/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.monoidal.braided
import category_theory.functor.reflects_isomorphisms
import category_theory.monoidal.coherence

/-!
# Half braidings and the Drinfeld center of a monoidal category

We define `center C` to be pairs `⟨X, b⟩`, where `X : C` and `b` is a half-braiding on `X`.

We show that `center C` is braided monoidal,
and provide the monoidal functor `center.forget` from `center C` back to `C`.

## Future work

Verifying the various axioms here is done by tedious rewriting.
Using the `slice` tactic may make the proofs marginally more readable.

More exciting, however, would be to make possible one of the following options:
1. Integration with homotopy.io / globular to give "picture proofs".
2. The monoidal coherence theorem, so we can ignore associators
   (after which most of these proofs are trivial;
   I'm unsure if the monoidal coherence theorem is even usable in dependent type theory).
3. Automating these proofs using `rewrite_search` or some relative.

-/

open category_theory
open category_theory.monoidal_category

universes v v₁ v₂ v₃ u u₁ u₂ u₃
noncomputable theory

namespace category_theory

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

/--
A half-braiding on `X : C` is a family of isomorphisms `X ⊗ U ≅ U ⊗ X`,
monoidally natural in `U : C`.

Thinking of `C` as a 2-category with a single `0`-morphism, these are the same as natural
transformations (in the pseudo- sense) of the identity 2-functor on `C`, which send the unique
`0`-morphism to `X`.
-/
@[nolint has_nonempty_instance]
structure half_braiding (X : C) :=
(β : Π U, X ⊗ U ≅ U ⊗ X)
(monoidal' : ∀ U U', (β (U ⊗ U')).hom =
  (α_ _ _ _).inv ≫ ((β U).hom ⊗ 𝟙 U') ≫ (α_ _ _ _).hom ≫ (𝟙 U ⊗ (β U').hom) ≫ (α_ _ _ _).inv
  . obviously)
(naturality' : ∀ {U U'} (f : U ⟶ U'), (𝟙 X ⊗ f) ≫ (β U').hom = (β U).hom ≫ (f ⊗ 𝟙 X) . obviously)

restate_axiom half_braiding.monoidal'
attribute [reassoc, simp] half_braiding.monoidal -- the reassoc lemma is redundant as a simp lemma
restate_axiom half_braiding.naturality'
attribute [simp, reassoc] half_braiding.naturality

variables (C)
/--
The Drinfeld center of a monoidal category `C` has as objects pairs `⟨X, b⟩`, where `X : C`
and `b` is a half-braiding on `X`.
-/
@[nolint has_nonempty_instance]
def center := Σ X : C, half_braiding X

namespace center

variables {C}

/-- A morphism in the Drinfeld center of `C`. -/
@[ext, nolint has_nonempty_instance]
structure hom (X Y : center C) :=
(f : X.1 ⟶ Y.1)
(comm' : ∀ U, (f ⊗ 𝟙 U) ≫ (Y.2.β U).hom = (X.2.β U).hom ≫ (𝟙 U ⊗ f) . obviously)

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

instance : category (center C) :=
{ hom := hom,
  id := λ X, { f := 𝟙 X.1, },
  comp := λ X Y Z f g, { f := f.f ≫ g.f, }, }

@[simp] lemma id_f (X : center C) : hom.f (𝟙 X) = 𝟙 X.1 := rfl
@[simp] lemma comp_f {X Y Z : center C} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g).f = f.f ≫ g.f := rfl

@[ext]
lemma ext {X Y : center C} (f g : X ⟶ Y) (w : f.f = g.f) : f = g :=
by { cases f, cases g, congr, exact w, }

/--
Construct an isomorphism in the Drinfeld center from
a morphism whose underlying morphism is an isomorphism.
-/
@[simps]
def iso_mk {X Y : center C} (f : X ⟶ Y) [is_iso f.f] : X ≅ Y :=
{ hom := f,
  inv := ⟨inv f.f, λ U, by simp [←cancel_epi (f.f ⊗ 𝟙 U), ←comp_tensor_id_assoc, ←id_tensor_comp]⟩ }

instance is_iso_of_f_is_iso {X Y : center C} (f : X ⟶ Y) [is_iso f.f] : is_iso f :=
begin
  change is_iso (iso_mk f).hom,
  apply_instance,
end

/-- Auxiliary definition for the `monoidal_category` instance on `center C`. -/
@[simps]
def tensor_obj (X Y : center C) : center C :=
⟨X.1 ⊗ Y.1,
  { β := λ U, α_ _ _ _ ≪≫ (iso.refl X.1 ⊗ Y.2.β U) ≪≫ (α_ _ _ _).symm
      ≪≫ (X.2.β U ⊗ iso.refl Y.1) ≪≫ α_ _ _ _,
    monoidal' := λ U U',
    begin
      dsimp,
      simp only [comp_tensor_id, id_tensor_comp, category.assoc, half_braiding.monoidal],
      -- On the RHS, we'd like to commute `((X.snd.β U).hom ⊗ 𝟙 Y.fst) ⊗ 𝟙 U'`
      -- and `𝟙 U ⊗ 𝟙 X.fst ⊗ (Y.snd.β U').hom` past each other,
      -- but there are some associators we need to get out of the way first.
      slice_rhs 6 8 { rw pentagon, },
      slice_rhs 5 6 { rw associator_naturality, },
      slice_rhs 7 8 { rw ←associator_naturality, },
      slice_rhs 6 7 { rw [tensor_id, tensor_id, tensor_id_comp_id_tensor, ←id_tensor_comp_tensor_id,
        ←tensor_id, ←tensor_id], },
      -- Now insert associators as needed to make the four half-braidings look identical
      slice_rhs 10 10 { rw associator_inv_conjugation, },
      slice_rhs 7 7 { rw associator_inv_conjugation, },
      slice_rhs 6 6 { rw associator_conjugation, },
      slice_rhs 3 3 { rw associator_conjugation, },
      -- Finish with an application of the coherence theorem.
      coherence,
    end,
    naturality' := λ U U' f,
    begin
      dsimp,
      rw [category.assoc, category.assoc, category.assoc, category.assoc,
        id_tensor_associator_naturality_assoc, ←id_tensor_comp_assoc, half_braiding.naturality,
        id_tensor_comp_assoc, associator_inv_naturality_assoc, ←comp_tensor_id_assoc,
        half_braiding.naturality, comp_tensor_id_assoc, associator_naturality, ←tensor_id],
    end, }⟩

/-- Auxiliary definition for the `monoidal_category` instance on `center C`. -/
@[simps]
def tensor_hom {X₁ Y₁ X₂ Y₂ : center C} (f : X₁ ⟶ Y₁) (g : X₂ ⟶ Y₂) :
  tensor_obj X₁ X₂ ⟶ tensor_obj Y₁ Y₂ :=
{ f := f.f ⊗ g.f,
  comm' := λ U, begin
    dsimp,
    rw [category.assoc, category.assoc, category.assoc, category.assoc,
      associator_naturality_assoc, ←tensor_id_comp_id_tensor, category.assoc,
      ←id_tensor_comp_assoc, g.comm, id_tensor_comp_assoc, tensor_id_comp_id_tensor_assoc,
      ←id_tensor_comp_tensor_id, category.assoc, associator_inv_naturality_assoc,
      id_tensor_associator_inv_naturality_assoc, tensor_id,
      id_tensor_comp_tensor_id_assoc, ←tensor_id_comp_id_tensor g.f, category.assoc,
      ←comp_tensor_id_assoc, f.comm, comp_tensor_id_assoc, id_tensor_associator_naturality,
      associator_naturality_assoc, ←id_tensor_comp, tensor_id_comp_id_tensor],
  end }

/-- Auxiliary definition for the `monoidal_category` instance on `center C`. -/
@[simps]
def tensor_unit : center C :=
⟨𝟙_ C,
  { β := λ U, (λ_ U) ≪≫ (ρ_ U).symm,
    monoidal' := λ U U', by simp,
    naturality' := λ U U' f, begin
      dsimp,
      rw [left_unitor_naturality_assoc, right_unitor_inv_naturality, category.assoc],
    end, }⟩

/-- Auxiliary definition for the `monoidal_category` instance on `center C`. -/
def associator (X Y Z : center C) : tensor_obj (tensor_obj X Y) Z ≅ tensor_obj X (tensor_obj Y Z) :=
iso_mk ⟨(α_ X.1 Y.1 Z.1).hom, λ U, begin
  dsimp,
  simp only [comp_tensor_id, id_tensor_comp, ←tensor_id, associator_conjugation],
  coherence,
end⟩

/-- Auxiliary definition for the `monoidal_category` instance on `center C`. -/
def left_unitor (X : center C) : tensor_obj tensor_unit X ≅ X :=
iso_mk ⟨(λ_ X.1).hom, λ U, begin
  dsimp,
  simp only [category.comp_id, category.assoc, tensor_inv_hom_id, comp_tensor_id,
    tensor_id_comp_id_tensor, triangle_assoc_comp_right_inv],
  rw [←left_unitor_tensor, left_unitor_naturality, left_unitor_tensor'_assoc],
end⟩

/-- Auxiliary definition for the `monoidal_category` instance on `center C`. -/
def right_unitor (X : center C) : tensor_obj X tensor_unit ≅ X :=
iso_mk ⟨(ρ_ X.1).hom, λ U, begin
  dsimp,
  simp only [tensor_id_comp_id_tensor_assoc, triangle_assoc, id_tensor_comp, category.assoc],
  rw [←tensor_id_comp_id_tensor_assoc (ρ_ U).inv, cancel_epi, ←right_unitor_tensor_inv_assoc,
    ←right_unitor_inv_naturality_assoc],
  simp,
end⟩

section
local attribute [simp] associator_naturality left_unitor_naturality right_unitor_naturality
  pentagon
local attribute [simp] center.associator center.left_unitor center.right_unitor

instance : monoidal_category (center C) :=
{ tensor_obj := λ X Y, tensor_obj X Y,
  tensor_hom := λ X₁ Y₁ X₂ Y₂ f g, tensor_hom f g,
  tensor_unit := tensor_unit,
  associator := associator,
  left_unitor := left_unitor,
  right_unitor := right_unitor, }

@[simp] lemma tensor_fst (X Y : center C) : (X ⊗ Y).1 = X.1 ⊗ Y.1 := rfl

@[simp] lemma tensor_β (X Y : center C) (U : C) :
  (X ⊗ Y).2.β U =
    α_ _ _ _ ≪≫ (iso.refl X.1 ⊗ Y.2.β U) ≪≫ (α_ _ _ _).symm
      ≪≫ (X.2.β U ⊗ iso.refl Y.1) ≪≫ α_ _ _ _ :=
rfl
@[simp]

@[simp] lemma tensor_unit_β (U : C) : (𝟙_ (center C)).2.β U = (λ_ U) ≪≫ (ρ_ U).symm := rfl

@[simp] lemma associator_hom_f (X Y Z : center C) : hom.f (α_ X Y Z).hom = (α_ X.1 Y.1 Z.1).hom :=
rfl

@[simp] lemma associator_inv_f (X Y Z : center C) : hom.f (α_ X Y Z).inv = (α_ X.1 Y.1 Z.1).inv :=
by { ext, rw [←associator_hom_f, ←comp_f, iso.hom_inv_id], refl, }

@[simp] lemma left_unitor_hom_f (X : center C) : hom.f (λ_ X).hom = (λ_ X.1).hom :=
rfl

@[simp] lemma left_unitor_inv_f (X : center C) : hom.f (λ_ X).inv = (λ_ X.1).inv :=
by { ext, rw [←left_unitor_hom_f, ←comp_f, iso.hom_inv_id], refl, }

@[simp] lemma right_unitor_hom_f (X : center C) : hom.f (ρ_ X).hom = (ρ_ X.1).hom :=
rfl

@[simp] lemma right_unitor_inv_f (X : center C) : hom.f (ρ_ X).inv = (ρ_ X.1).inv :=
by { ext, rw [←right_unitor_hom_f, ←comp_f, iso.hom_inv_id], refl, }

end

section
variables (C)

/-- The forgetful monoidal functor from the Drinfeld center to the original category. -/
@[simps]
def forget : monoidal_functor (center C) C :=
{ obj := λ X, X.1,
  map := λ X Y f, f.f,
  ε := 𝟙 (𝟙_ C),
  μ := λ X Y, 𝟙 (X.1 ⊗ Y.1), }

instance : reflects_isomorphisms (forget C).to_functor :=
{ reflects := λ A B f i, by { dsimp at i, resetI, change is_iso (iso_mk f).hom, apply_instance, } }

end

/-- Auxiliary definition for the `braided_category` instance on `center C`. -/
@[simps]
def braiding (X Y : center C) : X ⊗ Y ≅ Y ⊗ X :=
iso_mk ⟨(X.2.β Y.1).hom, λ U, begin
  dsimp,
  simp only [category.assoc],
  rw [←is_iso.inv_comp_eq, is_iso.iso.inv_hom, ←half_braiding.monoidal_assoc,
    ←half_braiding.naturality_assoc, half_braiding.monoidal],
  simp,
end⟩

instance braided_category_center : braided_category (center C) :=
{ braiding := braiding,
  braiding_naturality' := λ X Y X' Y' f g, begin
    ext,
    dsimp,
    rw [←tensor_id_comp_id_tensor, category.assoc, half_braiding.naturality, f.comm_assoc,
      id_tensor_comp_tensor_id],
  end, } -- `obviously` handles the hexagon axioms

section
variables [braided_category C]

open braided_category

/-- Auxiliary construction for `of_braided`. -/
@[simps]
def of_braided_obj (X : C) : center C :=
⟨X, { β := λ Y, β_ X Y,
  monoidal' := λ U U', begin
    rw [iso.eq_inv_comp, ←category.assoc, ←category.assoc, iso.eq_comp_inv,
      category.assoc, category.assoc],
    exact hexagon_forward X U U',
  end }⟩

variables (C)

/--
The functor lifting a braided category to its center, using the braiding as the half-braiding.
-/
@[simps]
def of_braided : monoidal_functor C (center C) :=
{ obj := of_braided_obj,
  map := λ X X' f,
  { f := f,
    comm' := λ U, braiding_naturality _ _, },
  ε :=
  { f := 𝟙 _,
    comm' := λ U, begin
      dsimp,
      rw [tensor_id, category.id_comp, tensor_id, category.comp_id, ←braiding_right_unitor,
        category.assoc, iso.hom_inv_id, category.comp_id],
    end, },
  μ := λ X Y,
  { f := 𝟙 _,
    comm' := λ U, begin
      dsimp,
      rw [tensor_id, tensor_id, category.id_comp, category.comp_id,
        ←iso.inv_comp_eq, ←category.assoc, ←category.assoc, ←iso.comp_inv_eq,
        category.assoc, hexagon_reverse, category.assoc],
    end, }, }

end

end center

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
-/
import category_theory.limits.shapes.finite_products
import category_theory.limits.shapes.binary_products
import category_theory.preadditive

/-!
# Biproducts and binary biproducts

We introduce the notion of (finite) biproducts and binary biproducts.

These are slightly unusual relative to the other shapes in the library,
as they are simultaneously limits and colimits.
(Zero objects are similar; they are "biterminal".)

We treat first the case of a general category with zero morphisms,
and subsequently the case of a preadditive category.

In a category with zero morphisms, we model the (binary) biproduct of `P Q : C`
using a `binary_bicone`, which has a cone point `X`,
and morphisms `fst : X ⟶ P`, `snd : X ⟶ Q`, `inl : P ⟶ X` and `inr : X ⟶ Q`,
such that `inl ≫ fst = 𝟙 P`, `inl ≫ snd = 0`, `inr ≫ fst = 0`, and `inr ≫ snd = 𝟙 Q`.
Such a `binary_bicone` is a biproduct if the cone is a limit cone, and the cocone is a colimit
cocone.

In a preadditive category,
* any `binary_biproduct` satisfies `total : fst ≫ inl + snd ≫ inr = 𝟙 X`
* any `binary_product` is a `binary_biproduct`
* any `binary_coproduct` is a `binary_biproduct`

For biproducts indexed by a `fintype J`, a `bicone` again consists of a cone point `X`
and morphisms `π j : X ⟶ F j` and `ι j : F j ⟶ X` for each `j`,
such that `ι j ≫ π j'` is the identity when `j = j'` and zero otherwise.

In a preadditive category,
* any `biproduct` satisfies `total : ∑ j : J, biproduct.π f j ≫ biproduct.ι f j = 𝟙 (⨁ f)`
* any `product` is a `biproduct`
* any `coproduct` is a `biproduct`

## Notation
As `⊕` is already taken for the sum of types, we introduce the notation `X ⊞ Y` for
a binary biproduct. We introduce `⨁ f` for the indexed biproduct.
-/

noncomputable theory

universes v u

open category_theory
open category_theory.functor

namespace category_theory.limits

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

/--
A `c : bicone F` is:
* an object `c.X` and
* morphisms `π j : X ⟶ F j` and `ι j : F j ⟶ X` for each `j`,
* such that `ι j ≫ π j'` is the identity when `j = j'` and zero otherwise.
-/
@[nolint has_inhabited_instance]
structure bicone (F : J → C) :=
(X : C)
(π : Π j, X ⟶ F j)
(ι : Π j, F j ⟶ X)
(ι_π : ∀ j j', ι j ≫ π j' = if h : j = j' then eq_to_hom (congr_arg F h) else 0)

@[simp] lemma bicone_ι_π_self {F : J → C} (B : bicone F) (j : J) : B.ι j ≫ B.π j = 𝟙 (F j) :=
by simpa using B.ι_π j j

@[simp] lemma bicone_ι_π_ne {F : J → C} (B : bicone F) {j j' : J} (h : j ≠ j') :
  B.ι j ≫ B.π j' = 0 :=
by simpa [h] using B.ι_π j j'

variables {F : J → C}

namespace bicone
/-- Extract the cone from a bicone. -/
@[simps]
def to_cone (B : bicone F) : cone (discrete.functor F) :=
{ X := B.X,
  π := { app := λ j, B.π j }, }

/-- Extract the cocone from a bicone. -/
@[simps]
def to_cocone (B : bicone F) : cocone (discrete.functor F) :=
{ X := B.X,
  ι := { app := λ j, B.ι j }, }

end bicone

/--
A bicone over `F : J → C`, which is both a limit cone and a colimit cocone.
-/
@[nolint has_inhabited_instance]
structure limit_bicone (F : J → C) :=
(bicone : bicone F)
(is_limit : is_limit bicone.to_cone)
(is_colimit : is_colimit bicone.to_cocone)

/--
`has_biproduct F` expresses the mere existence of a bicone which is
simultaneously a limit and a colimit of the diagram `F`.
-/
class has_biproduct (F : J → C) : Prop :=
mk' :: (exists_biproduct : nonempty (limit_bicone F))

lemma has_biproduct.mk {F : J → C} (d : limit_bicone F) : has_biproduct F :=
⟨nonempty.intro d⟩

/-- Use the axiom of choice to extract explicit `biproduct_data F` from `has_biproduct F`. -/
def get_biproduct_data (F : J → C) [has_biproduct F] : limit_bicone F :=
classical.choice has_biproduct.exists_biproduct

/-- A bicone for `F` which is both a limit cone and a colimit cocone. -/
def biproduct.bicone (F : J → C) [has_biproduct F] : bicone F :=
(get_biproduct_data F).bicone

/-- `biproduct.bicone F` is a limit cone. -/
def biproduct.is_limit (F : J → C) [has_biproduct F] : is_limit (biproduct.bicone F).to_cone :=
(get_biproduct_data F).is_limit

/-- `biproduct.bicone F` is a colimit cocone. -/
def biproduct.is_colimit (F : J → C) [has_biproduct F] :
  is_colimit (biproduct.bicone F).to_cocone :=
(get_biproduct_data F).is_colimit

@[priority 100]
instance has_product_of_has_biproduct [has_biproduct F] : has_limit (discrete.functor F) :=
has_limit.mk { cone := (biproduct.bicone F).to_cone,
  is_limit := biproduct.is_limit F, }

@[priority 100]
instance has_coproduct_of_has_biproduct [has_biproduct F] : has_colimit (discrete.functor F) :=
has_colimit.mk { cocone := (biproduct.bicone F).to_cocone,
  is_colimit := biproduct.is_colimit F, }

variables (J C)

/--
`C` has biproducts of shape `J` if we have
a limit and a colimit, with the same cone points,
of every function `F : J → C`.
-/
class has_biproducts_of_shape : Prop :=
(has_biproduct : Π F : J → C, has_biproduct F)

attribute [instance, priority 100] has_biproducts_of_shape.has_biproduct

/-- `has_finite_biproducts C` represents a choice of biproduct for every family of objects in `C`
indexed by a finite type with decidable equality. -/
class has_finite_biproducts : Prop :=
(has_biproducts_of_shape : Π (J : Type v) [decidable_eq J] [fintype J],
  has_biproducts_of_shape J C)

attribute [instance, priority 100] has_finite_biproducts.has_biproducts_of_shape

@[priority 100]
instance has_finite_products_of_has_finite_biproducts [has_finite_biproducts C] :
  has_finite_products C :=
{ out := λ J _ _, ⟨λ F, by exactI has_limit_of_iso discrete.nat_iso_functor.symm⟩ }

@[priority 100]
instance has_finite_coproducts_of_has_finite_biproducts [has_finite_biproducts C] :
  has_finite_coproducts C :=
{ out := λ J _ _, ⟨λ F, by exactI has_colimit_of_iso discrete.nat_iso_functor⟩ }

variables {J C}

/--
The isomorphism between the specified limit and the specified colimit for
a functor with a bilimit.
-/
def biproduct_iso (F : J → C) [has_biproduct F] :
  limits.pi_obj F ≅ limits.sigma_obj F :=
(is_limit.cone_point_unique_up_to_iso (limit.is_limit _) (biproduct.is_limit F)).trans $
  is_colimit.cocone_point_unique_up_to_iso (biproduct.is_colimit F) (colimit.is_colimit _)

end category_theory.limits

namespace category_theory.limits
variables {J : Type v} [decidable_eq J]
variables {C : Type u} [category.{v} C] [has_zero_morphisms C]

/-- `biproduct f` computes the biproduct of a family of elements `f`. (It is defined as an
   abbreviation for `limit (discrete.functor f)`, so for most facts about `biproduct f`, you will
   just use general facts about limits and colimits.) -/
abbreviation biproduct (f : J → C) [has_biproduct f] : C :=
(biproduct.bicone f).X

notation `⨁ ` f:20 := biproduct f

/-- The projection onto a summand of a biproduct. -/
abbreviation biproduct.π (f : J → C) [has_biproduct f] (b : J) : ⨁ f ⟶ f b :=
(biproduct.bicone f).π b

@[simp]
lemma biproduct.bicone_π (f : J → C) [has_biproduct f] (b : J) :
  (biproduct.bicone f).π b = biproduct.π f b := rfl

/-- The inclusion into a summand of a biproduct. -/
abbreviation biproduct.ι (f : J → C) [has_biproduct f] (b : J) : f b ⟶ ⨁ f :=
(biproduct.bicone f).ι b

@[simp]
lemma biproduct.bicone_ι (f : J → C) [has_biproduct f] (b : J) :
  (biproduct.bicone f).ι b = biproduct.ι f b := rfl

@[reassoc]
lemma biproduct.ι_π (f : J → C) [has_biproduct f] (j j' : J) :
  biproduct.ι f j ≫ biproduct.π f j' = if h : j = j' then eq_to_hom (congr_arg f h) else 0 :=
(biproduct.bicone f).ι_π j j'

@[simp,reassoc]
lemma biproduct.ι_π_self (f : J → C) [has_biproduct f] (j : J) :
  biproduct.ι f j ≫ biproduct.π f j = 𝟙 _ :=
by simp [biproduct.ι_π]

@[simp,reassoc]
lemma biproduct.ι_π_ne (f : J → C) [has_biproduct f] {j j' : J} (h : j ≠ j') :
  biproduct.ι f j ≫ biproduct.π f j' = 0 :=
by simp [biproduct.ι_π, h]

/-- Given a collection of maps into the summands, we obtain a map into the biproduct. -/
abbreviation biproduct.lift
  {f : J → C} [has_biproduct f] {P : C} (p : Π b, P ⟶ f b) : P ⟶ ⨁ f :=
(biproduct.is_limit f).lift (fan.mk P p)
/-- Given a collection of maps out of the summands, we obtain a map out of the biproduct. -/
abbreviation biproduct.desc
  {f : J → C} [has_biproduct f] {P : C} (p : Π b, f b ⟶ P) : ⨁ f ⟶ P :=
(biproduct.is_colimit f).desc (cofan.mk P p)

@[simp, reassoc]
lemma biproduct.lift_π {f : J → C} [has_biproduct f] {P : C} (p : Π b, P ⟶ f b) (j : J) :
  biproduct.lift p ≫ biproduct.π f j = p j :=
(biproduct.is_limit f).fac _ _

@[simp, reassoc]
lemma biproduct.ι_desc {f : J → C} [has_biproduct f] {P : C} (p : Π b, f b ⟶ P) (j : J) :
  biproduct.ι f j ≫ biproduct.desc p = p j :=
(biproduct.is_colimit f).fac _ _

/-- Given a collection of maps between corresponding summands of a pair of biproducts
indexed by the same type, we obtain a map between the biproducts. -/
abbreviation biproduct.map [fintype J] {f g : J → C} [has_finite_biproducts C]
  (p : Π b, f b ⟶ g b) : ⨁ f ⟶ ⨁ g :=
is_limit.map (biproduct.bicone f).to_cone (biproduct.is_limit g) (discrete.nat_trans p)

/-- An alternative to `biproduct.map` constructed via colimits.
This construction only exists in order to show it is equal to `biproduct.map`. -/
abbreviation biproduct.map' [fintype J] {f g : J → C} [has_finite_biproducts C]
  (p : Π b, f b ⟶ g b) : ⨁ f ⟶ ⨁ g :=
is_colimit.map (biproduct.is_colimit f) (biproduct.bicone g).to_cocone (discrete.nat_trans p)

@[ext] lemma biproduct.hom_ext {f : J → C} [has_biproduct f]
  {Z : C} (g h : Z ⟶ ⨁ f)
  (w : ∀ j, g ≫ biproduct.π f j = h ≫ biproduct.π f j) : g = h :=
(biproduct.is_limit f).hom_ext w

@[ext] lemma biproduct.hom_ext' {f : J → C} [has_biproduct f]
  {Z : C} (g h : ⨁ f ⟶ Z)
  (w : ∀ j, biproduct.ι f j ≫ g = biproduct.ι f j ≫ h) : g = h :=
(biproduct.is_colimit f).hom_ext w

lemma biproduct.map_eq_map' [fintype J] {f g : J → C} [has_finite_biproducts C]
  (p : Π b, f b ⟶ g b) : biproduct.map p = biproduct.map' p :=
begin
  ext j j',
  simp only [discrete.nat_trans_app, limits.is_colimit.ι_map, limits.is_limit.map_π, category.assoc,
    ←bicone.to_cone_π_app, ←biproduct.bicone_π, ←bicone.to_cocone_ι_app, ←biproduct.bicone_ι],
  simp only [biproduct.bicone_ι, biproduct.bicone_π, bicone.to_cocone_ι_app, bicone.to_cone_π_app],
  rw [biproduct.ι_π_assoc, biproduct.ι_π],
  split_ifs,
  { subst h, rw [eq_to_hom_refl, category.id_comp], erw category.comp_id, },
  { simp, },
end

@[simp, reassoc]
lemma biproduct.map_π [fintype J] {f g : J → C} [has_finite_biproducts C]
  (p : Π j, f j ⟶ g j) (j : J) :
  biproduct.map p ≫ biproduct.π g j = biproduct.π f j ≫ p j :=
limits.is_limit.map_π _ _ _ _

@[simp, reassoc]
lemma biproduct.ι_map [fintype J] {f g : J → C} [has_finite_biproducts C]
  (p : Π j, f j ⟶ g j) (j : J) :
  biproduct.ι f j ≫ biproduct.map p = p j ≫ biproduct.ι g j :=
begin
  rw biproduct.map_eq_map',
  convert limits.is_colimit.ι_map _ _ _ _; refl
end

@[simp, reassoc]
lemma biproduct.map_desc [fintype J] {f g : J → C} [has_finite_biproducts C]
  (p : Π j, f j ⟶ g j) {P : C} (k : Π j, g j ⟶ P) :
  biproduct.map p ≫ biproduct.desc k = biproduct.desc (λ j, p j ≫ k j) :=
by { ext, simp, }

@[simp, reassoc]
lemma biproduct.lift_map [fintype J] {f g : J → C} [has_finite_biproducts C]
  {P : C} (k : Π j, P ⟶ f j) (p : Π j, f j ⟶ g j)  :
  biproduct.lift k ≫ biproduct.map p = biproduct.lift (λ j, k j ≫ p j) :=
by { ext, simp, }

/-- Given a collection of isomorphisms between corresponding summands of a pair of biproducts
indexed by the same type, we obtain an isomorphism between the biproducts. -/
@[simps]
def biproduct.map_iso [fintype J] {f g : J → C} [has_finite_biproducts C]
  (p : Π b, f b ≅ g b) : ⨁ f ≅ ⨁ g :=
{ hom := biproduct.map (λ b, (p b).hom),
  inv := biproduct.map (λ b, (p b).inv), }

section
variables [fintype J] {K : Type v} [fintype K] [decidable_eq K] {f : J → C} {g : K → C}
  [has_finite_biproducts C]

/--
Convert a (dependently typed) matrix to a morphism of biproducts.
-/
def biproduct.matrix (m : Π j k, f j ⟶ g k) : ⨁ f ⟶ ⨁ g :=
biproduct.desc (λ j, biproduct.lift (λ k, m j k))

@[simp, reassoc]
lemma biproduct.matrix_π (m : Π j k, f j ⟶ g k) (k : K) :
  biproduct.matrix m ≫ biproduct.π g k = biproduct.desc (λ j, m j k) :=
by { ext, simp [biproduct.matrix], }

@[simp, reassoc]
lemma biproduct.ι_matrix (m : Π j k, f j ⟶ g k) (j : J) :
  biproduct.ι f j ≫ biproduct.matrix m = biproduct.lift (λ k, m j k) :=
by { ext, simp [biproduct.matrix], }

/--
Extract the matrix components from a morphism of biproducts.
-/
def biproduct.components (m : ⨁ f ⟶ ⨁ g) (j : J) (k : K) : f j ⟶ g k :=
biproduct.ι f j ≫ m ≫ biproduct.π g k

@[simp] lemma biproduct.matrix_components (m : Π j k, f j ⟶ g k) (j : J) (k : K) :
  biproduct.components (biproduct.matrix m) j k = m j k :=
by simp [biproduct.components]

@[simp] lemma biproduct.components_matrix (m : ⨁ f ⟶ ⨁ g) :
  biproduct.matrix (λ j k, biproduct.components m j k) = m :=
by { ext, simp [biproduct.components], }

/-- Morphisms between direct sums are matrices. -/
@[simps]
def biproduct.matrix_equiv : (⨁ f ⟶ ⨁ g) ≃ (Π j k, f j ⟶ g k) :=
{ to_fun := biproduct.components,
  inv_fun := biproduct.matrix,
  left_inv := biproduct.components_matrix,
  right_inv := λ m, by { ext, apply biproduct.matrix_components } }

end

instance biproduct.ι_mono (f : J → C) [has_biproduct f]
  (b : J) : split_mono (biproduct.ι f b) :=
{ retraction := biproduct.desc $
    λ b', if h : b' = b then eq_to_hom (congr_arg f h) else biproduct.ι f b' ≫ biproduct.π f b }

instance biproduct.π_epi (f : J → C) [has_biproduct f]
  (b : J) : split_epi (biproduct.π f b) :=
{ section_ := biproduct.lift $
    λ b', if h : b = b' then eq_to_hom (congr_arg f h) else biproduct.ι f b ≫ biproduct.π f b' }

variables {C}

/--
A binary bicone for a pair of objects `P Q : C` consists of the cone point `X`,
maps from `X` to both `P` and `Q`, and maps from both `P` and `Q` to `X`,
so that `inl ≫ fst = 𝟙 P`, `inl ≫ snd = 0`, `inr ≫ fst = 0`, and `inr ≫ snd = 𝟙 Q`
-/
@[nolint has_inhabited_instance]
structure binary_bicone (P Q : C) :=
(X : C)
(fst : X ⟶ P)
(snd : X ⟶ Q)
(inl : P ⟶ X)
(inr : Q ⟶ X)
(inl_fst' : inl ≫ fst = 𝟙 P . obviously)
(inl_snd' : inl ≫ snd = 0 . obviously)
(inr_fst' : inr ≫ fst = 0 . obviously)
(inr_snd' : inr ≫ snd = 𝟙 Q . obviously)

restate_axiom binary_bicone.inl_fst'
restate_axiom binary_bicone.inl_snd'
restate_axiom binary_bicone.inr_fst'
restate_axiom binary_bicone.inr_snd'
attribute [simp, reassoc] binary_bicone.inl_fst binary_bicone.inl_snd
  binary_bicone.inr_fst binary_bicone.inr_snd

namespace binary_bicone
variables {P Q : C}

/-- Extract the cone from a binary bicone. -/
def to_cone (c : binary_bicone P Q) : cone (pair P Q) :=
binary_fan.mk c.fst c.snd

@[simp]
lemma to_cone_X (c : binary_bicone P Q) :
  c.to_cone.X = c.X := rfl

@[simp]
lemma to_cone_π_app_left (c : binary_bicone P Q) :
  c.to_cone.π.app (walking_pair.left) = c.fst := rfl
@[simp]
lemma to_cone_π_app_right (c : binary_bicone P Q) :
  c.to_cone.π.app (walking_pair.right) = c.snd := rfl

/-- Extract the cocone from a binary bicone. -/
def to_cocone (c : binary_bicone P Q) : cocone (pair P Q) :=
binary_cofan.mk c.inl c.inr

@[simp]
lemma to_cocone_X (c : binary_bicone P Q) :
  c.to_cocone.X = c.X := rfl

@[simp]
lemma to_cocone_ι_app_left (c : binary_bicone P Q) :
  c.to_cocone.ι.app (walking_pair.left) = c.inl := rfl
@[simp]
lemma to_cocone_ι_app_right (c : binary_bicone P Q) :
  c.to_cocone.ι.app (walking_pair.right) = c.inr := rfl

end binary_bicone

namespace bicone

/-- Convert a `bicone` over a function on `walking_pair` to a binary_bicone. -/
@[simps]
def to_binary_bicone {X Y : C} (b : bicone (pair X Y).obj) : binary_bicone X Y :=
{ X := b.X,
  fst := b.π walking_pair.left,
  snd := b.π walking_pair.right,
  inl := b.ι walking_pair.left,
  inr := b.ι walking_pair.right,
  inl_fst' := by { simp [bicone.ι_π], refl, },
  inr_fst' := by simp [bicone.ι_π],
  inl_snd' := by simp [bicone.ι_π],
  inr_snd' := by { simp [bicone.ι_π], refl, }, }

/--
If the cone obtained from a bicone over `pair X Y` is a limit cone,
so is the cone obtained by converting that bicone to a binary_bicone, then to a cone.
-/
def to_binary_bicone_is_limit {X Y : C} {b : bicone (pair X Y).obj}
  (c : is_limit (b.to_cone)) :
  is_limit (b.to_binary_bicone.to_cone) :=
{ lift := λ s, c.lift s,
   fac' := λ s j, by { cases j; erw c.fac, },
   uniq' := λ s m w,
   begin
     apply c.uniq s,
     rintro (⟨⟩|⟨⟩),
     exact w walking_pair.left,
     exact w walking_pair.right,
   end, }

/--
If the cocone obtained from a bicone over `pair X Y` is a colimit cocone,
so is the cocone obtained by converting that bicone to a binary_bicone, then to a cocone.
-/
def to_binary_bicone_is_colimit {X Y : C} {b : bicone (pair X Y).obj}
  (c : is_colimit (b.to_cocone)) :
  is_colimit (b.to_binary_bicone.to_cocone) :=
{ desc := λ s, c.desc s,
   fac' := λ s j, by { cases j; erw c.fac, },
   uniq' := λ s m w,
   begin
     apply c.uniq s,
     rintro (⟨⟩|⟨⟩),
     exact w walking_pair.left,
     exact w walking_pair.right,
   end, }

end bicone

/--
A bicone over `P Q : C`, which is both a limit cone and a colimit cocone.
-/
@[nolint has_inhabited_instance]
structure binary_biproduct_data (P Q : C) :=
(bicone : binary_bicone P Q)
(is_limit : is_limit bicone.to_cone)
(is_colimit : is_colimit bicone.to_cocone)

/--
`has_binary_biproduct P Q` expresses the mere existence of a bicone which is
simultaneously a limit and a colimit of the diagram `pair P Q`.
-/
class has_binary_biproduct (P Q : C) : Prop :=
mk' :: (exists_binary_biproduct : nonempty (binary_biproduct_data P Q))

lemma has_binary_biproduct.mk {P Q : C} (d : binary_biproduct_data P Q) :
  has_binary_biproduct P Q :=
⟨nonempty.intro d⟩

/--
Use the axiom of choice to extract explicit `binary_biproduct_data F` from `has_binary_biproduct F`.
-/
def get_binary_biproduct_data (P Q : C) [has_binary_biproduct P Q] : binary_biproduct_data P Q :=
classical.choice has_binary_biproduct.exists_binary_biproduct

/-- A bicone for `P Q ` which is both a limit cone and a colimit cocone. -/
def binary_biproduct.bicone (P Q : C) [has_binary_biproduct P Q] : binary_bicone P Q :=
(get_binary_biproduct_data P Q).bicone

/-- `binary_biproduct.bicone P Q` is a limit cone. -/
def binary_biproduct.is_limit (P Q : C) [has_binary_biproduct P Q] :
  is_limit (binary_biproduct.bicone P Q).to_cone :=
(get_binary_biproduct_data P Q).is_limit

/-- `binary_biproduct.bicone P Q` is a colimit cocone. -/
def binary_biproduct.is_colimit (P Q : C) [has_binary_biproduct P Q] :
  is_colimit (binary_biproduct.bicone P Q).to_cocone :=
(get_binary_biproduct_data P Q).is_colimit

section
variable (C)

/--
`has_binary_biproducts C` represents the existence of a bicone which is
simultaneously a limit and a colimit of the diagram `pair P Q`, for every `P Q : C`.
-/
class has_binary_biproducts : Prop :=
(has_binary_biproduct : Π (P Q : C), has_binary_biproduct P Q)

attribute [instance, priority 100] has_binary_biproducts.has_binary_biproduct

/--
A category with finite biproducts has binary biproducts.

This is not an instance as typically in concrete categories there will be
an alternative construction with nicer definitional properties.
-/
lemma has_binary_biproducts_of_finite_biproducts [has_finite_biproducts C] :
  has_binary_biproducts C :=
{ has_binary_biproduct := λ P Q, has_binary_biproduct.mk
  { bicone := (biproduct.bicone (pair P Q).obj).to_binary_bicone,
    is_limit := bicone.to_binary_bicone_is_limit (biproduct.is_limit _),
    is_colimit := bicone.to_binary_bicone_is_colimit (biproduct.is_colimit _) } }

end

variables {P Q : C}

instance has_binary_biproduct.has_limit_pair [has_binary_biproduct P Q] :
  has_limit (pair P Q) :=
has_limit.mk ⟨_, binary_biproduct.is_limit P Q⟩

instance has_binary_biproduct.has_colimit_pair [has_binary_biproduct P Q] :
  has_colimit (pair P Q) :=
has_colimit.mk ⟨_, binary_biproduct.is_colimit P Q⟩

@[priority 100]
instance has_binary_products_of_has_binary_biproducts [has_binary_biproducts C] :
  has_binary_products C :=
{ has_limit := λ F, has_limit_of_iso (diagram_iso_pair F).symm }
@[priority 100]
instance has_binary_coproducts_of_has_binary_biproducts [has_binary_biproducts C] :
  has_binary_coproducts C :=
{ has_colimit := λ F, has_colimit_of_iso (diagram_iso_pair F) }

/--
The isomorphism between the specified binary product and the specified binary coproduct for
a pair for a binary biproduct.
-/
def biprod_iso (X Y : C) [has_binary_biproduct X Y]  :
  limits.prod X Y ≅ limits.coprod X Y :=
(is_limit.cone_point_unique_up_to_iso (limit.is_limit _) (binary_biproduct.is_limit X Y)).trans $
  is_colimit.cocone_point_unique_up_to_iso (binary_biproduct.is_colimit X Y) (colimit.is_colimit _)

/-- An arbitrary choice of biproduct of a pair of objects. -/
abbreviation biprod (X Y : C) [has_binary_biproduct X Y] := (binary_biproduct.bicone X Y).X

notation X ` ⊞ `:20 Y:20 := biprod X Y

/-- The projection onto the first summand of a binary biproduct. -/
abbreviation biprod.fst {X Y : C} [has_binary_biproduct X Y] : X ⊞ Y ⟶ X :=
(binary_biproduct.bicone X Y).fst
/-- The projection onto the second summand of a binary biproduct. -/
abbreviation biprod.snd {X Y : C} [has_binary_biproduct X Y] : X ⊞ Y ⟶ Y :=
(binary_biproduct.bicone X Y).snd
/-- The inclusion into the first summand of a binary biproduct. -/
abbreviation biprod.inl {X Y : C} [has_binary_biproduct X Y] : X ⟶ X ⊞ Y :=
(binary_biproduct.bicone X Y).inl
/-- The inclusion into the second summand of a binary biproduct. -/
abbreviation biprod.inr {X Y : C} [has_binary_biproduct X Y] : Y ⟶ X ⊞ Y :=
(binary_biproduct.bicone X Y).inr

section
variables {X Y : C} [has_binary_biproduct X Y]

@[simp] lemma binary_biproduct.bicone_fst : (binary_biproduct.bicone X Y).fst = biprod.fst := rfl
@[simp] lemma binary_biproduct.bicone_snd : (binary_biproduct.bicone X Y).snd = biprod.snd := rfl
@[simp] lemma binary_biproduct.bicone_inl : (binary_biproduct.bicone X Y).inl = biprod.inl := rfl
@[simp] lemma binary_biproduct.bicone_inr : (binary_biproduct.bicone X Y).inr = biprod.inr := rfl

end

@[simp,reassoc]
lemma biprod.inl_fst {X Y : C} [has_binary_biproduct X Y] :
  (biprod.inl : X ⟶ X ⊞ Y) ≫ (biprod.fst : X ⊞ Y ⟶ X) = 𝟙 X :=
(binary_biproduct.bicone X Y).inl_fst
@[simp,reassoc]
lemma biprod.inl_snd {X Y : C} [has_binary_biproduct X Y] :
  (biprod.inl : X ⟶ X ⊞ Y) ≫ (biprod.snd : X ⊞ Y ⟶ Y) = 0 :=
(binary_biproduct.bicone X Y).inl_snd
@[simp,reassoc]
lemma biprod.inr_fst {X Y : C} [has_binary_biproduct X Y] :
  (biprod.inr : Y ⟶ X ⊞ Y) ≫ (biprod.fst : X ⊞ Y ⟶ X) = 0 :=
(binary_biproduct.bicone X Y).inr_fst
@[simp,reassoc]
lemma biprod.inr_snd {X Y : C} [has_binary_biproduct X Y] :
  (biprod.inr : Y ⟶ X ⊞ Y) ≫ (biprod.snd : X ⊞ Y ⟶ Y) = 𝟙 Y :=
(binary_biproduct.bicone X Y).inr_snd

/-- Given a pair of maps into the summands of a binary biproduct,
we obtain a map into the binary biproduct. -/
abbreviation biprod.lift {W X Y : C} [has_binary_biproduct X Y] (f : W ⟶ X) (g : W ⟶ Y) :
  W ⟶ X ⊞ Y :=
(binary_biproduct.is_limit X Y).lift (binary_fan.mk f g)
/-- Given a pair of maps out of the summands of a binary biproduct,
we obtain a map out of the binary biproduct. -/
abbreviation biprod.desc {W X Y : C} [has_binary_biproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) :
  X ⊞ Y ⟶ W :=
(binary_biproduct.is_colimit X Y).desc (binary_cofan.mk f g)

@[simp, reassoc]
lemma biprod.lift_fst {W X Y : C} [has_binary_biproduct X Y] (f : W ⟶ X) (g : W ⟶ Y) :
  biprod.lift f g ≫ biprod.fst = f :=
(binary_biproduct.is_limit X Y).fac _ walking_pair.left

@[simp, reassoc]
lemma biprod.lift_snd {W X Y : C} [has_binary_biproduct X Y] (f : W ⟶ X) (g : W ⟶ Y) :
  biprod.lift f g ≫ biprod.snd = g :=
(binary_biproduct.is_limit X Y).fac _ walking_pair.right

@[simp, reassoc]
lemma biprod.inl_desc {W X Y : C} [has_binary_biproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) :
  biprod.inl ≫ biprod.desc f g = f :=
(binary_biproduct.is_colimit X Y).fac _ walking_pair.left

@[simp, reassoc]
lemma biprod.inr_desc {W X Y : C} [has_binary_biproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) :
  biprod.inr ≫ biprod.desc f g = g :=
(binary_biproduct.is_colimit X Y).fac _ walking_pair.right

instance biprod.mono_lift_of_mono_left {W X Y : C} [has_binary_biproduct X Y] (f : W ⟶ X)
  (g : W ⟶ Y) [mono f] : mono (biprod.lift f g) :=
mono_of_mono_fac $ biprod.lift_fst _ _

instance biprod.mono_lift_of_mono_right {W X Y : C} [has_binary_biproduct X Y] (f : W ⟶ X)
  (g : W ⟶ Y) [mono g] : mono (biprod.lift f g) :=
mono_of_mono_fac $ biprod.lift_snd _ _

instance biprod.epi_desc_of_epi_left {W X Y : C} [has_binary_biproduct X Y] (f : X ⟶ W) (g : Y ⟶ W)
  [epi f] : epi (biprod.desc f g) :=
epi_of_epi_fac $ biprod.inl_desc _ _

instance biprod.epi_desc_of_epi_right {W X Y : C} [has_binary_biproduct X Y] (f : X ⟶ W) (g : Y ⟶ W)
  [epi g] : epi (biprod.desc f g) :=
epi_of_epi_fac $ biprod.inr_desc _ _

/-- Given a pair of maps between the summands of a pair of binary biproducts,
we obtain a map between the binary biproducts. -/
abbreviation biprod.map {W X Y Z : C} [has_binary_biproduct W X] [has_binary_biproduct Y Z]
  (f : W ⟶ Y) (g : X ⟶ Z) : W ⊞ X ⟶ Y ⊞ Z :=
is_limit.map (binary_biproduct.bicone W X).to_cone (binary_biproduct.is_limit Y Z)
  (@map_pair _ _ (pair W X) (pair Y Z) f g)

/-- An alternative to `biprod.map` constructed via colimits.
This construction only exists in order to show it is equal to `biprod.map`. -/
abbreviation biprod.map' {W X Y Z : C} [has_binary_biproduct W X] [has_binary_biproduct Y Z]
  (f : W ⟶ Y) (g : X ⟶ Z) : W ⊞ X ⟶ Y ⊞ Z :=
is_colimit.map (binary_biproduct.is_colimit W X) (binary_biproduct.bicone Y Z).to_cocone
  (@map_pair _ _ (pair W X) (pair Y Z) f g)

@[ext] lemma biprod.hom_ext {X Y Z : C} [has_binary_biproduct X Y] (f g : Z ⟶ X ⊞ Y)
  (h₀ : f ≫ biprod.fst = g ≫ biprod.fst) (h₁ : f ≫ biprod.snd = g ≫ biprod.snd) : f = g :=
binary_fan.is_limit.hom_ext (binary_biproduct.is_limit X Y) h₀ h₁

@[ext] lemma biprod.hom_ext' {X Y Z : C} [has_binary_biproduct X Y] (f g : X ⊞ Y ⟶ Z)
  (h₀ : biprod.inl ≫ f = biprod.inl ≫ g) (h₁ : biprod.inr ≫ f = biprod.inr ≫ g) : f = g :=
binary_cofan.is_colimit.hom_ext (binary_biproduct.is_colimit X Y) h₀ h₁

lemma biprod.map_eq_map' {W X Y Z : C} [has_binary_biproduct W X] [has_binary_biproduct Y Z]
  (f : W ⟶ Y) (g : X ⟶ Z) : biprod.map f g = biprod.map' f g :=
begin
  ext,
  { simp only [map_pair_left, is_colimit.ι_map, is_limit.map_π, biprod.inl_fst_assoc,
    category.assoc, ←binary_bicone.to_cone_π_app_left, ←binary_biproduct.bicone_fst,
    ←binary_bicone.to_cocone_ι_app_left, ←binary_biproduct.bicone_inl],
    simp },
  { simp only [map_pair_left, is_colimit.ι_map, is_limit.map_π, zero_comp,
      biprod.inl_snd_assoc, category.assoc,
      ←binary_bicone.to_cone_π_app_right, ←binary_biproduct.bicone_snd,
      ←binary_bicone.to_cocone_ι_app_left, ←binary_biproduct.bicone_inl],
    simp },
  { simp only [map_pair_right, biprod.inr_fst_assoc, is_colimit.ι_map, is_limit.map_π,
      zero_comp, category.assoc,
      ←binary_bicone.to_cone_π_app_left, ←binary_biproduct.bicone_fst,
      ←binary_bicone.to_cocone_ι_app_right, ←binary_biproduct.bicone_inr],
    simp },
  { simp only [map_pair_right, is_colimit.ι_map, is_limit.map_π, biprod.inr_snd_assoc,
      category.assoc, ←binary_bicone.to_cone_π_app_right, ←binary_biproduct.bicone_snd,
      ←binary_bicone.to_cocone_ι_app_right, ←binary_biproduct.bicone_inr],
    simp }
end

instance biprod.inl_mono {X Y : C} [has_binary_biproduct X Y] :
  split_mono (biprod.inl : X ⟶ X ⊞ Y) :=
{ retraction := biprod.desc (𝟙 X) (biprod.inr ≫ biprod.fst) }

instance biprod.inr_mono {X Y : C} [has_binary_biproduct X Y] :
  split_mono (biprod.inr : Y ⟶ X ⊞ Y) :=
{ retraction := biprod.desc (biprod.inl ≫ biprod.snd) (𝟙 Y)}

instance biprod.fst_epi {X Y : C} [has_binary_biproduct X Y] :
  split_epi (biprod.fst : X ⊞ Y ⟶ X) :=
{ section_ := biprod.lift (𝟙 X) (biprod.inl ≫ biprod.snd) }

instance biprod.snd_epi {X Y : C} [has_binary_biproduct X Y] :
  split_epi (biprod.snd : X ⊞ Y ⟶ Y) :=
{ section_ := biprod.lift (biprod.inr ≫ biprod.fst) (𝟙 Y) }

@[simp,reassoc]
lemma biprod.map_fst {W X Y Z : C} [has_binary_biproduct W X] [has_binary_biproduct Y Z]
  (f : W ⟶ Y) (g : X ⟶ Z) :
  biprod.map f g ≫ biprod.fst = biprod.fst ≫ f :=
is_limit.map_π _ _ _ walking_pair.left

@[simp,reassoc]
lemma biprod.map_snd {W X Y Z : C} [has_binary_biproduct W X] [has_binary_biproduct Y Z]
  (f : W ⟶ Y) (g : X ⟶ Z) :
  biprod.map f g ≫ biprod.snd = biprod.snd ≫ g :=
is_limit.map_π _ _ _ walking_pair.right

-- Because `biprod.map` is defined in terms of `lim` rather than `colim`,
-- we need to provide additional `simp` lemmas.
@[simp,reassoc]
lemma biprod.inl_map {W X Y Z : C} [has_binary_biproduct W X] [has_binary_biproduct Y Z]
  (f : W ⟶ Y) (g : X ⟶ Z) :
  biprod.inl ≫ biprod.map f g = f ≫ biprod.inl :=
begin
  rw biprod.map_eq_map',
  exact is_colimit.ι_map (binary_biproduct.is_colimit W X) _ _ walking_pair.left
end

@[simp,reassoc]
lemma biprod.inr_map {W X Y Z : C} [has_binary_biproduct W X] [has_binary_biproduct Y Z]
  (f : W ⟶ Y) (g : X ⟶ Z) :
  biprod.inr ≫ biprod.map f g = g ≫ biprod.inr :=
begin
  rw biprod.map_eq_map',
  exact is_colimit.ι_map (binary_biproduct.is_colimit W X) _ _ walking_pair.right
end

/-- Given a pair of isomorphisms between the summands of a pair of binary biproducts,
we obtain an isomorphism between the binary biproducts. -/
@[simps]
def biprod.map_iso {W X Y Z : C} [has_binary_biproduct W X] [has_binary_biproduct Y Z]
  (f : W ≅ Y) (g : X ≅ Z) : W ⊞ X ≅ Y ⊞ Z :=
{ hom := biprod.map f.hom g.hom,
  inv := biprod.map f.inv g.inv }

section
variables [has_binary_biproducts C]

/-- The braiding isomorphism which swaps a binary biproduct. -/
@[simps] def biprod.braiding (P Q : C) : P ⊞ Q ≅ Q ⊞ P :=
{ hom := biprod.lift biprod.snd biprod.fst,
  inv := biprod.lift biprod.snd biprod.fst }

/--
An alternative formula for the braiding isomorphism which swaps a binary biproduct,
using the fact that the biproduct is a coproduct.
-/
@[simps]
def biprod.braiding' (P Q : C) : P ⊞ Q ≅ Q ⊞ P :=
{ hom := biprod.desc biprod.inr biprod.inl,
  inv := biprod.desc biprod.inr biprod.inl }

lemma biprod.braiding'_eq_braiding {P Q : C} :
  biprod.braiding' P Q = biprod.braiding P Q :=
by tidy

/-- The braiding isomorphism can be passed through a map by swapping the order. -/
@[reassoc] lemma biprod.braid_natural {W X Y Z : C} (f : X ⟶ Y) (g : Z ⟶ W) :
  biprod.map f g ≫ (biprod.braiding _ _).hom = (biprod.braiding _ _).hom ≫ biprod.map g f :=
by tidy

@[reassoc] lemma biprod.braiding_map_braiding {W X Y Z : C} (f : W ⟶ Y) (g : X ⟶ Z) :
  (biprod.braiding X W).hom ≫ biprod.map f g ≫ (biprod.braiding Y Z).hom = biprod.map g f :=
by tidy

@[simp, reassoc] lemma biprod.symmetry' (P Q : C) :
  biprod.lift biprod.snd biprod.fst ≫ biprod.lift biprod.snd biprod.fst = 𝟙 (P ⊞ Q) :=
by tidy

/-- The braiding isomorphism is symmetric. -/
@[reassoc] lemma biprod.symmetry (P Q : C) :
  (biprod.braiding P Q).hom ≫ (biprod.braiding Q P).hom = 𝟙 _ :=
by simp

end

-- TODO:
-- If someone is interested, they could provide the constructions:
--   has_binary_biproducts ↔ has_finite_biproducts

end category_theory.limits

namespace category_theory.limits

section preadditive
variables {C : Type u} [category.{v} C] [preadditive C]
variables {J : Type v} [decidable_eq J] [fintype J]

open category_theory.preadditive
open_locale big_operators

/--
In a preadditive category, we can construct a biproduct for `f : J → C` from
any bicone `b` for `f` satisfying `total : ∑ j : J, b.π j ≫ b.ι j = 𝟙 b.X`.

(That is, such a bicone is a limit cone and a colimit cocone.)
-/
lemma has_biproduct_of_total {f : J → C} (b : bicone f) (total : ∑ j : J, b.π j ≫ b.ι j = 𝟙 b.X) :
  has_biproduct f :=
has_biproduct.mk
{ bicone := b,
  is_limit :=
  { lift := λ s, ∑ j, s.π.app j ≫ b.ι j,
    uniq' := λ s m h,
    begin
      erw [←category.comp_id m, ←total, comp_sum],
      apply finset.sum_congr rfl,
      intros j m,
      erw [reassoc_of (h j)],
    end,
    fac' := λ s j,
    begin
      simp only [sum_comp, category.assoc, bicone.to_cone_π_app, b.ι_π, comp_dite],
      -- See note [dsimp, simp].
      dsimp, simp,
    end },
  is_colimit :=
  { desc := λ s, ∑ j, b.π j ≫ s.ι.app j,
    uniq' := λ s m h,
    begin
      erw [←category.id_comp m, ←total, sum_comp],
            apply finset.sum_congr rfl,
      intros j m,
      erw [category.assoc, h],
    end,
    fac' := λ s j,
    begin
      simp only [comp_sum, ←category.assoc, bicone.to_cocone_ι_app, b.ι_π, dite_comp],
      dsimp, simp,
    end } }

/-- In a preadditive category, if the product over `f : J → C` exists,
    then the biproduct over `f` exists. -/
lemma has_biproduct.of_has_product (f : J → C) [has_product f] :
  has_biproduct f :=
has_biproduct_of_total
{ X := pi_obj f,
  π := limits.pi.π f,
  ι := λ j, pi.lift (λ j', if h : j = j' then eq_to_hom (congr_arg f h) else 0),
  ι_π := λ j j', by simp, }
(by { ext, simp [sum_comp, comp_dite] })

/-- In a preadditive category, if the coproduct over `f : J → C` exists,
    then the biproduct over `f` exists. -/
lemma has_biproduct.of_has_coproduct (f : J → C) [has_coproduct f] :
  has_biproduct f :=
has_biproduct_of_total
{ X := sigma_obj f,
  π := λ j, sigma.desc (λ j', if h : j' = j then eq_to_hom (congr_arg f h) else 0),
  ι := limits.sigma.ι f,
  ι_π := λ j j', by simp, }
begin
  ext,
  simp only [comp_sum, limits.colimit.ι_desc_assoc, eq_self_iff_true,
    limits.colimit.ι_desc, category.comp_id],
  dsimp,
  simp only [dite_comp, finset.sum_dite_eq, finset.mem_univ, if_true, category.id_comp,
    eq_to_hom_refl, zero_comp],
end

/-- A preadditive category with finite products has finite biproducts. -/
lemma has_finite_biproducts.of_has_finite_products [has_finite_products C] :
  has_finite_biproducts C :=
⟨λ J _ _, { has_biproduct := λ F, by exactI has_biproduct.of_has_product _ }⟩

/-- A preadditive category with finite coproducts has finite biproducts. -/
lemma has_finite_biproducts.of_has_finite_coproducts [has_finite_coproducts C] :
  has_finite_biproducts C :=
⟨λ J _ _, { has_biproduct := λ F, by exactI has_biproduct.of_has_coproduct _ }⟩

section
variables {f : J → C} [has_biproduct f]

/--
In any preadditive category, any biproduct satsifies
`∑ j : J, biproduct.π f j ≫ biproduct.ι f j = 𝟙 (⨁ f)`
-/
@[simp] lemma biproduct.total : ∑ j : J, biproduct.π f j ≫ biproduct.ι f j = 𝟙 (⨁ f) :=
begin
  ext j j',
  simp [comp_sum, sum_comp, biproduct.ι_π, comp_dite, dite_comp],
end

lemma biproduct.lift_eq {T : C} {g : Π j, T ⟶ f j} :
  biproduct.lift g = ∑ j, g j ≫ biproduct.ι f j :=
begin
  ext j,
  simp [sum_comp, biproduct.ι_π, comp_dite],
end

lemma biproduct.desc_eq {T : C} {g : Π j, f j ⟶ T} :
  biproduct.desc g = ∑ j, biproduct.π f j ≫ g j :=
begin
  ext j,
  simp [comp_sum, biproduct.ι_π_assoc, dite_comp],
end

@[simp, reassoc] lemma biproduct.lift_desc {T U : C} {g : Π j, T ⟶ f j} {h : Π j, f j ⟶ U} :
  biproduct.lift g ≫ biproduct.desc h = ∑ j : J, g j ≫ h j :=
by simp [biproduct.lift_eq, biproduct.desc_eq, comp_sum, sum_comp, biproduct.ι_π_assoc,
  comp_dite, dite_comp]

lemma biproduct.map_eq [has_finite_biproducts C] {f g : J → C} {h : Π j, f j ⟶ g j} :
  biproduct.map h = ∑ j : J, biproduct.π f j ≫ h j ≫ biproduct.ι g j :=
begin
  ext,
  simp [biproduct.ι_π, biproduct.ι_π_assoc, comp_sum, sum_comp, comp_dite, dite_comp],
end

@[simp, reassoc]
lemma biproduct.matrix_desc
  {K : Type v} [fintype K] [decidable_eq K] [has_finite_biproducts C]
  {f : J → C} {g : K → C} (m : Π j k, f j ⟶ g k) {P} (x : Π k, g k ⟶ P) :
  biproduct.matrix m ≫ biproduct.desc x = biproduct.desc (λ j, ∑ k, m j k ≫ x k) :=
by { ext, simp, }

@[simp, reassoc]
lemma biproduct.lift_matrix
  {K : Type v} [fintype K] [decidable_eq K] [has_finite_biproducts C]
  {f : J → C} {g : K → C} {P} (x : Π j, P ⟶ f j) (m : Π j k, f j ⟶ g k)  :
  biproduct.lift x ≫ biproduct.matrix m = biproduct.lift (λ k, ∑ j, x j ≫ m j k) :=
by { ext, simp, }

@[reassoc]
lemma biproduct.matrix_map
  {K : Type v} [fintype K] [decidable_eq K] [has_finite_biproducts C]
  {f : J → C} {g : K → C} {h : K → C} (m : Π j k, f j ⟶ g k) (n : Π k, g k ⟶ h k) :
  biproduct.matrix m ≫ biproduct.map n = biproduct.matrix (λ j k, m j k ≫ n k) :=
by { ext, simp, }

@[reassoc]
lemma biproduct.map_matrix
  {K : Type v} [fintype K] [decidable_eq K] [has_finite_biproducts C]
  {f : J → C} {g : J → C} {h : K → C} (m : Π k, f k ⟶ g k) (n : Π j k, g j ⟶ h k) :
  biproduct.map m ≫ biproduct.matrix n = biproduct.matrix (λ j k, m j ≫ n j k) :=
by { ext, simp, }

end

/--
In a preadditive category, we can construct a binary biproduct for `X Y : C` from
any binary bicone `b` satisfying `total : b.fst ≫ b.inl + b.snd ≫ b.inr = 𝟙 b.X`.

(That is, such a bicone is a limit cone and a colimit cocone.)
-/
lemma has_binary_biproduct_of_total {X Y : C} (b : binary_bicone X Y)
  (total : b.fst ≫ b.inl + b.snd ≫ b.inr = 𝟙 b.X) :
  has_binary_biproduct X Y :=
has_binary_biproduct.mk
{ bicone := b,
  is_limit :=
  { lift := λ s, binary_fan.fst s ≫ b.inl +
      binary_fan.snd s ≫ b.inr,
    uniq' := λ s m h, by erw [←category.comp_id m, ←total,
      comp_add, reassoc_of (h walking_pair.left), reassoc_of (h walking_pair.right)],
    fac' := λ s j, by cases j; simp, },
  is_colimit :=
  { desc := λ s, b.fst ≫ binary_cofan.inl s +
      b.snd ≫ binary_cofan.inr s,
    uniq' := λ s m h, by erw [←category.id_comp m, ←total,
      add_comp, category.assoc, category.assoc, h walking_pair.left, h walking_pair.right],
    fac' := λ s j, by cases j; simp, } }

/-- In a preadditive category, if the product of `X` and `Y` exists, then the
    binary biproduct of `X` and `Y` exists. -/
lemma has_binary_biproduct.of_has_binary_product (X Y : C) [has_binary_product X Y] :
  has_binary_biproduct X Y :=
has_binary_biproduct_of_total
{ X := X ⨯ Y,
  fst := category_theory.limits.prod.fst,
  snd := category_theory.limits.prod.snd,
  inl := prod.lift (𝟙 X) 0,
  inr := prod.lift 0 (𝟙 Y) }
begin
  ext; simp [add_comp],
end

/-- In a preadditive category, if all binary products exist, then all binary biproducts exist. -/
lemma has_binary_biproducts.of_has_binary_products [has_binary_products C] :
  has_binary_biproducts C :=
{ has_binary_biproduct := λ X Y, has_binary_biproduct.of_has_binary_product X Y, }

/-- In a preadditive category, if the coproduct of `X` and `Y` exists, then the
    binary biproduct of `X` and `Y` exists. -/
lemma has_binary_biproduct.of_has_binary_coproduct (X Y : C) [has_binary_coproduct X Y] :
  has_binary_biproduct X Y :=
has_binary_biproduct_of_total
{ X := X ⨿ Y,
  fst := coprod.desc (𝟙 X) 0,
  snd := coprod.desc 0 (𝟙 Y),
  inl := category_theory.limits.coprod.inl,
  inr := category_theory.limits.coprod.inr }
begin
  ext; simp [add_comp],
end

/-- In a preadditive category, if all binary coproducts exist, then all binary biproducts exist. -/
lemma has_binary_biproducts.of_has_binary_coproducts [has_binary_coproducts C] :
  has_binary_biproducts C :=
{ has_binary_biproduct := λ X Y, has_binary_biproduct.of_has_binary_coproduct X Y, }

section
variables {X Y : C} [has_binary_biproduct X Y]

/--
In any preadditive category, any binary biproduct satsifies
`biprod.fst ≫ biprod.inl + biprod.snd ≫ biprod.inr = 𝟙 (X ⊞ Y)`.
-/
@[simp] lemma biprod.total : biprod.fst ≫ biprod.inl + biprod.snd ≫ biprod.inr = 𝟙 (X ⊞ Y) :=
begin
  ext; simp [add_comp],
end

lemma biprod.lift_eq {T : C} {f : T ⟶ X} {g : T ⟶ Y} :
  biprod.lift f g = f ≫ biprod.inl + g ≫ biprod.inr :=
begin
  ext; simp [add_comp],
end

lemma biprod.desc_eq {T : C} {f : X ⟶ T} {g : Y ⟶ T} :
  biprod.desc f g = biprod.fst ≫ f + biprod.snd ≫ g :=
begin
  ext; simp [add_comp],
end

@[simp, reassoc] lemma biprod.lift_desc {T U : C} {f : T ⟶ X} {g : T ⟶ Y} {h : X ⟶ U} {i : Y ⟶ U} :
  biprod.lift f g ≫ biprod.desc h i = f ≫ h + g ≫ i :=
by simp [biprod.lift_eq, biprod.desc_eq]

lemma biprod.map_eq [has_binary_biproducts C] {W X Y Z : C} {f : W ⟶ Y} {g : X ⟶ Z} :
  biprod.map f g = biprod.fst ≫ f ≫ biprod.inl + biprod.snd ≫ g ≫ biprod.inr :=
by apply biprod.hom_ext; apply biprod.hom_ext'; simp

end

end preadditive

end category_theory.limits


/-
Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.pi
import Mathlib.data.prod
import Mathlib.logic.unique
import Mathlib.logic.function.basic
import Mathlib.PostPort

universes u_3 l u_1 u_2 u_4

namespace Mathlib

/-!
# Nontrivial types

A type is *nontrivial* if it contains at least two elements. This is useful in particular for rings
(where it is equivalent to the fact that zero is different from one) and for vector spaces
(where it is equivalent to the fact that the dimension is positive).

We introduce a typeclass `nontrivial` formalizing this property.
-/

/-- Predicate typeclass for expressing that a type is not reduced to a single element. In rings,
this is equivalent to `0 ≠ 1`. In vector spaces, this is equivalent to positive dimension. -/
class nontrivial (α : Type u_3)
where
  exists_pair_ne : ∃ (x : α), ∃ (y : α), x ≠ y

theorem nontrivial_iff {α : Type u_1} : nontrivial α ↔ ∃ (x : α), ∃ (y : α), x ≠ y :=
  { mp := fun (h : nontrivial α) => nontrivial.exists_pair_ne,
    mpr := fun (h : ∃ (x : α), ∃ (y : α), x ≠ y) => nontrivial.mk h }

theorem exists_pair_ne (α : Type u_1) [nontrivial α] : ∃ (x : α), ∃ (y : α), x ≠ y :=
  nontrivial.exists_pair_ne

theorem exists_ne {α : Type u_1} [nontrivial α] (x : α) : ∃ (y : α), y ≠ x := sorry

-- `x` and `y` are explicit here, as they are often needed to guide typechecking of `h`.

theorem nontrivial_of_ne {α : Type u_1} (x : α) (y : α) (h : x ≠ y) : nontrivial α :=
  nontrivial.mk (Exists.intro x (Exists.intro y h))

-- `x` and `y` are explicit here, as they are often needed to guide typechecking of `h`.

theorem nontrivial_of_lt {α : Type u_1} [preorder α] (x : α) (y : α) (h : x < y) : nontrivial α :=
  nontrivial.mk (Exists.intro x (Exists.intro y (ne_of_lt h)))

protected instance nontrivial.to_nonempty {α : Type u_1} [nontrivial α] : Nonempty α :=
  sorry

/-- An inhabited type is either nontrivial, or has a unique element. -/
def nontrivial_psum_unique (α : Type u_1) [Inhabited α] : psum (nontrivial α) (unique α) :=
  dite (nontrivial α) (fun (h : nontrivial α) => psum.inl h)
    fun (h : ¬nontrivial α) => psum.inr (unique.mk { default := Inhabited.default } sorry)

theorem subsingleton_iff {α : Type u_1} : subsingleton α ↔ ∀ (x y : α), x = y :=
  { mp := fun (h : subsingleton α) => subsingleton.elim, mpr := fun (h : ∀ (x y : α), x = y) => subsingleton.intro h }

theorem not_nontrivial_iff_subsingleton {α : Type u_1} : ¬nontrivial α ↔ subsingleton α := sorry

theorem not_subsingleton (α : Type u_1) [h : nontrivial α] : ¬subsingleton α := sorry

/-- A type is either a subsingleton or nontrivial. -/
theorem subsingleton_or_nontrivial (α : Type u_1) : subsingleton α ∨ nontrivial α :=
  eq.mpr (id (Eq._oldrec (Eq.refl (subsingleton α ∨ nontrivial α)) (Eq.symm (propext not_nontrivial_iff_subsingleton))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (¬nontrivial α ∨ nontrivial α)) (propext (or_comm (¬nontrivial α) (nontrivial α)))))
      (classical.em (nontrivial α)))

theorem false_of_nontrivial_of_subsingleton (α : Type u_1) [nontrivial α] [subsingleton α] : False := sorry

protected instance option.nontrivial {α : Type u_1} [Nonempty α] : nontrivial (Option α) :=
  nonempty.elim_to_inhabited
    fun (inst : Inhabited α) =>
      nontrivial.mk
        (Exists.intro none
          (Exists.intro (some Inhabited.default)
            (id (id fun (ᾰ : none = some Inhabited.default) => option.no_confusion ᾰ))))

/-- Pushforward a `nontrivial` instance along an injective function. -/
protected theorem function.injective.nontrivial {α : Type u_1} {β : Type u_2} [nontrivial α] {f : α → β} (hf : function.injective f) : nontrivial β := sorry

/-- Pullback a `nontrivial` instance along a surjective function. -/
protected theorem function.surjective.nontrivial {α : Type u_1} {β : Type u_2} [nontrivial β] {f : α → β} (hf : function.surjective f) : nontrivial α := sorry

/-- An injective function from a nontrivial type has an argument at
which it does not take a given value. -/
protected theorem function.injective.exists_ne {α : Type u_1} {β : Type u_2} [nontrivial α] {f : α → β} (hf : function.injective f) (y : β) : ∃ (x : α), f x ≠ y := sorry

protected instance nontrivial_prod_right {α : Type u_1} {β : Type u_2} [Nonempty α] [nontrivial β] : nontrivial (α × β) :=
  function.surjective.nontrivial prod.snd_surjective

protected instance nontrivial_prod_left {α : Type u_1} {β : Type u_2} [nontrivial α] [Nonempty β] : nontrivial (α × β) :=
  function.surjective.nontrivial prod.fst_surjective

namespace pi

/-- A pi type is nontrivial if it's nonempty everywhere and nontrivial somewhere. -/
theorem nontrivial_at {I : Type u_3} {f : I → Type u_4} (i' : I) [inst : ∀ (i : I), Nonempty (f i)] [nontrivial (f i')] : nontrivial ((i : I) → f i) :=
  function.injective.nontrivial (function.update_injective (fun (i : I) => Classical.choice (inst i)) i')

/--
As a convenience, provide an instance automatically if `(f (default I))` is nontrivial.

If a different index has the non-trivial type, then use `haveI := nontrivial_at that_index`.
-/
protected instance nontrivial {I : Type u_3} {f : I → Type u_4} [Inhabited I] [inst : ∀ (i : I), Nonempty (f i)] [nontrivial (f Inhabited.default)] : nontrivial ((i : I) → f i) :=
  nontrivial_at Inhabited.default

end pi

protected instance function.nontrivial {α : Type u_1} {β : Type u_2} [h : Nonempty α] [nontrivial β] : nontrivial (α → β) :=
  nonempty.elim h fun (a : α) => pi.nontrivial_at a

protected theorem subsingleton.le {α : Type u_1} [preorder α] [subsingleton α] (x : α) (y : α) : x ≤ y :=
  le_of_eq (subsingleton.elim x y)

namespace tactic

/--
Tries to generate a `nontrivial α` instance by performing case analysis on
`subsingleton_or_nontrivial α`,
attempting to discharge the subsingleton branch using lemmas with `@[nontriviality]` attribute,
including `subsingleton.le` and `eq_iff_true_of_subsingleton`.
-/
/--
Tries to generate a `nontrivial α` instance using `nontrivial_of_ne` or `nontrivial_of_lt`
and local hypotheses.
-/
end tactic

namespace tactic.interactive

/--
Attempts to generate a `nontrivial α` hypothesis.

The tactic first looks for an instance using `apply_instance`.

If the goal is an (in)equality, the type `α` is inferred from the goal.
Otherwise, the type needs to be specified in the tactic invocation, as `nontriviality α`.

The `nontriviality` tactic will first look for strict inequalities amongst the hypotheses,
and use these to derive the `nontrivial` instance directly.

Otherwise, it will perform a case split on `subsingleton α ∨ nontrivial α`, and attempt to discharge
the `subsingleton` goal using `simp [lemmas] with nontriviality`, where `[lemmas]` is a list of
additional `simp` lemmas that can be passed to `nontriviality` using the syntax
`nontriviality α using [lemmas]`.

```
example {R : Type} [ordered_ring R] {a : R} (h : 0 < a) : 0 < a :=
begin
  nontriviality, -- There is now a `nontrivial R` hypothesis available.
  assumption,
end
```

```
example {R : Type} [comm_ring R] {r s : R} : r * s = s * r :=
begin
  nontriviality, -- There is now a `nontrivial R` hypothesis available.
  apply mul_comm,
end
```

```
example {R : Type} [ordered_ring R] {a : R} (h : 0 < a) : (2 : ℕ) ∣ 4 :=
begin
  nontriviality R, -- there is now a `nontrivial R` hypothesis available.
  dec_trivial
end
```

```
def myeq {α : Type} (a b : α) : Prop := a = b

example {α : Type} (a b : α) (h : a = b) : myeq a b :=
begin
  success_if_fail { nontriviality α }, -- Fails
  nontriviality α using [myeq], -- There is now a `nontrivial α` hypothesis available
  assumption
end
```
-/
end tactic.interactive

namespace bool

protected instance nontrivial : nontrivial Bool :=
  nontrivial.mk (Exists.intro tt (Exists.intro false tt_eq_ff_eq_false))


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.list.forall2

/-!
# List sections

This file proves some stuff about `list.sections` (definition in `data.list.defs`). A section of a
list of lists `[l₁, ..., lₙ]` is a list whose `i`-th element comes from the `i`-th list.
-/

open nat function

namespace list
variables {α β : Type*}

theorem mem_sections {L : list (list α)} {f} : f ∈ sections L ↔ forall₂ (∈) f L :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { induction L generalizing f, {cases mem_singleton.1 h, exact forall₂.nil},
    simp only [sections, bind_eq_bind, mem_bind, mem_map] at h,
    rcases h with ⟨_, _, _, _, rfl⟩,
    simp only [*, forall₂_cons, true_and] },
  { induction h with a l f L al fL fs, {exact or.inl rfl},
    simp only [sections, bind_eq_bind, mem_bind, mem_map],
    exact ⟨_, fs, _, al, rfl, rfl⟩ }
end

theorem mem_sections_length {L : list (list α)} {f} (h : f ∈ sections L) : length f = length L :=
forall₂_length_eq (mem_sections.1 h)

lemma rel_sections {r : α → β → Prop} :
  (forall₂ (forall₂ r) ⇒ forall₂ (forall₂ r)) sections sections
| _ _ forall₂.nil := forall₂.cons forall₂.nil forall₂.nil
| _ _ (forall₂.cons h₀ h₁) :=
  rel_bind (rel_sections h₁) (assume _ _ hl, rel_map (assume _ _ ha, forall₂.cons ha hl) h₀)

end list


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Ken Lee, Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.ring
import Mathlib.algebra.big_operators.basic
import Mathlib.data.fintype.basic
import Mathlib.data.int.gcd
import Mathlib.data.set.disjointed
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# Coprime elements of a ring

## Main definitions

* `is_coprime x y`: that `x` and `y` are coprime, defined to be the existence of `a` and `b` such
that `a * x + b * y = 1`. Note that elements with no common divisors are not necessarily coprime,
e.g., the multivariate polynomials `x₁` and `x₂` are not coprime.

-/

/-- The proposition that `x` and `y` are coprime, defined to be the existence of `a` and `b` such
that `a * x + b * y = 1`. Note that elements with no common divisors are not necessarily coprime,
e.g., the multivariate polynomials `x₁` and `x₂` are not coprime. -/
@[simp] def is_coprime {R : Type u} [comm_semiring R] (x : R) (y : R) :=
  ∃ (a : R), ∃ (b : R), a * x + b * y = 1

theorem nat.is_coprime_iff_coprime {m : ℕ} {n : ℕ} : is_coprime ↑m ↑n ↔ nat.coprime m n := sorry

theorem is_coprime.symm {R : Type u} [comm_semiring R] {x : R} {y : R} (H : is_coprime x y) : is_coprime y x := sorry

theorem is_coprime_comm {R : Type u} [comm_semiring R] {x : R} {y : R} : is_coprime x y ↔ is_coprime y x :=
  { mp := is_coprime.symm, mpr := is_coprime.symm }

theorem is_coprime_self {R : Type u} [comm_semiring R] {x : R} : is_coprime x x ↔ is_unit x := sorry

theorem is_coprime_zero_left {R : Type u} [comm_semiring R] {x : R} : is_coprime 0 x ↔ is_unit x := sorry

theorem is_coprime_zero_right {R : Type u} [comm_semiring R] {x : R} : is_coprime x 0 ↔ is_unit x :=
  iff.trans is_coprime_comm is_coprime_zero_left

theorem is_coprime_one_left {R : Type u} [comm_semiring R] {x : R} : is_coprime 1 x := sorry

theorem is_coprime_one_right {R : Type u} [comm_semiring R] {x : R} : is_coprime x 1 := sorry

theorem is_coprime.dvd_of_dvd_mul_right {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} (H1 : is_coprime x z) (H2 : x ∣ y * z) : x ∣ y := sorry

theorem is_coprime.dvd_of_dvd_mul_left {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} (H1 : is_coprime x y) (H2 : x ∣ y * z) : x ∣ z := sorry

theorem is_coprime.mul_left {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} (H1 : is_coprime x z) (H2 : is_coprime y z) : is_coprime (x * y) z := sorry

theorem is_coprime.mul_right {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} (H1 : is_coprime x y) (H2 : is_coprime x z) : is_coprime x (y * z) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime x (y * z))) (propext is_coprime_comm)))
    (is_coprime.mul_left (eq.mp (Eq._oldrec (Eq.refl (is_coprime x y)) (propext is_coprime_comm)) H1)
      (eq.mp (Eq._oldrec (Eq.refl (is_coprime x z)) (propext is_coprime_comm)) H2))

theorem is_coprime.prod_left {R : Type u} [comm_semiring R] {x : R} {I : Type v} {s : I → R} {t : finset I} : (∀ (i : I), i ∈ t → is_coprime (s i) x) → is_coprime (finset.prod t fun (i : I) => s i) x := sorry

theorem is_coprime.prod_right {R : Type u} [comm_semiring R] {x : R} {I : Type v} {s : I → R} {t : finset I} : (∀ (i : I), i ∈ t → is_coprime x (s i)) → is_coprime x (finset.prod t fun (i : I) => s i) := sorry

theorem is_coprime.mul_dvd {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} (H : is_coprime x y) (H1 : x ∣ z) (H2 : y ∣ z) : x * y ∣ z := sorry

theorem finset.prod_dvd_of_coprime {R : Type u} [comm_semiring R] {z : R} {I : Type v} {s : I → R} {t : finset I} (Hs : set.pairwise_on (↑t) (is_coprime on s)) (Hs1 : ∀ (i : I), i ∈ t → s i ∣ z) : (finset.prod t fun (x : I) => s x) ∣ z := sorry

theorem fintype.prod_dvd_of_coprime {R : Type u} [comm_semiring R] {z : R} {I : Type v} {s : I → R} [fintype I] (Hs : pairwise (is_coprime on s)) (Hs1 : ∀ (i : I), s i ∣ z) : (finset.prod finset.univ fun (x : I) => s x) ∣ z :=
  finset.prod_dvd_of_coprime (pairwise.pairwise_on Hs ↑finset.univ) fun (i : I) (_x : i ∈ finset.univ) => Hs1 i

theorem is_coprime.of_mul_left_left {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} (H : is_coprime (x * y) z) : is_coprime x z := sorry

theorem is_coprime.of_mul_left_right {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} (H : is_coprime (x * y) z) : is_coprime y z :=
  is_coprime.of_mul_left_left (eq.mp (Eq._oldrec (Eq.refl (is_coprime (x * y) z)) (mul_comm x y)) H)

theorem is_coprime.of_mul_right_left {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} (H : is_coprime x (y * z)) : is_coprime x y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime x y)) (propext is_coprime_comm)))
    (is_coprime.of_mul_left_left (eq.mp (Eq._oldrec (Eq.refl (is_coprime x (y * z))) (propext is_coprime_comm)) H))

theorem is_coprime.of_mul_right_right {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} (H : is_coprime x (y * z)) : is_coprime x z :=
  is_coprime.of_mul_right_left (eq.mp (Eq._oldrec (Eq.refl (is_coprime x (y * z))) (mul_comm y z)) H)

theorem is_coprime.mul_left_iff {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} : is_coprime (x * y) z ↔ is_coprime x z ∧ is_coprime y z := sorry

theorem is_coprime.mul_right_iff {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} : is_coprime x (y * z) ↔ is_coprime x y ∧ is_coprime x z := sorry

theorem is_coprime.prod_left_iff {R : Type u} [comm_semiring R] {x : R} {I : Type v} {s : I → R} {t : finset I} : is_coprime (finset.prod t fun (i : I) => s i) x ↔ ∀ (i : I), i ∈ t → is_coprime (s i) x := sorry

theorem is_coprime.prod_right_iff {R : Type u} [comm_semiring R] {x : R} {I : Type v} {s : I → R} {t : finset I} : is_coprime x (finset.prod t fun (i : I) => s i) ↔ ∀ (i : I), i ∈ t → is_coprime x (s i) := sorry

theorem is_coprime.of_prod_left {R : Type u} [comm_semiring R] {x : R} {I : Type v} {s : I → R} {t : finset I} (H1 : is_coprime (finset.prod t fun (i : I) => s i) x) (i : I) (hit : i ∈ t) : is_coprime (s i) x :=
  iff.mp is_coprime.prod_left_iff H1 i hit

theorem is_coprime.of_prod_right {R : Type u} [comm_semiring R] {x : R} {I : Type v} {s : I → R} {t : finset I} (H1 : is_coprime x (finset.prod t fun (i : I) => s i)) (i : I) (hit : i ∈ t) : is_coprime x (s i) :=
  iff.mp is_coprime.prod_right_iff H1 i hit

theorem is_coprime.pow_left {R : Type u} [comm_semiring R] {x : R} {y : R} {m : ℕ} (H : is_coprime x y) : is_coprime (x ^ m) y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime (x ^ m) y)) (Eq.symm (finset.card_range m))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime (x ^ finset.card (finset.range m)) y)) (Eq.symm (finset.prod_const x))))
      (is_coprime.prod_left fun (_x : ℕ) (_x : _x ∈ finset.range m) => H))

theorem is_coprime.pow_right {R : Type u} [comm_semiring R] {x : R} {y : R} {n : ℕ} (H : is_coprime x y) : is_coprime x (y ^ n) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime x (y ^ n))) (Eq.symm (finset.card_range n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime x (y ^ finset.card (finset.range n)))) (Eq.symm (finset.prod_const y))))
      (is_coprime.prod_right fun (_x : ℕ) (_x : _x ∈ finset.range n) => H))

theorem is_coprime.pow {R : Type u} [comm_semiring R] {x : R} {y : R} {m : ℕ} {n : ℕ} (H : is_coprime x y) : is_coprime (x ^ m) (y ^ n) :=
  is_coprime.pow_right (is_coprime.pow_left H)

theorem is_coprime.is_unit_of_dvd {R : Type u} [comm_semiring R] {x : R} {y : R} (H : is_coprime x y) (d : x ∣ y) : is_unit x := sorry

theorem is_coprime.map {R : Type u} [comm_semiring R] {x : R} {y : R} (H : is_coprime x y) {S : Type v} [comm_semiring S] (f : R →+* S) : is_coprime (coe_fn f x) (coe_fn f y) := sorry

theorem is_coprime.of_add_mul_left_left {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} (h : is_coprime (x + y * z) y) : is_coprime x y := sorry

theorem is_coprime.of_add_mul_right_left {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} (h : is_coprime (x + z * y) y) : is_coprime x y :=
  is_coprime.of_add_mul_left_left (eq.mp (Eq._oldrec (Eq.refl (is_coprime (x + z * y) y)) (mul_comm z y)) h)

theorem is_coprime.of_add_mul_left_right {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} (h : is_coprime x (y + x * z)) : is_coprime x y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime x y)) (propext is_coprime_comm)))
    (is_coprime.of_add_mul_left_left
      (eq.mp (Eq._oldrec (Eq.refl (is_coprime x (y + x * z))) (propext is_coprime_comm)) h))

theorem is_coprime.of_add_mul_right_right {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} (h : is_coprime x (y + z * x)) : is_coprime x y :=
  is_coprime.of_add_mul_left_right (eq.mp (Eq._oldrec (Eq.refl (is_coprime x (y + z * x))) (mul_comm z x)) h)

theorem is_coprime.of_mul_add_left_left {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} (h : is_coprime (y * z + x) y) : is_coprime x y :=
  is_coprime.of_add_mul_left_left (eq.mp (Eq._oldrec (Eq.refl (is_coprime (y * z + x) y)) (add_comm (y * z) x)) h)

theorem is_coprime.of_mul_add_right_left {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} (h : is_coprime (z * y + x) y) : is_coprime x y :=
  is_coprime.of_add_mul_right_left (eq.mp (Eq._oldrec (Eq.refl (is_coprime (z * y + x) y)) (add_comm (z * y) x)) h)

theorem is_coprime.of_mul_add_left_right {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} (h : is_coprime x (x * z + y)) : is_coprime x y :=
  is_coprime.of_add_mul_left_right (eq.mp (Eq._oldrec (Eq.refl (is_coprime x (x * z + y))) (add_comm (x * z) y)) h)

theorem is_coprime.of_mul_add_right_right {R : Type u} [comm_semiring R] {x : R} {y : R} {z : R} (h : is_coprime x (z * x + y)) : is_coprime x y :=
  is_coprime.of_add_mul_right_right (eq.mp (Eq._oldrec (Eq.refl (is_coprime x (z * x + y))) (add_comm (z * x) y)) h)

namespace is_coprime

theorem add_mul_left_left {R : Type u} [comm_ring R] {x : R} {y : R} (h : is_coprime x y) (z : R) : is_coprime (x + y * z) y := sorry

theorem add_mul_right_left {R : Type u} [comm_ring R] {x : R} {y : R} (h : is_coprime x y) (z : R) : is_coprime (x + z * y) y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime (x + z * y) y)) (mul_comm z y))) (add_mul_left_left h z)

theorem add_mul_left_right {R : Type u} [comm_ring R] {x : R} {y : R} (h : is_coprime x y) (z : R) : is_coprime x (y + x * z) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime x (y + x * z))) (propext is_coprime_comm))) (add_mul_left_left (symm h) z)

theorem add_mul_right_right {R : Type u} [comm_ring R] {x : R} {y : R} (h : is_coprime x y) (z : R) : is_coprime x (y + z * x) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime x (y + z * x))) (propext is_coprime_comm))) (add_mul_right_left (symm h) z)

theorem mul_add_left_left {R : Type u} [comm_ring R] {x : R} {y : R} (h : is_coprime x y) (z : R) : is_coprime (y * z + x) y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime (y * z + x) y)) (add_comm (y * z) x))) (add_mul_left_left h z)

theorem mul_add_right_left {R : Type u} [comm_ring R] {x : R} {y : R} (h : is_coprime x y) (z : R) : is_coprime (z * y + x) y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime (z * y + x) y)) (add_comm (z * y) x))) (add_mul_right_left h z)

theorem mul_add_left_right {R : Type u} [comm_ring R] {x : R} {y : R} (h : is_coprime x y) (z : R) : is_coprime x (x * z + y) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime x (x * z + y))) (add_comm (x * z) y))) (add_mul_left_right h z)

theorem mul_add_right_right {R : Type u} [comm_ring R] {x : R} {y : R} (h : is_coprime x y) (z : R) : is_coprime x (z * x + y) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime x (z * x + y))) (add_comm (z * x) y))) (add_mul_right_right h z)

theorem add_mul_left_left_iff {R : Type u} [comm_ring R] {x : R} {y : R} {z : R} : is_coprime (x + y * z) y ↔ is_coprime x y :=
  { mp := of_add_mul_left_left, mpr := fun (h : is_coprime x y) => add_mul_left_left h z }

theorem add_mul_right_left_iff {R : Type u} [comm_ring R] {x : R} {y : R} {z : R} : is_coprime (x + z * y) y ↔ is_coprime x y :=
  { mp := of_add_mul_right_left, mpr := fun (h : is_coprime x y) => add_mul_right_left h z }

theorem add_mul_left_right_iff {R : Type u} [comm_ring R] {x : R} {y : R} {z : R} : is_coprime x (y + x * z) ↔ is_coprime x y :=
  { mp := of_add_mul_left_right, mpr := fun (h : is_coprime x y) => add_mul_left_right h z }

theorem add_mul_right_right_iff {R : Type u} [comm_ring R] {x : R} {y : R} {z : R} : is_coprime x (y + z * x) ↔ is_coprime x y :=
  { mp := of_add_mul_right_right, mpr := fun (h : is_coprime x y) => add_mul_right_right h z }

theorem mul_add_left_left_iff {R : Type u} [comm_ring R] {x : R} {y : R} {z : R} : is_coprime (y * z + x) y ↔ is_coprime x y :=
  { mp := of_mul_add_left_left, mpr := fun (h : is_coprime x y) => mul_add_left_left h z }

theorem mul_add_right_left_iff {R : Type u} [comm_ring R] {x : R} {y : R} {z : R} : is_coprime (z * y + x) y ↔ is_coprime x y :=
  { mp := of_mul_add_right_left, mpr := fun (h : is_coprime x y) => mul_add_right_left h z }

theorem mul_add_left_right_iff {R : Type u} [comm_ring R] {x : R} {y : R} {z : R} : is_coprime x (x * z + y) ↔ is_coprime x y :=
  { mp := of_mul_add_left_right, mpr := fun (h : is_coprime x y) => mul_add_left_right h z }

theorem mul_add_right_right_iff {R : Type u} [comm_ring R] {x : R} {y : R} {z : R} : is_coprime x (z * x + y) ↔ is_coprime x y :=
  { mp := of_mul_add_right_right, mpr := fun (h : is_coprime x y) => mul_add_right_right h z }


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import topology.sheaves.presheaf
import category_theory.adjunction.fully_faithful

/-!
# Presheafed spaces

Introduces the category of topological spaces equipped with a presheaf (taking values in an
arbitrary target category `C`.)

We further describe how to apply functors and natural transformations to the values of the
presheaves.
-/

universes v u

open category_theory
open Top
open topological_space
open opposite
open category_theory.category category_theory.functor

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

local attribute [tidy] tactic.op_induction'

namespace algebraic_geometry

/-- A `PresheafedSpace C` is a topological space equipped with a presheaf of `C`s. -/
structure PresheafedSpace :=
(carrier : Top)
(presheaf : carrier.presheaf C)

variables {C}

namespace PresheafedSpace

attribute [protected] presheaf

instance coe_carrier : has_coe (PresheafedSpace C) Top :=
{ coe := λ X, X.carrier }

@[simp] lemma as_coe (X : PresheafedSpace C) : X.carrier = (X : Top.{v}) := rfl
@[simp] lemma mk_coe (carrier) (presheaf) : (({ carrier := carrier, presheaf := presheaf } :
  PresheafedSpace.{v} C) : Top.{v}) = carrier := rfl

instance (X : PresheafedSpace.{v} C) : topological_space X := X.carrier.str

/-- The constant presheaf on `X` with value `Z`. -/
def const (X : Top) (Z : C) : PresheafedSpace C :=
{ carrier := X,
  presheaf :=
  { obj := λ U, Z,
    map := λ U V f, 𝟙 Z, } }

instance [inhabited C] : inhabited (PresheafedSpace C) := ⟨const (Top.of pempty) default⟩

/-- A morphism between presheafed spaces `X` and `Y` consists of a continuous map
    `f` between the underlying topological spaces, and a (notice contravariant!) map
    from the presheaf on `Y` to the pushforward of the presheaf on `X` via `f`. -/
structure hom (X Y : PresheafedSpace C) :=
(base : (X : Top.{v}) ⟶ (Y : Top.{v}))
(c : Y.presheaf ⟶ base _* X.presheaf)

@[ext] lemma ext {X Y : PresheafedSpace C} (α β : hom X Y)
  (w : α.base = β.base)
  (h : α.c ≫ (whisker_right (eq_to_hom (by rw w)) _) = β.c) :
  α = β :=
begin
  cases α, cases β,
  dsimp [presheaf.pushforward_obj] at *,
  tidy, -- TODO including `injections` would make tidy work earlier.
end

lemma hext {X Y : PresheafedSpace C} (α β : hom X Y)
  (w : α.base = β.base)
  (h : α.c == β.c) :
  α = β :=
by { cases α, cases β, congr, exacts [w,h] }

.

/-- The identity morphism of a `PresheafedSpace`. -/
def id (X : PresheafedSpace C) : hom X X :=
{ base := 𝟙 (X : Top.{v}),
  c := eq_to_hom (presheaf.pushforward.id_eq X.presheaf).symm }

instance hom_inhabited (X : PresheafedSpace C) : inhabited (hom X X) := ⟨id X⟩

/-- Composition of morphisms of `PresheafedSpace`s. -/
def comp {X Y Z : PresheafedSpace C} (α : hom X Y) (β : hom Y Z) : hom X Z :=
{ base := α.base ≫ β.base,
  c := β.c ≫ (presheaf.pushforward _ β.base).map α.c }

lemma comp_c {X Y Z : PresheafedSpace C} (α : hom X Y) (β : hom Y Z) :
  (comp α β).c = β.c ≫ (presheaf.pushforward _ β.base).map α.c := rfl

variables (C)

section
local attribute [simp] id comp

/- The proofs below can be done by `tidy`, but it is too slow,
   and we don't have a tactic caching mechanism. -/
/-- The category of PresheafedSpaces. Morphisms are pairs, a continuous map and a presheaf map
    from the presheaf on the target to the pushforward of the presheaf on the source. -/
instance category_of_PresheafedSpaces : category (PresheafedSpace C) :=
{ hom := hom,
  id := id,
  comp := λ X Y Z f g, comp f g,
  id_comp' := λ X Y f, begin
    ext1,
    { rw comp_c,
      erw eq_to_hom_map,
      simp only [eq_to_hom_refl, assoc, whisker_right_id'],
      erw [comp_id, comp_id] },
    apply id_comp
  end,
  comp_id' := λ X Y f, begin
    ext1,
    { rw comp_c,
      erw congr_hom (presheaf.id_pushforward _) f.c,
      simp only [comp_id, functor.id_map, eq_to_hom_refl, assoc, whisker_right_id'],
      erw eq_to_hom_trans_assoc,
      simp only [id_comp, eq_to_hom_refl],
      erw comp_id },
    apply comp_id
  end,
  assoc' := λ W X Y Z f g h, begin
    ext1,
    repeat {rw comp_c},
    simp only [eq_to_hom_refl, assoc, functor.map_comp, whisker_right_id'],
    erw comp_id,
    congr,
    refl
  end }

end

variables {C}

@[simp] lemma id_base (X : PresheafedSpace C) :
  ((𝟙 X) : X ⟶ X).base = 𝟙 (X : Top.{v}) := rfl

lemma id_c (X : PresheafedSpace C) :
  ((𝟙 X) : X ⟶ X).c = eq_to_hom (presheaf.pushforward.id_eq X.presheaf).symm := rfl

@[simp] lemma id_c_app (X : PresheafedSpace C) (U) :
  ((𝟙 X) : X ⟶ X).c.app U = X.presheaf.map
    (eq_to_hom (by { induction U using opposite.rec, cases U, refl })) :=
by { induction U using opposite.rec, cases U, simp only [id_c], dsimp, simp, }

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

instance (X Y : PresheafedSpace C) : has_coe_to_fun (X ⟶ Y) (λ _, X → Y) :=
⟨λ f, f.base⟩

lemma coe_to_fun_eq {X Y : PresheafedSpace C} (f : X ⟶ Y) : (f : X → Y) = f.base := rfl

-- The `reassoc` attribute was added despite the LHS not being a composition of two homs,
-- for the reasons explained in the docstring.
/-- Sometimes rewriting with `comp_c_app` doesn't work because of dependent type issues.
In that case, `erw comp_c_app_assoc` might make progress.
The lemma `comp_c_app_assoc` is also better suited for rewrites in the opposite direction. -/
@[reassoc, simp] lemma comp_c_app {X Y Z : PresheafedSpace C} (α : X ⟶ Y) (β : Y ⟶ Z) (U) :
  (α ≫ β).c.app U = (β.c).app U ≫ (α.c).app (op ((opens.map (β.base)).obj (unop U))) := rfl

lemma congr_app {X Y : PresheafedSpace C} {α β : X ⟶ Y} (h : α = β) (U) :
  α.c.app U = β.c.app U ≫ X.presheaf.map (eq_to_hom (by subst h)) :=
by { subst h, dsimp, simp, }

section
variables (C)

/-- The forgetful functor from `PresheafedSpace` to `Top`. -/
@[simps]
def forget : PresheafedSpace C ⥤ Top :=
{ obj := λ X, (X : Top.{v}),
  map := λ X Y f, f.base }

end

section iso

variables {X Y : PresheafedSpace C}

/--
An isomorphism of PresheafedSpaces is a homeomorphism of the underlying space, and a
natural transformation between the sheaves.
-/
@[simps hom inv]
def iso_of_components (H : X.1 ≅ Y.1) (α : H.hom _* X.2 ≅ Y.2) : X ≅ Y :=
{ hom := { base := H.hom, c := α.inv },
  inv := { base := H.inv,
    c := presheaf.to_pushforward_of_iso H α.hom },
  hom_inv_id' := by { ext, { simp, erw category.id_comp, simpa }, simp },
  inv_hom_id' :=
  begin
    ext x,
    induction x using opposite.rec,
    simp only [comp_c_app, whisker_right_app, presheaf.to_pushforward_of_iso_app,
      nat_trans.comp_app, eq_to_hom_app, id_c_app, category.assoc],
    erw [← α.hom.naturality],
    have := nat_trans.congr_app (α.inv_hom_id) (op x),
    cases x,
    rw nat_trans.comp_app at this,
    convert this,
    { dsimp, simp },
    { simp },
    { simp }
  end }

/-- Isomorphic PresheafedSpaces have natural isomorphic presheaves. -/
@[simps]
def sheaf_iso_of_iso (H : X ≅ Y) : Y.2 ≅ H.hom.base _* X.2 :=
{ hom := H.hom.c,
  inv := presheaf.pushforward_to_of_iso ((forget _).map_iso H).symm H.inv.c,
  hom_inv_id' :=
  begin
    ext U,
    have := congr_app H.inv_hom_id U,
    simp only [comp_c_app, id_c_app,
      eq_to_hom_map, eq_to_hom_trans] at this,
    generalize_proofs h at this,
    simpa using congr_arg (λ f, f ≫ eq_to_hom h.symm) this,
  end,
  inv_hom_id' :=
  begin
    ext U,
    simp only [presheaf.pushforward_to_of_iso_app, nat_trans.comp_app, category.assoc,
      nat_trans.id_app, H.hom.c.naturality],
    have := congr_app H.hom_inv_id ((opens.map H.hom.base).op.obj U),
    generalize_proofs h at this,
    simpa using congr_arg (λ f, f ≫ X.presheaf.map (eq_to_hom h.symm)) this
  end }

instance base_is_iso_of_iso (f : X ⟶ Y) [is_iso f] : is_iso f.base :=
is_iso.of_iso ((forget _).map_iso (as_iso f))

instance c_is_iso_of_iso (f : X ⟶ Y) [is_iso f] : is_iso f.c :=
is_iso.of_iso (sheaf_iso_of_iso (as_iso f))

/-- This could be used in conjunction with `category_theory.nat_iso.is_iso_of_is_iso_app`. -/
lemma is_iso_of_components (f : X ⟶ Y) [is_iso f.base] [is_iso f.c] : is_iso f :=
begin
  convert is_iso.of_iso (iso_of_components (as_iso f.base) (as_iso f.c).symm),
  ext, { simpa }, { simp },
end

end iso

section restrict

/--
The restriction of a presheafed space along an open embedding into the space.
-/
@[simps]
def restrict {U : Top} (X : PresheafedSpace C)
  {f : U ⟶ (X : Top.{v})} (h : open_embedding f) : PresheafedSpace C :=
{ carrier := U,
  presheaf := h.is_open_map.functor.op ⋙ X.presheaf }

/--
The map from the restriction of a presheafed space.
-/
@[simps]
def of_restrict {U : Top} (X : PresheafedSpace C)
  {f : U ⟶ (X : Top.{v})} (h : open_embedding f) :
  X.restrict h ⟶ X :=
{ base := f,
  c := { app := λ V, X.presheaf.map (h.is_open_map.adjunction.counit.app V.unop).op,
    naturality' := λ U V f, show _ = _ ≫ X.presheaf.map _,
      by { rw [← map_comp, ← map_comp], refl } } }

instance of_restrict_mono {U : Top} (X : PresheafedSpace C) (f : U ⟶ X.1)
   (hf : open_embedding f) : mono (X.of_restrict hf) :=
 begin
   haveI : mono f := (Top.mono_iff_injective _).mpr hf.inj,
   constructor,
   intros Z g₁ g₂ eq,
   ext V,
   { induction V using opposite.rec,
     have hV : (opens.map (X.of_restrict hf).base).obj (hf.is_open_map.functor.obj V) = V,
     { cases V, simp[opens.map, set.preimage_image_eq _ hf.inj] },
     haveI : is_iso (hf.is_open_map.adjunction.counit.app
               (unop (op (hf.is_open_map.functor.obj V)))) :=
       (nat_iso.is_iso_app_of_is_iso (whisker_left
         hf.is_open_map.functor hf.is_open_map.adjunction.counit) V : _),
     have := PresheafedSpace.congr_app eq (op (hf.is_open_map.functor.obj V)),
     simp only [PresheafedSpace.comp_c_app, PresheafedSpace.of_restrict_c_app, category.assoc,
       cancel_epi] at this,
     have h : _ ≫ _ = _ ≫ _ ≫ _ :=
       congr_arg (λ f, (X.restrict hf).presheaf.map (eq_to_hom hV).op ≫ f) this,
     erw [g₁.c.naturality, g₂.c.naturality_assoc] at h,
     simp only [presheaf.pushforward_obj_map, eq_to_hom_op,
       category.assoc, eq_to_hom_map, eq_to_hom_trans] at h,
     rw ←is_iso.comp_inv_eq at h,
     simpa using h },
   { have := congr_arg PresheafedSpace.hom.base eq,
     simp only [PresheafedSpace.comp_base, PresheafedSpace.of_restrict_base] at this,
     rw cancel_mono at this,
     exact this }
 end

lemma of_restrict_top_c (X : PresheafedSpace C) :
  (X.of_restrict (opens.open_embedding ⊤)).c = eq_to_hom
    (by { rw [restrict_top_presheaf, ←presheaf.pushforward.comp_eq],
          erw iso.inv_hom_id, rw presheaf.pushforward.id_eq }) :=
  /- another approach would be to prove the left hand side
     is a natural isoomorphism, but I encountered a universe
     issue when `apply nat_iso.is_iso_of_is_iso_app`. -/
begin
  ext U, change X.presheaf.map _ = _, convert eq_to_hom_map _ _ using 1,
  congr, simpa,
  { induction U using opposite.rec, dsimp, congr, ext,
    exact ⟨ λ h, ⟨⟨x,trivial⟩,h,rfl⟩, λ ⟨⟨_,_⟩,h,rfl⟩, h ⟩ },
  /- or `rw [opens.inclusion_top_functor, ←comp_obj, ←opens.map_comp_eq],
         erw iso.inv_hom_id, cases U, refl` after `dsimp` -/
end

/--
The map to the restriction of a presheafed space along the canonical inclusion from the top
subspace.
-/
@[simps]
def to_restrict_top (X : PresheafedSpace C) :
  X ⟶ X.restrict (opens.open_embedding ⊤) :=
{ base := (opens.inclusion_top_iso X.carrier).inv,
  c := eq_to_hom (restrict_top_presheaf X) }

/--
The isomorphism from the restriction to the top subspace.
-/
@[simps]
def restrict_top_iso (X : PresheafedSpace C) :
  X.restrict (opens.open_embedding ⊤) ≅ X :=
{ hom := X.of_restrict _,
  inv := X.to_restrict_top,
  hom_inv_id' := ext _ _ (concrete_category.hom_ext _ _ $ λ ⟨x, _⟩, rfl) $
    by { erw comp_c, rw X.of_restrict_top_c, ext, simp },
  inv_hom_id' := ext _ _ rfl $
    by { erw comp_c, rw X.of_restrict_top_c, ext, simpa [-eq_to_hom_refl] } }

end restrict

/--
The global sections, notated Gamma.
-/
@[simps]
def Γ : (PresheafedSpace C)ᵒᵖ ⥤ C :=
{ obj := λ X, (unop X).presheaf.obj (op ⊤),
  map := λ X Y f, f.unop.c.app (op ⊤) }

lemma Γ_obj_op (X : PresheafedSpace C) : Γ.obj (op X) = X.presheaf.obj (op ⊤) := rfl

lemma Γ_map_op {X Y : PresheafedSpace C} (f : X ⟶ Y) :
  Γ.map f.op = f.c.app (op ⊤) := rfl

end PresheafedSpace

end algebraic_geometry

open algebraic_geometry algebraic_geometry.PresheafedSpace

variables {C}

namespace category_theory

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

local attribute [simp] presheaf.pushforward_obj

namespace functor

/-- We can apply a functor `F : C ⥤ D` to the values of the presheaf in any `PresheafedSpace C`,
    giving a functor `PresheafedSpace C ⥤ PresheafedSpace D` -/
def map_presheaf (F : C ⥤ D) : PresheafedSpace C ⥤ PresheafedSpace D :=
{ obj := λ X, { carrier := X.carrier, presheaf := X.presheaf ⋙ F },
  map := λ X Y f, { base := f.base, c := whisker_right f.c F }, }

@[simp] lemma map_presheaf_obj_X (F : C ⥤ D) (X : PresheafedSpace C) :
  ((F.map_presheaf.obj X) : Top.{v}) = (X : Top.{v}) := rfl
@[simp] lemma map_presheaf_obj_presheaf (F : C ⥤ D) (X : PresheafedSpace C) :
  (F.map_presheaf.obj X).presheaf = X.presheaf ⋙ F := rfl
@[simp] lemma map_presheaf_map_f (F : C ⥤ D) {X Y : PresheafedSpace C} (f : X ⟶ Y) :
  (F.map_presheaf.map f).base = f.base := rfl
@[simp] lemma map_presheaf_map_c (F : C ⥤ D) {X Y : PresheafedSpace C} (f : X ⟶ Y) :
  (F.map_presheaf.map f).c = whisker_right f.c F := rfl

end functor

namespace nat_trans

/--
A natural transformation induces a natural transformation between the `map_presheaf` functors.
-/
def on_presheaf {F G : C ⥤ D} (α : F ⟶ G) : G.map_presheaf ⟶ F.map_presheaf :=
{ app := λ X,
  { base := 𝟙 _,
    c := whisker_left X.presheaf α ≫ eq_to_hom (presheaf.pushforward.id_eq _).symm } }

-- TODO Assemble the last two constructions into a functor
--   `(C ⥤ D) ⥤ (PresheafedSpace C ⥤ PresheafedSpace D)`
end nat_trans

end category_theory


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import combinatorics.simplicial_complex.basic

namespace affine
open set
variables {m n : ℕ} {E : Type*} [normed_group E] [normed_space ℝ E] {S : simplicial_complex E}
  {X Y : finset E}

/--
A simplicial complex is finite iff it has finitely many faces.
-/
def simplicial_complex.finite (S : simplicial_complex E) : Prop := S.faces.finite

noncomputable def simplicial_complex.faces_finset (S : simplicial_complex E) (hS : S.finite) :
  finset (finset E) :=
hS.to_finset

@[simp]
lemma mem_faces_finset (hS : S.finite) :
  X ∈ S.faces_finset hS ↔ X ∈ S.faces :=
set.finite.mem_to_finset _

/--
A simplicial complex `S` is locally finite at the face `X` iff `X` is a subface of finitely many
faces in `S`.
-/
def simplicial_complex.locally_finite_at (S : simplicial_complex E) (X : finset E) : Prop :=
set.finite {Y ∈ S.faces | X ⊆ Y}

/--
A simplicial complex `S` is locally finite at the face `X` iff `X` is a subface of infinitely many
faces in `S`.
-/
def simplicial_complex.locally_infinite_at (S : simplicial_complex E) (X : finset E) : Prop :=
set.infinite {Y ∈ S.faces | X ⊆ Y}

lemma simplicial_complex.locally_finite_at_iff_not_locally_infinite_at :
  ¬S.locally_infinite_at X ↔ S.locally_finite_at X :=
not_not

/--
A simplicial complex is locally finite iff each of its nonempty faces belongs to finitely many faces.
-/
def simplicial_complex.locally_finite (S : simplicial_complex E) : Prop :=
∀ {X : finset _}, X ∈ S.faces → X.nonempty → S.locally_finite_at X

example {α : Type*} {s : set α} {p q : α → Prop} (h : ∀ x, p x → q x) :
  {x ∈ s | p x} ⊆ {x ∈ s | q x} :=
begin
  refine inter_subset_inter_right s h,
end

lemma locally_finite_at_up_closed (hX : S.locally_finite_at X) (hXY : X ⊆ Y) :
  S.locally_finite_at Y :=
begin
  apply hX.subset,
  rintro Z ⟨_, _⟩,
  exact ⟨‹Z ∈ S.faces›, finset.subset.trans hXY ‹Y ⊆ Z›⟩,
end

lemma locally_infinite_at_down_closed (hY : S.locally_infinite_at Y) (hXY : X ⊆ Y) :
  S.locally_infinite_at X :=
λ t, hY (locally_finite_at_up_closed t hXY)

lemma locally_finite_of_finite (hS : S.finite) :
  S.locally_finite :=
λ X hX _, hS.subset (λ Y hY, hY.1)

/--
A simplicial complex is locally finite iff each point belongs to finitely many faces.
-/
lemma locally_finite_iff_mem_finitely_many_faces [decidable_eq E] :
  S.locally_finite ↔ ∀ (x : E), finite {X | X ∈ S.faces ∧ x ∈ convex_hull (X : set E)} :=
begin
  split,
  { unfold simplicial_complex.locally_finite,
    contrapose!,
    rintro ⟨x, hx⟩,
    by_cases hxspace : x ∈ S.space,
    { obtain ⟨X, ⟨hX, hXhull, hXbound⟩, hXunique⟩ := combi_interiors_partition hxspace,
      simp at hXunique,
      use [X, hX],
      split,
      { apply finset.nonempty_of_ne_empty,
        rintro rfl,
        simpa using hXhull },
      rintro hXlocallyfinite,
      apply hx,
      suffices h : {X : finset E | X ∈ S.faces ∧ x ∈ convex_hull ↑X} ⊆
        {Y : finset E | Y ∈ S.faces ∧ X ⊆ Y},
      { exact finite.subset hXlocallyfinite h },
      rintro Y ⟨hY, hYhull⟩,
      use hY,
      have hXYhull := S.disjoint hX hY ⟨hXhull, hYhull⟩,
      rw ←finset.coe_inter at hXYhull,
      by_contra hXY,
      apply hXbound,
      have hYX : X ∩ Y ⊂ X,
      { use finset.inter_subset_left X Y,
        rintro hXXY,
        exact hXY (finset.subset_inter_iff.1 hXXY).2 },
      exact mem_combi_frontier_iff.2 ⟨X ∩ Y, hYX, hXYhull⟩ },
    { exfalso,
      apply hx,
      suffices h : {X : finset E | X ∈ S.faces ∧ x ∈ convex_hull ↑X} = ∅,
      { rw h,
        exact finite_empty },
      apply eq_empty_of_subset_empty,
      rintro X ⟨hX, h⟩,
      exact hxspace (mem_bUnion hX h) }},
  { rintro hS X hX h,
    obtain ⟨x, hx⟩ := h,
    suffices h : {Y : finset E | Y ∈ S.faces ∧ X ⊆ Y} ⊆
      {Y : finset E | Y ∈ S.faces ∧ x ∈ convex_hull ↑Y},
    { exact (hS x).subset h },
    rintro Y ⟨hY, hXY⟩,
    exact ⟨hY, subset_convex_hull Y (hXY hx)⟩ }
end

end affine


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.functor
import Mathlib.PostPort

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

namespace Mathlib

/-!
# Unbundled functors, as a typeclass decorating the object-level function.
-/

namespace category_theory

/-- A unbundled functor. -/
-- Perhaps in the future we could redefine `functor` in terms of this, but that isn't the

-- immediate plan.

class functorial {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C → D) where
  map : {X Y : C} → (X ⟶ Y) → (F X ⟶ F Y)
  map_id' :
    autoParam (C → map 𝟙 = 𝟙)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  map_comp' :
    autoParam (∀ {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z), map (f ≫ g) = map f ≫ map g)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

/--
If `F : C → D` (just a function) has `[functorial F]`,
we can write `map F f : F X ⟶ F Y` for the action of `F` on a morphism `f : X ⟶ Y`.
-/
def map {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C → D) [functorial F] {X : C}
    {Y : C} (f : X ⟶ Y) : F X ⟶ F Y :=
  functorial.map f

@[simp] theorem map_as_map {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C → D}
    [functorial F] {X : C} {Y : C} {f : X ⟶ Y} : functorial.map f = map F f :=
  rfl

@[simp] theorem functorial.map_id {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C → D}
    [functorial F] {X : C} : map F 𝟙 = 𝟙 :=
  functorial.map_id' X

@[simp] theorem functorial.map_comp {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C → D} [functorial F] {X : C} {Y : C} {Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} :
    map F (f ≫ g) = map F f ≫ map F g :=
  functorial.map_comp' f g

namespace functor

/--
Bundle a functorial function as a functor.
-/
def of {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C → D) [I : functorial F] :
    C ⥤ D :=
  mk F functorial.map

end functor

protected instance functor.obj.functorial {C : Type u₁} [category C] {D : Type u₂} [category D]
    (F : C ⥤ D) : functorial (functor.obj F) :=
  functorial.mk (functor.map F)

@[simp] theorem map_functorial_obj {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D)
    {X : C} {Y : C} (f : X ⟶ Y) : map (functor.obj F) f = functor.map F f :=
  rfl

protected instance functorial_id {C : Type u₁} [category C] : functorial id :=
  functorial.mk fun (X Y : C) (f : X ⟶ Y) => f

/--
`G ∘ F` is a functorial if both `F` and `G` are.
-/
-- This is no longer viable as an instance in Lean 3.7,

-- #lint reports an instance loop

-- Will this be a problem?

def functorial_comp {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃} [category E]
    (F : C → D) [functorial F] (G : D → E) [functorial G] : functorial (G ∘ F) :=
  functorial.mk (functor.map (functor.of F ⋙ functor.of G))

end Mathlib