/-
Copyright (c) 2021 Yuma Mizuno. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yuma Mizuno

! This file was ported from Lean 3 source module category_theory.bicategory.basic
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Iso

/-!
# Bicategories

In this file we define typeclass for bicategories.

A bicategory `B` consists of
* objects `a : B`,
* 1-morphisms `f : a ⟶ b` between objects `a b : B`, and
* 2-morphisms `η : f ⟶ g` beween 1-morphisms `f g : a ⟶ b` between objects `a b : B`.

We use `u`, `v`, and `w` as the universe variables for objects, 1-morphisms, and 2-morphisms,
respectively.

A typeclass for bicategories extends `CategoryTheory.CategoryStruct` typeclass. This means that
we have
* a composition `f ≫ g : a ⟶ c` for each 1-morphisms `f : a ⟶ b` and `g : b ⟶ c`, and
* a identity `𝟙 a : a ⟶ a` for each object `a : B`.

For each object `a b : B`, the collection of 1-morphisms `a ⟶ b` has a category structure. The
2-morphisms in the bicategory are implemented as the morphisms in this family of categories.

The composition of 1-morphisms is in fact a object part of a functor
`(a ⟶ b) ⥤ (b ⟶ c) ⥤ (a ⟶ c)`. The definition of bicategories in this file does not
require this functor directly. Instead, it requires the whiskering functions. For a 1-morphism
`f : a ⟶ b` and a 2-morphism `η : g ⟶ h` between 1-morphisms `g h : b ⟶ c`, there is a
2-morphism `whiskerLeft f η : f ≫ g ⟶ f ≫ h`. Similarly, for a 2-morphism `η : f ⟶ g`
between 1-morphisms `f g : a ⟶ b` and a 1-morphism `f : b ⟶ c`, there is a 2-morphism
`whiskerRight η h : f ≫ h ⟶ g ≫ h`. These satisfy the exchange law
`whiskerLeft f θ ≫ whiskerRight η i = whiskerRight η h ≫ whiskerReft g θ`,
which is required as an axiom in the definition here.
-/

namespace CategoryTheory

universe w v u

open Category Iso

-- intended to be used with explicit universe parameters
/-- In a bicategory, we can compose the 1-morphisms `f : a ⟶ b` and `g : b ⟶ c` to obtain
a 1-morphism `f ≫ g : a ⟶ c`. This composition does not need to be strictly associative,
but there is a specified associator, `α_ f g h : (f ≫ g) ≫ h ≅ f ≫ (g ≫ h)`.
There is an identity 1-morphism `𝟙 a : a ⟶ a`, with specified left and right unitor
isomorphisms `λ_ f : 𝟙 a ≫ f ≅ f` and `ρ_ f : f ≫ 𝟙 a ≅ f`.
These associators and unitors satisfy the pentagon and triangle equations.

See https://ncatlab.org/nlab/show/bicategory.
-/
@[nolint checkUnivs]
class Bicategory (B : Type u) extends CategoryStruct.{v} B where
  -- category structure on the collection of 1-morphisms:
  homCategory : ∀ a b : B, Category.{w} (a ⟶ b) := by infer_instance
  -- left whiskering:
  whiskerLeft {a b c : B} (f : a ⟶ b) {g h : b ⟶ c} (η : g ⟶ h) : f ≫ g ⟶ f ≫ h
  -- right whiskering:
  whiskerRight {a b c : B} {f g : a ⟶ b} (η : f ⟶ g) (h : b ⟶ c) : f ≫ h ⟶ g ≫ h
  -- associator:
  associator {a b c d : B} (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d) : (f ≫ g) ≫ h ≅ f ≫ g ≫ h
  -- left unitor:
  leftUnitor {a b : B} (f : a ⟶ b) : 𝟙 a ≫ f ≅ f
  -- right unitor:
  rightUnitor {a b : B} (f : a ⟶ b) : f ≫ 𝟙 b ≅ f
  -- axioms for left whiskering:
  whiskerLeft_id : ∀ {a b c} (f : a ⟶ b) (g : b ⟶ c), whiskerLeft f (𝟙 g) = 𝟙 (f ≫ g) :=
    by aesop_cat
  whiskerLeft_comp :
    ∀ {a b c} (f : a ⟶ b) {g h i : b ⟶ c} (η : g ⟶ h) (θ : h ⟶ i),
      whiskerLeft f (η ≫ θ) = whiskerLeft f η ≫ whiskerLeft f θ := by
    aesop_cat
  id_whiskerLeft :
    ∀ {a b} {f g : a ⟶ b} (η : f ⟶ g),
      whiskerLeft (𝟙 a) η = (leftUnitor f).hom ≫ η ≫ (leftUnitor g).inv := by
    aesop_cat
  comp_whiskerLeft :
    ∀ {a b c d} (f : a ⟶ b) (g : b ⟶ c) {h h' : c ⟶ d} (η : h ⟶ h'),
      whiskerLeft (f ≫ g) η =
        (associator f g h).hom ≫ whiskerLeft f (whiskerLeft g η) ≫ (associator f g h').inv := by
    aesop_cat
  -- axioms for right whiskering:
  id_whiskerRight : ∀ {a b c} (f : a ⟶ b) (g : b ⟶ c),  whiskerRight (𝟙 f) g = 𝟙 (f ≫ g) := by
    aesop_cat
  comp_whiskerRight :
    ∀ {a b c} {f g h : a ⟶ b} (η : f ⟶ g) (θ : g ⟶ h) (i : b ⟶ c),
      whiskerRight (η ≫ θ) i = whiskerRight η i ≫ whiskerRight θ i := by
    aesop_cat
  whiskerRight_id :
    ∀ {a b} {f g : a ⟶ b} (η : f ⟶ g),
      whiskerRight η (𝟙 b) = (rightUnitor f).hom ≫ η ≫ (rightUnitor g).inv := by
    aesop_cat
  whiskerRight_comp :
    ∀ {a b c d} {f f' : a ⟶ b} (η : f ⟶ f') (g : b ⟶ c) (h : c ⟶ d),
      whiskerRight η (g ≫ h) =
        (associator f g h).inv ≫ whiskerRight (whiskerRight η g) h ≫ (associator f' g h).hom := by
    aesop_cat
  -- associativity of whiskerings:
  whisker_assoc :
    ∀ {a b c d} (f : a ⟶ b) {g g' : b ⟶ c} (η : g ⟶ g') (h : c ⟶ d),
      whiskerRight (whiskerLeft f η) h =
        (associator f g h).hom ≫ whiskerLeft f (whiskerRight η h) ≫ (associator f g' h).inv := by
    aesop_cat
  -- exchange law of left and right whiskerings:
  whisker_exchange :
    ∀ {a b c} {f g : a ⟶ b} {h i : b ⟶ c} (η : f ⟶ g) (θ : h ⟶ i),
      whiskerLeft f θ ≫ whiskerRight η i = whiskerRight η h ≫ whiskerLeft g θ := by
    aesop_cat
  -- pentagon identity:
  pentagon :
    ∀ {a b c d e} (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d) (i : d ⟶ e),
      whiskerRight (associator f g h).hom i ≫
          (associator f (g ≫ h) i).hom ≫ whiskerLeft f (associator g h i).hom =
        (associator (f ≫ g) h i).hom ≫ (associator f g (h ≫ i)).hom := by
    aesop_cat
  -- triangle identity:
  triangle :
    ∀ {a b c} (f : a ⟶ b) (g : b ⟶ c),
      (associator f (𝟙 b) g).hom ≫ whiskerLeft f (leftUnitor g).hom
      = whiskerRight (rightUnitor f).hom g := by
    aesop_cat
#align category_theory.bicategory CategoryTheory.Bicategory
#align category_theory.bicategory.hom_category CategoryTheory.Bicategory.homCategory
#align category_theory.bicategory.whisker_left CategoryTheory.Bicategory.whiskerLeft
#align category_theory.bicategory.whisker_right CategoryTheory.Bicategory.whiskerRight
#align category_theory.bicategory.left_unitor CategoryTheory.Bicategory.leftUnitor
#align category_theory.bicategory.right_unitor CategoryTheory.Bicategory.rightUnitor
#align category_theory.bicategory.whisker_left_id' CategoryTheory.Bicategory.whiskerLeft_id
#align category_theory.bicategory.whisker_left_comp' CategoryTheory.Bicategory.whiskerLeft_comp
#align category_theory.bicategory.id_whisker_left' CategoryTheory.Bicategory.id_whiskerLeft
#align category_theory.bicategory.comp_whisker_left' CategoryTheory.Bicategory.comp_whiskerLeft
#align category_theory.bicategory.id_whisker_right' CategoryTheory.Bicategory.id_whiskerRight
#align category_theory.bicategory.comp_whisker_right' CategoryTheory.Bicategory.comp_whiskerRight
#align category_theory.bicategory.whisker_right_id' CategoryTheory.Bicategory.whiskerRight_id
#align category_theory.bicategory.whisker_right_comp' CategoryTheory.Bicategory.whiskerRight_comp
#align category_theory.bicategory.whisker_assoc' CategoryTheory.Bicategory.whisker_assoc
#align category_theory.bicategory.whisker_exchange' CategoryTheory.Bicategory.whisker_exchange
#align category_theory.bicategory.pentagon' CategoryTheory.Bicategory.pentagon
#align category_theory.bicategory.triangle' CategoryTheory.Bicategory.triangle

namespace Bicategory

scoped infixr:81 " ◁ " => Bicategory.whiskerLeft
scoped infixl:81 " ▷ " => Bicategory.whiskerRight
scoped notation "α_" => Bicategory.associator
scoped notation "λ_" => Bicategory.leftUnitor
scoped notation "ρ_" => Bicategory.rightUnitor

/-!
### Simp-normal form for 2-morphisms

Rewriting involving associators and unitors could be very complicated. We try to ease this
complexity by putting carefully chosen simp lemmas that rewrite any 2-morphisms into simp-normal
form defined below. Rewriting into simp-normal form is also useful when applying (forthcoming)
`coherence` tactic.

The simp-normal form of 2-morphisms is defined to be an expression that has the minimal number of
parentheses. More precisely,
1. it is a composition of 2-morphisms like `η₁ ≫ η₂ ≫ η₃ ≫ η₄ ≫ η₅` such that each `ηᵢ` is
  either a structural 2-morphisms (2-morphisms made up only of identities, associators, unitors)
  or non-structural 2-morphisms, and
2. each non-structural 2-morphism in the composition is of the form `f₁ ◁ f₂ ◁ f₃ ◁ η ▷ f₄ ▷ f₅`,
  where each `fᵢ` is a 1-morphism that is not the identity or a composite and `η` is a
  non-structural 2-morphisms that is also not the identity or a composite.

Note that `f₁ ◁ f₂ ◁ f₃ ◁ η ▷ f₄ ▷ f₅` is actually `f₁ ◁ (f₂ ◁ (f₃ ◁ ((η ▷ f₄) ▷ f₅)))`.
-/

attribute [instance] homCategory

attribute [reassoc]
  whiskerLeft_comp id_whiskerLeft comp_whiskerLeft comp_whiskerRight whiskerRight_id
  whiskerRight_comp whisker_assoc whisker_exchange

attribute [reassoc (attr := simp)] pentagon triangle
/-
The following simp attributes are put in order to rewrite any 2-morphisms into normal forms. There
are associators and unitors in the RHS in the several simp lemmas here (e.g. `id_whiskerLeft`),
which at first glance look more complicated than the LHS, but they will be eventually reduced by
the pentagon or the triangle identities, and more generally, (forthcoming) `coherence` tactic.
-/
attribute [simp]
  whiskerLeft_id whiskerLeft_comp id_whiskerLeft comp_whiskerLeft id_whiskerRight comp_whiskerRight
  whiskerRight_id whiskerRight_comp whisker_assoc

variable {B : Type u} [Bicategory.{w, v} B] {a b c d e : B}

@[reassoc (attr := simp)]
theorem hom_inv_whiskerLeft (f : a ⟶ b) {g h : b ⟶ c} (η : g ≅ h) :
    f ◁ η.hom ≫ f ◁ η.inv = 𝟙 (f ≫ g) := by rw [← whiskerLeft_comp, hom_inv_id, whiskerLeft_id]
#align category_theory.bicategory.hom_inv_whisker_left CategoryTheory.Bicategory.hom_inv_whiskerLeft

@[reassoc (attr := simp)]
theorem hom_inv_whiskerRight {f g : a ⟶ b} (η : f ≅ g) (h : b ⟶ c) :
    η.hom ▷ h ≫ η.inv ▷ h = 𝟙 (f ≫ h) := by rw [← comp_whiskerRight, hom_inv_id, id_whiskerRight]
#align category_theory.bicategory.hom_inv_whisker_right
  CategoryTheory.Bicategory.hom_inv_whiskerRight

@[reassoc (attr := simp)]
theorem inv_hom_whiskerLeft (f : a ⟶ b) {g h : b ⟶ c} (η : g ≅ h) :
    f ◁ η.inv ≫ f ◁ η.hom = 𝟙 (f ≫ h) := by rw [← whiskerLeft_comp, inv_hom_id, whiskerLeft_id]
#align category_theory.bicategory.inv_hom_whisker_left CategoryTheory.Bicategory.inv_hom_whiskerLeft

@[reassoc (attr := simp)]
theorem inv_hom_whiskerRight {f g : a ⟶ b} (η : f ≅ g) (h : b ⟶ c) :
    η.inv ▷ h ≫ η.hom ▷ h = 𝟙 (g ≫ h) := by rw [← comp_whiskerRight, inv_hom_id, id_whiskerRight]
#align category_theory.bicategory.inv_hom_whisker_right CategoryTheory.Bicategory.inv_hom_whiskerRight

/-- The left whiskering of a 2-isomorphism is a 2-isomorphism. -/
@[simps]
def whiskerLeftIso (f : a ⟶ b) {g h : b ⟶ c} (η : g ≅ h) : f ≫ g ≅ f ≫ h
    where
  hom := f ◁ η.hom
  inv := f ◁ η.inv
#align category_theory.bicategory.whisker_left_iso CategoryTheory.Bicategory.whiskerLeftIso

instance whiskerLeft_isIso (f : a ⟶ b) {g h : b ⟶ c} (η : g ⟶ h) [IsIso η] : IsIso (f ◁ η) :=
  IsIso.of_iso (whiskerLeftIso f (asIso η))
#align category_theory.bicategory.whisker_left_is_iso CategoryTheory.Bicategory.whiskerLeft_isIso

@[simp]
theorem inv_whiskerLeft (f : a ⟶ b) {g h : b ⟶ c} (η : g ⟶ h) [IsIso η] :
  inv (f ◁ η) = f ◁ inv η := by
  aesop_cat_nonterminal
  simp only [← whiskerLeft_comp, whiskerLeft_id, IsIso.hom_inv_id]
#align category_theory.bicategory.inv_whisker_left CategoryTheory.Bicategory.inv_whiskerLeft

/-- The right whiskering of a 2-isomorphism is a 2-isomorphism. -/
@[simps!]
def whiskerRightIso {f g : a ⟶ b} (η : f ≅ g) (h : b ⟶ c) : f ≫ h ≅ g ≫ h
    where
  hom := η.hom ▷ h
  inv := η.inv ▷ h
#align category_theory.bicategory.whisker_right_iso CategoryTheory.Bicategory.whiskerRightIso

instance whiskerRight_isIso {f g : a ⟶ b} (η : f ⟶ g) (h : b ⟶ c) [IsIso η] : IsIso (η ▷ h) :=
  IsIso.of_iso (whiskerRightIso (asIso η) h)
#align category_theory.bicategory.whisker_right_is_iso CategoryTheory.Bicategory.whiskerRight_isIso

@[simp]
theorem inv_whiskerRight {f g : a ⟶ b} (η : f ⟶ g) (h : b ⟶ c) [IsIso η] :
    inv (η ▷ h) = inv η ▷ h := by
  aesop_cat_nonterminal
  simp only [← comp_whiskerRight, id_whiskerRight, IsIso.hom_inv_id]
#align category_theory.bicategory.inv_whisker_right CategoryTheory.Bicategory.inv_whiskerRight

@[reassoc (attr := simp)]
theorem pentagon_inv (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d) (i : d ⟶ e) :
    f ◁ (α_ g h i).inv ≫ (α_ f (g ≫ h) i).inv ≫ (α_ f g h).inv ▷ i =
      (α_ f g (h ≫ i)).inv ≫ (α_ (f ≫ g) h i).inv :=
  eq_of_inv_eq_inv (by simp)
#align category_theory.bicategory.pentagon_inv CategoryTheory.Bicategory.pentagon_inv

@[reassoc (attr := simp)]
theorem pentagon_inv_inv_hom_hom_inv (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d) (i : d ⟶ e) :
    (α_ f (g ≫ h) i).inv ≫ (α_ f g h).inv ▷ i ≫ (α_ (f ≫ g) h i).hom =
      f ◁ (α_ g h i).hom ≫ (α_ f g (h ≫ i)).inv :=
  by
  rw [← cancel_epi (f ◁ (α_ g h i).inv), ← cancel_mono (α_ (f ≫ g) h i).inv]
  simp
#align category_theory.bicategory.pentagon_inv_inv_hom_hom_inv CategoryTheory.Bicategory.pentagon_inv_inv_hom_hom_inv

@[reassoc (attr := simp)]
theorem pentagon_inv_hom_hom_hom_inv (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d) (i : d ⟶ e) :
    (α_ (f ≫ g) h i).inv ≫ (α_ f g h).hom ▷ i ≫ (α_ f (g ≫ h) i).hom =
      (α_ f g (h ≫ i)).hom ≫ f ◁ (α_ g h i).inv :=
  eq_of_inv_eq_inv (by simp)
#align category_theory.bicategory.pentagon_inv_hom_hom_hom_inv CategoryTheory.Bicategory.pentagon_inv_hom_hom_hom_inv

@[reassoc (attr := simp)]
theorem pentagon_hom_inv_inv_inv_inv (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d) (i : d ⟶ e) :
    f ◁ (α_ g h i).hom ≫ (α_ f g (h ≫ i)).inv ≫ (α_ (f ≫ g) h i).inv =
      (α_ f (g ≫ h) i).inv ≫ (α_ f g h).inv ▷ i :=
  by simp [← cancel_epi (f ◁ (α_ g h i).inv)]
#align category_theory.bicategory.pentagon_hom_inv_inv_inv_inv CategoryTheory.Bicategory.pentagon_hom_inv_inv_inv_inv

@[reassoc (attr := simp)]
theorem pentagon_hom_hom_inv_hom_hom (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d) (i : d ⟶ e) :
    (α_ (f ≫ g) h i).hom ≫ (α_ f g (h ≫ i)).hom ≫ f ◁ (α_ g h i).inv =
      (α_ f g h).hom ▷ i ≫ (α_ f (g ≫ h) i).hom :=
  eq_of_inv_eq_inv (by simp)
#align category_theory.bicategory.pentagon_hom_hom_inv_hom_hom CategoryTheory.Bicategory.pentagon_hom_hom_inv_hom_hom

@[reassoc (attr := simp)]
theorem pentagon_hom_inv_inv_inv_hom (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d) (i : d ⟶ e) :
    (α_ f g (h ≫ i)).hom ≫ f ◁ (α_ g h i).inv ≫ (α_ f (g ≫ h) i).inv =
      (α_ (f ≫ g) h i).inv ≫ (α_ f g h).hom ▷ i :=
  by
  rw [← cancel_epi (α_ f g (h ≫ i)).inv, ← cancel_mono ((α_ f g h).inv ▷ i)]
  simp
#align category_theory.bicategory.pentagon_hom_inv_inv_inv_hom CategoryTheory.Bicategory.pentagon_hom_inv_inv_inv_hom

@[reassoc (attr := simp)]
theorem pentagon_hom_hom_inv_inv_hom (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d) (i : d ⟶ e) :
    (α_ f (g ≫ h) i).hom ≫ f ◁ (α_ g h i).hom ≫ (α_ f g (h ≫ i)).inv =
      (α_ f g h).inv ▷ i ≫ (α_ (f ≫ g) h i).hom :=
  eq_of_inv_eq_inv (by simp)
#align category_theory.bicategory.pentagon_hom_hom_inv_inv_hom CategoryTheory.Bicategory.pentagon_hom_hom_inv_inv_hom

@[reassoc (attr := simp)]
theorem pentagon_inv_hom_hom_hom_hom (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d) (i : d ⟶ e) :
    (α_ f g h).inv ▷ i ≫ (α_ (f ≫ g) h i).hom ≫ (α_ f g (h ≫ i)).hom =
      (α_ f (g ≫ h) i).hom ≫ f ◁ (α_ g h i).hom :=
  by simp [← cancel_epi ((α_ f g h).hom ▷ i)]
#align category_theory.bicategory.pentagon_inv_hom_hom_hom_hom CategoryTheory.Bicategory.pentagon_inv_hom_hom_hom_hom

@[reassoc (attr := simp)]
theorem pentagon_inv_inv_hom_inv_inv (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d) (i : d ⟶ e) :
    (α_ f g (h ≫ i)).inv ≫ (α_ (f ≫ g) h i).inv ≫ (α_ f g h).hom ▷ i =
      f ◁ (α_ g h i).inv ≫ (α_ f (g ≫ h) i).inv :=
  eq_of_inv_eq_inv (by simp)
#align category_theory.bicategory.pentagon_inv_inv_hom_inv_inv CategoryTheory.Bicategory.pentagon_inv_inv_hom_inv_inv

theorem triangle_assoc_comp_left (f : a ⟶ b) (g : b ⟶ c) :
    (α_ f (𝟙 b) g).hom ≫ f ◁ (λ_ g).hom = (ρ_ f).hom ▷ g :=
  triangle f g
#align category_theory.bicategory.triangle_assoc_comp_left CategoryTheory.Bicategory.triangle_assoc_comp_left

@[reassoc (attr := simp)]
theorem triangle_assoc_comp_right (f : a ⟶ b) (g : b ⟶ c) :
    (α_ f (𝟙 b) g).inv ≫ (ρ_ f).hom ▷ g = f ◁ (λ_ g).hom := by rw [← triangle, inv_hom_id_assoc]
#align category_theory.bicategory.triangle_assoc_comp_right CategoryTheory.Bicategory.triangle_assoc_comp_right

@[reassoc (attr := simp)]
theorem triangle_assoc_comp_right_inv (f : a ⟶ b) (g : b ⟶ c) :
    (ρ_ f).inv ▷ g ≫ (α_ f (𝟙 b) g).hom = f ◁ (λ_ g).inv := by
  simp [← cancel_mono (f ◁ (λ_ g).hom)]
#align category_theory.bicategory.triangle_assoc_comp_right_inv
  CategoryTheory.Bicategory.triangle_assoc_comp_right_inv

@[reassoc (attr := simp)]
theorem triangle_assoc_comp_left_inv (f : a ⟶ b) (g : b ⟶ c) :
    f ◁ (λ_ g).inv ≫ (α_ f (𝟙 b) g).inv = (ρ_ f).inv ▷ g := by
  simp [← cancel_mono ((ρ_ f).hom ▷ g)]
#align category_theory.bicategory.triangle_assoc_comp_left_inv CategoryTheory.Bicategory.triangle_assoc_comp_left_inv

@[reassoc]
theorem associator_naturality_left {f f' : a ⟶ b} (η : f ⟶ f') (g : b ⟶ c) (h : c ⟶ d) :
    η ▷ g ▷ h ≫ (α_ f' g h).hom = (α_ f g h).hom ≫ η ▷ (g ≫ h) := by simp
#align category_theory.bicategory.associator_naturality_left CategoryTheory.Bicategory.associator_naturality_left

@[reassoc]
theorem associator_inv_naturality_left {f f' : a ⟶ b} (η : f ⟶ f') (g : b ⟶ c) (h : c ⟶ d) :
    η ▷ (g ≫ h) ≫ (α_ f' g h).inv = (α_ f g h).inv ≫ η ▷ g ▷ h := by simp
#align category_theory.bicategory.associator_inv_naturality_left CategoryTheory.Bicategory.associator_inv_naturality_left

@[reassoc]
theorem whiskerRight_comp_symm {f f' : a ⟶ b} (η : f ⟶ f') (g : b ⟶ c) (h : c ⟶ d) :
    η ▷ g ▷ h = (α_ f g h).hom ≫ η ▷ (g ≫ h) ≫ (α_ f' g h).inv := by simp
#align category_theory.bicategory.whisker_right_comp_symm CategoryTheory.Bicategory.whiskerRight_comp_symm

@[reassoc]
theorem associator_naturality_middle (f : a ⟶ b) {g g' : b ⟶ c} (η : g ⟶ g') (h : c ⟶ d) :
    (f ◁ η) ▷ h ≫ (α_ f g' h).hom = (α_ f g h).hom ≫ f ◁ η ▷ h := by simp
#align category_theory.bicategory.associator_naturality_middle CategoryTheory.Bicategory.associator_naturality_middle

@[reassoc]
theorem associator_inv_naturality_middle (f : a ⟶ b) {g g' : b ⟶ c} (η : g ⟶ g') (h : c ⟶ d) :
    f ◁ η ▷ h ≫ (α_ f g' h).inv = (α_ f g h).inv ≫ (f ◁ η) ▷ h := by simp
#align category_theory.bicategory.associator_inv_naturality_middle CategoryTheory.Bicategory.associator_inv_naturality_middle

@[reassoc]
theorem whisker_assoc_symm (f : a ⟶ b) {g g' : b ⟶ c} (η : g ⟶ g') (h : c ⟶ d) :
    f ◁ η ▷ h = (α_ f g h).inv ≫ (f ◁ η) ▷ h ≫ (α_ f g' h).hom := by simp
#align category_theory.bicategory.whisker_assoc_symm CategoryTheory.Bicategory.whisker_assoc_symm

@[reassoc]
theorem associator_naturality_right (f : a ⟶ b) (g : b ⟶ c) {h h' : c ⟶ d} (η : h ⟶ h') :
    (f ≫ g) ◁ η ≫ (α_ f g h').hom = (α_ f g h).hom ≫ f ◁ g ◁ η := by simp
#align category_theory.bicategory.associator_naturality_right CategoryTheory.Bicategory.associator_naturality_right

@[reassoc]
theorem associator_inv_naturality_right (f : a ⟶ b) (g : b ⟶ c) {h h' : c ⟶ d} (η : h ⟶ h') :
    f ◁ g ◁ η ≫ (α_ f g h').inv = (α_ f g h).inv ≫ (f ≫ g) ◁ η := by simp
#align category_theory.bicategory.associator_inv_naturality_right CategoryTheory.Bicategory.associator_inv_naturality_right

@[reassoc]
theorem comp_whiskerLeft_symm (f : a ⟶ b) (g : b ⟶ c) {h h' : c ⟶ d} (η : h ⟶ h') :
    f ◁ g ◁ η = (α_ f g h).inv ≫ (f ≫ g) ◁ η ≫ (α_ f g h').hom := by simp
#align category_theory.bicategory.comp_whisker_left_symm CategoryTheory.Bicategory.comp_whiskerLeft_symm

@[reassoc]
theorem leftUnitor_naturality {f g : a ⟶ b} (η : f ⟶ g) :
    𝟙 a ◁ η ≫ (λ_ g).hom = (λ_ f).hom ≫ η :=
  by simp
#align category_theory.bicategory.left_unitor_naturality
  CategoryTheory.Bicategory.leftUnitor_naturality

@[reassoc]
theorem leftUnitor_inv_naturality {f g : a ⟶ b} (η : f ⟶ g) :
    η ≫ (λ_ g).inv = (λ_ f).inv ≫ 𝟙 a ◁ η := by simp
#align category_theory.bicategory.left_unitor_inv_naturality CategoryTheory.Bicategory.leftUnitor_inv_naturality

theorem id_whiskerLeft_symm {f g : a ⟶ b} (η : f ⟶ g) : η = (λ_ f).inv ≫ 𝟙 a ◁ η ≫ (λ_ g).hom := by
  simp
#align category_theory.bicategory.id_whisker_left_symm CategoryTheory.Bicategory.id_whiskerLeft_symm

@[reassoc]
theorem rightUnitor_naturality {f g : a ⟶ b} (η : f ⟶ g) : η ▷ 𝟙 b ≫ (ρ_ g).hom = (ρ_ f).hom ≫ η :=
  by simp
#align category_theory.bicategory.right_unitor_naturality CategoryTheory.Bicategory.rightUnitor_naturality

@[reassoc]
theorem rightUnitor_inv_naturality {f g : a ⟶ b} (η : f ⟶ g) :
    η ≫ (ρ_ g).inv = (ρ_ f).inv ≫ η ▷ 𝟙 b := by simp
#align category_theory.bicategory.right_unitor_inv_naturality CategoryTheory.Bicategory.rightUnitor_inv_naturality

theorem whiskerRight_id_symm {f g : a ⟶ b} (η : f ⟶ g) : η = (ρ_ f).inv ≫ η ▷ 𝟙 b ≫ (ρ_ g).hom := by
  simp
#align category_theory.bicategory.whisker_right_id_symm CategoryTheory.Bicategory.whiskerRight_id_symm

theorem whiskerLeft_iff {f g : a ⟶ b} (η θ : f ⟶ g) : 𝟙 a ◁ η = 𝟙 a ◁ θ ↔ η = θ := by simp
#align category_theory.bicategory.whisker_left_iff CategoryTheory.Bicategory.whiskerLeft_iff

theorem whiskerRight_iff {f g : a ⟶ b} (η θ : f ⟶ g) : η ▷ 𝟙 b = θ ▷ 𝟙 b ↔ η = θ := by simp
#align category_theory.bicategory.whisker_right_iff CategoryTheory.Bicategory.whiskerRight_iff

/-- We state it as a simp lemma, which is regarded as an involved version of
`id_whiskerRight f g : 𝟙 f ▷ g = 𝟙 (f ≫ g)`.
-/
@[reassoc, simp]
theorem leftUnitor_whiskerRight (f : a ⟶ b) (g : b ⟶ c) :
    (λ_ f).hom ▷ g = (α_ (𝟙 a) f g).hom ≫ (λ_ (f ≫ g)).hom := by
  rw [← whiskerLeft_iff, whiskerLeft_comp, ← cancel_epi (α_ _ _ _).hom, ←
      cancel_epi ((α_ _ _ _).hom ▷ _), pentagon_assoc, triangle, ← associator_naturality_middle, ←
      comp_whiskerRight_assoc, triangle, associator_naturality_left]
#align category_theory.bicategory.left_unitor_whisker_right CategoryTheory.Bicategory.leftUnitor_whiskerRight

@[reassoc, simp]
theorem leftUnitor_inv_whiskerRight (f : a ⟶ b) (g : b ⟶ c) :
    (λ_ f).inv ▷ g = (λ_ (f ≫ g)).inv ≫ (α_ (𝟙 a) f g).inv :=
  eq_of_inv_eq_inv (by simp)
#align category_theory.bicategory.left_unitor_inv_whisker_right CategoryTheory.Bicategory.leftUnitor_inv_whiskerRight

@[reassoc, simp]
theorem whiskerLeft_rightUnitor (f : a ⟶ b) (g : b ⟶ c) :
    f ◁ (ρ_ g).hom = (α_ f g (𝟙 c)).inv ≫ (ρ_ (f ≫ g)).hom := by
  rw [← whiskerRight_iff, comp_whiskerRight, ← cancel_epi (α_ _ _ _).inv, ←
      cancel_epi (f ◁ (α_ _ _ _).inv), pentagon_inv_assoc, triangle_assoc_comp_right, ←
      associator_inv_naturality_middle, ← whiskerLeft_comp_assoc, triangle_assoc_comp_right,
      associator_inv_naturality_right]
#align category_theory.bicategory.whisker_left_right_unitor CategoryTheory.Bicategory.whiskerLeft_rightUnitor

@[reassoc, simp]
theorem whiskerLeft_rightUnitor_inv (f : a ⟶ b) (g : b ⟶ c) :
    f ◁ (ρ_ g).inv = (ρ_ (f ≫ g)).inv ≫ (α_ f g (𝟙 c)).hom :=
  eq_of_inv_eq_inv (by simp)
#align category_theory.bicategory.whisker_left_right_unitor_inv CategoryTheory.Bicategory.whiskerLeft_rightUnitor_inv

/-
It is not so obvious whether `leftUnitor_whiskerRight` or `leftUnitor_comp` should be a simp
lemma. Our choice is the former. One reason is that the latter yields the following loop:
[id_whiskerLeft]   : 𝟙 a ◁ (ρ_ f).hom ==> (λ_ (f ≫ 𝟙 b)).hom ≫ (ρ_ f).hom ≫ (λ_ f).inv
[leftUnitor_comp]  : (λ_ (f ≫ 𝟙 b)).hom ==> (α_ (𝟙 a) f (𝟙 b)).inv ≫ (λ_ f).hom ▷ 𝟙 b
[whiskerRight_id]  : (λ_ f).hom ▷ 𝟙 b ==> (ρ_ (𝟙 a ≫ f)).hom ≫ (λ_ f).hom ≫ (ρ_ f).inv
[rightUnitor_comp] : (ρ_ (𝟙 a ≫ f)).hom ==> (α_ (𝟙 a) f (𝟙 b)).hom ≫ 𝟙 a ◁ (ρ_ f).hom
-/
@[reassoc]
theorem leftUnitor_comp (f : a ⟶ b) (g : b ⟶ c) :
    (λ_ (f ≫ g)).hom = (α_ (𝟙 a) f g).inv ≫ (λ_ f).hom ▷ g := by simp
#align category_theory.bicategory.left_unitor_comp CategoryTheory.Bicategory.leftUnitor_comp

@[reassoc]
theorem leftUnitor_comp_inv (f : a ⟶ b) (g : b ⟶ c) :
    (λ_ (f ≫ g)).inv = (λ_ f).inv ▷ g ≫ (α_ (𝟙 a) f g).hom := by simp
#align category_theory.bicategory.left_unitor_comp_inv CategoryTheory.Bicategory.leftUnitor_comp_inv

@[reassoc]
theorem rightUnitor_comp (f : a ⟶ b) (g : b ⟶ c) :
    (ρ_ (f ≫ g)).hom = (α_ f g (𝟙 c)).hom ≫ f ◁ (ρ_ g).hom := by simp
#align category_theory.bicategory.right_unitor_comp CategoryTheory.Bicategory.rightUnitor_comp

@[reassoc]
theorem rightUnitor_comp_inv (f : a ⟶ b) (g : b ⟶ c) :
    (ρ_ (f ≫ g)).inv = f ◁ (ρ_ g).inv ≫ (α_ f g (𝟙 c)).inv := by simp
#align category_theory.bicategory.right_unitor_comp_inv CategoryTheory.Bicategory.rightUnitor_comp_inv

@[simp]
theorem unitors_equal : (λ_ (𝟙 a)).hom = (ρ_ (𝟙 a)).hom := by
  rw [← whiskerLeft_iff, ← cancel_epi (α_ _ _ _).hom, ← cancel_mono (ρ_ _).hom, triangle, ←
      rightUnitor_comp, rightUnitor_naturality]
#align category_theory.bicategory.unitors_equal CategoryTheory.Bicategory.unitors_equal

@[simp]
theorem unitors_inv_equal : (λ_ (𝟙 a)).inv = (ρ_ (𝟙 a)).inv := by simp [Iso.inv_eq_inv]
#align category_theory.bicategory.unitors_inv_equal CategoryTheory.Bicategory.unitors_inv_equal

end Bicategory

end CategoryTheory


import ECTate.Algebra.ValuedRing
import ECTate.FieldTheory.PerfectClosure
import Mathlib.RingTheory.Congruence

open Enat

variable {R : Type u} [CommRing R] [IsDomain R]
section residue

def congruence_p {p : R} (nav : SurjVal p) (a b : R) : Prop := nav (a - b) > 0

variable {p : R}
variable {nav : SurjVal p}

lemma congruence_p_refl : ∀ x : R, congruence_p nav x x := by
  simp [congruence_p]

lemma congruence_p_symm : ∀ {x y : R}, congruence_p nav x y → congruence_p nav y x := by
  simp only [congruence_p, gt_iff_lt]
  intro x y H
  rwa [←neg_neg (y-x), neg_sub, nav.val_neg]

lemma congruence_p_trans : ∀ {x y z : R},
  congruence_p nav x y → congruence_p nav y z → congruence_p nav x z := by
  simp only [congruence_p, gt_iff_lt]
  intro x y z Hxy Hyz
  rw [←add_zero x, ←sub_self (-y), sub_eq_add_neg, sub_eq_add_neg, neg_neg, ←add_assoc,
    ←sub_eq_add_neg x, add_assoc, ←sub_eq_add_neg]
  exact lt_of_lt_of_le (lt_min Hxy Hyz) (nav.v_add_ge_min_v (x-y) (y-z))

lemma eqv_congr : Equivalence (congruence_p nav) :=
{ refl          := congruence_p_refl
  symm          := congruence_p_symm
  trans         := congruence_p_trans }

def equiv_p (nav : SurjVal p) : HasEquiv R :=
{ Equiv := congruence_p nav }

def SurjVal.s (nav : SurjVal p) : Setoid R :=
{ r := congruence_p nav
  iseqv := eqv_congr }

lemma SurjVal.s.r_eq : nav.s.r = congruence_p nav := rfl

--def SurjVal.qt (nav : SurjVal p) := Quotient (val_setoid nav)

notation "⟦" arg1:60 "⟧." arg2:120 => Quotient.mk (SurjVal.s arg2) arg1

theorem add_repr_eq_repr_add (nav : SurjVal p) (a b : R)
  (a' b' : R) (ha : nav.s.r a' a) (hb : nav.s.r b' b) : nav.s.r (a' + b') (a + b) := by
  rw [SurjVal.s.r_eq] at *
  rw [congruence_p, add_sub_assoc, sub_eq_add_neg, neg_add, ←add_assoc b', add_comm _ (-a),
    ←add_assoc, ←add_assoc, add_assoc, ←sub_eq_add_neg, ←sub_eq_add_neg]
  exact lt_of_lt_of_le (lt_min ha hb) (SurjVal.v_add_ge_min_v nav (a' - a) (b' - b))

theorem equiv_of_congr (nav : SurjVal p) (a b : R) : nav.s.r a b → (equiv_p nav).Equiv a b := id

def add_quot' (a b : R) : Quotient nav.s := ⟦a + b⟧

def add_quot : Quotient nav.s → Quotient nav.s → Quotient nav.s :=
  Quotient.lift₂ add_quot' fun a b a' b' ha hb =>
  Quotient.sound (equiv_of_congr nav (a + b) (a' + b') (add_repr_eq_repr_add nav a' b' a b ha hb))

instance : Add (Quotient nav.s) :=
{ add := add_quot }

theorem add_quot_eq_quot_add_rep {a b : R} {x y : Quotient nav.s} (hx : ⟦a⟧ = x) (hy : ⟦b⟧ = y) :
  x + y = ⟦a + b⟧ := by
  rw [←hx, ←hy]
  rfl

lemma add_quot_eq_quot_add {a b : R} : ⟦a + b⟧ = ⟦a⟧.nav + ⟦b⟧ := rfl

lemma add_quot_assoc (a b c : Quotient nav.s) : a + b + c = a + (b + c) := by
  match Quotient.exists_rep a, Quotient.exists_rep b, Quotient.exists_rep c with
  | ⟨ra, ha⟩, ⟨rb, hb⟩, ⟨rc, hc⟩ =>
    rw [add_quot_eq_quot_add_rep ha hb, add_quot_eq_quot_add_rep hb hc, add_quot_eq_quot_add_rep ha rfl, add_quot_eq_quot_add_rep rfl hc, add_assoc]

instance : Zero (Quotient nav.s) :=
{ zero := ⟦0⟧ }

lemma quot_zero : (0 : Quotient nav.s) = ⟦0⟧ := rfl

lemma zero_add_quot (a : Quotient nav.s) : 0 + a = a := by
  match Quotient.exists_rep a with
  | ⟨ra, ha⟩ =>
    rw [quot_zero, add_quot_eq_quot_add_rep rfl ha, zero_add, ha]

lemma add_quot_zero (a : Quotient nav.s) : a + 0 = a := by
  match Quotient.exists_rep a with
  | ⟨ra, ha⟩ =>
    rw [quot_zero, add_quot_eq_quot_add_rep ha rfl, add_zero, ha]

lemma add_quot_comm (a b : Quotient nav.s) : a + b = b + a := by
  match Quotient.exists_rep a, Quotient.exists_rep b with
  | ⟨ra, ha⟩, ⟨rb, hb⟩ =>
    rw [add_quot_eq_quot_add_rep ha hb, add_quot_eq_quot_add_rep hb ha, add_comm]

theorem mul_repr_eq_repr_mul (nav : SurjVal p) (a b : R) (a' b' : R) (ha : nav.s.r a' a) (hb : nav.s.r b' b) :
  nav.s.r (a' * b') (a * b) := by
  erw [SurjVal.s.r_eq, congruence_p, gt_iff_lt, lt_iff_succ_le,
       Nat.zero_eq, Nat.cast_zero, succ_eq_add_one, zero_add] at *
  -- todo can we avoid this step with some sort of succ/discrete order gives contra add > from contra add ≥
  rw [show a' * b' - a * b = a' * (b' - b) + b * (a' - a) by ring]
  apply le_trans (le_min _ _) (nav.v_add_ge_min_v _ _) <;>
    rw [SurjVal.v_mul_eq_add_v] <;>
    apply le_trans le_add_self (add_le_add_left _ _) <;>
    assumption

def mul_quot' (a b : R) : Quotient nav.s := ⟦a * b⟧

def mul_quot : Quotient nav.s → Quotient nav.s → Quotient nav.s :=
Quotient.lift₂ mul_quot' fun a b a' b' ha hb =>
  Quotient.sound (equiv_of_congr nav (a * b) (a' * b') (mul_repr_eq_repr_mul nav a' b' a b ha hb))

instance : Mul (Quotient nav.s) :=
{ mul := mul_quot }

theorem mul_quot_eq_quot_mul_rep {a b : R} {x y : Quotient nav.s} (hx : ⟦a⟧ = x) (hy : ⟦b⟧ = y) : x * y = ⟦a * b⟧ := by
  rw [←hx, ←hy]
  rfl

lemma mul_quot_eq_quot_mul {a b : R} : ⟦a * b⟧ = ⟦a⟧.nav * ⟦b⟧ := rfl

lemma left_distrib_quot (a b c : Quotient nav.s) : a * (b + c) = a * b + a * c := by
  match Quotient.exists_rep a, Quotient.exists_rep b, Quotient.exists_rep c with
  | ⟨ra, ha⟩, ⟨rb, hb⟩, ⟨rc, hc⟩ =>
    rw [add_quot_eq_quot_add_rep hb hc, mul_quot_eq_quot_mul_rep ha hb, mul_quot_eq_quot_mul_rep ha hc,
      mul_quot_eq_quot_mul_rep ha rfl, add_quot_eq_quot_add_rep rfl rfl, left_distrib]

lemma right_distrib_quot (a b c : Quotient nav.s) : (a + b) * c = a * c + b * c := by
  match Quotient.exists_rep a, Quotient.exists_rep b, Quotient.exists_rep c with
  | ⟨ra, ha⟩, ⟨rb, hb⟩, ⟨rc, hc⟩ =>
    rw [add_quot_eq_quot_add_rep ha hb, mul_quot_eq_quot_mul_rep ha hc, mul_quot_eq_quot_mul_rep hb hc,
      mul_quot_eq_quot_mul_rep rfl hc, add_quot_eq_quot_add_rep rfl rfl, right_distrib]

lemma zero_mul_quot (a : Quotient nav.s) : 0 * a = 0 := by
  match Quotient.exists_rep a with
  | ⟨ra, ha⟩ =>
    rw [quot_zero, mul_quot_eq_quot_mul_rep rfl ha, zero_mul]

lemma mul_quot_zero (a : Quotient nav.s) : a * 0 = 0 := by
  match Quotient.exists_rep a with
  | ⟨ra, ha⟩ =>
    rw [quot_zero, mul_quot_eq_quot_mul_rep ha rfl, mul_zero]

lemma mul_quot_assoc (a b c : Quotient nav.s) : a * b * c = a * (b * c) := by
  match Quotient.exists_rep a, Quotient.exists_rep b, Quotient.exists_rep c with
  | ⟨ra, ha⟩, ⟨rb, hb⟩, ⟨rc, hc⟩ =>
    rw [mul_quot_eq_quot_mul_rep ha hb, mul_quot_eq_quot_mul_rep hb hc, mul_quot_eq_quot_mul_rep ha rfl,
      mul_quot_eq_quot_mul_rep rfl hc, mul_assoc]

instance : One (Quotient nav.s) :=
{ one := ⟦1⟧ }

lemma quot_one : (1 : Quotient nav.s) = ⟦1⟧ := rfl

lemma one_mul_quot (a : Quotient nav.s) : 1 * a = a := by
  match Quotient.exists_rep a with
  | ⟨ra, ha⟩ =>
    rw [quot_one, mul_quot_eq_quot_mul_rep rfl ha, one_mul, ha]

lemma mul_quot_one (a : Quotient nav.s) : a * 1 = a := by
  match Quotient.exists_rep a with
  | ⟨ra, ha⟩ =>
    rw [quot_one, mul_quot_eq_quot_mul_rep ha rfl, mul_one, ha]

theorem neg_repr_eq_repr_neg (nav : SurjVal p) (a : R) : ∀ (a' : R), nav.s.r a' a → nav.s.r (-a') (-a) := by
  intro a' ha
  rw [SurjVal.s.r_eq] at *
  rwa [congruence_p, ←nav.val_neg, sub_eq_add_neg, neg_neg, neg_add, neg_neg, ←sub_eq_add_neg]

def neg_quot' (a : R) : Quotient nav.s := ⟦-a⟧

def neg_quot : Quotient nav.s → Quotient nav.s := by
  apply Quotient.lift (neg_quot') _
  intro a a' ha
  rw [neg_quot']
  apply Quotient.sound
  apply equiv_of_congr nav _ _ (neg_repr_eq_repr_neg nav a' a ha)

instance : Neg (Quotient nav.s) :=
{ neg := neg_quot }

theorem neg_quot_eq_quot_neg_rep {a : R} {x : Quotient nav.s} (hx : ⟦a⟧ = x) : -x = ⟦-a⟧ := by
  rw [←hx]
  rfl

theorem neg_quot_eq_quot_neg {a : R} : -⟦a⟧.nav = ⟦-a⟧ := rfl

lemma add_left_neg_quot (a : Quotient nav.s) : -a + a = 0 := by
  match Quotient.exists_rep a with
  | ⟨ra, ha⟩ =>
    rw [neg_quot_eq_quot_neg_rep ha, ←ha, add_quot_eq_quot_add_rep rfl rfl, add_left_neg]
    rfl

instance res_ring_p : Ring (Quotient nav.s) :=
{ add_assoc := add_quot_assoc
  zero_add := zero_add_quot
  add_zero := add_quot_zero
  add_comm := add_quot_comm
  left_distrib := left_distrib_quot
  right_distrib := right_distrib_quot
  zero_mul := zero_mul_quot
  mul_zero := mul_quot_zero
  mul_assoc := mul_quot_assoc
  one_mul := one_mul_quot
  mul_one := mul_quot_one
  add_left_neg := add_left_neg_quot }

lemma pos_val_of_quot_zero {x : R} (h : ⟦x⟧.nav = ⟦0⟧) : nav x > 0 := by
  rw [←sub_zero x, ←congruence_p, ←SurjVal.s.r_eq]
  exact Quotient.exact h

lemma quot_pos_val {x : R} (h : nav x > 0) : ⟦x⟧.nav = ⟦0⟧ := by
  rw [Quotient.sound]
  simp [HasEquiv.Equiv, instHasEquiv, SurjVal.s.r_eq, congruence_p, h]

lemma quot_pos_val_mul {x y : R} (h : nav x > 0) : ⟦x * y⟧.nav = ⟦0⟧ := by
  rwa [mul_quot_eq_quot_mul, quot_pos_val, ←mul_quot_eq_quot_mul, zero_mul]

lemma quot_mul_pos_val {x y : R} (h : nav y > 0) : ⟦x * y⟧.nav = ⟦0⟧ := by
  rw [mul_comm, quot_pos_val_mul h]

lemma quot_pow_eq_quot_of_pow {a : R} {n : ℕ} : ⟦a⟧.nav ^ n = ⟦a ^ n⟧ := by
  induction n with
  | zero => simp [pow_zero]; rfl
  | succ n ih =>
    simp [pow_succ, ih, mul_quot_eq_quot_mul]

/- not sure I need those -/
section quot_p
lemma quot_p : ⟦p⟧.nav = ⟦0⟧ := by
  apply quot_pos_val
  simp [nav.v_uniformizer]

lemma quot_p_mul (x : R) : ⟦p * x⟧.nav = ⟦0⟧ := by
  apply quot_pos_val_mul
  simp [nav.v_uniformizer]

lemma quot_mul_p (x : R) : ⟦x * p⟧.nav = ⟦0⟧ := by
  rw [mul_comm, quot_p_mul]
end quot_p

end residue

--set_option pp.all true
structure ResidueRing {p : R} (valtn : SurjVal p) where
  lift' : R → R --lift function
  lift_def : ∀ (a b : R), valtn.s.r a b → lift' a = lift' b
  char : ℕ
  val_char : valtn char > 0
  char_min : ∀ n : ℕ, n.succ < char → valtn.v n.succ = 0

namespace ResidueRing

variable {p : R}
variable {valtn : SurjVal p}

--def repr_p (rr : ResidueRing valtn) (x : R) : Quotient valtn.s := Quotient.mk valtn.s x

--def congr_of_repr : ∀ a b : R, congruence_p valtn a b → repr_p a = repr_p b

lemma quot_char (rr : ResidueRing valtn) : (⟦(rr.char : R)⟧ : Quotient valtn.s) = ⟦0⟧ := by
  rw [Quotient.sound]
  simp [HasEquiv.Equiv, instHasEquiv, SurjVal.s.r_eq, congruence_p, rr.val_char]

lemma quot_char_mul (rr : ResidueRing valtn) (x : R) : (⟦(rr.char : R) * x⟧ : Quotient valtn.s) = ⟦0⟧ := by
  rw [mul_quot_eq_quot_mul, quot_char rr, ←mul_quot_eq_quot_mul, zero_mul]

lemma quot_mul_char (rr : ResidueRing valtn) (x : R) : (⟦x * (rr.char : R)⟧ : Quotient valtn.s) = ⟦0⟧ := by
  rw [mul_comm, quot_char_mul rr]

/- prove might involve that the characteristic is prime (?) -/
-- doesnt look true to alex
-- lemma quot_pow_char (rr : ResidueRing valtn) (x : R) : (⟦x ^ rr.char⟧ : Quotient valtn.s) = ⟦x⟧ := by sorry

end ResidueRing

lemma RingCon.exists_rep (RC : RingCon R) : ∀ a : RC.Quotient, ∃ A : R, A = a :=
Quotient.exists_rep

namespace EnatValRing
variable {R : Type u} [CommRing R] [IsDomain R] {p : R} (evr : EnatValRing p)

def RingCon : RingCon R :=
{ evr.valtn.s with
  add' := add_repr_eq_repr_add evr.valtn _ _ _ _
  mul' := mul_repr_eq_repr_mul evr.valtn _ _ _ _ }

instance : Nontrivial evr.RingCon.Quotient :=
{ exists_pair_ne := by
    refine ⟨(0 : R), (1 : R), ?_⟩
    rw [Ne.def, RingCon.eq, RingCon.rel_mk, SurjVal.s.r_eq, congruence_p]
    simp }

instance : NoZeroDivisors evr.RingCon.Quotient :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := by
    intro a b h
    obtain ⟨A, rfl⟩ := evr.RingCon.exists_rep a
    obtain ⟨B, rfl⟩ := evr.RingCon.exists_rep b
    rw [← RingCon.coe_zero] at *
    rw [← RingCon.coe_mul] at *
    rw [RingCon.eq, RingCon.rel_mk, SurjVal.s.r_eq, congruence_p] at *
    rw [RingCon.eq, RingCon.rel_mk, SurjVal.s.r_eq, congruence_p] at *
    aesop }

instance : Field evr.RingCon.Quotient :=
{ inv := fun x => (Quotient.lift evr.inv_mod) sorry x
  mul_inv_cancel := sorry
  inv_zero := sorry }

instance : IsDomain evr.RingCon.Quotient := {}

lemma key : ring_char evr.RingCon.Quotient = evr.residue_char := sorry
instance : PerfectRing evr.RingCon.Quotient :=
{ pth_power_bijective := by
    rw [or_iff_not_imp_left]
    intro h
    rw [Function.Bijective]
    apply And.intro
    . exact pow_ring_char_injective h
    . intro x
      obtain ⟨B, rfl⟩ := evr.RingCon.exists_rep x
      use evr.pth_root B
      rw [key] at *
      simp only
      rw [← RingCon.coe_pow]
      rw [RingCon.eq, RingCon.rel_mk, SurjVal.s.r_eq, congruence_p]
      apply evr.pth_root_spec.resolve_left h }
end EnatValRing


import analysis.special_functions.trigonometric.basic
import analysis.normed_space.lp_space
import data.fin.vec_notation

import to_mathlib.combinatorics.simple_graph.cyclic
import to_mathlib.combinatorics.simple_graph.shannon_capacity

noncomputable theory

open set function real simple_graph
open_locale real_inner_product_space

local notation `𝔼³` := euclidean_space ℝ $ fin 3
local notation `𝔾₅` := simple_graph.cyclic 5

/-- Standard basis element. -/
def e₁ : 𝔼³ := euclidean_space.single 0 1

/-- Standard basis element. -/
def e₂ : 𝔼³ := euclidean_space.single 1 1

/-- Standard basis element. -/
def e₃ : 𝔼³ := euclidean_space.single 2 1

@[simp] lemma norm_e₁ : ∥e₁∥ = 1 :=
  by simp [e₁, euclidean_space.norm_eq, finset.filter_eq']

/-- The Lovász umbrella. -/
def lovasz_umbrella : orthogonal_representation 𝔾₅ 𝔼³ :=
{ to_fun := λ i j, sorry, -- See: https://en.wikipedia.org/wiki/Lov%C3%A1sz_number#Relation_to_Shannon_capacity
  norm_eq_one' := sorry,
  inner_eq_zero_of_ne_of_not_adj' := sorry, }

/-- Proving this will probably require explicit results about the sine or cosine of
`π / 5`, `2 * π / 5`, etc. -/
@[simp] lemma inner_lovasz_umbrella_e₁ (i : fin 5) :
  ⟪lovasz_umbrella i, e₁⟫^2 = 1 / sqrt 5 :=
sorry

@[simp] lemma lovasz_number_at_lovasz_umbrella_eq :
  lovasz_umbrella.lovasz_number_at e₁ = sqrt 5 :=
begin
  dunfold simple_graph.orthogonal_representation.lovasz_number_at,
  simp_rw [inner_lovasz_umbrella_e₁, ←inv_eq_one_div, div_inv_eq_mul],
  rw [show ∥e₁∥ = 1, from _],
  simp_rw [pow_two, one_mul],
  rw [supr, real.Sup_def, dif_pos],
  generalize_proofs h,
  refine le_antisymm _ _,
  { refine h.some_spec.2 _, rintros _ ⟨y, rfl⟩, exact le_refl _, },
  { exact h.some_spec.1 ⟨0, rfl⟩, },
  { refine ⟨⟨_, ⟨0, rfl⟩⟩, ⟨sqrt 5, _⟩⟩,
    rintros _ ⟨y, rfl⟩, refl, },
  { erw [norm_eq_sqrt_real_inner, sqrt_eq_iff_mul_self_eq, one_mul,
      euclidean_space.inner_single_left, map_one, one_mul],
    dunfold e₁, rw [euclidean_space.single_apply, if_pos rfl],
    exact real_inner_self_nonneg, norm_num },
end

abbreviation max_independent_set : set (fin 2 → fin 5) := { ![0,0], ![1,2], ![2, 4], ![3, 1], ![4, 3] }

lemma mem_max_independent_set (i : fin 2 → fin 5) :
  i ∈ max_independent_set ↔ i = ![0,0] ∨ i = ![1,2] ∨ i = ![2, 4] ∨ i = ![3, 1] ∨ i = ![4, 3] :=
by rw [mem_insert_iff, mem_insert_iff, mem_insert_iff, mem_insert_iff, mem_singleton_iff]

lemma card_max_independent_set : nat.card max_independent_set = 5 :=
begin
  rw [nat.card_eq_fintype_card, card_insert, card_insert, card_insert, card_insert, card_singleton],
  { simp only [mem_singleton_iff], intros r, have : (3 : fin 5) = 4 := congr_fun r 0,
    rw fin.ext_iff at this, change 3 = 4 at this, norm_num at this, },
  { intro r, rw [mem_insert_iff, mem_singleton_iff] at r,
    rcases r with r|r;
    have := congr_fun r 0;
    simp only [matrix.cons_val_zero] at this; norm_num at this, },
  { intro r, rw [mem_insert_iff, mem_insert_iff, mem_singleton_iff] at r,
    rcases r with r|r|r;
    have := congr_fun r 0;
    simp only [matrix.cons_val_zero] at this; norm_num at this, },
  { intro r, rw [mem_insert_iff, mem_insert_iff, mem_insert_iff, mem_singleton_iff] at r,
    rcases r with r|r|r|r;
    have := congr_fun r 0;
    simp only [matrix.cons_val_zero] at this; norm_num at this, },
end

lemma max_independent_set_is_independent :
  (⊠^2 (cyclic 5)).independent_set max_independent_set :=
begin
  rintros ⟨i, hi⟩ ⟨j, hj⟩, rw [subtype.coe_mk, subtype.coe_mk],
  rw mem_max_independent_set at hi hj,
  rcases hi with hi|hi|hi|hi|hi;
  rcases hj with hj|hj|hj|hj|hj;
  rw [hi, hj],
  all_goals { try { simp only [simple_graph.irrefl, not_false_iff] }, },
  all_goals { simp only [strong_pi_adj, ne.def, not_and, not_forall], intros h, push_neg, },
  all_goals { try { refine ⟨1, _⟩, split; simp only [matrix.cons_val_one, matrix.head_cons, ne.def], norm_num,
    exact not_cyclic_5_adj_0_2 } },
  all_goals { try { refine ⟨0, _⟩, split; simp only [matrix.cons_val_zero, ne.def], norm_num,
    exact not_cyclic_5_adj_0_2 } },
  all_goals { try { refine ⟨0, _⟩, split; simp only [matrix.cons_val_zero, ne.def], norm_num,
    exact not_cyclic_5_adj_0_3 } },
  all_goals { try { refine ⟨1, _⟩, split; simp only [matrix.cons_val_one, matrix.head_cons, ne.def], norm_num,
    exact not_cyclic_5_adj_0_3 } },
end

lemma strong_pow_two_independence_number :
  5 ≤ (⊠^2 (cyclic 5)).independence_number :=
begin
  rw [independence_number_eq_bcsupr, supr],
  apply le_cSup, swap,
  { refine ⟨max_independent_set, _⟩, dsimp only,
    rw nat.supr_pos, apply card_max_independent_set,
    apply max_independent_set_is_independent },
  let s : set ℕ := _, suffices : bdd_above s, exact this,
  apply fintype.bdd_above_range,
end

/-- The easier direction.

Easy on paper, not necessarily in Lean. -/
lemma le_shannon_capacity_cyclic_graph_five :
  sqrt 5 ≤ shannon_capacity 𝔾₅ :=
begin
  dunfold shannon_capacity, rw [supr],
  rw le_cSup_iff,
  { intros b hb,
    have := (lovasz_umbrella).independence_number_le_lovasz_number_at e₁,
    specialize @hb _ ⟨1, rfl⟩, dsimp only at hb,
    rw [show 1 + 1 = 2, from rfl, show (↑(1 : ℕ) : ℝ) = 1, by norm_cast,
      show (1 : ℝ) + 1 = 2, by norm_cast, ←sqrt_eq_rpow, sqrt_le_iff] at hb,
    have h2 : (5 : ℝ) ≤ (⊠^2 (cyclic 5)).independence_number :=
      by exact_mod_cast strong_pow_two_independence_number,
    rw sqrt_le_iff, refine ⟨hb.1, h2.trans hb.2⟩ },
  { refine ⟨sqrt 5, _⟩, rintros _ ⟨k, rfl⟩, dsimp only,
    have H := (lovasz_umbrella.pow (k+1)).independence_number_le_lovasz_number_at
      (tensor_power.tpow ℝ (λ _, e₁)),
    rw [orthogonal_representation.pow_lovasz_number_at', lovasz_number_at_lovasz_umbrella_eq] at H,
    refine (real.rpow_le_rpow _ H _).trans _,
    { norm_cast, exact nat.zero_le _, },
    { rw div_nonneg_iff, left, split, norm_num, norm_cast, exact nat.zero_le _, },
    { rw [show sqrt 5 ^ (k + 1) = sqrt 5 ^ (k + 1 : ℝ), by norm_cast, ←real.rpow_mul,
      mul_one_div_cancel, rpow_one], norm_cast,
      linarith, exact sqrt_nonneg _, }, },
  { exact ⟨_, ⟨1, rfl⟩⟩, },
end

/-- The harder direction. -/
lemma shannon_capacity_cyclic_graph_five_le :
  shannon_capacity 𝔾₅ ≤ sqrt 5 :=
begin
  apply (shannon_capacity_le_lovasz_number_at 𝔾₅ lovasz_umbrella e₁).trans,
  apply lovasz_number_at_lovasz_umbrella_eq.le,
end

/-- *Main project goal* -/
@[simp] lemma shannon_capacity_cyclic_graph_five_eq :
  shannon_capacity 𝔾₅ = sqrt 5 :=
le_antisymm shannon_capacity_cyclic_graph_five_le le_shannon_capacity_cyclic_graph_five

/- The `#print` statement below currently produces:
```
classical.choice
quot.sound
propext
[sorry]
```
Our goal is to get it to stop printing the line saying `[sorry]`.
-/
#print axioms shannon_capacity_cyclic_graph_five_eq


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

! This file was ported from Lean 3 source module category_theory.subobject.basic
! 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.MonoOver
import Mathbin.CategoryTheory.Skeletal
import Mathbin.CategoryTheory.ConcreteCategory.Basic
import Mathbin.Tactic.ApplyFun
import Mathbin.Tactic.Elementwise

/-!
# Subobjects

We define `subobject X` as the quotient (by isomorphisms) of
`mono_over X := {f : over X // mono f.hom}`.

Here `mono_over X` is a thin category (a pair of objects has at most one morphism between them),
so we can think of it as a preorder. However as it is not skeletal, it is not a partial order.

There is a coercion from `subobject X` back to the ambient category `C`
(using choice to pick a representative), and for `P : subobject X`,
`P.arrow : (P : C) ⟶ X` is the inclusion morphism.

We provide
* `def pullback [has_pullbacks C] (f : X ⟶ Y) : subobject Y ⥤ subobject X`
* `def map (f : X ⟶ Y) [mono f] : subobject X ⥤ subobject Y`
* `def «exists» [has_images C] (f : X ⟶ Y) : subobject X ⥤ subobject Y`
and prove their basic properties and relationships.
These are all easy consequences of the earlier development
of the corresponding functors for `mono_over`.

The subobjects of `X` form a preorder making them into a category. We have `X ≤ Y` if and only if
`X.arrow` factors through `Y.arrow`: see `of_le`/`of_le_mk`/`of_mk_le`/`of_mk_le_mk` and
`le_of_comm`. Similarly, to show that two subobjects are equal, we can supply an isomorphism between
the underlying objects that commutes with the arrows (`eq_of_comm`).

See also

* `category_theory.subobject.factor_thru` :
  an API describing factorization of morphisms through subobjects.
* `category_theory.subobject.lattice` :
  the lattice structures on subobjects.

## Notes

This development originally appeared in Bhavik Mehta's "Topos theory for Lean" repository,
and was ported to mathlib by Scott Morrison.

### Implementation note

Currently we describe `pullback`, `map`, etc., as functors.
It may be better to just say that they are monotone functions,
and even avoid using categorical language entirely when describing `subobject X`.
(It's worth keeping this in mind in future use; it should be a relatively easy change here
if it looks preferable.)

### Relation to pseudoelements

There is a separate development of pseudoelements in `category_theory.abelian.pseudoelements`,
as a quotient (but not by isomorphism) of `over X`.

When a morphism `f` has an image, the image represents the same pseudoelement.
In a category with images `pseudoelements X` could be constructed as a quotient of `mono_over X`.
In fact, in an abelian category (I'm not sure in what generality beyond that),
`pseudoelements X` agrees with `subobject X`, but we haven't developed this in mathlib yet.

-/

universe v₁ v₂ u₁ u₂

noncomputable section

namespace CategoryTheory

open CategoryTheory CategoryTheory.Category CategoryTheory.Limits

variable {C : Type u₁} [Category.{v₁} C] {X Y Z : C}

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

/-!
We now construct the subobject lattice for `X : C`,
as the quotient by isomorphisms of `mono_over X`.

Since `mono_over X` is a thin category, we use `thin_skeleton` to take the quotient.

Essentially all the structure defined above on `mono_over X` descends to `subobject X`,
with morphisms becoming inequalities, and isomorphisms becoming equations.
-/

/-- The category of subobjects of `X : C`, defined as isomorphism classes of monomorphisms into `X`.
-/
def Subobject (X : C) :=
  ThinSkeleton (MonoOver X)deriving PartialOrder, Category
#align category_theory.subobject CategoryTheory.Subobject

namespace Subobject

/-- Convenience constructor for a subobject. -/
abbrev mk {X A : C} (f : A ⟶ X) [Mono f] : Subobject X :=
  (toThinSkeleton _).obj (MonoOver.mk' f)
#align category_theory.subobject.mk CategoryTheory.Subobject.mk

section

attribute [local ext] CategoryTheory.Comma

protected theorem ind {X : C} (p : Subobject X → Prop)
    (h : ∀ ⦃A : C⦄ (f : A ⟶ X) [Mono f], p (subobject.mk f)) (P : Subobject X) : p P :=
  by
  apply Quotient.inductionOn'
  intro a
  convert h a.arrow
  ext <;> rfl
#align category_theory.subobject.ind CategoryTheory.Subobject.ind

protected theorem ind₂ {X : C} (p : Subobject X → Subobject X → Prop)
    (h : ∀ ⦃A B : C⦄ (f : A ⟶ X) (g : B ⟶ X) [Mono f] [Mono g], p (subobject.mk f) (subobject.mk g))
    (P Q : Subobject X) : p P Q := by
  apply Quotient.inductionOn₂'
  intro a b
  convert h a.arrow b.arrow <;> ext <;> rfl
#align category_theory.subobject.ind₂ CategoryTheory.Subobject.ind₂

end

/-- Declare a function on subobjects of `X` by specifying a function on monomorphisms with
    codomain `X`. -/
protected def lift {α : Sort _} {X : C} (F : ∀ ⦃A : C⦄ (f : A ⟶ X) [Mono f], α)
    (h :
      ∀ ⦃A B : C⦄ (f : A ⟶ X) (g : B ⟶ X) [Mono f] [Mono g] (i : A ≅ B),
        i.Hom ≫ g = f → F f = F g) :
    Subobject X → α := fun P =>
  Quotient.liftOn' P (fun m => F m.arrow) fun m n ⟨i⟩ =>
    h m.arrow n.arrow ((MonoOver.forget X ⋙ Over.forget X).mapIso i) (Over.w i.Hom)
#align category_theory.subobject.lift CategoryTheory.Subobject.lift

@[simp]
protected theorem lift_mk {α : Sort _} {X : C} (F : ∀ ⦃A : C⦄ (f : A ⟶ X) [Mono f], α) {h A}
    (f : A ⟶ X) [Mono f] : Subobject.lift F h (Subobject.mk f) = F f :=
  rfl
#align category_theory.subobject.lift_mk CategoryTheory.Subobject.lift_mk

/-- The category of subobjects is equivalent to the `mono_over` category. It is more convenient to
use the former due to the partial order instance, but oftentimes it is easier to define structures
on the latter. -/
noncomputable def equivMonoOver (X : C) : Subobject X ≌ MonoOver X :=
  ThinSkeleton.equivalence _
#align category_theory.subobject.equiv_mono_over CategoryTheory.Subobject.equivMonoOver

/-- Use choice to pick a representative `mono_over X` for each `subobject X`.
-/
noncomputable def representative {X : C} : Subobject X ⥤ MonoOver X :=
  (equivMonoOver X).Functor
#align category_theory.subobject.representative CategoryTheory.Subobject.representative

/-- Starting with `A : mono_over X`, we can take its equivalence class in `subobject X`
then pick an arbitrary representative using `representative.obj`.
This is isomorphic (in `mono_over X`) to the original `A`.
-/
noncomputable def representativeIso {X : C} (A : MonoOver X) :
    representative.obj ((toThinSkeleton _).obj A) ≅ A :=
  (equivMonoOver X).counitIso.app A
#align category_theory.subobject.representative_iso CategoryTheory.Subobject.representativeIso

/-- Use choice to pick a representative underlying object in `C` for any `subobject X`.

Prefer to use the coercion `P : C` rather than explicitly writing `underlying.obj P`.
-/
noncomputable def underlying {X : C} : Subobject X ⥤ C :=
  representative ⋙ MonoOver.forget _ ⋙ Over.forget _
#align category_theory.subobject.underlying CategoryTheory.Subobject.underlying

instance : Coe (Subobject X) C where coe Y := underlying.obj Y

@[simp]
theorem underlying_as_coe {X : C} (P : Subobject X) : underlying.obj P = P :=
  rfl
#align category_theory.subobject.underlying_as_coe CategoryTheory.Subobject.underlying_as_coe

/-- If we construct a `subobject Y` from an explicit `f : X ⟶ Y` with `[mono f]`,
then pick an arbitrary choice of underlying object `(subobject.mk f : C)` back in `C`,
it is isomorphic (in `C`) to the original `X`.
-/
noncomputable def underlyingIso {X Y : C} (f : X ⟶ Y) [Mono f] : (Subobject.mk f : C) ≅ X :=
  (MonoOver.forget _ ⋙ Over.forget _).mapIso (representativeIso (MonoOver.mk' f))
#align category_theory.subobject.underlying_iso CategoryTheory.Subobject.underlyingIso

/-- The morphism in `C` from the arbitrarily chosen underlying object to the ambient object.
-/
noncomputable def arrow {X : C} (Y : Subobject X) : (Y : C) ⟶ X :=
  (representative.obj Y).obj.Hom
#align category_theory.subobject.arrow CategoryTheory.Subobject.arrow

instance arrow_mono {X : C} (Y : Subobject X) : Mono Y.arrow :=
  (representative.obj Y).property
#align category_theory.subobject.arrow_mono CategoryTheory.Subobject.arrow_mono

@[simp]
theorem arrow_congr {A : C} (X Y : Subobject A) (h : X = Y) :
    eqToHom (congr_arg (fun X : Subobject A => (X : C)) h) ≫ Y.arrow = X.arrow :=
  by
  induction h
  simp
#align category_theory.subobject.arrow_congr CategoryTheory.Subobject.arrow_congr

@[simp]
theorem representative_coe (Y : Subobject X) : (representative.obj Y : C) = (Y : C) :=
  rfl
#align category_theory.subobject.representative_coe CategoryTheory.Subobject.representative_coe

@[simp]
theorem representative_arrow (Y : Subobject X) : (representative.obj Y).arrow = Y.arrow :=
  rfl
#align category_theory.subobject.representative_arrow CategoryTheory.Subobject.representative_arrow

@[simp, reassoc.1]
theorem underlying_arrow {X : C} {Y Z : Subobject X} (f : Y ⟶ Z) :
    underlying.map f ≫ arrow Z = arrow Y :=
  Over.w (representative.map f)
#align category_theory.subobject.underlying_arrow CategoryTheory.Subobject.underlying_arrow

@[simp, reassoc.1, elementwise]
theorem underlyingIso_arrow {X Y : C} (f : X ⟶ Y) [Mono f] :
    (underlyingIso f).inv ≫ (Subobject.mk f).arrow = f :=
  Over.w _
#align category_theory.subobject.underlying_iso_arrow CategoryTheory.Subobject.underlyingIso_arrow

@[simp, reassoc.1]
theorem underlyingIso_hom_comp_eq_mk {X Y : C} (f : X ⟶ Y) [Mono f] :
    (underlyingIso f).Hom ≫ f = (mk f).arrow :=
  (Iso.eq_inv_comp _).1 (underlyingIso_arrow f).symm
#align category_theory.subobject.underlying_iso_hom_comp_eq_mk CategoryTheory.Subobject.underlyingIso_hom_comp_eq_mk

/-- Two morphisms into a subobject are equal exactly if
the morphisms into the ambient object are equal -/
@[ext]
theorem eq_of_comp_arrow_eq {X Y : C} {P : Subobject Y} {f g : X ⟶ P}
    (h : f ≫ P.arrow = g ≫ P.arrow) : f = g :=
  (cancel_mono P.arrow).mp h
#align category_theory.subobject.eq_of_comp_arrow_eq CategoryTheory.Subobject.eq_of_comp_arrow_eq

theorem mk_le_mk_of_comm {B A₁ A₂ : C} {f₁ : A₁ ⟶ B} {f₂ : A₂ ⟶ B} [Mono f₁] [Mono f₂] (g : A₁ ⟶ A₂)
    (w : g ≫ f₂ = f₁) : mk f₁ ≤ mk f₂ :=
  ⟨MonoOver.homMk _ w⟩
#align category_theory.subobject.mk_le_mk_of_comm CategoryTheory.Subobject.mk_le_mk_of_comm

@[simp]
theorem mk_arrow (P : Subobject X) : mk P.arrow = P :=
  Quotient.inductionOn' P fun Q =>
    by
    obtain ⟨e⟩ := @Quotient.mk_out' _ (is_isomorphic_setoid _) Q
    refine' Quotient.sound' ⟨mono_over.iso_mk _ _ ≪≫ e⟩ <;> tidy
#align category_theory.subobject.mk_arrow CategoryTheory.Subobject.mk_arrow

theorem le_of_comm {B : C} {X Y : Subobject B} (f : (X : C) ⟶ (Y : C)) (w : f ≫ Y.arrow = X.arrow) :
    X ≤ Y := by convert mk_le_mk_of_comm _ w <;> simp
#align category_theory.subobject.le_of_comm CategoryTheory.Subobject.le_of_comm

theorem le_mk_of_comm {B A : C} {X : Subobject B} {f : A ⟶ B} [Mono f] (g : (X : C) ⟶ A)
    (w : g ≫ f = X.arrow) : X ≤ mk f :=
  le_of_comm (g ≫ (underlyingIso f).inv) <| by simp [w]
#align category_theory.subobject.le_mk_of_comm CategoryTheory.Subobject.le_mk_of_comm

theorem mk_le_of_comm {B A : C} {X : Subobject B} {f : A ⟶ B} [Mono f] (g : A ⟶ (X : C))
    (w : g ≫ X.arrow = f) : mk f ≤ X :=
  le_of_comm ((underlyingIso f).Hom ≫ g) <| by simp [w]
#align category_theory.subobject.mk_le_of_comm CategoryTheory.Subobject.mk_le_of_comm

/-- To show that two subobjects are equal, it suffices to exhibit an isomorphism commuting with
    the arrows. -/
@[ext]
theorem eq_of_comm {B : C} {X Y : Subobject B} (f : (X : C) ≅ (Y : C))
    (w : f.Hom ≫ Y.arrow = X.arrow) : X = Y :=
  le_antisymm (le_of_comm f.Hom w) <| le_of_comm f.inv <| f.inv_comp_eq.2 w.symm
#align category_theory.subobject.eq_of_comm CategoryTheory.Subobject.eq_of_comm

/-- To show that two subobjects are equal, it suffices to exhibit an isomorphism commuting with
    the arrows. -/
@[ext]
theorem eq_mk_of_comm {B A : C} {X : Subobject B} (f : A ⟶ B) [Mono f] (i : (X : C) ≅ A)
    (w : i.Hom ≫ f = X.arrow) : X = mk f :=
  eq_of_comm (i.trans (underlyingIso f).symm) <| by simp [w]
#align category_theory.subobject.eq_mk_of_comm CategoryTheory.Subobject.eq_mk_of_comm

/-- To show that two subobjects are equal, it suffices to exhibit an isomorphism commuting with
    the arrows. -/
@[ext]
theorem mk_eq_of_comm {B A : C} {X : Subobject B} (f : A ⟶ B) [Mono f] (i : A ≅ (X : C))
    (w : i.Hom ≫ X.arrow = f) : mk f = X :=
  Eq.symm <| eq_mk_of_comm _ i.symm <| by rw [iso.symm_hom, iso.inv_comp_eq, w]
#align category_theory.subobject.mk_eq_of_comm CategoryTheory.Subobject.mk_eq_of_comm

/-- To show that two subobjects are equal, it suffices to exhibit an isomorphism commuting with
    the arrows. -/
@[ext]
theorem mk_eq_mk_of_comm {B A₁ A₂ : C} (f : A₁ ⟶ B) (g : A₂ ⟶ B) [Mono f] [Mono g] (i : A₁ ≅ A₂)
    (w : i.Hom ≫ g = f) : mk f = mk g :=
  eq_mk_of_comm _ ((underlyingIso f).trans i) <| by simp [w]
#align category_theory.subobject.mk_eq_mk_of_comm CategoryTheory.Subobject.mk_eq_mk_of_comm

-- We make `X` and `Y` explicit arguments here so that when `of_le` appears in goal statements
-- it is possible to see its source and target
-- (`h` will just display as `_`, because it is in `Prop`).
/-- An inequality of subobjects is witnessed by some morphism between the corresponding objects. -/
def ofLe {B : C} (X Y : Subobject B) (h : X ≤ Y) : (X : C) ⟶ (Y : C) :=
  underlying.map <| h.Hom
#align category_theory.subobject.of_le CategoryTheory.Subobject.ofLe

@[simp, reassoc.1]
theorem ofLe_arrow {B : C} {X Y : Subobject B} (h : X ≤ Y) : ofLe X Y h ≫ Y.arrow = X.arrow :=
  underlying_arrow _
#align category_theory.subobject.of_le_arrow CategoryTheory.Subobject.ofLe_arrow

instance {B : C} (X Y : Subobject B) (h : X ≤ Y) : Mono (ofLe X Y h) :=
  by
  fconstructor
  intro Z f g w
  replace w := w =≫ Y.arrow
  ext
  simpa using w

theorem ofLe_mk_le_mk_of_comm {B A₁ A₂ : C} {f₁ : A₁ ⟶ B} {f₂ : A₂ ⟶ B} [Mono f₁] [Mono f₂]
    (g : A₁ ⟶ A₂) (w : g ≫ f₂ = f₁) :
    ofLe _ _ (mk_le_mk_of_comm g w) = (underlyingIso _).Hom ≫ g ≫ (underlyingIso _).inv :=
  by
  ext
  simp [w]
#align category_theory.subobject.of_le_mk_le_mk_of_comm CategoryTheory.Subobject.ofLe_mk_le_mk_of_comm

/-- An inequality of subobjects is witnessed by some morphism between the corresponding objects. -/
def ofLeMk {B A : C} (X : Subobject B) (f : A ⟶ B) [Mono f] (h : X ≤ mk f) : (X : C) ⟶ A :=
  ofLe X (mk f) h ≫ (underlyingIso f).Hom deriving Mono
#align category_theory.subobject.of_le_mk CategoryTheory.Subobject.ofLeMk

@[simp]
theorem ofLeMk_comp {B A : C} {X : Subobject B} {f : A ⟶ B} [Mono f] (h : X ≤ mk f) :
    ofLeMk X f h ≫ f = X.arrow := by simp [of_le_mk]
#align category_theory.subobject.of_le_mk_comp CategoryTheory.Subobject.ofLeMk_comp

/-- An inequality of subobjects is witnessed by some morphism between the corresponding objects. -/
def ofMkLe {B A : C} (f : A ⟶ B) [Mono f] (X : Subobject B) (h : mk f ≤ X) : A ⟶ (X : C) :=
  (underlyingIso f).inv ≫ ofLe (mk f) X h deriving Mono
#align category_theory.subobject.of_mk_le CategoryTheory.Subobject.ofMkLe

@[simp]
theorem ofMkLe_arrow {B A : C} {f : A ⟶ B} [Mono f] {X : Subobject B} (h : mk f ≤ X) :
    ofMkLe f X h ≫ X.arrow = f := by simp [of_mk_le]
#align category_theory.subobject.of_mk_le_arrow CategoryTheory.Subobject.ofMkLe_arrow

/-- An inequality of subobjects is witnessed by some morphism between the corresponding objects. -/
def ofMkLeMk {B A₁ A₂ : C} (f : A₁ ⟶ B) (g : A₂ ⟶ B) [Mono f] [Mono g] (h : mk f ≤ mk g) :
    A₁ ⟶ A₂ :=
  (underlyingIso f).inv ≫ ofLe (mk f) (mk g) h ≫ (underlyingIso g).Hom deriving Mono
#align category_theory.subobject.of_mk_le_mk CategoryTheory.Subobject.ofMkLeMk

@[simp]
theorem ofMkLeMk_comp {B A₁ A₂ : C} {f : A₁ ⟶ B} {g : A₂ ⟶ B} [Mono f] [Mono g] (h : mk f ≤ mk g) :
    ofMkLeMk f g h ≫ g = f := by simp [of_mk_le_mk]
#align category_theory.subobject.of_mk_le_mk_comp CategoryTheory.Subobject.ofMkLeMk_comp

@[simp, reassoc.1]
theorem ofLe_comp_ofLe {B : C} (X Y Z : Subobject B) (h₁ : X ≤ Y) (h₂ : Y ≤ Z) :
    ofLe X Y h₁ ≫ ofLe Y Z h₂ = ofLe X Z (h₁.trans h₂) := by
  simp [of_le, ← functor.map_comp underlying]
#align category_theory.subobject.of_le_comp_of_le CategoryTheory.Subobject.ofLe_comp_ofLe

@[simp, reassoc.1]
theorem ofLe_comp_ofLeMk {B A : C} (X Y : Subobject B) (f : A ⟶ B) [Mono f] (h₁ : X ≤ Y)
    (h₂ : Y ≤ mk f) : ofLe X Y h₁ ≫ ofLeMk Y f h₂ = ofLeMk X f (h₁.trans h₂) := by
  simp [of_mk_le, of_le_mk, of_le, ← functor.map_comp_assoc underlying]
#align category_theory.subobject.of_le_comp_of_le_mk CategoryTheory.Subobject.ofLe_comp_ofLeMk

@[simp, reassoc.1]
theorem ofLeMk_comp_ofMkLe {B A : C} (X : Subobject B) (f : A ⟶ B) [Mono f] (Y : Subobject B)
    (h₁ : X ≤ mk f) (h₂ : mk f ≤ Y) : ofLeMk X f h₁ ≫ ofMkLe f Y h₂ = ofLe X Y (h₁.trans h₂) := by
  simp [of_mk_le, of_le_mk, of_le, ← functor.map_comp underlying]
#align category_theory.subobject.of_le_mk_comp_of_mk_le CategoryTheory.Subobject.ofLeMk_comp_ofMkLe

@[simp, reassoc.1]
theorem ofLeMk_comp_ofMkLeMk {B A₁ A₂ : C} (X : Subobject B) (f : A₁ ⟶ B) [Mono f] (g : A₂ ⟶ B)
    [Mono g] (h₁ : X ≤ mk f) (h₂ : mk f ≤ mk g) :
    ofLeMk X f h₁ ≫ ofMkLeMk f g h₂ = ofLeMk X g (h₁.trans h₂) := by
  simp [of_mk_le, of_le_mk, of_le, of_mk_le_mk, ← functor.map_comp_assoc underlying]
#align category_theory.subobject.of_le_mk_comp_of_mk_le_mk CategoryTheory.Subobject.ofLeMk_comp_ofMkLeMk

@[simp, reassoc.1]
theorem ofMkLe_comp_ofLe {B A₁ : C} (f : A₁ ⟶ B) [Mono f] (X Y : Subobject B) (h₁ : mk f ≤ X)
    (h₂ : X ≤ Y) : ofMkLe f X h₁ ≫ ofLe X Y h₂ = ofMkLe f Y (h₁.trans h₂) := by
  simp [of_mk_le, of_le_mk, of_le, of_mk_le_mk, ← functor.map_comp underlying]
#align category_theory.subobject.of_mk_le_comp_of_le CategoryTheory.Subobject.ofMkLe_comp_ofLe

@[simp, reassoc.1]
theorem ofMkLe_comp_ofLeMk {B A₁ A₂ : C} (f : A₁ ⟶ B) [Mono f] (X : Subobject B) (g : A₂ ⟶ B)
    [Mono g] (h₁ : mk f ≤ X) (h₂ : X ≤ mk g) :
    ofMkLe f X h₁ ≫ ofLeMk X g h₂ = ofMkLeMk f g (h₁.trans h₂) := by
  simp [of_mk_le, of_le_mk, of_le, of_mk_le_mk, ← functor.map_comp_assoc underlying]
#align category_theory.subobject.of_mk_le_comp_of_le_mk CategoryTheory.Subobject.ofMkLe_comp_ofLeMk

@[simp, reassoc.1]
theorem ofMkLeMk_comp_ofMkLe {B A₁ A₂ : C} (f : A₁ ⟶ B) [Mono f] (g : A₂ ⟶ B) [Mono g]
    (X : Subobject B) (h₁ : mk f ≤ mk g) (h₂ : mk g ≤ X) :
    ofMkLeMk f g h₁ ≫ ofMkLe g X h₂ = ofMkLe f X (h₁.trans h₂) := by
  simp [of_mk_le, of_le_mk, of_le, of_mk_le_mk, ← functor.map_comp underlying]
#align category_theory.subobject.of_mk_le_mk_comp_of_mk_le CategoryTheory.Subobject.ofMkLeMk_comp_ofMkLe

@[simp, reassoc.1]
theorem ofMkLeMk_comp_ofMkLeMk {B A₁ A₂ A₃ : C} (f : A₁ ⟶ B) [Mono f] (g : A₂ ⟶ B) [Mono g]
    (h : A₃ ⟶ B) [Mono h] (h₁ : mk f ≤ mk g) (h₂ : mk g ≤ mk h) :
    ofMkLeMk f g h₁ ≫ ofMkLeMk g h h₂ = ofMkLeMk f h (h₁.trans h₂) := by
  simp [of_mk_le, of_le_mk, of_le, of_mk_le_mk, ← functor.map_comp_assoc underlying]
#align category_theory.subobject.of_mk_le_mk_comp_of_mk_le_mk CategoryTheory.Subobject.ofMkLeMk_comp_ofMkLeMk

@[simp]
theorem ofLe_refl {B : C} (X : Subobject B) : ofLe X X le_rfl = 𝟙 _ :=
  by
  apply (cancel_mono X.arrow).mp
  simp
#align category_theory.subobject.of_le_refl CategoryTheory.Subobject.ofLe_refl

@[simp]
theorem ofMkLeMk_refl {B A₁ : C} (f : A₁ ⟶ B) [Mono f] : ofMkLeMk f f le_rfl = 𝟙 _ :=
  by
  apply (cancel_mono f).mp
  simp
#align category_theory.subobject.of_mk_le_mk_refl CategoryTheory.Subobject.ofMkLeMk_refl

-- As with `of_le`, we have `X` and `Y` as explicit arguments for readability.
/-- An equality of subobjects gives an isomorphism of the corresponding objects.
(One could use `underlying.map_iso (eq_to_iso h))` here, but this is more readable.) -/
@[simps]
def isoOfEq {B : C} (X Y : Subobject B) (h : X = Y) : (X : C) ≅ (Y : C)
    where
  Hom := ofLe _ _ h.le
  inv := ofLe _ _ h.ge
#align category_theory.subobject.iso_of_eq CategoryTheory.Subobject.isoOfEq

/-- An equality of subobjects gives an isomorphism of the corresponding objects. -/
@[simps]
def isoOfEqMk {B A : C} (X : Subobject B) (f : A ⟶ B) [Mono f] (h : X = mk f) : (X : C) ≅ A
    where
  Hom := ofLeMk X f h.le
  inv := ofMkLe f X h.ge
#align category_theory.subobject.iso_of_eq_mk CategoryTheory.Subobject.isoOfEqMk

/-- An equality of subobjects gives an isomorphism of the corresponding objects. -/
@[simps]
def isoOfMkEq {B A : C} (f : A ⟶ B) [Mono f] (X : Subobject B) (h : mk f = X) : A ≅ (X : C)
    where
  Hom := ofMkLe f X h.le
  inv := ofLeMk X f h.ge
#align category_theory.subobject.iso_of_mk_eq CategoryTheory.Subobject.isoOfMkEq

/-- An equality of subobjects gives an isomorphism of the corresponding objects. -/
@[simps]
def isoOfMkEqMk {B A₁ A₂ : C} (f : A₁ ⟶ B) (g : A₂ ⟶ B) [Mono f] [Mono g] (h : mk f = mk g) :
    A₁ ≅ A₂ where
  Hom := ofMkLeMk f g h.le
  inv := ofMkLeMk g f h.ge
#align category_theory.subobject.iso_of_mk_eq_mk CategoryTheory.Subobject.isoOfMkEqMk

end Subobject

open CategoryTheory.Limits

namespace Subobject

/-- Any functor `mono_over X ⥤ mono_over Y` descends to a functor
`subobject X ⥤ subobject Y`, because `mono_over Y` is thin. -/
def lower {Y : D} (F : MonoOver X ⥤ MonoOver Y) : Subobject X ⥤ Subobject Y :=
  ThinSkeleton.map F
#align category_theory.subobject.lower CategoryTheory.Subobject.lower

/-- Isomorphic functors become equal when lowered to `subobject`.
(It's not as evil as usual to talk about equality between functors
because the categories are thin and skeletal.) -/
theorem lower_iso (F₁ F₂ : MonoOver X ⥤ MonoOver Y) (h : F₁ ≅ F₂) : lower F₁ = lower F₂ :=
  ThinSkeleton.map_iso_eq h
#align category_theory.subobject.lower_iso CategoryTheory.Subobject.lower_iso

/-- A ternary version of `subobject.lower`. -/
def lower₂ (F : MonoOver X ⥤ MonoOver Y ⥤ MonoOver Z) : Subobject X ⥤ Subobject Y ⥤ Subobject Z :=
  ThinSkeleton.map₂ F
#align category_theory.subobject.lower₂ CategoryTheory.Subobject.lower₂

@[simp]
theorem lower_comm (F : MonoOver Y ⥤ MonoOver X) :
    toThinSkeleton _ ⋙ lower F = F ⋙ toThinSkeleton _ :=
  rfl
#align category_theory.subobject.lower_comm CategoryTheory.Subobject.lower_comm

/-- An adjunction between `mono_over A` and `mono_over B` gives an adjunction
between `subobject A` and `subobject B`. -/
def lowerAdjunction {A : C} {B : D} {L : MonoOver A ⥤ MonoOver B} {R : MonoOver B ⥤ MonoOver A}
    (h : L ⊣ R) : lower L ⊣ lower R :=
  ThinSkeleton.lowerAdjunction _ _ h
#align category_theory.subobject.lower_adjunction CategoryTheory.Subobject.lowerAdjunction

/-- An equivalence between `mono_over A` and `mono_over B` gives an equivalence
between `subobject A` and `subobject B`. -/
@[simps]
def lowerEquivalence {A : C} {B : D} (e : MonoOver A ≌ MonoOver B) : Subobject A ≌ Subobject B
    where
  Functor := lower e.Functor
  inverse := lower e.inverse
  unitIso := by
    apply eq_to_iso
    convert thin_skeleton.map_iso_eq e.unit_iso
    · exact thin_skeleton.map_id_eq.symm
    · exact (thin_skeleton.map_comp_eq _ _).symm
  counitIso := by
    apply eq_to_iso
    convert thin_skeleton.map_iso_eq e.counit_iso
    · exact (thin_skeleton.map_comp_eq _ _).symm
    · exact thin_skeleton.map_id_eq.symm
#align category_theory.subobject.lower_equivalence CategoryTheory.Subobject.lowerEquivalence

section Pullback

variable [HasPullbacks C]

/-- When `C` has pullbacks, a morphism `f : X ⟶ Y` induces a functor `subobject Y ⥤ subobject X`,
by pulling back a monomorphism along `f`. -/
def pullback (f : X ⟶ Y) : Subobject Y ⥤ Subobject X :=
  lower (MonoOver.pullback f)
#align category_theory.subobject.pullback CategoryTheory.Subobject.pullback

theorem pullback_id (x : Subobject X) : (pullback (𝟙 X)).obj x = x :=
  by
  apply Quotient.inductionOn' x
  intro f
  apply Quotient.sound
  exact ⟨mono_over.pullback_id.app f⟩
#align category_theory.subobject.pullback_id CategoryTheory.Subobject.pullback_id

theorem pullback_comp (f : X ⟶ Y) (g : Y ⟶ Z) (x : Subobject Z) :
    (pullback (f ≫ g)).obj x = (pullback f).obj ((pullback g).obj x) :=
  by
  apply Quotient.inductionOn' x
  intro t
  apply Quotient.sound
  refine' ⟨(mono_over.pullback_comp _ _).app t⟩
#align category_theory.subobject.pullback_comp CategoryTheory.Subobject.pullback_comp

instance (f : X ⟶ Y) : Faithful (pullback f) where

end Pullback

section Map

/-- We can map subobjects of `X` to subobjects of `Y`
by post-composition with a monomorphism `f : X ⟶ Y`.
-/
def map (f : X ⟶ Y) [Mono f] : Subobject X ⥤ Subobject Y :=
  lower (MonoOver.map f)
#align category_theory.subobject.map CategoryTheory.Subobject.map

theorem map_id (x : Subobject X) : (map (𝟙 X)).obj x = x :=
  by
  apply Quotient.inductionOn' x
  intro f
  apply Quotient.sound
  exact ⟨mono_over.map_id.app f⟩
#align category_theory.subobject.map_id CategoryTheory.Subobject.map_id

theorem map_comp (f : X ⟶ Y) (g : Y ⟶ Z) [Mono f] [Mono g] (x : Subobject X) :
    (map (f ≫ g)).obj x = (map g).obj ((map f).obj x) :=
  by
  apply Quotient.inductionOn' x
  intro t
  apply Quotient.sound
  refine' ⟨(mono_over.map_comp _ _).app t⟩
#align category_theory.subobject.map_comp CategoryTheory.Subobject.map_comp

/-- Isomorphic objects have equivalent subobject lattices. -/
def mapIso {A B : C} (e : A ≅ B) : Subobject A ≌ Subobject B :=
  lowerEquivalence (MonoOver.mapIso e)
#align category_theory.subobject.map_iso CategoryTheory.Subobject.mapIso

-- @[simps] here generates a lemma `map_iso_to_order_iso_to_equiv_symm_apply`
-- whose left hand side is not in simp normal form.
/-- In fact, there's a type level bijection between the subobjects of isomorphic objects,
which preserves the order. -/
def mapIsoToOrderIso (e : X ≅ Y) : Subobject X ≃o Subobject Y
    where
  toFun := (map e.Hom).obj
  invFun := (map e.inv).obj
  left_inv g := by simp_rw [← map_comp, e.hom_inv_id, map_id]
  right_inv g := by simp_rw [← map_comp, e.inv_hom_id, map_id]
  map_rel_iff' A B := by
    dsimp; fconstructor
    · intro h
      apply_fun (map e.inv).obj  at h
      simp_rw [← map_comp, e.hom_inv_id, map_id] at h
      exact h
    · intro h
      apply_fun (map e.hom).obj  at h
      exact h
#align category_theory.subobject.map_iso_to_order_iso CategoryTheory.Subobject.mapIsoToOrderIso

@[simp]
theorem mapIsoToOrderIso_apply (e : X ≅ Y) (P : Subobject X) :
    mapIsoToOrderIso e P = (map e.Hom).obj P :=
  rfl
#align category_theory.subobject.map_iso_to_order_iso_apply CategoryTheory.Subobject.mapIsoToOrderIso_apply

@[simp]
theorem mapIsoToOrderIso_symm_apply (e : X ≅ Y) (Q : Subobject Y) :
    (mapIsoToOrderIso e).symm Q = (map e.inv).obj Q :=
  rfl
#align category_theory.subobject.map_iso_to_order_iso_symm_apply CategoryTheory.Subobject.mapIsoToOrderIso_symm_apply

/-- `map f : subobject X ⥤ subobject Y` is
the left adjoint of `pullback f : subobject Y ⥤ subobject X`. -/
def mapPullbackAdj [HasPullbacks C] (f : X ⟶ Y) [Mono f] : map f ⊣ pullback f :=
  lowerAdjunction (MonoOver.mapPullbackAdj f)
#align category_theory.subobject.map_pullback_adj CategoryTheory.Subobject.mapPullbackAdj

@[simp]
theorem pullback_map_self [HasPullbacks C] (f : X ⟶ Y) [Mono f] (g : Subobject X) :
    (pullback f).obj ((map f).obj g) = g := by
  revert g
  apply Quotient.ind
  intro g'
  apply Quotient.sound
  exact ⟨(mono_over.pullback_map_self f).app _⟩
#align category_theory.subobject.pullback_map_self CategoryTheory.Subobject.pullback_map_self

theorem map_pullback [HasPullbacks C] {X Y Z W : C} {f : X ⟶ Y} {g : X ⟶ Z} {h : Y ⟶ W} {k : Z ⟶ W}
    [Mono h] [Mono g] (comm : f ≫ h = g ≫ k) (t : IsLimit (PullbackCone.mk f g comm))
    (p : Subobject Y) : (map g).obj ((pullback f).obj p) = (pullback k).obj ((map h).obj p) :=
  by
  revert p
  apply Quotient.ind'
  intro a
  apply Quotient.sound
  apply thin_skeleton.equiv_of_both_ways
  · refine' mono_over.hom_mk (pullback.lift pullback.fst _ _) (pullback.lift_snd _ _ _)
    change _ ≫ a.arrow ≫ h = (pullback.snd ≫ g) ≫ _
    rw [assoc, ← comm, pullback.condition_assoc]
  · refine'
      mono_over.hom_mk
        (pullback.lift pullback.fst
          (pullback_cone.is_limit.lift' t (pullback.fst ≫ a.arrow) pullback.snd _).1
          (pullback_cone.is_limit.lift' _ _ _ _).2.1.symm)
        _
    · rw [← pullback.condition, assoc]
      rfl
    · dsimp
      rw [pullback.lift_snd_assoc]
      apply (pullback_cone.is_limit.lift' _ _ _ _).2.2
#align category_theory.subobject.map_pullback CategoryTheory.Subobject.map_pullback

end Map

section Exists

variable [HasImages C]

/-- The functor from subobjects of `X` to subobjects of `Y` given by
sending the subobject `S` to its "image" under `f`, usually denoted $\exists_f$.
For instance, when `C` is the category of types,
viewing `subobject X` as `set X` this is just `set.image f`.

This functor is left adjoint to the `pullback f` functor (shown in `exists_pullback_adj`)
provided both are defined, and generalises the `map f` functor, again provided it is defined.
-/
def exists (f : X ⟶ Y) : Subobject X ⥤ Subobject Y :=
  lower (MonoOver.exists f)
#align category_theory.subobject.exists CategoryTheory.Subobject.exists

/-- When `f : X ⟶ Y` is a monomorphism, `exists f` agrees with `map f`.
-/
theorem exists_iso_map (f : X ⟶ Y) [Mono f] : exists f = map f :=
  lower_iso _ _ (MonoOver.existsIsoMap f)
#align category_theory.subobject.exists_iso_map CategoryTheory.Subobject.exists_iso_map

/-- `exists f : subobject X ⥤ subobject Y` is
left adjoint to `pullback f : subobject Y ⥤ subobject X`.
-/
def existsPullbackAdj (f : X ⟶ Y) [HasPullbacks C] : exists f ⊣ pullback f :=
  lowerAdjunction (MonoOver.existsPullbackAdj f)
#align category_theory.subobject.exists_pullback_adj CategoryTheory.Subobject.existsPullbackAdj

end Exists

end Subobject

end CategoryTheory