/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Scott Morrison, Adam Topaz
-/
import algebraic_topology.simplex_category
import category_theory.arrow
import category_theory.limits.functor_category
import category_theory.opposites

/-!
# Simplicial objects in a category.

A simplicial object in a category `C` is a `C`-valued presheaf on `simplex_category`.
(Similarly a cosimplicial object is functor `simplex_category ⥤ C`.)

Use the notation `X _[n]` in the `simplicial` locale to obtain the `n`-th term of a
(co)simplicial object `X`, where `n` is a natural number.

-/

open opposite
open category_theory
open category_theory.limits

universes v u v' u'

namespace category_theory

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

/-- The category of simplicial objects valued in a category `C`.
This is the category of contravariant functors from `simplex_category` to `C`. -/
@[derive category, nolint has_nonempty_instance]
def simplicial_object := simplex_categoryᵒᵖ ⥤ C

namespace simplicial_object

localized "notation (name := simplicial_object.at) X ` _[`:1000 n `]` :=
  (X : category_theory.simplicial_object hole!).obj (opposite.op (simplex_category.mk n))"
  in simplicial

instance {J : Type v} [small_category J] [has_limits_of_shape J C] :
  has_limits_of_shape J (simplicial_object C) := by {dsimp [simplicial_object], apply_instance}

instance [has_limits C] : has_limits (simplicial_object C) := ⟨infer_instance⟩

instance {J : Type v} [small_category J] [has_colimits_of_shape J C] :
  has_colimits_of_shape J (simplicial_object C) := by {dsimp [simplicial_object], apply_instance}

instance [has_colimits C] : has_colimits (simplicial_object C) := ⟨infer_instance⟩

variables {C} (X : simplicial_object C)

/-- Face maps for a simplicial object. -/
def δ {n} (i : fin (n+2)) : X _[n+1] ⟶ X _[n] :=
X.map (simplex_category.δ i).op

/-- Degeneracy maps for a simplicial object. -/
def σ {n} (i : fin (n+1)) : X _[n] ⟶ X _[n+1] :=
X.map (simplex_category.σ i).op

/-- Isomorphisms from identities in ℕ. -/
def eq_to_iso {n m : ℕ} (h : n = m) : X _[n] ≅ X _[m] :=
X.map_iso (eq_to_iso (by rw h))

@[simp] lemma eq_to_iso_refl {n : ℕ} (h : n = n) : X.eq_to_iso h = iso.refl _ :=
by { ext, simp [eq_to_iso], }

/-- The generic case of the first simplicial identity -/
@[reassoc]
lemma δ_comp_δ {n} {i j : fin (n+2)} (H : i ≤ j) :
  X.δ j.succ ≫ X.δ i = X.δ i.cast_succ ≫ X.δ j :=
by { dsimp [δ], simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_δ H] }

@[reassoc]
lemma δ_comp_δ' {n} {i : fin (n+2)} {j : fin (n+3)} (H : i.cast_succ < j) :
  X.δ j ≫ X.δ i = X.δ i.cast_succ ≫
    X.δ (j.pred (λ hj, by simpa only [hj, fin.not_lt_zero] using H)) :=
by { dsimp [δ], simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_δ' H] }

@[reassoc]

/-- The special case of the first simplicial identity -/
@[reassoc]
lemma δ_comp_δ_self {n} {i : fin (n+2)} : X.δ i.cast_succ ≫ X.δ i = X.δ i.succ ≫ X.δ i :=
by { dsimp [δ], simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_δ_self] }

@[reassoc]
lemma δ_comp_δ_self' {n} {j : fin (n+3)} {i : fin (n+2)} (H : j = i.cast_succ) :
  X.δ j ≫ X.δ i = X.δ i.succ ≫ X.δ i :=
by { subst H, rw δ_comp_δ_self, }

/-- The second simplicial identity -/
@[reassoc]
lemma δ_comp_σ_of_le {n} {i : fin (n+2)} {j : fin (n+1)} (H : i ≤ j.cast_succ) :
  X.σ j.succ ≫ X.δ i.cast_succ = X.δ i ≫ X.σ j :=
by { dsimp [δ, σ], simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_σ_of_le H] }

/-- The first part of the third simplicial identity -/
@[reassoc]
lemma δ_comp_σ_self {n} {i : fin (n+1)} :
  X.σ i ≫ X.δ i.cast_succ = 𝟙 _ :=
begin
  dsimp [δ, σ],
  simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_σ_self, op_id, X.map_id],
end

@[reassoc]
lemma δ_comp_σ_self' {n} {j : fin (n+2)} {i : fin (n+1)} (H : j = i.cast_succ):
  X.σ i ≫ X.δ j = 𝟙 _ := by { subst H, rw δ_comp_σ_self, }

/-- The second part of the third simplicial identity -/
@[reassoc]
lemma δ_comp_σ_succ {n} {i : fin (n+1)} :
  X.σ i ≫ X.δ i.succ = 𝟙 _ :=
begin
  dsimp [δ, σ],
  simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_σ_succ, op_id, X.map_id],
end

@[reassoc]
lemma δ_comp_σ_succ' {n} {j : fin (n+2)} {i : fin (n+1)} (H : j = i.succ) :
  X.σ i ≫ X.δ j = 𝟙 _ := by { subst H, rw δ_comp_σ_succ, }

/-- The fourth simplicial identity -/
@[reassoc]
lemma δ_comp_σ_of_gt {n} {i : fin (n+2)} {j : fin (n+1)} (H : j.cast_succ < i) :
  X.σ j.cast_succ ≫ X.δ i.succ = X.δ i ≫ X.σ j :=
by { dsimp [δ, σ], simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_σ_of_gt H] }

@[reassoc]
lemma δ_comp_σ_of_gt' {n} {i : fin (n+3)} {j : fin (n+2)} (H : j.succ < i) :
  X.σ j ≫ X.δ i = X.δ (i.pred (λ hi, by simpa only [fin.not_lt_zero, hi] using H)) ≫
    X.σ (j.cast_lt ((add_lt_add_iff_right 1).mp (lt_of_lt_of_le
      (by simpa only [fin.val_eq_coe, ← fin.coe_succ]
        using fin.lt_iff_coe_lt_coe.mp H) i.is_le))) :=
by { dsimp [δ, σ], simpa only [←X.map_comp, ←op_comp, simplex_category.δ_comp_σ_of_gt' H], }

/-- The fifth simplicial identity -/
@[reassoc]
lemma σ_comp_σ {n} {i j : fin (n+1)} (H : i ≤ j) :
  X.σ j ≫ X.σ i.cast_succ = X.σ i ≫ X.σ j.succ :=
by { dsimp [δ, σ], simp only [←X.map_comp, ←op_comp, simplex_category.σ_comp_σ H] }

open_locale simplicial

@[simp, reassoc]
lemma δ_naturality {X' X : simplicial_object C} (f : X ⟶ X') {n : ℕ} (i : fin (n+2)) :
  X.δ i ≫ f.app (op [n]) = f.app (op [n+1]) ≫ X'.δ i := f.naturality _

@[simp, reassoc]
lemma σ_naturality {X' X : simplicial_object C} (f : X ⟶ X') {n : ℕ} (i : fin (n+1)) :
  X.σ i ≫ f.app (op [n+1]) = f.app (op [n]) ≫ X'.σ i := f.naturality _

variable (C)

/-- Functor composition induces a functor on simplicial objects. -/
@[simps]
def whiskering (D : Type*) [category D] :
  (C ⥤ D) ⥤ simplicial_object C ⥤ simplicial_object D :=
whiskering_right _ _ _

/-- Truncated simplicial objects. -/
@[derive category, nolint has_nonempty_instance]
def truncated (n : ℕ) := (simplex_category.truncated n)ᵒᵖ ⥤ C

variable {C}

namespace truncated

instance {n} {J : Type v} [small_category J] [has_limits_of_shape J C] :
  has_limits_of_shape J (simplicial_object.truncated C n) := by {dsimp [truncated], apply_instance}

instance {n} [has_limits C] : has_limits (simplicial_object.truncated C n) := ⟨infer_instance⟩

instance {n} {J : Type v} [small_category J] [has_colimits_of_shape J C] :
  has_colimits_of_shape J (simplicial_object.truncated C n) :=
by {dsimp [truncated], apply_instance}

instance {n} [has_colimits C] : has_colimits (simplicial_object.truncated C n) := ⟨infer_instance⟩

variable (C)

/-- Functor composition induces a functor on truncated simplicial objects. -/
@[simps]
def whiskering {n} (D : Type*) [category D] :
  (C ⥤ D) ⥤ truncated C n ⥤ truncated D n :=
whiskering_right _ _ _

variable {C}

end truncated

section skeleton

/-- The skeleton functor from simplicial objects to truncated simplicial objects. -/
def sk (n : ℕ) : simplicial_object C ⥤ simplicial_object.truncated C n :=
(whiskering_left _ _ _).obj simplex_category.truncated.inclusion.op

end skeleton

variable (C)

/-- The constant simplicial object is the constant functor. -/
abbreviation const : C ⥤ simplicial_object C := category_theory.functor.const _

/-- The category of augmented simplicial objects, defined as a comma category. -/
@[derive category, nolint has_nonempty_instance]
def augmented := comma (𝟭 (simplicial_object C)) (const C)

variable {C}

namespace augmented

/-- Drop the augmentation. -/
@[simps]
def drop : augmented C ⥤ simplicial_object C := comma.fst _ _

/-- The point of the augmentation. -/
@[simps]
def point : augmented C ⥤ C := comma.snd _ _

/-- The functor from augmented objects to arrows. -/
@[simps]
def to_arrow : augmented C ⥤ arrow C :=
{ obj := λ X,
  { left := (drop.obj X) _[0],
    right := (point.obj X),
    hom := X.hom.app _ },
  map := λ X Y η,
  { left := (drop.map η).app _,
    right := (point.map η),
    w' := begin
      dsimp,
      rw ← nat_trans.comp_app,
      erw η.w,
      refl,
    end } }

/-- The compatibility of a morphism with the augmentation, on 0-simplices -/
@[reassoc]
lemma w₀ {X Y : augmented C} (f : X ⟶ Y) :
  (augmented.drop.map f).app (op (simplex_category.mk 0)) ≫
    Y.hom.app (op (simplex_category.mk 0)) =
  X.hom.app (op (simplex_category.mk 0)) ≫ augmented.point.map f :=
by convert congr_app f.w (op (simplex_category.mk 0))

variable (C)

/-- Functor composition induces a functor on augmented simplicial objects. -/
@[simp]
def whiskering_obj (D : Type*) [category D] (F : C ⥤ D) :
  augmented C ⥤ augmented D :=
{ obj := λ X,
  { left := ((whiskering _ _).obj F).obj (drop.obj X),
    right := F.obj (point.obj X),
    hom := whisker_right X.hom F ≫ (functor.const_comp _ _ _).hom },
  map := λ X Y η,
  { left := whisker_right η.left _,
    right := F.map η.right,
    w' := begin
      ext,
      dsimp,
      rw [category.comp_id, category.comp_id, ← F.map_comp, ← F.map_comp, ← nat_trans.comp_app],
      erw η.w,
      refl,
    end } }

/-- Functor composition induces a functor on augmented simplicial objects. -/
@[simps]
def whiskering (D : Type u') [category.{v'} D] :
  (C ⥤ D) ⥤ augmented C ⥤ augmented D :=
{ obj := whiskering_obj _ _,
  map := λ X Y η,
  { app := λ A,
    { left := whisker_left _ η,
      right := η.app _,
      w' := begin
        ext n,
        dsimp,
        rw [category.comp_id, category.comp_id, η.naturality],
      end }, }, }

variable {C}

end augmented

/-- Augment a simplicial object with an object. -/
@[simps]
def augment (X : simplicial_object C) (X₀ : C) (f : X _[0] ⟶ X₀)
  (w : ∀ (i : simplex_category) (g₁ g₂ : [0] ⟶ i),
    X.map g₁.op ≫ f = X.map g₂.op ≫ f) : simplicial_object.augmented C :=
{ left := X,
  right := X₀,
  hom :=
  { app := λ i, X.map (simplex_category.const i.unop 0).op ≫ f,
    naturality' := begin
      intros i j g,
      dsimp,
      rw ← g.op_unop,
      simpa only [← X.map_comp, ← category.assoc, category.comp_id, ← op_comp] using w _ _ _,
    end } }

@[simp]
lemma augment_hom_zero (X : simplicial_object C) (X₀ : C) (f : X _[0] ⟶ X₀) (w) :
  (X.augment X₀ f w).hom.app (op [0]) = f :=
by { dsimp, rw [simplex_category.hom_zero_zero ([0].const 0), op_id, X.map_id, category.id_comp] }

end simplicial_object

/-- Cosimplicial objects. -/
@[derive category, nolint has_nonempty_instance]
def cosimplicial_object := simplex_category ⥤ C

namespace cosimplicial_object

localized "notation (name := cosimplicial_object.at) X ` _[`:1000 n `]` :=
  (X : category_theory.cosimplicial_object hole!).obj (simplex_category.mk n)" in simplicial

instance {J : Type v} [small_category J] [has_limits_of_shape J C] :
  has_limits_of_shape J (cosimplicial_object C) := by {dsimp [cosimplicial_object], apply_instance}

instance [has_limits C] : has_limits (cosimplicial_object C) := ⟨infer_instance⟩

instance {J : Type v} [small_category J] [has_colimits_of_shape J C] :
  has_colimits_of_shape J (cosimplicial_object C) :=
by {dsimp [cosimplicial_object], apply_instance}

instance [has_colimits C] : has_colimits (cosimplicial_object C) := ⟨infer_instance⟩

variables {C} (X : cosimplicial_object C)

/-- Coface maps for a cosimplicial object. -/
def δ {n} (i : fin (n+2)) : X _[n] ⟶ X _[n+1] :=
X.map (simplex_category.δ i)

/-- Codegeneracy maps for a cosimplicial object. -/
def σ {n} (i : fin (n+1)) : X _[n+1] ⟶ X _[n] :=
X.map (simplex_category.σ i)

/-- Isomorphisms from identities in ℕ. -/
def eq_to_iso {n m : ℕ} (h : n = m) : X _[n] ≅ X _[m] :=
X.map_iso (eq_to_iso (by rw h))

@[simp] lemma eq_to_iso_refl {n : ℕ} (h : n = n) : X.eq_to_iso h = iso.refl _ :=
by { ext, simp [eq_to_iso], }

/-- The generic case of the first cosimplicial identity -/
@[reassoc]
lemma δ_comp_δ {n} {i j : fin (n+2)} (H : i ≤ j) :
  X.δ i ≫ X.δ j.succ = X.δ j ≫ X.δ i.cast_succ :=
by { dsimp [δ], simp only [←X.map_comp, simplex_category.δ_comp_δ H], }

@[reassoc]
lemma δ_comp_δ' {n} {i : fin (n+2)} {j : fin (n+3)} (H : i.cast_succ < j) :
  X.δ i ≫ X.δ j = X.δ (j.pred (λ hj, by simpa only [hj, fin.not_lt_zero] using H)) ≫
    X.δ i.cast_succ :=
by { dsimp [δ], simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_δ' H] }

@[reassoc]
lemma δ_comp_δ'' {n} {i : fin (n+3)} {j : fin (n+2)} (H : i ≤ j.cast_succ) :
  X.δ (i.cast_lt (nat.lt_of_le_of_lt (fin.le_iff_coe_le_coe.mp H) j.is_lt)) ≫ X.δ j.succ =
    X.δ j ≫ X.δ i :=
by { dsimp [δ], simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_δ'' H] }

/-- The special case of the first cosimplicial identity -/
@[reassoc]
lemma δ_comp_δ_self {n} {i : fin (n+2)} : X.δ i ≫ X.δ i.cast_succ = X.δ i ≫ X.δ i.succ :=
by { dsimp [δ], simp only [←X.map_comp, simplex_category.δ_comp_δ_self] }

@[reassoc]
lemma δ_comp_δ_self' {n} {i : fin (n+2)} {j : fin (n+3)} (H : j = i.cast_succ) :
  X.δ i ≫ X.δ j = X.δ i ≫ X.δ i.succ :=
by { subst H, rw δ_comp_δ_self, }

/-- The second cosimplicial identity -/
@[reassoc]
lemma δ_comp_σ_of_le {n} {i : fin (n+2)} {j : fin (n+1)} (H : i ≤ j.cast_succ) :
  X.δ i.cast_succ ≫ X.σ j.succ = X.σ j ≫ X.δ i :=
by { dsimp [δ, σ], simp only [←X.map_comp, simplex_category.δ_comp_σ_of_le H] }

/-- The first part of the third cosimplicial identity -/
@[reassoc]
lemma δ_comp_σ_self {n} {i : fin (n+1)} :
  X.δ i.cast_succ ≫ X.σ i = 𝟙 _ :=
begin
  dsimp [δ, σ],
  simp only [←X.map_comp, simplex_category.δ_comp_σ_self, X.map_id],
end

@[reassoc]
lemma δ_comp_σ_self' {n} {j : fin (n+2)} {i : fin (n+1)} (H : j = i.cast_succ) :
  X.δ j ≫ X.σ i = 𝟙 _ :=
by { subst H, rw δ_comp_σ_self, }

/-- The second part of the third cosimplicial identity -/
@[reassoc]
lemma δ_comp_σ_succ {n} {i : fin (n+1)} :
  X.δ i.succ ≫ X.σ i = 𝟙 _ :=
begin
  dsimp [δ, σ],
  simp only [←X.map_comp, simplex_category.δ_comp_σ_succ, X.map_id],
end

@[reassoc]
lemma δ_comp_σ_succ' {n} {j : fin (n+2)} {i : fin (n+1)} (H : j = i.succ) :
  X.δ j ≫ X.σ i = 𝟙 _ :=
by { subst H, rw δ_comp_σ_succ, }

/-- The fourth cosimplicial identity -/
@[reassoc]
lemma δ_comp_σ_of_gt {n} {i : fin (n+2)} {j : fin (n+1)} (H : j.cast_succ < i) :
  X.δ i.succ ≫ X.σ j.cast_succ = X.σ j ≫ X.δ i :=
by { dsimp [δ, σ], simp only [←X.map_comp, simplex_category.δ_comp_σ_of_gt H] }

@[reassoc]
lemma δ_comp_σ_of_gt' {n} {i : fin (n+3)} {j : fin (n+2)} (H : j.succ < i) :
  X.δ i ≫ X.σ j = X.σ (j.cast_lt ((add_lt_add_iff_right 1).mp (lt_of_lt_of_le
      (by simpa only [fin.val_eq_coe, ← fin.coe_succ]
        using fin.lt_iff_coe_lt_coe.mp H) i.is_le))) ≫
    X.δ (i.pred (λ hi, by simpa only [fin.not_lt_zero, hi] using H)) :=
by { dsimp [δ, σ], simpa only [←X.map_comp, ←op_comp, simplex_category.δ_comp_σ_of_gt' H], }

/-- The fifth cosimplicial identity -/
@[reassoc]
lemma σ_comp_σ {n} {i j : fin (n+1)} (H : i ≤ j) :
  X.σ i.cast_succ ≫ X.σ j = X.σ j.succ ≫ X.σ i :=
by { dsimp [δ, σ], simp only [←X.map_comp, simplex_category.σ_comp_σ H] }

@[simp, reassoc]
lemma δ_naturality {X' X : cosimplicial_object C} (f : X ⟶ X') {n : ℕ} (i : fin (n+2)) :
  X.δ i ≫ f.app (simplex_category.mk (n+1)) =
    f.app (simplex_category.mk n) ≫ X'.δ i := f.naturality _

@[simp, reassoc]
lemma σ_naturality {X' X : cosimplicial_object C} (f : X ⟶ X') {n : ℕ} (i : fin (n+1)) :
  X.σ i ≫ f.app (simplex_category.mk n) =
    f.app (simplex_category.mk (n+1)) ≫ X'.σ i := f.naturality _

variable (C)

/-- Functor composition induces a functor on cosimplicial objects. -/
@[simps]
def whiskering (D : Type*) [category D] :
  (C ⥤ D) ⥤ cosimplicial_object C ⥤ cosimplicial_object D :=
whiskering_right _ _ _

/-- Truncated cosimplicial objects. -/
@[derive category, nolint has_nonempty_instance]
def truncated (n : ℕ) := simplex_category.truncated n ⥤ C

variable {C}

namespace truncated

instance {n} {J : Type v} [small_category J] [has_limits_of_shape J C] :
  has_limits_of_shape J (cosimplicial_object.truncated C n) :=
by {dsimp [truncated], apply_instance}

instance {n} [has_limits C] : has_limits (cosimplicial_object.truncated C n) := ⟨infer_instance⟩

instance {n} {J : Type v} [small_category J] [has_colimits_of_shape J C] :
  has_colimits_of_shape J (cosimplicial_object.truncated C n) :=
by {dsimp [truncated], apply_instance}

instance {n} [has_colimits C] : has_colimits (cosimplicial_object.truncated C n) := ⟨infer_instance⟩

variable (C)

/-- Functor composition induces a functor on truncated cosimplicial objects. -/
@[simps]
def whiskering {n} (D : Type*) [category D] :
  (C ⥤ D) ⥤ truncated C n ⥤ truncated D n :=
whiskering_right _ _ _

variable {C}

end truncated

section skeleton

/-- The skeleton functor from cosimplicial objects to truncated cosimplicial objects. -/
def sk (n : ℕ) : cosimplicial_object C ⥤ cosimplicial_object.truncated C n :=
(whiskering_left _ _ _).obj simplex_category.truncated.inclusion

end skeleton

variable (C)

/-- The constant cosimplicial object. -/
abbreviation const : C ⥤ cosimplicial_object C := category_theory.functor.const _

/-- Augmented cosimplicial objects. -/
@[derive category, nolint has_nonempty_instance]
def augmented := comma (const C) (𝟭 (cosimplicial_object C))

variable {C}

namespace augmented

/-- Drop the augmentation. -/
@[simps]
def drop : augmented C ⥤ cosimplicial_object C := comma.snd _ _

/-- The point of the augmentation. -/
@[simps]
def point : augmented C ⥤ C := comma.fst _ _

/-- The functor from augmented objects to arrows. -/
@[simps]
def to_arrow : augmented C ⥤ arrow C :=
{ obj := λ X,
  { left := (point.obj X),
    right := (drop.obj X) _[0],
    hom := X.hom.app _ },
  map := λ X Y η,
  { left := (point.map η),
    right := (drop.map η).app _,
    w' := begin
      dsimp,
      rw ← nat_trans.comp_app,
      erw ← η.w,
      refl,
    end } }

variable (C)

/-- Functor composition induces a functor on augmented cosimplicial objects. -/
@[simp]
def whiskering_obj (D : Type*) [category D] (F : C ⥤ D) :
  augmented C ⥤ augmented D :=
{ obj := λ X,
  { left := F.obj (point.obj X),
    right := ((whiskering _ _).obj F).obj (drop.obj X),
    hom := (functor.const_comp _ _ _).inv ≫ whisker_right X.hom F },
  map := λ X Y η,
  { left := F.map η.left,
    right := whisker_right η.right _,
    w' := begin
      ext,
      dsimp,
      rw [category.id_comp, category.id_comp, ← F.map_comp, ← F.map_comp, ← nat_trans.comp_app],
      erw ← η.w,
      refl,
    end } }

/-- Functor composition induces a functor on augmented cosimplicial objects. -/
@[simps]
def whiskering (D : Type u') [category.{v'} D] :
  (C ⥤ D) ⥤ augmented C ⥤ augmented D :=
{ obj := whiskering_obj _ _,
  map := λ X Y η,
  { app := λ A,
    { left := η.app _,
      right := whisker_left _ η,
      w' := begin
        ext n,
        dsimp,
        rw [category.id_comp, category.id_comp, η.naturality],
      end }, }, }

variable {C}

end augmented

open_locale simplicial

/-- Augment a cosimplicial object with an object. -/
@[simps]
def augment (X : cosimplicial_object C) (X₀ : C) (f : X₀ ⟶ X.obj [0])
  (w : ∀ (i : simplex_category) (g₁ g₂ : [0] ⟶ i),
    f ≫ X.map g₁ = f ≫ X.map g₂) : cosimplicial_object.augmented C :=
{ left := X₀,
  right := X,
  hom :=
  { app := λ i, f ≫ X.map (simplex_category.const i 0),
  naturality' := begin
    intros i j g,
    dsimp,
    simpa [← X.map_comp] using w _ _ _,
  end } }

@[simp]
lemma augment_hom_zero (X : cosimplicial_object C) (X₀ : C) (f : X₀ ⟶ X.obj [0]) (w) :
  (X.augment X₀ f w).hom.app [0] = f :=
by { dsimp, rw [simplex_category.hom_zero_zero ([0].const 0), X.map_id, category.comp_id] }

end cosimplicial_object

/-- The anti-equivalence between simplicial objects and cosimplicial objects. -/
@[simps]
def simplicial_cosimplicial_equiv : (simplicial_object C)ᵒᵖ ≌ (cosimplicial_object Cᵒᵖ) :=
functor.left_op_right_op_equiv _ _

/-- The anti-equivalence between cosimplicial objects and simplicial objects. -/
@[simps]
def cosimplicial_simplicial_equiv : (cosimplicial_object C)ᵒᵖ ≌ (simplicial_object Cᵒᵖ) :=
functor.op_unop_equiv _ _

variable {C}

/-- Construct an augmented cosimplicial object in the opposite
category from an augmented simplicial object. -/
@[simps]
def simplicial_object.augmented.right_op (X : simplicial_object.augmented C) :
  cosimplicial_object.augmented Cᵒᵖ :=
{ left := opposite.op X.right,
  right := X.left.right_op,
  hom := X.hom.right_op }

/-- Construct an augmented simplicial object from an augmented cosimplicial
object in the opposite category. -/
@[simps]
def cosimplicial_object.augmented.left_op (X : cosimplicial_object.augmented Cᵒᵖ) :
  simplicial_object.augmented C :=
{ left := X.right.left_op,
  right := X.left.unop,
  hom := X.hom.left_op }

/-- Converting an augmented simplicial object to an augmented cosimplicial
object and back is isomorphic to the given object. -/
@[simps]
def simplicial_object.augmented.right_op_left_op_iso (X : simplicial_object.augmented C) :
  X.right_op.left_op ≅ X :=
comma.iso_mk X.left.right_op_left_op_iso (eq_to_iso $ by simp) (by tidy)

/-- Converting an augmented cosimplicial object to an augmented simplicial
object and back is isomorphic to the given object. -/
@[simps]
def cosimplicial_object.augmented.left_op_right_op_iso (X : cosimplicial_object.augmented Cᵒᵖ) :
  X.left_op.right_op ≅ X :=
comma.iso_mk (eq_to_iso $ by simp) X.right.left_op_right_op_iso (by tidy)

variable (C)

/-- A functorial version of `simplicial_object.augmented.right_op`. -/
@[simps]
def simplicial_to_cosimplicial_augmented :
  (simplicial_object.augmented C)ᵒᵖ ⥤ cosimplicial_object.augmented Cᵒᵖ :=
{ obj := λ X, X.unop.right_op,
  map := λ X Y f,
  { left := f.unop.right.op,
    right := f.unop.left.right_op,
    w' := begin
      ext x,
      dsimp,
      simp_rw ← op_comp,
      congr' 1,
      exact (congr_app f.unop.w (op x)).symm,
    end } }

/-- A functorial version of `cosimplicial_object.augmented.left_op`. -/
@[simps]
def cosimplicial_to_simplicial_augmented :
  cosimplicial_object.augmented Cᵒᵖ ⥤ (simplicial_object.augmented C)ᵒᵖ :=
{ obj := λ X, opposite.op X.left_op,
  map := λ X Y f, quiver.hom.op $
  { left := f.right.left_op,
    right := f.left.unop,
    w' := begin
      ext x,
      dsimp,
      simp_rw ← unop_comp,
      congr' 1,
      exact (congr_app f.w x.unop).symm,
    end} }

/-- The contravariant categorical equivalence between augmented simplicial
objects and augmented cosimplicial objects in the opposite category. -/
@[simps functor inverse]
def simplicial_cosimplicial_augmented_equiv :
  (simplicial_object.augmented C)ᵒᵖ ≌ cosimplicial_object.augmented Cᵒᵖ :=
equivalence.mk
  (simplicial_to_cosimplicial_augmented _)
  (cosimplicial_to_simplicial_augmented _)
  (nat_iso.of_components (λ X, X.unop.right_op_left_op_iso.op) $ λ X Y f,
    by { dsimp, rw ←f.op_unop, simp_rw ← op_comp, congr' 1, tidy })
  (nat_iso.of_components (λ X, X.left_op_right_op_iso) $ by tidy)

end category_theory


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

! This file was ported from Lean 3 source module topology.instances.sign
! leanprover-community/mathlib commit 50832daea47b195a48b5b33b1c8b2162c48c3afc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Sign
import Mathbin.Topology.Order.Basic

/-!
# Topology on `sign_type`

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

This file gives `sign_type` the discrete topology, and proves continuity results for `sign` in
an `order_topology`.

-/

instance : TopologicalSpace SignType :=
  ⊥

instance : DiscreteTopology SignType :=
  ⟨rfl⟩

variable {α : Type _} [Zero α] [TopologicalSpace α]

section PartialOrder

variable [PartialOrder α] [DecidableRel ((· < ·) : α → α → Prop)] [OrderTopology α]

/- warning: continuous_at_sign_of_pos -> continuousAt_sign_of_pos is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Zero.{u1} α] [_inst_2 : TopologicalSpace.{u1} α] [_inst_3 : PartialOrder.{u1} α] [_inst_4 : DecidableRel.{succ u1} α (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α _inst_3)))] [_inst_5 : OrderTopology.{u1} α _inst_2 (PartialOrder.toPreorder.{u1} α _inst_3)] {a : α}, (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α _inst_3)) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α _inst_1))) a) -> (ContinuousAt.{u1, 0} α SignType _inst_2 SignType.topologicalSpace (coeFn.{succ u1, succ u1} (OrderHom.{u1, 0} α SignType (PartialOrder.toPreorder.{u1} α _inst_3) (PartialOrder.toPreorder.{0} SignType (SemilatticeInf.toPartialOrder.{0} SignType (Lattice.toSemilatticeInf.{0} SignType (LinearOrder.toLattice.{0} SignType SignType.linearOrder))))) (fun (_x : OrderHom.{u1, 0} α SignType (PartialOrder.toPreorder.{u1} α _inst_3) (PartialOrder.toPreorder.{0} SignType (SemilatticeInf.toPartialOrder.{0} SignType (Lattice.toSemilatticeInf.{0} SignType (LinearOrder.toLattice.{0} SignType SignType.linearOrder))))) => α -> SignType) (OrderHom.hasCoeToFun.{u1, 0} α SignType (PartialOrder.toPreorder.{u1} α _inst_3) (PartialOrder.toPreorder.{0} SignType (SemilatticeInf.toPartialOrder.{0} SignType (Lattice.toSemilatticeInf.{0} SignType (LinearOrder.toLattice.{0} SignType SignType.linearOrder))))) (SignType.sign.{u1} α _inst_1 (PartialOrder.toPreorder.{u1} α _inst_3) (fun (a : α) (b : α) => _inst_4 a b))) a)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : Zero.{u1} α] [_inst_2 : TopologicalSpace.{u1} α] [_inst_3 : PartialOrder.{u1} α] [_inst_4 : DecidableRel.{succ u1} α (fun (x._@.Mathlib.Topology.Instances.Sign._hyg.105 : α) (x._@.Mathlib.Topology.Instances.Sign._hyg.107 : α) => LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α _inst_3)) x._@.Mathlib.Topology.Instances.Sign._hyg.105 x._@.Mathlib.Topology.Instances.Sign._hyg.107)] [_inst_5 : OrderTopology.{u1} α _inst_2 (PartialOrder.toPreorder.{u1} α _inst_3)] {a : α}, (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α _inst_3)) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α _inst_1)) a) -> (ContinuousAt.{u1, 0} α SignType _inst_2 instTopologicalSpaceSignType (OrderHom.toFun.{u1, 0} α SignType (PartialOrder.toPreorder.{u1} α _inst_3) (PartialOrder.toPreorder.{0} SignType (SemilatticeInf.toPartialOrder.{0} SignType (Lattice.toSemilatticeInf.{0} SignType (DistribLattice.toLattice.{0} SignType (instDistribLattice.{0} SignType SignType.instLinearOrderSignType))))) (SignType.sign.{u1} α _inst_1 (PartialOrder.toPreorder.{u1} α _inst_3) (fun (a : α) (b : α) => _inst_4 a b))) a)
Case conversion may be inaccurate. Consider using '#align continuous_at_sign_of_pos continuousAt_sign_of_posₓ'. -/
theorem continuousAt_sign_of_pos {a : α} (h : 0 < a) : ContinuousAt SignType.sign a :=
  by
  refine' (continuousAt_const : ContinuousAt (fun x => (1 : SignType)) a).congr _
  rw [Filter.EventuallyEq, eventually_nhds_iff]
  exact ⟨{ x | 0 < x }, fun x hx => (sign_pos hx).symm, isOpen_lt' 0, h⟩
#align continuous_at_sign_of_pos continuousAt_sign_of_pos

/- warning: continuous_at_sign_of_neg -> continuousAt_sign_of_neg is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Zero.{u1} α] [_inst_2 : TopologicalSpace.{u1} α] [_inst_3 : PartialOrder.{u1} α] [_inst_4 : DecidableRel.{succ u1} α (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α _inst_3)))] [_inst_5 : OrderTopology.{u1} α _inst_2 (PartialOrder.toPreorder.{u1} α _inst_3)] {a : α}, (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α _inst_3)) a (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α _inst_1)))) -> (ContinuousAt.{u1, 0} α SignType _inst_2 SignType.topologicalSpace (coeFn.{succ u1, succ u1} (OrderHom.{u1, 0} α SignType (PartialOrder.toPreorder.{u1} α _inst_3) (PartialOrder.toPreorder.{0} SignType (SemilatticeInf.toPartialOrder.{0} SignType (Lattice.toSemilatticeInf.{0} SignType (LinearOrder.toLattice.{0} SignType SignType.linearOrder))))) (fun (_x : OrderHom.{u1, 0} α SignType (PartialOrder.toPreorder.{u1} α _inst_3) (PartialOrder.toPreorder.{0} SignType (SemilatticeInf.toPartialOrder.{0} SignType (Lattice.toSemilatticeInf.{0} SignType (LinearOrder.toLattice.{0} SignType SignType.linearOrder))))) => α -> SignType) (OrderHom.hasCoeToFun.{u1, 0} α SignType (PartialOrder.toPreorder.{u1} α _inst_3) (PartialOrder.toPreorder.{0} SignType (SemilatticeInf.toPartialOrder.{0} SignType (Lattice.toSemilatticeInf.{0} SignType (LinearOrder.toLattice.{0} SignType SignType.linearOrder))))) (SignType.sign.{u1} α _inst_1 (PartialOrder.toPreorder.{u1} α _inst_3) (fun (a : α) (b : α) => _inst_4 a b))) a)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : Zero.{u1} α] [_inst_2 : TopologicalSpace.{u1} α] [_inst_3 : PartialOrder.{u1} α] [_inst_4 : DecidableRel.{succ u1} α (fun (x._@.Mathlib.Topology.Instances.Sign._hyg.235 : α) (x._@.Mathlib.Topology.Instances.Sign._hyg.237 : α) => LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α _inst_3)) x._@.Mathlib.Topology.Instances.Sign._hyg.235 x._@.Mathlib.Topology.Instances.Sign._hyg.237)] [_inst_5 : OrderTopology.{u1} α _inst_2 (PartialOrder.toPreorder.{u1} α _inst_3)] {a : α}, (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α _inst_3)) a (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α _inst_1))) -> (ContinuousAt.{u1, 0} α SignType _inst_2 instTopologicalSpaceSignType (OrderHom.toFun.{u1, 0} α SignType (PartialOrder.toPreorder.{u1} α _inst_3) (PartialOrder.toPreorder.{0} SignType (SemilatticeInf.toPartialOrder.{0} SignType (Lattice.toSemilatticeInf.{0} SignType (DistribLattice.toLattice.{0} SignType (instDistribLattice.{0} SignType SignType.instLinearOrderSignType))))) (SignType.sign.{u1} α _inst_1 (PartialOrder.toPreorder.{u1} α _inst_3) (fun (a : α) (b : α) => _inst_4 a b))) a)
Case conversion may be inaccurate. Consider using '#align continuous_at_sign_of_neg continuousAt_sign_of_negₓ'. -/
theorem continuousAt_sign_of_neg {a : α} (h : a < 0) : ContinuousAt SignType.sign a :=
  by
  refine' (continuousAt_const : ContinuousAt (fun x => (-1 : SignType)) a).congr _
  rw [Filter.EventuallyEq, eventually_nhds_iff]
  exact ⟨{ x | x < 0 }, fun x hx => (sign_neg hx).symm, isOpen_gt' 0, h⟩
#align continuous_at_sign_of_neg continuousAt_sign_of_neg

end PartialOrder

section LinearOrder

variable [LinearOrder α] [OrderTopology α]

#print continuousAt_sign_of_ne_zero /-
theorem continuousAt_sign_of_ne_zero {a : α} (h : a ≠ 0) : ContinuousAt SignType.sign a :=
  by
  rcases h.lt_or_lt with (h_neg | h_pos)
  · exact continuousAt_sign_of_neg h_neg
  · exact continuousAt_sign_of_pos h_pos
#align continuous_at_sign_of_ne_zero continuousAt_sign_of_ne_zero
-/

end LinearOrder


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Markus Himmel, Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.shapes.wide_pullbacks
import Mathlib.category_theory.limits.shapes.binary_products
import Mathlib.PostPort

universes v u_1 u u₂

namespace Mathlib

/-!
# Pullbacks

We define a category `walking_cospan` (resp. `walking_span`), which is the index category
for the given data for a pullback (resp. pushout) diagram. Convenience methods `cospan f g`
and `span f g` construct functors from the walking (co)span, hitting the given morphisms.

We define `pullback f g` and `pushout f g` as limits and colimits of such functors.

## References
* [Stacks: Fibre products](https://stacks.math.columbia.edu/tag/001U)
* [Stacks: Pushouts](https://stacks.math.columbia.edu/tag/0025)
-/

namespace category_theory.limits

/--
The type of objects for the diagram indexing a pullback, defined as a special case of
`wide_pullback_shape`.
-/
def walking_cospan :=
  wide_pullback_shape walking_pair

/-- The left point of the walking cospan. -/
/-- The right point of the walking cospan. -/
def walking_cospan.left : walking_cospan :=
  some walking_pair.left

/-- The central point of the walking cospan. -/
def walking_cospan.right : walking_cospan :=
  some walking_pair.right

def walking_cospan.one : walking_cospan :=
  none

/--
The type of objects for the diagram indexing a pushout, defined as a special case of
`wide_pushout_shape`.
-/
def walking_span :=
  wide_pushout_shape walking_pair

/-- The left point of the walking span. -/
/-- The right point of the walking span. -/
def walking_span.left : walking_span :=
  some walking_pair.left

/-- The central point of the walking span. -/
def walking_span.right : walking_span :=
  some walking_pair.right

def walking_span.zero : walking_span :=
  none

namespace walking_cospan

/-- The type of arrows for the diagram indexing a pullback. -/
def hom : walking_cospan → walking_cospan → Type v :=
  wide_pullback_shape.hom

/-- The left arrow of the walking cospan. -/
/-- The right arrow of the walking cospan. -/
def hom.inl : left ⟶ one :=
  wide_pullback_shape.hom.term walking_pair.left

/-- The identity arrows of the walking cospan. -/
def hom.inr : right ⟶ one :=
  wide_pullback_shape.hom.term walking_pair.right

def hom.id (X : walking_cospan) : X ⟶ X :=
  wide_pullback_shape.hom.id X

protected instance category_theory.has_hom.hom.subsingleton (X : walking_cospan) (Y : walking_cospan) : subsingleton (X ⟶ Y) :=
  subsingleton.intro fun (a b : X ⟶ Y) => eq.mpr (id (propext (eq_iff_true_of_subsingleton a b))) trivial

end walking_cospan

namespace walking_span

/-- The type of arrows for the diagram indexing a pushout. -/
def hom : walking_span → walking_span → Type v :=
  wide_pushout_shape.hom

/-- The left arrow of the walking span. -/
/-- The right arrow of the walking span. -/
def hom.fst : zero ⟶ left :=
  wide_pushout_shape.hom.init walking_pair.left

/-- The identity arrows of the walking span. -/
def hom.snd : zero ⟶ right :=
  wide_pushout_shape.hom.init walking_pair.right

def hom.id (X : walking_span) : X ⟶ X :=
  wide_pushout_shape.hom.id X

protected instance category_theory.has_hom.hom.subsingleton (X : walking_span) (Y : walking_span) : subsingleton (X ⟶ Y) :=
  subsingleton.intro fun (a b : X ⟶ Y) => eq.mpr (id (propext (eq_iff_true_of_subsingleton a b))) trivial

end walking_span

/-- `cospan f g` is the functor from the walking cospan hitting `f` and `g`. -/
def cospan {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) : walking_cospan ⥤ C :=
  wide_pullback_shape.wide_cospan Z (fun (j : walking_pair) => walking_pair.cases_on j X Y)
    fun (j : walking_pair) => walking_pair.cases_on j f g

/-- `span f g` is the functor from the walking span hitting `f` and `g`. -/
def span {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : X ⟶ Z) : walking_span ⥤ C :=
  wide_pushout_shape.wide_span X (fun (j : walking_pair) => walking_pair.cases_on j Y Z)
    fun (j : walking_pair) => walking_pair.cases_on j f g

@[simp] theorem cospan_left {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) : functor.obj (cospan f g) walking_cospan.left = X :=
  rfl

@[simp] theorem span_left {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : X ⟶ Z) : functor.obj (span f g) walking_span.left = Y :=
  rfl

@[simp] theorem cospan_right {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) : functor.obj (cospan f g) walking_cospan.right = Y :=
  rfl

@[simp] theorem span_right {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : X ⟶ Z) : functor.obj (span f g) walking_span.right = Z :=
  rfl

@[simp] theorem cospan_one {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) : functor.obj (cospan f g) walking_cospan.one = Z :=
  rfl

@[simp] theorem span_zero {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : X ⟶ Z) : functor.obj (span f g) walking_span.zero = X :=
  rfl

@[simp] theorem cospan_map_inl {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) : functor.map (cospan f g) walking_cospan.hom.inl = f :=
  rfl

@[simp] theorem span_map_fst {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : X ⟶ Z) : functor.map (span f g) walking_span.hom.fst = f :=
  rfl

@[simp] theorem cospan_map_inr {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) : functor.map (cospan f g) walking_cospan.hom.inr = g :=
  rfl

@[simp] theorem span_map_snd {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : X ⟶ Z) : functor.map (span f g) walking_span.hom.snd = g :=
  rfl

theorem cospan_map_id {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) (w : walking_cospan) : functor.map (cospan f g) (walking_cospan.hom.id w) = 𝟙 :=
  rfl

theorem span_map_id {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : X ⟶ Z) (w : walking_span) : functor.map (span f g) (walking_span.hom.id w) = 𝟙 :=
  rfl

/-- Every diagram indexing an pullback is naturally isomorphic (actually, equal) to a `cospan` -/
def diagram_iso_cospan {C : Type u} [category C] (F : walking_cospan ⥤ C) : F ≅ cospan (functor.map F walking_cospan.hom.inl) (functor.map F walking_cospan.hom.inr) :=
  nat_iso.of_components (fun (j : walking_cospan) => eq_to_iso sorry) sorry

/-- Every diagram indexing a pushout is naturally isomorphic (actually, equal) to a `span` -/
def diagram_iso_span {C : Type u} [category C] (F : walking_span ⥤ C) : F ≅ span (functor.map F walking_span.hom.fst) (functor.map F walking_span.hom.snd) :=
  nat_iso.of_components (fun (j : walking_span) => eq_to_iso sorry) sorry

/-- A pullback cone is just a cone on the cospan formed by two morphisms `f : X ⟶ Z` and
    `g : Y ⟶ Z`.-/
def pullback_cone {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) :=
  cone (cospan f g)

namespace pullback_cone

/-- The first projection of a pullback cone. -/
def fst {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (t : pullback_cone f g) : cone.X t ⟶ X :=
  nat_trans.app (cone.π t) walking_cospan.left

/-- The second projection of a pullback cone. -/
def snd {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (t : pullback_cone f g) : cone.X t ⟶ Y :=
  nat_trans.app (cone.π t) walking_cospan.right

/-- This is a slightly more convenient method to verify that a pullback cone is a limit cone. It
    only asks for a proof of facts that carry any mathematical content -/
def is_limit_aux {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (t : pullback_cone f g) (lift : (s : cone (cospan f g)) → cone.X s ⟶ cone.X t) (fac_left : ∀ (s : pullback_cone f g), lift s ≫ fst t = fst s) (fac_right : ∀ (s : pullback_cone f g), lift s ≫ snd t = snd s) (uniq : ∀ (s : pullback_cone f g) (m : cone.X s ⟶ cone.X t),
  (∀ (j : walking_cospan), m ≫ nat_trans.app (cone.π t) j = nat_trans.app (cone.π s) j) → m = lift s) : is_limit t :=
  is_limit.mk lift

/-- This is another convenient method to verify that a pullback cone is a limit cone. It
    only asks for a proof of facts that carry any mathematical content, and allows access to the
    same `s` for all parts. -/
def is_limit_aux' {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (t : pullback_cone f g) (create : (s : pullback_cone f g) →
  Subtype
    fun (l : cone.X s ⟶ cone.X t) =>
      l ≫ fst t = fst s ∧ l ≫ snd t = snd s ∧ ∀ {m : cone.X s ⟶ cone.X t}, m ≫ fst t = fst s → m ≫ snd t = snd s → m = l) : is_limit t :=
  is_limit_aux t (fun (s : cone (cospan f g)) => subtype.val (create s)) sorry sorry sorry

/-- A pullback cone on `f` and `g` is determined by morphisms `fst : W ⟶ X` and `snd : W ⟶ Y`
    such that `fst ≫ f = snd ≫ g`. -/
@[simp] theorem mk_π_app {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} {W : C} (fst : W ⟶ X) (snd : W ⟶ Y) (eq : fst ≫ f = snd ≫ g) (j : walking_cospan) : nat_trans.app (cone.π (mk fst snd eq)) j =
  option.cases_on j (fst ≫ f) fun (j' : walking_pair) => walking_pair.cases_on j' fst snd :=
  Eq.refl (nat_trans.app (cone.π (mk fst snd eq)) j)

@[simp] theorem mk_π_app_left {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} {W : C} (fst : W ⟶ X) (snd : W ⟶ Y) (eq : fst ≫ f = snd ≫ g) : nat_trans.app (cone.π (mk fst snd eq)) walking_cospan.left = fst :=
  rfl

@[simp] theorem mk_π_app_right {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} {W : C} (fst : W ⟶ X) (snd : W ⟶ Y) (eq : fst ≫ f = snd ≫ g) : nat_trans.app (cone.π (mk fst snd eq)) walking_cospan.right = snd :=
  rfl

@[simp] theorem mk_π_app_one {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} {W : C} (fst : W ⟶ X) (snd : W ⟶ Y) (eq : fst ≫ f = snd ≫ g) : nat_trans.app (cone.π (mk fst snd eq)) walking_cospan.one = fst ≫ f :=
  rfl

@[simp] theorem mk_fst {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} {W : C} (fst : W ⟶ X) (snd : W ⟶ Y) (eq : fst ≫ f = snd ≫ g) : fst (mk fst snd eq) = fst :=
  rfl

@[simp] theorem mk_snd {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} {W : C} (fst : W ⟶ X) (snd : W ⟶ Y) (eq : fst ≫ f = snd ≫ g) : snd (mk fst snd eq) = snd :=
  rfl

theorem condition_assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (t : pullback_cone f g) {X' : C} (f' : Z ⟶ X') : fst t ≫ f ≫ f' = snd t ≫ g ≫ f' := sorry

/-- To check whether a morphism is equalized by the maps of a pullback cone, it suffices to check
  it for `fst t` and `snd t` -/
theorem equalizer_ext {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (t : pullback_cone f g) {W : C} {k : W ⟶ cone.X t} {l : W ⟶ cone.X t} (h₀ : k ≫ fst t = l ≫ fst t) (h₁ : k ≫ snd t = l ≫ snd t) (j : walking_cospan) : k ≫ nat_trans.app (cone.π t) j = l ≫ nat_trans.app (cone.π t) j := sorry

theorem is_limit.hom_ext {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} {t : pullback_cone f g} (ht : is_limit t) {W : C} {k : W ⟶ cone.X t} {l : W ⟶ cone.X t} (h₀ : k ≫ fst t = l ≫ fst t) (h₁ : k ≫ snd t = l ≫ snd t) : k = l :=
  is_limit.hom_ext ht (equalizer_ext t h₀ h₁)

/-- If `t` is a limit pullback cone over `f` and `g` and `h : W ⟶ X` and `k : W ⟶ Y` are such that
    `h ≫ f = k ≫ g`, then we have `l : W ⟶ t.X` satisfying `l ≫ fst t = h` and `l ≫ snd t = k`.
    -/
def is_limit.lift' {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} {t : pullback_cone f g} (ht : is_limit t) {W : C} (h : W ⟶ X) (k : W ⟶ Y) (w : h ≫ f = k ≫ g) : Subtype fun (l : W ⟶ cone.X t) => l ≫ fst t = h ∧ l ≫ snd t = k :=
  { val := is_limit.lift ht (mk h k w), property := sorry }

/--
This is a more convenient formulation to show that a `pullback_cone` constructed using
`pullback_cone.mk` is a limit cone.
-/
def is_limit.mk {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} {W : C} {fst : W ⟶ X} {snd : W ⟶ Y} (eq : fst ≫ f = snd ≫ g) (lift : (s : pullback_cone f g) → cone.X s ⟶ W) (fac_left : ∀ (s : pullback_cone f g), lift s ≫ fst = fst s) (fac_right : ∀ (s : pullback_cone f g), lift s ≫ snd = snd s) (uniq : ∀ (s : pullback_cone f g) (m : cone.X s ⟶ W), m ≫ fst = fst s → m ≫ snd = snd s → m = lift s) : is_limit (mk fst snd eq) :=
  is_limit_aux (mk fst snd eq) lift fac_left fac_right sorry

/-- The flip of a pullback square is a pullback square. -/
def flip_is_limit {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} {W : C} {h : W ⟶ X} {k : W ⟶ Y} {comm : h ≫ f = k ≫ g} (t : is_limit (mk k h flip_is_limit._proof_1)) : is_limit (mk h k comm) :=
  is_limit_aux' (mk h k comm)
    fun (s : pullback_cone f g) => { val := subtype.val (is_limit.lift' t (snd s) (fst s) sorry), property := sorry }

/--
The pullback cone `(𝟙 X, 𝟙 X)` for the pair `(f, f)` is a limit if `f` is a mono. The converse is
shown in `mono_of_pullback_is_id`.
-/
def is_limit_mk_id_id {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) [mono f] : is_limit (mk 𝟙 𝟙 (is_limit_mk_id_id._proof_1 f)) :=
  is_limit.mk sorry (fun (s : pullback_cone f f) => fst s) sorry sorry sorry

/--
`f` is a mono if the pullback cone `(𝟙 X, 𝟙 X)` is a limit for the pair `(f, f)`. The converse is
given in `pullback_cone.is_id_of_mono`.
-/
theorem mono_of_is_limit_mk_id_id {C : Type u} [category C] {X : C} {Y : C} (f : X ⟶ Y) (t : is_limit (mk 𝟙 𝟙 rfl)) : mono f := sorry

end pullback_cone

/-- A pushout cocone is just a cocone on the span formed by two morphisms `f : X ⟶ Y` and
    `g : X ⟶ Z`.-/
def pushout_cocone {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : X ⟶ Z) :=
  cocone (span f g)

namespace pushout_cocone

/-- The first inclusion of a pushout cocone. -/
def inl {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (t : pushout_cocone f g) : Y ⟶ cocone.X t :=
  nat_trans.app (cocone.ι t) walking_span.left

/-- The second inclusion of a pushout cocone. -/
def inr {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (t : pushout_cocone f g) : Z ⟶ cocone.X t :=
  nat_trans.app (cocone.ι t) walking_span.right

/-- This is a slightly more convenient method to verify that a pushout cocone is a colimit cocone.
    It only asks for a proof of facts that carry any mathematical content -/
def is_colimit_aux {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (t : pushout_cocone f g) (desc : (s : pushout_cocone f g) → cocone.X t ⟶ cocone.X s) (fac_left : ∀ (s : pushout_cocone f g), inl t ≫ desc s = inl s) (fac_right : ∀ (s : pushout_cocone f g), inr t ≫ desc s = inr s) (uniq : ∀ (s : pushout_cocone f g) (m : cocone.X t ⟶ cocone.X s),
  (∀ (j : walking_span), nat_trans.app (cocone.ι t) j ≫ m = nat_trans.app (cocone.ι s) j) → m = desc s) : is_colimit t :=
  is_colimit.mk desc

/-- This is another convenient method to verify that a pushout cocone is a colimit cocone. It
    only asks for a proof of facts that carry any mathematical content, and allows access to the
    same `s` for all parts. -/
def is_colimit_aux' {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (t : pushout_cocone f g) (create : (s : pushout_cocone f g) →
  Subtype
    fun (l : cocone.X t ⟶ cocone.X s) =>
      inl t ≫ l = inl s ∧
        inr t ≫ l = inr s ∧ ∀ {m : cocone.X t ⟶ cocone.X s}, inl t ≫ m = inl s → inr t ≫ m = inr s → m = l) : is_colimit t :=
  is_colimit_aux t (fun (s : pushout_cocone f g) => subtype.val (create s)) sorry sorry sorry

/-- A pushout cocone on `f` and `g` is determined by morphisms `inl : Y ⟶ W` and `inr : Z ⟶ W` such
    that `f ≫ inl = g ↠ inr`. -/
def mk {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} {W : C} (inl : Y ⟶ W) (inr : Z ⟶ W) (eq : f ≫ inl = g ≫ inr) : pushout_cocone f g :=
  cocone.mk W
    (nat_trans.mk
      fun (j : walking_span) => option.cases_on j (f ≫ inl) fun (j' : walking_pair) => walking_pair.cases_on j' inl inr)

@[simp] theorem mk_ι_app_left {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} {W : C} (inl : Y ⟶ W) (inr : Z ⟶ W) (eq : f ≫ inl = g ≫ inr) : nat_trans.app (cocone.ι (mk inl inr eq)) walking_span.left = inl :=
  rfl

@[simp] theorem mk_ι_app_right {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} {W : C} (inl : Y ⟶ W) (inr : Z ⟶ W) (eq : f ≫ inl = g ≫ inr) : nat_trans.app (cocone.ι (mk inl inr eq)) walking_span.right = inr :=
  rfl

@[simp] theorem mk_ι_app_zero {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} {W : C} (inl : Y ⟶ W) (inr : Z ⟶ W) (eq : f ≫ inl = g ≫ inr) : nat_trans.app (cocone.ι (mk inl inr eq)) walking_span.zero = f ≫ inl :=
  rfl

@[simp] theorem mk_inl {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} {W : C} (inl : Y ⟶ W) (inr : Z ⟶ W) (eq : f ≫ inl = g ≫ inr) : inl (mk inl inr eq) = inl :=
  rfl

@[simp] theorem mk_inr {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} {W : C} (inl : Y ⟶ W) (inr : Z ⟶ W) (eq : f ≫ inl = g ≫ inr) : inr (mk inl inr eq) = inr :=
  rfl

theorem condition_assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (t : pushout_cocone f g) {X' : C} (f' : cocone.X t ⟶ X') : f ≫ inl t ≫ f' = g ≫ inr t ≫ f' := sorry

/-- To check whether a morphism is coequalized by the maps of a pushout cocone, it suffices to check
  it for `inl t` and `inr t` -/
theorem coequalizer_ext {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (t : pushout_cocone f g) {W : C} {k : cocone.X t ⟶ W} {l : cocone.X t ⟶ W} (h₀ : inl t ≫ k = inl t ≫ l) (h₁ : inr t ≫ k = inr t ≫ l) (j : walking_span) : nat_trans.app (cocone.ι t) j ≫ k = nat_trans.app (cocone.ι t) j ≫ l := sorry

theorem is_colimit.hom_ext {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} {t : pushout_cocone f g} (ht : is_colimit t) {W : C} {k : cocone.X t ⟶ W} {l : cocone.X t ⟶ W} (h₀ : inl t ≫ k = inl t ≫ l) (h₁ : inr t ≫ k = inr t ≫ l) : k = l :=
  is_colimit.hom_ext ht (coequalizer_ext t h₀ h₁)

/-- If `t` is a colimit pushout cocone over `f` and `g` and `h : Y ⟶ W` and `k : Z ⟶ W` are
    morphisms satisfying `f ≫ h = g ≫ k`, then we have a factorization `l : t.X ⟶ W` such that
    `inl t ≫ l = h` and `inr t ≫ l = k`. -/
def is_colimit.desc' {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} {t : pushout_cocone f g} (ht : is_colimit t) {W : C} (h : Y ⟶ W) (k : Z ⟶ W) (w : f ≫ h = g ≫ k) : Subtype fun (l : cocone.X t ⟶ W) => inl t ≫ l = h ∧ inr t ≫ l = k :=
  { val := is_colimit.desc ht (mk h k w), property := sorry }

/--
This is a more convenient formulation to show that a `pushout_cocone` constructed using
`pushout_cocone.mk` is a colimit cocone.
-/
def is_colimit.mk {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} {W : C} {inl : Y ⟶ W} {inr : Z ⟶ W} (eq : f ≫ inl = g ≫ inr) (desc : (s : pushout_cocone f g) → W ⟶ cocone.X s) (fac_left : ∀ (s : pushout_cocone f g), inl ≫ desc s = inl s) (fac_right : ∀ (s : pushout_cocone f g), inr ≫ desc s = inr s) (uniq : ∀ (s : pushout_cocone f g) (m : W ⟶ cocone.X s), inl ≫ m = inl s → inr ≫ m = inr s → m = desc s) : is_colimit (mk inl inr eq) :=
  is_colimit_aux (mk inl inr eq) desc fac_left fac_right sorry

/-- The flip of a pushout square is a pushout square. -/
def flip_is_colimit {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} {W : C} {h : Y ⟶ W} {k : Z ⟶ W} {comm : f ≫ h = g ≫ k} (t : is_colimit (mk k h flip_is_colimit._proof_1)) : is_colimit (mk h k comm) :=
  is_colimit_aux' (mk h k comm)
    fun (s : pushout_cocone f g) => { val := subtype.val (is_colimit.desc' t (inr s) (inl s) sorry), property := sorry }

end pushout_cocone

/-- This is a helper construction that can be useful when verifying that a category has all
    pullbacks. Given `F : walking_cospan ⥤ C`, which is really the same as
    `cospan (F.map inl) (F.map inr)`, and a pullback cone on `F.map inl` and `F.map inr`, we
    get a cone on `F`.

    If you're thinking about using this, have a look at `has_pullbacks_of_has_limit_cospan`,
    which you may find to be an easier way of achieving your goal. -/
@[simp] theorem cone.of_pullback_cone_π {C : Type u} [category C] {F : walking_cospan ⥤ C} (t : pullback_cone (functor.map F walking_cospan.hom.inl) (functor.map F walking_cospan.hom.inr)) : cone.π (cone.of_pullback_cone t) = cone.π t ≫ iso.inv (diagram_iso_cospan F) :=
  Eq.refl (cone.π (cone.of_pullback_cone t))

/-- This is a helper construction that can be useful when verifying that a category has all
    pushout. Given `F : walking_span ⥤ C`, which is really the same as
    `span (F.map fst) (F.mal snd)`, and a pushout cocone on `F.map fst` and `F.map snd`,
    we get a cocone on `F`.

    If you're thinking about using this, have a look at `has_pushouts_of_has_colimit_span`, which
    you may find to be an easiery way of achieving your goal.  -/
@[simp] theorem cocone.of_pushout_cocone_X {C : Type u} [category C] {F : walking_span ⥤ C} (t : pushout_cocone (functor.map F walking_span.hom.fst) (functor.map F walking_span.hom.snd)) : cocone.X (cocone.of_pushout_cocone t) = cocone.X t :=
  Eq.refl (cocone.X (cocone.of_pushout_cocone t))

/-- Given `F : walking_cospan ⥤ C`, which is really the same as `cospan (F.map inl) (F.map inr)`,
    and a cone on `F`, we get a pullback cone on `F.map inl` and `F.map inr`. -/
@[simp] theorem pullback_cone.of_cone_X {C : Type u} [category C] {F : walking_cospan ⥤ C} (t : cone F) : cone.X (pullback_cone.of_cone t) = cone.X t :=
  Eq.refl (cone.X (pullback_cone.of_cone t))

/-- Given `F : walking_span ⥤ C`, which is really the same as `span (F.map fst) (F.map snd)`,
    and a cocone on `F`, we get a pushout cocone on `F.map fst` and `F.map snd`. -/
def pushout_cocone.of_cocone {C : Type u} [category C] {F : walking_span ⥤ C} (t : cocone F) : pushout_cocone (functor.map F walking_span.hom.fst) (functor.map F walking_span.hom.snd) :=
  cocone.mk (cocone.X t) (iso.inv (diagram_iso_span F) ≫ cocone.ι t)

/--
`has_pullback f g` represents a particular choice of limiting cone
for the pair of morphisms `f : X ⟶ Z` and `g : Y ⟶ Z`.
-/
/--
def has_pullback {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) :=
  has_limit (cospan f g)

`has_pushout f g` represents a particular choice of colimiting cocone
for the pair of morphisms `f : X ⟶ Y` and `g : X ⟶ Z`.
-/
def has_pushout {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : X ⟶ Z) :=
  has_colimit (span f g)

/-- `pullback f g` computes the pullback of a pair of morphisms with the same target. -/
def pullback {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) [has_pullback f g] : C :=
  limit (cospan f g)

/-- `pushout f g` computes the pushout of a pair of morphisms with the same source. -/
def pushout {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : X ⟶ Z) [has_pushout f g] : C :=
  colimit (span f g)

/-- The first projection of the pullback of `f` and `g`. -/
def pullback.fst {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} [has_pullback f g] : pullback f g ⟶ X :=
  limit.π (cospan f g) walking_cospan.left

/-- The second projection of the pullback of `f` and `g`. -/
def pullback.snd {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} [has_pullback f g] : pullback f g ⟶ Y :=
  limit.π (cospan f g) walking_cospan.right

/-- The first inclusion into the pushout of `f` and `g`. -/
def pushout.inl {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} [has_pushout f g] : Y ⟶ pushout f g :=
  colimit.ι (span f g) walking_span.left

/-- The second inclusion into the pushout of `f` and `g`. -/
def pushout.inr {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} [has_pushout f g] : Z ⟶ pushout f g :=
  colimit.ι (span f g) walking_span.right

/-- A pair of morphisms `h : W ⟶ X` and `k : W ⟶ Y` satisfying `h ≫ f = k ≫ g` induces a morphism
    `pullback.lift : W ⟶ pullback f g`. -/
def pullback.lift {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} [has_pullback f g] (h : W ⟶ X) (k : W ⟶ Y) (w : h ≫ f = k ≫ g) : W ⟶ pullback f g :=
  limit.lift (cospan f g) (pullback_cone.mk h k w)

/-- A pair of morphisms `h : Y ⟶ W` and `k : Z ⟶ W` satisfying `f ≫ h = g ≫ k` induces a morphism
    `pushout.desc : pushout f g ⟶ W`. -/
def pushout.desc {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} [has_pushout f g] (h : Y ⟶ W) (k : Z ⟶ W) (w : f ≫ h = g ≫ k) : pushout f g ⟶ W :=
  colimit.desc (span f g) (pushout_cocone.mk h k w)

@[simp] theorem pullback.lift_fst_assoc {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} [has_pullback f g] (h : W ⟶ X) (k : W ⟶ Y) (w : h ≫ f = k ≫ g) {X' : C} (f' : X ⟶ X') : pullback.lift h k w ≫ pullback.fst ≫ f' = h ≫ f' := sorry

@[simp] theorem pullback.lift_snd_assoc {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} [has_pullback f g] (h : W ⟶ X) (k : W ⟶ Y) (w : h ≫ f = k ≫ g) {X' : C} (f' : Y ⟶ X') : pullback.lift h k w ≫ pullback.snd ≫ f' = k ≫ f' := sorry

@[simp] theorem pushout.inl_desc_assoc {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} [has_pushout f g] (h : Y ⟶ W) (k : Z ⟶ W) (w : f ≫ h = g ≫ k) {X' : C} (f' : W ⟶ X') : pushout.inl ≫ pushout.desc h k w ≫ f' = h ≫ f' := sorry

@[simp] theorem pushout.inr_desc_assoc {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} [has_pushout f g] (h : Y ⟶ W) (k : Z ⟶ W) (w : f ≫ h = g ≫ k) {X' : C} (f' : W ⟶ X') : pushout.inr ≫ pushout.desc h k w ≫ f' = k ≫ f' := sorry

/-- A pair of morphisms `h : W ⟶ X` and `k : W ⟶ Y` satisfying `h ≫ f = k ≫ g` induces a morphism
    `l : W ⟶ pullback f g` such that `l ≫ pullback.fst = h` and `l ≫ pullback.snd = k`. -/
def pullback.lift' {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} [has_pullback f g] (h : W ⟶ X) (k : W ⟶ Y) (w : h ≫ f = k ≫ g) : Subtype fun (l : W ⟶ pullback f g) => l ≫ pullback.fst = h ∧ l ≫ pullback.snd = k :=
  { val := pullback.lift h k w, property := sorry }

/-- A pair of morphisms `h : Y ⟶ W` and `k : Z ⟶ W` satisfying `f ≫ h = g ≫ k` induces a morphism
    `l : pushout f g ⟶ W` such that `pushout.inl ≫ l = h` and `pushout.inr ≫ l = k`. -/
def pullback.desc' {C : Type u} [category C] {W : C} {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} [has_pushout f g] (h : Y ⟶ W) (k : Z ⟶ W) (w : f ≫ h = g ≫ k) : Subtype fun (l : pushout f g ⟶ W) => pushout.inl ≫ l = h ∧ pushout.inr ≫ l = k :=
  { val := pushout.desc h k w, property := sorry }

theorem pullback.condition {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} [has_pullback f g] : pullback.fst ≫ f = pullback.snd ≫ g :=
  pullback_cone.condition (limit.cone (cospan f g))

theorem pushout.condition_assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} [has_pushout f g] {X' : C} (f' : pushout f g ⟶ X') : f ≫ pushout.inl ≫ f' = g ≫ pushout.inr ≫ f' := sorry

/-- Two morphisms into a pullback are equal if their compositions with the pullback morphisms are
    equal -/
theorem pullback.hom_ext {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} [has_pullback f g] {W : C} {k : W ⟶ pullback f g} {l : W ⟶ pullback f g} (h₀ : k ≫ pullback.fst = l ≫ pullback.fst) (h₁ : k ≫ pullback.snd = l ≫ pullback.snd) : k = l :=
  limit.hom_ext (pullback_cone.equalizer_ext (limit.cone (cospan f g)) h₀ h₁)

/-- The pullback cone built from the pullback projections is a pullback. -/
def pullback_is_pullback {C : Type u} [category C] {X : C} {Y : C} {Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) [has_pullback f g] : is_limit (pullback_cone.mk pullback.fst pullback.snd pullback.condition) :=
  pullback_cone.is_limit.mk pullback.condition
    (fun (s : pullback_cone f g) => pullback.lift (pullback_cone.fst s) (pullback_cone.snd s) (pullback_cone.condition s))
    sorry sorry sorry

/-- The pullback of a monomorphism is a monomorphism -/
protected instance pullback.fst_of_mono {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} [has_pullback f g] [mono g] : mono pullback.fst := sorry

/-- The pullback of a monomorphism is a monomorphism -/
protected instance pullback.snd_of_mono {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} [has_pullback f g] [mono f] : mono pullback.snd := sorry

/-- Two morphisms out of a pushout are equal if their compositions with the pushout morphisms are
    equal -/
theorem pushout.hom_ext {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} [has_pushout f g] {W : C} {k : pushout f g ⟶ W} {l : pushout f g ⟶ W} (h₀ : pushout.inl ≫ k = pushout.inl ≫ l) (h₁ : pushout.inr ≫ k = pushout.inr ≫ l) : k = l :=
  colimit.hom_ext (pushout_cocone.coequalizer_ext (colimit.cocone (span f g)) h₀ h₁)

/-- The pushout of an epimorphism is an epimorphism -/
protected instance pushout.inl_of_epi {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} [has_pushout f g] [epi g] : epi pushout.inl :=
  epi.mk
    fun (W : C) (u v : pushout f g ⟶ W) (h : pushout.inl ≫ u = pushout.inl ≫ v) =>
      pushout.hom_ext h
        (iff.mp (cancel_epi g)
          (eq.mpr
            (id
              (Eq.trans
                ((fun (a a_1 : X ⟶ W) (e_1 : a = a_1) (ᾰ ᾰ_1 : X ⟶ W) (e_2 : ᾰ = ᾰ_1) => congr (congr_arg Eq e_1) e_2)
                  (g ≫ pushout.inr ≫ u) (f ≫ pushout.inl ≫ v)
                  (Eq.trans (Eq.symm (pushout.condition_assoc u))
                    ((fun (ᾰ ᾰ_1 : X ⟶ Y) (e_1 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : Y ⟶ W) (e_2 : ᾰ_2 = ᾰ_3) =>
                        congr (congr_arg category_struct.comp e_1) e_2)
                      f f (Eq.refl f) (pushout.inl ≫ u) (pushout.inl ≫ v) h))
                  (g ≫ pushout.inr ≫ v) (f ≫ pushout.inl ≫ v) (Eq.symm (pushout.condition_assoc v)))
                (propext (eq_self_iff_true (f ≫ pushout.inl ≫ v)))))
            trivial))

/-- The pushout of an epimorphism is an epimorphism -/
protected instance pushout.inr_of_epi {C : Type u} [category C] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : X ⟶ Z} [has_pushout f g] [epi f] : epi pushout.inr :=
  epi.mk
    fun (W : C) (u v : pushout f g ⟶ W) (h : pushout.inr ≫ u = pushout.inr ≫ v) =>
      pushout.hom_ext
        (iff.mp (cancel_epi f)
          (eq.mpr
            (id
              (Eq.trans
                ((fun (a a_1 : X ⟶ W) (e_1 : a = a_1) (ᾰ ᾰ_1 : X ⟶ W) (e_2 : ᾰ = ᾰ_1) => congr (congr_arg Eq e_1) e_2)
                  (f ≫ pushout.inl ≫ u) (g ≫ pushout.inr ≫ v)
                  (Eq.trans (pushout.condition_assoc u)
                    ((fun (ᾰ ᾰ_1 : X ⟶ Z) (e_1 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : Z ⟶ W) (e_2 : ᾰ_2 = ᾰ_3) =>
                        congr (congr_arg category_struct.comp e_1) e_2)
                      g g (Eq.refl g) (pushout.inr ≫ u) (pushout.inr ≫ v) h))
                  (f ≫ pushout.inl ≫ v) (g ≫ pushout.inr ≫ v) (pushout.condition_assoc v))
                (propext (eq_self_iff_true (g ≫ pushout.inr ≫ v)))))
            trivial))
        h

/--
The comparison morphism for the pullback of `f,g`.
This is an isomorphism iff `G` preserves the pullback of `f,g`; see
`category_theory/limits/preserves/shapes/pullbacks.lean`
-/
def pullback_comparison {C : Type u} [category C] {X : C} {Y : C} {Z : C} {D : Type u₂} [category D] (G : C ⥤ D) (f : X ⟶ Z) (g : Y ⟶ Z) [has_pullback f g] [has_pullback (functor.map G f) (functor.map G g)] : functor.obj G (pullback f g) ⟶ pullback (functor.map G f) (functor.map G g) :=
  pullback.lift (functor.map G pullback.fst) (functor.map G pullback.snd) sorry

@[simp] theorem pullback_comparison_comp_fst_assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C} {D : Type u₂} [category D] (G : C ⥤ D) (f : X ⟶ Z) (g : Y ⟶ Z) [has_pullback f g] [has_pullback (functor.map G f) (functor.map G g)] {X' : D} (f' : functor.obj G X ⟶ X') : pullback_comparison G f g ≫ pullback.fst ≫ f' = functor.map G pullback.fst ≫ f' := sorry

@[simp] theorem pullback_comparison_comp_snd_assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C} {D : Type u₂} [category D] (G : C ⥤ D) (f : X ⟶ Z) (g : Y ⟶ Z) [has_pullback f g] [has_pullback (functor.map G f) (functor.map G g)] {X' : D} (f' : functor.obj G Y ⟶ X') : pullback_comparison G f g ≫ pullback.snd ≫ f' = functor.map G pullback.snd ≫ f' := sorry

@[simp] theorem map_lift_pullback_comparison_assoc {C : Type u} [category C] {X : C} {Y : C} {Z : C} {D : Type u₂} [category D] (G : C ⥤ D) (f : X ⟶ Z) (g : Y ⟶ Z) [has_pullback f g] [has_pullback (functor.map G f) (functor.map G g)] {W : C} {h : W ⟶ X} {k : W ⟶ Y} (w : h ≫ f = k ≫ g) {X' : D} (f' : pullback (functor.map G f) (functor.map G g) ⟶ X') : functor.map G (pullback.lift h k w) ≫ pullback_comparison G f g ≫ f' =
  pullback.lift (functor.map G h) (functor.map G k)
      (eq.mpr
        (id
          ((fun (a a_1 : functor.obj G W ⟶ functor.obj G Z) (e_1 : a = a_1) (ᾰ ᾰ_1 : functor.obj G W ⟶ functor.obj G Z)
              (e_2 : ᾰ = ᾰ_1) => congr (congr_arg Eq e_1) e_2)
            (functor.map G h ≫ functor.map G f) (functor.map G (k ≫ g))
            (Eq.trans (Eq.symm (functor.map_comp G h f))
              ((fun (c : C ⥤ D) {X Y : C} (ᾰ ᾰ_1 : X ⟶ Y) (e_4 : ᾰ = ᾰ_1) => congr_arg (functor.map c) e_4) G (h ≫ f)
                (k ≫ g) w))
            (functor.map G k ≫ functor.map G g) (functor.map G (k ≫ g)) (Eq.symm (functor.map_comp G k g))))
        (Eq.refl (functor.map G (k ≫ g)))) ≫
    f' := sorry

/--
`has_pullbacks` represents a choice of pullback for every pair of morphisms

See https://stacks.math.columbia.edu/tag/001W.
-/
def has_pullbacks (C : Type u) [category C] :=
  has_limits_of_shape walking_cospan C

/-- `has_pushouts` represents a choice of pushout for every pair of morphisms -/
def has_pushouts (C : Type u) [category C] :=
  has_colimits_of_shape walking_span C

/-- If `C` has all limits of diagrams `cospan f g`, then it has all pullbacks -/
theorem has_pullbacks_of_has_limit_cospan (C : Type u) [category C] [∀ {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z}, has_limit (cospan f g)] : has_pullbacks C :=
  has_limits_of_shape.mk fun (F : walking_cospan ⥤ C) => has_limit_of_iso (iso.symm (diagram_iso_cospan F))

/-- If `C` has all colimits of diagrams `span f g`, then it has all pushouts -/
theorem has_pushouts_of_has_colimit_span (C : Type u) [category C] [∀ {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z}, has_colimit (span f g)] : has_pushouts C :=
  has_colimits_of_shape.mk fun (F : walking_span ⥤ C) => has_colimit_of_iso (diagram_iso_span F)


/-
Copyright (c) 2015 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Robert Y. Lewis
The real numbers, constructed as equivalence classes of Cauchy sequences of rationals.
This construction follows Bishop and Bridges (1985).

At this point, we no longer proceed constructively: this file makes heavy use of decidability
and excluded middle.
-/
import data.real.basic data.real.order data.rat data.nat
open rat
open nat
open eq.ops pnat classical

namespace rat_seq
local postfix ⁻¹ := pnat.inv

-----------------------------
-- Facts about absolute values of sequences, to define inverse

definition s_abs (s : seq) : seq := λ n, abs (s n)

theorem abs_reg_of_reg {s : seq} (Hs : regular s) : regular (s_abs s) :=
  begin
    intros,
    apply le.trans,
    apply abs_abs_sub_abs_le_abs_sub,
    apply Hs
  end

theorem abs_pos_of_nonzero {s : seq} (Hs : regular s) (Hnz : sep s zero) :
        ∃ N : ℕ+, ∀ m : ℕ+, m ≥ N → abs (s m) ≥ N⁻¹ :=
  begin
    rewrite [↑sep at Hnz, ↑s_lt at Hnz],
    apply or.elim Hnz,
    intro Hnz1,
    have H' : pos (sneg s), begin
      apply pos_of_pos_equiv,
      rotate 2,
      apply Hnz1,
      rotate 1,
      apply s_zero_add,
      repeat (assumption | apply reg_add_reg | apply reg_neg_reg | apply zero_is_reg)
    end,
    cases bdd_away_of_pos (reg_neg_reg Hs) H' with [N, HN],
    existsi N,
    intro m Hm,
    apply le.trans,
    apply HN m Hm,
    rewrite ↑sneg,
    apply neg_le_abs_self,
    intro Hnz2,
    let H' := pos_of_pos_equiv (reg_add_reg Hs (reg_neg_reg zero_is_reg)) (s_add_zero s Hs) Hnz2,
    let H'' := bdd_away_of_pos Hs H',
    cases H'' with [N, HN],
    existsi N,
    intro m Hm,
    apply le.trans,
    apply HN m Hm,
    apply le_abs_self
  end

theorem abs_well_defined {s t : seq} (Hs : regular s) (Ht : regular t) (Heq : s ≡ t) :
        s_abs s ≡ s_abs t :=
  begin
    rewrite [↑equiv at *],
    intro n,
    rewrite ↑s_abs,
    apply le.trans,
    apply abs_abs_sub_abs_le_abs_sub,
    apply Heq
  end

theorem sep_zero_of_pos {s : seq} (Hs : regular s) (Hpos : pos s) : sep s zero :=
  begin
    apply or.inr,
    apply pos_of_pos_equiv,
    rotate 2,
    apply Hpos,
    apply Hs,
    apply equiv.symm,
    apply s_sub_zero Hs
  end

------------------------
-- This section could be cleaned up.

private noncomputable definition pb {s : seq} (Hs : regular s) (Hpos : pos s) :=
  some (abs_pos_of_nonzero Hs (sep_zero_of_pos Hs Hpos))
private noncomputable definition ps {s : seq} (Hs : regular s) (Hsep : sep s zero) :=
  some (abs_pos_of_nonzero Hs Hsep)

private theorem pb_spec {s : seq} (Hs : regular s) (Hpos : pos s) :
        ∀ m : ℕ+, m ≥ (pb Hs Hpos) → abs (s m) ≥ (pb Hs Hpos)⁻¹ :=
  some_spec (abs_pos_of_nonzero Hs (sep_zero_of_pos Hs Hpos))

private theorem ps_spec {s : seq} (Hs : regular s) (Hsep : sep s zero) :
        ∀ m : ℕ+, m ≥ (ps Hs Hsep) → abs (s m) ≥ (ps Hs Hsep)⁻¹ :=
  some_spec (abs_pos_of_nonzero Hs Hsep)

noncomputable definition s_inv {s : seq} (Hs : regular s) (n : ℕ+) : ℚ :=
  if H : sep s zero then
      (if n < (ps Hs H) then 1 / (s ((ps Hs H) * (ps Hs H) * (ps Hs H)))
        else 1 / (s ((ps Hs H) * (ps Hs H) * n)))
  else 0

private theorem peq {s : seq} (Hsep : sep s zero) (Hpos : pos s)  (Hs : regular s) :
        pb Hs Hpos = ps Hs Hsep := rfl

private theorem s_inv_of_sep_lt_p {s : seq} (Hs : regular s) (Hsep : sep s zero) {n : ℕ+}
        (Hn : n < (ps Hs Hsep)) : s_inv Hs n = 1 / s ((ps Hs Hsep) * (ps Hs Hsep) * (ps Hs Hsep)) :=
  begin
    apply eq.trans,
    apply dif_pos Hsep,
    apply dif_pos Hn
  end

private theorem s_inv_of_sep_gt_p {s : seq} (Hs : regular s) (Hsep : sep s zero) {n : ℕ+}
        (Hn : n ≥ (ps Hs Hsep)) : s_inv Hs n = 1 / s ((ps Hs Hsep) * (ps Hs Hsep) * n) :=
  begin
    apply eq.trans,
    apply dif_pos Hsep,
    apply dif_neg (not_lt_of_ge Hn)
  end

private theorem s_inv_of_pos_lt_p {s : seq} (Hs : regular s) (Hpos : pos s) {n : ℕ+}
        (Hn : n < (pb Hs Hpos)) : s_inv Hs n = 1 / s ((pb Hs Hpos) * (pb Hs Hpos) * (pb Hs Hpos)) :=
  s_inv_of_sep_lt_p Hs (sep_zero_of_pos Hs Hpos) Hn

private theorem s_inv_of_pos_gt_p {s : seq} (Hs : regular s) (Hpos : pos s) {n : ℕ+}
        (Hn : n ≥ (pb Hs Hpos)) : s_inv Hs n = 1 / s ((pb Hs Hpos) * (pb Hs Hpos) * n) :=
  s_inv_of_sep_gt_p Hs (sep_zero_of_pos Hs Hpos) Hn

private theorem le_ps {s : seq} (Hs : regular s) (Hsep : sep s zero) (n : ℕ+) :
        abs (s_inv Hs n) ≤ (rat_of_pnat (ps Hs Hsep)) :=
  if Hn : n < ps Hs Hsep then
    (begin
      rewrite [(s_inv_of_sep_lt_p Hs Hsep Hn), abs_one_div],
      apply div_le_pnat,
      apply ps_spec,
      apply pnat.mul_le_mul_left
    end)
  else
    (begin
      rewrite [(s_inv_of_sep_gt_p Hs Hsep (le_of_not_gt Hn)), abs_one_div],
      apply div_le_pnat,
      apply ps_spec,
      rewrite pnat.mul_assoc,
      apply pnat.mul_le_mul_right
    end)

theorem s_inv_zero : s_inv zero_is_reg = zero :=
  funext (λ n, dif_neg (!not_sep_self))

private theorem s_inv_of_zero' {s : seq} (Hs : regular s) (Hz : ¬ sep s zero) (n : ℕ+) : s_inv Hs n = 0 :=
  dif_neg Hz

theorem s_inv_of_zero {s : seq} (Hs : regular s) (Hz : ¬ sep s zero) : s_inv Hs = zero :=
  begin
    apply funext,
    intro n,
    apply s_inv_of_zero' Hs Hz n
  end

private theorem s_ne_zero_of_ge_p {s : seq} (Hs : regular s) (Hsep : sep s zero) {n : ℕ+}
        (Hn : n ≥ (ps Hs Hsep)) : s n ≠ 0 :=
  begin
    let Hps := ps_spec Hs Hsep,
    apply ne_zero_of_abs_ne_zero,
    apply ne_of_gt,
    apply gt_of_ge_of_gt,
    apply Hps,
    apply Hn,
    apply pnat.inv_pos
  end

theorem reg_inv_reg {s : seq} (Hs : regular s) (Hsep : sep s zero) : regular (s_inv Hs) :=
  begin
    rewrite ↑regular,
    intros,
    have Hsp : s ((ps Hs Hsep) * (ps Hs Hsep) * (ps Hs Hsep)) ≠ 0, from
      s_ne_zero_of_ge_p Hs Hsep !pnat.mul_le_mul_left,
    have Hspn : s ((ps Hs Hsep) * (ps Hs Hsep) * n) ≠ 0, from
      s_ne_zero_of_ge_p Hs Hsep (show (ps Hs Hsep) * (ps Hs Hsep) * n ≥ ps Hs Hsep, by
        rewrite pnat.mul_assoc; apply pnat.mul_le_mul_right),
    have Hspm : s ((ps Hs Hsep) * (ps Hs Hsep) * m) ≠ 0, from
      s_ne_zero_of_ge_p Hs Hsep (show (ps Hs Hsep) * (ps Hs Hsep) * m ≥ ps Hs Hsep, by
        rewrite pnat.mul_assoc; apply pnat.mul_le_mul_right),
    cases em (m < ps Hs Hsep) with [Hmlt, Hmlt],
      cases em (n < ps Hs Hsep) with [Hnlt, Hnlt],
        rewrite [(s_inv_of_sep_lt_p Hs Hsep Hmlt), (s_inv_of_sep_lt_p Hs Hsep Hnlt)],
        rewrite [sub_self, abs_zero],
        apply add_invs_nonneg,
       rewrite [(s_inv_of_sep_lt_p Hs Hsep Hmlt),
                (s_inv_of_sep_gt_p Hs Hsep (le_of_not_gt Hnlt))],
       rewrite [(!div_sub_div Hsp Hspn), div_eq_mul_one_div, *abs_mul, *mul_one, *one_mul],
       apply le.trans,
       apply mul_le_mul,
       apply Hs,
       rewrite [-(mul_one 1), -(!field.div_mul_div Hsp Hspn), abs_mul],
       apply mul_le_mul,
       rewrite -(s_inv_of_sep_lt_p Hs Hsep Hmlt),
       apply le_ps Hs Hsep,
       rewrite  -(s_inv_of_sep_gt_p Hs Hsep (le_of_not_gt Hnlt)),
       apply le_ps Hs Hsep,
       apply abs_nonneg,
       apply le_of_lt !rat_of_pnat_is_pos,
       apply abs_nonneg,
       apply add_invs_nonneg,
       rewrite [right_distrib, *pnat_cancel', add.comm],
       apply add_le_add_right,
       apply inv_ge_of_le,
       apply le_of_lt,
       apply Hmlt,
      cases em (n < ps Hs Hsep) with [Hnlt, Hnlt],
        rewrite [(s_inv_of_sep_lt_p Hs Hsep Hnlt),
                 (s_inv_of_sep_gt_p Hs Hsep (le_of_not_gt Hmlt))],
        rewrite [(!div_sub_div Hspm Hsp), div_eq_mul_one_div, *abs_mul, *mul_one, *one_mul],
        apply le.trans,
        apply mul_le_mul,
        apply Hs,
        rewrite [-(mul_one 1), -(!field.div_mul_div Hspm Hsp), abs_mul],
        apply mul_le_mul,
        rewrite -(s_inv_of_sep_gt_p Hs Hsep (le_of_not_gt Hmlt)),
        apply le_ps Hs Hsep,
        rewrite -(s_inv_of_sep_lt_p Hs Hsep Hnlt),
        apply le_ps Hs Hsep,
        apply abs_nonneg,
        apply le_of_lt !rat_of_pnat_is_pos,
        apply abs_nonneg,
        apply add_invs_nonneg,
        rewrite [right_distrib, *pnat_cancel', add.comm],
        apply rat.add_le_add_left,
        apply inv_ge_of_le,
        apply le_of_lt,
        apply Hnlt,
      rewrite [(s_inv_of_sep_gt_p Hs Hsep (le_of_not_gt Hnlt)),
              (s_inv_of_sep_gt_p Hs Hsep (le_of_not_gt Hmlt))],
      rewrite [(!div_sub_div Hspm Hspn), div_eq_mul_one_div, abs_mul, *one_mul, *mul_one],
      apply le.trans,
      apply mul_le_mul,
      apply Hs,
      rewrite [-(mul_one 1), -(!field.div_mul_div Hspm Hspn), abs_mul],
      apply mul_le_mul,
      rewrite -(s_inv_of_sep_gt_p Hs Hsep (le_of_not_gt Hmlt)),
      apply le_ps Hs Hsep,
      rewrite -(s_inv_of_sep_gt_p Hs Hsep (le_of_not_gt Hnlt)),
      apply le_ps Hs Hsep,
      apply abs_nonneg,
      apply le_of_lt !rat_of_pnat_is_pos,
      apply abs_nonneg,
      apply add_invs_nonneg,
      rewrite [right_distrib, *pnat_cancel', add.comm],
      apply le.refl
  end

theorem s_inv_ne_zero {s : seq} (Hs : regular s) (Hsep : sep s zero) (n : ℕ+) : s_inv Hs n ≠ 0 :=
  if H : n ≥ ps Hs Hsep then
    (begin
      rewrite (s_inv_of_sep_gt_p Hs Hsep H),
      apply one_div_ne_zero,
      apply s_ne_zero_of_ge_p,
      apply le.trans,
      apply H,
      apply pnat.mul_le_mul_left
    end)
  else
    (begin
      rewrite (s_inv_of_sep_lt_p Hs Hsep (lt_of_not_ge H)),
      apply one_div_ne_zero,
      apply s_ne_zero_of_ge_p,
      apply pnat.mul_le_mul_left
    end)

protected theorem mul_inv {s : seq} (Hs : regular s) (Hsep : sep s zero) :
          smul s (s_inv Hs) ≡ one :=
  begin
    let Rsi := reg_inv_reg Hs Hsep,
    let Rssi := reg_mul_reg Hs Rsi,
    apply eq_of_bdd Rssi one_is_reg,
    intros,
    existsi max (ps Hs Hsep) j,
    intro n Hn,
    have Hnz : s_inv Hs ((K₂ s (s_inv Hs)) * 2 * n) ≠ 0, from s_inv_ne_zero Hs Hsep _,
    rewrite [↑smul, ↑one, mul.comm, -(mul_one_div_cancel Hnz),
            -mul_sub_left_distrib, abs_mul],
    apply le.trans,
    apply mul_le_mul_of_nonneg_right,
    apply canon_2_bound_right s,
    apply Rsi,
    apply abs_nonneg,
    have Hp : (K₂ s (s_inv Hs)) * 2 * n ≥ ps Hs Hsep, begin
      apply le.trans,
      apply le_max_left,
      rotate 1,
      apply le.trans,
      apply Hn,
      apply pnat.mul_le_mul_left
    end,
    have Hnz' : s (((ps Hs Hsep) * (ps Hs Hsep)) * ((K₂ s (s_inv Hs)) * 2 * n)) ≠ 0, from
      s_ne_zero_of_ge_p Hs Hsep
        (show ps Hs Hsep ≤ ((ps Hs Hsep) * (ps Hs Hsep)) * ((K₂ s (s_inv Hs)) * 2 * n),
          by rewrite *pnat.mul_assoc; apply pnat.mul_le_mul_right),
    rewrite [(s_inv_of_sep_gt_p Hs Hsep Hp), (division_ring.one_div_one_div Hnz')],
    apply rat.le_trans,
    apply mul_le_mul_of_nonneg_left,
    apply Hs,
    apply le_of_lt,
    apply rat_of_pnat_is_pos,
    rewrite [left_distrib, pnat.mul_comm ((ps Hs Hsep) * (ps Hs Hsep)), *pnat.mul_assoc,
            *(@pnat.inv_mul_eq_mul_inv (K₂ s (s_inv Hs))), -*mul.assoc, *pnat.inv_cancel_left,
            *one_mul, -(pnat.add_halves j)],
    apply add_le_add,
    apply inv_ge_of_le,
    apply pnat_mul_le_mul_left',
    apply le.trans,
    rotate 1,
    apply Hn,
    rotate_right 1,
    apply le_max_right,
    apply inv_ge_of_le,
    apply pnat_mul_le_mul_left',
    apply le.trans,
    apply le_max_right,
    rotate 1,
    apply le.trans,
    apply Hn,
    apply pnat.mul_le_mul_right
   end

protected theorem inv_mul {s : seq} (Hs : regular s) (Hsep : sep s zero) :
          smul (s_inv Hs) s ≡ one :=
  begin
    apply equiv.trans,
    rotate 3,
    apply s_mul_comm,
    apply rat_seq.mul_inv,
    repeat (assumption | apply reg_mul_reg | apply reg_inv_reg | apply zero_is_reg)
  end

theorem sep_of_equiv_sep {s t : seq} (Hs : regular s) (Ht : regular t) (Heq : s ≡ t)
        (Hsep : sep s zero) : sep t zero :=
  begin
    apply or.elim Hsep,
    intro Hslt,
    apply or.inl,
    rewrite ↑s_lt at *,
    apply pos_of_pos_equiv,
    rotate 2,
    apply Hslt,
    rotate_right 1,
    apply add_well_defined,
    rotate 4,
    apply equiv.refl,
    apply neg_well_defined,
    apply Heq,
    intro Hslt,
    apply or.inr,
    rewrite ↑s_lt at *,
    apply pos_of_pos_equiv,
    rotate 2,
    apply Hslt,
    rotate_right 1,
    apply add_well_defined,
    rotate 5,
    apply equiv.refl,
    repeat (assumption | apply reg_neg_reg | apply reg_add_reg | apply zero_is_reg)
  end

theorem inv_unique {s t : seq} (Hs : regular s) (Ht : regular t) (Hsep : sep s zero)
        (Heq : smul s t ≡ one) : s_inv Hs ≡ t :=
  begin
    apply equiv.trans,
    rotate 3,
    apply equiv.symm,
    apply s_mul_one,
    rotate 1,
    apply equiv.trans,
    rotate 3,
    apply mul_well_defined,
    rotate 4,
    apply equiv.refl,
    apply equiv.symm,
    apply Heq,
    apply equiv.trans,
    rotate 3,
    apply equiv.symm,
    apply s_mul_assoc,
    rotate 3,
    apply equiv.trans,
    rotate 3,
    apply mul_well_defined,
    rotate 4,
    apply rat_seq.inv_mul,
    rotate 1,
    apply equiv.refl,
    apply s_one_mul,
    repeat (assumption | apply reg_inv_reg | apply reg_mul_reg | apply one_is_reg)
  end

theorem inv_well_defined {s t : seq} (Hs : regular s) (Ht : regular t) (Heq : s ≡ t) :
        s_inv Hs ≡ s_inv Ht :=
  if Hsep : sep s zero then
    (begin
       note Hsept := sep_of_equiv_sep Hs Ht Heq Hsep,
       have Hm : smul t (s_inv Hs) ≡ smul s (s_inv Hs), begin
         apply mul_well_defined,
         repeat (assumption | apply reg_inv_reg),
         apply equiv.symm s t Heq,
         apply equiv.refl
       end,
       apply equiv.symm,
       apply inv_unique,
       rotate 2,
       apply equiv.trans,
       rotate 3,
       apply Hm,
       apply rat_seq.mul_inv,
       repeat (assumption | apply reg_inv_reg | apply reg_mul_reg),
       apply one_is_reg
     end)
  else
    (have H : s_inv Hs = zero, from funext (λ n, dif_neg Hsep),
     have Hsept : ¬ sep t zero, from
       assume H', Hsep (sep_of_equiv_sep Ht Hs (equiv.symm _ _ Heq) H'),
     have H' : s_inv Ht = zero, from funext (λ n, dif_neg Hsept),
     by rewrite [H', H]; apply equiv.refl)

theorem s_neg_neg {s : seq} : sneg (sneg s) ≡ s :=
  begin
    rewrite [↑equiv, ↑sneg],
    intro n,
    rewrite [neg_neg, sub_self, abs_zero],
    apply add_invs_nonneg
  end

theorem s_neg_sub {s t : seq} (Hs : regular s) (Ht : regular t) :
        sneg (sadd s (sneg t)) ≡ sadd t (sneg s) :=
  begin
    apply equiv.trans,
    rotate 3,
    apply s_neg_add_eq_s_add_neg,
    apply equiv.trans,
    rotate 3,
    apply add_well_defined,
    rotate 4,
    apply equiv.refl,
    apply s_neg_neg,
    apply s_add_comm,
    repeat (assumption | apply reg_add_reg | apply reg_neg_reg)
  end

theorem s_le_total {s t : seq} (Hs : regular s) (Ht : regular t) : s_le s t ∨ s_le t s :=
  if H : s_le s t then or.inl H else or.inr begin
      rewrite [↑s_le at *],
      have H' : ∃ n : ℕ+, -n⁻¹ > sadd t (sneg s) n, begin
        apply by_contradiction,
        intro Hex,
        have Hex' : ∀ n : ℕ+, -n⁻¹ ≤ sadd t (sneg s) n, begin
          intro m,
          apply by_contradiction,
          intro Hm,
          note Hm' := lt_of_not_ge Hm,
          note Hex'' := exists.intro m Hm',
          apply Hex Hex''
        end,
        apply H Hex'
      end,
      eapply exists.elim H',
      intro m Hm,
      note Hm' := neg_lt_neg Hm,
      rewrite neg_neg at Hm',
      apply s_nonneg_of_pos,
      rotate 1,
      apply pos_of_pos_equiv,
      rotate 1,
      apply s_neg_sub,
      rotate 2,
      rewrite [↑pos, ↑sneg],
      existsi m,
      apply Hm',
      repeat (assumption | apply reg_add_reg | apply reg_neg_reg)
    end

theorem s_le_of_not_lt {s t : seq} (Hle : ¬ s_lt s t) : s_le t s :=
  begin
    rewrite [↑s_le, ↑nonneg, ↑s_lt at Hle, ↑pos at Hle],
    let Hle' := iff.mp forall_iff_not_exists Hle,
    intro n,
    let Hn := neg_le_neg (le_of_not_gt (Hle' n)),
    rewrite [↑sadd, ↑sneg, add_neg_eq_neg_add_rev],
    apply Hn
  end

theorem sep_of_nequiv {s t : seq} (Hs : regular s) (Ht : regular t) (Hneq : ¬ equiv s t) :
        sep s t :=
  begin
    rewrite ↑sep,
    apply by_contradiction,
    intro Hnor,
    let Hand := iff.mp !not_or_iff_not_and_not Hnor,
    let Hle1 := s_le_of_not_lt (and.left Hand),
    let Hle2 := s_le_of_not_lt (and.right Hand),
    apply Hneq (equiv_of_le_of_ge Hs Ht Hle2 Hle1)
  end

theorem s_zero_inv_equiv_zero : s_inv zero_is_reg ≡ zero :=
  by rewrite s_inv_zero; apply equiv.refl

theorem lt_or_equiv_of_le {s t : seq} (Hs : regular s) (Ht : regular t) (Hle : s_le s t) :
        s_lt s t ∨ s ≡ t :=
  if H : s ≡ t then or.inr H else
    or.inl (lt_of_le_and_sep Hs Ht (and.intro Hle (sep_of_nequiv Hs Ht H)))

theorem s_le_of_equiv_le_left {s t u : seq} (Hs : regular s) (Ht : regular t) (Hu : regular u)
        (Heq : s ≡ t) (Hle : s_le s u) : s_le t u :=
  begin
    rewrite ↑s_le at *,
    apply nonneg_of_nonneg_equiv,
    rotate 2,
    apply add_well_defined,
    rotate 4,
    apply equiv.refl,
    apply neg_well_defined,
    apply Heq,
    repeat (assumption | apply reg_add_reg | apply reg_neg_reg)
  end

theorem s_le_of_equiv_le_right {s t u : seq} (Hs : regular s) (Ht : regular t) (Hu : regular u)
        (Heq : t ≡ u) (Hle : s_le s t) : s_le s u :=
  begin
    rewrite ↑s_le at *,
    apply nonneg_of_nonneg_equiv,
    rotate 2,
    apply add_well_defined,
    rotate 4,
    apply Heq,
    apply equiv.refl,
    repeat (assumption | apply reg_add_reg | apply reg_neg_reg)
  end

-----------------------------

noncomputable definition r_inv (s : reg_seq) : reg_seq := reg_seq.mk (s_inv (reg_seq.is_reg s))
  (if H : sep (reg_seq.sq s) zero then reg_inv_reg (reg_seq.is_reg s) H else
    have Hz : s_inv (reg_seq.is_reg s) = zero, from funext (λ n, dif_neg H),
    by rewrite Hz; apply zero_is_reg)

theorem r_inv_zero : requiv (r_inv r_zero) r_zero :=
  s_zero_inv_equiv_zero

theorem r_inv_well_defined {s t : reg_seq} (H : requiv s t) : requiv (r_inv s) (r_inv t) :=
  inv_well_defined (reg_seq.is_reg s) (reg_seq.is_reg t) H

theorem r_le_total (s t : reg_seq) : r_le s t ∨ r_le t s :=
  s_le_total (reg_seq.is_reg s) (reg_seq.is_reg t)

theorem r_mul_inv (s : reg_seq) (Hsep : r_sep s r_zero) : requiv (s * (r_inv s)) r_one :=
  rat_seq.mul_inv (reg_seq.is_reg s) Hsep

theorem r_sep_of_nequiv (s t : reg_seq) (Hneq : ¬ requiv s t) : r_sep s t :=
  sep_of_nequiv (reg_seq.is_reg s) (reg_seq.is_reg t) Hneq

theorem r_lt_or_equiv_of_le (s t : reg_seq) (Hle : r_le s t) : r_lt s t ∨ requiv s t :=
  lt_or_equiv_of_le (reg_seq.is_reg s) (reg_seq.is_reg t) Hle

theorem r_le_of_equiv_le_left {s t u : reg_seq} (Heq : requiv s t) (Hle : r_le s u) : r_le t u :=
  s_le_of_equiv_le_left (reg_seq.is_reg s) (reg_seq.is_reg t) (reg_seq.is_reg u) Heq Hle

theorem r_le_of_equiv_le_right {s t u : reg_seq} (Heq : requiv t u) (Hle : r_le s t) : r_le s u :=
  s_le_of_equiv_le_right (reg_seq.is_reg s) (reg_seq.is_reg t) (reg_seq.is_reg u) Heq Hle

definition r_abs (s : reg_seq) : reg_seq :=
  reg_seq.mk (s_abs (reg_seq.sq s)) (abs_reg_of_reg (reg_seq.is_reg s))

theorem r_abs_well_defined {s t : reg_seq} (H : requiv s t) : requiv (r_abs s) (r_abs t) :=
  abs_well_defined (reg_seq.is_reg s) (reg_seq.is_reg t) H

end rat_seq

namespace real
open [class] rat_seq

noncomputable protected definition inv (x : ℝ) : ℝ :=
  quot.lift_on x (λ a, quot.mk (rat_seq.r_inv a))
           (λ a b H, quot.sound (rat_seq.r_inv_well_defined H))

noncomputable definition real_has_inv [instance] [priority real.prio] : has_inv real :=
  has_inv.mk real.inv

noncomputable protected definition div (x y : ℝ) : ℝ :=
  x * y⁻¹

noncomputable definition real_has_div : has_div real :=
  has_div.mk real.div

local attribute real_has_div [instance] [priority real.prio]

protected theorem le_total (x y : ℝ) : x ≤ y ∨ y ≤ x :=
  quot.induction_on₂ x y (λ s t, rat_seq.r_le_total s t)

protected theorem mul_inv_cancel' (x : ℝ) : x ≢ 0 → x * x⁻¹ = 1 :=
  quot.induction_on x (λ s H, quot.sound (rat_seq.r_mul_inv s H))

protected theorem inv_mul_cancel' (x : ℝ) : x ≢ 0 → x⁻¹ * x = 1 :=
  by rewrite real.mul_comm; apply real.mul_inv_cancel'

theorem neq_of_sep {x y : ℝ} (H : x ≢ y) : ¬ x = y :=
  assume Heq, !not_sep_self (Heq ▸ H)

theorem sep_of_neq {x y : ℝ} : ¬ x = y → x ≢ y :=
  quot.induction_on₂ x y (λ s t H, rat_seq.r_sep_of_nequiv s t (assume Heq, H (quot.sound Heq)))

theorem sep_is_neq (x y : ℝ) : (x ≢ y) = (¬ x = y) :=
  propext (iff.intro neq_of_sep sep_of_neq)

protected theorem mul_inv_cancel (x : ℝ) : x ≠ 0 → x * x⁻¹ = 1 :=
  !sep_is_neq ▸ !real.mul_inv_cancel'

protected theorem inv_mul_cancel (x : ℝ) : x ≠ 0 → x⁻¹ * x = 1 :=
  !sep_is_neq ▸ !real.inv_mul_cancel'

protected theorem inv_zero : (0 : ℝ)⁻¹ = 0 := quot.sound (rat_seq.r_inv_zero)

protected theorem lt_or_eq_of_le (x y : ℝ) : x ≤ y → x < y ∨ x = y :=
  quot.induction_on₂ x y (λ s t H, or.elim (rat_seq.r_lt_or_equiv_of_le s t H)
    (assume H1, or.inl H1)
    (assume H2, or.inr (quot.sound H2)))

protected theorem le_iff_lt_or_eq (x y : ℝ) : x ≤ y ↔ x < y ∨ x = y :=
  iff.intro (real.lt_or_eq_of_le x y) (real.le_of_lt_or_eq x y)

noncomputable definition dec_lt : decidable_rel real.lt :=
  begin
    rewrite ↑decidable_rel,
    intros,
    apply prop_decidable
  end

protected noncomputable definition discrete_linear_ordered_field [trans_instance]:
  discrete_linear_ordered_field ℝ :=
  ⦃ discrete_linear_ordered_field, real.comm_ring, real.ordered_ring,
    le_total        := real.le_total,
    mul_inv_cancel  := real.mul_inv_cancel,
    inv_mul_cancel  := real.inv_mul_cancel,
    zero_lt_one     := real.zero_lt_one,
    inv_zero        := real.inv_zero,
    le_iff_lt_or_eq := real.le_iff_lt_or_eq,
    decidable_lt    := dec_lt
   ⦄

theorem of_rat_divide (x y : ℚ) : of_rat (x / y) = of_rat x / of_rat y :=
by_cases
  (assume yz : y = 0, by krewrite [yz, div_zero, +of_rat_zero, div_zero])
  (assume ynz : y ≠ 0,
    have ynz' : of_rat y ≠ 0, from assume yz', ynz (of_rat.inj yz'),
    !eq_div_of_mul_eq ynz' (by krewrite [-of_rat_mul, !div_mul_cancel ynz]))

open int

theorem of_int_div (x y : ℤ) (H : y ∣ x) : of_int (x / y) = of_int x / of_int y :=
by rewrite [of_int_eq, rat.of_int_div H, of_rat_divide]

theorem of_nat_div (x y : ℕ) (H : y ∣ x) : of_nat (x / y) = of_nat x / of_nat y :=
by rewrite [of_nat_eq, rat.of_nat_div H, of_rat_divide]

/- useful for proving equalities -/

theorem eq_zero_of_nonneg_of_forall_lt {x : ℝ} (xnonneg : x ≥ 0) (H : ∀ ε : ℝ, ε > 0 → x < ε) :
  x = 0 :=
decidable.by_contradiction
  (suppose x ≠ 0,
   have x > 0, from lt_of_le_of_ne xnonneg (ne.symm this),
   have x < x, from H x this,
   show false, from !lt.irrefl this)

theorem eq_zero_of_nonneg_of_forall_le {x : ℝ} (xnonneg : x ≥ 0) (H : ∀ ε : ℝ, ε > 0 → x ≤ ε) :
  x = 0 :=
have ∀ ε : ℝ, ε > 0 → x < ε, from
  take ε, suppose ε > 0,
  have e2pos : ε / 2 > 0, from div_pos_of_pos_of_pos `ε > 0` two_pos,
  have ε / 2 < ε, from div_two_lt_of_pos `ε > 0`,
  begin apply lt_of_le_of_lt, apply H _ e2pos, apply this end,
eq_zero_of_nonneg_of_forall_lt xnonneg this

theorem eq_zero_of_forall_abs_le {x : ℝ} (H : ∀ ε : ℝ, ε > 0 → abs x ≤ ε) :
  x = 0 :=
by_contradiction
  (suppose x ≠ 0,
   have abs x = 0, from eq_zero_of_nonneg_of_forall_le !abs_nonneg H,
   show false, from `x ≠ 0` (eq_zero_of_abs_eq_zero this))

theorem eq_of_forall_abs_sub_le {x y : ℝ} (H : ∀ ε : ℝ, ε > 0 → abs (x - y) ≤ ε) :
  x = y :=
have x - y = 0, from eq_zero_of_forall_abs_le H,
eq_of_sub_eq_zero this
end real