diff --git a/Mathlib.lean b/Mathlib.lean index 1f54a764a7e5b5..dc166cc3353609 100644 --- a/Mathlib.lean +++ b/Mathlib.lean @@ -1892,6 +1892,8 @@ import Mathlib.CategoryTheory.Adjunction.Triple import Mathlib.CategoryTheory.Adjunction.Unique import Mathlib.CategoryTheory.Adjunction.Whiskering import Mathlib.CategoryTheory.Balanced +import Mathlib.CategoryTheory.Bicategory.Adjunction.Adj +import Mathlib.CategoryTheory.Bicategory.Adjunction.BaseChange import Mathlib.CategoryTheory.Bicategory.Adjunction.Basic import Mathlib.CategoryTheory.Bicategory.Adjunction.Mate import Mathlib.CategoryTheory.Bicategory.Basic @@ -1899,11 +1901,13 @@ import Mathlib.CategoryTheory.Bicategory.Coherence import Mathlib.CategoryTheory.Bicategory.End import Mathlib.CategoryTheory.Bicategory.Extension import Mathlib.CategoryTheory.Bicategory.Free +import Mathlib.CategoryTheory.Bicategory.Functor.Cat import Mathlib.CategoryTheory.Bicategory.Functor.Lax import Mathlib.CategoryTheory.Bicategory.Functor.LocallyDiscrete import Mathlib.CategoryTheory.Bicategory.Functor.Oplax import Mathlib.CategoryTheory.Bicategory.Functor.Prelax import Mathlib.CategoryTheory.Bicategory.Functor.Pseudofunctor +import Mathlib.CategoryTheory.Bicategory.Functor.Strict import Mathlib.CategoryTheory.Bicategory.FunctorBicategory.Oplax import Mathlib.CategoryTheory.Bicategory.Grothendieck import Mathlib.CategoryTheory.Bicategory.Kan.Adjunction @@ -1914,6 +1918,7 @@ import Mathlib.CategoryTheory.Bicategory.Modification.Oplax import Mathlib.CategoryTheory.Bicategory.NaturalTransformation.Oplax import Mathlib.CategoryTheory.Bicategory.NaturalTransformation.Pseudo import Mathlib.CategoryTheory.Bicategory.NaturalTransformation.Strong +import Mathlib.CategoryTheory.Bicategory.Opposite import Mathlib.CategoryTheory.Bicategory.SingleObj import Mathlib.CategoryTheory.Bicategory.Strict import Mathlib.CategoryTheory.CatCommSq @@ -2497,6 +2502,14 @@ import Mathlib.CategoryTheory.Sites.CoversTop import Mathlib.CategoryTheory.Sites.DenseSubsite.Basic import Mathlib.CategoryTheory.Sites.DenseSubsite.InducedTopology import Mathlib.CategoryTheory.Sites.DenseSubsite.SheafEquiv +import Mathlib.CategoryTheory.Sites.Descent.DescentData +import Mathlib.CategoryTheory.Sites.Descent.DescentDataAsCoalgebra +import Mathlib.CategoryTheory.Sites.Descent.DescentDataDoublePrime +import Mathlib.CategoryTheory.Sites.Descent.DescentDataPrime +import Mathlib.CategoryTheory.Sites.Descent.IsPrestack +import Mathlib.CategoryTheory.Sites.Descent.IsStack +import Mathlib.CategoryTheory.Sites.Descent.ModuleCat +import Mathlib.CategoryTheory.Sites.Descent.PullbackStruct import Mathlib.CategoryTheory.Sites.EffectiveEpimorphic import Mathlib.CategoryTheory.Sites.EpiMono import Mathlib.CategoryTheory.Sites.EqualizerSheafCondition diff --git a/Mathlib/CategoryTheory/Bicategory/Adjunction/Adj.lean b/Mathlib/CategoryTheory/Bicategory/Adjunction/Adj.lean new file mode 100644 index 00000000000000..d9924221c3fb50 --- /dev/null +++ b/Mathlib/CategoryTheory/Bicategory/Adjunction/Adj.lean @@ -0,0 +1,534 @@ +/- +Copyright (c) 2025 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ +import Mathlib.CategoryTheory.Bicategory.Adjunction.Mate +import Mathlib.CategoryTheory.Bicategory.Functor.Pseudofunctor +import Mathlib.CategoryTheory.Bicategory.Opposite +import Mathlib.CategoryTheory.Bicategory.Functor.Strict + +/-! +# The bicategory of adjunctions in a bicategory + +Given a bicategory `B`, we construct a bicategory `Adj B` that has the same +objects but whose `1`-morphisms are adjunctions (in the same direction +as the left adjoints), and `2`-morphisms are tuples of mate maps between +the left and right adjoints (where the map between right +adjoints is in the opposite direction). + +Certain pseudofunctors to the bicategory `Adj Cat` are analogous to bifibered categories: +in various contexts, this may be used in order to formalize the properties of +both pullback and pushforward functors. + +## References + +* https://ncatlab.org/nlab/show/2-category+of+adjunctions +* https://ncatlab.org/nlab/show/transformation+of+adjoints +* https://ncatlab.org/nlab/show/mate + +-/ + +universe w v u + +namespace CategoryTheory + +namespace Bicategory + +variable {B : Type u} [Bicategory.{w, v} B] + +section + +variable {a b c d : B} {l₁ : a ⟶ b} {r₁ : b ⟶ a} (adj₁ : l₁ ⊣ r₁) + {l₂ : c ⟶ d} {r₂ : d ⟶ c} (adj₂ : l₂ ⊣ r₂) + +variable {f : a ⟶ c} {g : b ⟶ d} + +lemma mateEquiv_id_comp_right (φ : f ≫ 𝟙 _ ≫ l₂ ⟶ l₁ ≫ g) : + mateEquiv adj₁ ((Adjunction.id _).comp adj₂) φ = + mateEquiv adj₁ adj₂ (f ◁ (λ_ l₂).inv ≫ φ) ≫ (ρ_ _).inv ≫ (α_ _ _ _).hom := by + simp only [mateEquiv_apply, Adjunction.homEquiv₁_apply, Adjunction.homEquiv₂_apply, + Adjunction.id] + dsimp + bicategory + +lemma mateEquiv_comp_id_right (φ : f ≫ l₂ ≫ 𝟙 d ⟶ l₁ ≫ g) : + mateEquiv adj₁ (adj₂.comp (Adjunction.id _)) φ = + mateEquiv adj₁ adj₂ ((ρ_ _).inv ≫ (α_ _ _ _).hom ≫ φ) ≫ g ◁ (λ_ r₂).inv := by + simp only [mateEquiv_apply, Adjunction.homEquiv₁_apply, Adjunction.homEquiv₂_apply, + Adjunction.id] + dsimp + bicategory + +end + +section + +variable {a b : B} {l : a ⟶ b} {r : b ⟶ a} (adj : l ⊣ r) + {l' : a ⟶ b} {r' : b ⟶ a} (adj' : l' ⊣ r') (φ : l' ⟶ l) + +lemma conjugateEquiv_id_comp_right_apply : + conjugateEquiv adj ((Adjunction.id _).comp adj') ((λ_ _).hom ≫ φ) = + conjugateEquiv adj adj' φ ≫ (ρ_ _).inv := by + simp only [conjugateEquiv_apply, mateEquiv_id_comp_right, + id_whiskerLeft, Category.assoc, Iso.inv_hom_id_assoc] + bicategory + +lemma conjugateEquiv_comp_id_right_apply : + conjugateEquiv adj (adj'.comp (Adjunction.id _)) ((ρ_ _).hom ≫ φ) = + conjugateEquiv adj adj' φ ≫ (λ_ _).inv := by + simp only [conjugateEquiv_apply, Category.assoc, mateEquiv_comp_id_right, id_whiskerLeft, + Iso.inv_hom_id, Category.comp_id, Iso.hom_inv_id, Iso.cancel_iso_inv_left, + EmbeddingLike.apply_eq_iff_eq] + bicategory + +end + +section + +variable {a b : B} {l : a ⟶ b} {r : b ⟶ a} (adj : l ⊣ r) + +@[simp] +lemma mateEquiv_leftUnitor_hom_rightUnitor_inv : + mateEquiv adj adj ((λ_ _).hom ≫ (ρ_ _).inv) = (ρ_ _).hom ≫ (λ_ _).inv := by + simp only [← cancel_mono (λ_ r).hom, ← cancel_epi (ρ_ r).inv, + Category.assoc, Iso.inv_hom_id_assoc, Iso.inv_hom_id, + ← conjugateEquiv_id adj, conjugateEquiv_apply, Category.id_comp] + +end + +section + +variable {a b c : B} {l₁ : a ⟶ b} {r₁ : b ⟶ a} (adj₁ : l₁ ⊣ r₁) + {l₂ : b ⟶ c} {r₂ : c ⟶ b} (adj₂ : l₂ ⊣ r₂) + {l₂' : b ⟶ c} {r₂' : c ⟶ b} (adj₂' : l₂' ⊣ r₂') + +lemma conjugateEquiv_whiskerLeft (φ : l₂' ⟶ l₂) : + conjugateEquiv (adj₁.comp adj₂) (adj₁.comp adj₂') (l₁ ◁ φ) = + conjugateEquiv adj₂ adj₂' φ ▷ r₁ := by + have := mateEquiv_hcomp adj₁ adj₁ adj₂ adj₂' ((λ_ _).hom ≫ (ρ_ _).inv) + ((λ_ _).hom ≫ φ ≫ (ρ_ _).inv) + dsimp [leftAdjointSquare.hcomp, rightAdjointSquare.hcomp] at this + simp only [comp_whiskerRight, leftUnitor_whiskerRight, Category.assoc, whiskerLeft_comp, + whiskerLeft_rightUnitor_inv, Iso.hom_inv_id, Category.comp_id, triangle_assoc, + inv_hom_whiskerRight_assoc, Iso.inv_hom_id_assoc, mateEquiv_leftUnitor_hom_rightUnitor_inv, + whiskerLeft_rightUnitor, triangle_assoc_comp_left_inv_assoc, Iso.hom_inv_id_assoc] at this + simp [conjugateEquiv_apply, this] + +end + +section + +variable {a b c : B} {l₁ : a ⟶ b} {r₁ : b ⟶ a} (adj₁ : l₁ ⊣ r₁) + {l₁' : a ⟶ b} {r₁' : b ⟶ a} (adj₁' : l₁' ⊣ r₁') + {l₂ : b ⟶ c} {r₂ : c ⟶ b} (adj₂ : l₂ ⊣ r₂) + {l₂' : b ⟶ c} {r₂' : c ⟶ b} (adj₂' : l₂' ⊣ r₂') + +lemma conjugateEquiv_whiskerRight (φ : l₁' ⟶ l₁) : + conjugateEquiv (adj₁.comp adj₂) (adj₁'.comp adj₂) (φ ▷ l₂) = + r₂ ◁ conjugateEquiv adj₁ adj₁' φ := by + have := mateEquiv_hcomp adj₁ adj₁' adj₂ adj₂ + ((λ_ _).hom ≫ φ ≫ (ρ_ _).inv) ((λ_ _).hom ≫ (ρ_ _).inv) + dsimp [leftAdjointSquare.hcomp, rightAdjointSquare.hcomp] at this + simp only [comp_whiskerRight, leftUnitor_whiskerRight, Category.assoc, whiskerLeft_comp, + whiskerLeft_rightUnitor_inv, Iso.hom_inv_id, Category.comp_id, triangle_assoc, + inv_hom_whiskerRight_assoc, Iso.inv_hom_id_assoc, mateEquiv_leftUnitor_hom_rightUnitor_inv, + leftUnitor_inv_whiskerRight, Iso.inv_hom_id, triangle_assoc_comp_right_assoc] at this + simp [conjugateEquiv_apply, this] + +end + +section + +variable {a b c d : B} {l₁ : a ⟶ b} {r₁ : b ⟶ a} (adj₁ : l₁ ⊣ r₁) + {l₂ : b ⟶ c} {r₂ : c ⟶ b} (adj₂ : l₂ ⊣ r₂) + {l₃ : c ⟶ d} {r₃ : d ⟶ c} (adj₃ : l₃ ⊣ r₃) + +lemma conjugateEquiv_associator_hom : + conjugateEquiv (adj₁.comp (adj₂.comp adj₃)) + ((adj₁.comp adj₂).comp adj₃) (α_ _ _ _).hom = (α_ _ _ _).hom := by + simp [← cancel_epi (ρ_ ((r₃ ≫ r₂) ≫ r₁)).hom, ← cancel_mono (λ_ (r₃ ≫ r₂ ≫ r₁)).inv, + conjugateEquiv_apply, mateEquiv_eq_iff, Adjunction.homEquiv₁_symm_apply, + Adjunction.homEquiv₂_apply] + bicategory + +end + + +variable (B) in +/-- +The bicategory that has the same objects as a bicategory `B`, in which `1`-morphisms +are adjunctions (in the same direction as the left adjoints), +and `2`-morphisms are tuples of mate maps between the left and right +adjoints (where the map between right adjoints is in the opposite direction). +-/ +def Adj : Type u := B + +namespace Adj + +/-- If `a : Adj B`, `a.obj : B` is the underlying object of `B`. -/ +abbrev obj (a : Adj B) : B := a + +variable (a b c d : B) + +/-- +Given two objects `a` and `b` in a bicategory, +this is the type of adjunctions between `a` and `b`. +-/ +structure Hom where + /-- the left adjoint -/ + l : a ⟶ b + /-- the right adjoint -/ + r : b ⟶ a + /-- the adjunction -/ + adj : l ⊣ r + +variable {a b} in +/-- Constructor for `1`-morphisms in the bicategory `Adj B`. -/ +@[simps] +def Hom.mk' {l : a ⟶ b} {r : b ⟶ a} (adj : l ⊣ r) : Hom a b where + l := l + r := r + adj := adj + +instance : CategoryStruct (Adj B) where + Hom (a : B) b := Hom a b + id (a : B) := .mk' (Adjunction.id a) + comp f g := .mk' (f.adj.comp g.adj) + +@[simp] lemma id_l (a : Adj B) : Hom.l (𝟙 a) = 𝟙 a.obj := rfl +@[simp] lemma id_r (a : Adj B) : Hom.r (𝟙 a) = 𝟙 a.obj := rfl +@[simp] lemma id_adj (a : Adj B) : Hom.adj (𝟙 a) = Adjunction.id a.obj := rfl + +variable {a b c d : Adj B} + +@[simp] lemma comp_l (α : a ⟶ b) (β : b ⟶ c) : (α ≫ β).l = α.l ≫ β.l := rfl +@[simp] lemma comp_r (α : a ⟶ b) (β : b ⟶ c) : (α ≫ β).r = β.r ≫ α.r := rfl +@[simp] lemma comp_adj (α : a ⟶ b) (β : b ⟶ c) : (α ≫ β).adj = α.adj.comp β.adj := rfl + +/-- A morphism between two adjunctions consists of a tuple of mate maps. -/ +@[ext] +structure Hom₂ (α β : a ⟶ b) where + /-- the morphism between left adjoints -/ + τl : α.l ⟶ β.l + /-- the morphism in the opposite direction between right adjoints -/ + τr : β.r ⟶ α.r + conjugateEquiv_τl : conjugateEquiv β.adj α.adj τl = τr := by aesop_cat + +namespace Hom₂ + +variable {α β : a ⟶ b} (p : Hom₂ α β) + +lemma conjugateEquiv_symm_τg : + (conjugateEquiv β.adj α.adj).symm p.τr = p.τl := by + rw [← Hom₂.conjugateEquiv_τl, Equiv.symm_apply_apply] + +lemma homEquiv₂_τl_eq : + α.adj.homEquiv₂ ((λ_ _).hom ≫ p.τl ≫ (ρ_ _).inv) = + β.adj.homEquiv₁.symm ((ρ_ _).hom ≫ p.τr ≫ (λ_ _).inv) ≫ (α_ _ _ _).inv := by + symm + rw [← cancel_mono (α_ _ _ _).hom, Category.assoc, Iso.inv_hom_id, + Category.comp_id, ← mateEquiv_eq_iff, ← p.conjugateEquiv_τl, + conjugateEquiv_apply, Category.assoc, Category.assoc, Iso.hom_inv_id_assoc, + Iso.hom_inv_id, Category.comp_id] + +lemma homEquiv₁_τl_eq : + β.adj.homEquiv₁ ((λ_ α.l).hom ≫ p.τl ≫ (ρ_ β.l).inv) = + (α_ _ _ _).inv ≫ α.adj.homEquiv₂.symm ((ρ_ _).hom ≫ p.τr ≫ (λ_ _).inv) := by + symm + rw [← cancel_epi (α_ _ _ _).hom, Iso.hom_inv_id_assoc, ← mateEquiv_eq_iff', + mateEquiv_eq_iff, homEquiv₂_τl_eq, Category.assoc, Iso.inv_hom_id, Category.comp_id] + +@[reassoc] +lemma τr_whiskerRight_comp_counit : + p.τr ▷ α.l ≫ α.adj.counit = β.r ◁ p.τl ≫ β.adj.counit := by + simpa [Adjunction.homEquiv₁_apply, Adjunction.homEquiv₂_symm_apply, + ← cancel_epi (β.r ◁ (λ_ _).inv)] using p.homEquiv₁_τl_eq.symm + +@[reassoc] +lemma unit_comp_τl_whiskerRIght : α.adj.unit ≫ p.τl ▷ α.r = β.adj.unit ≫ β.l ◁ p.τr := by + simpa [Adjunction.homEquiv₁_symm_apply, Adjunction.homEquiv₂_apply, + ← cancel_mono ((ρ_ _).hom ▷ α.r)] using p.homEquiv₂_τl_eq + +end Hom₂ + +instance : CategoryStruct (a ⟶ b) where + Hom α β := Hom₂ α β + id α := + { τl := 𝟙 _ + τr := 𝟙 _ } + comp {a b c} x y := + { τl := x.τl ≫ y.τl + τr := y.τr ≫ x.τr + conjugateEquiv_τl := by simp [← conjugateEquiv_comp c.adj b.adj a.adj y.τl x.τl, + Hom₂.conjugateEquiv_τl] } + +@[ext] +lemma hom₂_ext {α β : a ⟶ b} {x y : α ⟶ β} (hl : x.τl = y.τl) : x = y := + Hom₂.ext hl (by simp only [← Hom₂.conjugateEquiv_τl, hl]) + +@[simp] lemma id_τl (α : a ⟶ b) : Hom₂.τl (𝟙 α) = 𝟙 α.l := rfl +@[simp] lemma id_τr (α : a ⟶ b) : Hom₂.τr (𝟙 α) = 𝟙 α.r := rfl + +section + +variable {α β γ : a ⟶ b} + +@[simp, reassoc] lemma comp_τl (x : α ⟶ β) (y : β ⟶ γ) : (x ≫ y).τl = x.τl ≫ y.τl := rfl +@[simp, reassoc] lemma comp_τr (x : α ⟶ β) (y : β ⟶ γ) : (x ≫ y).τr = y.τr ≫ x.τr := rfl + +end + +instance : Category (a ⟶ b) where + +/-- Constructor for isomorphisms between 1-morphisms in the bicategory `Adj B`. -/ +@[simps] +def iso₂Mk {α β : a ⟶ b} (el : α.l ≅ β.l) (er : β.r ≅ α.r) + (h : conjugateEquiv β.adj α.adj el.hom = er.hom) : + α ≅ β where + hom := + { τl := el.hom + τr := er.hom + conjugateEquiv_τl := h } + inv := + { τl := el.inv + τr := er.inv + conjugateEquiv_τl := by + rw [← cancel_mono er.hom, Iso.inv_hom_id, ← h, + conjugateEquiv_comp, Iso.hom_inv_id, conjugateEquiv_id] } + +/-- The associator in the bicategory `Adj B`. -/ +@[simps!] +def associator (α : a ⟶ b) (β : b ⟶ c) (γ : c ⟶ d) : (α ≫ β) ≫ γ ≅ α ≫ β ≫ γ := + iso₂Mk (α_ _ _ _) (α_ _ _ _) (conjugateEquiv_associator_hom _ _ _) + +/-- The left unitor in the bicategory `Adj B`. -/ +@[simps!] +def leftUnitor (α : a ⟶ b) : 𝟙 a ≫ α ≅ α := + iso₂Mk (λ_ _) (ρ_ _).symm + (by simpa using conjugateEquiv_id_comp_right_apply α.adj α.adj (𝟙 _)) + +/-- The right unitor in the bicategory `Adj B`. -/ +@[simps!] +def rightUnitor (α : a ⟶ b) : α ≫ 𝟙 b ≅ α := + iso₂Mk (ρ_ _) (λ_ _).symm + (by simpa using conjugateEquiv_comp_id_right_apply α.adj α.adj (𝟙 _) ) + +/-- The left whiskering in the bicategory `Adj B`. -/ +@[simps] +def whiskerLeft (α : a ⟶ b) {β β' : b ⟶ c} (y : β ⟶ β') : α ≫ β ⟶ α ≫ β' where + τl := _ ◁ y.τl + τr := y.τr ▷ _ + conjugateEquiv_τl := by + dsimp + simp only [conjugateEquiv_whiskerLeft, Hom₂.conjugateEquiv_τl] + +/-- The right whiskering in the bicategory `Adj B`. -/ +@[simps] +def whiskerRight {α α' : a ⟶ b} (x : α ⟶ α') (β : b ⟶ c) : α ≫ β ⟶ α' ≫ β where + τl := x.τl ▷ _ + τr := _ ◁ x.τr + conjugateEquiv_τl := by + dsimp + simp only [conjugateEquiv_whiskerRight, Hom₂.conjugateEquiv_τl] + +attribute [local simp] whisker_exchange + +instance : Bicategory (Adj B) where + whiskerLeft := whiskerLeft + whiskerRight := whiskerRight + associator := associator + leftUnitor := leftUnitor + rightUnitor := rightUnitor + +@[simp] lemma whiskerRight_τr' {α α' : a ⟶ b} (x : α ⟶ α') (β : b ⟶ c) : + (x ▷ β).τr = β.r ◁ x.τr := rfl + +@[simp] lemma whiskerRight_τl' {α α' : a ⟶ b} (x : α ⟶ α') (β : b ⟶ c) : + (x ▷ β).τl = x.τl ▷ β.l := rfl + +@[simp] lemma whiskerLeft_τl' (α : a ⟶ b) {β β' : b ⟶ c} (y : β ⟶ β') : + (α ◁ y).τl = α.l ◁ y.τl := rfl + +@[simp] lemma whiskerLeft_τr' (α : a ⟶ b) {β β' : b ⟶ c} (y : β ⟶ β') : + (α ◁ y).τr = y.τr ▷ α.r := rfl + +@[simp] lemma leftUnitor_hom_τl' (α : a ⟶ b) : (λ_ α).hom.τl = (λ_ _).hom := rfl +@[simp] lemma leftUnitor_hom_τr' (α : a ⟶ b) : (λ_ α).hom.τr = (ρ_ _).inv := rfl +@[simp] lemma rightUnitor_hom_τl' (α : a ⟶ b) : (ρ_ α).hom.τl = (ρ_ _).hom := rfl +@[simp] lemma rightUnitor_hom_τr' (α : a ⟶ b) : (ρ_ α).hom.τr = (λ_ _).inv := rfl +@[simp] lemma leftUnitor_inv_τl' (α : a ⟶ b) : (λ_ α).inv.τl = (λ_ _).inv := rfl +@[simp] lemma leftUnitor_inv_τr' (α : a ⟶ b) : (λ_ α).inv.τr = (ρ_ _).hom := rfl +@[simp] lemma rightUnitor_inv_τl' (α : a ⟶ b) : (ρ_ α).inv.τl = (ρ_ _).inv := rfl +@[simp] lemma rightUnitor_inv_τr' (α : a ⟶ b) : (ρ_ α).inv.τr = (λ_ _).hom := rfl + +/-- The forget pseudofunctor from `Adj B` to `B`. -/ +@[simps obj map map₂ mapId mapComp] +def forget₁ : Pseudofunctor (Adj B) B where + obj a := a.obj + map x := x.l + map₂ α := α.τl + mapId _ := Iso.refl _ + mapComp _ _ := Iso.refl _ + +-- this forgets the left adjoints +--@[simps obj map, simps -isSimp map₂ mapId mapComp] +@[simps obj map map₂ mapId mapComp] +def forget₂ : Pseudofunctor (Adj B)ᵒᵖ B where + obj a := a.unop.obj + map x := x.unop.r + map₂ α := α.unop.τr + mapId _ := Iso.refl _ + mapComp _ _ := Iso.refl _ + +section + +variable {a b : Adj B} {adj₁ adj₂ : a ⟶ b} (e : adj₁ ≅ adj₂) + +/-- Given an isomorphism between two 1-morphisms in `Adj B`, this is the +underlying isomorphisms between the left adjoints. -/ +@[simps] +def lIso : adj₁.l ≅ adj₂.l where + hom := e.hom.τl + inv := e.inv.τl + hom_inv_id := by rw [← comp_τl, e.hom_inv_id, id_τl] + inv_hom_id := by rw [← comp_τl, e.inv_hom_id, id_τl] + +@[reassoc (attr := simp)] +lemma hom_inv_id_τl : + e.hom.τl ≫ e.inv.τl = 𝟙 _ := + (lIso e).hom_inv_id + +@[reassoc (attr := simp)] +lemma inv_hom_id_τl : + e.inv.τl ≫ e.hom.τl = 𝟙 _ := + (lIso e).inv_hom_id + +instance : IsIso e.hom.τl := ⟨e.inv.τl, by simp⟩ +instance : IsIso e.inv.τl := ⟨e.hom.τl, by simp⟩ + +/-- Given an isomorphism between two 1-morphisms in `Adj B`, this is the +underlying isomorphisms between the right adjoints. -/ +@[simps] +def rIso : adj₁.r ≅ adj₂.r where + hom := e.inv.τr + inv := e.hom.τr + hom_inv_id := by rw [← comp_τr, e.hom_inv_id, id_τr] + inv_hom_id := by rw [← comp_τr, e.inv_hom_id, id_τr] + +@[reassoc (attr := simp)] +lemma hom_inv_id_τr : + e.hom.τr ≫ e.inv.τr = 𝟙 _ := + (rIso e).inv_hom_id + +@[reassoc (attr := simp)] +lemma inv_hom_id_τr : + e.inv.τr ≫ e.hom.τr = 𝟙 _ := + (rIso e).hom_inv_id + +instance : IsIso e.hom.τr := ⟨e.inv.τr, by simp⟩ +instance : IsIso e.inv.τr := ⟨e.hom.τr, by simp⟩ + +instance (φ : adj₁ ⟶ adj₂) [IsIso φ] : IsIso φ.τl := (lIso (asIso φ)).isIso_hom +instance (φ : adj₁ ⟶ adj₂) [IsIso φ] : IsIso φ.τr := (rIso (asIso φ)).isIso_inv + +end + +section + +variable {C : Type*} [Bicategory C] (F : Pseudofunctor B (Adj C)) + {a b c : B} (f : a ⟶ b) (g : b ⟶ c) (fg : a ⟶ c) (hfg : f ≫ g = fg) + +lemma comp_forget₁_mapComp' : + (F.comp forget₁).mapComp' f g fg hfg = lIso (F.mapComp' f g fg hfg) := by + subst hfg + ext + simp [Pseudofunctor.mapComp'_eq_mapComp, forget₁] + +lemma mapComp'_comp_adjForget₁_hom : + ((F.comp Adj.forget₁).mapComp' f g fg hfg).hom = (F.mapComp' f g fg hfg).hom.τl := by + simp [comp_forget₁_mapComp'] + +lemma mapComp'_comp_adjForget₁_inv : + ((F.comp Adj.forget₁).mapComp' f g fg hfg).inv = (F.mapComp' f g fg hfg).inv.τl := by + simp [comp_forget₁_mapComp'] + +lemma mapId_comp_adjForget₁ (x : B) : + (F.comp forget₁).mapId x = lIso (F.mapId x) := by + ext + simp + +lemma mapId_comp_adjForget₁_hom (x : B) : + ((F.comp forget₁).mapId x).hom = (F.mapId x).hom.τl := by + simp [mapId_comp_adjForget₁] + +lemma mapId_comp_adjForget₁_inv (x : B) : + ((F.comp forget₁).mapId x).inv = (F.mapId x).inv.τl := by + simp [mapId_comp_adjForget₁] + +lemma counit_map_id : + (F.map (𝟙 a)).adj.counit = + (F.mapId a).inv.τr ▷ _ ≫ _ ◁ (F.mapId a).hom.τl ≫ (λ_ _).hom := by + rw [← whisker_exchange_assoc, ← (F.mapId a).inv.conjugateEquiv_τl, conjugateEquiv_apply'] + simp [Adjunction.id, ← whiskerLeft_comp_assoc] + +@[reassoc] +lemma unit_comp_mapComp'_hom_τr_comp_counit : + (F.map g).adj.unit ▷ (F.map f).r ▷ (F.map fg).l ≫ + (α_ _ _ _).hom ▷ _ ≫ (α_ _ _ _).hom ≫ + (F.map g).l ◁ (F.mapComp' f g fg hfg).hom.τr ▷ (F.map fg).l ≫ + (F.map g).l ◁ (F.map fg).adj.counit = + (α_ _ _ _).hom ≫ (λ_ _).hom ≫ (F.map f).r ◁ (F.mapComp' f g fg hfg).hom.τl ≫ + (α_ _ _ _).inv ≫ (F.map f).adj.counit ▷ _ ≫ (λ_ _).hom ≫ (ρ_ _).inv := by + -- this proof needs some improvements... + rw [← cancel_mono (ρ_ _).hom, ← cancel_epi (α_ _ _ _).inv, ← cancel_epi (λ_ _).inv] + apply (F.map f).adj.homEquiv₁.symm.injective + simp only [Adjunction.homEquiv₁_symm_apply] + trans (F.mapComp' f g fg hfg).hom.τl + · simp only [comp_r, Category.assoc, whiskerLeft_comp, whiskerLeft_rightUnitor, + ← Hom₂.conjugateEquiv_symm_τg, comp_l, comp_adj, conjugateEquiv_symm_apply', + Adjunction.comp_unit, Adjunction.compUnit, comp_whiskerRight, whisker_assoc, + leftUnitor_inv_whiskerRight, Iso.inv_hom_id_assoc, comp_whiskerLeft, + pentagon_inv_hom_hom_hom_hom_assoc] + · simp only [comp_l, Category.assoc, Iso.inv_hom_id, Category.comp_id, Iso.inv_hom_id_assoc, + whiskerLeft_comp] + trans (λ_ _).inv ≫ ((F.map f).adj.unit ▷ (F.map fg).l ≫ + ((F.map f).l ≫ (F.map f).r) ◁ (F.mapComp' f g fg hfg).hom.τl) ≫ + ((α_ _ _ _ ).hom ≫ _ ◁ (α_ _ _ _).inv) ≫ + ((F.map f).l ◁ (F.map f).adj.counit ▷ (F.map g).l) ≫ _ ◁ (λ_ _).hom + · rw [← whisker_exchange, id_whiskerLeft, Category.assoc, Category.assoc, + Category.assoc, Category.assoc, Iso.inv_hom_id_assoc] + trans (F.mapComp' f g fg hfg).hom.τl ≫ (λ_ _).inv ▷ _ ≫ + leftZigzag (F.map f).adj.unit (F.map f).adj.counit ▷ (F.map g).l ≫ (ρ_ _).hom ▷ _ + · simp + · dsimp only [leftZigzag] + simp [-Adjunction.left_triangle, bicategoricalComp] + · simp + +lemma counit_map_of_comp : + (F.map fg).adj.counit = + (F.mapComp' f g fg hfg).inv.τr ▷ _ ≫ + _ ◁ (F.mapComp' f g fg hfg).hom.τl ≫ + (α_ _ _ _).inv ≫ + (α_ _ _ _).hom ▷ (F.map g).l ≫ + ((F.map g).r ◁ (F.map f).adj.counit) ▷ (F.map g).l ≫ + (ρ_ _).hom ▷ (F.map g).l ≫ + (F.map g).adj.counit := by + rw [← cancel_epi ((F.mapComp' f g fg hfg).hom.τr ▷ (F.map fg).l), ← cancel_epi (α_ _ _ _).inv] + apply (F.map g).adj.homEquiv₁.symm.injective + rw [Adjunction.homEquiv₁_symm_apply] + simp only [whiskerRight_comp, comp_r, whiskerLeft_comp, Category.assoc, + pentagon_hom_hom_inv_hom_hom_assoc, comp_l, comp_whiskerLeft, whisker_assoc, + triangle_assoc_comp_right_assoc, pentagon_inv_hom_hom_hom_inv_assoc, Iso.inv_hom_id_assoc, + Iso.cancel_iso_inv_left, unit_comp_mapComp'_hom_τr_comp_counit] + apply (F.map g).adj.homEquiv₁.injective + rw [Adjunction.homEquiv₁_apply, ← comp_whiskerRight_assoc] + simp + +end + +end Adj + +end Bicategory + +end CategoryTheory diff --git a/Mathlib/CategoryTheory/Bicategory/Adjunction/BaseChange.lean b/Mathlib/CategoryTheory/Bicategory/Adjunction/BaseChange.lean new file mode 100644 index 00000000000000..5f43702bcdc8dc --- /dev/null +++ b/Mathlib/CategoryTheory/Bicategory/Adjunction/BaseChange.lean @@ -0,0 +1,821 @@ +/- +Copyright (c) 2025 Christian Merten, Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christian Merten, Joël Riou +-/ +import Mathlib.CategoryTheory.Sites.Descent.DescentData +import Mathlib.CategoryTheory.Sites.Descent.PullbackStruct +import Mathlib.CategoryTheory.Bicategory.Adjunction.Adj +import Mathlib.CategoryTheory.Monad.Comonadicity + +/-! +# Base change morphisms associated to commutative squares + +-/ + +namespace CategoryTheory + +-- TODO: move +namespace CommSq + +variable {C : Type*} [Category C] + +def toLoc {C : Type*} [Category C] {W X Y Z : C} + {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z} (sq : CommSq f g h i) : + CommSq f.toLoc g.toLoc h.toLoc i.toLoc where + w := by simp [← Quiver.Hom.comp_toLoc, sq.w] + +end CommSq + +open Bicategory Limits Opposite + +namespace Bicategory + +variable {B : Type*} [Bicategory B] {c d e : B} + {l₁ : c ⟶ d} {r₁ : d ⟶ c} {l₂ : d ⟶ e} {r₂ : e ⟶ d} + +@[reassoc] +lemma whiskerLeft_whiskerLeft_associator_whiskerRight + {x y z v : B} (f : x ⟶ y) (g : y ⟶ z) (h : x ⟶ z) + (u' h' : z ⟶ v) + (α : f ≫ g ⟶ h) (β : u' ⟶ h') : + f ◁ g ◁ β ≫ (α_ _ _ _).inv ≫ α ▷ _ = + (α_ _ _ _).inv ≫ + α ▷ _ ≫ _ ◁ β := by + rw [← whisker_exchange] + simp + +@[reassoc] +lemma whiskerRight_associator_whiskerLeft_whiskerLeft + {x y z v : B} (f : x ⟶ y) (g : y ⟶ z) (h : x ⟶ z) + (u' h' : z ⟶ v) (α : h ⟶ f ≫ g) (β : u' ⟶ h') : + α ▷ u' ≫ (α_ f g u').hom ≫ f ◁ g ◁ β = + h ◁ β ≫ α ▷ _ ≫ (α_ _ _ _).hom := by + rw [whisker_exchange_assoc] + simp + +@[reassoc] +lemma whiskerLeft_associator_whiskerRight_whiskerRight + {x y z v : B} (f : v ⟶ y) (g : y ⟶ z) (h : v ⟶ z) + (u' h' : x ⟶ v) (α : h ⟶ f ≫ g) (β : u' ⟶ h') : + u' ◁ α ≫ (α_ _ _ _).inv ≫ β ▷ f ▷ g = + β ▷ h ≫ h' ◁ α ≫ (α_ _ _ _).inv := by + rw [← whisker_exchange_assoc] + simp + +@[reassoc] +lemma whiskerRight_whiskerRight_associator_whiskerLeft + {x y z v : B} (f : v ⟶ y) (g : y ⟶ z) (h : v ⟶ z) + (u' h' : x ⟶ v) (β : u' ⟶ h') (α : f ≫ g ⟶ h) : + β ▷ f ▷ g ≫ (α_ _ _ _).hom ≫ h' ◁ α = + (α_ _ _ _).hom ≫ u' ◁ α ≫ β ▷ h := by + simp [whisker_exchange] + +@[reassoc (attr := simp)] +lemma Adjunction.whiskerRight_unit_whiskerLeft_counit (adj₁ : Adjunction l₁ r₁) : + adj₁.unit ▷ l₁ ⊗≫ l₁ ◁ adj₁.counit = (λ_ l₁).hom ≫ (ρ_ l₁).inv := + adj₁.left_triangle + +@[reassoc (attr := simp)] +lemma Adjunction.whiskerRight_unit_associator_whiskerLeft_counit (adj₁ : Adjunction l₁ r₁) : + adj₁.unit ▷ l₁ ≫ (α_ _ _ _).hom ≫ l₁ ◁ adj₁.counit = (λ_ l₁).hom ≫ (ρ_ l₁).inv := by + rw [← adj₁.left_triangle] + bicategory + +@[reassoc (attr := simp)] +lemma Adjunction.whiskerLeft_unit_associator_whiskerRight_counit (adj₁ : Adjunction l₁ r₁) : + r₁ ◁ adj₁.unit ≫ (α_ _ _ _).inv ≫ adj₁.counit ▷ r₁ = (ρ_ _).hom ≫ (λ_ _).inv := by + rw [← adj₁.right_triangle] + bicategory + +lemma mateEquiv_id (adj₁ : Adjunction l₁ r₁) (adj₂ : Adjunction l₂ r₂) : + mateEquiv adj₁ adj₂ (𝟙 _) = adj₁.counit ≫ adj₂.unit := by + simp only [mateEquiv_apply, + Adjunction.homEquiv₁_apply, Adjunction.homEquiv₂_apply] + trans 𝟙 _ ⊗≫ ((r₁ ≫ l₁) ◁ adj₂.unit ≫ adj₁.counit ▷ _ ) ⊗≫ 𝟙 _ + · bicategory + · rw [whisker_exchange] + bicategory + +lemma Adjunction.homEquiv₁_symm_whiskerRight {b c d e : B} {l : b ⟶ c} + {r : c ⟶ b} (adj : l ⊣ r) {g : b ⟶ d} {h : c ⟶ d} (β : r ≫ g ⟶ h) (u : d ⟶ e) : + adj.homEquiv₁.symm ((α_ _ _ _).inv ≫ β ▷ u) = + adj.homEquiv₁.symm β ▷ u ≫ (α_ _ _ _).hom := by + simp [homEquiv₁_symm_apply] + +lemma Adjunction.homEquiv₁_symm_comp {b c d : B} {l : b ⟶ c} + {r : c ⟶ b} (adj : l ⊣ r) {g : b ⟶ d} {h h' : c ⟶ d} (β : r ≫ g ⟶ h) (α : h ⟶ h') : + adj.homEquiv₁.symm (β ≫ α) = + adj.homEquiv₁.symm β ≫ l ◁ α := by + simp [homEquiv₁_symm_apply] + +lemma Adjunction.homEquiv₁_comp {b c d : B} {l : b ⟶ c} + {r : c ⟶ b} (adj : l ⊣ r) {g g' : b ⟶ d} {h : c ⟶ d} (β : g ⟶ l ≫ h) (α : g' ⟶ g) : + adj.homEquiv₁ (α ≫ β) = + r ◁ α ≫ adj.homEquiv₁ β := by + simp [homEquiv₁_apply] + +lemma Adjunction.homEquiv₁_symm_whiskerLeft_comp {b c d : B} {l : b ⟶ c} + {r : c ⟶ b} (adj : l ⊣ r) {g g' : b ⟶ d} {h : c ⟶ d} (β : g' ⟶ g) (α : r ≫ g ⟶ h) : + adj.homEquiv₁.symm (r ◁ β ≫ α) = + β ≫ adj.homEquiv₁.symm α := by + simp [homEquiv₁_symm_apply, whiskerRight_associator_whiskerLeft_whiskerLeft_assoc] + +lemma Adjunction.homEquiv₁_symm_whiskerRight_comp {b c e : B} {l : b ⟶ c} + {r : c ⟶ b} (adj : l ⊣ r) {h : b ⟶ e} {f : c ⟶ b} (α : r ≫ 𝟙 _ ⟶ f) : + adj.homEquiv₁.symm ((ρ_ _).inv ▷ h ≫ α ▷ h) = + (λ_ _).inv ≫ adj.homEquiv₁.symm α ▷ h ≫ (α_ _ _ _).hom := by + simp [homEquiv₁_symm_apply] + bicategory + +lemma Adjunction.homEquiv₂_comp {a b c : B} {l : b ⟶ c} {r : c ⟶ b} + (adj : l ⊣ r) {g : a ⟶ b} {h h' : a ⟶ c} (α : g ≫ l ⟶ h) (β : h ⟶ h') : + adj.homEquiv₂ (α ≫ β) = adj.homEquiv₂ α ≫ β ▷ r := by + simp [homEquiv₂_apply] + +lemma Adjunction.homEquiv₂_whiskerRight_comp {a b c : B} {l : b ⟶ c} {r : c ⟶ b} + (adj : l ⊣ r) {g g' : a ⟶ b} {h : a ⟶ c} (β : g' ⟶ g) (α : g ≫ l ⟶ h) : + adj.homEquiv₂ (β ▷ l ≫ α) = β ≫ adj.homEquiv₂ α := by + simp [homEquiv₂_apply, whiskerLeft_associator_whiskerRight_whiskerRight_assoc] + +lemma mateEquiv_whiskerRight_comp {c d e f : B} {g g' : c ⟶ e} {h : d ⟶ f} + {l₁ : c ⟶ d} {r₁ : d ⟶ c} {l₂ : e ⟶ f} {r₂ : f ⟶ e} (adj₁ : l₁ ⊣ r₁) + (adj₂ : l₂ ⊣ r₂) (α : g' ≫ l₂ ⟶ l₁ ≫ h) (β : g ⟶ g') : + mateEquiv adj₁ adj₂ (β ▷ l₂ ≫ α) = r₁ ◁ β ≫ mateEquiv adj₁ adj₂ α := by + rw [mateEquiv_eq_iff] + simp [mateEquiv_apply, Adjunction.homEquiv₂_whiskerRight_comp, + Adjunction.homEquiv₁_symm_whiskerLeft_comp] + +lemma mateEquiv_comp_whiskerLeft {c d e f : B} {g : c ⟶ e} {h h' : d ⟶ f} + {l₁ : c ⟶ d} {r₁ : d ⟶ c} {l₂ : e ⟶ f} {r₂ : f ⟶ e} (adj₁ : l₁ ⊣ r₁) + (adj₂ : l₂ ⊣ r₂) (α : g ≫ l₂ ⟶ l₁ ≫ h) (β : h ⟶ h') : + mateEquiv adj₁ adj₂ (α ≫ l₁ ◁ β) = mateEquiv adj₁ adj₂ α ≫ β ▷ r₂ := by + rw [mateEquiv_eq_iff] + simp [Adjunction.homEquiv₁_symm_comp, mateEquiv_apply, Adjunction.homEquiv₂_comp] + +lemma Adj.homEquiv₁_of_iso {b c d : Adj B} {l l' : b ⟶ c} {g : b.obj ⟶ d.obj} + {h : c.obj ⟶ d.obj} (e : l ≅ l') (α : g ⟶ l.l ≫ h) : + l.adj.homEquiv₁ α = e.inv.τr ▷ g ≫ l'.adj.homEquiv₁ (α ≫ e.hom.τl ▷ h) := by + simp only [Adjunction.homEquiv₁_apply, whiskerLeft_comp, Category.assoc] + rw [← whisker_exchange_assoc] + congr 1 + simp only [whiskerRight_comp, Category.assoc, Iso.cancel_iso_inv_left] + rw [whiskerRight_whiskerRight_associator_whiskerLeft_assoc] + simp only [whiskerRight_comp, Category.assoc, Iso.hom_inv_id_assoc] + rw [← comp_whiskerRight_assoc, Adj.Hom₂.τr_whiskerRight_comp_counit] + simp only [comp_whiskerRight, whisker_assoc, Category.assoc, Iso.inv_hom_id_assoc] + simp [← whiskerLeft_comp_assoc, ← comp_whiskerRight] + +lemma Adj.homEquiv₁_symm_of_iso {b c d : Adj B} {l l' : b ⟶ c} {g : b.obj ⟶ d.obj} + {h : c.obj ⟶ d.obj} (e : l ≅ l') (α : l.r ≫ g ⟶ h) : + l.adj.homEquiv₁.symm α = l'.adj.homEquiv₁.symm (e.hom.τr ▷ g ≫ α) ≫ e.inv.τl ▷ _ := by + apply l.adj.homEquiv₁.injective + simp only [Equiv.apply_symm_apply] + rw [Adj.homEquiv₁_of_iso e] + simp [Adj.homEquiv₁_of_iso e, ← comp_whiskerRight, ← comp_whiskerRight_assoc] + +lemma Adj.homEquiv₂_of_iso {a b c : Adj B} {l l' : b ⟶ c} + {g : a.obj ⟶ b.obj} {h : a.obj ⟶ c.obj} (e : l ≅ l') + (α : g ≫ l.l ⟶ h) : + l.adj.homEquiv₂ α = l'.adj.homEquiv₂ (g ◁ e.inv.τl ≫ α) ≫ h ◁ e.hom.τr := by + simp only [Adjunction.homEquiv₂_apply, comp_whiskerRight, whisker_assoc, Category.assoc, + Iso.inv_hom_id_assoc, Iso.cancel_iso_inv_left] + rw [← whiskerLeft_comp_assoc, Hom₂.unit_comp_τl_whiskerRIght] + simp only [whiskerLeft_comp, Category.assoc] + simp [whiskerLeft_whiskerLeft_associator_whiskerRight_assoc, ← whiskerLeft_comp] + +lemma mateEquiv_of_iso {c d e f : Adj B} {g : c.obj ⟶ e.obj} {h : d.obj ⟶ f.obj} + {l₁ l₁' : c ⟶ d} {l₂ l₂' : e ⟶ f} + (e₁ : l₁ ≅ l₁') (e₂ : l₂ ≅ l₂') (α : g ≫ l₂.l ⟶ l₁.l ≫ h) : + mateEquiv l₁'.adj l₂'.adj (g ◁ e₂.inv.τl ≫ α ≫ e₁.hom.τl ▷ _) = + e₁.hom.τr ▷ g ≫ mateEquiv l₁.adj l₂.adj α ≫ h ◁ e₂.inv.τr := by + rw [mateEquiv_eq_iff, Adj.homEquiv₁_symm_of_iso e₁.symm, mateEquiv_apply] + simp only [Iso.symm_hom, ← comp_whiskerRight_assoc, Adj.inv_hom_id_τr, id_whiskerRight, + Category.id_comp, Adjunction.homEquiv₁_symm_comp, Equiv.symm_apply_apply, Category.assoc, + Iso.symm_inv, whiskerRight_comp] + rw [Adj.homEquiv₂_of_iso e₂.symm] + simp [Adj.homEquiv₂_of_iso e₂.symm, ← whiskerLeft_comp_assoc, Adjunction.homEquiv₂_comp, + whiskerRight_whiskerRight_associator_whiskerLeft_assoc] + +@[simp] lemma Adj.associator_hom_τl' {a b c d : Adj B} (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d) : + (α_ f g h).hom.τl = (α_ _ _ _).hom := rfl + +@[simp] lemma Adj.associator_hom_τr' {a b c d : Adj B} (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d) : + (α_ f g h).hom.τr = (α_ _ _ _).hom := rfl + +@[simp] lemma Adj.associator_inv_τl' {a b c d : Adj B} (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d) : + (α_ f g h).inv.τl = (α_ _ _ _).inv := rfl + +@[simp] lemma Adj.associator_inv_τr' {a b c d : Adj B} (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d) : + (α_ f g h).inv.τr = (α_ _ _ _).inv := rfl + +end Bicategory + +variable {C : Type*} [Category C] + +namespace Pseudofunctor + +variable (F : Pseudofunctor (LocallyDiscrete Cᵒᵖ) (Adj Cat)) {X S : C} (f : X ⟶ S) + +/- +Let us think that `sq` is a square in `LocallyDiscrete B₀ᵒᵖ` that is dual to a square in `B₀` +``` + t b.unop +X₁ ⟶ Y₁ Y₂ ⟶ X₂ +l| |r dual of r.unop| | l.unop +v v v v +X₂ ⟶ Y₂ Y₁ ⟶ X₁ + b t.unop +``` +This is the base change natural transformation +`l_* ≫ t^* ⟶ b^* ≫ r_*` +-/ +def baseChange + {B C : Type*} [Bicategory B] [Strict B] [Bicategory C] (F : Pseudofunctor B (Adj C)) + {X₁ X₂ Y₁ Y₂ : B} {t : X₁ ⟶ Y₁} {l : X₁ ⟶ X₂} + {r : Y₁ ⟶ Y₂} {b : X₂ ⟶ Y₂} (sq : CommSq t l r b) : + (F.map l).r ≫ (F.map t).l ⟶ (F.map b).l ≫ (F.map r).r := +Bicategory.mateEquiv (F.map l).adj (F.map r).adj (F.isoMapOfCommSq sq).hom.τl + +variable {B C : Type*} [Bicategory B] [Strict B] [Bicategory C] (F : Pseudofunctor B (Adj C)) + {X₁ X₂ Y₁ Y₂ : B} {t : X₁ ⟶ Y₁} {l : X₁ ⟶ X₂} + {r : Y₁ ⟶ Y₂} {b : X₂ ⟶ Y₂} (sq : CommSq t l r b) + +/-- +This is the base change natural transformation whiskered on the right with `r^*` and +composed with the counit of `r^*`, i.e. the composition +`l_* ≫ t^* ≫ r^* ⟶ b^* ≫ r_* ≫ r^* ⟶ b^*`. + +This is used to construct the morphism in `DescentData'` from a `DescentDataAsCoalgebra`. We +postpone descending to the level of objects as long as possible and hence +state all necessary compatibility properties for `whiskerBaseChange` instead. +-/ +def whiskerBaseChange : (F.map l).r ≫ (F.map t).l ≫ (F.map r).l ⟶ (F.map b).l := + (F.map l).adj.homEquiv₁ (F.isoMapOfCommSq sq).hom.τl + +lemma whiskerBaseChange_eq : F.whiskerBaseChange sq = + (F.map l).adj.homEquiv₁ (F.isoMapOfCommSq sq).hom.τl := rfl + +lemma whiskerBaseChange_eq' : F.whiskerBaseChange sq = + (α_ _ _ _).inv ≫ (F.map r).adj.homEquiv₂.symm (F.baseChange sq) := by + dsimp only [baseChange] + rw [mateEquiv_apply', Equiv.symm_apply_apply, Iso.inv_hom_id_assoc, + whiskerBaseChange] + +lemma whiskerBaseChange_eq_whiskerLeft_isoMapOfCommSq : + F.whiskerBaseChange sq = + (F.map l).r ◁ (F.isoMapOfCommSq sq).hom.τl ≫ + (α_ _ _ _).inv ≫ + (F.map l).adj.counit ▷ _ ≫ + (λ_ _).hom := + rfl + +lemma whiskerBaseChange_eq_whiskerRight_baseChange : + F.whiskerBaseChange sq = + (α_ _ _ _).inv ≫ F.baseChange sq ▷ (F.map r).l ≫ + (α_ _ _ _).hom ≫ (F.map b).l ◁ (F.map r).adj.counit ≫ (ρ_ _).hom := by + apply (F.map l).adj.homEquiv₁.symm.injective + rw [whiskerBaseChange] + simp only [Equiv.symm_apply_apply] + rw [← Category.assoc] + rw [Adjunction.homEquiv₁_symm_comp] + rw [Adjunction.homEquiv₁_symm_whiskerRight] + rw [baseChange, Bicategory.mateEquiv_apply] + simp only [Equiv.symm_apply_apply, comp_whiskerRight, Category.assoc, Bicategory.whiskerLeft_comp, + whiskerLeft_rightUnitor, pentagon_assoc] + rw [Adjunction.homEquiv₂_apply] + simp only [comp_whiskerRight, whisker_assoc, Category.assoc, triangle_assoc_comp_right_inv_assoc] + have : + (F.isoMapOfCommSq sq).hom.τl ▷ (F.map r).r ▷ (F.map r).l ≫ + (α_ ((F.map l).l ≫ (F.map b).l) (F.map r).r (F.map r).l).hom ≫ + (α_ (F.map l).l (F.map b).l ((F.map r).r ≫ (F.map r).l)).hom ≫ + (F.map l).l ◁ (F.map b).l ◁ (F.map r).adj.counit = + (α_ _ _ _).hom ≫ + _ ◁ (F.map r).adj.counit ≫ + (F.isoMapOfCommSq sq).hom.τl ▷ _ ≫ + (α_ _ _ _).hom := by + rw [whisker_exchange_assoc] + simp + rw [reassoc_of% this] + simp only [Adj.comp_l, comp_whiskerLeft, Bicategory.whiskerRight_id, Iso.hom_inv_id_assoc, + Category.assoc, Iso.inv_hom_id, Category.comp_id, pentagon_inv_hom_hom_hom_hom_assoc, + Iso.inv_hom_id_assoc] + nth_rw 2 [← Bicategory.whiskerLeft_comp_assoc] + nth_rw 2 [← Bicategory.whiskerLeft_comp_assoc] + rw [Category.assoc] + simp + +section Unit + +variable {B C : Type*} [Bicategory B] [Strict B] [Bicategory C] + (F : Pseudofunctor B (Adj C)) + +variable {X Y : B} (f : X ⟶ Y) + +lemma baseChange_id_id_eq_unit : + F.baseChange (t := 𝟙 X) (l := 𝟙 X) (b := f) (r := f) ⟨rfl⟩ = + (F.map (𝟙 X)).r ◁ (F.mapId _).hom.τl ≫ + (ρ_ _).hom ≫ + (F.mapId _).inv.τr ≫ + (F.map f).adj.unit := by + simp only [baseChange, isoMapOfCommSq_self_self, Iso.refl_hom, Adj.id_τl, Adj.comp_l] + rw [mateEquiv_id, Adj.counit_map_id, ← whisker_exchange_assoc] + simp + +end Unit + +section Horizontal + +variable {B C : Type*} [Bicategory B] [Strict B] [Bicategory C] +(F : Pseudofunctor B (Adj C)) + +variable {X₁ X₂ Y₁ Y₂ Z₁ Z₂ : B} {t : X₁ ⟶ Y₁} {t' : Y₁ ⟶ Z₁} + {l : X₁ ⟶ X₂} {m : Y₁ ⟶ Y₂} {r : Z₁ ⟶ Z₂} + {b : X₂ ⟶ Y₂} {b' : Y₂ ⟶ Z₂} + (sq : CommSq t l m b) (sq' : CommSq t' m r b') + {t'' : X₁ ⟶ Z₁} {b'' : X₂ ⟶ Z₂} + (ht : t ≫ t' = t'') (hb : b ≫ b' = b'') + +lemma baseChange_horiz_comp' : + baseChange F (sq.horiz_comp' sq' ht hb) = + (F.map l).r ◁ (F.mapComp' t t' t'' ht).hom.τl ≫ + (α_ _ _ _).inv ≫ + baseChange F sq ▷ (F.map t').l ≫ + (α_ _ _ _).hom ≫ + (F.map b).l ◁ baseChange F sq' ≫ + (α_ _ _ _).inv ≫ + (F.mapComp' b b' b'' hb).inv.τl ▷ (F.map r).r := by + rw [baseChange, isoMapOfCommSq_horiz_comp F sq sq' ht hb] + dsimp + rw [baseChange, baseChange] + trans + (F.map l).r ◁ (F.mapComp' t t' t'' ht).hom.τl ≫ + Bicategory.mateEquiv (F.map l).adj (F.map r).adj + (leftAdjointSquare.vcomp (F.isoMapOfCommSq sq).hom.τl (F.isoMapOfCommSq sq').hom.τl) ≫ + ((F.mapComp' b b' b'' hb).inv.τl ▷ (F.map r).r) + · rw [mateEquiv_whiskerRight_comp] + simp_rw [← Category.assoc, mateEquiv_comp_whiskerLeft, Category.assoc] + rfl + · erw [Bicategory.mateEquiv_vcomp (F.map l).adj (F.map m).adj (F.map r).adj] + simp [rightAdjointSquare.vcomp] + +end Horizontal + +section Vertical + +variable {B C : Type*} [Bicategory B] [Strict B] [Bicategory C] + (F : Pseudofunctor B (Adj C)) + +variable {X₁ X₂ X₃ Y₁ Y₂ Y₃ : B} + {t : X₁ ⟶ Y₁} {m : X₂ ⟶ Y₂} {b : X₃ ⟶ Y₃} + {l : X₁ ⟶ X₂} {l' : X₂ ⟶ X₃} + {r : Y₁ ⟶ Y₂} {r' : Y₂ ⟶ Y₃} + (sq : CommSq t l r m) + (sq' : CommSq m l' r' b) + {l'' : X₁ ⟶ X₃} {r'' : Y₁ ⟶ Y₃} + (hl : l ≫ l' = l'') (hr : r ≫ r' = r'') + +lemma baseChange_vert_comp' : + baseChange F (sq.vert_comp' sq' hl hr) = + (F.mapComp' l l' l'').inv.τr ▷ (F.map t).l ≫ + (α_ _ _ _).hom ≫ + (F.map l').r ◁ baseChange F sq ≫ + (α_ _ _ _).inv ≫ + baseChange F sq' ▷ (F.map r).r ≫ + (α_ _ _ _).hom ≫ + _ ◁ (F.mapComp' r r' r'').hom.τr := by + rw [baseChange, isoMapOfCommSq_vert_comp F sq sq' hl hr] + dsimp + trans (F.mapComp' l l' l'' hl).inv.τr ▷ (F.map t).l ≫ + Bicategory.mateEquiv ((F.map l).adj.comp (F.map l').adj) ((F.map r).adj.comp (F.map r').adj) + (leftAdjointSquare.hcomp (F.isoMapOfCommSq sq).hom.τl + (F.isoMapOfCommSq sq').hom.τl) ≫ _ ◁ (F.mapComp' r r' r'' hr).hom.τr + · convert mateEquiv_of_iso (F.mapComp' l l' l'' hl).symm + (F.mapComp' r r' r'' hr).symm + (leftAdjointSquare.hcomp (F.isoMapOfCommSq sq).hom.τl (F.isoMapOfCommSq sq').hom.τl) using 1 + simp [leftAdjointSquare.hcomp] + · rw [Bicategory.mateEquiv_hcomp, rightAdjointSquare.hcomp] + simp_rw [Category.assoc] + rfl + +end Vertical + +section Square + +variable {B C : Type*} [Bicategory B] [Strict B] [Bicategory C] + (F : Pseudofunctor B (Adj C)) + +-- 3 by 3 square from left to right `X` -> `Y` -> `Z` and from +-- top to bottom `_₁` -> `_₂` -> `_₃` +variable {X₁ X₂ X₃ Y₁ Y₂ Y₃ Z₁ Z₂ Z₃ : B} + {tl : X₁ ⟶ Y₁} {tr : Y₁ ⟶ Z₁} + {ml : X₂ ⟶ Y₂} {mr : Y₂ ⟶ Z₂} + {bl : X₃ ⟶ Y₃} {br : Y₃ ⟶ Z₃} + {lt : X₁ ⟶ X₂} {lb : X₂ ⟶ X₃} + {mt : Y₁ ⟶ Y₂} {mb : Y₂ ⟶ Y₃} + {rt : Z₁ ⟶ Z₂} {rb : Z₂ ⟶ Z₃} + {t : X₁ ⟶ Z₁} {l : X₁ ⟶ X₃} {r : Z₁ ⟶ Z₃} {b : X₃ ⟶ Z₃} + (sqtl : CommSq tl lt mt ml) + (sqtr : CommSq tr mt rt mr) + (sqbl : CommSq ml lb mb bl) + (sqbr : CommSq mr mb rb br) + (sq : CommSq t l r b) + (ht : tl ≫ tr = t) + (hl : lt ≫ lb = l) + (hr : rt ≫ rb = r) + (hb : bl ≫ br = b) + +lemma baseChange_square : + F.baseChange sq = + (F.mapComp' lt lb l hl).inv.τr ▷ _ ≫ + (α_ _ _ _).hom ≫ + (F.map lb).r ◁ _ ◁ (F.mapComp' tl tr t ht).hom.τl ≫ + (F.map lb).r ◁ (α_ _ _ _).inv ≫ + (F.map lb).r ◁ F.baseChange sqtl ▷ _ ≫ + (F.map lb).r ◁ (α_ _ _ _).hom ≫ + (F.map lb).r ◁ (F.map ml).l ◁ F.baseChange sqtr ≫ + (α_ _ _ _).inv ≫ + (α_ _ _ _).inv ≫ + F.baseChange sqbl ▷ (F.map mr).l ▷ (F.map rt).r ≫ + (α_ _ _ _).hom ▷ (F.map rt).r ≫ + (α_ _ _ _).hom ≫ + (F.map bl).l ◁ F.baseChange sqbr ▷ (F.map rt).r ≫ + (F.map bl).l ◁ (α_ _ _ _).hom ≫ + (F.map bl).l ◁ (F.map br).l ◁ (F.mapComp' rt rb r hr).hom.τr ≫ + (α_ _ _ _).inv ≫ + (F.mapComp' bl br b hb).inv.τl ▷ (F.map r).r := by + let sqt : CommSq t lt rt (ml ≫ mr) := ⟨by simp [← ht, sqtr.1, reassoc_of% sqtl.1]⟩ + let sqb : CommSq (ml ≫ mr) lb rb b := ⟨by simp [← hb, sqbr.1, reassoc_of% sqbl.1]⟩ + rw [F.baseChange_vert_comp' sqt sqb hl hr] + rw [F.baseChange_horiz_comp' sqtl sqtr ht rfl] + rw [F.baseChange_horiz_comp' sqbl sqbr rfl hb] + simp only [Adj.forget₂_obj, Adj.forget₂_map, Quiver.Hom.unop_op', Adj.comp_r, Adj.forget₂_map₂, + Quiver.Hom.unop_op, comp_toPrelaxFunctor, PrelaxFunctor.comp_toPrelaxFunctorStruct, + PrelaxFunctorStruct.comp_toPrefunctor, Prefunctor.comp_obj, Adj.forget₁_obj, + Prefunctor.comp_map, Adj.forget₁_map, Adj.mapComp'_comp_adjForget₁_hom, + Adj.mapComp'_comp_adjForget₁_inv, Bicategory.whiskerLeft_comp, comp_whiskerRight, whisker_assoc, + Category.assoc, Iso.inv_hom_id_assoc, Adj.comp_l] + congr 7 + slice_lhs 2 3 => + rw [← Bicategory.whiskerLeft_comp, ← Bicategory.comp_whiskerRight] + simp only [Adj.inv_hom_id_τl, Adj.comp_l, id_whiskerRight, Bicategory.whiskerLeft_id] + simp only [Category.id_comp, Category.assoc, pentagon_inv_assoc, Iso.cancel_iso_inv_left] + congr 4 + simp [whiskerLeft_whiskerLeft_associator_whiskerRight] + +end Square + +section + +lemma baseChange_self_self {S X Y : B} (f : S ⟶ X) (g : X ⟶ Y) : + F.baseChange (l := f) (t := f) (b := g) (r := g) (by simp) = + (F.map f).adj.counit ≫ (F.map g).adj.unit := by + simp [baseChange, mateEquiv_id] + +lemma whiskerBaseChange_self_self {S X Y : B} (f : S ⟶ X) (g : X ⟶ Y) : + F.whiskerBaseChange (t := f) (l := f) (r := g) (b := g) ⟨by simp⟩ = + (α_ _ _ _).inv ≫ (F.map f).adj.counit ▷ _ ≫ (λ_ _).hom := by + simp [whiskerBaseChange_eq, Adjunction.homEquiv₁_apply, baseChange_self_self] + +variable {Z : B} (b' : X₂ ⟶ Z) (r' : Y₁ ⟶ Z) (d : Y₂ ⟶ Z) + (hbd : b ≫ d = b') (hrd : r ≫ d = r') + +lemma baseChange_id_left (b' : X₁ ⟶ Y₂) (hlb : l ≫ b = b') : + F.baseChange (t := t) (l := 𝟙 _) (r := r) (b := b') ⟨by simpa [hlb] using sq.1⟩ = + (F.mapId _).inv.τr ▷ _ ≫ + (F.map l).adj.unit ▷ _ ≫ + (α_ _ _ _).hom ≫ + _ ◁ F.baseChange sq ≫ + (α_ _ _ _).inv ≫ + (F.mapComp' l b b' hlb).inv.τl ▷ _ := by + let sql : CommSq (𝟙 X₁) (𝟙 X₁) l l := ⟨rfl⟩ + have ht : 𝟙 _ ≫ t = t := by simp + rw [F.baseChange_horiz_comp' sql sq ht hlb, baseChange_id_id_eq_unit, mapComp'_id_comp] + simp only [Adj.comp_l, Iso.trans_hom, Iso.symm_hom, whiskerRightIso_hom, Adj.comp_τl, Adj.id_l, + Adj.leftUnitor_inv_τl', Adj.whiskerRight_τl', Bicategory.whiskerLeft_comp, Adj.id_r, + comp_whiskerRight, whisker_assoc, Category.assoc, triangle_assoc_comp_right_assoc, + Iso.inv_hom_id_assoc] + nth_rw 2 [← Bicategory.whiskerLeft_comp_assoc] + simp [← Bicategory.comp_whiskerRight] + +lemma baseChange_id_comp : + F.baseChange (t := 𝟙 Y₁) (l := r) (r := r ≫ d) (b := d) (by simp) = + (F.map r).r ◁ (F.mapId _).hom.τl ≫ + (ρ_ _).hom ≫ (λ_ _).inv ≫ + (F.map d).adj.unit ▷ _ ≫ + (α_ _ _ _).hom ≫ + (F.map d).l ◁ (F.mapComp r d).hom.τr := by + let sqt : CommSq (𝟙 Y₁) (𝟙 Y₁) r r := ⟨rfl⟩ + let sqb : CommSq r r d d := ⟨rfl⟩ + have hl : 𝟙 _ ≫ r = r := by simp + rw [F.baseChange_vert_comp' sqt sqb hl rfl, baseChange_id_id_eq_unit, baseChange_self_self, + mapComp'_eq_mapComp, mapComp'_id_comp] + simp only [Adj.comp_r, Iso.trans_inv, whiskerRightIso_inv, Iso.symm_inv, Adj.comp_τr, Adj.id_r, + Adj.leftUnitor_hom_τr', Adj.whiskerRight_τr', comp_whiskerRight, whisker_assoc, + triangle_assoc_comp_right_inv_assoc, Adj.id_l, Bicategory.whiskerLeft_comp, + whiskerLeft_rightUnitor, Category.assoc, + Adjunction.whiskerLeft_unit_associator_whiskerRight_counit_assoc, Iso.inv_hom_id_assoc] + nth_rw 2 [← Bicategory.whiskerLeft_comp_assoc] + simp only [← whisker_exchange, id_whiskerLeft, + Category.assoc, Iso.inv_hom_id_assoc, Bicategory.whiskerLeft_comp, + whiskerLeft_rightUnitor_inv, Iso.hom_inv_id_assoc, whiskerLeft_inv_hom_assoc] + simp [← Bicategory.whiskerLeft_comp_assoc] + +lemma baseChange_of_comp_eq : + F.baseChange (l := l) (t := t) (b := b') (r := r') ⟨by rw [← hrd, ← hbd, sq.w_assoc]⟩ = + F.baseChange sq ≫ (F.map b).l ◁ ((λ_ _).inv ≫ (F.map d).adj.unit ▷ _) ≫ + ((F.map b).l ◁ (α_ _ _ _).hom) ≫ (α_ _ _ _).inv ≫ + _ ◁ (F.mapComp' _ _ _ hrd).hom.τr ≫ + (F.mapComp' _ _ _ hbd).inv.τl ▷ (F.map r').r := by + subst hbd hrd + let sq'' : CommSq t l (r ≫ d) (b ≫ d) := ⟨by rw [sq.w_assoc]⟩ + let sq' : CommSq (𝟙 _) r (r ≫ d) d := ⟨by simp⟩ + have : sq'' = sq.horiz_comp' sq' (by simp) rfl := rfl + show F.baseChange (sq.horiz_comp' sq' (by simp) rfl) = _ + rw [F.baseChange_horiz_comp' sq sq' (by simp) rfl] + simp only [Adj.forget₁_obj, Adj.forget₁_map, Adj.comp_l, comp_toPrelaxFunctor, + PrelaxFunctor.comp_toPrelaxFunctorStruct, PrelaxFunctorStruct.comp_toPrefunctor, + Prefunctor.comp_obj, Prefunctor.comp_map, Bicategory.whiskerLeft_comp, Adj.forget₂_map, + Quiver.Hom.unop_op', comp_whiskerLeft, Category.assoc, Iso.inv_hom_id_assoc] + rw [F.baseChange_id_comp] + simp only [comp_toPrelaxFunctor, PrelaxFunctor.comp_toPrelaxFunctorStruct, + PrelaxFunctorStruct.comp_toPrefunctor, Prefunctor.comp_obj, Adj.forget₁_obj, + Prefunctor.comp_map, Adj.forget₁_map, Adj.forget₂_map, Quiver.Hom.unop_op', comp_mapId, + Adj.id_l, Iso.trans_hom, Functor.mapIso_hom, PrelaxFunctor.mapFunctor_map, + Bicategory.whiskerLeft_comp, Category.assoc, whiskerLeft_rightUnitor] + simp_rw [← Category.assoc] + rw [mapComp'_eq_mapComp, mapComp'_eq_mapComp] + congr 6 + simp only [Category.assoc] + rw [mapComp'_comp_id] + -- TODO: make this a `simp` lemma + have : (Adj.forget₁.mapId (F.obj Y₁)).inv = 𝟙 _ := rfl + simp only [Iso.trans_hom, Iso.symm_hom, whiskerLeftIso_hom, Adj.comp_τl, Adj.comp_l, Adj.id_l, + Adj.rightUnitor_inv_τl', Adj.whiskerLeft_τl', Bicategory.whiskerLeft_comp, + whiskerLeft_rightUnitor_inv, Category.assoc] + rw [← comp_whiskerLeft_assoc, whisker_exchange_assoc, comp_whiskerLeft] + simp only [Bicategory.whiskerRight_id, Category.assoc] + simp [← Bicategory.whiskerLeft_comp_assoc, ← Bicategory.whiskerLeft_comp] + +lemma whiskerRight_whiskerBaseChange : + F.whiskerBaseChange sq ▷ (F.map d).l = + (α_ _ _ _).hom ≫ + (F.map l).r ◁ ((α_ _ _ _).hom ≫ (F.map t).l ◁ ((F.comp Adj.forget₁).mapComp' _ _ _ hrd).inv) ≫ + F.whiskerBaseChange (l := l) (t := t) (b := b') (r := r') ⟨by rw [← hrd, ← hbd, sq.w_assoc]⟩ ≫ + ((F.comp Adj.forget₁).mapComp' _ _ _ hbd).hom := by + dsimp + simp only [Bicategory.whiskerLeft_comp, Category.assoc] + simp only [whiskerBaseChange_eq', Adjunction.homEquiv₂_symm_apply, + comp_whiskerRight, whisker_assoc, Category.assoc, + triangle_assoc_comp_right] + rw [F.baseChange_of_comp_eq sq b' r' d hbd hrd] + simp [Adj.comp_forget₁_mapComp'] + rw [Bicategory.associator_inv_naturality_right_assoc, + whisker_exchange_assoc] + simp only [Bicategory.whiskerRight_comp, comp_whiskerLeft, Category.assoc, Iso.inv_hom_id_assoc, + pentagon_hom_inv_inv_inv_inv_assoc, Iso.hom_inv_id_assoc] + congr 2 + dsimp + rw [← Bicategory.associator_inv_naturality_left_assoc, + Iso.inv_hom_id_assoc, ← whisker_exchange_assoc, + Bicategory.whiskerRight_id_assoc, Iso.inv_hom_id_assoc, + Adj.inv_hom_id_τl] + dsimp + rw [Category.comp_id, comp_whiskerLeft_assoc, Iso.inv_hom_id_assoc] + simp only [← Bicategory.whiskerLeft_comp_assoc, + Category.assoc] + rw [Adj.unit_comp_mapComp'_hom_τr_comp_counit F r d r' hrd, + Iso.inv_hom_id_assoc, Iso.inv_hom_id_assoc, ← Bicategory.whiskerLeft_comp_assoc, + Adj.inv_hom_id_τl] + simp + +end + +section Codiag + +variable {S X Y : B} (f : S ⟶ X) (r b : X ⟶ Y) (sq : CommSq f f r b) (d : Y ⟶ X) + (hrd : r ≫ d = 𝟙 _) (hbd : b ≫ d = 𝟙 _) + +lemma whiskerRight_whiskerBaseChange_self_self : + F.whiskerBaseChange sq ▷ (F.map d).l = + ((α_ _ _ _).inv ≫ (F.map f).adj.counit ▷ (F.map r).l ≫ (λ_ _).hom) ▷ (F.map d).l ≫ + ((F.comp Adj.forget₁).mapComp' r d (𝟙 X) hrd).inv ≫ + ((F.comp Adj.forget₁).mapComp' b d (𝟙 X) hbd).hom := by + rw [F.whiskerRight_whiskerBaseChange sq _ _ _ hbd hrd, whiskerBaseChange_self_self] + let a := ((F.map f).r ≫ (F.map f).l) ◁ ((F.comp Adj.forget₁).mapComp' r d (𝟙 X) hrd).inv ≫ + (F.map f).adj.counit ▷ _ + let b := ((F.comp Adj.forget₁).mapComp' b d (𝟙 X) hbd).hom + dsimp at a b ⊢ + trans 𝟙 _ ⊗≫ a ⊗≫ b ⊗≫ 𝟙 _ <;> dsimp [a, b] + · simp [bicategoricalComp] -- why does not `bicategory` work?! + · rw [whisker_exchange] + simp [bicategoricalComp] + +end Codiag + +section Triple + +variable {S X₁ X₂ X₃ : B} {f₁ : S ⟶ X₁} {f₂ : S ⟶ X₂} {f₃ : S ⟶ X₃} + {P₁₂ P₂₃ P₁₃ P₁₂₃ : B} + {u₁₂ : X₁ ⟶ P₁₂} {u₂₁ : X₂ ⟶ P₁₂} {u₂₃ : X₂ ⟶ P₂₃} {u₃₂ : X₃ ⟶ P₂₃} + {u₁₃ : X₁ ⟶ P₁₃} {u₃₁ : X₃ ⟶ P₁₃} + {p₁₂ : P₁₂ ⟶ P₁₂₃} {p₂₃ : P₂₃ ⟶ P₁₂₃} {p₁₃ : P₁₃ ⟶ P₁₂₃} + (sq₁₂ : CommSq f₁ f₂ u₁₂ u₂₁) + (sq₂₃ : CommSq f₂ f₃ u₂₃ u₃₂) + (sq₁₃ : CommSq f₁ f₃ u₁₃ u₃₁) + (h₁₃₁₂ : CommSq u₁₃ u₁₂ p₁₃ p₁₂) + (h₂₁₂₃ : CommSq u₂₁ u₂₃ p₁₂ p₂₃) + (h₃₂₃₁ : CommSq u₃₂ u₃₁ p₂₃ p₁₃) + (p₁ : X₁ ⟶ P₁₂₃) (p₂ : X₂ ⟶ P₁₂₃) (p₃ : X₃ ⟶ P₁₂₃) + (hp₁ : u₁₂ ≫ p₁₂ = p₁) + (hp₂ : u₂₃ ≫ p₂₃ = p₂) + (hp₃ : u₃₂ ≫ p₂₃ = p₃) + +-- TODO: this lemma should not be needed, but `bicategory` can't prove this +omit [Strict B] in +@[reassoc] +private lemma aux (x : (F.map f₃).r ≫ (F.map f₁).l ⟶ (F.map u₃₁).l ≫ (F.map u₁₃).r) : + (ρ_ (F.map f₃)).hom.τr ▷ (F.map f₁).l ≫ + (F.map f₃ ◁ (F.mapId X₃).hom).τr ▷ (F.map f₁).l ≫ + (α_ (F.map (𝟙 X₃)).r (F.map f₃).r (F.map f₁).l).hom ≫ + (F.map (𝟙 X₃)).r ◁ x = x ≫ (λ_ _).inv ≫ + (F.mapId _).hom.τr ▷ _ := by + have : (ρ_ (F.map f₃)).hom.τr = (λ_ _).inv := rfl + rw [this] + dsimp + simp only [Bicategory.whiskerRight_comp] + rw [← cancel_mono (α_ (F.map (𝟙 X₃)).r (F.map u₃₁).l (F.map u₁₃).r).inv] + simp only [Category.assoc, Iso.hom_inv_id, Category.comp_id] + rw [whiskerRight_comp_symm] + simp_rw [Category.assoc] + rw [Iso.inv_hom_id_assoc, whiskerRight_comp_symm, Iso.inv_hom_id_assoc, ← whisker_exchange_assoc] + simp + +lemma baseChange_triple' : + F.baseChange sq₁₃ ≫ + (F.map u₃₁).l ◁ (λ_ _).inv ≫ (F.map u₃₁).l ◁ ((F.map p₁₃).adj.unit ▷ (F.map u₁₃).r) ≫ + (F.map u₃₁).l ◁ (α_ _ _ _).hom ≫ + (α_ _ _ _).inv ≫ + (F.mapComp' u₃₁ p₁₃ p₃ (hp₃ ▸ h₃₂₃₁.1.symm)).inv.τl ▷ _ ≫ + _ ◁ (F.mapComp' u₁₃ p₁₃ p₁ (hp₁ ▸ h₁₃₁₂.1)).hom.τr = + (F.map f₃).r ◁ (λ_ _).inv ≫ (F.map f₃).r ◁ ((F.map f₂).adj.unit ▷ (F.map f₁).l) ≫ + (F.map f₃).r ◁ (α_ _ _ _).hom ≫ + (F.map f₃).r ◁ (F.map f₂).l ◁ F.baseChange sq₁₂ ≫ + (α_ _ _ _).inv ≫ + (F.baseChange sq₂₃) ▷ ((F.map u₂₁).l ≫ (F.map u₁₂).r) ≫ + (α_ _ _ _).hom ≫ + (F.map u₃₂).l ◁ (α_ _ _ _).inv ≫ + (F.map u₃₂).l ◁ (F.baseChange h₂₁₂₃ ▷ (F.map u₁₂).r) ≫ + (F.map u₃₂).l ◁ (α_ _ _ _).hom ≫ + (F.map u₃₂).l ◁ (F.map p₂₃).l ◁ (F.mapComp' u₁₂ p₁₂ p₁ hp₁).hom.τr ≫ + (α_ _ _ _).inv ≫ + (F.mapComp' u₃₂ p₂₃ p₃ hp₃).inv.τl ▷ (F.map p₁).r := by + let sq₃₁₃ : CommSq u₃₁ (𝟙 X₃) p₁₃ p₃ := ⟨by simp [← hp₃, h₃₂₃₁.1]⟩ + let bigsq : CommSq f₁ f₃ p₁ p₃ := sq₁₃.vert_comp' sq₃₁₃ (by simp) (by simp [← hp₁, h₁₃₁₂.1]) + trans F.baseChange bigsq + · rw [F.baseChange_vert_comp' (sq := sq₁₃) (sq' := sq₃₁₃) (l'' := f₃) (r'' := p₁) (by simp) + (by simp [← hp₁, h₁₃₁₂.1])] + simp only [Adj.forget₂_obj, Adj.forget₂_map, Quiver.Hom.unop_op', Adj.comp_r, Adj.forget₂_map₂, + Quiver.Hom.unop_op] + rw [mapComp'_comp_id] + simp only [Iso.trans_inv, whiskerLeftIso_inv, Iso.symm_inv, Adj.comp_τr, Adj.comp_r, Adj.id_r, + comp_whiskerRight, Category.assoc] + rw [F.baseChange_id_left (t := u₃₁) (b' := p₃) (r := p₁₃) (l := u₃₁) (b := p₁₃) (by simp) + (by simp [← hp₃, h₃₂₃₁.1])] + rw [F.baseChange_self_self] + simp only [Adj.comp_l, Bicategory.whiskerRight_comp, Category.assoc, + pentagon_hom_inv_inv_inv_inv_assoc, Adj.id_r, Bicategory.whiskerLeft_comp, + Adjunction.whiskerRight_unit_associator_whiskerLeft_counit_assoc, comp_whiskerRight, + leftUnitor_whiskerRight, whisker_assoc, triangle_assoc_comp_right_inv_assoc] + rw [aux_assoc] + simp [← comp_whiskerRight_assoc, ← comp_whiskerRight] + · let sqtl : CommSq (𝟙 _) (𝟙 _) f₂ f₂ := ⟨rfl⟩ + have := F.baseChange_square sqtl sq₁₂ sq₂₃ h₂₁₂₃ bigsq (by simp) (by simp) hp₁ hp₃ + rw [this] + rw [baseChange_id_id_eq_unit] + simp only [Adj.comp_r, mapComp'_id_comp, Iso.trans_inv, whiskerRightIso_inv, Iso.symm_inv, + Adj.comp_τr, Adj.id_r, Adj.whiskerRight_τr', comp_whiskerRight, whisker_assoc, Adj.comp_l, + Iso.trans_hom, Iso.symm_hom, whiskerRightIso_hom, Adj.comp_τl, Adj.id_l, Adj.whiskerRight_τl', + Bicategory.whiskerLeft_comp, Category.assoc, triangle_assoc_comp_right_assoc, + whiskerLeft_inv_hom_assoc, Iso.inv_hom_id_assoc, Bicategory.whiskerRight_comp, + pentagon_hom_inv_inv_inv_inv_assoc, pentagon_hom_hom_inv_hom_hom_assoc] + have : + (λ_ (F.map f₃)).hom.τr ▷ (F.map f₁).l ≫ + (α_ (F.map f₃).r (𝟙 (F.obj S).obj) (F.map f₁).l).hom ≫ + (F.map f₃).r ◁ (F.mapId S).hom.τr ▷ (F.map f₁).l ≫ + (F.map f₃).r ◁ (F.map (𝟙 S)).r ◁ (λ_ (F.map f₁)).inv.τl ≫ + (F.map f₃).r ◁ (F.map (𝟙 S)).r ◁ (F.mapId S).inv.τl ▷ (F.map f₁).l ≫ + (F.map f₃).r ◁ (F.map (𝟙 S)).r ◁ (F.mapId S).hom.τl ▷ (F.map f₁).l ≫ + (F.map f₃).r ◁ (F.map (𝟙 S)).r ◁ (λ_ (F.map f₁).l).hom ≫ + (F.map f₃).r ◁ (F.mapId S).inv.τr ▷ (F.map f₁).l = + (F.map f₃).r ◁ (λ_ (F.map f₁).l).inv := by + nth_rw 3 [← Bicategory.whiskerLeft_comp_assoc (F.map f₃).r] + rw [← Bicategory.whiskerLeft_comp (F.map (𝟙 S)).r] + rw [← Bicategory.comp_whiskerRight, Adj.inv_hom_id_τl] + have : (λ_ (F.map f₁)).inv.τl = (λ_ _).inv := rfl + simp only [Adj.id_r, Adj.comp_r, Adj.comp_l, Adj.id_l, this, id_whiskerRight, + Bicategory.whiskerLeft_id, Category.id_comp] + nth_rw 2 [← Bicategory.whiskerLeft_comp_assoc (F.map f₃).r] + rw [← Bicategory.whiskerLeft_comp (F.map (𝟙 S)).r] + simp only [Iso.inv_hom_id, Bicategory.whiskerLeft_id, Category.id_comp] + nth_rw 1 [← Bicategory.whiskerLeft_comp (F.map f₃).r] + rw [← Bicategory.comp_whiskerRight] + simp + rw [reassoc_of% this] + +-- TODO: improve this, intentionally ungolfed for now +lemma baseChange_triple : + F.baseChange sq₁₃ ≫ + (F.map u₃₁).l ◁ (λ_ _).inv ≫ (F.map u₃₁).l ◁ ((F.map p₁₃).adj.unit ▷ (F.map u₁₃).r) ≫ + (F.map u₃₁).l ◁ (α_ _ _ _).hom = + (F.map f₃).r ◁ (λ_ _).inv ≫ (F.map f₃).r ◁ ((F.map f₂).adj.unit ▷ (F.map f₁).l) ≫ + (F.map f₃).r ◁ (α_ _ _ _).hom ≫ + (F.map f₃).r ◁ (F.map f₂).l ◁ F.baseChange sq₁₂ ≫ + (α_ _ _ _).inv ≫ + (F.baseChange sq₂₃) ▷ ((F.map u₂₁).l ≫ (F.map u₁₂).r) ≫ + (α_ _ _ _).hom ≫ + (F.map u₃₂).l ◁ (α_ _ _ _).inv ≫ + (F.map u₃₂).l ◁ (F.baseChange h₂₁₂₃ ▷ (F.map u₁₂).r) ≫ + (F.map u₃₂).l ◁ (α_ _ _ _).hom ≫ + (α_ _ _ _).inv ≫ + (F.isoMapOfCommSq h₃₂₃₁).hom.τl ▷ _ ≫ + (α_ _ _ _).hom ≫ + _ ◁ _ ◁ (F.isoMapOfCommSq h₁₃₁₂).hom.τr := by + let p₁ : X₁ ⟶ P₁₂₃ := u₁₂ ≫ p₁₂ + let p₃ : X₃ ⟶ P₁₂₃ := u₃₂ ≫ p₂₃ + rw [← cancel_mono (α_ _ _ _).inv, ← cancel_mono ((F.mapComp' _ _ p₃ (h₃₂₃₁.1.symm)).inv.τl ▷ _)] + rw [← cancel_mono (_ ◁ (F.mapComp' _ _ p₁ (h₁₃₁₂.1)).hom.τr)] + simp_rw [Category.assoc] + rw [F.baseChange_triple' sq₁₂ sq₂₃ sq₁₃ h₁₃₁₂ h₂₁₂₃ h₃₂₃₁ p₁ p₃ rfl rfl] + rw [isoMapOfCommSq_eq _ _ p₁ h₁₃₁₂.1] + rw [isoMapOfCommSq_eq _ _ p₃ rfl] + simp only [Bicategory.whiskerRight_comp, Adj.comp_l, Category.assoc, + pentagon_hom_hom_inv_hom_hom_assoc, Iso.trans_hom, Iso.symm_hom, Adj.comp_τl, comp_whiskerRight, + Adj.comp_r, Adj.comp_τr, Bicategory.whiskerLeft_comp, pentagon_hom_inv_inv_inv_inv_assoc] + congr 10 + rw [← pentagon_inv_assoc] + rw [← pentagon_assoc] + have : + (F.map u₃₁).l ◁ (F.map p₁₃).l ◁ (F.mapComp' u₁₃ p₁₃ p₁ h₁₃₁₂.1).inv.τr ≫ + (α_ (F.map u₃₁).l (F.map p₁₃).l ((F.map p₁₃).r ≫ (F.map u₁₃).r)).inv ≫ + (α_ ((F.map u₃₁).l ≫ (F.map p₁₃).l) (F.map p₁₃).r (F.map u₁₃).r).inv ≫ + (F.mapComp' u₃₁ p₁₃ p₃ (h₃₂₃₁.1.symm)).inv.τl ▷ (F.map p₁₃).r ▷ (F.map u₁₃).r = + (α_ _ _ _).inv ≫ + (F.mapComp' u₃₁ p₁₃ p₃ (h₃₂₃₁.1.symm)).inv.τl ▷ (F.map p₁).r ≫ + (F.map p₃).l ◁ (F.mapComp' u₁₃ p₁₃ p₁ h₁₃₁₂.1).inv.τr ≫ + (α_ _ _ _).inv := by + rw [← whisker_exchange_assoc] + simp + have : (F.mapComp' u₃₁ p₁₃ p₃ (h₃₂₃₁.1.symm)).hom.τl ▷ (F.map p₁₂).r ▷ (F.map u₁₂).r ≫ + (α_ (F.map u₃₁).l (F.map p₁₃).l (F.map p₁₂).r).hom ▷ (F.map u₁₂).r ≫ + (α_ (F.map u₃₁).l ((F.map p₁₃).l ≫ (F.map p₁₂).r) (F.map u₁₂).r).hom ≫ + (F.map u₃₁).l ◁ (α_ (F.map p₁₃).l (F.map p₁₂).r (F.map u₁₂).r).hom ≫ + (F.map u₃₁).l ◁ (F.map p₁₃).l ◁ (F.mapComp' u₁₂ p₁₂ p₁ rfl).hom.τr ≫ + (F.map u₃₁).l ◁ (F.map p₁₃).l ◁ (F.mapComp' u₁₃ p₁₃ p₁ h₁₃₁₂.1).inv.τr ≫ + (F.map u₃₁).l ◁ (α_ (F.map p₁₃).l (F.map p₁₃).r (F.map u₁₃).r).inv ≫ + (α_ (F.map u₃₁).l ((F.map p₁₃).l ≫ (F.map p₁₃).r) (F.map u₁₃).r).inv ≫ + (α_ (F.map u₃₁).l (F.map p₁₃).l (F.map p₁₃).r).inv ▷ (F.map u₁₃).r ≫ + (F.mapComp' u₃₁ p₁₃ p₃ (h₃₂₃₁.1.symm)).inv.τl ▷ (F.map p₁₃).r ▷ (F.map u₁₃).r = + (F.mapComp' u₃₁ p₁₃ p₃ (h₃₂₃₁.1.symm)).hom.τl ▷ (F.map p₁₂).r ▷ (F.map u₁₂).r ≫ + (F.mapComp' u₃₁ p₁₃ p₃ (h₃₂₃₁.1.symm)).inv.τl ▷ _ ▷ _ ≫ + (α_ _ _ _).hom ≫ + (F.map p₃).l ◁ (F.mapComp' u₁₂ p₁₂ p₁ rfl).hom.τr ≫ + (F.map p₃).l ◁ (F.mapComp' u₁₃ p₁₃ p₁ h₁₃₁₂.1).inv.τr ≫ + (α_ _ _ _).inv := by + congr 1 + simp only [Adj.comp_l, Adj.comp_r, pentagon_inv_assoc, pentagon_assoc] + rw [this] + have : + (F.map u₃₁).l ◁ (F.map p₁₃).l ◁ (F.mapComp' u₁₂ p₁₂ p₁ rfl).hom.τr ≫ + (α_ _ _ _).inv ≫ + (F.mapComp' u₃₁ p₁₃ p₃ h₃₂₃₁.1.symm).inv.τl ▷ (F.map p₁).r = + (α_ _ _ _).inv ≫ + (F.mapComp' u₃₁ p₁₃ p₃ h₃₂₃₁.1.symm).inv.τl ▷ _ ≫ + _ ◁ (F.mapComp' u₁₂ p₁₂ p₁ rfl).hom.τr := by + rw [← whisker_exchange] + simp + rw [reassoc_of% this] + simp + rw [reassoc_of% this] + nth_rw 3 [← Bicategory.comp_whiskerRight_assoc] + rw [← Bicategory.comp_whiskerRight] + simp only [Adj.comp_l, Adj.hom_inv_id_τl, id_whiskerRight, Adj.comp_r, Iso.inv_hom_id_assoc, + Category.id_comp] + rw [← Bicategory.whiskerLeft_comp] + simp only [Adj.inv_hom_id_τr, Bicategory.whiskerLeft_id, Category.comp_id] + have : + (F.mapComp' u₃₂ p₂₃ p₃ rfl).inv.τl ▷ (F.map p₁₂).r ▷ (F.map u₁₂).r ≫ + (α_ (F.map p₃).l (F.map p₁₂).r (F.map u₁₂).r).hom ≫ + (F.map p₃).l ◁ (F.mapComp' u₁₂ p₁₂ p₁ rfl).hom.τr = + (α_ _ _ _).hom ≫ + (F.map u₃₂ ≫ F.map p₂₃).l ◁ (F.mapComp' u₁₂ p₁₂ p₁ rfl).hom.τr ≫ + (F.mapComp' u₃₂ p₂₃ p₃ rfl).inv.τl ▷ (F.map p₁).r := by + rw [whisker_exchange] + simp + simp [this] + +end Triple + +end Pseudofunctor + +end CategoryTheory diff --git a/Mathlib/CategoryTheory/Bicategory/Adjunction/Basic.lean b/Mathlib/CategoryTheory/Bicategory/Adjunction/Basic.lean index a9c4d30c13e6e1..703cc46f9f7cb6 100644 --- a/Mathlib/CategoryTheory/Bicategory/Adjunction/Basic.lean +++ b/Mathlib/CategoryTheory/Bicategory/Adjunction/Basic.lean @@ -109,12 +109,15 @@ variable {f₁ : a ⟶ b} {g₁ : b ⟶ a} {f₂ : b ⟶ c} {g₂ : c ⟶ b} /-- Auxiliary definition for `adjunction.comp`. -/ @[simp] def compUnit (adj₁ : f₁ ⊣ g₁) (adj₂ : f₂ ⊣ g₂) : 𝟙 a ⟶ (f₁ ≫ f₂) ≫ g₂ ≫ g₁ := - adj₁.unit ⊗≫ f₁ ◁ adj₂.unit ▷ g₁ ⊗≫ 𝟙 _ + adj₁.unit ≫ f₁ ◁ ((λ_ _).inv ≫ adj₂.unit ▷ g₁ ≫ (α_ _ _ _).hom) ≫ + (α_ _ _ _).inv + --adj₁.unit ⊗≫ f₁ ◁ adj₂.unit ▷ g₁ ⊗≫ 𝟙 _ /-- Auxiliary definition for `adjunction.comp`. -/ @[simp] def compCounit (adj₁ : f₁ ⊣ g₁) (adj₂ : f₂ ⊣ g₂) : (g₂ ≫ g₁) ≫ f₁ ≫ f₂ ⟶ 𝟙 c := - 𝟙 _ ⊗≫ g₂ ◁ adj₁.counit ▷ f₂ ⊗≫ adj₂.counit + (α_ _ _ _).hom ≫ _ ◁ (α_ _ _ _).inv ≫ g₂ ◁ (adj₁.counit ▷ f₂ ≫ (λ_ _).hom) ≫ adj₂.counit + --𝟙 _ ⊗≫ g₂ ◁ adj₁.counit ▷ f₂ ⊗≫ adj₂.counit theorem comp_left_triangle_aux (adj₁ : f₁ ⊣ g₁) (adj₂ : f₂ ⊣ g₂) : leftZigzag (compUnit adj₁ adj₂) (compCounit adj₁ adj₂) = (λ_ _).hom ≫ (ρ_ _).inv := by diff --git a/Mathlib/CategoryTheory/Bicategory/Adjunction/Mate.lean b/Mathlib/CategoryTheory/Bicategory/Adjunction/Mate.lean index 2484df94193291..d4ec295ff24563 100644 --- a/Mathlib/CategoryTheory/Bicategory/Adjunction/Mate.lean +++ b/Mathlib/CategoryTheory/Bicategory/Adjunction/Mate.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2025 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Yuma Mizuno, Joël Riou -/ import Mathlib.CategoryTheory.Bicategory.Adjunction.Basic import Mathlib.CategoryTheory.HomCongr @@ -25,6 +25,16 @@ For the bicategory `Cat`, the definitions in this file are provided in `Mathlib/CategoryTheory/Adjunction/Mates.lean`, where you can find more detailed documentation about mates. + +## Implementation + +The correspondence between mates is obtained by combining +bijections of the form `(g ⟶ l ≫ h) ≃ (r ≫ g ⟶ h)` +and `(g ≫ l ⟶ h) ≃ (g ⟶ h ≫ r)` when `l ⊣ r` is an adjunction. +Indeed, `g ≫ l₂ ⟶ l₁ ≫ h` identifies to `g ⟶ (l₁ ≫ h) ≫ r₂` by using the +second bijection applied to `l₂ ⊣ r₂`, and this identifies to `r₁ ≫ g ⟶ h ≫ r₂` +by using the first bijection applied to `l₁ ⊣ r₁`. + ## Remarks To be precise, the definitions in `Mathlib/CategoryTheory/Adjunction/Mates.lean` are universe @@ -42,6 +52,66 @@ open Bicategory variable {B : Type u} [Bicategory.{w, v} B] +namespace Adjunction + +variable {a b c d : B} {l : b ⟶ c} {r : c ⟶ b} (adj : l ⊣ r) + +/-- The bijection `(g ⟶ l ≫ h) ≃ (r ≫ g ⟶ h)` induced by an adjunction +`l ⊣ r` in a bicategory. -/ +@[simps -isSimp] +def homEquiv₁ {g : b ⟶ d} {h : c ⟶ d} : (g ⟶ l ≫ h) ≃ (r ≫ g ⟶ h) where + toFun γ := r ◁ γ ≫ (α_ _ _ _).inv ≫ adj.counit ▷ h ≫ (λ_ _).hom + invFun β := (λ_ _).inv ≫ adj.unit ▷ _ ≫ (α_ _ _ _).hom ≫ l ◁ β + left_inv γ := + calc + _ = 𝟙 _ ⊗≫ (adj.unit ▷ g ≫ (l ≫ r) ◁ γ) ⊗≫ l ◁ adj.counit ▷ h ⊗≫ 𝟙 _:= by + bicategory + _ = γ ⊗≫ leftZigzag adj.unit adj.counit ▷ h ⊗≫ 𝟙 _ := by + rw [← whisker_exchange] + bicategory + _ = γ := by + rw [adj.left_triangle] + bicategory + right_inv β := by + calc + _ = 𝟙 _ ⊗≫ r ◁ adj.unit ▷ g ⊗≫ ((r ≫ l) ◁ β ≫ adj.counit ▷ h) ⊗≫ 𝟙 _ := by + bicategory + _ = 𝟙 _ ⊗≫ rightZigzag adj.unit adj.counit ▷ g ⊗≫ β := by + rw [whisker_exchange] + bicategory + _ = β := by + rw [adj.right_triangle] + bicategory + +/-- The bijection `(g ≫ l ⟶ h) ≃ (g ⟶ h ≫ r)` induced by an adjunction +`l ⊣ r` in a bicategory. -/ +@[simps -isSimp] +def homEquiv₂ {g : a ⟶ b} {h : a ⟶ c} : (g ≫ l ⟶ h) ≃ (g ⟶ h ≫ r) where + toFun α := (ρ_ _).inv ≫ g ◁ adj.unit ≫ (α_ _ _ _).inv ≫ α ▷ r + invFun γ := γ ▷ l ≫ (α_ _ _ _ ).hom ≫ h ◁ adj.counit ≫ (ρ_ _).hom + left_inv α := + calc + _ = 𝟙 _ ⊗≫ g ◁ adj.unit ▷ l ⊗≫ (α ▷ (r ≫ l) ≫ h ◁ adj.counit) ⊗≫ 𝟙 _ := by + bicategory + _ = 𝟙 _ ⊗≫ g ◁ leftZigzag adj.unit adj.counit ⊗≫ α := by + rw [← whisker_exchange] + bicategory + _ = α := by + rw [adj.left_triangle] + bicategory + right_inv γ := + calc + _ = 𝟙 _ ⊗≫ (g ◁ adj.unit ≫ γ ▷ (l ≫ r)) ⊗≫ h ◁ adj.counit ▷ r ⊗≫ 𝟙 _ := by + bicategory + _ = 𝟙 _ ⊗≫ γ ⊗≫ h ◁ rightZigzag adj.unit adj.counit ⊗≫ 𝟙 _ := by + rw [whisker_exchange] + bicategory + _ = γ := by + rw [adj.right_triangle] + bicategory + +end Adjunction + section mateEquiv variable {c d e f : B} {g : c ⟶ e} {h : d ⟶ f} {l₁ : c ⟶ d} {r₁ : d ⟶ c} {l₂ : e ⟶ f} {r₂ : f ⟶ e} @@ -65,58 +135,33 @@ Then we have a bijection between natural transformations `g ≫ l₂ ⟶ l₁ Note that if one of the transformations is an iso, it does not imply the other is an iso. -/ -@[simps] -def mateEquiv : (g ≫ l₂ ⟶ l₁ ≫ h) ≃ (r₁ ≫ g ⟶ h ≫ r₂) where - toFun α := 𝟙 _ ⊗≫ r₁ ◁ g ◁ adj₂.unit ⊗≫ r₁ ◁ α ▷ r₂ ⊗≫ adj₁.counit ▷ h ▷ r₂ ⊗≫ 𝟙 _ - invFun β := 𝟙 _ ⊗≫ adj₁.unit ▷ g ▷ l₂ ⊗≫ l₁ ◁ β ▷ l₂ ⊗≫ l₁ ◁ h ◁ adj₂.counit ⊗≫ 𝟙 _ - left_inv α := - calc - _ = 𝟙 _ ⊗≫ (adj₁.unit ▷ (g ≫ 𝟙 e) ≫ (l₁ ≫ r₁) ◁ g ◁ adj₂.unit) ▷ l₂ ⊗≫ - l₁ ◁ r₁ ◁ α ▷ r₂ ▷ l₂ ⊗≫ - l₁ ◁ (adj₁.counit ▷ h ▷ (r₂ ≫ l₂) ≫ (𝟙 d ≫ h) ◁ adj₂.counit) ⊗≫ 𝟙 _ := by - bicategory - _ = 𝟙 _ ⊗≫ g ◁ adj₂.unit ▷ l₂ ⊗≫ - (adj₁.unit ▷ (g ≫ l₂) ≫ (l₁ ≫ r₁) ◁ α) ▷ (r₂ ≫ l₂) ⊗≫ - l₁ ◁ (((r₁ ≫ l₁) ≫ h) ◁ adj₂.counit ≫ adj₁.counit ▷ h ▷ 𝟙 f) ⊗≫ 𝟙 _ := by - rw [← whisker_exchange, ← whisker_exchange] - bicategory - _ = 𝟙 _ ⊗≫ g ◁ adj₂.unit ▷ l₂ ⊗≫ α ▷ r₂ ▷ l₂ ⊗≫ - leftZigzag adj₁.unit adj₁.counit ▷ h ▷ r₂ ▷ l₂ ⊗≫ l₁ ◁ h ◁ adj₂.counit ⊗≫ 𝟙 _ := by - rw [← whisker_exchange, whisker_exchange _ adj₂.counit] - bicategory - _ = 𝟙 _ ⊗≫ g ◁ adj₂.unit ▷ l₂ ⊗≫ (α ▷ (r₂ ≫ l₂) ≫ (l₁ ≫ h) ◁ adj₂.counit) ⊗≫ 𝟙 _ := by - rw [adj₁.left_triangle] - bicategory - _ = 𝟙 _ ⊗≫ g ◁ (leftZigzag adj₂.unit adj₂.counit) ⊗≫ α ⊗≫ 𝟙 _ := by - rw [← whisker_exchange] - bicategory - _ = α := by - rw [adj₂.left_triangle] - bicategory - right_inv β := - calc - _ = 𝟙 _ ⊗≫ r₁ ◁ ((𝟙 c ≫ g) ◁ adj₂.unit ≫ adj₁.unit ▷ g ▷ (l₂ ≫ r₂)) ⊗≫ - r₁ ◁ l₁ ◁ β ▷ l₂ ▷ r₂ ⊗≫ - ((r₁ ≫ l₁) ◁ h ◁ adj₂.counit ≫ adj₁.counit ▷ (h ≫ 𝟙 f)) ▷ r₂ ⊗≫ 𝟙 _ := by - bicategory - _ = 𝟙 _ ⊗≫ r₁ ◁ (adj₁.unit ▷ g ▷ 𝟙 e ≫ ((l₁ ≫ r₁) ≫ g) ◁ adj₂.unit) ⊗≫ - ((r₁ ≫ l₁) ◁ β ≫ adj₁.counit ▷ (h ≫ r₂)) ▷ l₂ ▷ r₂ ⊗≫ - h ◁ adj₂.counit ▷ r₂ ⊗≫ 𝟙 _ := by - rw [whisker_exchange, whisker_exchange] - bicategory - _ = 𝟙 _ ⊗≫ r₁ ◁ g ◁ adj₂.unit ⊗≫ rightZigzag adj₁.unit adj₁.counit ▷ g ▷ l₂ ▷ r₂ ⊗≫ - β ▷ l₂ ▷ r₂ ⊗≫ h ◁ adj₂.counit ▷ r₂ ⊗≫ 𝟙 _ := by - rw [whisker_exchange, ← whisker_exchange _ adj₂.unit] - bicategory - _ = 𝟙 _ ⊗≫ ((r₁ ≫ g) ◁ adj₂.unit ≫ β ▷ (l₂ ≫ r₂)) ⊗≫ h ◁ adj₂.counit ▷ r₂ ⊗≫ 𝟙 _ := by - rw [adj₁.right_triangle] - bicategory - _ = 𝟙 _ ⊗≫ β ⊗≫ h ◁ rightZigzag adj₂.unit adj₂.counit ⊗≫ 𝟙 _ := by - rw [whisker_exchange] - bicategory - _ = β := by - rw [adj₂.right_triangle] - bicategory +@[simps! -isSimp] +def mateEquiv : (g ≫ l₂ ⟶ l₁ ≫ h) ≃ (r₁ ≫ g ⟶ h ≫ r₂) := + adj₂.homEquiv₂.trans ((Iso.homCongr (Iso.refl _) (α_ _ _ _)).trans adj₁.homEquiv₁) + +lemma mateEquiv_apply' (α : g ≫ l₂ ⟶ l₁ ≫ h) : + mateEquiv adj₁ adj₂ α = + adj₂.homEquiv₂ ((α_ _ _ _).hom ≫ adj₁.homEquiv₁ α) := by + simp [mateEquiv_apply, Adjunction.homEquiv₁_apply, + Adjunction.homEquiv₂_apply] + +lemma mateEquiv_symm_apply' (β : r₁ ≫ g ⟶ h ≫ r₂) : + (mateEquiv adj₁ adj₂).symm β = + adj₁.homEquiv₁.symm ((α_ _ _ _).inv ≫ adj₂.homEquiv₂.symm β) := by + simp [mateEquiv_symm_apply, Adjunction.homEquiv₁_symm_apply, + Adjunction.homEquiv₂_symm_apply] + +lemma mateEquiv_eq_iff (α : g ≫ l₂ ⟶ l₁ ≫ h) (β : r₁ ≫ g ⟶ h ≫ r₂) : + mateEquiv adj₁ adj₂ α = β ↔ + adj₁.homEquiv₁.symm β = adj₂.homEquiv₂ α ≫ (α_ _ _ _).hom := by + conv_lhs => rw [eq_comm, ← adj₁.homEquiv₁.symm.injective.eq_iff'] + rw [mateEquiv_apply, Equiv.symm_apply_apply] + +lemma mateEquiv_eq_iff' (α : g ≫ l₂ ⟶ l₁ ≫ h) (β : r₁ ≫ g ⟶ h ≫ r₂) : + mateEquiv adj₁ adj₂ α = β ↔ + adj₂.homEquiv₂.symm β = (α_ _ _ _).hom ≫ adj₁.homEquiv₁ α := by + rw [eq_comm, mateEquiv_apply', ← adj₂.homEquiv₂.symm.injective.eq_iff'] + rw [Equiv.symm_apply_apply] end mateEquiv @@ -140,7 +185,8 @@ def rightAdjointSquare.vcomp (α : r₁ ≫ g₁ ⟶ h₁ ≫ r₂) (β : r₂ theorem mateEquiv_vcomp (α : g₁ ≫ l₂ ⟶ l₁ ≫ h₁) (β : g₂ ≫ l₃ ⟶ l₂ ≫ h₂) : mateEquiv adj₁ adj₃ (leftAdjointSquare.vcomp α β) = rightAdjointSquare.vcomp (mateEquiv adj₁ adj₂ α) (mateEquiv adj₂ adj₃ β) := by - dsimp only [leftAdjointSquare.vcomp, mateEquiv_apply, rightAdjointSquare.vcomp] + simp only [leftAdjointSquare.vcomp, mateEquiv_apply, rightAdjointSquare.vcomp, + Adjunction.homEquiv₁_apply, Adjunction.homEquiv₂_apply] symm calc _ = 𝟙 _ ⊗≫ r₁ ◁ g₁ ◁ adj₂.unit ▷ g₂ ⊗≫ r₁ ◁ α ▷ r₂ ▷ g₂ ⊗≫ @@ -197,7 +243,8 @@ def rightAdjointSquare.hcomp (α : r₁ ≫ g ⟶ h ≫ r₂) (β : r₃ ≫ h theorem mateEquiv_hcomp (α : g ≫ l₂ ⟶ l₁ ≫ h) (β : h ≫ l₄ ⟶ l₃ ≫ k) : (mateEquiv (adj₁.comp adj₃) (adj₂.comp adj₄)) (leftAdjointSquare.hcomp α β) = rightAdjointSquare.hcomp (mateEquiv adj₁ adj₂ α) (mateEquiv adj₃ adj₄ β) := by - dsimp [mateEquiv, leftAdjointSquare.hcomp, rightAdjointSquare.hcomp] + dsimp [mateEquiv, leftAdjointSquare.hcomp, rightAdjointSquare.hcomp, + Adjunction.homEquiv₁_apply, Adjunction.homEquiv₂_apply] calc _ = 𝟙 _ ⊗≫ r₃ ◁ r₁ ◁ g ◁ adj₂.unit ⊗≫ r₃ ◁ r₁ ◁ ((g ≫ l₂) ◁ adj₄.unit ≫ α ▷ (l₄ ≫ r₄)) ▷ r₂ ⊗≫ @@ -328,7 +375,8 @@ theorem conjugateEquiv_apply' (α : l₂ ⟶ l₁) : conjugateEquiv adj₁ adj₂ α = (ρ_ _).inv ≫ r₁ ◁ adj₂.unit ≫ r₁ ◁ α ▷ r₂ ≫ (α_ _ _ _).inv ≫ adj₁.counit ▷ r₂ ≫ (λ_ _).hom := by - rw [conjugateEquiv_apply, mateEquiv_apply] + rw [conjugateEquiv_apply, mateEquiv_apply, + Adjunction.homEquiv₁_apply, Adjunction.homEquiv₂_apply] bicategory theorem conjugateEquiv_symm_apply (α : r₁ ⟶ r₂) : @@ -340,12 +388,14 @@ theorem conjugateEquiv_symm_apply' (α : r₁ ⟶ r₂) : (conjugateEquiv adj₁ adj₂).symm α = (λ_ _).inv ≫ adj₁.unit ▷ l₂ ≫ (α_ _ _ _).hom ≫ l₁ ◁ α ▷ l₂ ≫ l₁ ◁ adj₂.counit ≫ (ρ_ _).hom := by - rw [conjugateEquiv_symm_apply, mateEquiv_symm_apply] + rw [conjugateEquiv_symm_apply, mateEquiv_symm_apply, + Adjunction.homEquiv₁_symm_apply, Adjunction.homEquiv₂_symm_apply] bicategory @[simp] theorem conjugateEquiv_id : conjugateEquiv adj₁ adj₁ (𝟙 _) = 𝟙 _ := by - rw [conjugateEquiv_apply, mateEquiv_apply] + rw [conjugateEquiv_apply, mateEquiv_apply, Adjunction.homEquiv₁_apply, + Adjunction.homEquiv₂_apply] calc _ = 𝟙 _ ⊗≫ rightZigzag adj₁.unit adj₁.counit ⊗≫ 𝟙 _ := by bicategory @@ -359,12 +409,14 @@ theorem conjugateEquiv_symm_id : (conjugateEquiv adj₁ adj₁).symm (𝟙 _) = theorem conjugateEquiv_adjunction_id {l r : c ⟶ c} (adj : l ⊣ r) (α : 𝟙 c ⟶ l) : (conjugateEquiv adj (Adjunction.id c) α) = (ρ_ _).inv ≫ r ◁ α ≫ adj.counit := by - dsimp [conjugateEquiv, mateEquiv, Adjunction.id] + dsimp [conjugateEquiv, mateEquiv, Adjunction.id, Adjunction.homEquiv₁_apply, + Adjunction.homEquiv₂_apply] bicategory theorem conjugateEquiv_adjunction_id_symm {l r : c ⟶ c} (adj : l ⊣ r) (α : r ⟶ 𝟙 c) : (conjugateEquiv adj (Adjunction.id c)).symm α = adj.unit ≫ l ◁ α ≫ (ρ_ _).hom := by - dsimp [conjugateEquiv, mateEquiv, Adjunction.id] + dsimp [conjugateEquiv, mateEquiv, Adjunction.id, Adjunction.homEquiv₁_symm_apply, + Adjunction.homEquiv₂_symm_apply] bicategory end conjugateEquiv @@ -388,7 +440,8 @@ theorem conjugateEquiv_comp (α : l₂ ⟶ l₁) (β : l₃ ⟶ l₂) : bicategory _ = _ := by rw [← mateEquiv_vcomp] - dsimp only [leftAdjointSquare.vcomp, mateEquiv_apply] + simp only [leftAdjointSquare.vcomp, mateEquiv_apply, + Adjunction.homEquiv₁_apply, Adjunction.homEquiv₂_apply] bicategory @[simp] @@ -494,7 +547,9 @@ isomorphism if and only if the original 2-morphism is. This explains why some Be theorem iterated_mateEquiv_conjugateEquiv (α : f₁ ≫ l₂ ⟶ l₁ ≫ f₂) : mateEquiv adj₄ adj₃ (mateEquiv adj₁ adj₂ α) = conjugateEquiv (adj₁.comp adj₄) (adj₃.comp adj₂) α := by - dsimp [conjugateEquiv, mateEquiv, Adjunction.comp] + simp only [conjugateEquiv, mateEquiv, Adjunction.comp, Adjunction.homEquiv₁, + Adjunction.homEquiv₂] + dsimp bicategory theorem iterated_mateEquiv_conjugateEquiv_symm (α : u₂ ≫ r₁ ⟶ r₂ ≫ u₁) : @@ -538,7 +593,9 @@ theorem mateEquiv_conjugateEquiv_vcomp bicategory _ = _ := by rw [← mateEquiv_vcomp] - dsimp only [leftAdjointSquare.vcomp, mateEquiv_apply, leftAdjointSquareConjugate.vcomp] + simp only [leftAdjointSquare.vcomp, mateEquiv_apply, leftAdjointSquareConjugate.vcomp, + Adjunction.homEquiv₁, Adjunction.homEquiv₂] + dsimp bicategory end mateEquiv_conjugateEquiv_vcomp @@ -575,7 +632,9 @@ theorem conjugateEquiv_mateEquiv_vcomp bicategory _ = _ := by rw [← mateEquiv_vcomp] - dsimp only [leftAdjointSquare.vcomp, mateEquiv_apply, leftAdjointConjugateSquare.vcomp] + simp only [leftAdjointSquare.vcomp, mateEquiv_apply, leftAdjointConjugateSquare.vcomp, + Adjunction.homEquiv₁, Adjunction.homEquiv₂] + dsimp bicategory end conjugateEquiv_mateEquiv_vcomp diff --git a/Mathlib/CategoryTheory/Bicategory/Functor/Cat.lean b/Mathlib/CategoryTheory/Bicategory/Functor/Cat.lean new file mode 100644 index 00000000000000..80de8f06ac30ff --- /dev/null +++ b/Mathlib/CategoryTheory/Bicategory/Functor/Cat.lean @@ -0,0 +1,194 @@ +/- +Copyright (c) 2025 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou, Christian Merten +-/ +import Mathlib.CategoryTheory.Bicategory.Functor.Strict + +/-! +# Pseudofunctors to Cat + +In this file, the equalities stated in `CategoryTheory.Bicategory.Functor.Strict` +for pseudofunctors (from a strict bicategory) are rephrased in the particular +case the target bicategory is `Cat`. Indeed, in that case, the general lemmas +for pseudofunctors involve equalities between natural transformations: +we rephrase them after the application of `NatTrans.app`. + +-/ + +namespace CategoryTheory + +open Bicategory + +namespace Pseudofunctor + +variable {B : Type*} [Bicategory B] (F : Pseudofunctor B Cat) + +attribute [local simp] Cat.leftUnitor_hom_app Cat.rightUnitor_hom_app + Cat.leftUnitor_inv_app Cat.rightUnitor_inv_app + Cat.associator_hom_app Cat.associator_inv_app + +section naturality + +variable {b₀ b₁ b₂ : B} {X Y : F.obj b₀} + +section + +variable (f : b₀ ⟶ b₀) (hf : f = 𝟙 b₀) (a : X ⟶ Y) + +@[reassoc] +lemma mapId'_hom_naturality : + (F.map f).map a ≫ (F.mapId' f hf).hom.app Y = (F.mapId' f hf).hom.app X ≫ a := + (F.mapId' f hf).hom.naturality a + +@[reassoc] +lemma mapId'_inv_naturality : + (F.mapId' f hf).inv.app X ≫ (F.map f).map a = a ≫ (F.mapId' f hf).inv.app Y := + ((F.mapId' f hf).inv.naturality a).symm + +end + +section + +variable (f : b₀ ⟶ b₁) (g : b₁ ⟶ b₂) (fg : b₀ ⟶ b₂) + (hfg : f ≫ g = fg) (a : X ⟶ Y) + +@[reassoc] +lemma mapComp'_hom_naturality : + (F.map fg).map a ≫ (F.mapComp' f g fg hfg).hom.app Y = + (F.mapComp' f g fg hfg).hom.app X ≫ (F.map g).map ((F.map f).map a) := + (F.mapComp' f g fg hfg).hom.naturality a + +@[reassoc (attr := simp)] +lemma mapComp'_inv_naturality : + (F.map g).map ((F.map f).map a) ≫ (F.mapComp' f g fg hfg).inv.app Y = + (F.mapComp' f g fg hfg).inv.app X ≫ (F.map fg).map a := + (F.mapComp' f g fg hfg).inv.naturality a + +@[reassoc] +lemma mapComp'_naturality_1 : + (F.mapComp' f g fg hfg).inv.app X ≫ + (F.map fg).map a ≫ (F.mapComp' f g fg hfg).hom.app Y = + (F.map g).map ((F.map f).map a) := + NatIso.naturality_1 (F.mapComp' f g fg hfg) a + +@[reassoc] +lemma mapComp'_naturality_2 : + (F.mapComp' f g fg hfg).hom.app X ≫ (F.map g).map ((F.map f).map a) ≫ + (F.mapComp' f g fg hfg).inv.app Y = + (F.map fg).map a := + NatIso.naturality_2 (F.mapComp' f g fg hfg) a + +end + +end naturality + +variable [Strict B] + +section unitality + +variable {b₀ b₁ : B} (f : b₀ ⟶ b₁) (X : F.obj b₀) + +lemma mapComp'_comp_id_hom_app : + (F.mapComp' f (𝟙 b₁) f).hom.app X = (F.mapId b₁).inv.app ((F.map f).obj X) := by + simp [mapComp'_comp_id] + +lemma mapComp'_comp_id_inv_app : + (F.mapComp' f (𝟙 b₁) f).inv.app X = (F.mapId b₁).hom.app ((F.map f).obj X) := by + simp [mapComp'_comp_id] + +lemma mapComp'_id_comp_hom_app : + (F.mapComp' (𝟙 b₀) f f).hom.app X = (F.map f).map ((F.mapId b₀).inv.app X) := by + simp [mapComp'_id_comp] + +lemma mapComp'_id_comp_inv_app : + (F.mapComp' (𝟙 b₀) f f).inv.app X = (F.map f).map ((F.mapId b₀).hom.app X) := by + simp [mapComp'_id_comp] + +end unitality + +section associativity + +variable {b₀ b₁ b₂ b₃ : B} (f₀₁ : b₀ ⟶ b₁) + (f₁₂ : b₁ ⟶ b₂) (f₂₃ : b₂ ⟶ b₃) (f₀₂ : b₀ ⟶ b₂) (f₁₃ : b₁ ⟶ b₃) (f : b₀ ⟶ b₃) + (h₀₂ : f₀₁ ≫ f₁₂ = f₀₂) (h₁₃ : f₁₂ ≫ f₂₃ = f₁₃) + +@[reassoc] +lemma mapComp'_hom_app_comp_mapComp'_hom_app_map_obj (hf : f₀₁ ≫ f₁₃ = f) (X : F.obj b₀) : + (F.mapComp' f₀₁ f₁₃ f).hom.app X ≫ + (F.mapComp' f₁₂ f₂₃ f₁₃ h₁₃).hom.app ((F.map f₀₁).obj X) = + (F.mapComp' f₀₂ f₂₃ f).hom.app X ≫ + (F.map f₂₃).map ((F.mapComp' f₀₁ f₁₂ f₀₂ h₀₂).hom.app X) := by + simpa using NatTrans.congr_app (F.mapComp'_hom_comp_whiskerLeft_mapComp'_hom + f₀₁ f₁₂ f₂₃ f₀₂ f₁₃ f h₀₂ h₁₃ hf) X + +@[reassoc] +lemma mapComp'_inv_app_comp_mapComp'_hom_app (hf : f₀₁ ≫ f₁₃ = f) (X : F.obj b₀) : + (F.mapComp' f₀₁ f₁₃ f).inv.app X ≫ (F.mapComp' f₀₂ f₂₃ f).hom.app X = + (F.mapComp' f₁₂ f₂₃ f₁₃ h₁₃).hom.app ((F.map f₀₁).obj X) ≫ + (F.map f₂₃).map ((F.mapComp' f₀₁ f₁₂ f₀₂ h₀₂).inv.app X) := by + simpa using NatTrans.congr_app (F.mapComp'_inv_comp_mapComp'_hom + f₀₁ f₁₂ f₂₃ f₀₂ f₁₃ f h₀₂ h₁₃ hf) X + +@[reassoc] +lemma mapComp'_inv_app_map_obj_comp_mapComp'_inv_app (hf : f₀₁ ≫ f₁₃ = f) (X : F.obj b₀) : + (F.mapComp' f₁₂ f₂₃ f₁₃ h₁₃).inv.app ((F.map f₀₁).obj X) ≫ (F.mapComp' f₀₁ f₁₃ f).inv.app X = + (F.map f₂₃).map ((F.mapComp' f₀₁ f₁₂ f₀₂ h₀₂).inv.app X) ≫ + (F.mapComp' f₀₂ f₂₃ f).inv.app X := by + simpa using NatTrans.congr_app (F.whiskerLeft_mapComp'_inv_comp_mapComp'_inv + f₀₁ f₁₂ f₂₃ f₀₂ f₁₃ f h₀₂ h₁₃ hf) X + +@[reassoc] +lemma mapComp'_hom_app_comp_map_map_mapComp'_hom_app (hf : f₀₂ ≫ f₂₃ = f) (X : F.obj b₀) : + (F.mapComp' f₀₂ f₂₃ f).hom.app X ≫ (F.map f₂₃).map ((F.mapComp' f₀₁ f₁₂ f₀₂ h₀₂).hom.app X) = + (F.mapComp' f₀₁ f₁₃ f).hom.app X ≫ + (F.mapComp' f₁₂ f₂₃ f₁₃ h₁₃).hom.app ((F.map f₀₁).obj X) := by + simpa using NatTrans.congr_app (F.mapComp'_hom_comp_mapComp'_hom_whiskerRight + f₀₁ f₁₂ f₂₃ f₀₂ f₁₃ f h₀₂ h₁₃ hf) X + +@[reassoc] +lemma map_map_mapComp'_inv_app_comp_mapComp'_inv_app (hf : f₀₂ ≫ f₂₃ = f) (X : F.obj b₀) : + (F.map f₂₃).map ((F.mapComp' f₀₁ f₁₂ f₀₂ h₀₂).inv.app X) ≫ (F.mapComp' f₀₂ f₂₃ f).inv.app X = + (F.mapComp' f₁₂ f₂₃ f₁₃ h₁₃).inv.app ((F.map f₀₁).obj X) ≫ + (F.mapComp' f₀₁ f₁₃ f).inv.app X := by + simpa using NatTrans.congr_app (F.mapComp'_inv_whiskerRight_comp_mapComp'_inv + f₀₁ f₁₂ f₂₃ f₀₂ f₁₃ f h₀₂ h₁₃ hf) X + +@[reassoc] +lemma mapComp'₀₁₃_inv_app (hf : f₀₁ ≫ f₁₃ = f) (X : F.obj b₀) : + (F.mapComp' f₀₁ f₁₃ f hf).inv.app X = + (F.mapComp' f₁₂ f₂₃ f₁₃ h₁₃).hom.app ((F.map f₀₁).obj X) ≫ + (F.map f₂₃).map ((F.mapComp' f₀₁ f₁₂ f₀₂ h₀₂).inv.app X) ≫ + (F.mapComp' f₀₂ f₂₃ f).inv.app X := by + rw [← F.mapComp'_inv_app_comp_mapComp'_hom_app_assoc _ _ _ _ _ _ _ _ hf X, + Iso.hom_inv_id_app, Category.comp_id] + +@[reassoc] +lemma mapComp'₀₁₃_hom_app (hf : f₀₁ ≫ f₁₃ = f) (X : F.obj b₀) : + (F.mapComp' f₀₁ f₁₃ f hf).hom.app X = + (F.mapComp' f₀₂ f₂₃ f).hom.app X ≫ + (F.map f₂₃).map ((F.mapComp' f₀₁ f₁₂ f₀₂ h₀₂).hom.app X) ≫ + (F.mapComp' f₁₂ f₂₃ f₁₃ h₁₃).inv.app ((F.map f₀₁).obj X) := by + rw [← F.mapComp'_hom_app_comp_mapComp'_hom_app_map_obj_assoc _ _ _ _ _ _ h₀₂ h₁₃ hf X] + simp + +@[reassoc] +lemma mapComp'_inv_app_comp_mapComp'_hom_app' (hf : f₀₁ ≫ f₁₃ = f) (X : F.obj b₀) : + (F.mapComp' f₀₂ f₂₃ f).inv.app X ≫ (F.mapComp' f₀₁ f₁₃ f).hom.app X = + (F.map f₂₃).map ((F.mapComp' f₀₁ f₁₂ f₀₂ h₀₂).hom.app X) ≫ + (F.mapComp' f₁₂ f₂₃ f₁₃ h₁₃).inv.app ((F.map f₀₁).obj X) := by + simp [F.mapComp'₀₁₃_hom_app f₀₁ f₁₂ f₂₃ f₀₂ f₁₃ f h₀₂ h₁₃ hf] + +@[reassoc] +lemma mapComp'_hom_app_comp_mapComp'_inv_app (hf : f₀₁ ≫ f₁₃ = f) (X : F.obj b₀) : + (F.mapComp' f₀₂ f₂₃ f).inv.app X ≫ (F.mapComp' f₀₁ f₁₃ f).hom.app X = + (F.map f₂₃).map ((F.mapComp' f₀₁ f₁₂ f₀₂ h₀₂).hom.app X) ≫ + (F.mapComp' f₁₂ f₂₃ f₁₃ h₁₃).inv.app ((F.map f₀₁).obj X) := by + simp [F.mapComp'₀₁₃_hom_app f₀₁ f₁₂ f₂₃ f₀₂ f₁₃ f h₀₂ h₁₃ hf] + + +end associativity + +end Pseudofunctor + +end CategoryTheory diff --git a/Mathlib/CategoryTheory/Bicategory/Functor/LocallyDiscrete.lean b/Mathlib/CategoryTheory/Bicategory/Functor/LocallyDiscrete.lean index 17e17f0c9bb8f7..250dc67cf419e5 100644 --- a/Mathlib/CategoryTheory/Bicategory/Functor/LocallyDiscrete.lean +++ b/Mathlib/CategoryTheory/Bicategory/Functor/LocallyDiscrete.lean @@ -154,4 +154,13 @@ def mkPseudofunctor {B₀ C : Type*} [Category B₀] [Bicategory C] end LocallyDiscrete +/-- The pseudofunctor from `LocallyDiscrete B` to `LocallyDiscrete C` +induced by a functor `F : B ⥤ C`. -/ +@[simps! obj map mapId mapComp] +def mapLocallyDiscrete {B C : Type*} [Category B] [Category C] (F : B ⥤ C): + Pseudofunctor (LocallyDiscrete B) (LocallyDiscrete C) := + LocallyDiscrete.mkPseudofunctor + (fun X ↦ .mk (F.obj X)) (fun f ↦ .toLoc (F.map f)) + (fun _ ↦ eqToIso (by simp)) (fun _ _ ↦ eqToIso (by simp)) + end CategoryTheory diff --git a/Mathlib/CategoryTheory/Bicategory/Functor/Strict.lean b/Mathlib/CategoryTheory/Bicategory/Functor/Strict.lean new file mode 100644 index 00000000000000..2c34536d2ab25e --- /dev/null +++ b/Mathlib/CategoryTheory/Bicategory/Functor/Strict.lean @@ -0,0 +1,261 @@ +/- +Copyright (c) 2025 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou, Christian Merten +-/ +import Mathlib.CategoryTheory.Bicategory.Functor.Pseudofunctor +import Mathlib.CategoryTheory.CommSq + +/-! +# Pseudofunctors from strict bicategory + +This file provides an API for pseudofunctors `F` from a strict bicategory `B`. In +particular, this shall apply to pseudofunctors from locally discrete bicategories. + +We first introduce more flexible variants of `mapId` and `mapComp`: for example, +if `f` and `g` are composable morphisms and `fg` is such that `h : fg = f ≫ f`, +we provide an isomorphism `F.mapComp' f g fg h : F.map fg ≅ F.map f ≫ F.map g`. +We study the compatibilities of these isomorphisms with respect to composition +with identities and associativity. + +Secondly, given a commutative square `t ≫ r = l ≫ b` in `B`, we construct an +isomorphism `F.map t ≫ F.map r ≅ F.map l ≫ F.map b` +(see `Pseudofunctor.isoMapOfCommSq`). + +-/ + +namespace CategoryTheory + +open Bicategory + +namespace Pseudofunctor + +variable {B C : Type*} [Bicategory B] [Bicategory C] (F : Pseudofunctor B C) + +/-- More flexible variant of `mapId`. -/ +def mapId' {b : B} (f : b ⟶ b) (hf : f = 𝟙 b := by aesop_cat) : + F.map f ≅ 𝟙 _ := + F.map₂Iso (eqToIso (by rw [hf])) ≪≫ F.mapId _ + +lemma mapId'_eq_mapId (b : B) : + F.mapId' (𝟙 b) rfl = F.mapId b := by + simp [mapId'] + +/-- More flexible variant of `mapComp`. -/ +def mapComp' {b₀ b₁ b₂ : B} (f : b₀ ⟶ b₁) (g : b₁ ⟶ b₂) (fg : b₀ ⟶ b₂) + (h : f ≫ g = fg := by aesop_cat) : + F.map fg ≅ F.map f ≫ F.map g := + F.map₂Iso (eqToIso (by rw [h])) ≪≫ F.mapComp f g + +lemma mapComp'_eq_mapComp {b₀ b₁ b₂ : B} (f : b₀ ⟶ b₁) (g : b₁ ⟶ b₂) : + F.mapComp' f g _ rfl = F.mapComp f g := by + simp [mapComp'] + +variable [Strict B] + +lemma mapComp'_comp_id {b₀ b₁ : B} (f : b₀ ⟶ b₁) : + F.mapComp' f (𝟙 b₁) f = (ρ_ _).symm ≪≫ whiskerLeftIso _ (F.mapId b₁).symm := by + ext + dsimp [mapComp'] + rw [F.mapComp_id_right_hom f, Strict.rightUnitor_eqToIso, eqToIso.hom, + ← F.map₂_comp_assoc, eqToHom_trans, eqToHom_refl, PrelaxFunctor.map₂_id, + Category.id_comp] + +lemma mapComp'_id_comp {b₀ b₁ : B} (f : b₀ ⟶ b₁) : + F.mapComp' (𝟙 b₀) f f = (λ_ _).symm ≪≫ whiskerRightIso (F.mapId b₀).symm _ := by + ext + dsimp [mapComp'] + rw [F.mapComp_id_left_hom f, Strict.leftUnitor_eqToIso, eqToIso.hom, + ← F.map₂_comp_assoc, eqToHom_trans, eqToHom_refl, PrelaxFunctor.map₂_id, + Category.id_comp] + +section associativity + +variable {b₀ b₁ b₂ b₃ : B} (f₀₁ : b₀ ⟶ b₁) + (f₁₂ : b₁ ⟶ b₂) (f₂₃ : b₂ ⟶ b₃) (f₀₂ : b₀ ⟶ b₂) (f₁₃ : b₁ ⟶ b₃) (f : b₀ ⟶ b₃) + (h₀₂ : f₀₁ ≫ f₁₂ = f₀₂) (h₁₃ : f₁₂ ≫ f₂₃ = f₁₃) + +@[reassoc] +lemma mapComp'_hom_comp_whiskerLeft_mapComp'_hom (hf : f₀₁ ≫ f₁₃ = f) : + (F.mapComp' f₀₁ f₁₃ f).hom ≫ F.map f₀₁ ◁ (F.mapComp' f₁₂ f₂₃ f₁₃ h₁₃).hom = + (F.mapComp' f₀₂ f₂₃ f).hom ≫ + (F.mapComp' f₀₁ f₁₂ f₀₂ h₀₂).hom ▷ F.map f₂₃ ≫ (α_ _ _ _).hom := by + subst h₀₂ h₁₃ hf + simp [mapComp_assoc_right_hom, Strict.associator_eqToIso, mapComp'] + +@[reassoc] +lemma mapComp'_inv_comp_mapComp'_hom (hf : f₀₁ ≫ f₁₃ = f) : + (F.mapComp' f₀₁ f₁₃ f).inv ≫ + (F.mapComp' f₀₂ f₂₃ f).hom = + F.map f₀₁ ◁ (F.mapComp' f₁₂ f₂₃ f₁₃ h₁₃).hom ≫ + (α_ _ _ _).inv ≫ (F.mapComp' f₀₁ f₁₂ f₀₂ h₀₂).inv ▷ F.map f₂₃ := by + rw [← cancel_epi (F.mapComp' f₀₁ f₁₃ f hf).hom, Iso.hom_inv_id_assoc, + F.mapComp'_hom_comp_whiskerLeft_mapComp'_hom_assoc _ _ _ _ _ _ h₀₂ h₁₃ hf] + simp + +@[reassoc] +lemma whiskerLeft_mapComp'_inv_comp_mapComp'_inv (hf : f₀₁ ≫ f₁₃ = f) : + F.map f₀₁ ◁ (F.mapComp' f₁₂ f₂₃ f₁₃ h₁₃).inv ≫ (F.mapComp' f₀₁ f₁₃ f hf).inv = + (α_ _ _ _).inv ≫ (F.mapComp' f₀₁ f₁₂ f₀₂ h₀₂).inv ▷ F.map f₂₃ ≫ + (F.mapComp' f₀₂ f₂₃ f).inv := by + simp [← cancel_mono (F.mapComp' f₀₂ f₂₃ f).hom, + F.mapComp'_inv_comp_mapComp'_hom _ _ _ _ _ _ h₀₂ h₁₃ hf] + +@[reassoc] +lemma mapComp'_hom_comp_mapComp'_hom_whiskerRight (hf : f₀₂ ≫ f₂₃ = f) : + (F.mapComp' f₀₂ f₂₃ f).hom ≫ (F.mapComp' f₀₁ f₁₂ f₀₂ h₀₂).hom ▷ F.map f₂₃ = + (F.mapComp' f₀₁ f₁₃ f).hom ≫ F.map f₀₁ ◁ (F.mapComp' f₁₂ f₂₃ f₁₃ h₁₃).hom ≫ + (α_ _ _ _).inv := by + rw [F.mapComp'_hom_comp_whiskerLeft_mapComp'_hom_assoc _ _ _ _ _ f h₀₂ h₁₃ (by aesop_cat)] + simp + +@[reassoc] +lemma mapComp'_inv_comp_mapComp'_hom' (hf : f₀₂ ≫ f₂₃ = f) : + (F.mapComp' f₀₁ f₁₃ f).inv ≫ (F.mapComp' f₀₂ f₂₃ f).hom = + F.map f₀₁ ◁ (F.mapComp' f₁₂ f₂₃ f₁₃ h₁₃).hom ≫ + (α_ _ _ _).inv ≫ (F.mapComp' f₀₁ f₁₂ f₀₂ h₀₂).inv ▷ F.map f₂₃:= by + simp only [← cancel_mono ((F.mapComp' f₀₁ f₁₂ f₀₂ h₀₂).hom ▷ F.map f₂₃), + mapComp'_hom_comp_mapComp'_hom_whiskerRight _ _ _ _ _ _ _ h₀₂ h₁₃ hf, + Category.assoc, Iso.inv_hom_id_assoc, inv_hom_whiskerRight, Category.comp_id] + +@[reassoc] +lemma mapComp'_inv_whiskerRight_comp_mapComp'_inv (hf : f₀₂ ≫ f₂₃ = f) : + (F.mapComp' f₀₁ f₁₂ f₀₂ h₀₂).inv ▷ F.map f₂₃ ≫ (F.mapComp' f₀₂ f₂₃ f).inv = + (α_ _ _ _).hom ≫ F.map f₀₁ ◁ (F.mapComp' f₁₂ f₂₃ f₁₃ h₁₃).inv ≫ + (F.mapComp' f₀₁ f₁₃ f).inv := by + rw [whiskerLeft_mapComp'_inv_comp_mapComp'_inv _ _ _ _ _ _ f h₀₂ h₁₃, + Iso.hom_inv_id_assoc] + +end associativity + +section CommSq + +variable {X₁ X₂ X₃ Y₁ Y₂ Y₃ Z₁ Z₂ : B} + +section + +variable {t : X₁ ⟶ Y₁} {l : X₁ ⟶ X₂} {r : Y₁ ⟶ Y₂} {b : X₂ ⟶ Y₂} (sq : CommSq t l r b) + +/-- Given a commutative square `CommSq t l r b` in a strict bicategory `B` and +a pseudofunctor from `B`, this is the natural isomorphism +`F.map t ≫ F.map r ≅ F.map l ≫ F.map b`. -/ +def isoMapOfCommSq : F.map t ≫ F.map r ≅ F.map l ≫ F.map b := + (F.mapComp t r).symm ≪≫ F.mapComp' _ _ _ (by rw [sq.w]) + +lemma isoMapOfCommSq_eq (φ : X₁ ⟶ Y₂) (hφ : t ≫ r = φ) : + F.isoMapOfCommSq sq = + (F.mapComp' t r φ (by rw [hφ])).symm ≪≫ + F.mapComp' l b φ (by rw [← hφ, sq.w]) := by + subst hφ + simp [isoMapOfCommSq, mapComp'_eq_mapComp] + +lemma isoMapOfCommSq_hom_eq (φ : X₁ ⟶ Y₂) (hφ : t ≫ r = φ) : + (F.isoMapOfCommSq sq).hom = + (F.mapComp' t r φ (by rw [hφ])).inv ≫ + (F.mapComp' l b φ (by rw [← hφ, sq.w])).hom := by + simp [F.isoMapOfCommSq_eq sq _ hφ] + +lemma isoMapOfCommSq_flip : F.isoMapOfCommSq sq.flip = + (F.isoMapOfCommSq sq).symm := by + rw [F.isoMapOfCommSq_eq sq.flip (t ≫ r) sq.w.symm, + F.isoMapOfCommSq_eq sq (t ≫ r) rfl, + Iso.trans_symm, Iso.symm_symm_eq] + +lemma mapComp'_isoMapOfCommSq {tr'} (htr' : t ≫ r = tr') : + (F.mapComp' t r tr' htr') ≪≫ F.isoMapOfCommSq sq = + F.mapComp' l b tr' (by rw [← htr', sq.w]) := by + subst htr' + simp [F.isoMapOfCommSq_eq sq _ rfl] + +@[reassoc] +lemma mapComp'_hom_isoMapOfCommSq_hom {tr'} (htr' : t ≫ r = tr') : + (F.mapComp' t r tr' htr').hom ≫ (F.isoMapOfCommSq sq).hom = + (F.mapComp' l b tr' (by rw [← htr', sq.w])).hom := by + simp [← F.mapComp'_isoMapOfCommSq sq htr'] + +lemma isoMapOfCommSq_mapComp'_symm {tr'} (htr' : t ≫ r = tr') : + F.isoMapOfCommSq sq ≪≫ (F.mapComp' l b tr' (by rw [← htr', sq.w])).symm = + (F.mapComp' t r tr' htr').symm := by + subst htr' + simp [F.isoMapOfCommSq_eq sq _ rfl] + +@[reassoc] +lemma isoMapOfCommSq_hom_mapComp'_inv {tr'} (htr' : t ≫ r = tr') : + (F.isoMapOfCommSq sq).hom ≫ (F.mapComp' l b tr' (by rw [← htr', sq.w])).inv = + (F.mapComp' t r tr' htr').inv := by + simp [← F.mapComp'_isoMapOfCommSq sq htr'] + +end + +@[simp] +lemma isoMapOfCommSq_self_self (f : X₁ ⟶ X₂) (g : X₂ ⟶ X₃) : + F.isoMapOfCommSq (t := f) (l := f) (r := g) (b := g) ⟨rfl⟩ = Iso.refl _ := by + simp [isoMapOfCommSq, mapComp'] + +/-- Equational lemma for `Pseudofunctor.isoMapOfCommSq` when +both vertical maps of the square are the same and horizontal maps are identities. -/ +lemma isoMapOfCommSq_horiz_id (f : X₁ ⟶ X₂) : + F.isoMapOfCommSq (t := 𝟙 _) (l := f) (r := f) (b := 𝟙 _) ⟨by simp⟩ = + whiskerRightIso (F.mapId X₁) (F.map f) ≪≫ λ_ _ ≪≫ (ρ_ _).symm ≪≫ + (whiskerLeftIso (F.map f) (F.mapId X₂)).symm := by + ext + rw [isoMapOfCommSq_eq _ _ f (by simp), mapComp'_comp_id, mapComp'_id_comp] + simp + +/-- Equational lemma for `Pseudofunctor.isoMapOfCommSq` when +both horizontal maps of the square are the same and vertical maps are identities. -/ +lemma isoMapOfCommSq_vert_id (f : X₁ ⟶ X₂) : + F.isoMapOfCommSq (t := f) (l := 𝟙 _) (r := 𝟙 _) (b := f) ⟨by simp⟩ = + whiskerLeftIso (F.map f) (F.mapId X₂) ≪≫ ρ_ _ ≪≫ (λ_ _).symm ≪≫ + (whiskerRightIso (F.mapId X₁) (F.map f)).symm := by + ext + rw [isoMapOfCommSq_eq _ _ f (by simp), mapComp'_comp_id, mapComp'_id_comp] + simp + +lemma isoMapOfCommSq_horiz_comp + {t : X₁ ⟶ Y₁} {t' : Y₁ ⟶ Z₁} {l : X₁ ⟶ X₂} {m : Y₁ ⟶ Y₂} {r : Z₁ ⟶ Z₂} + {b : X₂ ⟶ Y₂} {b' : Y₂ ⟶ Z₂} (sq : CommSq t l m b) (sq' : CommSq t' m r b') + {t'' : X₁ ⟶ Z₁} {b'' : X₂ ⟶ Z₂} (ht : t ≫ t' = t'') (hb : b ≫ b' = b'') : + F.isoMapOfCommSq (sq.horiz_comp' sq' ht hb) = + whiskerRightIso (F.mapComp' t t' t'' (by rw [← ht])) (F.map r) ≪≫ + α_ _ _ _ ≪≫ whiskerLeftIso (F.map t) (F.isoMapOfCommSq sq') ≪≫ + (α_ _ _ _).symm ≪≫ whiskerRightIso (F.isoMapOfCommSq sq) (F.map b') ≪≫ + α_ _ _ _ ≪≫ whiskerLeftIso (F.map l) + ((F.mapComp' b b' b'' (by rw [← hb])).symm) := by + ext + have w : t'' ≫ r = t ≫ t' ≫ r := by rw [reassoc_of% ht] + rw [F.isoMapOfCommSq_eq ((sq.horiz_comp' sq' ht hb)) (t ≫ t' ≫ r) w, + F.isoMapOfCommSq_eq sq' (t' ≫ r) rfl, F.isoMapOfCommSq_eq sq (t ≫ m) rfl] + dsimp + simp only [Bicategory.whiskerLeft_comp, comp_whiskerRight, Category.assoc] + rw [← F.mapComp'_inv_comp_mapComp'_hom_assoc t _ _ _ (t' ≫ r) _ _ _ rfl, + F.mapComp'_hom_comp_mapComp'_hom_whiskerRight_assoc _ _ _ _ _ _ _ hb + (by rw [Category.assoc, ← sq'.w]), + Iso.inv_hom_id_assoc, whiskerLeft_hom_inv, Category.comp_id, + ← cancel_epi (F.mapComp' t'' r (t ≫ t' ≫ r) w).hom, + F.mapComp'_hom_comp_mapComp'_hom_whiskerRight_assoc _ _ _ _ _ _ ht rfl w, + Iso.hom_inv_id_assoc, Iso.inv_hom_id_assoc, + whiskerLeft_hom_inv_assoc, Iso.hom_inv_id_assoc] + +lemma isoMapOfCommSq_vert_comp + {t : X₁ ⟶ Y₁} {m : X₂ ⟶ Y₂} {b : X₃ ⟶ Y₃} + {l : X₁ ⟶ X₂} {l' : X₂ ⟶ X₃} {r : Y₁ ⟶ Y₂} {r' : Y₂ ⟶ Y₃} + (sq : CommSq t l r m) (sq' : CommSq m l' r' b) + {l'' : X₁ ⟶ X₃} {r'' : Y₁ ⟶ Y₃} (hl : l ≫ l' = l'') (hr : r ≫ r' = r'') : + F.isoMapOfCommSq (sq.vert_comp' sq' hl hr) = + whiskerLeftIso (F.map t) (F.mapComp' r r' r'' hr) ≪≫ + (α_ _ _ _).symm ≪≫ whiskerRightIso (F.isoMapOfCommSq sq) (F.map r') ≪≫ + α_ _ _ _ ≪≫ whiskerLeftIso (F.map l) (F.isoMapOfCommSq sq') ≪≫ + (α_ _ _ _).symm ≪≫ whiskerRightIso (F.mapComp' l l' l'' hl).symm (F.map b) := by + rw [← Iso.symm_eq_iff, ← isoMapOfCommSq_flip, + F.isoMapOfCommSq_horiz_comp sq.flip sq'.flip hl hr, + F.isoMapOfCommSq_flip sq', F.isoMapOfCommSq_flip sq] + ext + dsimp + simp only [Category.assoc] + +end CommSq + +end Pseudofunctor + +end CategoryTheory diff --git a/Mathlib/CategoryTheory/Bicategory/Opposite.lean b/Mathlib/CategoryTheory/Bicategory/Opposite.lean new file mode 100644 index 00000000000000..7ec6831c091804 --- /dev/null +++ b/Mathlib/CategoryTheory/Bicategory/Opposite.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2025 Christian Merten. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christian Merten, Joël Riou +-/ +import Mathlib.CategoryTheory.Bicategory.Functor.Pseudofunctor + +/-! +# The opposite of a bicategory +-/ + +universe w v u + +namespace CategoryTheory + +open Opposite + +namespace Bicategory.Opposite + +variable {B : Type u} [Bicategory.{w, v} B] + +instance {X Y : Bᵒᵖ} : Category.{w} (X ⟶ Y) := + inferInstanceAs <| Category (Y.unop ⟶ X.unop)ᵒᵖ + +@[simp] +lemma Hom.unop_comp {a b : Bᵒᵖ} {f g h : a ⟶ b} (u : f ⟶ g) (v : g ⟶ h) : + (u ≫ v).unop = v.unop ≫ u.unop := rfl + +@[simp] +lemma Hom.unop_id {a b : Bᵒᵖ} (f : a ⟶ b) : + (𝟙 f).unop = 𝟙 f.unop := rfl + +@[ext] +lemma Hom.ext {a b : Bᵒᵖ} {f g : a ⟶ b} (u v : f ⟶ g) (h : u.unop = v.unop) : u = v := + congrArg op h + +@[simps!] +def associator {a b c d : Bᵒᵖ} (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d) : + op (h.unop ≫ Quiver.Hom.unop (Opposite.op (g.unop ≫ f.unop))) ≅ + op (Quiver.Hom.unop (Opposite.op (h.unop ≫ g.unop)) ≫ f.unop) := + (α_ h.unop g.unop f.unop).op + +@[simps!] +def leftUnitor {a b : Bᵒᵖ} (f : a ⟶ b) : + op (f.unop ≫ Quiver.Hom.unop (op (𝟙 (unop a)))) ≅ f := + (rightUnitor f.unop).symm.op + +@[simps!] +def rightUnitor {a b : Bᵒᵖ} (f : a ⟶ b) : + op (Quiver.Hom.unop (op (𝟙 (unop b))) ≫ f.unop) ≅ f := + (Bicategory.leftUnitor f.unop).symm.op + +instance : Bicategory Bᵒᵖ where + id X := ⟨𝟙 X.unop⟩ + comp {X Y Z} f g := ⟨g.unop ≫ f.unop⟩ + whiskerLeft {X Y Z} f g h u := (u.unop ▷ f.unop).op + whiskerRight {X Y Z} f g h u := (u.unop ◁ h.unop).op + associator {a b c d} f g h := associator f g h + leftUnitor {a b} f := leftUnitor f + rightUnitor {a b} f := rightUnitor f + whiskerLeft_id {a b c} f g := congrArg op <| id_whiskerRight g.unop f.unop + id_whiskerRight f g := congrArg op <| whiskerLeft_id g.unop f.unop + whisker_exchange η θ := congrArg op <| whisker_exchange θ.unop η.unop + whisker_assoc f g h u v := by + ext + dsimp + rw [whisker_assoc_symm, Category.assoc] + rfl + triangle f g := congrArg op <| triangle_assoc_comp_right_inv (unop g) f.unop + +@[simp] +lemma unop_comp {a b c : Bᵒᵖ} {f : a ⟶ b} {g : b ⟶ c} : (f ≫ g).unop = g.unop ≫ f.unop := rfl + +@[simp] lemma unop_whiskerLeft {a b c : Bᵒᵖ} {f : a ⟶ b} {g h : b ⟶ c} {u : g ⟶ h} : + (f ◁ u).unop = u.unop ▷ f.unop := rfl + +@[simp] lemma unop_whiskerRight {a b c : Bᵒᵖ} {f g : a ⟶ b} (h : b ⟶ c) (u : f ⟶ g) : + (u ▷ h).unop = h.unop ◁ u.unop := rfl + +end Bicategory.Opposite + +end CategoryTheory diff --git a/Mathlib/CategoryTheory/CommSq.lean b/Mathlib/CategoryTheory/CommSq.lean index ec4b0c6f19775e..7aa60b07dbf312 100644 --- a/Mathlib/CategoryTheory/CommSq.lean +++ b/Mathlib/CategoryTheory/CommSq.lean @@ -88,6 +88,22 @@ lemma horiz_comp {W X X' Y Z Z' : C} {f : W ⟶ X} {f' : X ⟶ X'} {g : W ⟶ Y} CommSq (f ≫ f') g h' (i ≫ i') := ⟨by rw [← Category.assoc, Category.assoc, ← hsq₁.w, hsq₂.w, Category.assoc]⟩ +/-- +``` + X₁ ---t---> Y₁ ---t'---> Z₁ + | | | + l m r + | | | + v v v + X₂ ---b---> Y₂ ---b'---> Z₂ +``` +-/ +lemma horiz_comp' {X₁ X₂ Y₁ Y₂ Z₁ Z₂ : C} {t : X₁ ⟶ Y₁} {t' : Y₁ ⟶ Z₁} + {l : X₁ ⟶ X₂} {m : Y₁ ⟶ Y₂} {r : Z₁ ⟶ Z₂} {b : X₂ ⟶ Y₂} {b' : Y₂ ⟶ Z₂} + (sq : CommSq t l m b) (sq' : CommSq t' m r b') {t'' : X₁ ⟶ Z₁} {b'' : X₂ ⟶ Z₂} + (ht : t ≫ t' = t'') (hb : b ≫ b' = b''): CommSq t'' l r b'' := + ht ▸ hb ▸ sq.horiz_comp sq' + /-- The vertical composition of two commutative squares as below is a commutative square. ``` W ---f---> X @@ -109,6 +125,26 @@ lemma vert_comp {W X Y Y' Z Z' : C} {f : W ⟶ X} {g : W ⟶ Y} {g' : Y ⟶ Y'} CommSq f (g ≫ g') (h ≫ h') i' := flip (horiz_comp (flip hsq₁) (flip hsq₂)) +/-- +``` + X₁ ---t---> Y₁ + | | + l r + | | + v v + X₂ ---m---> Y₂ + | | + l' r' + | | + v v + X₃ ---b---> Y₃ +``` +-/ +lemma vert_comp' {X₁ X₂ X₃ Y₁ Y₂ Y₃ : C} {t : X₁ ⟶ Y₁} {m : X₂ ⟶ Y₂} {b : X₃ ⟶ Y₃} + {l : X₁ ⟶ X₂} {l' : X₂ ⟶ X₃} {r : Y₁ ⟶ Y₂} {r' : Y₂ ⟶ Y₃} + (sq : CommSq t l r m) (sq' : CommSq m l' r' b) {l'' : X₁ ⟶ X₃} {r'' : Y₁ ⟶ Y₃} + (hl : l ≫ l' = l'') (hr : r ≫ r' = r'') : CommSq t l'' r'' b := + hl ▸ hr ▸ sq.vert_comp sq' section diff --git a/Mathlib/CategoryTheory/Limits/Shapes/Pullback/CommSq.lean b/Mathlib/CategoryTheory/Limits/Shapes/Pullback/CommSq.lean index ef2e6728057833..140173c87b588e 100644 --- a/Mathlib/CategoryTheory/Limits/Shapes/Pullback/CommSq.lean +++ b/Mathlib/CategoryTheory/Limits/Shapes/Pullback/CommSq.lean @@ -214,6 +214,11 @@ lemma lift_snd (hP : IsPullback fst snd f g) {W : C} (h : W ⟶ X) (k : W ⟶ Y) (w : h ≫ f = k ≫ g) : hP.lift h k w ≫ snd = k := PullbackCone.IsLimit.lift_snd hP.isLimit h k w +noncomputable def exists_lift (hP : IsPullback fst snd f g) {W : C} (h : W ⟶ X) (k : W ⟶ Y) + (w : h ≫ f = k ≫ g) : + ∃ (l : W ⟶ P), l ≫ fst = h ∧ l ≫ snd = k := + ⟨hP.lift h k w, by simp, by simp⟩ + lemma hom_ext (hP : IsPullback fst snd f g) {W : C} {k l : W ⟶ P} (h₀ : k ≫ fst = l ≫ fst) (h₁ : k ≫ snd = l ≫ snd) : k = l := PullbackCone.IsLimit.hom_ext hP.isLimit h₀ h₁ @@ -437,6 +442,11 @@ lemma inr_desc (hP : IsPushout f g inl inr) {W : C} (h : X ⟶ W) (k : Y ⟶ W) (w : f ≫ h = g ≫ k) : inr ≫ hP.desc h k w = k := PushoutCocone.IsColimit.inr_desc hP.isColimit h k w +noncomputable def exists_desc (hP : IsPushout f g inl inr) {W : C} (h : X ⟶ W) (k : Y ⟶ W) + (w : f ≫ h = g ≫ k) : + ∃ (d : P ⟶ W), inl ≫ d = h ∧ inr ≫ d = k := + ⟨hP.desc h k w, by simp, by simp⟩ + lemma hom_ext (hP : IsPushout f g inl inr) {W : C} {k l : P ⟶ W} (h₀ : inl ≫ k = inl ≫ l) (h₁ : inr ≫ k = inr ≫ l) : k = l := PushoutCocone.IsColimit.hom_ext hP.isColimit h₀ h₁ diff --git a/Mathlib/CategoryTheory/Sites/Descent/DescentData.lean b/Mathlib/CategoryTheory/Sites/Descent/DescentData.lean new file mode 100644 index 00000000000000..b6994d1b1362c6 --- /dev/null +++ b/Mathlib/CategoryTheory/Sites/Descent/DescentData.lean @@ -0,0 +1,142 @@ +/- +Copyright (c) 2025 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou, Christian Merten +-/ +import Mathlib.CategoryTheory.Bicategory.Functor.LocallyDiscrete +import Mathlib.CategoryTheory.Bicategory.Functor.Cat +import Mathlib.CategoryTheory.Sites.Descent.PullbackStruct +import Mathlib.CategoryTheory.Sites.Descent.IsPrestack + +/-! +# Descent data + +-/ + +universe t v' v u' u + +namespace CategoryTheory + +open Opposite Limits + +namespace Pseudofunctor + +macro "aesoptoloc" : tactic => + `(tactic|(simp [← Quiver.Hom.comp_toLoc, ← op_comp] <;> aesop)) + +open LocallyDiscreteOpToCat + +variable {C : Type u} [Category.{v} C] (F : Pseudofunctor (LocallyDiscrete Cᵒᵖ) Cat.{v', u'}) + {ι : Type t} {S : C} {X : ι → C} (f : ∀ i, X i ⟶ S) + +structure DescentData where + obj (i : ι) : F.obj (.mk (op (X i))) + hom ⦃Y : C⦄ (q : Y ⟶ S) ⦃i₁ i₂ : ι⦄ (f₁ : Y ⟶ X i₁) (f₂ : Y ⟶ X i₂) + (_hf₁ : f₁ ≫ f i₁ = q := by aesop_cat) (_hf₂ : f₂ ≫ f i₂ = q := by aesop_cat) : + (F.map f₁.op.toLoc).obj (obj i₁) ⟶ (F.map f₂.op.toLoc).obj (obj i₂) + pullHom_hom ⦃Y' Y : C⦄ (g : Y' ⟶ Y) (q : Y ⟶ S) (q' : Y' ⟶ S) (hq : g ≫ q = q') + ⦃i₁ i₂ : ι⦄ (f₁ : Y ⟶ X i₁) (f₂ : Y ⟶ X i₂) (hf₁ : f₁ ≫ f i₁ = q) (hf₂ : f₂ ≫ f i₂ = q) + (gf₁ : Y' ⟶ X i₁) (gf₂ : Y' ⟶ X i₂) (hgf₁ : g ≫ f₁ = gf₁) (hgf₂ : g ≫ f₂ = gf₂) : + pullHom (hom q f₁ f₂) g gf₁ gf₂ = hom q' gf₁ gf₂ := by aesop_cat + hom_self ⦃Y : C⦄ (q : Y ⟶ S) ⦃i : ι⦄ (g : Y ⟶ X i) (_ : g ≫ f i = q) : + hom q g g = 𝟙 _ := by aesop_cat + hom_comp ⦃Y : C⦄ (q : Y ⟶ S) ⦃i₁ i₂ i₃ : ι⦄ (f₁ : Y ⟶ X i₁) (f₂ : Y ⟶ X i₂) (f₃ : Y ⟶ X i₃) + (hf₁ : f₁ ≫ f i₁ = q) (hf₂ : f₂ ≫ f i₂ = q) (hf₃ : f₃ ≫ f i₃ = q) : + hom q f₁ f₂ hf₁ hf₂ ≫ hom q f₂ f₃ hf₂ hf₃ = hom q f₁ f₃ hf₁ hf₃ := by aesop_cat + +namespace DescentData + +variable {F f} (D : F.DescentData f) + +attribute [local simp] hom_self pullHom_hom +attribute [reassoc (attr := simp)] hom_comp + +@[simps] +def iso ⦃Y : C⦄ (q : Y ⟶ S) ⦃i₁ i₂ : ι⦄ (f₁ : Y ⟶ X i₁) (f₂ : Y ⟶ X i₂) + (_hf₁ : f₁ ≫ f i₁ = q := by aesop_cat) (_hf₂ : f₂ ≫ f i₂ = q := by aesop_cat) : + (F.map f₁.op.toLoc).obj (D.obj i₁) ≅ (F.map f₂.op.toLoc).obj (D.obj i₂) where + hom := D.hom q f₁ f₂ + inv := D.hom q f₂ f₁ + +instance {Y : C} (q : Y ⟶ S) {i₁ i₂ : ι} (f₁ : Y ⟶ X i₁) (f₂ : Y ⟶ X i₂) + (hf₁ : f₁ ≫ f i₁ = q) (hf₂ : f₂ ≫ f i₂ = q) : + IsIso (D.hom q f₁ f₂ hf₁ hf₂) := + (D.iso q f₁ f₂).isIso_hom + +@[ext] +structure Hom (D₁ D₂ : F.DescentData f) where + hom (i : ι) : D₁.obj i ⟶ D₂.obj i + comm ⦃Y : C⦄ (q : Y ⟶ S) ⦃i₁ i₂ : ι⦄ (f₁ : Y ⟶ X i₁) + (f₂ : Y ⟶ X i₂) (hf₁ : f₁ ≫ f i₁ = q) (hf₂ : f₂ ≫ f i₂ = q) : + (F.map f₁.op.toLoc).map (hom i₁) ≫ D₂.hom q f₁ f₂ = + D₁.hom q f₁ f₂ ≫ (F.map f₂.op.toLoc).map (hom i₂) := by aesop_cat + +attribute [reassoc (attr := local simp)] Hom.comm + +@[simps] +def Hom.id (D : F.DescentData f) : Hom D D where + hom i := 𝟙 _ + +@[simps] +def Hom.comp {D₁ D₂ D₃ : F.DescentData f} (φ : Hom D₁ D₂) (φ' : Hom D₂ D₃) : Hom D₁ D₃ where + hom i := φ.hom i ≫ φ'.hom i + +instance : Category (F.DescentData f) where + Hom := Hom + id := Hom.id + comp := Hom.comp + +@[ext] +lemma hom_ext {D₁ D₂ : F.DescentData f} {φ φ' : D₁ ⟶ D₂} + (h : ∀ i, φ.hom i = φ'.hom i) : φ = φ' := + Hom.ext (funext h) + +@[simp] +lemma id_hom (D : F.DescentData f) (i : ι) : Hom.hom (𝟙 D) i = 𝟙 _ := rfl + +@[simp, reassoc] +lemma comp_hom {D₁ D₂ D₃ : F.DescentData f} (φ : D₁ ⟶ D₂) (φ' : D₂ ⟶ D₃) (i : ι) : + (φ ≫ φ').hom i = φ.hom i ≫ φ'.hom i := rfl + +@[simps] +def ofObj (M : F.obj (.mk (op S))) : F.DescentData f where + obj i := (F.map (f i).op.toLoc).obj M + hom Y q i₁ i₂ f₁ f₂ hf₁ hf₂ := + (F.mapComp' (f i₁).op.toLoc f₁.op.toLoc q.op.toLoc (by aesoptoloc)).inv.app _ ≫ + (F.mapComp' (f i₂).op.toLoc f₂.op.toLoc q.op.toLoc (by aesoptoloc)).hom.app _ + pullHom_hom Y' Y g q q' hq i₁ i₂ f₁ f₂ hf₁ hf₂ gf₁ gf₂ hgf₁ hgf₂ := by + dsimp + simp only [pullHom, Functor.map_comp, Category.assoc, + F.mapComp'₀₁₃_inv_app (f i₁).op.toLoc f₁.op.toLoc g.op.toLoc q.op.toLoc + gf₁.op.toLoc q'.op.toLoc (by aesoptoloc) (by aesoptoloc) (by aesoptoloc), + F.mapComp'_hom_app_comp_mapComp'_inv_app + (f i₂).op.toLoc f₂.op.toLoc g.op.toLoc q.op.toLoc gf₂.op.toLoc q'.op.toLoc + (by aesoptoloc) (by aesoptoloc) (by aesoptoloc) M] + +@[simps] +def isoMk {D₁ D₂ : F.DescentData f} (e : ∀ (i : ι), D₁.obj i ≅ D₂.obj i) + (comm : ∀ ⦃Y : C⦄ (q : Y ⟶ S) ⦃i₁ i₂ : ι⦄ (f₁ : Y ⟶ X i₁) + (f₂ : Y ⟶ X i₂) (hf₁ : f₁ ≫ f i₁ = q) (hf₂ : f₂ ≫ f i₂ = q), + (F.map f₁.op.toLoc).map (e i₁).hom ≫ D₂.hom q f₁ f₂ = + D₁.hom q f₁ f₂ ≫ (F.map f₂.op.toLoc).map (e i₂).hom := by aesop_cat) : D₁ ≅ D₂ where + hom := + { hom i := (e i).hom + comm := comm } + inv := + { hom i := (e i).inv + comm Y q i₁ i₂ f₁ f₂ hf₁ hf₂ := by + rw [← cancel_mono ((F.map f₂.op.toLoc).map (e i₂).hom), Category.assoc, + Category.assoc, Iso.map_inv_hom_id, Category.comp_id, + ← cancel_epi ((F.map f₁.op.toLoc).map (e i₁).hom), + Iso.map_hom_inv_id_assoc, comm q f₁ f₂ hf₁ hf₂] } + +end DescentData + +/-- The functor `F.obj (.mk (op S)) ⥤ F.DescentData f`. -/ +def toDescentData : F.obj (.mk (op S)) ⥤ F.DescentData f where + obj M := .ofObj M + map {M M'} φ := { hom i := (F.map (f i).op.toLoc).map φ } + +end Pseudofunctor + +end CategoryTheory diff --git a/Mathlib/CategoryTheory/Sites/Descent/DescentDataAsCoalgebra.lean b/Mathlib/CategoryTheory/Sites/Descent/DescentDataAsCoalgebra.lean new file mode 100644 index 00000000000000..780156795df06f --- /dev/null +++ b/Mathlib/CategoryTheory/Sites/Descent/DescentDataAsCoalgebra.lean @@ -0,0 +1,262 @@ +/- +Copyright (c) 2025 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ +import Mathlib.CategoryTheory.Sites.Descent.DescentDataDoublePrime +import Mathlib.CategoryTheory.Bicategory.Adjunction.Adj +import Mathlib.CategoryTheory.Monad.Adjunction +import Mathlib.CategoryTheory.Bicategory.Adjunction.BaseChange + +/-! +# Descent data as coalgebras... + +-/ + +namespace CategoryTheory + +open Opposite Limits Bicategory + +namespace Pseudofunctor + +variable {C : Type*} [Category C] (F : Pseudofunctor (LocallyDiscrete Cᵒᵖ) (Adj Cat)) + +namespace LocallyDiscreteToAdjCat + +set_option quotPrecheck false in +scoped notation g:80 " _* " M:81 => ((_ : Pseudofunctor _ (Adj Cat)).map + (Quiver.Hom.op g).toLoc).r.obj M + +set_option quotPrecheck false in +scoped notation g:80 " ^* " M:81 => ((_ : Pseudofunctor _ (Adj Cat)).map + (Quiver.Hom.op g).toLoc).l.obj M + +end LocallyDiscreteToAdjCat + +open LocallyDiscreteToAdjCat + +@[ext] +structure DescentDataAsCoalgebra {ι : Type*} {S : C} {X : ι → C} (f : ∀ i, X i ⟶ S) where + obj (i : ι) : (F.obj (.mk (op (X i)))).obj + hom (i₁ i₂ : ι) : obj i₁ ⟶ (f i₁) ^* (f i₂) _* (obj i₂) + counit (i : ι) : hom i i ≫ (F.map (f i).op.toLoc).adj.counit.app _ = 𝟙 _ := by aesop_cat + coassoc (i₁ i₂ i₃ : ι) : + hom i₁ i₂ ≫ (F.map (f i₁).op.toLoc).l.map ((F.map (f i₂).op.toLoc).r.map (hom i₂ i₃)) = + hom i₁ i₃ ≫ + (F.map (f i₁).op.toLoc).l.map ((F.map (f i₂).op.toLoc).adj.unit.app _) := by aesop_cat + +namespace DescentDataAsCoalgebra + +attribute [reassoc (attr := simp)] counit coassoc +variable {F} + +section + +variable {ι : Type*} {S : C} {X : ι → C} {f : ∀ i, X i ⟶ S} + +@[ext] +structure Hom (D₁ D₂ : F.DescentDataAsCoalgebra f) where + hom (i : ι) : D₁.obj i ⟶ D₂.obj i + comm (i₁ i₂ : ι) : + D₁.hom i₁ i₂ ≫ + (F.map (f i₁).op.toLoc).l.map ((F.map (f i₂).op.toLoc).r.map (hom i₂)) = + hom i₁ ≫ D₂.hom i₁ i₂ := by aesop_cat + +attribute [reassoc (attr := simp)] Hom.comm + +@[simps] +def Hom.id (D : F.DescentDataAsCoalgebra f) : Hom D D where + hom _ := 𝟙 _ + +@[simps] +def Hom.comp {D₁ D₂ D₃ : F.DescentDataAsCoalgebra f} (φ : Hom D₁ D₂) (φ' : Hom D₂ D₃) : + Hom D₁ D₃ where + hom i := φ.hom i ≫ φ'.hom i + +instance : Category (F.DescentDataAsCoalgebra f) where + Hom := Hom + id := Hom.id + comp := Hom.comp + +@[ext] +lemma hom_ext {D₁ D₂ : F.DescentDataAsCoalgebra f} {φ φ' : D₁ ⟶ D₂} + (h : ∀ i, φ.hom i = φ'.hom i): φ = φ' := + Hom.ext (funext h) + +@[simp] +lemma id_hom (D : F.DescentDataAsCoalgebra f) (i : ι) : + Hom.hom (𝟙 D) i = 𝟙 _ := rfl + +@[reassoc, simp] +lemma comp_hom {D₁ D₂ D₃ : F.DescentDataAsCoalgebra f} (φ : D₁ ⟶ D₂) (φ' : D₂ ⟶ D₃) (i : ι) : + (φ ≫ φ').hom i = φ.hom i ≫ φ'.hom i := rfl + +@[simps] +def isoMk {D₁ D₂ : F.DescentDataAsCoalgebra f} (e : ∀ (i : ι), D₁.obj i ≅ D₂.obj i) + (comm : ∀ (i₁ i₂ : ι), D₁.hom i₁ i₂ ≫ + (F.map (f i₁).op.toLoc).l.map ((F.map (f i₂).op.toLoc).r.map (e i₂).hom) = + (e i₁).hom ≫ D₂.hom i₁ i₂ := by aesop_cat) : + D₁ ≅ D₂ where + hom.hom i := (e i).hom + hom.comm := comm + inv.hom i := (e i).inv + inv.comm i₁ i₂ := by + rw [← cancel_epi (e i₁).hom, ← reassoc_of% (comm i₁ i₂), ← Functor.map_comp, ← Functor.map_comp] + simp + +end + +section Unit + +variable {X S : C} {f : X ⟶ S} + +@[simps] +def toCoalgebra (D : F.DescentDataAsCoalgebra (fun (_ : Unit) ↦ f)) : + (F.map f.op.toLoc).adj.toCategory.toComonad.Coalgebra where + A := D.obj .unit + a := D.hom .unit .unit + +@[simps] +def ofCoalgebra (A : (F.map f.op.toLoc).adj.toCategory.toComonad.Coalgebra) : + F.DescentDataAsCoalgebra (fun (_ : Unit) ↦ f) where + obj _ := A.A + hom _ _ := A.a + counit _ := A.counit + coassoc _ _ _ := A.coassoc.symm + +variable (F f) + +@[simps] +def toCoalgebraFunctor : + F.DescentDataAsCoalgebra (fun (_ : Unit) ↦ f) ⥤ + (F.map f.op.toLoc).adj.toCategory.toComonad.Coalgebra where + obj D := D.toCoalgebra + map φ := { f := φ.hom .unit } + +@[simps] +def fromCoalgebraFunctor : + (F.map f.op.toLoc).adj.toCategory.toComonad.Coalgebra ⥤ + F.DescentDataAsCoalgebra (fun (_ : Unit) ↦ f) where + obj A := ofCoalgebra A + map φ := + { hom _ := φ.f + comm _ _ := φ.h } + +@[simps] +def coalgebraEquivalence : + F.DescentDataAsCoalgebra (fun (_ : Unit) ↦ f) ≌ + (F.map f.op.toLoc).adj.toCategory.toComonad.Coalgebra where + functor := toCoalgebraFunctor F f + inverse := fromCoalgebraFunctor F f + unitIso := Iso.refl _ + counitIso := Iso.refl _ + +end Unit + +variable (F) {ι : Type*} {S : C} {X : ι → C} {f : ∀ i, X i ⟶ S} + (sq : ∀ i j, ChosenPullback (f i) (f j)) + (sq₃ : ∀ (i₁ i₂ i₃ : ι), ChosenPullback₃ (sq i₁ i₂) (sq i₂ i₃) (sq i₁ i₃)) + +section + +variable {F} + +variable (A : F.DescentDataAsCoalgebra f) + +open DescentData'' + +variable [∀ i₁ i₂, IsIso (F.baseChange (sq i₁ i₂).isPullback.toCommSq.flip.op.toLoc)] + [∀ i₁ i₂ i₃, IsIso (F.baseChange (sq₃ i₁ i₂ i₃).isPullback₂.toCommSq.flip.op.toLoc)] + +@[simps] +noncomputable +def toDescentDataAsCoalgebra : F.DescentData'' sq sq₃ ⥤ F.DescentDataAsCoalgebra f where + obj D := + { obj := D.obj + hom := dataEquivCoalgebra D.hom + counit i := by + obtain ⟨δ⟩ := inferInstanceAs (Nonempty (sq i i).Diagonal) + rw [← hom_self_iff_dataEquivCoalgebra _ δ] + exact D.hom_self i δ + coassoc i₁ i₂ i₃ := by + rw [← hom_comp_iff_dataEquivCoalgebra sq₃] + exact D.hom_comp i₁ i₂ i₃ } + map {D₁ D₂} g := + { hom := g.hom + comm i₁ i₂ := by + rw [← hom_comm_iff_dataEquivCoalgebra] + exact g.comm i₁ i₂ } + +set_option maxHeartbeats 400000 in +-- TODO: automation is slow here +@[simps] +noncomputable +def fromDescentDataAsCoalgebra : F.DescentDataAsCoalgebra f ⥤ F.DescentData'' sq sq₃ where + obj D := + { obj := D.obj + hom := dataEquivCoalgebra.symm D.hom + hom_self i δ := by + rw [hom_self_iff_dataEquivCoalgebra _ δ] + simp + hom_comp i₁ i₂ i₃ := by + rw [hom_comp_iff_dataEquivCoalgebra sq₃] + simp } + map {D₁ D₂} g := + { hom := g.hom + comm i₁ i₂ := by + rw [hom_comm_iff_dataEquivCoalgebra] + simp } + +noncomputable +def equivDescentData'' : F.DescentDataAsCoalgebra f ≌ F.DescentData'' sq sq₃ where + functor := fromDescentDataAsCoalgebra sq sq₃ + inverse := toDescentDataAsCoalgebra sq sq₃ + unitIso := NatIso.ofComponents + (fun D ↦ isoMk (fun i ↦ Iso.refl _) + (fun i₁ i₂ ↦ by simp [fromDescentDataAsCoalgebra])) + counitIso := NatIso.ofComponents + (fun D ↦ DescentData''.isoMk (fun i ↦ Iso.refl _) + (fun i₁ i₂ ↦ by simp [toDescentDataAsCoalgebra])) + +end + +noncomputable +def descentData'Equivalence [∀ i₁ i₂, IsIso (F.baseChange (sq i₁ i₂).commSq.flip.op.toLoc)] + [∀ i₁ i₂ i₃, IsIso (F.baseChange (sq₃ i₁ i₂ i₃).isPullback₂.toCommSq.flip.op.toLoc)] : + F.DescentDataAsCoalgebra f ≌ (F.comp Adj.forget₁).DescentData' sq sq₃ := + (equivDescentData'' sq sq₃).trans (DescentData''.equivDescentData' sq₃) + +end DescentDataAsCoalgebra + +namespace DescentData' + +variable {X S : C} {f : X ⟶ S} (sq : ChosenPullback f f) (sq₃ : ChosenPullback₃ sq sq sq) + +noncomputable def equivalenceOfComonadicLeftAdjoint [IsIso (F.baseChange sq.commSq.flip.op.toLoc)] + [IsIso (F.baseChange sq₃.isPullback₂.toCommSq.flip.op.toLoc)] + [(Comonad.comparison (F.map f.op.toLoc).adj.toCategory).IsEquivalence] : + (F.obj (.mk (op S))).obj ≌ + (F.comp Adj.forget₁).DescentData' (fun (_ : Unit) _ ↦ sq) (fun _ _ _ ↦ sq₃) := + (Comonad.comparison (F.map f.op.toLoc).adj.toCategory).asEquivalence.trans + ((DescentDataAsCoalgebra.coalgebraEquivalence _ _).symm.trans + (DescentDataAsCoalgebra.descentData'Equivalence _ _ _)) + +end DescentData' + +namespace DescentData + +variable {X S : C} (f : X ⟶ S) (sq : ChosenPullback f f) (sq₃ : ChosenPullback₃ sq sq sq) + +noncomputable def equivalenceOfComonadicLeftAdjoint [IsIso (F.baseChange sq.commSq.flip.op.toLoc)] + [IsIso (F.baseChange sq₃.isPullback₂.toCommSq.flip.op.toLoc)] + [(Comonad.comparison (F.map f.op.toLoc).adj.toCategory).IsEquivalence] : + (F.obj (.mk (op S))).obj ≌ + (F.comp Adj.forget₁).DescentData (fun (_ : Unit) ↦ f) := + (DescentData'.equivalenceOfComonadicLeftAdjoint F sq sq₃).trans + (DescentData'.descentDataEquivalence (F.comp Adj.forget₁) _ _) + +end DescentData + +end Pseudofunctor + +end CategoryTheory diff --git a/Mathlib/CategoryTheory/Sites/Descent/DescentDataDoublePrime.lean b/Mathlib/CategoryTheory/Sites/Descent/DescentDataDoublePrime.lean new file mode 100644 index 00000000000000..dffe79ddd2c0ba --- /dev/null +++ b/Mathlib/CategoryTheory/Sites/Descent/DescentDataDoublePrime.lean @@ -0,0 +1,689 @@ +/- +Copyright (c) 2025 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou, Christian Merten +-/ +import Mathlib.CategoryTheory.Sites.Descent.DescentDataPrime +import Mathlib.CategoryTheory.Sites.Descent.IsStack +import Mathlib.CategoryTheory.Bicategory.Adjunction.Adj +import Mathlib.CategoryTheory.Bicategory.Adjunction.BaseChange + +/-! +# Descent data ... + +-/ + +namespace CategoryTheory + +@[simps] +def Bicategory.Adjunction.toCategory {C D : Cat} {F : C ⟶ D} {G : D ⟶ C} + (adj : Bicategory.Adjunction F G) : + CategoryTheory.Adjunction F G where + unit := adj.unit + counit := adj.counit + left_triangle_components X := by + have := congr_app adj.left_triangle X + dsimp [leftZigzag, bicategoricalComp] at this + simpa [Cat.associator_hom_app, Cat.leftUnitor_hom_app, Cat.rightUnitor_inv_app] using this + right_triangle_components X := by + have := congr_app adj.right_triangle X + dsimp [rightZigzag, bicategoricalComp] at this + simpa [Cat.associator_inv_app, Cat.leftUnitor_inv_app] using this + +open Opposite Limits Bicategory + +@[reassoc (attr := simp)] +lemma Bicategory.Adj.hom_inv_id_τl_app {C D : Adj Cat} {f g : C ⟶ D} (u : f ≅ g) (M) : + u.hom.τl.app M ≫ u.inv.τl.app M = 𝟙 _ := by + rw [← NatTrans.comp_app, Adj.hom_inv_id_τl] + simp + +@[reassoc (attr := simp)] +lemma Bicategory.Adj.inv_hom_id_τl_app {C D : Adj Cat} {f g : C ⟶ D} (u : f ≅ g) (M) : + u.inv.τl.app M ≫ u.hom.τl.app M = 𝟙 _ := by + rw [← NatTrans.comp_app, Adj.inv_hom_id_τl] + simp + +@[reassoc (attr := simp)] +lemma Bicategory.Adj.hom_inv_id_τr_app {C D : Adj Cat} {f g : C ⟶ D} (u : f ≅ g) (M) : + u.hom.τr.app M ≫ u.inv.τr.app M = 𝟙 _ := by + rw [← NatTrans.comp_app, Adj.hom_inv_id_τr] + simp + +@[reassoc (attr := simp)] +lemma Bicategory.Adj.inv_hom_id_τr_app {C D : Adj Cat} {f g : C ⟶ D} (u : f ≅ g) (M) : + u.inv.τr.app M ≫ u.hom.τr.app M = 𝟙 _ := by + rw [← NatTrans.comp_app, Adj.inv_hom_id_τr] + simp + +namespace Pseudofunctor + +open LocallyDiscreteOpToCat + +variable {C : Type*} [Category C] (F : Pseudofunctor (LocallyDiscrete Cᵒᵖ) (Adj Cat)) + +instance {X Y : C} (f : X ⟶ Y) [IsIso f] (F : Pseudofunctor (LocallyDiscrete C) (Adj Cat)) : + (F.map (.toLoc f)).l.IsEquivalence := by + change ((F.comp Adj.forget₁).map f.toLoc).IsEquivalence + infer_instance + +instance (X : LocallyDiscrete C) (F : Pseudofunctor (LocallyDiscrete C) (Adj Cat)) : + (F.map (𝟙 X)).l.IsEquivalence := by + obtain ⟨X⟩ := X + change (F.map (𝟙 X).toLoc).l.IsEquivalence + infer_instance + +-- TODO: add `Pseudofunctor.comp_mapComp'` +lemma mapComp'_comp_forget₁_hom {C : Type*} [Bicategory C] [Strict C] + (F : Pseudofunctor C (Adj Cat)) + {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (fg : X ⟶ Z) (hfg : f ≫ g = fg) : + ((F.comp Adj.forget₁).mapComp' f g fg hfg).hom = + (F.mapComp' f g fg hfg).hom.τl := by + simp [Adj.comp_forget₁_mapComp'] + +lemma mapComp'_comp_forget₁_inv {C : Type*} [Bicategory C] [Strict C] + (F : Pseudofunctor C (Adj Cat)) + {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (fg : X ⟶ Z) (hfg : f ≫ g = fg) : + ((F.comp Adj.forget₁).mapComp' f g fg hfg).inv = + (F.mapComp' f g fg hfg).inv.τl := by + simp [Adj.comp_forget₁_mapComp'] + +section + +variable {C B : Type*} [Bicategory C] [Strict C] [Bicategory B] + (F : Pseudofunctor C (Adj B)) + +end + +variable {ι : Type*} {S : C} {X : ι → C} {f : ∀ i, X i ⟶ S} + (sq : ∀ i j, ChosenPullback (f i) (f j)) + (sq₃ : ∀ (i₁ i₂ i₃ : ι), ChosenPullback₃ (sq i₁ i₂) (sq i₂ i₃) (sq i₁ i₃)) + +namespace DescentData'' + +variable {F sq} +section + +variable {obj : ∀ (i : ι), (F.obj (.mk (op (X i)))).obj} + (hom : ∀ (i₁ i₂ : ι), obj i₁ ⟶ (F.map (sq i₁ i₂).p₁.op.toLoc).r.obj + ((F.map (sq i₁ i₂).p₂.op.toLoc).l.obj (obj i₂))) + +def homComp (i₁ i₂ i₃ : ι) : obj i₁ ⟶ (F.map (sq₃ i₁ i₂ i₃).p₁.op.toLoc).r.obj + ((F.map (sq₃ i₁ i₂ i₃).p₃.op.toLoc).l.obj (obj i₃)) := + hom i₁ i₂ ≫ (F.map (sq i₁ i₂).p₁.op.toLoc).r.map + ((F.map (sq i₁ i₂).p₂.op.toLoc).l.map (hom i₂ i₃)) ≫ + (F.map (sq i₁ i₂).p₁.op.toLoc).r.map + ((F.baseChange (sq₃ i₁ i₂ i₃).isPullback₂.toCommSq.flip.op.toLoc).app _) ≫ + (Adj.rIso (F.mapComp' (sq i₁ i₂).p₁.op.toLoc (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc + (sq₃ i₁ i₂ i₃).p₁.op.toLoc (by aesoptoloc))).inv.app _ ≫ + (F.map (sq₃ i₁ i₂ i₃).p₁.op.toLoc).r.map + ((Adj.lIso (F.mapComp' (sq i₂ i₃).p₂.op.toLoc (sq₃ i₁ i₂ i₃).p₂₃.op.toLoc + (sq₃ i₁ i₂ i₃).p₃.op.toLoc (by aesoptoloc))).inv.app _) + +end + +section + +variable {X₁₂ X₁ X₂ : C} + {obj₁ : (F.obj (.mk (op X₁))).obj} {obj₂ : (F.obj (.mk (op X₂))).obj} + {p₁ : X₁₂ ⟶ X₁} {p₂ : X₁₂ ⟶ X₂} + (hom : obj₁ ⟶ (F.map p₁.op.toLoc).r.obj ((F.map p₂.op.toLoc).l.obj obj₂)) + +def pullHom'' ⦃Y₁₂ : C⦄ (p₁₂ : Y₁₂ ⟶ X₁₂) (q₁ : Y₁₂ ⟶ X₁) (q₂ : Y₁₂ ⟶ X₂) + (hq₁ : p₁₂ ≫ p₁ = q₁ := by aesop_cat) (hq₂ : p₁₂ ≫ p₂ = q₂ := by aesop_cat) : + obj₁ ⟶ (F.map q₁.op.toLoc).r.obj ((F.map q₂.op.toLoc).l.obj obj₂) := + hom ≫ (F.map p₁.op.toLoc).r.map ((F.map p₁₂.op.toLoc).adj.unit.app _) ≫ + (Adj.rIso (F.mapComp' p₁.op.toLoc p₁₂.op.toLoc q₁.op.toLoc (by aesoptoloc))).inv.app _ ≫ + (F.map q₁.op.toLoc).r.map + ((Adj.lIso (F.mapComp' p₂.op.toLoc p₁₂.op.toLoc q₂.op.toLoc (by aesoptoloc))).inv.app _) + +end + +@[reassoc] +lemma mapComp'_τl_τr_compatibility + ⦃X Y Z : C⦄ (f : X ⟶ Y) (g : Y ⟶ Z) (fg : X ⟶ Z) (hfg : f ≫ g = fg) + (obj : (F.obj (.mk (op Y))).obj) : + (F.map fg.op.toLoc).l.map + ((F.map g.op.toLoc).r.map ((F.map f.op.toLoc).adj.unit.app obj)) ≫ + (F.map fg.op.toLoc).l.map + ((F.mapComp' g.op.toLoc f.op.toLoc fg.op.toLoc (by aesoptoloc)).hom.τr.app + (((F.map f.op.toLoc).l.obj obj))) ≫ + (F.map fg.op.toLoc).adj.counit.app ((F.map f.op.toLoc).l.obj obj) = + (F.mapComp' g.op.toLoc f.op.toLoc fg.op.toLoc (by aesoptoloc)).hom.τl.app _ ≫ + (F.map f.op.toLoc).l.map ((F.map g.op.toLoc).adj.counit.app obj) := by + simpa [Cat.associator_hom_app, Cat.associator_inv_app, Cat.rightUnitor_inv_app, + Cat.leftUnitor_hom_app] using + NatTrans.congr_app + (Adj.unit_comp_mapComp'_hom_τr_comp_counit F g.op.toLoc f.op.toLoc fg.op.toLoc + (by aesoptoloc)) obj + +lemma homEquiv_symm_pullHom'' ⦃X₁ X₂ : C⦄ + ⦃obj₁ : (F.obj (.mk (op X₁))).obj⦄ ⦃obj₂ : (F.obj (.mk (op X₂))).obj⦄ + ⦃X₁₂ : C⦄ ⦃p₁ : X₁₂ ⟶ X₁⦄ ⦃p₂ : X₁₂ ⟶ X₂⦄ + (hom : obj₁ ⟶ (F.map p₁.op.toLoc).r.obj ((F.map p₂.op.toLoc).l.obj obj₂)) + ⦃Y₁₂ : C⦄ (g : Y₁₂ ⟶ X₁₂) (gp₁ : Y₁₂ ⟶ X₁) (gp₂ : Y₁₂ ⟶ X₂) + (hgp₁ : g ≫ p₁ = gp₁) (hgp₂ : g ≫ p₂ = gp₂) : + ((F.map gp₁.op.toLoc).adj.toCategory.homEquiv _ _ ).symm (pullHom'' hom g gp₁ gp₂ hgp₁ hgp₂) = + pullHom (F := F.comp Adj.forget₁) + ((((F.map p₁.op.toLoc).adj.toCategory).homEquiv _ _ ).symm hom) g gp₁ gp₂ hgp₁ hgp₂ := by + rw [Adjunction.homEquiv_counit, Adjunction.homEquiv_counit] + dsimp [pullHom'', pullHom] + simp only [Functor.map_comp, Category.assoc, Adj.comp_forget₁_mapComp', Adj.lIso_hom, + Adj.lIso_inv] + erw [← NatTrans.naturality_assoc] + dsimp + congr 1 + have := (F.map gp₁.op.toLoc).adj.toCategory.counit.naturality + ((F.mapComp' p₂.op.toLoc g.op.toLoc gp₂.op.toLoc (by aesoptoloc)).inv.τl.app obj₂) + dsimp at this + rw [this, mapComp'_τl_τr_compatibility_assoc _ _ _ hgp₁] + +section + +variable + ⦃X₁₂ X X S : C⦄ ⦃p₁ : X₁₂ ⟶ X⦄ ⦃p₂ : X₁₂ ⟶ X⦄ ⦃f : X ⟶ S⦄ + (sq : CommSq p₁ p₂ f f) (obj : (F.obj (.mk (op X))).obj) + +@[reassoc] +lemma map_baseChange_comp_counit (g : X ⟶ X₁₂) (hg₁ : g ≫ p₁ = 𝟙 X) (hg₂ : g ≫ p₂ = 𝟙 X) : + (F.map g.op.toLoc).l.map + ((F.map p₁.op.toLoc).l.map ((F.baseChange sq.flip.op.toLoc).app obj)) ≫ + (F.map g.op.toLoc).l.map + ((F.map p₁.op.toLoc).adj.counit.app _) = + (F.mapComp' p₁.op.toLoc g.op.toLoc (𝟙 _) (by aesoptoloc)).inv.τl.app + ((F.map f.op.toLoc).l.obj ((F.map f.op.toLoc).r.obj obj)) ≫ + (F.map (𝟙 _)).l.map ((F.map f.op.toLoc).adj.counit.app _) ≫ + (F.mapComp' p₂.op.toLoc g.op.toLoc (𝟙 _) (by aesoptoloc)).hom.τl.app obj := by + have := NatTrans.congr_app + (F.whiskerRight_whiskerBaseChange_self_self _ _ _ sq.flip.op.toLoc g.op.toLoc (by aesoptoloc) + (by aesoptoloc)) obj + simp [Cat.associator_inv_app, Cat.associator_hom_app, Cat.leftUnitor_hom_app, + Adj.comp_forget₁_mapComp', whiskerBaseChange_eq', + Adjunction.homEquiv₂_symm_apply] at this + rw [this] + erw [← NatTrans.naturality_assoc] + rfl + +end + + +end DescentData'' + +open DescentData'' in +structure DescentData'' where + obj (i : ι) : (F.obj (.mk (op (X i)))).obj + hom (i₁ i₂ : ι) : obj i₁ ⟶ + (F.map (sq i₁ i₂).p₁.op.toLoc).r.obj + ((F.map (sq i₁ i₂).p₂.op.toLoc).l.obj (obj i₂)) + hom_self (i : ι) (δ : (sq i i).Diagonal) : + pullHom'' (hom i i) δ.f (𝟙 _) (𝟙 _) = (F.map (𝟙 (.mk (op (X i))))).adj.unit.app _ + hom_comp (i₁ i₂ i₃ : ι) : + homComp sq₃ hom i₁ i₂ i₃ = pullHom'' (hom i₁ i₃) (sq₃ i₁ i₂ i₃).p₁₃ _ _ + +namespace DescentData'' + +section Category + +variable {F sq sq₃} + +@[ext] +structure Hom (D₁ D₂ : F.DescentData'' sq sq₃) where + hom (i : ι) : D₁.obj i ⟶ D₂.obj i + comm (i₁ i₂ : ι) : + D₁.hom i₁ i₂ ≫ (F.map (sq i₁ i₂).p₁.op.toLoc).r.map + ((F.map (sq i₁ i₂).p₂.op.toLoc).l.map (hom i₂)) = hom i₁ ≫ D₂.hom i₁ i₂ := by aesop_cat + +attribute [reassoc (attr := simp)] Hom.comm + +@[simps] +def Hom.id (D : F.DescentData'' sq sq₃) : Hom D D where + hom _ := 𝟙 _ + +@[simps] +def Hom.comp {D₁ D₂ D₃ : F.DescentData'' sq sq₃} (f : Hom D₁ D₂) (g : Hom D₂ D₃) : Hom D₁ D₃ where + hom i := f.hom i ≫ g.hom i + +instance : Category (F.DescentData'' sq sq₃) where + Hom := Hom + id := Hom.id + comp := Hom.comp + +@[ext] +lemma hom_ext {D₁ D₂ : F.DescentData'' sq sq₃} {f g : D₁ ⟶ D₂} + (h : ∀ i, f.hom i = g.hom i) : f = g := + Hom.ext (funext h) + +@[reassoc, simp] +lemma comp_hom {D₁ D₂ D₃ : F.DescentData'' sq sq₃} (f : D₁ ⟶ D₂) (g : D₂ ⟶ D₃) (i : ι) : + (f ≫ g).hom i = f.hom i ≫ g.hom i := + rfl + +@[simp] +lemma id_hom (D : F.DescentData'' sq sq₃) (i : ι) : + Hom.hom (𝟙 D) i = 𝟙 _ := + rfl + +@[simps] +def isoMk {D₁ D₂ : F.DescentData'' sq sq₃} (e : ∀ (i : ι), D₁.obj i ≅ D₂.obj i) + (comm : ∀ (i₁ i₂ : ι), D₁.hom i₁ i₂ ≫ (F.map (sq i₁ i₂).p₁.op.toLoc).r.map + ((F.map (sq i₁ i₂).p₂.op.toLoc).l.map (e i₂).hom) = + (e i₁).hom ≫ D₂.hom i₁ i₂ := by aesop_cat) : + D₁ ≅ D₂ where + hom := + { hom i := (e i).hom + comm := comm } + inv := + { hom i := (e i).inv + comm i₁ i₂ := by + rw [← cancel_epi (e i₁).hom, ← reassoc_of% comm i₁ i₂] + simp [← Functor.map_comp] } + +end Category + +variable {F} {sq} {obj : ∀ (i : ι), (F.obj (.mk (op (X i)))).obj} + (hom : ∀ i₁ i₂, obj i₁ ⟶ (F.map (sq i₁ i₂).p₁.op.toLoc).r.obj + ((F.map (sq i₁ i₂).p₂.op.toLoc).l.obj (obj i₂))) + +section + +def dataEquivDescentData' : + (∀ i₁ i₂, obj i₁ ⟶ (F.map (sq i₁ i₂).p₁.op.toLoc).r.obj + ((F.map (sq i₁ i₂).p₂.op.toLoc).l.obj (obj i₂))) ≃ + (∀ i₁ i₂, (F.map (sq i₁ i₂).p₁.op.toLoc).l.obj (obj i₁) ⟶ + (F.map (sq i₁ i₂).p₂.op.toLoc).l.obj (obj i₂)) := + Equiv.piCongrRight (fun i₁ ↦ Equiv.piCongrRight (fun i₂ ↦ + (((F.map (sq i₁ i₂).p₁.op.toLoc).adj.toCategory).homEquiv _ _).symm)) + +lemma hom_self_iff_dataEquivDescentData' ⦃i : ι⦄ (δ : (sq i i).Diagonal) : + pullHom'' (hom i i) δ.f (𝟙 _) (𝟙 _) = (F.map (𝟙 (.mk (op (X i))))).adj.unit.app _ ↔ + DescentData'.pullHom' (F := F.comp Adj.forget₁) + (dataEquivDescentData' hom) (f i) (𝟙 (X i)) (𝟙 (X i)) = 𝟙 _ := by + trans ((F.map (𝟙 (.mk (op (X i))))).adj.toCategory.homEquiv _ _).symm + (pullHom'' (hom i i) δ.f (𝟙 (X i)) (𝟙 (X i))) = 𝟙 _ + · dsimp + rw [← Adjunction.toCategory_unit, ← Adjunction.homEquiv_id, + Equiv.apply_eq_iff_eq_symm_apply, Equiv.symm_symm] + · convert Iff.rfl using 2 + have := homEquiv_symm_pullHom'' (hom _ _) δ.f (𝟙 _) (𝟙 _) (by simp) (by simp) + dsimp at this ⊢ + rw [this] + apply DescentData'.pullHom'_eq_pullHom <;> simp + +lemma homEquiv_symm_pullHom''_eq_pullHom'_dataEquivDescentData' (i₁ i₂ i₃ : ι) : + (((F.map (sq₃ i₁ i₂ i₃).p₁.op.toLoc).adj.toCategory).homEquiv _ _).symm + (pullHom'' (hom i₁ i₃) (sq₃ i₁ i₂ i₃).p₁₃ _ _) = + DescentData'.pullHom' (F := F.comp Adj.forget₁) + (dataEquivDescentData' hom) (sq₃ i₁ i₂ i₃).p (sq₃ i₁ i₂ i₃).p₁ (sq₃ i₁ i₂ i₃).p₃ := by + rw [homEquiv_symm_pullHom'', dataEquivDescentData'] + simp only [comp_toPrelaxFunctor, PrelaxFunctor.comp_toPrelaxFunctorStruct, + PrelaxFunctorStruct.comp_toPrefunctor, Prefunctor.comp_obj, Adj.forget₁_obj, + Prefunctor.comp_map, Adj.forget₁_map] + rw [DescentData'.pullHom'_eq_pullHom _ (sq₃ i₁ i₂ i₃).p _ _ _ _ (sq₃ i₁ i₂ i₃).p₁₃] + · rfl + · simp + · simp + +variable (i₁ i₂ i₃ : ι) + +@[reassoc] +lemma map_p₁₂_baseChange_comp_counit (i₁ i₂ i₃ : ι) (M) : + (F.map (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc).l.map + ((F.baseChange (sq₃ i₁ i₂ i₃).isPullback₂.toCommSq.flip.op.toLoc).app M) ≫ + (F.map (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc).adj.counit.app _ = + (F.mapComp' (sq i₁ i₂).p₂.op.toLoc (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc + (sq₃ i₁ i₂ i₃).p₂.op.toLoc (by aesoptoloc)).inv.τl.app _ ≫ + (F.mapComp' (sq i₂ i₃).p₁.op.toLoc (sq₃ i₁ i₂ i₃).p₂₃.op.toLoc + (sq₃ i₁ i₂ i₃).p₂.op.toLoc (by aesoptoloc)).hom.τl.app _ ≫ + (F.map (sq₃ i₁ i₂ i₃).p₂₃.op.toLoc).l.map + ((F.map (sq i₂ i₃).p₁.op.toLoc).adj.counit.app _) ≫ + (by dsimp; exact eqToHom rfl) := by + have h1 := congr($(F.whiskerBaseChange_eq_whiskerRight_baseChange + (sq₃ i₁ i₂ i₃).isPullback₂.toCommSq.flip.op.toLoc).app M) + have h2 := congr($(F.whiskerBaseChange_eq_whiskerLeft_isoMapOfCommSq + (sq₃ i₁ i₂ i₃).isPullback₂.toCommSq.flip.op.toLoc).app M) + dsimp at h1 h2 + rw [h2] at h1 + simp [Cat.associator_hom_app, Cat.associator_inv_app, Cat.rightUnitor_inv_app, + Cat.leftUnitor_hom_app, Cat.rightUnitor_hom_app] at h1 + rw [← h1] + simp only [Cat.comp_obj, Cat.id_obj, Adj.comp_l, eqToHom_refl, id_eq, Category.comp_id] + rw [F.isoMapOfCommSq_eq _ (sq₃ i₁ i₂ i₃).p₂.op.toLoc (by aesoptoloc)] + simp + +-- TODO: fix the name, this has nothing to do with `baseChange`, could maybe even be inlined by +-- adding some more lemmas +@[reassoc] +lemma baseChange_eq'' (i₁ i₂ i₃ : ι) (M) + (f : (F.map (sq i₁ i₂).p₂.op.toLoc).l.obj ((F.map (sq i₂ i₃).p₁.op.toLoc).r.obj M) ⟶ + (F.map (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc).r.obj ((F.map (sq₃ i₁ i₂ i₃).p₂₃.op.toLoc).l.obj M)) : + (F.map (sq₃ i₁ i₂ i₃).p₁.op.toLoc).l.map + ((F.map (sq i₁ i₂).p₁.op.toLoc).r.map f) ≫ + (F.map (sq₃ i₁ i₂ i₃).p₁.op.toLoc).l.map + ((F.mapComp' _ _ (sq₃ i₁ i₂ i₃).p₁.op.toLoc (by aesoptoloc)).hom.τr.app _) ≫ + (F.map (sq₃ i₁ i₂ i₃).p₁.op.toLoc).adj.counit.app _ = + ((F.mapComp' (sq i₁ i₂).p₁.op.toLoc (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc + (sq₃ i₁ i₂ i₃).p₁.op.toLoc (by aesoptoloc)).hom.τl.app _) ≫ + (F.map (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc).l.map + ((F.map (sq i₁ i₂).p₁.op.toLoc).adj.counit.app _) ≫ + (F.map (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc).l.map f ≫ + (F.map (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc).adj.counit.app _ := by + have := Adj.counit_map_of_comp F (sq i₁ i₂).p₁.op.toLoc (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc + (sq₃ i₁ i₂ i₃).p₁.op.toLoc (by aesoptoloc) + rw [this] + simp [Cat.associator_hom_app, Cat.associator_inv_app, Cat.rightUnitor_inv_app, + Cat.leftUnitor_hom_app] + congr 1 + rw [← (F.map (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc).l.map_comp_assoc] + rw [← (F.map (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc).l.map_comp_assoc] + rw [Category.assoc] + rw [← (F.map (sq i₁ i₂).p₁.op.toLoc).l.map_comp] + rw [← NatTrans.comp_app] + rw [Adj.hom_inv_id_τr] + simp only [Adj.comp_r, Cat.id_app, Cat.comp_obj, Functor.map_id, Category.comp_id] + rw [← (F.map (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc).l.map_comp_assoc] + erw [(F.map (sq i₁ i₂).p₁.op.toLoc).adj.counit.naturality] + simp + +-- TODO: clean this up, it's an `erw`-massacre +lemma homEquiv_symm_homComp (i₁ i₂ i₃ : ι) : + (((F.map (sq₃ i₁ i₂ i₃).p₁.op.toLoc).adj.toCategory).homEquiv _ _).symm + (homComp sq₃ hom i₁ i₂ i₃) = + DescentData'.pullHom' (F := F.comp Adj.forget₁) + (dataEquivDescentData' hom) (sq₃ i₁ i₂ i₃).p (sq₃ i₁ i₂ i₃).p₁ (sq₃ i₁ i₂ i₃).p₂ ≫ + DescentData'.pullHom' + (dataEquivDescentData' hom) (sq₃ i₁ i₂ i₃).p (sq₃ i₁ i₂ i₃).p₂ (sq₃ i₁ i₂ i₃).p₃ := by + rw [DescentData'.pullHom'₁₂_eq_pullHom_of_chosenPullback₃] + rw [DescentData'.pullHom'₂₃_eq_pullHom_of_chosenPullback₃] + rw [dataEquivDescentData'] + dsimp only [comp_toPrelaxFunctor, PrelaxFunctor.comp_toPrelaxFunctorStruct, + PrelaxFunctorStruct.comp_toPrefunctor, Prefunctor.comp_obj, Adj.forget₁_obj, + Prefunctor.comp_map, Adj.forget₁_map, Equiv.piCongrRight_apply, Pi.map_apply] + simp_rw [Adjunction.homEquiv_counit] + dsimp only [Adjunction.toCategory_counit] + rw [homComp] + simp only [Cat.comp_obj, Adj.comp_r, Adj.rIso_inv, Adj.comp_l, Adj.lIso_inv, Functor.map_comp, + Category.assoc, pullHom, comp_toPrelaxFunctor, PrelaxFunctor.comp_toPrelaxFunctorStruct, + PrelaxFunctorStruct.comp_toPrefunctor, Prefunctor.comp_obj, Adj.forget₁_obj, + Prefunctor.comp_map, Adj.forget₁_map] + erw [(F.map (sq₃ i₁ i₂ i₃).p₁.op.toLoc).adj.counit.naturality] + dsimp only [Cat.comp_obj, Cat.id_obj, Cat.id_map] + rw [baseChange_eq''_assoc] + rw [map_p₁₂_baseChange_comp_counit_assoc] + simp only [Cat.comp_obj, Adj.comp_l, Cat.id_obj, eqToHom_refl, id_eq, Category.id_comp, + NatTrans.naturality_assoc, Cat.comp_map] + rw [mapComp'_comp_forget₁_hom] + rw [mapComp'_comp_forget₁_hom] + rw [mapComp'_comp_forget₁_inv] + rw [mapComp'_comp_forget₁_inv] + congr 2 + rw [← (F.map (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc).l.map_comp_assoc] + erw [(F.map (sq i₁ i₂).p₁.op.toLoc).adj.counit.naturality] + simp only [Cat.comp_obj, Cat.id_obj, Cat.id_map, Functor.map_comp, Category.assoc] + erw [(F.mapComp' _ _ _ _).inv.τl.naturality_assoc] + simp + +lemma hom_comp_iff_dataEquivDescentData' (i₁ i₂ i₃ : ι) : + homComp sq₃ hom i₁ i₂ i₃ = pullHom'' (hom i₁ i₃) (sq₃ i₁ i₂ i₃).p₁₃ _ _ ↔ + DescentData'.pullHom' (F := F.comp Adj.forget₁) + (dataEquivDescentData' hom) (sq₃ i₁ i₂ i₃).p (sq₃ i₁ i₂ i₃).p₁ (sq₃ i₁ i₂ i₃).p₂ ≫ + DescentData'.pullHom' + (dataEquivDescentData' hom) (sq₃ i₁ i₂ i₃).p (sq₃ i₁ i₂ i₃).p₂ (sq₃ i₁ i₂ i₃).p₃ = + DescentData'.pullHom' + (dataEquivDescentData' hom) (sq₃ i₁ i₂ i₃).p (sq₃ i₁ i₂ i₃).p₁ (sq₃ i₁ i₂ i₃).p₃ := by + rw [← homEquiv_symm_pullHom''_eq_pullHom'_dataEquivDescentData', ← homEquiv_symm_homComp] + simp + +variable + (obj₁ obj₂ : (i : ι) → (F.obj { as := op (X i) }).obj) + (hom₁ : (i₁ i₂ : ι) → obj₁ i₁ ⟶ + (F.map (sq i₁ i₂).p₁.op.toLoc).r.obj ((F.map (sq i₁ i₂).p₂.op.toLoc).l.obj (obj₁ i₂))) + (hom₂ : (i₁ i₂ : ι) → obj₂ i₁ ⟶ + (F.map (sq i₁ i₂).p₁.op.toLoc).r.obj ((F.map (sq i₁ i₂).p₂.op.toLoc).l.obj (obj₂ i₂))) + (hom : (i : ι) → obj₁ i ⟶ obj₂ i) + +lemma hom_comm_iff_dataEquivDescentData' (i₁ i₂ : ι) : + hom₁ i₁ i₂ ≫ (F.map (sq i₁ i₂).p₁.op.toLoc).r.map + ((F.map (sq i₁ i₂).p₂.op.toLoc).l.map (hom i₂)) = hom i₁ ≫ hom₂ i₁ i₂ ↔ + (F.map (sq i₁ i₂).p₁.op.toLoc).l.map (hom i₁) ≫ dataEquivDescentData' hom₂ i₁ i₂ = + dataEquivDescentData' hom₁ i₁ i₂ ≫ (F.map (sq i₁ i₂).p₂.op.toLoc).l.map (hom i₂) := by + conv_lhs => + rw [← Equiv.apply_eq_iff_eq + (((F.map (sq i₁ i₂).p₁.op.toLoc).adj.toCategory).homEquiv (obj₁ i₁) _).symm, Eq.comm] + congr! + · simp [dataEquivDescentData', Adjunction.homEquiv_symm_apply] + · simp only [Adjunction.homEquiv_symm_apply, Functor.map_comp, Adjunction.toCategory_counit, + Category.assoc, dataEquivDescentData', Equiv.piCongrRight_apply, Pi.map_apply] + congr 1 + apply (F.map (sq i₁ i₂).p₁.op.toLoc).adj.counit.naturality + +@[simps] +def toDescentData' : F.DescentData'' sq sq₃ ⥤ (F.comp Adj.forget₁).DescentData' sq sq₃ where + obj D := + { obj := D.obj + hom := dataEquivDescentData' D.hom + pullHom'_hom_self i := by + obtain ⟨δ⟩ := inferInstanceAs (Nonempty (sq i i).Diagonal) + rw [← hom_self_iff_dataEquivDescentData'] + exact D.hom_self i δ + pullHom'_hom_comp i₁ i₂ i₃ := by + rw [← hom_comp_iff_dataEquivDescentData'] + exact D.hom_comp i₁ i₂ i₃ } + map {D₁ D₂} f := + { hom i := f.hom i + comm i₁ i₂ := by + dsimp + rw [← hom_comm_iff_dataEquivDescentData'] + exact f.comm i₁ i₂ } + +@[simps] +def fromDescentData' : (F.comp Adj.forget₁).DescentData' sq sq₃ ⥤ F.DescentData'' sq sq₃ where + obj D := + { obj := D.obj + hom := dataEquivDescentData'.symm D.hom + hom_self i δ := by + rw [hom_self_iff_dataEquivDescentData'] + simp + hom_comp i₁ i₂ i₃ := by + rw [hom_comp_iff_dataEquivDescentData'] + simp } + map {D₁ D₂} f := + { hom i := f.hom i + comm i₁ i₂ := by + dsimp + rw [hom_comm_iff_dataEquivDescentData'] + simpa using f.comm i₁ i₂ } + +set_option maxHeartbeats 240000 in +-- TODO: automation is slow here +@[simps] +def equivDescentData' : + F.DescentData'' sq sq₃ ≌ (F.comp Adj.forget₁).DescentData' sq sq₃ where + functor := toDescentData' sq₃ + inverse := fromDescentData' sq₃ + unitIso := NatIso.ofComponents + (fun D ↦ isoMk (fun i ↦ Iso.refl _) (fun i₁ i₂ ↦ by simp [toDescentData'])) + counitIso := NatIso.ofComponents + (fun D ↦ DescentData'.isoMk (fun i ↦ Iso.refl _) (fun i₁ i₂ ↦ by simp [fromDescentData'])) + +end + +section + +variable [∀ i₁ i₂, IsIso (F.baseChange (sq i₁ i₂).isPullback.toCommSq.flip.op.toLoc)] + [∀ i₁ i₂ i₃, IsIso (F.baseChange (sq₃ i₁ i₂ i₃).isPullback₂.toCommSq.flip.op.toLoc)] + +noncomputable def dataEquivCoalgebra + [∀ i₁ i₂, IsIso (F.baseChange (sq i₁ i₂).isPullback.toCommSq.flip.op.toLoc)] : + (∀ i₁ i₂, obj i₁ ⟶ (F.map (sq i₁ i₂).p₁.op.toLoc).r.obj + ((F.map (sq i₁ i₂).p₂.op.toLoc).l.obj (obj i₂))) ≃ + (∀ i₁ i₂, obj i₁ ⟶ (F.map (f i₁).op.toLoc).l.obj ((F.map (f i₂).op.toLoc).r.obj (obj i₂))) := + Equiv.piCongrRight (fun i₁ ↦ Equiv.piCongrRight (fun i₂ ↦ + Iso.homCongr (Iso.refl _) + ((asIso (F.baseChange (sq i₁ i₂).isPullback.toCommSq.flip.op.toLoc)).symm.app _))) + +lemma hom_self_iff_dataEquivCoalgebra ⦃i : ι⦄ (δ : (sq i i).Diagonal): + pullHom'' (hom i i) δ.f (𝟙 _) (𝟙 _) = (F.map (𝟙 (.mk (op (X i))))).adj.unit.app _ ↔ + dataEquivCoalgebra hom i i ≫ (F.map (f i).op.toLoc).adj.counit.app _ = 𝟙 _ := by + obtain ⟨hom, rfl⟩ := dataEquivCoalgebra.symm.surjective hom + rw [Equiv.apply_symm_apply] + dsimp [dataEquivCoalgebra] + rw [Category.id_comp, + ← ((F.map (𝟙 (X i)).op.toLoc).adj.toCategory.homEquiv _ _ ).symm.injective.eq_iff, + homEquiv_symm_pullHom''] + dsimp + rw [← Adjunction.toCategory_unit, ← Adjunction.homEquiv_id, Equiv.symm_apply_apply] + trans (F.map (𝟙 { as := op (X i) })).l.map + (hom i i ≫ (F.map (f i).op.toLoc).adj.counit.app (obj i)) = 𝟙 _ ; swap + · rw [← Functor.map_id] + have : Functor.Faithful (F.map (𝟙 { as := op (X i) })).l := inferInstance + rw [Functor.map_injective_iff] + · convert Iff.rfl using 2 + dsimp [pullHom] + simp [Adjunction.homEquiv_counit] + erw [← NatTrans.naturality_assoc] + congr 1 + simp [Adj.comp_forget₁_mapComp'] + rw [map_baseChange_comp_counit_assoc (sq i i).commSq (obj i) δ.f (by simp) (by simp)] + dsimp + rw [← Adj.lIso_hom, ← Adj.lIso_inv, Iso.hom_inv_id_app_assoc, + ← Adj.lIso_hom, ← Adj.lIso_inv, Iso.hom_inv_id_app, Category.comp_id] + +variable (obj) in +private noncomputable def correction (i₁ i₂ i₃ : ι) : + (F.map (sq₃ i₁ i₂ i₃).p₁.op.toLoc).r.obj + ((F.map (sq₃ i₁ i₂ i₃).p₃.op.toLoc).l.obj (obj i₃)) ⟶ + (F.map (f i₁).op.toLoc).l.obj + ((F.map (f i₂).op.toLoc).r.obj + ((F.map (f i₂).op.toLoc).l.obj + ((F.map (f i₃).op.toLoc).r.obj (obj i₃)))) := + (F.map (sq₃ i₁ i₂ i₃).p₁.op.toLoc).r.map + ((F.mapComp' (sq i₂ i₃).p₂.op.toLoc (sq₃ i₁ i₂ i₃).p₂₃.op.toLoc + (sq₃ i₁ i₂ i₃).p₃.op.toLoc (by aesoptoloc)).hom.τl.app _) ≫ + (F.mapComp' (sq i₁ i₂).p₁.op.toLoc (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc + (sq₃ i₁ i₂ i₃).p₁.op.toLoc (by aesoptoloc)).inv.τr.app _ ≫ + (F.map (sq i₁ i₂).p₁.op.toLoc).r.map + (inv ((F.baseChange (sq₃ i₁ i₂ i₃).isPullback₂.toCommSq.flip.op.toLoc).app _)) ≫ + (inv (F.baseChange (sq i₁ i₂).isPullback.toCommSq.flip.op.toLoc)).app _ ≫ + (F.map (f i₁).op.toLoc).l.map ((F.map (f i₂).op.toLoc).r.map + (inv ((F.baseChange (sq i₂ i₃).isPullback.toCommSq.flip.op.toLoc).app _))) + +private instance (i₁ i₂ i₃ : ι) : IsIso (correction sq₃ obj i₁ i₂ i₃) := by + dsimp [correction] + -- TODO: does not work without these auxiliary instances + have : IsIso (F.mapComp' (sq i₁ i₂).p₁.op.toLoc (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc + (sq₃ i₁ i₂ i₃).p₁.op.toLoc (by aesoptoloc)).inv.τr := inferInstance + have : IsIso (F.mapComp' (sq i₂ i₃).p₂.op.toLoc (sq₃ i₁ i₂ i₃).p₂₃.op.toLoc + (sq₃ i₁ i₂ i₃).p₃.op.toLoc (by aesoptoloc)).hom.τl := inferInstance + infer_instance + +private lemma homComp_correction (i₁ i₂ i₃ : ι) : + homComp sq₃ hom i₁ i₂ i₃ ≫ correction sq₃ obj i₁ i₂ i₃ = dataEquivCoalgebra hom i₁ i₂ ≫ + (F.map (f i₁).op.toLoc).l.map + ((F.map (f i₂).op.toLoc).r.map (dataEquivCoalgebra hom i₂ i₃)) := by + simp only [homComp, Cat.comp_obj, Adj.comp_r, Adj.rIso_inv, Adj.comp_l, Adj.lIso_inv, + NatTrans.naturality_assoc, Cat.comp_map, Category.assoc, correction] + rw [← NatTrans.comp_app_assoc] + rw [Adj.hom_inv_id_τr] + simp only [Cat.comp_obj, Adj.comp_r, Cat.id_app, Category.id_comp] + nth_rw 3 [← (F.map (sq i₁ i₂).p₁.op.toLoc).r.map_comp_assoc] + rw [← (F.map (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc).r.map_comp] + rw [← NatTrans.comp_app] + rw [Adj.inv_hom_id_τl] + simp only [Adj.comp_l, Cat.id_app, Cat.comp_obj, Functor.map_id, Category.id_comp] + nth_rw 2 [← (F.map (sq i₁ i₂).p₁.op.toLoc).r.map_comp_assoc] + simp only [IsIso.hom_inv_id, Functor.map_id, Functor.map_inv, Category.id_comp] + dsimp [dataEquivCoalgebra] + simp only [NatIso.isIso_inv_app, Cat.comp_obj, Category.id_comp, Functor.map_comp, + Functor.map_inv, Category.assoc] + congr 1 + simp_rw [← Category.assoc] + congr 1 + rw [← NatIso.isIso_inv_app] + exact (inv (F.baseChange (sq i₁ i₂).isPullback.toCommSq.flip.op.toLoc)).naturality _ + +set_option maxHeartbeats 202000 in +-- TODO: this proof needs improvement +private lemma pullHom''_correction (i₁ i₂ i₃ : ι) : + pullHom'' (hom i₁ i₃) (sq₃ i₁ i₂ i₃).p₁₃ (sq₃ i₁ i₂ i₃).p₁ (sq₃ i₁ i₂ i₃).p₃ ≫ + correction sq₃ obj i₁ i₂ i₃ = + dataEquivCoalgebra hom i₁ i₃ ≫ + (F.map (f i₁).op.toLoc).l.map ((F.map (f i₂).op.toLoc).adj.unit.app + ((F.map (f i₃).op.toLoc).r.toPrefunctor.1 (obj i₃))) := by + dsimp only [pullHom'', Cat.comp_obj, Adj.comp_r, Adj.rIso_inv, Adj.comp_l, Adj.lIso_inv, + dataEquivCoalgebra, Equiv.piCongrRight_apply, Pi.map_apply, Iso.homCongr_apply, Iso.refl_inv, + Iso.app_hom, Iso.symm_hom, asIso_inv] + simp only [Category.assoc, NatIso.isIso_inv_app, Cat.comp_obj, Category.id_comp] + congr 1 + simp only [correction, Adj.comp_l, Cat.comp_obj, Adj.comp_r, Functor.map_inv, + NatTrans.naturality_assoc, Cat.comp_map, IsIso.eq_inv_comp] + have h := F.baseChange_triple (sq i₁ i₂).isPullback.toCommSq.flip.op.toLoc + (sq i₂ i₃).isPullback.toCommSq.flip.op.toLoc + (sq i₁ i₃).isPullback.toCommSq.flip.op.toLoc + (sq₃ i₁ i₂ i₃).isPullback₁.op.toLoc + (sq₃ i₁ i₂ i₃).isPullback₂.flip.op.toLoc + (sq₃ i₁ i₂ i₃).isPullback₃.op.toLoc + have h' := congr($(h).app (obj i₃)) + simp only [Cat.comp_obj, Cat.comp_app, Cat.id_obj, Cat.whiskerLeft_app, Cat.leftUnitor_inv_app, + eqToHom_refl, Cat.whiskerRight_app, Cat.associator_hom_app, Category.comp_id, Category.id_comp, + Adj.comp_r, Bicategory.whiskerRight_comp, Adj.comp_l, Category.assoc, + pentagon_hom_inv_inv_inv_inv_assoc, pentagon_hom_hom_inv_hom_hom_assoc, Cat.associator_inv_app, + Functor.map_id] at h' + rw [reassoc_of% h', F.isoMapOfCommSq_eq _ (sq₃ i₁ i₂ i₃).p₁.op.toLoc (by aesoptoloc), + F.isoMapOfCommSq_eq _ (sq₃ i₁ i₂ i₃).p₃.op.toLoc (by aesoptoloc)] + simp only [Iso.trans_hom, Iso.symm_hom, Adj.comp_τl, Adj.comp_l, Cat.comp_app, Cat.comp_obj, + Functor.map_comp, Adj.comp_τr, Adj.comp_r, Category.assoc, Adj.inv_hom_id_τr_app_assoc, + Adj.hom_inv_id_τr_app_assoc] + nth_rw 4 [← (F.map (sq i₁ i₂).p₁.op.toLoc).r.map_comp_assoc] + rw [← (F.map (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc).r.map_comp] + simp only [Adj.hom_inv_id_τl_app, Functor.map_id, Category.id_comp] + nth_rw 3 [← (F.map (sq i₁ i₂).p₁.op.toLoc).r.map_comp_assoc] + rw [← (F.map (sq₃ i₁ i₂ i₃).p₁₂.op.toLoc).r.map_comp] + simp only [Adj.inv_hom_id_τl_app, Functor.map_id, Category.comp_id] + simp only [Adj.comp_l, Cat.comp_obj, Functor.map_id, Category.id_comp, IsIso.hom_inv_id_assoc] + erw [← NatTrans.naturality_assoc] + simp only [Cat.comp_obj, Cat.comp_map] + rw [CategoryTheory.NatIso.isIso_inv_app] + simp + +lemma hom_comp_iff_dataEquivCoalgebra (i₁ i₂ i₃ : ι) : + homComp sq₃ hom i₁ i₂ i₃ = pullHom'' (hom i₁ i₃) (sq₃ i₁ i₂ i₃).p₁₃ _ _ ↔ + dataEquivCoalgebra hom i₁ i₂ ≫ (F.map (f i₁).op.toLoc).l.map + ((F.map (f i₂).op.toLoc).r.map (dataEquivCoalgebra hom i₂ i₃)) = + dataEquivCoalgebra hom i₁ i₃ ≫ + (F.map (f i₁).op.toLoc).l.map ((F.map (f i₂).op.toLoc).adj.unit.app _) := by + conv_lhs => rw [← cancel_mono (correction sq₃ obj i₁ i₂ i₃)] + rw [homComp_correction, pullHom''_correction] + +variable + (obj₁ obj₂ : (i : ι) → (F.obj { as := op (X i) }).obj) + (hom₁ : (i₁ i₂ : ι) → obj₁ i₁ ⟶ + (F.map (sq i₁ i₂).p₁.op.toLoc).r.obj ((F.map (sq i₁ i₂).p₂.op.toLoc).l.obj (obj₁ i₂))) + (hom₂ : (i₁ i₂ : ι) → obj₂ i₁ ⟶ + (F.map (sq i₁ i₂).p₁.op.toLoc).r.obj ((F.map (sq i₁ i₂).p₂.op.toLoc).l.obj (obj₂ i₂))) + (hom : (i : ι) → obj₁ i ⟶ obj₂ i) + +lemma hom_comm_iff_dataEquivCoalgebra (i₁ i₂ : ι) : + hom₁ i₁ i₂ ≫ (F.map (sq i₁ i₂).p₁.op.toLoc).r.map + ((F.map (sq i₁ i₂).p₂.op.toLoc).l.map (hom i₂)) = hom i₁ ≫ hom₂ i₁ i₂ ↔ + dataEquivCoalgebra hom₁ i₁ i₂ ≫ + (F.map (f i₁).op.toLoc).l.map ((F.map (f i₂).op.toLoc).r.map (hom i₂)) = + hom i₁ ≫ dataEquivCoalgebra hom₂ i₁ i₂ := by + obtain ⟨hom₁, rfl⟩ := dataEquivCoalgebra.symm.surjective hom₁ + obtain ⟨hom₂, rfl⟩ := dataEquivCoalgebra.symm.surjective hom₂ + simp only [dataEquivCoalgebra, Equiv.piCongrRight_symm_apply, Pi.map_apply, Iso.homCongr_symm, + Iso.refl_symm, Iso.homCongr_apply, Iso.refl_inv, Iso.symm_hom, Iso.app_inv, Iso.symm_inv, + asIso_hom, Category.id_comp, Category.assoc, Equiv.piCongrRight_apply, Iso.app_hom, asIso_inv, + NatIso.isIso_inv_app, Cat.comp_obj, IsIso.hom_inv_id, Category.comp_id] + conv_rhs => + rw [← cancel_mono ((F.baseChange (sq i₁ i₂).isPullback.toCommSq.flip.op.toLoc).app (obj₂ i₂))] + simp_rw [Category.assoc] + congr! 2 + exact ((F.baseChange (sq i₁ i₂).isPullback.toCommSq.flip.op.toLoc).naturality _).symm + +end + +end DescentData'' + +end Pseudofunctor + +end CategoryTheory diff --git a/Mathlib/CategoryTheory/Sites/Descent/DescentDataPrime.lean b/Mathlib/CategoryTheory/Sites/Descent/DescentDataPrime.lean new file mode 100644 index 00000000000000..9f155b34a7403d --- /dev/null +++ b/Mathlib/CategoryTheory/Sites/Descent/DescentDataPrime.lean @@ -0,0 +1,298 @@ +/- +Copyright (c) 2025 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ +import Mathlib.CategoryTheory.Sites.Descent.DescentData + +/-! +# Descent data ... + +-/ + +namespace CategoryTheory + +open Opposite Limits + +namespace Pseudofunctor + +open LocallyDiscreteOpToCat + +variable {C : Type*} [Category C] (F : Pseudofunctor (LocallyDiscrete Cᵒᵖ) Cat) + {ι : Type*} {S : C} {X : ι → C} {f : ∀ i, X i ⟶ S} + (sq : ∀ i j, ChosenPullback (f i) (f j)) + (sq₃ : ∀ (i₁ i₂ i₃ : ι), ChosenPullback₃ (sq i₁ i₂) (sq i₂ i₃) (sq i₁ i₃)) + +namespace DescentData' + +variable {F sq} + +section + +variable {obj obj' : ∀ (i : ι), F.obj (.mk (op (X i)))} + (hom : ∀ (i j : ι), (F.map (sq i j).p₁.op.toLoc).obj (obj i) ⟶ + (F.map (sq i j).p₂.op.toLoc).obj (obj' j)) + +noncomputable def pullHom' ⦃Y : C⦄ (q : Y ⟶ S) ⦃i₁ i₂ : ι⦄ (f₁ : Y ⟶ X i₁) (f₂ : Y ⟶ X i₂) + (hf₁ : f₁ ≫ f i₁ = q := by aesop_cat) (hf₂ : f₂ ≫ f i₂ = q := by aesop_cat) : + (F.map f₁.op.toLoc).obj (obj i₁) ⟶ (F.map f₂.op.toLoc).obj (obj' i₂) := + pullHom (hom i₁ i₂) ((sq i₁ i₂).isPullback.lift f₁ f₂ (by aesop)) f₁ f₂ + +@[reassoc] +lemma pullHom'_eq_pullHom ⦃Y : C⦄ (q : Y ⟶ S) ⦃i₁ i₂ : ι⦄ (f₁ : Y ⟶ X i₁) (f₂ : Y ⟶ X i₂) + (hf₁ : f₁ ≫ f i₁ = q) (hf₂ : f₂ ≫ f i₂ = q) (p : Y ⟶ (sq i₁ i₂).pullback) + (hp₁ : p ≫ (sq i₁ i₂).p₁ = f₁) (hp₂ : p ≫ (sq i₁ i₂).p₂ = f₂) : + pullHom' hom q f₁ f₂ hf₁ hf₂ = + pullHom (hom i₁ i₂) p f₁ f₂ := by + obtain rfl : p = (sq i₁ i₂).isPullback.lift f₁ f₂ (by rw [hf₁, hf₂]) := by + apply (sq i₁ i₂).isPullback.hom_ext <;> aesop + rfl + +@[reassoc] +lemma pullHom'₁₂_eq_pullHom_of_chosenPullback₃ (i₁ i₂ i₃ : ι) : + pullHom' hom (sq₃ i₁ i₂ i₃).p (sq₃ i₁ i₂ i₃).p₁ (sq₃ i₁ i₂ i₃).p₂ = + pullHom (hom i₁ i₂) (sq₃ i₁ i₂ i₃).p₁₂ _ _ := + pullHom'_eq_pullHom _ _ _ _ _ _ _ (by simp) (by simp) + +@[reassoc] +lemma pullHom'₁₃_eq_pullHom_of_chosenPullback₃ (i₁ i₂ i₃ : ι) : + pullHom' hom (sq₃ i₁ i₂ i₃).p (sq₃ i₁ i₂ i₃).p₁ (sq₃ i₁ i₂ i₃).p₃ = + pullHom (hom i₁ i₃) (sq₃ i₁ i₂ i₃).p₁₃ _ _ := + pullHom'_eq_pullHom _ _ _ _ _ _ _ (by simp) (by simp) + +@[reassoc] +lemma pullHom'₂₃_eq_pullHom_of_chosenPullback₃ (i₁ i₂ i₃ : ι) : + pullHom' hom (sq₃ i₁ i₂ i₃).p (sq₃ i₁ i₂ i₃).p₂ (sq₃ i₁ i₂ i₃).p₃ = + pullHom (hom i₂ i₃) (sq₃ i₁ i₂ i₃).p₂₃ _ _ := + pullHom'_eq_pullHom _ _ _ _ _ _ _ (by simp) (by simp) + +@[reassoc] + lemma pullHom_pullHom' ⦃Y Y' : C⦄ (g : Y' ⟶ Y) (q : Y ⟶ S) (q' : Y' ⟶ S) (hq : g ≫ q = q') + ⦃i₁ i₂ : ι⦄ (f₁ : Y ⟶ X i₁) (f₂ : Y ⟶ X i₂) (hf₁ : f₁ ≫ f i₁ = q) (hf₂ : f₂ ≫ f i₂ = q) + (gf₁ : Y' ⟶ X i₁) (gf₂ : Y' ⟶ X i₂) (hgf₁ : g ≫ f₁ = gf₁) (hgf₂ : g ≫ f₂ = gf₂) : + pullHom (pullHom' hom q f₁ f₂ hf₁ hf₂) g gf₁ gf₂ = + pullHom' hom q' gf₁ gf₂ := by + let p := (sq i₁ i₂).isPullback.lift f₁ f₂ (by aesop) + dsimp + rw [pullHom'_eq_pullHom _ _ _ _ _ _ p (by aesop) (by aesop), + pullHom'_eq_pullHom _ _ _ _ _ _ (g ≫ p) (by aesop) (by aesop)] + dsimp [pullHom] + simp only [Functor.map_comp, Category.assoc] + rw [← F.mapComp'_hom_app_comp_mapComp'_hom_app_map_obj_assoc + _ _ _ _ _ _ (by rw [← Quiver.Hom.comp_toLoc, ← op_comp, IsPullback.lift_fst]) rfl + (by rw [← Quiver.Hom.comp_toLoc, ← Quiver.Hom.comp_toLoc, ← op_comp, ← op_comp, + Category.assoc, IsPullback.lift_fst, hgf₁])] + rw [F.map_map_mapComp'_inv_app_comp_mapComp'_inv_app + _ _ _ _ _ _ (by rw [← Quiver.Hom.comp_toLoc, ← op_comp, IsPullback.lift_snd]) rfl + (by rw [← Quiver.Hom.comp_toLoc, ← op_comp, hgf₂]), + mapComp'_inv_naturality_assoc, Iso.hom_inv_id_app_assoc] + +end + +section + +variable {obj : ∀ (i : ι), F.obj (.mk (op (X i)))} + (hom : ∀ (i j : ι), (F.map (sq i j).p₁.op.toLoc).obj (obj i) ⟶ + (F.map (sq i j).p₂.op.toLoc).obj (obj j)) + +@[simp] +lemma pullHom'_p₁_p₂ (i₁ i₂ : ι) : + pullHom' hom (sq i₁ i₂).p (sq i₁ i₂).p₁ (sq i₁ i₂).p₂ (by simp) (by simp) = hom i₁ i₂ := by + rw [pullHom'_eq_pullHom hom (sq i₁ i₂).p (sq i₁ i₂).p₁ (sq i₁ i₂).p₂ (by simp) (by simp) + (𝟙 _) (by simp) (by simp)] + simp [pullHom, mapComp'_comp_id_hom_app, mapComp'_comp_id_inv_app] + +lemma pullHom'_self' (hom_self : ∀ i, pullHom' hom (f i) (𝟙 (X i)) (𝟙 (X i)) = 𝟙 _) + ⦃Y : C⦄ (q : Y ⟶ S) ⦃i : ι⦄ (g : Y ⟶ X i) (hg : g ≫ f i = q) : + pullHom' hom q g g hg hg = 𝟙 _ := by + simp [← pullHom_pullHom' hom g (f i) q hg (𝟙 (X i)) (𝟙 (X i)) (by simp) (by simp) g g + (by simp) (by simp), hom_self, pullHom] + +variable {sq₃} in +@[reassoc] +lemma comp_pullHom'' (hom_comp : ∀ (i₁ i₂ i₃ : ι), + pullHom' hom (sq₃ i₁ i₂ i₃).p (sq₃ i₁ i₂ i₃).p₁ (sq₃ i₁ i₂ i₃).p₂ ≫ + pullHom' hom (sq₃ i₁ i₂ i₃).p (sq₃ i₁ i₂ i₃).p₂ (sq₃ i₁ i₂ i₃).p₃ = + pullHom' hom (sq₃ i₁ i₂ i₃).p (sq₃ i₁ i₂ i₃).p₁ (sq₃ i₁ i₂ i₃).p₃) + ⦃Y : C⦄ (q : Y ⟶ S) ⦃i₁ i₂ i₃ : ι⦄ (f₁ : Y ⟶ X i₁) + (f₂ : Y ⟶ X i₂) (f₃ : Y ⟶ X i₃) (hf₁ : f₁ ≫ f i₁ = q) + (hf₂ : f₂ ≫ f i₂ = q) (hf₃ : f₃ ≫ f i₃ = q) : + pullHom' hom q f₁ f₂ ≫ pullHom' hom q f₂ f₃ = pullHom' hom q f₁ f₃ := by + obtain ⟨φ, _, _, _⟩ := (sq₃ i₁ i₂ i₃).exists_lift f₁ f₂ f₃ q hf₁ hf₂ hf₃ + rw [← pullHom_pullHom'_assoc hom φ (sq₃ i₁ i₂ i₃).p _ _ (sq₃ i₁ i₂ i₃).p₁ (sq₃ i₁ i₂ i₃).p₂, + pullHom, Category.assoc, Category.assoc, + ← pullHom_pullHom' hom φ (sq₃ i₁ i₂ i₃).p _ _ (sq₃ i₁ i₂ i₃).p₂ (sq₃ i₁ i₂ i₃).p₃, + ← pullHom_pullHom' hom φ (sq₃ i₁ i₂ i₃).p _ _ (sq₃ i₁ i₂ i₃).p₁ (sq₃ i₁ i₂ i₃).p₃, + pullHom, pullHom, Iso.inv_hom_id_app_assoc, ← Functor.map_comp_assoc, hom_comp] + all_goals aesop + +end + +end DescentData' + +open DescentData' in + +structure DescentData' where + obj (i : ι) : F.obj (.mk (op (X i))) + hom : ∀ (i j : ι), (F.map (sq i j).p₁.op.toLoc).obj (obj i) ⟶ + (F.map (sq i j).p₂.op.toLoc).obj (obj j) + pullHom'_hom_self : ∀ i, pullHom' hom (f i) (𝟙 (X i)) (𝟙 (X i)) = 𝟙 _ + pullHom'_hom_comp (i₁ i₂ i₃ : ι) : + pullHom' hom (sq₃ i₁ i₂ i₃).p (sq₃ i₁ i₂ i₃).p₁ (sq₃ i₁ i₂ i₃).p₂ ≫ + pullHom' hom (sq₃ i₁ i₂ i₃).p (sq₃ i₁ i₂ i₃).p₂ (sq₃ i₁ i₂ i₃).p₃ = + pullHom' hom (sq₃ i₁ i₂ i₃).p (sq₃ i₁ i₂ i₃).p₁ (sq₃ i₁ i₂ i₃).p₃ + +namespace DescentData' + +variable {F sq sq₃} + +@[simp] +lemma pullHom'_self (D : F.DescentData' sq sq₃) + ⦃Y : C⦄ (q : Y ⟶ S) ⦃i : ι⦄ (g : Y ⟶ X i) (hg : g ≫ f i = q) : + pullHom' D.hom q g g hg hg = 𝟙 _ := + pullHom'_self' _ D.pullHom'_hom_self _ _ _ + +@[reassoc (attr := simp)] +lemma comp_pullHom' (D : F.DescentData' sq sq₃) + ⦃Y : C⦄ (q : Y ⟶ S) ⦃i₁ i₂ i₃ : ι⦄ (f₁ : Y ⟶ X i₁) + (f₂ : Y ⟶ X i₂) (f₃ : Y ⟶ X i₃) (hf₁ : f₁ ≫ f i₁ = q) + (hf₂ : f₂ ≫ f i₂ = q) (hf₃ : f₃ ≫ f i₃ = q) : + pullHom' D.hom q f₁ f₂ hf₁ hf₂ ≫ pullHom' D.hom q f₂ f₃ hf₂ hf₃ = + pullHom' D.hom q f₁ f₃ hf₁ hf₃ := + comp_pullHom'' _ D.pullHom'_hom_comp _ _ _ _ hf₁ hf₂ hf₃ + +@[ext] +structure Hom (D₁ D₂ : F.DescentData' sq sq₃) where + hom (i : ι) : D₁.obj i ⟶ D₂.obj i + comm (i₁ i₂ : ι) : + (F.map (sq i₁ i₂).p₁.op.toLoc).map (hom i₁) ≫ D₂.hom i₁ i₂ = + D₁.hom i₁ i₂ ≫ (F.map (sq i₁ i₂).p₂.op.toLoc).map (hom i₂) := by aesop_cat + +attribute [reassoc (attr := simp)] Hom.comm + +@[simps] +def Hom.id (D : F.DescentData' sq sq₃) : Hom D D where + hom _ := 𝟙 _ + +@[simps] +def Hom.comp {D₁ D₂ D₃ : F.DescentData' sq sq₃} (f : Hom D₁ D₂) (g : Hom D₂ D₃) : Hom D₁ D₃ where + hom i := f.hom i ≫ g.hom i + +instance : Category (F.DescentData' sq sq₃) where + Hom := Hom + id := Hom.id + comp := Hom.comp + +@[ext] +lemma hom_ext {D₁ D₂ : F.DescentData' sq sq₃} {f g : D₁ ⟶ D₂} + (h : ∀ i, f.hom i = g.hom i) : f = g := + Hom.ext (funext h) + +@[reassoc, simp] +lemma comp_hom {D₁ D₂ D₃ : F.DescentData' sq sq₃} (f : D₁ ⟶ D₂) (g : D₂ ⟶ D₃) (i : ι) : + (f ≫ g).hom i = f.hom i ≫ g.hom i := + rfl + +@[simp] +lemma id_hom (D : F.DescentData' sq sq₃) (i : ι) : + Hom.hom (𝟙 D) i = 𝟙 _ := + rfl + +@[reassoc] +lemma comm {D₁ D₂ : F.DescentData' sq sq₃} (φ : D₁ ⟶ D₂) + ⦃Y : C⦄ (q : Y ⟶ S) ⦃i₁ i₂ : ι⦄ (f₁ : Y ⟶ X i₁) + (f₂ : Y ⟶ X i₂) (hf₁ : f₁ ≫ f i₁ = q) (hf₂ : f₂ ≫ f i₂ = q) : + (F.map f₁.op.toLoc).map (φ.hom i₁) ≫ pullHom' D₂.hom q f₁ f₂ hf₁ hf₂ = + pullHom' D₁.hom q f₁ f₂ hf₁ hf₂ ≫ (F.map f₂.op.toLoc).map (φ.hom i₂) := by + obtain ⟨p, _, _⟩ := (sq i₁ i₂).isPullback.exists_lift f₁ f₂ (by aesop) + rw [← pullHom_pullHom' D₂.hom p (sq i₁ i₂).p q (by aesop) (sq i₁ i₂).p₁ (sq i₁ i₂).p₂ + (by simp) (by simp) f₁ f₂ (by aesop) (by aesop), + ← pullHom_pullHom' D₁.hom p (sq i₁ i₂).p q (by aesop) (sq i₁ i₂).p₁ (sq i₁ i₂).p₂ + (by simp) (by simp) f₁ f₂ (by aesop) (by aesop), pullHom'_p₁_p₂, pullHom'_p₁_p₂] + dsimp only [pullHom] + rw [NatTrans.naturality_assoc] + dsimp + rw [← Functor.map_comp_assoc, φ.comm, Functor.map_comp_assoc, mapComp'_inv_naturality] + simp only [Category.assoc] + +@[simps] +def isoMk {D₁ D₂ : F.DescentData' sq sq₃} (e : ∀ (i : ι), D₁.obj i ≅ D₂.obj i) + (comm : ∀ (i₁ i₂ : ι), (F.map (sq i₁ i₂).p₁.op.toLoc).map (e i₁).hom ≫ D₂.hom i₁ i₂ = + D₁.hom i₁ i₂ ≫ (F.map (sq i₁ i₂).p₂.op.toLoc).map (e i₂).hom := by aesop_cat) : + D₁ ≅ D₂ where + hom := + { hom i := (e i).hom + comm := comm } + inv := + { hom i := (e i).inv + comm i₁ i₂ := by + rw [← cancel_mono ((F.map _).map (e i₂).hom), Category.assoc, + Category.assoc, Iso.map_inv_hom_id, Category.comp_id, + ← cancel_epi ((F.map _).map (e i₁).hom), + Iso.map_hom_inv_id_assoc, comm i₁ i₂] } + +@[simps] +noncomputable def descentData (D : F.DescentData' sq sq₃) : F.DescentData f where + obj := D.obj + hom _ _ _ _ _ _ hf₁ hf₂ := pullHom' D.hom _ _ _ hf₁ hf₂ + pullHom_hom _ _ _ _ _ hq _ _ _ _ _ _ _ _ hgf₁ hgf₂ := + pullHom_pullHom' _ _ _ _ hq _ _ _ _ _ _ hgf₁ hgf₂ + +variable (sq sq₃) in +@[simps] +def ofDescentData (D : F.DescentData f) : F.DescentData' sq sq₃ where + obj := D.obj + hom i₁ i₂ := D.hom (sq i₁ i₂).p (sq i₁ i₂).p₁ (sq i₁ i₂).p₂ + pullHom'_hom_self i := by + obtain ⟨p, h₁, h₂⟩ := (sq i i).isPullback.exists_lift (𝟙 _) (𝟙 _) (by simp) + have : p ≫ (sq i i).p = f i := by rw [← (sq i i).hp₁, reassoc_of% h₁] + rw [pullHom'_eq_pullHom _ _ _ _ _ _ p, D.pullHom_hom _ _ (f i), D.hom_self (f i) (𝟙 _)] + all_goals aesop + pullHom'_hom_comp i₁ i₂ i₃ := by + rw [pullHom'_eq_pullHom _ _ _ _ _ _ (sq₃ i₁ i₂ i₃).p₁₂, + pullHom'_eq_pullHom _ _ _ _ _ _ (sq₃ i₁ i₂ i₃).p₂₃, + pullHom'_eq_pullHom _ _ _ _ _ _ (sq₃ i₁ i₂ i₃).p₁₃, + D.pullHom_hom _ _ (sq₃ i₁ i₂ i₃).p, D.pullHom_hom _ _ (sq₃ i₁ i₂ i₃).p, + D.pullHom_hom _ _ (sq₃ i₁ i₂ i₃).p, + D.hom_comp] + all_goals aesop + +variable (sq sq₃) in +@[simp] +lemma pullHom'_ofDescentData_hom (D : F.DescentData f) + ⦃Y : C⦄ (q : Y ⟶ S) ⦃i₁ i₂ : ι⦄ (f₁ : Y ⟶ X i₁) + (f₂ : Y ⟶ X i₂) (hf₁ : f₁ ≫ f i₁ = q) (hf₂ : f₂ ≫ f i₂ = q): + pullHom' (ofDescentData sq sq₃ D).hom q f₁ f₂ hf₁ hf₂ = D.hom q f₁ f₂ hf₁ hf₂ := by + obtain ⟨p, h₁, h₂⟩ := (sq i₁ i₂).isPullback.exists_lift f₁ f₂ (by aesop) + rw [pullHom'_eq_pullHom _ _ _ _ _ _ p (by aesop) (by aesop)] + dsimp + rw [D.pullHom_hom _ _ _ (by rw [← (sq i₁ i₂).hp₁, reassoc_of% h₁, hf₁]) _ _ + (by simp) (by simp) _ _ h₁ h₂] + +variable (F sq sq₃) + +@[simps] +noncomputable def toDescentDataFunctor : F.DescentData' sq sq₃ ⥤ F.DescentData f where + obj D := D.descentData + map φ := + { hom := φ.hom + comm := comm φ } + +attribute [local simp] DescentData.Hom.comm +@[simps] +noncomputable def fromDescentDataFunctor : F.DescentData f ⥤ F.DescentData' sq sq₃ where + obj D := .ofDescentData _ _ D + map {D₁ D₂} φ := { hom := φ.hom } + +@[simps] +noncomputable def descentDataEquivalence : F.DescentData' sq sq₃ ≌ F.DescentData f where + functor := toDescentDataFunctor _ _ _ + inverse := fromDescentDataFunctor _ _ _ + unitIso := NatIso.ofComponents (fun D ↦ isoMk (fun _ ↦ Iso.refl _)) + counitIso := NatIso.ofComponents (fun D ↦ DescentData.isoMk (fun _ ↦ Iso.refl _)) + +end DescentData' + +end Pseudofunctor + +end CategoryTheory diff --git a/Mathlib/CategoryTheory/Sites/Descent/IsPrestack.lean b/Mathlib/CategoryTheory/Sites/Descent/IsPrestack.lean new file mode 100644 index 00000000000000..0bc157628a372c --- /dev/null +++ b/Mathlib/CategoryTheory/Sites/Descent/IsPrestack.lean @@ -0,0 +1,142 @@ +/- +Copyright (c) 2025 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ +import Mathlib.CategoryTheory.Bicategory.Functor.Cat +import Mathlib.CategoryTheory.Bicategory.LocallyDiscrete +import Mathlib.CategoryTheory.Sites.Sheaf +import Mathlib.CategoryTheory.Sites.Over + +/-! +# Descent of morphisms + +Let `C` be a category and `F : Pseudofunctor (LocallyDiscrete Cᵒᵖ) Cat`. +Given `S : C`, and objects `M` and `N` in `F.obj (.mk (op S))`, +we define a presheaf of types `F.presheafHom M N` on the category `Over S`: +its sections on a object `T : Over S` corresponding to a morphism `p : X ⟶ S` +are the type of morphisms `p^* M ⟶ p^* N`. We shall say that +`F` satisfies the descent of morphisms for a Grothendieck topology `J` +if these presheaves are all sheaves (typeclass `F.HasDescentForMorphisms J`). + +## TODO + +* Relate this notion to the property that for any covering family `f i : X i ⟶ S` +for `J`, the functor `F.obj S` to the category of objects in `F.obj (X i)` for all `i` +equipped with a descent datum is fully faithful. +* Define a typeclass `HasEffectiveDescent` extending `HasDescentOfMorphisms` +by saying that the functors mentionned above are essentially surjective. + +-/ + +universe v' v u' u + +namespace CategoryTheory + +open Opposite Bicategory + +namespace Pseudofunctor + +variable {C : Type u} [Category.{v} C] {F : Pseudofunctor (LocallyDiscrete Cᵒᵖ) Cat.{v', u'}} + +namespace LocallyDiscreteOpToCat + +def pullHom ⦃X₁ X₂ : C⦄ ⦃M₁ : F.obj (.mk (op X₁))⦄ ⦃M₂ : F.obj (.mk (op X₂))⦄ + ⦃Y : C⦄ ⦃f₁ : Y ⟶ X₁⦄ ⦃f₂ : Y ⟶ X₂⦄ + (φ : (F.map f₁.op.toLoc).obj M₁ ⟶ (F.map f₂.op.toLoc).obj M₂) ⦃Y' : C⦄ (g : Y' ⟶ Y) + (gf₁ : Y' ⟶ X₁) (gf₂ : Y' ⟶ X₂) (hgf₁ : g ≫ f₁ = gf₁ := by aesop_cat) + (hgf₂ : g ≫ f₂ = gf₂ := by aesop_cat) : + (F.map gf₁.op.toLoc).obj M₁ ⟶ (F.map gf₂.op.toLoc).obj M₂ := + (F.mapComp' f₁.op.toLoc g.op.toLoc gf₁.op.toLoc (by aesop)).hom.app _ ≫ + (F.map g.op.toLoc).map φ ≫ + (F.mapComp' f₂.op.toLoc g.op.toLoc gf₂.op.toLoc (by aesop)).inv.app _ + +@[reassoc] +lemma map_eq_pullHom + ⦃X₁ X₂ : C⦄ ⦃M₁ : F.obj (.mk (op X₁))⦄ ⦃M₂ : F.obj (.mk (op X₂))⦄ + ⦃Y : C⦄ ⦃f₁ : Y ⟶ X₁⦄ ⦃f₂ : Y ⟶ X₂⦄ + (φ : (F.map f₁.op.toLoc).obj M₁ ⟶ (F.map f₂.op.toLoc).obj M₂) ⦃Y' : C⦄ (g : Y' ⟶ Y) + (gf₁ : Y' ⟶ X₁) (gf₂ : Y' ⟶ X₂) (hgf₁ : g ≫ f₁ = gf₁) + (hgf₂ : g ≫ f₂ = gf₂) : + (F.map g.op.toLoc).map φ = + (F.mapComp' f₁.op.toLoc g.op.toLoc gf₁.op.toLoc (by aesop)).inv.app _ ≫ + pullHom φ g gf₁ gf₂ hgf₁ hgf₂ ≫ + (F.mapComp' f₂.op.toLoc g.op.toLoc gf₂.op.toLoc (by aesop)).hom.app _ := by + simp [pullHom] + +@[simp] +lemma pullHom_id ⦃X₁ X₂ : C⦄ ⦃M₁ : F.obj (.mk (op X₁))⦄ ⦃M₂ : F.obj (.mk (op X₂))⦄ + ⦃Y : C⦄ ⦃f₁ : Y ⟶ X₁⦄ ⦃f₂ : Y ⟶ X₂⦄ + (φ : (F.map f₁.op.toLoc).obj M₁ ⟶ (F.map f₂.op.toLoc).obj M₂) : + pullHom φ (𝟙 _) f₁ f₂ = φ := by + simp [pullHom, mapComp'_comp_id_hom_app, mapComp'_comp_id_inv_app] + +@[simp] +lemma pullHom_pullHom + ⦃X₁ X₂ : C⦄ ⦃M₁ : F.obj (.mk (op X₁))⦄ ⦃M₂ : F.obj (.mk (op X₂))⦄ + ⦃Y : C⦄ ⦃f₁ : Y ⟶ X₁⦄ ⦃f₂ : Y ⟶ X₂⦄ + (φ : (F.map f₁.op.toLoc).obj M₁ ⟶ (F.map f₂.op.toLoc).obj M₂) ⦃Y' : C⦄ (g : Y' ⟶ Y) + (gf₁ : Y' ⟶ X₁) (gf₂ : Y' ⟶ X₂) ⦃Y'' : C⦄ + (g' : Y'' ⟶ Y') (g'f₁ : Y'' ⟶ X₁) (g'f₂ : Y'' ⟶ X₂) + (hgf₁ : g ≫ f₁ = gf₁ := by aesop_cat) + (hgf₂ : g ≫ f₂ = gf₂ := by aesop_cat) + (hg'f₁ : g' ≫ gf₁ = g'f₁ := by aesop_cat) + (hg'f₂ : g' ≫ gf₂ = g'f₂ := by aesop_cat) : + pullHom (pullHom φ g gf₁ gf₂ hgf₁ hgf₂) g' g'f₁ g'f₂ hg'f₁ hg'f₂ = + pullHom φ (g' ≫ g) g'f₁ g'f₂ := by + dsimp [pullHom] + rw [Functor.map_comp_assoc, Functor.map_comp_assoc, + F.map_map_mapComp'_inv_app_comp_mapComp'_inv_app _ _ _ _ _ _ _ rfl (by aesop), + F.mapComp'_hom_app_comp_map_map_mapComp'_hom_app_assoc _ _ _ _ _ _ _ rfl (by aesop), + mapComp'_inv_naturality_assoc, Iso.hom_inv_id_app_assoc] + +end LocallyDiscreteOpToCat + +open LocallyDiscreteOpToCat + +variable (F) {S : C} (M N : F.obj (.mk (op S))) +/-- If `F` is a pseudofunctor from `Cᵒᵖ` to `Cat`, and `M` and `N` are objects in +`F.obj (.mk (op S))`, this is the presheaf of morphisms from `M` to `N`: it sends +an object `T : Over S` corresponding to a morphism `p : X ⟶ S` to the type +of morphisms $$p^* M ⟶ p^* N$$. -/ +@[simps] +def presheafHom : (Over S)ᵒᵖ ⥤ Type v' where + obj T := (F.map (.toLoc T.unop.hom.op)).obj M ⟶ (F.map (.toLoc T.unop.hom.op)).obj N + map {T₁ T₂} p f := pullHom f p.unop.left T₂.unop.hom T₂.unop.hom + +/-- Compatiblity isomorphism of `Pseudofunctor.presheafHom` with the "restrictions". -/ +def overMapCompPresheafHomIso {S' : C} (q : S' ⟶ S) : + (Over.map q).op ⋙ F.presheafHom M N ≅ + F.presheafHom ((F.map (.toLoc q.op)).obj M) ((F.map (.toLoc q.op)).obj N) := + NatIso.ofComponents (fun T ↦ Equiv.toIso (by + letI e := F.mapComp' (.toLoc q.op) (.toLoc T.unop.hom.op) + (.toLoc ((Over.map q).obj T.unop).hom.op) + exact (Iso.homFromEquiv (e.app M)).trans (Iso.homToEquiv (e.app N)))) (by + rintro ⟨T₁⟩ ⟨T₂⟩ ⟨f⟩ + ext g + dsimp [pullHom] + simp only [Category.assoc, Functor.map_comp] + rw [F.mapComp'_inv_app_comp_mapComp'_hom_app_assoc _ _ _ _ _ _ rfl _ rfl, + F.mapComp'_inv_app_comp_mapComp'_hom_app' _ _ _ _ _ _ _ _ rfl]) + +/-- The property that a pseudofunctor `F : Pseudofunctor (LocallyDiscrete Cᵒᵖ) Cat` +satisfies the descent property for morphisms. -/ +class IsPrestack (J : GrothendieckTopology C) : Prop where + isSheaf {S : C} (M N : F.obj (.mk (op S))) : + Presheaf.IsSheaf (J.over S) (F.presheafHom M N) + +variable (J : GrothendieckTopology C) [F.IsPrestack J] + +/-- If `F` is a pseudofunctor from `Cᵒᵖ` to `Cat` which satisfies the descent +of morphisms for a Grothendieck topology `J`, and `M` and `N` are to objects in +`F.obj (.mk (op S))`, this is the esheaf of morphisms from `M` to `N`: it sends +an object `T : Over S` corresponding to a morphism `p : X ⟶ S` to the type +of morphisms $$p^* M ⟶ p^* N$$. -/ +@[simps] +def sheafHom : Sheaf (J.over S) (Type v') where + val := F.presheafHom M N + cond := IsPrestack.isSheaf _ _ + +end Pseudofunctor + +end CategoryTheory diff --git a/Mathlib/CategoryTheory/Sites/Descent/IsStack.lean b/Mathlib/CategoryTheory/Sites/Descent/IsStack.lean new file mode 100644 index 00000000000000..45cf7a199fccbe --- /dev/null +++ b/Mathlib/CategoryTheory/Sites/Descent/IsStack.lean @@ -0,0 +1,173 @@ +/- +Copyright (c) 2025 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou, Christian Merten +-/ +import Mathlib.CategoryTheory.Sites.Descent.DescentData +import Mathlib.CategoryTheory.Sites.Descent.IsPrestack + +/-! +# Effectiveness of descent + +-/ + +universe t w v' v u' u + +namespace CategoryTheory + +open Opposite Limits Bicategory + +-- to be moved +namespace Presieve + +variable {C : Type u} [Category.{v} C] (J : GrothendieckTopology C) + (P : Cᵒᵖ ⥤ Type w) {S : C} {ι : Type t} {S : C} {X : ι → C} (f : ∀ i, X i ⟶ S) + +@[simps] +def Arrows.toCompatible (s : P.obj (op S)) : + Subtype (Arrows.Compatible P f) where + val i := P.map (f i).op s + property i j Y pi pj w := by simp only [← FunctorToTypes.map_comp_apply, ← op_comp, w] + +lemma isSheafFor_ofArrows_iff_bijective_toCompatible : + IsSheafFor P (ofArrows _ f) ↔ Function.Bijective (Arrows.toCompatible P f) := by + constructor + · intro h + constructor + · intro s₁ s₂ hs + simp only [Subtype.ext_iff] at hs + apply h.isSeparatedFor.ext + rintro _ _ ⟨i⟩ + exact congr_fun hs i + · rw [isSheafFor_arrows_iff] at h + rintro ⟨x, hx⟩ + obtain ⟨s, hs⟩ := (h x hx).exists + exact ⟨s, by aesop⟩ + · rw [isSheafFor_arrows_iff] + intro h x hx + apply existsUnique_of_exists_of_unique + · obtain ⟨s, hs⟩ := h.surjective ⟨x, hx⟩ + simp only [Subtype.ext_iff] at hs + exact ⟨s, congr_fun hs⟩ + · intro s₁ s₂ hs i + apply h.injective (by aesop) + +lemma isSheaf_iff_isSheafFor_ofArrows : + Presieve.IsSheaf J P ↔ ∀ ⦃ι : Type max u v⦄ ⦃S : C⦄ ⦃X : ι → C⦄ (f : ∀ i, X i ⟶ S) + (_ : (Sieve.ofArrows _ f) ∈ J S), + IsSheafFor P (ofArrows _ f) := by + constructor + · intro h ι S X f hf + rw [isSheafFor_iff_generate] + exact h _ hf + · intro h S R hR + let X (i : R.arrows.category) : C := i.1.left + let f (i : R.arrows.category) : X i ⟶ S := i.1.hom + have : Presieve.ofArrows _ f = R := by + apply le_antisymm + · rintro _ _ ⟨i⟩ + exact i.2 + · intro _ g hg + rw [Sieve.arrows] at hg + exact ⟨(⟨Over.mk g, hg⟩ : R.arrows.category)⟩ + rw [← this] + apply h + simpa [Sieve.ofArrows, this] + +end Presieve + +namespace Pseudofunctor + +variable {C : Type u} [Category.{v} C] (F : Pseudofunctor (LocallyDiscrete Cᵒᵖ) Cat.{v', u'}) + {ι : Type t} {S : C} {X : ι → C} (f : ∀ i, X i ⟶ S) + +-- to be moved +instance {X Y : C} (f : X ⟶ Y) [IsIso f] (F : Pseudofunctor (LocallyDiscrete C) Cat.{v', u'}) : + (F.map (.toLoc f)).IsEquivalence := by + let e : F.obj (.mk X) ≌ F.obj (.mk Y) := + Equivalence.mk (F.map (.toLoc f)) (F.map (.toLoc (inv f))) + ((F.mapId _).symm ≪≫ F.mapComp' f.toLoc (inv f).toLoc (𝟙 _) (by + rw [← Quiver.Hom.comp_toLoc, IsIso.hom_inv_id, Quiver.Hom.id_toLoc])) + ((F.mapComp' (inv f).toLoc f.toLoc (𝟙 _) (by + rw [← Quiver.Hom.comp_toLoc, IsIso.inv_hom_id, Quiver.Hom.id_toLoc])).symm ≪≫ F.mapId _) + exact e.isEquivalence_functor + +/-- The property that a pseudofunctor `(LocallyDiscrete Cᵒᵖ)` to `Cat` has +effective descent relative to a family of morphisms `f i : X i ⟶ S` in `C`. -/ +abbrev HasEffectiveDescentRelativeTo : Prop := (F.toDescentData f).IsEquivalence + +open LocallyDiscreteOpToCat + +lemma toDescentData_fullyFaithful_iff : + Nonempty (F.toDescentData f).FullyFaithful ↔ + ∀ (M N : F.obj (.mk (op S))), + Presieve.IsSheafFor (F.presheafHom M N) + (Presieve.ofArrows (X := Over.mk (𝟙 S)) (fun (i : ι) ↦ Over.mk (f i)) + (fun (i : ι) ↦ Over.homMk (f i))) := by + trans ∀ (M N : F.obj (.mk (op S))), + Function.Bijective ((F.toDescentData f).map : (M ⟶ N) → _) + · exact ⟨fun ⟨h⟩ ↦ h.map_bijective, fun h ↦ ⟨{ + preimage {M N}:= (Equiv.ofBijective _ (h M N)).invFun + preimage_map := (Equiv.ofBijective _ (h _ _)).left_inv + map_preimage := (Equiv.ofBijective _ (h _ _)).right_inv + }⟩⟩ + · refine forall_congr' (fun M ↦ forall_congr' (fun N ↦ ?_)) + rw [Presieve.isSheafFor_ofArrows_iff_bijective_toCompatible] + let T := Subtype (Presieve.Arrows.Compatible (P := F.presheafHom M N) + (B := Over.mk (𝟙 S)) (X := (fun (i : ι) ↦ Over.mk (f i))) + (fun (i : ι) ↦ Over.homMk (f i))) + let α : ((F.toDescentData f).obj M ⟶ (F.toDescentData f).obj N) ≃ T := { + toFun φ := ⟨fun i ↦ φ.hom i, fun i j Z gi gj w ↦ by + have := φ.comm Z.hom gi.left gj.left (Over.w gi) (Over.w gj) + simp only [Functor.id_obj, toDescentData, DescentData.ofObj_obj, + DescentData.ofObj_hom, Category.assoc] at this + rw [← cancel_mono ((F.mapComp' (f j).op.toLoc gj.left.op.toLoc + Z.hom.op.toLoc (by simp [← Over.w gj])).hom.app N)] + simp [pullHom, this] ⟩ + invFun ψ := + { hom i := ψ.1 i + comm Y q i₁ i₂ f₁ f₂ hf₁ hf₂ := by + have this := ψ.2 i₁ i₂ (Over.mk q) (Over.homMk f₁) (Over.homMk f₂) + (by aesop) + dsimp at this ⊢ + rw [map_eq_pullHom (ψ.1 i₁) f₁ q q (by aesop) (by aesop), + map_eq_pullHom (ψ.1 i₂) f₂ q q (by aesop) (by aesop), this] + simp [toDescentData] } + left_inv _ := rfl + right_inv _ := rfl + } + let β : (M ⟶ N) ≃ (F.presheafHom M N).obj (op (Over.mk (𝟙 S))) := + Equiv.ofBijective _ (Functor.FullyFaithful.map_bijective + (Functor.FullyFaithful.ofFullyFaithful (F.map (.toLoc (𝟙 (op S))))) M N) + have : Function.comp α (F.toDescentData f).map = + (Presieve.Arrows.toCompatible _ _).comp β := by + ext φ i + simp [α, β, pullHom, toDescentData] + rw [← Function.Bijective.of_comp_iff' α.bijective, this, + Function.Bijective.of_comp_iff _ β.bijective] + +class IsStack (J : GrothendieckTopology C) : Prop where + hasEffectiveDescentRelativeTo_of_sieve_mem {S : C} (U : Sieve S) (hU : U ∈ J S) : + F.HasEffectiveDescentRelativeTo (f := fun (i : U.arrows.category) ↦ i.obj.hom) + +lemma hasEffectiveDescentRelativeTo_of_sieve_mem (J : GrothendieckTopology C) + [F.IsStack J] + {S : C} (U : Sieve S) (hU : U ∈ J S) : + F.HasEffectiveDescentRelativeTo (f := fun (i : U.arrows.category) ↦ i.obj.hom) := + IsStack.hasEffectiveDescentRelativeTo_of_sieve_mem _ hU + +instance (J : GrothendieckTopology C) [F.IsStack J] : + F.IsPrestack J where + isSheaf {S} M N := by + rw [isSheaf_iff_isSheaf_of_type] + intro X T hT + let T' : Sieve X.left := Sieve.overEquiv _ T + let f' (i : T'.arrows.category) := i.obj.hom + have : F.HasEffectiveDescentRelativeTo f' := + F.hasEffectiveDescentRelativeTo_of_sieve_mem J T' hT + have := (F.toDescentData_fullyFaithful_iff f').1 ⟨Functor.FullyFaithful.ofFullyFaithful _⟩ + sorry + +end Pseudofunctor + +end CategoryTheory diff --git a/Mathlib/CategoryTheory/Sites/Descent/ModuleCat.lean b/Mathlib/CategoryTheory/Sites/Descent/ModuleCat.lean new file mode 100644 index 00000000000000..a4f62f02e7a2bf --- /dev/null +++ b/Mathlib/CategoryTheory/Sites/Descent/ModuleCat.lean @@ -0,0 +1,20 @@ +import Mathlib.CategoryTheory.Sites.Descent.IsStack +import Mathlib.Algebra.Category.ModuleCat.Pseudofunctor +import Mathlib.RingTheory.Flat.FaithfullyFlat.Algebra + +universe u + +open CategoryTheory + +namespace CommRingCat.moduleCatExtendScalarsPseudofunctor + +-- this is the key statement of faithfully flat descent + +lemma hasEffectiveDescentRelativeTo_of_faithfullyFlat + (A B : Type u) [CommRing A] [CommRing B] [Algebra A B] [Module.FaithfullyFlat A B]: + ((mapLocallyDiscrete (opOpEquivalence CommRingCat.{u}).functor).comp + moduleCatExtendScalarsPseudofunctor).HasEffectiveDescentRelativeTo + (fun (_ : Unit) ↦ (CommRingCat.ofHom (algebraMap A B)).op) := + sorry + +end CommRingCat.moduleCatExtendScalarsPseudofunctor diff --git a/Mathlib/CategoryTheory/Sites/Descent/PullbackStruct.lean b/Mathlib/CategoryTheory/Sites/Descent/PullbackStruct.lean new file mode 100644 index 00000000000000..0021a99c6b2a78 --- /dev/null +++ b/Mathlib/CategoryTheory/Sites/Descent/PullbackStruct.lean @@ -0,0 +1,238 @@ +/- +Copyright (c) 2025 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou, Christian Merten +-/ +import Mathlib.CategoryTheory.Limits.Shapes.Pullback.CommSq + +/-! +# Chosen pullbacks + +-/ + +universe v u + +namespace CategoryTheory + +variable {C : Type u} [Category.{v} C] + +open Limits in +lemma IsPullback.mk' {P X Y Z : C} {fst : P ⟶ X} {snd : P ⟶ Y} {f : X ⟶ Z} {g : Y ⟶ Z} + (w : fst ≫ f = snd ≫ g) (hom_ext : ∀ ⦃T : C⦄ ⦃φ φ' : T ⟶ P⦄ (_ : φ ≫ fst = φ' ≫ fst) + (_ : φ ≫ snd = φ' ≫ snd), φ = φ') (exists_lift : ∀ ⦃T : C⦄ (a : T ⟶ X) (b : T ⟶ Y) + (_ : a ≫ f = b ≫ g), ∃ (l : T ⟶ P), l ≫ fst = a ∧ l ≫ snd = b) : + IsPullback fst snd f g where + w := w + isLimit' := by + let l (s : PullbackCone f g) : s.pt ⟶ P := (exists_lift _ _ s.condition).choose + exact ⟨Limits.PullbackCone.IsLimit.mk _ + (fun s ↦ (exists_lift _ _ s.condition).choose) + (fun s ↦ (exists_lift _ _ s.condition).choose_spec.1) + (fun s ↦ (exists_lift _ _ s.condition).choose_spec.2) + (fun s m h₁ h₂ ↦ hom_ext + (h₁.trans (exists_lift _ _ s.condition).choose_spec.1.symm) + (h₂.trans (exists_lift _ _ s.condition).choose_spec.2.symm))⟩ + +namespace Limits + +structure ChosenPullback {X₁ X₂ S : C} (f₁ : X₁ ⟶ S) (f₂ : X₂ ⟶ S) where + pullback : C + p₁ : pullback ⟶ X₁ + p₂ : pullback ⟶ X₂ + isPullback : IsPullback p₁ p₂ f₁ f₂ + p : pullback ⟶ S := p₁ ≫ f₁ + hp₁ : p₁ ≫ f₁ = p := by aesop_cat + +namespace ChosenPullback + +section + +variable {X₁ X₂ S : C} {f₁ : X₁ ⟶ S} {f₂ : X₂ ⟶ S} + (h : ChosenPullback f₁ f₂) + +@[reassoc] +lemma w : h.p₁ ≫ f₁ = h.p₂ ≫ f₂ := + h.isPullback.w + +lemma commSq : CommSq h.p₁ h.p₂ f₁ f₂ where + w := h.w + +attribute [reassoc (attr := simp)] hp₁ + +@[reassoc (attr := simp)] +lemma hp₂ : h.p₂ ≫ f₂ = h.p := by rw [← h.w, hp₁] + +structure LiftStruct {Y : C} (g₁ : Y ⟶ X₁) (g₂ : Y ⟶ X₂) (b : Y ⟶ S) where + f : Y ⟶ h.pullback + f_p₁ : f ≫ h.p₁ = g₁ + f_p₂ : f ≫ h.p₂ = g₂ + f_p : f ≫ h.p = b + +namespace LiftStruct + +attribute [reassoc (attr := simp)] f_p₁ f_p₂ f_p + +variable {h} {Y : C} {g₁ : Y ⟶ X₁} {g₂ : Y ⟶ X₂} {b : Y ⟶ S} (l : h.LiftStruct g₁ g₂ b) + +include l in +@[reassoc] +lemma w : g₁ ≫ f₁ = g₂ ≫ f₂ := by + simp only [← l.f_p₁, ← l.f_p₂, Category.assoc, h.w] + +instance : Subsingleton (h.LiftStruct g₁ g₂ b) where + allEq := by + rintro ⟨f, f_p₁, f_p₂, _⟩ ⟨f', f'_p₁, f'_p₂, _⟩ + obtain rfl : f = f' := by + apply h.isPullback.hom_ext + · rw [f_p₁, f'_p₁] + · rw [f_p₂, f'_p₂] + rfl + +lemma nonempty (w : g₁ ≫ f₁ = g₂ ≫ f₂) (hf₁ : g₁ ≫ f₁ = b) : + Nonempty (h.LiftStruct g₁ g₂ b) := by + obtain ⟨l, h₁, h₂⟩ := h.isPullback.exists_lift g₁ g₂ w + exact ⟨{ + f := l + f_p₁ := h₁ + f_p₂ := h₂ + f_p := by + rw [← h.hp₁, ← hf₁, reassoc_of% h₁] + }⟩ + +end LiftStruct + +end + +variable {X S : C} {f : X ⟶ S} (h : ChosenPullback f f) + +abbrev Diagonal := h.LiftStruct (𝟙 X) (𝟙 X) f + +instance : Nonempty h.Diagonal := by apply LiftStruct.nonempty <;> aesop + +end ChosenPullback + +variable {X₁ X₂ X₃ S : C} {f₁ : X₁ ⟶ S} {f₂ : X₂ ⟶ S} {f₃ : X₃ ⟶ S} + (h₁₂ : ChosenPullback f₁ f₂) (h₂₃ : ChosenPullback f₂ f₃) (h₁₃ : ChosenPullback f₁ f₃) + +structure ChosenPullback₃ where + chosenPullback : ChosenPullback h₁₂.p₂ h₂₃.p₁ + p : chosenPullback.pullback ⟶ S := chosenPullback.p₁ ≫ h₁₂.p + p₁ : chosenPullback.pullback ⟶ X₁ := chosenPullback.p₁ ≫ h₁₂.p₁ + p₃ : chosenPullback.pullback ⟶ X₃ := chosenPullback.p₂ ≫ h₂₃.p₂ + l : h₁₃.LiftStruct p₁ p₃ p + hp₁ : chosenPullback.p₁ ≫ h₁₂.p₁ = p₁ := by aesop_cat + hp₃ : chosenPullback.p₂ ≫ h₂₃.p₂ = p₃ := by aesop_cat + +namespace ChosenPullback₃ + +variable {h₁₂ h₂₃ h₁₃} (h : ChosenPullback₃ h₁₂ h₂₃ h₁₃) + +def p₁₃ : h.chosenPullback.pullback ⟶ h₁₃.pullback := h.l.f +def p₁₂ : h.chosenPullback.pullback ⟶ h₁₂.pullback := h.chosenPullback.p₁ +def p₂₃ : h.chosenPullback.pullback ⟶ h₂₃.pullback := h.chosenPullback.p₂ +def p₂ : h.chosenPullback.pullback ⟶ X₂ := h.chosenPullback.p + +@[reassoc (attr := simp)] +lemma p₁₂_p₁ : h.p₁₂ ≫ h₁₂.p₁ = h.p₁ := by simp [p₁₂, hp₁] + +@[reassoc (attr := simp)] +lemma p₁₂_p₂ : h.p₁₂ ≫ h₁₂.p₂ = h.p₂ := by simp [p₁₂, p₂] + +@[reassoc (attr := simp)] +lemma p₂₃_p₂ : h.p₂₃ ≫ h₂₃.p₁ = h.p₂ := by simp [p₂₃, p₂] + +@[reassoc (attr := simp)] +lemma p₂₃_p₃ : h.p₂₃ ≫ h₂₃.p₂ = h.p₃ := by simp [p₂₃, hp₃] + +@[reassoc (attr := simp)] +lemma p₁₃_p₁ : h.p₁₃ ≫ h₁₃.p₁ = h.p₁ := by simp [p₁₃, hp₁] + +@[reassoc (attr := simp)] +lemma p₁₃_p₃ : h.p₁₃ ≫ h₁₃.p₂ = h.p₃ := by simp [p₁₃, hp₃] + +@[reassoc (attr := simp)] +lemma w₁ : h.p₁ ≫ f₁ = h.p := by + simpa only [← hp₁, Category.assoc, h₁₃.hp₁, h.l.f_p] using h.l.f_p₁.symm =≫ f₁ + +@[reassoc (attr := simp)] +lemma w₃ : h.p₃ ≫ f₃ = h.p := by + simpa only [← hp₃, Category.assoc, h₁₃.hp₂, h.l.f_p] using h.l.f_p₂.symm =≫ f₃ + +@[reassoc (attr := simp)] +lemma w₂ : h.p₂ ≫ f₂ = h.p := by + rw [← p₂₃_p₂_assoc, h₂₃.w, ← w₃, p₂₃_p₃_assoc] + +@[reassoc (attr := simp)] +lemma p₁₂_p : h.p₁₂ ≫ h₁₂.p = h.p := by + rw [← h₁₂.hp₂, p₁₂_p₂_assoc, w₂] + +@[reassoc (attr := simp)] +lemma p₂₃_p : h.p₂₃ ≫ h₂₃.p = h.p := by + rw [← h₂₃.hp₂, p₂₃_p₃_assoc, w₃] + +@[reassoc (attr := simp)] +lemma p₁₃_p : h.p₁₃ ≫ h₁₃.p = h.p := by + rw [← h₁₃.hp₁, p₁₃_p₁_assoc, w₁] + +lemma p₁₂_eq_lift : h.p₁₂ = h₁₂.isPullback.lift h.p₁ h.p₂ (by simp) := by + apply h₁₂.isPullback.hom_ext <;> simp + +lemma p₂₃_eq_lift : h.p₂₃ = h₂₃.isPullback.lift h.p₂ h.p₃ (by simp) := by + apply h₂₃.isPullback.hom_ext <;> simp + +lemma p₁₃_eq_lift : h.p₁₃ = h₁₃.isPullback.lift h.p₁ h.p₃ (by simp) := by + apply h₁₃.isPullback.hom_ext <;> simp + +lemma exists_lift {Y : C} (g₁ : Y ⟶ X₁) (g₂ : Y ⟶ X₂) (g₃ : Y ⟶ X₃) (b : Y ⟶ S) + (hg₁ : g₁ ≫ f₁ = b) (hg₂ : g₂ ≫ f₂ = b) (hg₃ : g₃ ≫ f₃ = b) : + ∃ (φ : Y ⟶ h.chosenPullback.pullback), φ ≫ h.p₁ = g₁ ∧ φ ≫ h.p₂ = g₂ ∧ φ ≫ h.p₃ = g₃ := by + obtain ⟨φ₁₂, w₁, w₂⟩ := h₁₂.isPullback.exists_lift g₁ g₂ (by aesop) + obtain ⟨φ₂₃, w₂', w₃⟩ := h₂₃.isPullback.exists_lift g₂ g₃ (by aesop) + obtain ⟨φ, w₁₂, w₂₃⟩ := h.chosenPullback.isPullback.exists_lift φ₁₂ φ₂₃ (by aesop) + refine ⟨φ, ?_, ?_, ?_⟩ + · rw [← w₁, ← w₁₂, Category.assoc, ← p₁₂, p₁₂_p₁] + · rw [← w₂, ← w₁₂, Category.assoc, ← p₁₂, p₁₂_p₂] + · rw [← w₃, ← w₂₃, Category.assoc, ← p₂₃, p₂₃_p₃] + +lemma isPullback₂ : IsPullback h.p₁₂ h.p₂₃ h₁₂.p₂ h₂₃.p₁ := h.chosenPullback.isPullback + +lemma hom_ext {Y : C} {φ φ' : Y ⟶ h.chosenPullback.pullback} + (h₁ : φ ≫ h.p₁ = φ' ≫ h.p₁) (h₂ : φ ≫ h.p₂ = φ' ≫ h.p₂) + (h₃ : φ ≫ h.p₃ = φ' ≫ h.p₃) : φ = φ' := by + apply h.isPullback₂.hom_ext + · apply h₁₂.isPullback.hom_ext <;> simpa + · apply h₂₃.isPullback.hom_ext <;> simpa + +lemma isPullback₁ : IsPullback h.p₁₂ h.p₁₃ h₁₂.p₁ h₁₃.p₁ := + .mk' (by simp) (fun _ _ _ h₁ h₂ ↦ by + apply h.hom_ext + · simpa using h₁ =≫ h₁₂.p₁ + · simpa using h₁ =≫ h₁₂.p₂ + · simpa using h₂ =≫ h₁₃.p₂) + (fun _ a b w ↦ by + obtain ⟨φ, hφ₁, hφ₂, hφ₃⟩ := + h.exists_lift (a ≫ h₁₂.p₁) (a ≫ h₁₂.p₂) (b ≫ h₁₃.p₂) _ rfl + (by simp) (by simpa using w.symm =≫ f₁) + refine ⟨φ, ?_, ?_⟩ + · apply h₁₂.isPullback.hom_ext <;> simpa + · apply h₁₃.isPullback.hom_ext <;> aesop) + +lemma isPullback₃ : IsPullback h.p₁₃ h.p₂₃ h₁₃.p₂ h₂₃.p₂ := + .mk' (by simp) (fun _ _ _ h₁ h₂ ↦ by + apply h.hom_ext + · simpa using h₁ =≫ h₁₃.p₁ + · simpa using h₂ =≫ h₂₃.p₁ + · simpa using h₁ =≫ h₁₃.p₂) + (fun _ a b w ↦ by + obtain ⟨φ, hφ₁, hφ₂, hφ₃⟩ := + h.exists_lift (a ≫ h₁₃.p₁) (b ≫ h₂₃.p₁) (a ≫ h₁₃.p₂) _ rfl + (by simpa using w.symm =≫ f₃) (by simp) + refine ⟨φ, ?_, ?_⟩ + · apply h₁₃.isPullback.hom_ext <;> simpa + · apply h₂₃.isPullback.hom_ext <;> aesop) + +end ChosenPullback₃ + +end Limits + +end CategoryTheory