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

universes v u l

namespace Mathlib

/-!
# 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.
-/

namespace category_theory.limits

/--
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.
-/
structure bicone {J : Type v} [DecidableEq J] {C : Type u} [category C] [has_zero_morphisms C]
    (F : J → C)
    where
  X : C
  π : (j : J) → X ⟶ F j
  ι : (j : J) → F j ⟶ X
  ι_π :
    ∀ (j j' : J),
      ι j ≫ π j' =
        dite (j = j') (fun (h : j = j') => eq_to_hom (congr_arg F h)) fun (h : ¬j = j') => 0

@[simp] theorem bicone_ι_π_self {J : Type v} [DecidableEq J] {C : Type u} [category C]
    [has_zero_morphisms C] {F : J → C} (B : bicone F) (j : J) : bicone.ι B j ≫ bicone.π B j = 𝟙 :=
  sorry

@[simp] theorem bicone_ι_π_ne {J : Type v} [DecidableEq J] {C : Type u} [category C]
    [has_zero_morphisms C] {F : J → C} (B : bicone F) {j : J} {j' : J} (h : j ≠ j') :
    bicone.ι B j ≫ bicone.π B j' = 0 :=
  sorry

namespace bicone

/-- Extract the cone from a bicone. -/
def to_cone {J : Type v} [DecidableEq J] {C : Type u} [category C] [has_zero_morphisms C]
    {F : J → C} (B : bicone F) : cone (discrete.functor F) :=
  cone.mk (X B) (nat_trans.mk fun (j : discrete J) => π B j)

/-- Extract the cocone from a bicone. -/
def to_cocone {J : Type v} [DecidableEq J] {C : Type u} [category C] [has_zero_morphisms C]
    {F : J → C} (B : bicone F) : cocone (discrete.functor F) :=
  cocone.mk (X B) (nat_trans.mk fun (j : discrete J) => ι B j)

end bicone

/--
A bicone over `F : J → C`, which is both a limit cone and a colimit cocone.
-/
structure limit_bicone {J : Type v} [DecidableEq J] {C : Type u} [category C] [has_zero_morphisms C]
    (F : J → C)
    where
  bicone : bicone F
  is_limit : is_limit (bicone.to_cone bicone)
  is_colimit : is_colimit (bicone.to_cocone bicone)

/--
`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 {J : Type v} [DecidableEq J] {C : Type u} [category C] [has_zero_morphisms C]
    (F : J → C)
    where
  mk' :: (exists_biproduct : Nonempty (limit_bicone F))

theorem has_biproduct.mk {J : Type v} [DecidableEq J] {C : Type u} [category C]
    [has_zero_morphisms C] {F : J → C} (d : limit_bicone F) : has_biproduct F :=
  has_biproduct.mk' (Nonempty.intro d)

/-- Use the axiom of choice to extract explicit `biproduct_data F` from `has_biproduct F`. -/
def get_biproduct_data {J : Type v} [DecidableEq J] {C : Type u} [category C] [has_zero_morphisms C]
    (F : J → C) [has_biproduct F] : limit_bicone F :=
  Classical.choice sorry

/-- A bicone for `F` which is both a limit cone and a colimit cocone. -/
def biproduct.bicone {J : Type v} [DecidableEq J] {C : Type u} [category C] [has_zero_morphisms C]
    (F : J → C) [has_biproduct F] : bicone F :=
  limit_bicone.bicone (get_biproduct_data F)

/-- `biproduct.bicone F` is a limit cone. -/
def biproduct.is_limit {J : Type v} [DecidableEq J] {C : Type u} [category C] [has_zero_morphisms C]
    (F : J → C) [has_biproduct F] : is_limit (bicone.to_cone (biproduct.bicone F)) :=
  limit_bicone.is_limit (get_biproduct_data F)

/-- `biproduct.bicone F` is a colimit cocone. -/
def biproduct.is_colimit {J : Type v} [DecidableEq J] {C : Type u} [category C]
    [has_zero_morphisms C] (F : J → C) [has_biproduct F] :
    is_colimit (bicone.to_cocone (biproduct.bicone F)) :=
  limit_bicone.is_colimit (get_biproduct_data F)

protected instance has_product_of_has_biproduct {J : Type v} [DecidableEq J] {C : Type u}
    [category C] [has_zero_morphisms C] {F : J → C} [has_biproduct F] :
    has_limit (discrete.functor F) :=
  has_limit.mk (limit_cone.mk (bicone.to_cone (biproduct.bicone F)) (biproduct.is_limit F))

protected instance has_coproduct_of_has_biproduct {J : Type v} [DecidableEq J] {C : Type u}
    [category C] [has_zero_morphisms C] {F : J → C} [has_biproduct F] :
    has_colimit (discrete.functor F) :=
  has_colimit.mk
    (colimit_cocone.mk (bicone.to_cocone (biproduct.bicone F)) (biproduct.is_colimit F))

/--
`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 (J : Type v) [DecidableEq J] (C : Type u) [category C]
    [has_zero_morphisms C]
    where
  has_biproduct : ∀ (F : J → C), has_biproduct F

/-- `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 (C : Type u) [category C] [has_zero_morphisms C] where
  has_biproducts_of_shape :
    ∀ (J : Type v) [_inst_4 : DecidableEq J] [_inst_5 : fintype J], has_biproducts_of_shape J C

protected instance has_finite_products_of_has_finite_biproducts (C : Type u) [category C]
    [has_zero_morphisms C] [has_finite_biproducts C] : has_finite_products C :=
  fun (J : Type v) (_x : DecidableEq J) (_x_1 : fintype J) =>
    has_limits_of_shape.mk
      fun (F : discrete J ⥤ C) => has_limit_of_iso (iso.symm discrete.nat_iso_functor)

protected instance has_finite_coproducts_of_has_finite_biproducts (C : Type u) [category C]
    [has_zero_morphisms C] [has_finite_biproducts C] : has_finite_coproducts C :=
  fun (J : Type v) (_x : DecidableEq J) (_x_1 : fintype J) =>
    has_colimits_of_shape.mk fun (F : discrete J ⥤ C) => has_colimit_of_iso discrete.nat_iso_functor

/--
The isomorphism between the specified limit and the specified colimit for
a functor with a bilimit.
-/
def biproduct_iso {J : Type v} [DecidableEq J] {C : Type u} [category C] [has_zero_morphisms C]
    (F : J → C) [has_biproduct F] : ∏ F ≅ ∐ F :=
  is_limit.cone_point_unique_up_to_iso (limit.is_limit (discrete.functor F))
      (biproduct.is_limit F) ≪≫
    is_colimit.cocone_point_unique_up_to_iso (biproduct.is_colimit F)
      (colimit.is_colimit (discrete.functor F))

end category_theory.limits

namespace category_theory.limits

/-- `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.) -/
def biproduct {J : Type v} [DecidableEq J] {C : Type u} [category C] [has_zero_morphisms C]
    (f : J → C) [has_biproduct f] : C :=
  bicone.X sorry

prefix:20 "⨁ " => Mathlib.category_theory.limits.biproduct

/-- The projection onto a summand of a biproduct. -/
def biproduct.π {J : Type v} [DecidableEq J] {C : Type u} [category C] [has_zero_morphisms C]
    (f : J → C) [has_biproduct f] (b : J) : ⨁ f ⟶ f b :=
  bicone.π (biproduct.bicone f) b

@[simp] theorem biproduct.bicone_π {J : Type v} [DecidableEq J] {C : Type u} [category C]
    [has_zero_morphisms C] (f : J → C) [has_biproduct f] (b : J) :
    bicone.π (biproduct.bicone f) b = biproduct.π f b :=
  rfl

/-- The inclusion into a summand of a biproduct. -/
def biproduct.ι {J : Type v} [DecidableEq J] {C : Type u} [category C] [has_zero_morphisms C]
    (f : J → C) [has_biproduct f] (b : J) : f b ⟶ ⨁ f :=
  bicone.ι (biproduct.bicone f) b

@[simp] theorem biproduct.bicone_ι {J : Type v} [DecidableEq J] {C : Type u} [category C]
    [has_zero_morphisms C] (f : J → C) [has_biproduct f] (b : J) :
    bicone.ι (biproduct.bicone f) b = biproduct.ι f b :=
  rfl

theorem biproduct.ι_π {J : Type v} [DecidableEq J] {C : Type u} [category C] [has_zero_morphisms C]
    (f : J → C) [has_biproduct f] (j : J) (j' : J) :
    biproduct.ι f j ≫ biproduct.π f j' =
        dite (j = j') (fun (h : j = j') => eq_to_hom (congr_arg f h)) fun (h : ¬j = j') => 0 :=
  bicone.ι_π (biproduct.bicone f) j j'

@[simp] theorem biproduct.ι_π_self {J : Type v} [DecidableEq J] {C : Type u} [category C]
    [has_zero_morphisms C] (f : J → C) [has_biproduct f] (j : J) :
    biproduct.ι f j ≫ biproduct.π f j = 𝟙 :=
  sorry

@[simp] theorem biproduct.ι_π_ne {J : Type v} [DecidableEq J] {C : Type u} [category C]
    [has_zero_morphisms C] (f : J → C) [has_biproduct f] {j : J} {j' : J} (h : j ≠ j') :
    biproduct.ι f j ≫ biproduct.π f j' = 0 :=
  sorry

/-- Given a collection of maps into the summands, we obtain a map into the biproduct. -/
def biproduct.lift {J : Type v} [DecidableEq J] {C : Type u} [category C] [has_zero_morphisms C]
    {f : J → C} [has_biproduct f] {P : C} (p : (b : J) → P ⟶ f b) : P ⟶ ⨁ f :=
  is_limit.lift (biproduct.is_limit f) (fan.mk P p)

/-- Given a collection of maps out of the summands, we obtain a map out of the biproduct. -/
def biproduct.desc {J : Type v} [DecidableEq J] {C : Type u} [category C] [has_zero_morphisms C]
    {f : J → C} [has_biproduct f] {P : C} (p : (b : J) → f b ⟶ P) : ⨁ f ⟶ P :=
  is_colimit.desc (biproduct.is_colimit f) (cofan.mk P p)

@[simp] theorem biproduct.lift_π {J : Type v} [DecidableEq J] {C : Type u} [category C]
    [has_zero_morphisms C] {f : J → C} [has_biproduct f] {P : C} (p : (b : J) → P ⟶ f b) (j : J) :
    biproduct.lift p ≫ biproduct.π f j = p j :=
  is_limit.fac (biproduct.is_limit f) (fan.mk P p) j

@[simp] theorem biproduct.ι_desc_assoc {J : Type v} [DecidableEq J] {C : Type u} [category C]
    [has_zero_morphisms C] {f : J → C} [has_biproduct f] {P : C} (p : (b : J) → f b ⟶ P) (j : J)
    {X' : C} (f' : P ⟶ X') : biproduct.ι f j ≫ biproduct.desc p ≫ f' = p j ≫ f' :=
  sorry

/-- 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. -/
def biproduct.map {J : Type v} [DecidableEq J] {C : Type u} [category C] [has_zero_morphisms C]
    [fintype J] {f : J → C} {g : J → C} [has_finite_biproducts C] (p : (b : J) → f b ⟶ g b) :
    ⨁ f ⟶ ⨁ g :=
  is_limit.map (bicone.to_cone (biproduct.bicone f)) (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`. -/
def biproduct.map' {J : Type v} [DecidableEq J] {C : Type u} [category C] [has_zero_morphisms C]
    [fintype J] {f : J → C} {g : J → C} [has_finite_biproducts C] (p : (b : J) → f b ⟶ g b) :
    ⨁ f ⟶ ⨁ g :=
  is_colimit.map (biproduct.is_colimit f) (bicone.to_cocone (biproduct.bicone g))
    (discrete.nat_trans p)

theorem biproduct.hom_ext {J : Type v} [DecidableEq J] {C : Type u} [category C]
    [has_zero_morphisms C] {f : J → C} [has_biproduct f] {Z : C} (g : Z ⟶ ⨁ f) (h : Z ⟶ ⨁ f)
    (w : ∀ (j : J), g ≫ biproduct.π f j = h ≫ biproduct.π f j) : g = h :=
  is_limit.hom_ext (biproduct.is_limit f) w

theorem biproduct.hom_ext' {J : Type v} [DecidableEq J] {C : Type u} [category C]
    [has_zero_morphisms C] {f : J → C} [has_biproduct f] {Z : C} (g : ⨁ f ⟶ Z) (h : ⨁ f ⟶ Z)
    (w : ∀ (j : J), biproduct.ι f j ≫ g = biproduct.ι f j ≫ h) : g = h :=
  is_colimit.hom_ext (biproduct.is_colimit f) w

theorem biproduct.map_eq_map' {J : Type v} [DecidableEq J] {C : Type u} [category C]
    [has_zero_morphisms C] [fintype J] {f : J → C} {g : J → C} [has_finite_biproducts C]
    (p : (b : J) → f b ⟶ g b) : biproduct.map p = biproduct.map' p :=
  sorry

protected instance biproduct.ι_mono {J : Type v} [DecidableEq J] {C : Type u} [category C]
    [has_zero_morphisms C] (f : J → C) [has_biproduct f] (b : J) : split_mono (biproduct.ι f b) :=
  split_mono.mk
    (biproduct.desc
      fun (b' : J) =>
        dite (b' = b) (fun (h : b' = b) => eq_to_hom (congr_arg f h))
          fun (h : ¬b' = b) => biproduct.ι f b' ≫ biproduct.π f b)

protected instance biproduct.π_epi {J : Type v} [DecidableEq J] {C : Type u} [category C]
    [has_zero_morphisms C] (f : J → C) [has_biproduct f] (b : J) : split_epi (biproduct.π f b) :=
  split_epi.mk
    (biproduct.lift
      fun (b' : J) =>
        dite (b = b') (fun (h : b = b') => eq_to_hom (congr_arg f h))
          fun (h : ¬b = b') => biproduct.ι f b ≫ biproduct.π f b')

@[simp] theorem biproduct.map_π_assoc {J : Type v} [DecidableEq J] {C : Type u} [category C]
    [has_zero_morphisms C] [fintype J] {f : J → C} {g : J → C} [has_finite_biproducts C]
    (p : (j : J) → f j ⟶ g j) (j : J) {X' : C} (f' : g j ⟶ X') :
    biproduct.map p ≫ biproduct.π g j ≫ f' = biproduct.π f j ≫ p j ≫ f' :=
  sorry

@[simp] theorem biproduct.ι_map {J : Type v} [DecidableEq J] {C : Type u} [category C]
    [has_zero_morphisms C] [fintype J] {f : J → C} {g : J → C} [has_finite_biproducts C]
    (p : (j : J) → f j ⟶ g j) (j : J) : biproduct.ι f j ≫ biproduct.map p = p j ≫ biproduct.ι g j :=
  sorry

/--
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`
-/
structure binary_bicone {C : Type u} [category C] [has_zero_morphisms C] (P : C) (Q : C) where
  X : C
  fst : X ⟶ P
  snd : X ⟶ Q
  inl : P ⟶ X
  inr : Q ⟶ X
  inl_fst' :
    autoParam (inl ≫ fst = 𝟙)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  inl_snd' :
    autoParam (inl ≫ snd = 0)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  inr_fst' :
    autoParam (inr ≫ fst = 0)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  inr_snd' :
    autoParam (inr ≫ snd = 𝟙)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem binary_bicone.inl_fst {C : Type u} [category C] [has_zero_morphisms C] {P : C}
    {Q : C} (c : binary_bicone P Q) : binary_bicone.inl c ≫ binary_bicone.fst c = 𝟙 :=
  sorry

@[simp] theorem binary_bicone.inl_snd {C : Type u} [category C] [has_zero_morphisms C] {P : C}
    {Q : C} (c : binary_bicone P Q) : binary_bicone.inl c ≫ binary_bicone.snd c = 0 :=
  sorry

@[simp] theorem binary_bicone.inr_fst {C : Type u} [category C] [has_zero_morphisms C] {P : C}
    {Q : C} (c : binary_bicone P Q) : binary_bicone.inr c ≫ binary_bicone.fst c = 0 :=
  sorry

@[simp] theorem binary_bicone.inr_snd {C : Type u} [category C] [has_zero_morphisms C] {P : C}
    {Q : C} (c : binary_bicone P Q) : binary_bicone.inr c ≫ binary_bicone.snd c = 𝟙 :=
  sorry

@[simp] theorem binary_bicone.inr_fst_assoc {C : Type u} [category C] [has_zero_morphisms C] {P : C}
    {Q : C} (c : binary_bicone P Q) {X' : C} (f' : P ⟶ X') :
    binary_bicone.inr c ≫ binary_bicone.fst c ≫ f' = 0 ≫ f' :=
  sorry

namespace binary_bicone

/-- Extract the cone from a binary bicone. -/
def to_cone {C : Type u} [category C] [has_zero_morphisms C] {P : C} {Q : C}
    (c : binary_bicone P Q) : cone (pair P Q) :=
  binary_fan.mk (fst c) (snd c)

@[simp] theorem to_cone_X {C : Type u} [category C] [has_zero_morphisms C] {P : C} {Q : C}
    (c : binary_bicone P Q) : cone.X (to_cone c) = X c :=
  rfl

@[simp] theorem to_cone_π_app_left {C : Type u} [category C] [has_zero_morphisms C] {P : C} {Q : C}
    (c : binary_bicone P Q) : nat_trans.app (cone.π (to_cone c)) walking_pair.left = fst c :=
  rfl

@[simp] theorem to_cone_π_app_right {C : Type u} [category C] [has_zero_morphisms C] {P : C} {Q : C}
    (c : binary_bicone P Q) : nat_trans.app (cone.π (to_cone c)) walking_pair.right = snd c :=
  rfl

/-- Extract the cocone from a binary bicone. -/
def to_cocone {C : Type u} [category C] [has_zero_morphisms C] {P : C} {Q : C}
    (c : binary_bicone P Q) : cocone (pair P Q) :=
  binary_cofan.mk (inl c) (inr c)

@[simp] theorem to_cocone_X {C : Type u} [category C] [has_zero_morphisms C] {P : C} {Q : C}
    (c : binary_bicone P Q) : cocone.X (to_cocone c) = X c :=
  rfl

@[simp] theorem to_cocone_ι_app_left {C : Type u} [category C] [has_zero_morphisms C] {P : C}
    {Q : C} (c : binary_bicone P Q) :
    nat_trans.app (cocone.ι (to_cocone c)) walking_pair.left = inl c :=
  rfl

@[simp] theorem to_cocone_ι_app_right {C : Type u} [category C] [has_zero_morphisms C] {P : C}
    {Q : C} (c : binary_bicone P Q) :
    nat_trans.app (cocone.ι (to_cocone c)) walking_pair.right = inr c :=
  rfl

end binary_bicone

namespace bicone

/-- Convert a `bicone` over a function on `walking_pair` to a binary_bicone. -/
@[simp] theorem to_binary_bicone_snd {C : Type u} [category C] [has_zero_morphisms C] {X : C}
    {Y : C} (b : bicone (functor.obj (pair X Y))) :
    binary_bicone.snd (to_binary_bicone b) = π b walking_pair.right :=
  Eq.refl (binary_bicone.snd (to_binary_bicone b))

/--
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 {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C}
    {b : bicone (functor.obj (pair X Y))} (c : is_limit (to_cone b)) :
    is_limit (binary_bicone.to_cone (to_binary_bicone b)) :=
  is_limit.mk fun (s : cone (pair X Y)) => is_limit.lift c s

/--
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 {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C}
    {b : bicone (functor.obj (pair X Y))} (c : is_colimit (to_cocone b)) :
    is_colimit (binary_bicone.to_cocone (to_binary_bicone b)) :=
  is_colimit.mk fun (s : cocone (pair X Y)) => is_colimit.desc c s

end bicone

/--
A bicone over `P Q : C`, which is both a limit cone and a colimit cocone.
-/
structure binary_biproduct_data {C : Type u} [category C] [has_zero_morphisms C] (P : C) (Q : C)
    where
  bicone : binary_bicone P Q
  is_limit : is_limit (binary_bicone.to_cone bicone)
  is_colimit : is_colimit (binary_bicone.to_cocone bicone)

/--
`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 {C : Type u} [category C] [has_zero_morphisms C] (P : C) (Q : C) where
  mk' :: (exists_binary_biproduct : Nonempty (binary_biproduct_data P Q))

theorem has_binary_biproduct.mk {C : Type u} [category C] [has_zero_morphisms C] {P : C} {Q : C}
    (d : binary_biproduct_data P Q) : has_binary_biproduct P Q :=
  has_binary_biproduct.mk' (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 {C : Type u} [category C] [has_zero_morphisms C] (P : C) (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 {C : Type u} [category C] [has_zero_morphisms C] (P : C) (Q : C)
    [has_binary_biproduct P Q] : binary_bicone P Q :=
  binary_biproduct_data.bicone (get_binary_biproduct_data P Q)

/-- `binary_biproduct.bicone P Q` is a limit cone. -/
def binary_biproduct.is_limit {C : Type u} [category C] [has_zero_morphisms C] (P : C) (Q : C)
    [has_binary_biproduct P Q] : is_limit (binary_bicone.to_cone (binary_biproduct.bicone P Q)) :=
  binary_biproduct_data.is_limit (get_binary_biproduct_data P Q)

/-- `binary_biproduct.bicone P Q` is a colimit cocone. -/
def binary_biproduct.is_colimit {C : Type u} [category C] [has_zero_morphisms C] (P : C) (Q : C)
    [has_binary_biproduct P Q] :
    is_colimit (binary_bicone.to_cocone (binary_biproduct.bicone P Q)) :=
  binary_biproduct_data.is_colimit (get_binary_biproduct_data P Q)

/--
`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 (C : Type u) [category C] [has_zero_morphisms C] where
  has_binary_biproduct : ∀ (P Q : C), has_binary_biproduct P Q

/--
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.
-/
theorem has_binary_biproducts_of_finite_biproducts (C : Type u) [category C] [has_zero_morphisms C]
    [has_finite_biproducts C] : has_binary_biproducts C :=
  sorry

protected instance has_binary_biproduct.has_limit_pair {C : Type u} [category C]
    [has_zero_morphisms C] {P : C} {Q : C} [has_binary_biproduct P Q] : has_limit (pair P Q) :=
  has_limit.mk
    (limit_cone.mk (binary_bicone.to_cone (binary_biproduct.bicone P Q))
      (binary_biproduct.is_limit P Q))

protected instance has_binary_biproduct.has_colimit_pair {C : Type u} [category C]
    [has_zero_morphisms C] {P : C} {Q : C} [has_binary_biproduct P Q] : has_colimit (pair P Q) :=
  has_colimit.mk
    (colimit_cocone.mk (binary_bicone.to_cocone (binary_biproduct.bicone P Q))
      (binary_biproduct.is_colimit P Q))

protected instance has_binary_products_of_has_binary_biproducts {C : Type u} [category C]
    [has_zero_morphisms C] [has_binary_biproducts C] : has_binary_products C :=
  has_limits_of_shape.mk
    fun (F : discrete walking_pair ⥤ C) => has_limit_of_iso (iso.symm (diagram_iso_pair F))

protected instance has_binary_coproducts_of_has_binary_biproducts {C : Type u} [category C]
    [has_zero_morphisms C] [has_binary_biproducts C] : has_binary_coproducts C :=
  has_colimits_of_shape.mk
    fun (F : discrete walking_pair ⥤ C) => 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 {C : Type u} [category C] [has_zero_morphisms C] (X : C) (Y : C)
    [has_binary_biproduct X Y] : X ⨯ Y ≅ X ⨿ Y :=
  is_limit.cone_point_unique_up_to_iso (limit.is_limit (pair X Y))
      (binary_biproduct.is_limit X Y) ≪≫
    is_colimit.cocone_point_unique_up_to_iso (binary_biproduct.is_colimit X Y)
      (colimit.is_colimit (pair X Y))

/-- An arbitrary choice of biproduct of a pair of objects. -/
def biprod {C : Type u} [category C] [has_zero_morphisms C] (X : C) (Y : C)
    [has_binary_biproduct X Y] : C :=
  binary_bicone.X (binary_biproduct.bicone X Y)

infixl:20 " ⊞ " => Mathlib.category_theory.limits.biprod

/-- The projection onto the first summand of a binary biproduct. -/
def biprod.fst {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C}
    [has_binary_biproduct X Y] : X ⊞ Y ⟶ X :=
  binary_bicone.fst (binary_biproduct.bicone X Y)

/-- The projection onto the second summand of a binary biproduct. -/
def biprod.snd {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C}
    [has_binary_biproduct X Y] : X ⊞ Y ⟶ Y :=
  binary_bicone.snd (binary_biproduct.bicone X Y)

/-- The inclusion into the first summand of a binary biproduct. -/
def biprod.inl {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C}
    [has_binary_biproduct X Y] : X ⟶ X ⊞ Y :=
  binary_bicone.inl (binary_biproduct.bicone X Y)

/-- The inclusion into the second summand of a binary biproduct. -/
def biprod.inr {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C}
    [has_binary_biproduct X Y] : Y ⟶ X ⊞ Y :=
  binary_bicone.inr (binary_biproduct.bicone X Y)

@[simp] theorem binary_biproduct.bicone_fst {C : Type u} [category C] [has_zero_morphisms C] {X : C}
    {Y : C} [has_binary_biproduct X Y] :
    binary_bicone.fst (binary_biproduct.bicone X Y) = biprod.fst :=
  rfl

@[simp] theorem binary_biproduct.bicone_snd {C : Type u} [category C] [has_zero_morphisms C] {X : C}
    {Y : C} [has_binary_biproduct X Y] :
    binary_bicone.snd (binary_biproduct.bicone X Y) = biprod.snd :=
  rfl

@[simp] theorem binary_biproduct.bicone_inl {C : Type u} [category C] [has_zero_morphisms C] {X : C}
    {Y : C} [has_binary_biproduct X Y] :
    binary_bicone.inl (binary_biproduct.bicone X Y) = biprod.inl :=
  rfl

@[simp] theorem binary_biproduct.bicone_inr {C : Type u} [category C] [has_zero_morphisms C] {X : C}
    {Y : C} [has_binary_biproduct X Y] :
    binary_bicone.inr (binary_biproduct.bicone X Y) = biprod.inr :=
  rfl

@[simp] theorem biprod.inl_fst {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C}
    [has_binary_biproduct X Y] : biprod.inl ≫ biprod.fst = 𝟙 :=
  binary_bicone.inl_fst (binary_biproduct.bicone X Y)

@[simp] theorem biprod.inl_snd {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C}
    [has_binary_biproduct X Y] : biprod.inl ≫ biprod.snd = 0 :=
  binary_bicone.inl_snd (binary_biproduct.bicone X Y)

@[simp] theorem biprod.inr_fst_assoc {C : Type u} [category C] [has_zero_morphisms C] {X : C}
    {Y : C} [has_binary_biproduct X Y] {X' : C} (f' : X ⟶ X') :
    biprod.inr ≫ biprod.fst ≫ f' = 0 ≫ f' :=
  sorry

@[simp] theorem biprod.inr_snd_assoc {C : Type u} [category C] [has_zero_morphisms C] {X : C}
    {Y : C} [has_binary_biproduct X Y] {X' : C} (f' : Y ⟶ X') : biprod.inr ≫ biprod.snd ≫ f' = f' :=
  sorry

/-- Given a pair of maps into the summands of a binary biproduct,
we obtain a map into the binary biproduct. -/
def biprod.lift {C : Type u} [category C] [has_zero_morphisms C] {W : C} {X : C} {Y : C}
    [has_binary_biproduct X Y] (f : W ⟶ X) (g : W ⟶ Y) : W ⟶ X ⊞ Y :=
  is_limit.lift (binary_biproduct.is_limit X Y) (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. -/
def biprod.desc {C : Type u} [category C] [has_zero_morphisms C] {W : C} {X : C} {Y : C}
    [has_binary_biproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) : X ⊞ Y ⟶ W :=
  is_colimit.desc (binary_biproduct.is_colimit X Y) (binary_cofan.mk f g)

@[simp] theorem biprod.lift_fst_assoc {C : Type u} [category C] [has_zero_morphisms C] {W : C}
    {X : C} {Y : C} [has_binary_biproduct X Y] (f : W ⟶ X) (g : W ⟶ Y) {X' : C} (f' : X ⟶ X') :
    biprod.lift f g ≫ biprod.fst ≫ f' = f ≫ f' :=
  sorry

@[simp] theorem biprod.lift_snd_assoc {C : Type u} [category C] [has_zero_morphisms C] {W : C}
    {X : C} {Y : C} [has_binary_biproduct X Y] (f : W ⟶ X) (g : W ⟶ Y) {X' : C} (f' : Y ⟶ X') :
    biprod.lift f g ≫ biprod.snd ≫ f' = g ≫ f' :=
  sorry

@[simp] theorem biprod.inl_desc_assoc {C : Type u} [category C] [has_zero_morphisms C] {W : C}
    {X : C} {Y : C} [has_binary_biproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) {X' : C} (f' : W ⟶ X') :
    biprod.inl ≫ biprod.desc f g ≫ f' = f ≫ f' :=
  sorry

@[simp] theorem biprod.inr_desc_assoc {C : Type u} [category C] [has_zero_morphisms C] {W : C}
    {X : C} {Y : C} [has_binary_biproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) {X' : C} (f' : W ⟶ X') :
    biprod.inr ≫ biprod.desc f g ≫ f' = g ≫ f' :=
  sorry

protected instance biprod.mono_lift_of_mono_left {C : Type u} [category C] [has_zero_morphisms C]
    {W : C} {X : C} {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 f g)

protected instance biprod.mono_lift_of_mono_right {C : Type u} [category C] [has_zero_morphisms C]
    {W : C} {X : C} {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 f g)

protected instance biprod.epi_desc_of_epi_left {C : Type u} [category C] [has_zero_morphisms C]
    {W : C} {X : C} {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 f g)

protected instance biprod.epi_desc_of_epi_right {C : Type u} [category C] [has_zero_morphisms C]
    {W : C} {X : C} {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 f g)

/-- Given a pair of maps between the summands of a pair of binary biproducts,
we obtain a map between the binary biproducts. -/
def biprod.map {C : Type u} [category C] [has_zero_morphisms C] {W : C} {X : C} {Y : C} {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_bicone.to_cone (binary_biproduct.bicone W X)) (binary_biproduct.is_limit Y Z)
    (map_pair f g)

/-- An alternative to `biprod.map` constructed via colimits.
This construction only exists in order to show it is equal to `biprod.map`. -/
def biprod.map' {C : Type u} [category C] [has_zero_morphisms C] {W : C} {X : C} {Y : C} {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_bicone.to_cocone (binary_biproduct.bicone Y Z)) (map_pair f g)

theorem biprod.hom_ext {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {Z : C}
    [has_binary_biproduct X Y] (f : Z ⟶ X ⊞ Y) (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₁

theorem biprod.hom_ext' {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C} {Z : C}
    [has_binary_biproduct X Y] (f : X ⊞ Y ⟶ Z) (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₁

theorem biprod.map_eq_map' {C : Type u} [category C] [has_zero_morphisms C] {W : C} {X : C} {Y : C}
    {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 :=
  sorry

protected instance biprod.inl_mono {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C}
    [has_binary_biproduct X Y] : split_mono biprod.inl :=
  split_mono.mk (biprod.desc 𝟙 (biprod.inr ≫ biprod.fst))

protected instance biprod.inr_mono {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C}
    [has_binary_biproduct X Y] : split_mono biprod.inr :=
  split_mono.mk (biprod.desc (biprod.inl ≫ biprod.snd) 𝟙)

protected instance biprod.fst_epi {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C}
    [has_binary_biproduct X Y] : split_epi biprod.fst :=
  split_epi.mk (biprod.lift 𝟙 (biprod.inl ≫ biprod.snd))

protected instance biprod.snd_epi {C : Type u} [category C] [has_zero_morphisms C] {X : C} {Y : C}
    [has_binary_biproduct X Y] : split_epi biprod.snd :=
  split_epi.mk (biprod.lift (biprod.inr ≫ biprod.fst) 𝟙)

@[simp] theorem biprod.map_fst {C : Type u} [category C] [has_zero_morphisms C] {W : C} {X : C}
    {Y : C} {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_π (binary_bicone.to_cone (binary_biproduct.bicone W X))
    (binary_biproduct.is_limit Y Z) (map_pair f g) walking_pair.left

@[simp] theorem biprod.map_snd_assoc {C : Type u} [category C] [has_zero_morphisms C] {W : C}
    {X : C} {Y : C} {Z : C} [has_binary_biproduct W X] [has_binary_biproduct Y Z] (f : W ⟶ Y)
    (g : X ⟶ Z) {X' : C} (f' : Z ⟶ X') : biprod.map f g ≫ biprod.snd ≫ f' = biprod.snd ≫ g ≫ f' :=
  sorry

-- Because `biprod.map` is defined in terms of `lim` rather than `colim`,

-- we need to provide additional `simp` lemmas.

@[simp] theorem biprod.inl_map_assoc {C : Type u} [category C] [has_zero_morphisms C] {W : C}
    {X : C} {Y : C} {Z : C} [has_binary_biproduct W X] [has_binary_biproduct Y Z] (f : W ⟶ Y)
    (g : X ⟶ Z) {X' : C} (f' : Y ⊞ Z ⟶ X') :
    biprod.inl ≫ biprod.map f g ≫ f' = f ≫ biprod.inl ≫ f' :=
  sorry

@[simp] theorem biprod.inr_map {C : Type u} [category C] [has_zero_morphisms C] {W : C} {X : C}
    {Y : C} {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 :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (biprod.inr ≫ biprod.map f g = g ≫ biprod.inr))
        (biprod.map_eq_map' f g)))
    (is_colimit.ι_map (binary_biproduct.is_colimit W X)
      (binary_bicone.to_cocone (binary_biproduct.bicone Y Z)) (map_pair f g) walking_pair.right)

/-- Given a pair of isomorphisms between the summands of a pair of binary biproducts,
we obtain an isomorphism between the binary biproducts. -/
@[simp] theorem biprod.map_iso_hom {C : Type u} [category C] [has_zero_morphisms C] {W : C} {X : C}
    {Y : C} {Z : C} [has_binary_biproduct W X] [has_binary_biproduct Y Z] (f : W ≅ Y) (g : X ≅ Z) :
    iso.hom (biprod.map_iso f g) = biprod.map (iso.hom f) (iso.hom g) :=
  Eq.refl (iso.hom (biprod.map_iso f g))

/-- The braiding isomorphism which swaps a binary biproduct. -/
@[simp] theorem biprod.braiding_hom {C : Type u} [category C] [has_zero_morphisms C]
    [has_binary_biproducts C] (P : C) (Q : C) :
    iso.hom (biprod.braiding P Q) = biprod.lift biprod.snd biprod.fst :=
  Eq.refl (iso.hom (biprod.braiding P Q))

/--
An alternative formula for the braiding isomorphism which swaps a binary biproduct,
using the fact that the biproduct is a coproduct.
-/
def biprod.braiding' {C : Type u} [category C] [has_zero_morphisms C] [has_binary_biproducts C]
    (P : C) (Q : C) : P ⊞ Q ≅ Q ⊞ P :=
  iso.mk (biprod.desc biprod.inr biprod.inl) (biprod.desc biprod.inr biprod.inl)

theorem biprod.braiding'_eq_braiding {C : Type u} [category C] [has_zero_morphisms C]
    [has_binary_biproducts C] {P : C} {Q : C} : biprod.braiding' P Q = biprod.braiding P Q :=
  sorry

/-- The braiding isomorphism can be passed through a map by swapping the order. -/
theorem biprod.braid_natural_assoc {C : Type u} [category C] [has_zero_morphisms C]
    [has_binary_biproducts C] {W : C} {X : C} {Y : C} {Z : C} (f : X ⟶ Y) (g : Z ⟶ W) {X' : C}
    (f' : W ⊞ Y ⟶ X') :
    biprod.map f g ≫ iso.hom (biprod.braiding Y W) ≫ f' =
        iso.hom (biprod.braiding X Z) ≫ biprod.map g f ≫ f' :=
  sorry

theorem biprod.braiding_map_braiding {C : Type u} [category C] [has_zero_morphisms C]
    [has_binary_biproducts C] {W : C} {X : C} {Y : C} {Z : C} (f : W ⟶ Y) (g : X ⟶ Z) :
    iso.hom (biprod.braiding X W) ≫ biprod.map f g ≫ iso.hom (biprod.braiding Y Z) =
        biprod.map g f :=
  sorry

@[simp] theorem biprod.symmetry'_assoc {C : Type u} [category C] [has_zero_morphisms C]
    [has_binary_biproducts C] (P : C) (Q : C) {X' : C} (f' : P ⊞ Q ⟶ X') :
    biprod.lift biprod.snd biprod.fst ≫ biprod.lift biprod.snd biprod.fst ≫ f' = f' :=
  sorry

/-- The braiding isomorphism is symmetric. -/
theorem biprod.symmetry_assoc {C : Type u} [category C] [has_zero_morphisms C]
    [has_binary_biproducts C] (P : C) (Q : C) {X' : C} (f' : P ⊞ Q ⟶ X') :
    iso.hom (biprod.braiding P Q) ≫ iso.hom (biprod.braiding Q P) ≫ f' = f' :=
  sorry

-- TODO:

-- If someone is interested, they could provide the constructions:

--   has_binary_biproducts ↔ has_finite_biproducts

end category_theory.limits

namespace category_theory.limits

/--
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.)
-/
theorem has_biproduct_of_total {C : Type u} [category C] [preadditive C] {J : Type v}
    [DecidableEq J] [fintype J] {f : J → C} (b : bicone f)
    (total : (finset.sum finset.univ fun (j : J) => bicone.π b j ≫ bicone.ι b j) = 𝟙) :
    has_biproduct f :=
  sorry

/-- In a preadditive category, if the product over `f : J → C` exists,
    then the biproduct over `f` exists. -/
theorem has_biproduct.of_has_product {C : Type u} [category C] [preadditive C] {J : Type v}
    [DecidableEq J] [fintype J] (f : J → C) [has_product f] : has_biproduct f :=
  sorry

/-- In a preadditive category, if the coproduct over `f : J → C` exists,
    then the biproduct over `f` exists. -/
theorem has_biproduct.of_has_coproduct {C : Type u} [category C] [preadditive C] {J : Type v}
    [DecidableEq J] [fintype J] (f : J → C) [has_coproduct f] : has_biproduct f :=
  sorry

/-- A preadditive category with finite products has finite biproducts. -/
theorem has_finite_biproducts.of_has_finite_products {C : Type u} [category C] [preadditive C]
    [has_finite_products C] : has_finite_biproducts C :=
  has_finite_biproducts.mk
    fun (J : Type v) (_x : DecidableEq J) (_x_1 : fintype J) =>
      has_biproducts_of_shape.mk fun (F : J → C) => has_biproduct.of_has_product F

/-- A preadditive category with finite coproducts has finite biproducts. -/
theorem has_finite_biproducts.of_has_finite_coproducts {C : Type u} [category C] [preadditive C]
    [has_finite_coproducts C] : has_finite_biproducts C :=
  has_finite_biproducts.mk
    fun (J : Type v) (_x : DecidableEq J) (_x_1 : fintype J) =>
      has_biproducts_of_shape.mk fun (F : J → C) => has_biproduct.of_has_coproduct F

/--
In any preadditive category, any biproduct satsifies
`∑ j : J, biproduct.π f j ≫ biproduct.ι f j = 𝟙 (⨁ f)`
-/
@[simp] theorem biproduct.total {C : Type u} [category C] [preadditive C] {J : Type v}
    [DecidableEq J] [fintype J] {f : J → C} [has_biproduct f] :
    (finset.sum finset.univ fun (j : J) => biproduct.π f j ≫ biproduct.ι f j) = 𝟙 :=
  sorry

theorem biproduct.lift_eq {C : Type u} [category C] [preadditive C] {J : Type v} [DecidableEq J]
    [fintype J] {f : J → C} [has_biproduct f] {T : C} {g : (j : J) → T ⟶ f j} :
    biproduct.lift g = finset.sum finset.univ fun (j : J) => g j ≫ biproduct.ι f j :=
  sorry

theorem biproduct.desc_eq {C : Type u} [category C] [preadditive C] {J : Type v} [DecidableEq J]
    [fintype J] {f : J → C} [has_biproduct f] {T : C} {g : (j : J) → f j ⟶ T} :
    biproduct.desc g = finset.sum finset.univ fun (j : J) => biproduct.π f j ≫ g j :=
  sorry

@[simp] theorem biproduct.lift_desc {C : Type u} [category C] [preadditive C] {J : Type v}
    [DecidableEq J] [fintype J] {f : J → C} [has_biproduct f] {T : C} {U : C}
    {g : (j : J) → T ⟶ f j} {h : (j : J) → f j ⟶ U} :
    biproduct.lift g ≫ biproduct.desc h = finset.sum finset.univ fun (j : J) => g j ≫ h j :=
  sorry

theorem biproduct.map_eq {C : Type u} [category C] [preadditive C] {J : Type v} [DecidableEq J]
    [fintype J] [has_finite_biproducts C] {f : J → C} {g : J → C} {h : (j : J) → f j ⟶ g j} :
    biproduct.map h =
        finset.sum finset.univ fun (j : J) => biproduct.π f j ≫ h j ≫ biproduct.ι g j :=
  sorry

/--
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.)
-/
theorem has_binary_biproduct_of_total {C : Type u} [category C] [preadditive C] {X : C} {Y : C}
    (b : binary_bicone X Y)
    (total :
      binary_bicone.fst b ≫ binary_bicone.inl b + binary_bicone.snd b ≫ binary_bicone.inr b = 𝟙) :
    has_binary_biproduct X Y :=
  sorry

/-- In a preadditive category, if the product of `X` and `Y` exists, then the
    binary biproduct of `X` and `Y` exists. -/
theorem has_binary_biproduct.of_has_binary_product {C : Type u} [category C] [preadditive C] (X : C)
    (Y : C) [has_binary_product X Y] : has_binary_biproduct X Y :=
  sorry

/-- In a preadditive category, if all binary products exist, then all binary biproducts exist. -/
theorem has_binary_biproducts.of_has_binary_products {C : Type u} [category C] [preadditive C]
    [has_binary_products C] : has_binary_biproducts C :=
  has_binary_biproducts.mk fun (X Y : C) => 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. -/
theorem has_binary_biproduct.of_has_binary_coproduct {C : Type u} [category C] [preadditive C]
    (X : C) (Y : C) [has_binary_coproduct X Y] : has_binary_biproduct X Y :=
  sorry

/-- In a preadditive category, if all binary coproducts exist, then all binary biproducts exist. -/
theorem has_binary_biproducts.of_has_binary_coproducts {C : Type u} [category C] [preadditive C]
    [has_binary_coproducts C] : has_binary_biproducts C :=
  has_binary_biproducts.mk fun (X Y : C) => has_binary_biproduct.of_has_binary_coproduct X Y

/--
In any preadditive category, any binary biproduct satsifies
`biprod.fst ≫ biprod.inl + biprod.snd ≫ biprod.inr = 𝟙 (X ⊞ Y)`.
-/
@[simp] theorem biprod.total {C : Type u} [category C] [preadditive C] {X : C} {Y : C}
    [has_binary_biproduct X Y] : biprod.fst ≫ biprod.inl + biprod.snd ≫ biprod.inr = 𝟙 :=
  sorry

theorem biprod.lift_eq {C : Type u} [category C] [preadditive C] {X : C} {Y : C}
    [has_binary_biproduct X Y] {T : C} {f : T ⟶ X} {g : T ⟶ Y} :
    biprod.lift f g = f ≫ biprod.inl + g ≫ biprod.inr :=
  sorry

theorem biprod.desc_eq {C : Type u} [category C] [preadditive C] {X : C} {Y : C}
    [has_binary_biproduct X Y] {T : C} {f : X ⟶ T} {g : Y ⟶ T} :
    biprod.desc f g = biprod.fst ≫ f + biprod.snd ≫ g :=
  sorry

@[simp] theorem biprod.lift_desc {C : Type u} [category C] [preadditive C] {X : C} {Y : C}
    [has_binary_biproduct X Y] {T : C} {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 :=
  sorry

theorem biprod.map_eq {C : Type u} [category C] [preadditive C] [has_binary_biproducts C] {W : C}
    {X : C} {Y : C} {Z : C} {f : W ⟶ Y} {g : X ⟶ Z} :
    biprod.map f g = biprod.fst ≫ f ≫ biprod.inl + biprod.snd ≫ g ≫ biprod.inr :=
  sorry

end Mathlib


/-
Copyright (c) 2017 Daniel Selsam. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Daniel Selsam

Properties of dvecs of tensors.

We often want to do algebra manipulations on an entire dvec at a time,
and this file makes it possible to use standard notation when doing so.
-/
import .tensor .dvec .util .graph

namespace certigrad

namespace tvec

def lift0 (f : Π {shape : S}, T shape) : Π (shapes : list S), dvec T shapes
| [] := dvec.nil
| (shape::shapes) := dvec.cons f (lift0 shapes)

instance {shapes : list S} : has_zero (dvec T shapes) :=
⟨tvec.lift0 (λ sh, 0) shapes⟩

instance {shapes : list S} : has_one (dvec T shapes) :=
⟨tvec.lift0 (λ sh, 1) shapes⟩

def lift1 (f : Π {shape : S}, T shape → T shape) : Π {shapes : list S}, dvec T shapes → dvec T shapes
| [] _ := dvec.nil
| (shape::shapes) (dvec.cons x xs) := dvec.cons (f x) (lift1 xs)

instance {shapes : list S} : has_neg (dvec T shapes) :=
⟨@tvec.lift1 (λ sh x, - x) shapes⟩

instance {shapes : list S} : has_inv (dvec T shapes) :=
⟨@tvec.lift1 (λ sh x, x⁻¹) shapes⟩

def sqrt {shapes : list S} (xs : dvec T shapes) : dvec T shapes :=
lift1 @T.sqrt xs

def lift2 (f : Π {shape : S}, T shape → T shape → T shape) : Π (shapes : list S), dvec T shapes → dvec T shapes → dvec T shapes
| [] _ _ := dvec.nil
| (shape::shapes) (dvec.cons x xs) (dvec.cons y ys) := dvec.cons (f x y) (lift2 shapes xs ys)

instance {shapes : list S} : has_add (dvec T shapes) :=
⟨tvec.lift2 (λ sh x y, x + y) shapes⟩

instance {shapes : list S} : has_mul (dvec T shapes) :=
⟨tvec.lift2 (λ sh x y, x * y) shapes⟩

instance {shapes : list S} : has_sub (dvec T shapes) :=
⟨tvec.lift2 (λ sh x y, x - y) shapes⟩

instance {shapes : list S} : has_div (dvec T shapes) :=
⟨tvec.lift2 (λ sh x y, x / y) shapes⟩

def scalar_mul : Π (shapes : list S), ℝ → dvec T shapes → dvec T shapes
| [] α _ := dvec.nil
| (shape::shapes) α (dvec.cons x xs) := dvec.cons (α ⬝ x) (scalar_mul shapes α xs)

instance {shapes : list S} : has_smul (ℝ) (dvec T shapes) :=
⟨tvec.scalar_mul shapes⟩

----- Build env from dvec
def to_env_core : Π (names : list ID) (shapes : list S) (xs : dvec T shapes), env
| (name::names) (shape::shapes) (dvec.cons x xs) := env.insert (name, shape) x (to_env_core names shapes xs)
| _ _ _ := env.mk

def to_env (refs : list reference) (xs : dvec T refs^.p2) : env := to_env_core refs^.p1 refs^.p2 xs

-- Build dvec from env
def from_env : Π (tgts : list reference) (m : env), dvec T tgts^.p2
| (tgt::tgts) m := (env.get tgt m) ::: (from_env tgts m)
| [] _ := ⟦⟧

open list
lemma get_from_env {refs : list reference} {idx : ℕ} {ref : reference} (H_at_idx : at_idx refs idx ref) (m : env) :
  dvec.get ref.2 (from_env refs m) idx = env.get ref m :=
begin
assertv H_elem_at_idx : elem_at_idx refs idx ref := elem_at_idx_of_at_idx H_at_idx,
induction H_elem_at_idx with xs x xs idx' x y H_elem_at_idx IH,
{ dunfold from_env, erw dvec.get.equations._eqn_2, simp },
{ dunfold from_env, erw dvec.get.equations._eqn_3, exact IH (at_idx_of_cons H_at_idx) }
end

end tvec
end certigrad


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl
-/
import algebra.group.with_one.defs
import algebra.order.monoid.canonical.defs
import algebra.order.zero_le_one

/-!
# Adjoining a zero element to an ordered monoid.

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

set_option old_structure_cmd true

universe u
variables {α : Type u}

/-- A linearly ordered commutative monoid with a zero element. -/
class linear_ordered_comm_monoid_with_zero (α : Type*)
  extends linear_ordered_comm_monoid α, comm_monoid_with_zero α :=
(zero_le_one : (0 : α) ≤ 1)

@[priority 100]
instance linear_ordered_comm_monoid_with_zero.to_zero_le_one_class
  [linear_ordered_comm_monoid_with_zero α] : zero_le_one_class α :=
{ ..‹linear_ordered_comm_monoid_with_zero α› }

@[priority 100]
instance canonically_ordered_add_monoid.to_zero_le_one_class [canonically_ordered_add_monoid α]
  [has_one α] : zero_le_one_class α :=
⟨zero_le 1⟩

namespace with_zero

local attribute [semireducible] with_zero

instance [preorder α] : preorder (with_zero α) := with_bot.preorder

instance [partial_order α] : partial_order (with_zero α) := with_bot.partial_order

instance [preorder α] : order_bot (with_zero α) := with_bot.order_bot

lemma zero_le [preorder α] (a : with_zero α) : 0 ≤ a := bot_le

lemma zero_lt_coe [preorder α] (a : α) : (0 : with_zero α) < a := with_bot.bot_lt_coe a

lemma zero_eq_bot [preorder α] : (0 : with_zero α) = ⊥ := rfl

@[simp, norm_cast] lemma coe_lt_coe [preorder α] {a b : α} : (a : with_zero α) < b ↔ a < b :=
with_bot.coe_lt_coe

@[simp, norm_cast] lemma coe_le_coe [preorder α] {a b : α} : (a : with_zero α) ≤ b ↔ a ≤ b :=
with_bot.coe_le_coe

instance [lattice α] : lattice (with_zero α) := with_bot.lattice

instance [linear_order α] : linear_order (with_zero α) := with_bot.linear_order

instance covariant_class_mul_le {α : Type u} [has_mul α] [preorder α]
  [covariant_class α α (*) (≤)] :
  covariant_class (with_zero α) (with_zero α) (*) (≤) :=
begin
  refine ⟨λ a b c hbc, _⟩,
  induction a using with_zero.rec_zero_coe, { exact zero_le _ },
  induction b using with_zero.rec_zero_coe, { exact zero_le _ },
  rcases with_bot.coe_le_iff.1 hbc with ⟨c, rfl, hbc'⟩,
  rw [← coe_mul, ← coe_mul, coe_le_coe],
  exact mul_le_mul_left' hbc' a
end

@[simp] lemma le_max_iff [linear_order α] {a b c : α} :
  (a : with_zero α) ≤ max b c ↔ a ≤ max b c :=
by simp only [with_zero.coe_le_coe, le_max_iff]

@[simp] lemma min_le_iff [linear_order α] {a b c : α} :
   min (a : with_zero α) b ≤ c ↔ min a b ≤ c :=
by simp only [with_zero.coe_le_coe, min_le_iff]

instance [ordered_comm_monoid α] : ordered_comm_monoid (with_zero α) :=
{ mul_le_mul_left := λ _ _, mul_le_mul_left',
  ..with_zero.comm_monoid_with_zero,
  ..with_zero.partial_order }

protected lemma covariant_class_add_le [add_zero_class α] [preorder α]
  [covariant_class α α (+) (≤)] (h : ∀ a : α, 0 ≤ a) :
  covariant_class (with_zero α) (with_zero α) (+) (≤) :=
begin
  refine ⟨λ a b c hbc, _⟩,
  induction a using with_zero.rec_zero_coe,
  { rwa [zero_add, zero_add] },
  induction b using with_zero.rec_zero_coe,
  { rw [add_zero],
    induction c using with_zero.rec_zero_coe,
    { rw [add_zero], exact le_rfl },
    { rw [← coe_add, coe_le_coe],
      exact le_add_of_nonneg_right (h _) } },
  { rcases with_bot.coe_le_iff.1 hbc with ⟨c, rfl, hbc'⟩,
    rw [← coe_add, ← coe_add, coe_le_coe],
    exact add_le_add_left hbc' a }
end

/-
Note 1 : the below is not an instance because it requires `zero_le`. It seems
like a rather pathological definition because α already has a zero.
Note 2 : there is no multiplicative analogue because it does not seem necessary.
Mathematicians might be more likely to use the order-dual version, where all
elements are ≤ 1 and then 1 is the top element.
-/

/--
If `0` is the least element in `α`, then `with_zero α` is an `ordered_add_comm_monoid`.
See note [reducible non-instances].
-/
@[reducible] protected def ordered_add_comm_monoid [ordered_add_comm_monoid α]
  (zero_le : ∀ a : α, 0 ≤ a) : ordered_add_comm_monoid (with_zero α) :=
{ add_le_add_left := @add_le_add_left _ _ _ (with_zero.covariant_class_add_le zero_le),
  ..with_zero.partial_order,
  ..with_zero.add_comm_monoid, .. }

end with_zero

section canonically_ordered_monoid

instance with_zero.has_exists_add_of_le {α} [has_add α] [preorder α] [has_exists_add_of_le α] :
  has_exists_add_of_le (with_zero α) :=
⟨λ a b, begin
  apply with_zero.cases_on a,
  { exact λ _, ⟨b, (zero_add b).symm⟩ },
  apply with_zero.cases_on b,
  { exact λ b' h, (with_bot.not_coe_le_bot _ h).elim },
  rintro a' b' h,
  obtain ⟨c, rfl⟩ := exists_add_of_le (with_zero.coe_le_coe.1 h),
  exact ⟨c, rfl⟩,
end⟩

-- This instance looks absurd: a monoid already has a zero
/-- Adding a new zero to a canonically ordered additive monoid produces another one. -/
instance with_zero.canonically_ordered_add_monoid {α : Type u} [canonically_ordered_add_monoid α] :
  canonically_ordered_add_monoid (with_zero α) :=
{ le_self_add := λ a b, begin
    apply with_zero.cases_on a,
    { exact bot_le },
    apply with_zero.cases_on b,
    { exact λ b', le_rfl },
    { exact λ a' b', with_zero.coe_le_coe.2 le_self_add }
  end,
  .. with_zero.order_bot,
  .. with_zero.ordered_add_comm_monoid zero_le, ..with_zero.has_exists_add_of_le }

end canonically_ordered_monoid

section canonically_linear_ordered_monoid

instance with_zero.canonically_linear_ordered_add_monoid
  (α : Type*) [canonically_linear_ordered_add_monoid α] :
    canonically_linear_ordered_add_monoid (with_zero α) :=
{ .. with_zero.canonically_ordered_add_monoid,
  .. with_zero.linear_order }

end canonically_linear_ordered_monoid


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

! This file was ported from Lean 3 source module algebra.category.Module.projective
! leanprover-community/mathlib commit 201a3f4a0e59b5f836fe8a6c1a462ee674327211
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Category.Module.EpiMono
import Mathbin.Algebra.Module.Projective
import Mathbin.CategoryTheory.Preadditive.Projective
import Mathbin.LinearAlgebra.FinsuppVectorSpace

/-!
# The category of `R`-modules has enough projectives.
-/

universe v u

open CategoryTheory

open CategoryTheory.Limits

open LinearMap

open ModuleCat

/-- The categorical notion of projective object agrees with the explicit module-theoretic notion. -/
theorem IsProjective.iff_projective {R : Type u} [Ring R] {P : Type max u v} [AddCommGroup P]
    [Module R P] : Module.Projective R P ↔ Projective (ModuleCat.of R P) :=
  by
  refine' ⟨fun h => _, fun h => _⟩
  · letI : Module.Projective R ↥(ModuleCat.of R P) := h
    exact
      ⟨fun E X f e epi =>
        Module.projective_lifting_property _ _ ((ModuleCat.epi_iff_surjective _).mp epi)⟩
  · refine' Module.projectiveOfLiftingProperty _
    intro E X mE mX sE sX f g s
    haveI : epi (↟f) := (ModuleCat.epi_iff_surjective (↟f)).mpr s
    letI : projective (ModuleCat.of R P) := h
    exact ⟨projective.factor_thru (↟g) (↟f), projective.factor_thru_comp (↟g) (↟f)⟩
#align is_projective.iff_projective IsProjective.iff_projective

namespace ModuleCat

variable {R : Type u} [Ring R] {M : ModuleCat.{max u v} R}

-- We transport the corresponding result from `module.projective`.
/-- Modules that have a basis are projective. -/
theorem projective_of_free {ι : Type _} (b : Basis ι R M) : Projective M :=
  Projective.of_iso (ModuleCat.ofSelfIso _)
    (IsProjective.iff_projective.mp (Module.projectiveOfBasis b))
#align Module.projective_of_free ModuleCat.projective_of_free

/-- The category of modules has enough projectives, since every module is a quotient of a free
    module. -/
instance moduleCat_enoughProjectives : EnoughProjectives (ModuleCat.{max u v} R)
    where presentation M :=
    ⟨{  P := ModuleCat.of R (M →₀ R)
        Projective := projective_of_free Finsupp.basisSingleOne
        f := Finsupp.basisSingleOne.constr ℕ id
        Epi :=
          (epi_iff_range_eq_top _).mpr
            (range_eq_top.2 fun m => ⟨Finsupp.single m (1 : R), by simp [Basis.constr]⟩) }⟩
#align Module.Module_enough_projectives ModuleCat.moduleCat_enoughProjectives

end ModuleCat


import topology.tactic
import topology.algebra.monoid
import topology.instances.real
import analysis.special_functions.trigonometric.basic

example {X Y : Type*} [topological_space X] [topological_space Y]
  (f₁ f₂ : X → Y) (hf₁ : continuous f₁) (hf₂ : continuous f₂)
  (g : Y → ℝ) (hg : continuous g) : continuous (λ x, (max (g (f₁ x)) (g (f₂ x))) + 1) :=
by guard_proof_term { continuity } ((hg.comp hf₁).max (hg.comp hf₂)).add continuous_const

example {κ ι : Type}
  (K : κ → Type) [∀ k, topological_space (K k)] (I : ι → Type) [∀ i, topological_space (I i)]
  (e : κ ≃ ι) (F : Π k, homeomorph (K k) (I (e k))) :
  continuous (λ (f : Π k, K k) (i : ι), F (e.symm i) (f (e.symm i))) :=
by guard_proof_term { continuity }
  @continuous_pi _ _ _ _ _ (λ (f : Π k, K k) i, (F (e.symm i)) (f (e.symm i)))
    (λ (i : ι), ((F (e.symm i)).continuous).comp (continuous_apply (e.symm i)))

open real

local attribute [continuity] continuous_exp continuous_sin continuous_cos

example : continuous (λ x : ℝ, exp ((max x (-x)) + sin x)^2) :=
by guard_proof_term { continuity }
  (continuous_exp.comp ((continuous_id.max continuous_id.neg).add continuous_sin)).pow 2

example : continuous (λ x : ℝ, exp ((max x (-x)) + sin (cos x))^2) :=
by guard_proof_term { continuity }
 (continuous_exp.comp ((continuous_id'.max continuous_id'.neg).add (continuous_sin.comp continuous_cos))).pow 2

-- Without `md := semireducible` in the call to `apply_rules` in `continuity`,
-- this last example would have run off the rails:
-- ```
-- example : continuous (λ x : ℝ, exp ((max x (-x)) + sin (cos x))^2) :=
-- by show_term { continuity! }
-- ```
-- produces lots of subgoals, including many copies of
-- ⊢ continuous complex.re
-- ⊢ continuous complex.exp
-- ⊢ continuous coe
-- ⊢ continuous (λ (x : ℝ), ↑x)


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

! This file was ported from Lean 3 source module category_theory.subobject.comma
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Subobject.WellPowered
import Mathbin.CategoryTheory.Limits.Preserves.Finite
import Mathbin.CategoryTheory.Limits.Shapes.FiniteLimits

/-!
# Subobjects in the category of structured arrows

We compute the subobjects of an object `A` in the category `structured_arrow S T` for `T : C ⥤ D`
and `S : D` as a subtype of the subobjects of `A.right`. We deduce that `structured_arrow S T` is
well-powered if `C` is.

## Main declarations
* `structured_arrow.equiv_subtype`: the order-equivalence between `subobject A` and a subtype of
  `subobject A.right`.

## Implementation notes
Our computation requires that `C` has all limits and `T` preserves all limits. Furthermore, we
require that the morphisms of `C` and `D` are in the same universe. It is possible that both of
these requirements can be relaxed by refining the results about limits in comma categories.

We also provide the dual results. As usual, we use `subobject (op A)` for the quotient objects of
`A`.

-/

noncomputable section

open CategoryTheory.Limits Opposite

universe v u₁ u₂

namespace CategoryTheory

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

namespace StructuredArrow

variable {S : D} {T : C ⥤ D}

/-- Every subobject of a structured arrow can be projected to a subobject of the underlying
    object. -/
def projectSubobject [HasLimits C] [PreservesLimits T] {A : StructuredArrow S T} :
    Subobject A → Subobject A.right :=
  by
  refine' subobject.lift (fun P f hf => subobject.mk f.right) _
  intro P Q f g hf hg i hi
  refine' subobject.mk_eq_mk_of_comm _ _ ((proj S T).mapIso i) _
  exact congr_arg comma_morphism.right hi
#align category_theory.structured_arrow.project_subobject CategoryTheory.StructuredArrow.projectSubobject

@[simp]
theorem projectSubobject_mk [HasLimits C] [PreservesLimits T] {A P : StructuredArrow S T}
    (f : P ⟶ A) [Mono f] : projectSubobject (Subobject.mk f) = Subobject.mk f.right :=
  rfl
#align category_theory.structured_arrow.project_subobject_mk CategoryTheory.StructuredArrow.projectSubobject_mk

theorem projectSubobject_factors [HasLimits C] [PreservesLimits T] {A : StructuredArrow S T} :
    ∀ P : Subobject A, ∃ q, q ≫ T.map (projectSubobject P).arrow = A.Hom :=
  Subobject.ind _ fun P f hf =>
    ⟨P.Hom ≫ T.map (Subobject.underlyingIso _).inv,
      by
      dsimp
      simp [← T.map_comp]⟩
#align category_theory.structured_arrow.project_subobject_factors CategoryTheory.StructuredArrow.projectSubobject_factors

/-- A subobject of the underlying object of a structured arrow can be lifted to a subobject of
    the structured arrow, provided that there is a morphism making the subobject into a structured
    arrow. -/
@[simp]
def liftSubobject {A : StructuredArrow S T} (P : Subobject A.right) {q}
    (hq : q ≫ T.map P.arrow = A.Hom) : Subobject A :=
  Subobject.mk (homMk P.arrow hq : mk q ⟶ A)
#align category_theory.structured_arrow.lift_subobject CategoryTheory.StructuredArrow.liftSubobject

/-- Projecting and then lifting a subobject recovers the original subobject, because there is at
    most one morphism making the projected subobject into a structured arrow. -/
theorem lift_projectSubobject [HasLimits C] [PreservesLimits T] {A : StructuredArrow S T} :
    ∀ (P : Subobject A) {q} (hq : q ≫ T.map (projectSubobject P).arrow = A.Hom),
      liftSubobject (projectSubobject P) hq = P :=
  Subobject.ind _
    (by
      intro P f hf q hq
      fapply subobject.mk_eq_mk_of_comm
      · fapply iso_mk
        · exact subobject.underlying_iso _
        ·
          exact
            (cancel_mono (T.map f.right)).1
              (by
                dsimp
                simpa [← T.map_comp] using hq)
      ·
        exact
          ext _ _
            (by
              dsimp
              simp))
#align category_theory.structured_arrow.lift_project_subobject CategoryTheory.StructuredArrow.lift_projectSubobject

/-- If `A : S → T.obj B` is a structured arrow for `S : D` and `T : C ⥤ D`, then we can explicitly
    describe the subobjects of `A` as the subobjects `P` of `B` in `C` for which `A.hom` factors
    through the image of `P` under `T`. -/
@[simps]
def subobjectEquiv [HasLimits C] [PreservesLimits T] (A : StructuredArrow S T) :
    Subobject A ≃o { P : Subobject A.right // ∃ q, q ≫ T.map P.arrow = A.Hom }
    where
  toFun P := ⟨projectSubobject P, projectSubobject_factors P⟩
  invFun P := liftSubobject P.val P.Prop.choose_spec
  left_inv P := lift_projectSubobject _ _
  right_inv P := Subtype.ext (by simp)
  map_rel_iff' :=
    Subobject.ind₂ _
      (by
        intro P Q f g hf hg
        refine' ⟨fun h => subobject.mk_le_mk_of_comm _ (ext _ _ _), fun h => _⟩
        · refine' hom_mk (subobject.of_mk_le_mk _ _ h) ((cancel_mono (T.map g.right)).1 _)
          simp [← T.map_comp]
        ·
          simp only [mono_over.mk'_arrow, subobject.of_mk_le_mk_comp, comma.comp_right,
            hom_mk_right]
        · refine' subobject.mk_le_mk_of_comm (subobject.of_mk_le_mk _ _ h).right _
          exact congr_arg comma_morphism.right (subobject.of_mk_le_mk_comp h))
#align category_theory.structured_arrow.subobject_equiv CategoryTheory.StructuredArrow.subobjectEquiv

/-- If `C` is well-powered and complete and `T` preserves limits, then `structured_arrow S T` is
    well-powered. -/
instance wellPowered_structuredArrow [WellPowered C] [HasLimits C] [PreservesLimits T] :
    WellPowered (StructuredArrow S T)
    where subobject_small X := small_map (subobjectEquiv X).toEquiv
#align category_theory.structured_arrow.well_powered_structured_arrow CategoryTheory.StructuredArrow.wellPowered_structuredArrow

end StructuredArrow

namespace CostructuredArrow

variable {S : C ⥤ D} {T : D}

/-- Every quotient of a costructured arrow can be projected to a quotient of the underlying
    object. -/
def projectQuotient [HasColimits C] [PreservesColimits S] {A : CostructuredArrow S T} :
    Subobject (op A) → Subobject (op A.left) :=
  by
  refine' subobject.lift (fun P f hf => subobject.mk f.unop.left.op) _
  intro P Q f g hf hg i hi
  refine' subobject.mk_eq_mk_of_comm _ _ ((proj S T).mapIso i.unop).op (Quiver.Hom.unop_inj _)
  have := congr_arg Quiver.Hom.unop hi
  simpa using congr_arg comma_morphism.left this
#align category_theory.costructured_arrow.project_quotient CategoryTheory.CostructuredArrow.projectQuotient

@[simp]
theorem projectQuotient_mk [HasColimits C] [PreservesColimits S] {A : CostructuredArrow S T}
    {P : (CostructuredArrow S T)ᵒᵖ} (f : P ⟶ op A) [Mono f] :
    projectQuotient (Subobject.mk f) = Subobject.mk f.unop.left.op :=
  rfl
#align category_theory.costructured_arrow.project_quotient_mk CategoryTheory.CostructuredArrow.projectQuotient_mk

theorem projectQuotient_factors [HasColimits C] [PreservesColimits S] {A : CostructuredArrow S T} :
    ∀ P : Subobject (op A), ∃ q, S.map (projectQuotient P).arrow.unop ≫ q = A.Hom :=
  Subobject.ind _ fun P f hf =>
    ⟨S.map (Subobject.underlyingIso _).unop.inv ≫ P.unop.Hom,
      by
      dsimp
      rw [← category.assoc, ← S.map_comp, ← unop_comp]
      simp⟩
#align category_theory.costructured_arrow.project_quotient_factors CategoryTheory.CostructuredArrow.projectQuotient_factors

/-- A quotient of the underlying object of a costructured arrow can be lifted to a quotient of
    the costructured arrow, provided that there is a morphism making the quotient into a
    costructured arrow. -/
@[simp]
def liftQuotient {A : CostructuredArrow S T} (P : Subobject (op A.left)) {q}
    (hq : S.map P.arrow.unop ≫ q = A.Hom) : Subobject (op A) :=
  Subobject.mk (homMk P.arrow.unop hq : A ⟶ mk q).op
#align category_theory.costructured_arrow.lift_quotient CategoryTheory.CostructuredArrow.liftQuotient

/-- Technical lemma for `lift_project_quotient`. -/
@[simp]
theorem unop_left_comp_underlyingIso_hom_unop {A : CostructuredArrow S T}
    {P : (CostructuredArrow S T)ᵒᵖ} (f : P ⟶ op A) [Mono f.unop.left.op] :
    f.unop.left ≫ (Subobject.underlyingIso f.unop.left.op).Hom.unop =
      (Subobject.mk f.unop.left.op).arrow.unop :=
  by
  conv_lhs =>
    congr
    rw [← Quiver.Hom.unop_op f.unop.left]
  rw [← unop_comp, subobject.underlying_iso_hom_comp_eq_mk]
#align category_theory.costructured_arrow.unop_left_comp_underlying_iso_hom_unop CategoryTheory.CostructuredArrow.unop_left_comp_underlyingIso_hom_unop

/-- Projecting and then lifting a quotient recovers the original quotient, because there is at most
    one morphism making the projected quotient into a costructured arrow. -/
theorem lift_projectQuotient [HasColimits C] [PreservesColimits S] {A : CostructuredArrow S T} :
    ∀ (P : Subobject (op A)) {q} (hq : S.map (projectQuotient P).arrow.unop ≫ q = A.Hom),
      liftQuotient (projectQuotient P) hq = P :=
  Subobject.ind _
    (by
      intro P f hf q hq
      fapply subobject.mk_eq_mk_of_comm
      · refine' (iso.op (iso_mk _ _) : _ ≅ op (unop P))
        · exact (subobject.underlying_iso f.unop.left.op).unop
        · refine' (cancel_epi (S.map f.unop.left)).1 _
          simpa [← category.assoc, ← S.map_comp] using hq
      ·
        exact
          Quiver.Hom.unop_inj
            (ext _ _
              (by
                dsimp
                simp)))
#align category_theory.costructured_arrow.lift_project_quotient CategoryTheory.CostructuredArrow.lift_projectQuotient

/-- Technical lemma for `quotient_equiv`. -/
theorem unop_left_comp_ofMkLeMk_unop {A : CostructuredArrow S T} {P Q : (CostructuredArrow S T)ᵒᵖ}
    {f : P ⟶ op A} {g : Q ⟶ op A} [Mono f.unop.left.op] [Mono g.unop.left.op]
    (h : Subobject.mk f.unop.left.op ≤ Subobject.mk g.unop.left.op) :
    g.unop.left ≫ (Subobject.ofMkLeMk f.unop.left.op g.unop.left.op h).unop = f.unop.left :=
  by
  conv_lhs =>
    congr
    rw [← Quiver.Hom.unop_op g.unop.left]
  rw [← unop_comp]
  simp only [subobject.of_mk_le_mk_comp, Quiver.Hom.unop_op]
#align category_theory.costructured_arrow.unop_left_comp_of_mk_le_mk_unop CategoryTheory.CostructuredArrow.unop_left_comp_ofMkLeMk_unop

/-- If `A : S.obj B ⟶ T` is a costructured arrow for `S : C ⥤ D` and `T : D`, then we can
    explicitly describe the quotients of `A` as the quotients `P` of `B` in `C` for which `A.hom`
    factors through the image of `P` under `S`. -/
def quotientEquiv [HasColimits C] [PreservesColimits S] (A : CostructuredArrow S T) :
    Subobject (op A) ≃o { P : Subobject (op A.left) // ∃ q, S.map P.arrow.unop ≫ q = A.Hom }
    where
  toFun P := ⟨projectQuotient P, projectQuotient_factors P⟩
  invFun P := liftQuotient P.val P.Prop.choose_spec
  left_inv P := lift_projectQuotient _ _
  right_inv P := Subtype.ext (by simp)
  map_rel_iff' :=
    Subobject.ind₂ _
      (by
        intro P Q f g hf hg
        refine'
          ⟨fun h => subobject.mk_le_mk_of_comm _ (Quiver.Hom.unop_inj (ext _ _ _)), fun h => _⟩
        · refine'
            (hom_mk (subobject.of_mk_le_mk _ _ h).unop ((cancel_epi (S.map g.unop.left)).1 _)).op
          dsimp only [mono_over.mk'_arrow]
          rw [← category.assoc, ← S.map_comp, unop_left_comp_of_mk_le_mk_unop]
          dsimp
          simp
        · exact unop_left_comp_of_mk_le_mk_unop _
        · refine' subobject.mk_le_mk_of_comm (subobject.of_mk_le_mk _ _ h).unop.left.op _
          refine' Quiver.Hom.unop_inj _
          have := congr_arg Quiver.Hom.unop (subobject.of_mk_le_mk_comp h)
          simpa [-subobject.of_mk_le_mk_comp] using congr_arg comma_morphism.left this)
#align category_theory.costructured_arrow.quotient_equiv CategoryTheory.CostructuredArrow.quotientEquiv

/-- If `C` is well-copowered and cocomplete and `S` preserves colimits, then
    `costructured_arrow S T` is well-copowered. -/
instance well_copowered_costructuredArrow [WellPowered Cᵒᵖ] [HasColimits C] [PreservesColimits S] :
    WellPowered (CostructuredArrow S T)ᵒᵖ
    where subobject_small X := small_map (quotientEquiv (unop X)).toEquiv
#align category_theory.costructured_arrow.well_copowered_costructured_arrow CategoryTheory.CostructuredArrow.well_copowered_costructuredArrow

end CostructuredArrow

end CategoryTheory


/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import category_theory.endomorphism
import algebra.group_power

/-!
# Conjugate morphisms by isomorphisms

An isomorphism `α : X ≅ Y` defines
- a monoid isomorphism `conj : End X ≃* End Y` by `α.conj f = α.inv ≫ f ≫ α.hom`;
- a group isomorphism `conj_Aut : Aut X ≃* Aut Y` by `α.conj_Aut f = α.symm ≪≫ f ≪≫ α`.

For completeness, we also define `hom_congr : (X ≅ X₁) → (Y ≅ Y₁) → (X ⟶ Y) ≃ (X₁ ⟶ Y₁)`,
cf. `equiv.arrow_congr`.
-/

universes v u

namespace category_theory

namespace iso

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

/-- If `X` is isomorphic to `X₁` and `Y` is isomorphic to `Y₁`, then
there is a natural bijection between `X ⟶ Y` and `X₁ ⟶ Y₁`. See also `equiv.arrow_congr`. -/
def hom_congr {X Y X₁ Y₁ : C} (α : X ≅ X₁) (β : Y ≅ Y₁) :
  (X ⟶ Y) ≃ (X₁ ⟶ Y₁) :=
{ to_fun := λ f, α.inv ≫ f ≫ β.hom,
  inv_fun := λ f, α.hom ≫ f ≫ β.inv,
  left_inv := λ f, show α.hom ≫ (α.inv ≫ f ≫ β.hom) ≫ β.inv = f,
    by rw [category.assoc, category.assoc, β.hom_inv_id, α.hom_inv_id_assoc, category.comp_id],
  right_inv := λ f, show α.inv ≫ (α.hom ≫ f ≫ β.inv) ≫ β.hom = f,
    by rw [category.assoc, category.assoc, β.inv_hom_id, α.inv_hom_id_assoc, category.comp_id] }

@[simp]
lemma hom_congr_apply {X Y X₁ Y₁ : C} (α : X ≅ X₁) (β : Y ≅ Y₁) (f : X ⟶ Y) :
  α.hom_congr β f = α.inv ≫ f ≫ β.hom :=
rfl

lemma hom_congr_comp {X Y Z X₁ Y₁ Z₁ : C} (α : X ≅ X₁) (β : Y ≅ Y₁) (γ : Z ≅ Z₁)
  (f : X ⟶ Y) (g : Y ⟶ Z) :
  α.hom_congr γ (f ≫ g) = α.hom_congr β f ≫ β.hom_congr γ g :=
by simp

@[simp] lemma hom_congr_refl {X Y : C} (f : X ⟶ Y) :
  (iso.refl X).hom_congr (iso.refl Y) f = f :=
by simp

@[simp] lemma hom_congr_trans {X₁ Y₁ X₂ Y₂ X₃ Y₃ : C}
  (α₁ : X₁ ≅ X₂) (β₁ : Y₁ ≅ Y₂) (α₂ : X₂ ≅ X₃) (β₂ : Y₂ ≅ Y₃) (f : X₁ ⟶ Y₁) :
  (α₁ ≪≫ α₂).hom_congr (β₁ ≪≫ β₂) f = (α₁.hom_congr β₁).trans (α₂.hom_congr β₂) f :=
by simp

@[simp] lemma hom_congr_symm {X₁ Y₁ X₂ Y₂ : C} (α : X₁ ≅ X₂) (β : Y₁ ≅ Y₂) :
  (α.hom_congr β).symm = α.symm.hom_congr β.symm :=
rfl

variables {X Y : C} (α : X ≅ Y)

/-- An isomorphism between two objects defines a monoid isomorphism between their
monoid of endomorphisms. -/
def conj : End X ≃* End Y :=
{ map_mul' := λ f g, hom_congr_comp α α α g f,
  .. hom_congr α α }

lemma conj_apply (f : End X) : α.conj f = α.inv ≫ f ≫ α.hom := rfl

@[simp] lemma conj_comp (f g : End X) : α.conj (f ≫ g) = (α.conj f) ≫ (α.conj g) :=
α.conj.map_mul g f

@[simp] lemma conj_id : α.conj (𝟙 X) = 𝟙 Y :=
α.conj.map_one

@[simp] lemma refl_conj (f : End X) : (iso.refl X).conj f = f :=
by rw [conj_apply, iso.refl_inv, iso.refl_hom, category.id_comp, category.comp_id]

@[simp] lemma trans_conj {Z : C} (β : Y ≅ Z) (f : End X) : (α ≪≫ β).conj f = β.conj (α.conj f) :=
hom_congr_trans α α β β f

@[simp] lemma symm_self_conj (f : End X) : α.symm.conj (α.conj f) = f :=
by rw [← trans_conj, α.self_symm_id, refl_conj]

@[simp] lemma self_symm_conj (f : End Y) : α.conj (α.symm.conj f) = f :=
α.symm.symm_self_conj f

@[simp] lemma conj_pow (f : End X) (n : ℕ) : α.conj (f^n) = (α.conj f)^n :=
α.conj.to_monoid_hom.map_pow f n

/-- `conj` defines a group isomorphisms between groups of automorphisms -/
def conj_Aut : Aut X ≃* Aut Y :=
(Aut.units_End_equiv_Aut X).symm.trans $
(units.map_equiv α.conj).trans $
Aut.units_End_equiv_Aut Y

lemma conj_Aut_apply (f : Aut X) : α.conj_Aut f = α.symm ≪≫ f ≪≫ α :=
by cases f; cases α; ext; refl

@[simp] lemma conj_Aut_hom (f : Aut X) : (α.conj_Aut f).hom = α.conj f.hom := rfl

@[simp] lemma trans_conj_Aut {Z : C} (β : Y ≅ Z) (f : Aut X) :
  (α ≪≫ β).conj_Aut f = β.conj_Aut (α.conj_Aut f) :=
by simp only [conj_Aut_apply, iso.trans_symm, iso.trans_assoc]

@[simp] lemma conj_Aut_mul (f g : Aut X) : α.conj_Aut (f * g) = α.conj_Aut f * α.conj_Aut g :=
α.conj_Aut.map_mul f g

@[simp] lemma conj_Aut_trans (f g : Aut X) : α.conj_Aut (f ≪≫ g) = α.conj_Aut f ≪≫ α.conj_Aut g :=
conj_Aut_mul α g f

@[simp] lemma conj_Aut_pow (f : Aut X) (n : ℕ) : α.conj_Aut (f^n) = (α.conj_Aut f)^n :=
α.conj_Aut.to_monoid_hom.map_pow f n

@[simp] lemma conj_Aut_gpow (f : Aut X) (n : ℤ) : α.conj_Aut (f^n) = (α.conj_Aut f)^n :=
α.conj_Aut.to_monoid_hom.map_gpow f n

end iso

namespace functor

universes v₁ u₁

variables {C : Type u} [category.{v} C] {D : Type u₁} [category.{v₁} D] (F : C ⥤ D)

lemma map_hom_congr {X Y X₁ Y₁ : C} (α : X ≅ X₁) (β : Y ≅ Y₁) (f : X ⟶ Y) :
  F.map (iso.hom_congr α β f) = iso.hom_congr (F.map_iso α) (F.map_iso β) (F.map f) :=
by simp

lemma map_conj {X Y : C} (α : X ≅ Y) (f : End X) :
  F.map (α.conj f) = (F.map_iso α).conj (F.map f) :=
map_hom_congr F α α f

lemma map_conj_Aut (F : C ⥤ D) {X Y : C} (α : X ≅ Y) (f : Aut X) :
  F.map_iso (α.conj_Aut f) = (F.map_iso α).conj_Aut (F.map_iso f) :=
by ext; simp only [map_iso_hom, iso.conj_Aut_hom, F.map_conj]
-- alternative proof: by simp only [iso.conj_Aut_apply, F.map_iso_trans, F.map_iso_symm]

end functor
end category_theory