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

! This file was ported from Lean 3 source module category_theory.limits.full_subcategory
! leanprover-community/mathlib commit f47581155c818e6361af4e4fda60d27d020c226b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Limits.Creates

/-!
# Limits in full subcategories

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

We introduce the notion of a property closed under taking limits and show that if `P` is closed
under taking limits, then limits in `full_subcategory P` can be constructed from limits in `C`.
More precisely, the inclusion creates such limits.

-/

noncomputable section

universe w' w v u

open CategoryTheory

namespace CategoryTheory.Limits

#print CategoryTheory.Limits.ClosedUnderLimitsOfShape /-
/-- We say that a property is closed under limits of shape `J` if whenever all objects in a
    `J`-shaped diagram have the property, any limit of this diagram also has the property. -/
def ClosedUnderLimitsOfShape {C : Type u} [Category.{v} C] (J : Type w) [Category.{w'} J]
    (P : C → Prop) : Prop :=
  ∀ ⦃F : J ⥤ C⦄ ⦃c : Cone F⦄ (hc : IsLimit c), (∀ j, P (F.obj j)) → P c.pt
#align category_theory.limits.closed_under_limits_of_shape CategoryTheory.Limits.ClosedUnderLimitsOfShape
-/

#print CategoryTheory.Limits.ClosedUnderColimitsOfShape /-
/-- We say that a property is closed under colimits of shape `J` if whenever all objects in a
    `J`-shaped diagram have the property, any colimit of this diagram also has the property. -/
def ClosedUnderColimitsOfShape {C : Type u} [Category.{v} C] (J : Type w) [Category.{w'} J]
    (P : C → Prop) : Prop :=
  ∀ ⦃F : J ⥤ C⦄ ⦃c : Cocone F⦄ (hc : IsColimit c), (∀ j, P (F.obj j)) → P c.pt
#align category_theory.limits.closed_under_colimits_of_shape CategoryTheory.Limits.ClosedUnderColimitsOfShape
-/

section

variable {C : Type u} [Category.{v} C] {J : Type w} [Category.{w'} J] {P : C → Prop}

/- warning: category_theory.limits.closed_under_limits_of_shape.limit -> CategoryTheory.Limits.ClosedUnderLimitsOfShape.limit is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u3, u4} C] {J : Type.{u2}} [_inst_2 : CategoryTheory.Category.{u1, u2} J] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderLimitsOfShape.{u1, u2, u3, u4} C _inst_1 J _inst_2 P) -> (forall {F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_2 C _inst_1} [_inst_3 : CategoryTheory.Limits.HasLimit.{u1, u2, u3, u4} J _inst_2 C _inst_1 F], (forall (j : J), P (CategoryTheory.Functor.obj.{u1, u3, u2, u4} J _inst_2 C _inst_1 F j)) -> (P (CategoryTheory.Limits.limit.{u1, u2, u3, u4} J _inst_2 C _inst_1 F _inst_3)))
but is expected to have type
  forall {C : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u3, u4} C] {J : Type.{u2}} [_inst_2 : CategoryTheory.Category.{u1, u2} J] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderLimitsOfShape.{u1, u2, u3, u4} C _inst_1 J _inst_2 P) -> (forall {F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_2 C _inst_1} [_inst_3 : CategoryTheory.Limits.HasLimit.{u1, u2, u3, u4} J _inst_2 C _inst_1 F], (forall (j : J), P (Prefunctor.obj.{succ u1, succ u3, u2, u4} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} J (CategoryTheory.Category.toCategoryStruct.{u1, u2} J _inst_2)) C (CategoryTheory.CategoryStruct.toQuiver.{u3, u4} C (CategoryTheory.Category.toCategoryStruct.{u3, u4} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{u1, u3, u2, u4} J _inst_2 C _inst_1 F) j)) -> (P (CategoryTheory.Limits.limit.{u1, u2, u3, u4} J _inst_2 C _inst_1 F _inst_3)))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.closed_under_limits_of_shape.limit CategoryTheory.Limits.ClosedUnderLimitsOfShape.limitₓ'. -/
theorem ClosedUnderLimitsOfShape.limit (h : ClosedUnderLimitsOfShape J P) {F : J ⥤ C} [HasLimit F] :
    (∀ j, P (F.obj j)) → P (limit F) :=
  h (limit.isLimit _)
#align category_theory.limits.closed_under_limits_of_shape.limit CategoryTheory.Limits.ClosedUnderLimitsOfShape.limit

/- warning: category_theory.limits.closed_under_colimits_of_shape.colimit -> CategoryTheory.Limits.ClosedUnderColimitsOfShape.colimit is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u3, u4} C] {J : Type.{u2}} [_inst_2 : CategoryTheory.Category.{u1, u2} J] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderColimitsOfShape.{u1, u2, u3, u4} C _inst_1 J _inst_2 P) -> (forall {F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_2 C _inst_1} [_inst_3 : CategoryTheory.Limits.HasColimit.{u1, u2, u3, u4} J _inst_2 C _inst_1 F], (forall (j : J), P (CategoryTheory.Functor.obj.{u1, u3, u2, u4} J _inst_2 C _inst_1 F j)) -> (P (CategoryTheory.Limits.colimit.{u1, u2, u3, u4} J _inst_2 C _inst_1 F _inst_3)))
but is expected to have type
  forall {C : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u3, u4} C] {J : Type.{u2}} [_inst_2 : CategoryTheory.Category.{u1, u2} J] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderColimitsOfShape.{u1, u2, u3, u4} C _inst_1 J _inst_2 P) -> (forall {F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_2 C _inst_1} [_inst_3 : CategoryTheory.Limits.HasColimit.{u1, u2, u3, u4} J _inst_2 C _inst_1 F], (forall (j : J), P (Prefunctor.obj.{succ u1, succ u3, u2, u4} J (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} J (CategoryTheory.Category.toCategoryStruct.{u1, u2} J _inst_2)) C (CategoryTheory.CategoryStruct.toQuiver.{u3, u4} C (CategoryTheory.Category.toCategoryStruct.{u3, u4} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{u1, u3, u2, u4} J _inst_2 C _inst_1 F) j)) -> (P (CategoryTheory.Limits.colimit.{u1, u2, u3, u4} J _inst_2 C _inst_1 F _inst_3)))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.closed_under_colimits_of_shape.colimit CategoryTheory.Limits.ClosedUnderColimitsOfShape.colimitₓ'. -/
theorem ClosedUnderColimitsOfShape.colimit (h : ClosedUnderColimitsOfShape J P) {F : J ⥤ C}
    [HasColimit F] : (∀ j, P (F.obj j)) → P (colimit F) :=
  h (colimit.isColimit _)
#align category_theory.limits.closed_under_colimits_of_shape.colimit CategoryTheory.Limits.ClosedUnderColimitsOfShape.colimit

end

section

variable {J : Type w} [Category.{w'} J] {C : Type u} [Category.{v} C] {P : C → Prop}

/- warning: category_theory.limits.creates_limit_full_subcategory_inclusion' -> CategoryTheory.Limits.createsLimitFullSubcategoryInclusion' is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop} (F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P)) {c : CategoryTheory.Limits.Cone.{u1, u3, u2, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))}, (CategoryTheory.Limits.IsLimit.{u1, u3, u2, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P)) c) -> (P (CategoryTheory.Limits.Cone.pt.{u1, u3, u2, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P)) c)) -> (CategoryTheory.CreatesLimit.{u1, u2, u3, u3, u4, u4} (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 J _inst_1 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop} (F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P)) {c : CategoryTheory.Limits.Cone.{u1, u3, u2, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))}, (CategoryTheory.Limits.IsLimit.{u1, u3, u2, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P)) c) -> (P (CategoryTheory.Limits.Cone.pt.{u1, u3, u2, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P)) c)) -> (CategoryTheory.CreatesLimit.{u1, u2, u3, u3, u4, u4} (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 J _inst_1 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.creates_limit_full_subcategory_inclusion' CategoryTheory.Limits.createsLimitFullSubcategoryInclusion'ₓ'. -/
/-- If a `J`-shaped diagram in `full_subcategory P` has a limit cone in `C` whose cone point lives
    in the full subcategory, then this defines a limit in the full subcategory. -/
def createsLimitFullSubcategoryInclusion' (F : J ⥤ FullSubcategory P)
    {c : Cone (F ⋙ fullSubcategoryInclusion P)} (hc : IsLimit c) (h : P c.pt) :
    CreatesLimit F (fullSubcategoryInclusion P) :=
  createsLimitOfFullyFaithfulOfIso' hc ⟨_, h⟩ (Iso.refl _)
#align category_theory.limits.creates_limit_full_subcategory_inclusion' CategoryTheory.Limits.createsLimitFullSubcategoryInclusion'

/- warning: category_theory.limits.creates_limit_full_subcategory_inclusion -> CategoryTheory.Limits.createsLimitFullSubcategoryInclusion is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop} (F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P)) [_inst_3 : CategoryTheory.Limits.HasLimit.{u1, u2, u3, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))], (P (CategoryTheory.Limits.limit.{u1, u2, u3, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P)) _inst_3)) -> (CategoryTheory.CreatesLimit.{u1, u2, u3, u3, u4, u4} (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 J _inst_1 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop} (F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P)) [_inst_3 : CategoryTheory.Limits.HasLimit.{u1, u2, u3, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))], (P (CategoryTheory.Limits.limit.{u1, u2, u3, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P)) _inst_3)) -> (CategoryTheory.CreatesLimit.{u1, u2, u3, u3, u4, u4} (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 J _inst_1 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.creates_limit_full_subcategory_inclusion CategoryTheory.Limits.createsLimitFullSubcategoryInclusionₓ'. -/
/-- If a `J`-shaped diagram in `full_subcategory P` has a limit in `C` whose cone point lives in the
    full subcategory, then this defines a limit in the full subcategory. -/
def createsLimitFullSubcategoryInclusion (F : J ⥤ FullSubcategory P)
    [HasLimit (F ⋙ fullSubcategoryInclusion P)] (h : P (limit (F ⋙ fullSubcategoryInclusion P))) :
    CreatesLimit F (fullSubcategoryInclusion P) :=
  createsLimitFullSubcategoryInclusion' F (limit.isLimit _) h
#align category_theory.limits.creates_limit_full_subcategory_inclusion CategoryTheory.Limits.createsLimitFullSubcategoryInclusion

/- warning: category_theory.limits.creates_colimit_full_subcategory_inclusion' -> CategoryTheory.Limits.createsColimitFullSubcategoryInclusion' is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop} (F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P)) {c : CategoryTheory.Limits.Cocone.{u1, u3, u2, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))}, (CategoryTheory.Limits.IsColimit.{u1, u3, u2, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P)) c) -> (P (CategoryTheory.Limits.Cocone.pt.{u1, u3, u2, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P)) c)) -> (CategoryTheory.CreatesColimit.{u1, u2, u3, u3, u4, u4} (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 J _inst_1 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop} (F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P)) {c : CategoryTheory.Limits.Cocone.{u1, u3, u2, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))}, (CategoryTheory.Limits.IsColimit.{u1, u3, u2, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P)) c) -> (P (CategoryTheory.Limits.Cocone.pt.{u1, u3, u2, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P)) c)) -> (CategoryTheory.CreatesColimit.{u1, u2, u3, u3, u4, u4} (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 J _inst_1 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.creates_colimit_full_subcategory_inclusion' CategoryTheory.Limits.createsColimitFullSubcategoryInclusion'ₓ'. -/
/-- If a `J`-shaped diagram in `full_subcategory P` has a colimit cocone in `C` whose cocone point
    lives in the full subcategory, then this defines a colimit in the full subcategory. -/
def createsColimitFullSubcategoryInclusion' (F : J ⥤ FullSubcategory P)
    {c : Cocone (F ⋙ fullSubcategoryInclusion P)} (hc : IsColimit c) (h : P c.pt) :
    CreatesColimit F (fullSubcategoryInclusion P) :=
  createsColimitOfFullyFaithfulOfIso' hc ⟨_, h⟩ (Iso.refl _)
#align category_theory.limits.creates_colimit_full_subcategory_inclusion' CategoryTheory.Limits.createsColimitFullSubcategoryInclusion'

/- warning: category_theory.limits.creates_colimit_full_subcategory_inclusion -> CategoryTheory.Limits.createsColimitFullSubcategoryInclusion is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop} (F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P)) [_inst_3 : CategoryTheory.Limits.HasColimit.{u1, u2, u3, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))], (P (CategoryTheory.Limits.colimit.{u1, u2, u3, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P)) _inst_3)) -> (CategoryTheory.CreatesColimit.{u1, u2, u3, u3, u4, u4} (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 J _inst_1 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop} (F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P)) [_inst_3 : CategoryTheory.Limits.HasColimit.{u1, u2, u3, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))], (P (CategoryTheory.Limits.colimit.{u1, u2, u3, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P)) _inst_3)) -> (CategoryTheory.CreatesColimit.{u1, u2, u3, u3, u4, u4} (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 J _inst_1 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.creates_colimit_full_subcategory_inclusion CategoryTheory.Limits.createsColimitFullSubcategoryInclusionₓ'. -/
/-- If a `J`-shaped diagram in `full_subcategory P` has a colimit in `C` whose cocone point lives in
    the full subcategory, then this defines a colimit in the full subcategory. -/
def createsColimitFullSubcategoryInclusion (F : J ⥤ FullSubcategory P)
    [HasColimit (F ⋙ fullSubcategoryInclusion P)]
    (h : P (colimit (F ⋙ fullSubcategoryInclusion P))) :
    CreatesColimit F (fullSubcategoryInclusion P) :=
  createsColimitFullSubcategoryInclusion' F (colimit.isColimit _) h
#align category_theory.limits.creates_colimit_full_subcategory_inclusion CategoryTheory.Limits.createsColimitFullSubcategoryInclusion

/- warning: category_theory.limits.creates_limit_full_subcategory_inclusion_of_closed -> CategoryTheory.Limits.createsLimitFullSubcategoryInclusionOfClosed is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderLimitsOfShape.{u1, u2, u3, u4} C _inst_2 J _inst_1 P) -> (forall (F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P)) [_inst_3 : CategoryTheory.Limits.HasLimit.{u1, u2, u3, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))], CategoryTheory.CreatesLimit.{u1, u2, u3, u3, u4, u4} (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 J _inst_1 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderLimitsOfShape.{u1, u2, u3, u4} C _inst_2 J _inst_1 P) -> (forall (F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P)) [_inst_3 : CategoryTheory.Limits.HasLimit.{u1, u2, u3, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))], CategoryTheory.CreatesLimit.{u1, u2, u3, u3, u4, u4} (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 J _inst_1 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.creates_limit_full_subcategory_inclusion_of_closed CategoryTheory.Limits.createsLimitFullSubcategoryInclusionOfClosedₓ'. -/
/-- If `P` is closed under limits of shape `J`, then the inclusion creates such limits. -/
def createsLimitFullSubcategoryInclusionOfClosed (h : ClosedUnderLimitsOfShape J P)
    (F : J ⥤ FullSubcategory P) [HasLimit (F ⋙ fullSubcategoryInclusion P)] :
    CreatesLimit F (fullSubcategoryInclusion P) :=
  createsLimitFullSubcategoryInclusion F (h.limit fun j => (F.obj j).property)
#align category_theory.limits.creates_limit_full_subcategory_inclusion_of_closed CategoryTheory.Limits.createsLimitFullSubcategoryInclusionOfClosed

/- warning: category_theory.limits.creates_limits_of_shape_full_subcategory_inclusion -> CategoryTheory.Limits.createsLimitsOfShapeFullSubcategoryInclusion is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderLimitsOfShape.{u1, u2, u3, u4} C _inst_2 J _inst_1 P) -> (forall [_inst_3 : CategoryTheory.Limits.HasLimitsOfShape.{u1, u2, u3, u4} J _inst_1 C _inst_2], CategoryTheory.CreatesLimitsOfShape.{u1, u2, u3, u3, u4, u4} (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.InducedCategory.category.{u3, u4, u4} (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) C _inst_2 (CategoryTheory.FullSubcategoryₓ.obj.{u3, u4} C _inst_2 P)) C _inst_2 J _inst_1 (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderLimitsOfShape.{u1, u2, u3, u4} C _inst_2 J _inst_1 P) -> (forall [_inst_3 : CategoryTheory.Limits.HasLimitsOfShape.{u1, u2, u3, u4} J _inst_1 C _inst_2], CategoryTheory.CreatesLimitsOfShape.{u1, u2, u3, u3, u4, u4} (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 J _inst_1 (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.creates_limits_of_shape_full_subcategory_inclusion CategoryTheory.Limits.createsLimitsOfShapeFullSubcategoryInclusionₓ'. -/
/-- If `P` is closed under limits of shape `J`, then the inclusion creates such limits. -/
def createsLimitsOfShapeFullSubcategoryInclusion (h : ClosedUnderLimitsOfShape J P)
    [HasLimitsOfShape J C] : CreatesLimitsOfShape J (fullSubcategoryInclusion P)
    where CreatesLimit F := createsLimitFullSubcategoryInclusionOfClosed h F
#align category_theory.limits.creates_limits_of_shape_full_subcategory_inclusion CategoryTheory.Limits.createsLimitsOfShapeFullSubcategoryInclusion

/- warning: category_theory.limits.has_limit_of_closed_under_limits -> CategoryTheory.Limits.hasLimit_of_closed_under_limits is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderLimitsOfShape.{u1, u2, u3, u4} C _inst_2 J _inst_1 P) -> (forall (F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P)) [_inst_3 : CategoryTheory.Limits.HasLimit.{u1, u2, u3, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))], CategoryTheory.Limits.HasLimit.{u1, u2, u3, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) F)
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderLimitsOfShape.{u1, u2, u3, u4} C _inst_2 J _inst_1 P) -> (forall (F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P)) [_inst_3 : CategoryTheory.Limits.HasLimit.{u1, u2, u3, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))], CategoryTheory.Limits.HasLimit.{u1, u2, u3, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) F)
Case conversion may be inaccurate. Consider using '#align category_theory.limits.has_limit_of_closed_under_limits CategoryTheory.Limits.hasLimit_of_closed_under_limitsₓ'. -/
theorem hasLimit_of_closed_under_limits (h : ClosedUnderLimitsOfShape J P)
    (F : J ⥤ FullSubcategory P) [HasLimit (F ⋙ fullSubcategoryInclusion P)] : HasLimit F :=
  have : CreatesLimit F (fullSubcategoryInclusion P) :=
    createsLimitFullSubcategoryInclusionOfClosed h F
  has_limit_of_created F (full_subcategory_inclusion P)
#align category_theory.limits.has_limit_of_closed_under_limits CategoryTheory.Limits.hasLimit_of_closed_under_limits

/- warning: category_theory.limits.has_limits_of_shape_of_closed_under_limits -> CategoryTheory.Limits.hasLimitsOfShape_of_closed_under_limits is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderLimitsOfShape.{u1, u2, u3, u4} C _inst_2 J _inst_1 P) -> (forall [_inst_3 : CategoryTheory.Limits.HasLimitsOfShape.{u1, u2, u3, u4} J _inst_1 C _inst_2], CategoryTheory.Limits.HasLimitsOfShape.{u1, u2, u3, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P))
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderLimitsOfShape.{u1, u2, u3, u4} C _inst_2 J _inst_1 P) -> (forall [_inst_3 : CategoryTheory.Limits.HasLimitsOfShape.{u1, u2, u3, u4} J _inst_1 C _inst_2], CategoryTheory.Limits.HasLimitsOfShape.{u1, u2, u3, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.has_limits_of_shape_of_closed_under_limits CategoryTheory.Limits.hasLimitsOfShape_of_closed_under_limitsₓ'. -/
theorem hasLimitsOfShape_of_closed_under_limits (h : ClosedUnderLimitsOfShape J P)
    [HasLimitsOfShape J C] : HasLimitsOfShape J (FullSubcategory P) :=
  { HasLimit := fun F => hasLimit_of_closed_under_limits h F }
#align category_theory.limits.has_limits_of_shape_of_closed_under_limits CategoryTheory.Limits.hasLimitsOfShape_of_closed_under_limits

/- warning: category_theory.limits.creates_colimit_full_subcategory_inclusion_of_closed -> CategoryTheory.Limits.createsColimitFullSubcategoryInclusionOfClosed is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderColimitsOfShape.{u1, u2, u3, u4} C _inst_2 J _inst_1 P) -> (forall (F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P)) [_inst_3 : CategoryTheory.Limits.HasColimit.{u1, u2, u3, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))], CategoryTheory.CreatesColimit.{u1, u2, u3, u3, u4, u4} (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 J _inst_1 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderColimitsOfShape.{u1, u2, u3, u4} C _inst_2 J _inst_1 P) -> (forall (F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P)) [_inst_3 : CategoryTheory.Limits.HasColimit.{u1, u2, u3, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))], CategoryTheory.CreatesColimit.{u1, u2, u3, u3, u4, u4} (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 J _inst_1 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.creates_colimit_full_subcategory_inclusion_of_closed CategoryTheory.Limits.createsColimitFullSubcategoryInclusionOfClosedₓ'. -/
/-- If `P` is closed under colimits of shape `J`, then the inclusion creates such colimits. -/
def createsColimitFullSubcategoryInclusionOfClosed (h : ClosedUnderColimitsOfShape J P)
    (F : J ⥤ FullSubcategory P) [HasColimit (F ⋙ fullSubcategoryInclusion P)] :
    CreatesColimit F (fullSubcategoryInclusion P) :=
  createsColimitFullSubcategoryInclusion F (h.colimit fun j => (F.obj j).property)
#align category_theory.limits.creates_colimit_full_subcategory_inclusion_of_closed CategoryTheory.Limits.createsColimitFullSubcategoryInclusionOfClosed

/- warning: category_theory.limits.creates_colimits_of_shape_full_subcategory_inclusion -> CategoryTheory.Limits.createsColimitsOfShapeFullSubcategoryInclusion is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderColimitsOfShape.{u1, u2, u3, u4} C _inst_2 J _inst_1 P) -> (forall [_inst_3 : CategoryTheory.Limits.HasColimitsOfShape.{u1, u2, u3, u4} J _inst_1 C _inst_2], CategoryTheory.CreatesColimitsOfShape.{u1, u2, u3, u3, u4, u4} (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.InducedCategory.category.{u3, u4, u4} (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) C _inst_2 (CategoryTheory.FullSubcategoryₓ.obj.{u3, u4} C _inst_2 P)) C _inst_2 J _inst_1 (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderColimitsOfShape.{u1, u2, u3, u4} C _inst_2 J _inst_1 P) -> (forall [_inst_3 : CategoryTheory.Limits.HasColimitsOfShape.{u1, u2, u3, u4} J _inst_1 C _inst_2], CategoryTheory.CreatesColimitsOfShape.{u1, u2, u3, u3, u4, u4} (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 J _inst_1 (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.creates_colimits_of_shape_full_subcategory_inclusion CategoryTheory.Limits.createsColimitsOfShapeFullSubcategoryInclusionₓ'. -/
/-- If `P` is closed under colimits of shape `J`, then the inclusion creates such colimits. -/
def createsColimitsOfShapeFullSubcategoryInclusion (h : ClosedUnderColimitsOfShape J P)
    [HasColimitsOfShape J C] : CreatesColimitsOfShape J (fullSubcategoryInclusion P)
    where CreatesColimit F := createsColimitFullSubcategoryInclusionOfClosed h F
#align category_theory.limits.creates_colimits_of_shape_full_subcategory_inclusion CategoryTheory.Limits.createsColimitsOfShapeFullSubcategoryInclusion

/- warning: category_theory.limits.has_colimit_of_closed_under_colimits -> CategoryTheory.Limits.hasColimit_of_closed_under_colimits is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderColimitsOfShape.{u1, u2, u3, u4} C _inst_2 J _inst_1 P) -> (forall (F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P)) [_inst_3 : CategoryTheory.Limits.HasColimit.{u1, u2, u3, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))], CategoryTheory.Limits.HasColimit.{u1, u2, u3, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) F)
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderColimitsOfShape.{u1, u2, u3, u4} C _inst_2 J _inst_1 P) -> (forall (F : CategoryTheory.Functor.{u1, u3, u2, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P)) [_inst_3 : CategoryTheory.Limits.HasColimit.{u1, u2, u3, u4} J _inst_1 C _inst_2 (CategoryTheory.Functor.comp.{u1, u3, u3, u2, u4, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) C _inst_2 F (CategoryTheory.fullSubcategoryInclusion.{u3, u4} C _inst_2 P))], CategoryTheory.Limits.HasColimit.{u1, u2, u3, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P) F)
Case conversion may be inaccurate. Consider using '#align category_theory.limits.has_colimit_of_closed_under_colimits CategoryTheory.Limits.hasColimit_of_closed_under_colimitsₓ'. -/
theorem hasColimit_of_closed_under_colimits (h : ClosedUnderColimitsOfShape J P)
    (F : J ⥤ FullSubcategory P) [HasColimit (F ⋙ fullSubcategoryInclusion P)] : HasColimit F :=
  have : CreatesColimit F (fullSubcategoryInclusion P) :=
    createsColimitFullSubcategoryInclusionOfClosed h F
  has_colimit_of_created F (full_subcategory_inclusion P)
#align category_theory.limits.has_colimit_of_closed_under_colimits CategoryTheory.Limits.hasColimit_of_closed_under_colimits

/- warning: category_theory.limits.has_colimits_of_shape_of_closed_under_colimits -> CategoryTheory.Limits.hasColimitsOfShape_of_closed_under_colimits is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderColimitsOfShape.{u1, u2, u3, u4} C _inst_2 J _inst_1 P) -> (forall [_inst_3 : CategoryTheory.Limits.HasColimitsOfShape.{u1, u2, u3, u4} J _inst_1 C _inst_2], CategoryTheory.Limits.HasColimitsOfShape.{u1, u2, u3, u4} J _inst_1 (CategoryTheory.FullSubcategoryₓ.{u3, u4} C _inst_2 P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P))
but is expected to have type
  forall {J : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} J] {C : Type.{u4}} [_inst_2 : CategoryTheory.Category.{u3, u4} C] {P : C -> Prop}, (CategoryTheory.Limits.ClosedUnderColimitsOfShape.{u1, u2, u3, u4} C _inst_2 J _inst_1 P) -> (forall [_inst_3 : CategoryTheory.Limits.HasColimitsOfShape.{u1, u2, u3, u4} J _inst_1 C _inst_2], CategoryTheory.Limits.HasColimitsOfShape.{u1, u2, u3, u4} J _inst_1 (CategoryTheory.FullSubcategory.{u4} C P) (CategoryTheory.FullSubcategory.category.{u3, u4} C _inst_2 P))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.has_colimits_of_shape_of_closed_under_colimits CategoryTheory.Limits.hasColimitsOfShape_of_closed_under_colimitsₓ'. -/
theorem hasColimitsOfShape_of_closed_under_colimits (h : ClosedUnderColimitsOfShape J P)
    [HasColimitsOfShape J C] : HasColimitsOfShape J (FullSubcategory P) :=
  { HasColimit := fun F => hasColimit_of_closed_under_colimits h F }
#align category_theory.limits.has_colimits_of_shape_of_closed_under_colimits CategoryTheory.Limits.hasColimitsOfShape_of_closed_under_colimits

end

end CategoryTheory.Limits


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

import category_theory.over
import category_theory.limits.shapes.finite_limits
import category_theory.yoneda
import order.complete_lattice
import data.set.lattice

/-!
# Theory of sieves

- For an object `X` of a category `C`, a `sieve X` is a set of morphisms to `X`
  which is closed under left-composition.
- The complete lattice structure on sieves is given, as well as the Galois insertion
  given by downward-closing.
- A `sieve X` (functorially) induces a presheaf on `C` together with a monomorphism to
  the yoneda embedding of `X`.

## Tags

sieve, pullback
-/

universes v u
namespace category_theory

open category limits

variables {C : Type u} [category.{v} C]
variables {X Y Z : C} (f : Y ⟶ X)

/-- A set of arrows all with codomain `X`. -/
@[derive complete_lattice]
def presieve (X : C) := Π ⦃Y⦄, set (Y ⟶ X)

namespace presieve

instance : inhabited (presieve X) := ⟨⊤⟩

/--
Given a set of arrows `S` all with codomain `X`, and a set of arrows with codomain `Y` for each
`f : Y ⟶ X` in `S`, produce a set of arrows with codomain `X`:
`{ g ≫ f | (f : Y ⟶ X) ∈ S, (g : Z ⟶ Y) ∈ R f }`.
-/
def bind (S : presieve X) (R : Π ⦃Y⦄ ⦃f : Y ⟶ X⦄, S f → presieve Y) :
  presieve X :=
λ Z h, ∃ (Y : C) (g : Z ⟶ Y) (f : Y ⟶ X) (H : S f), R H g ∧ g ≫ f = h

@[simp]
lemma bind_comp {S : presieve X}
  {R : Π ⦃Y : C⦄ ⦃f : Y ⟶ X⦄, S f → presieve Y} {g : Z ⟶ Y} (h₁ : S f) (h₂ : R h₁ g) :
bind S R (g ≫ f) :=
⟨_, _, _, h₁, h₂, rfl⟩

/-- The singleton presieve.  -/
-- Note we can't make this into `has_singleton` because of the out-param.
inductive singleton : presieve X
| mk : singleton f

@[simp] lemma singleton_eq_iff_domain (f g : Y ⟶ X) : singleton f g ↔ f = g :=
begin
  split,
  { rintro ⟨a, rfl⟩,
    refl },
  { rintro rfl,
    apply singleton.mk, }
end

lemma singleton_self : singleton f f := singleton.mk

/--
Pullback a set of arrows with given codomain along a fixed map, by taking the pullback in the
category.
This is not the same as the arrow set of `sieve.pullback`, but there is a relation between them
in `pullback_arrows_comm`.
-/
inductive pullback_arrows [has_pullbacks C] (R : presieve X) :
  presieve Y
| mk (Z : C) (h : Z ⟶ X) : R h → pullback_arrows (pullback.snd : pullback h f ⟶ Y)

lemma pullback_singleton [has_pullbacks C] (g : Z ⟶ X) :
 pullback_arrows f (singleton g) = singleton (pullback.snd : pullback g f ⟶ _) :=
begin
  ext W h,
  split,
  { rintro ⟨W, _, _, _⟩,
    exact singleton.mk },
  { rintro ⟨_⟩,
    exact pullback_arrows.mk Z g singleton.mk }
end

/-- Construct the presieve given by the family of arrows indexed by `ι`. -/
inductive of_arrows {ι : Type*} (Y : ι → C) (f : Π i, Y i ⟶ X) : presieve X
| mk (i : ι) : of_arrows (f i)

lemma of_arrows_punit :
  of_arrows _ (λ _ : punit, f) = singleton f :=
begin
  ext Y g,
  split,
  { rintro ⟨_⟩,
    apply singleton.mk },
  { rintro ⟨_⟩,
    exact of_arrows.mk punit.star },
end

lemma of_arrows_pullback [has_pullbacks C] {ι : Type*}
  (Z : ι → C) (g : Π (i : ι), Z i ⟶ X) :
  of_arrows (λ i, pullback (g i) f) (λ i, pullback.snd) =
    pullback_arrows f (of_arrows Z g) :=
begin
  ext T h,
  split,
  { rintro ⟨hk⟩,
   exact pullback_arrows.mk _ _ (of_arrows.mk hk) },
  { rintro ⟨W, k, hk₁⟩,
    cases hk₁ with i hi,
    apply of_arrows.mk },
end

lemma of_arrows_bind {ι : Type*} (Z : ι → C) (g : Π (i : ι), Z i ⟶ X)
  (j : Π ⦃Y⦄ (f : Y ⟶ X), of_arrows Z g f → Type*)
  (W : Π ⦃Y⦄ (f : Y ⟶ X) H, j f H → C)
  (k : Π ⦃Y⦄ (f : Y ⟶ X) H i, W f H i ⟶ Y) :
  (of_arrows Z g).bind (λ Y f H, of_arrows (W f H) (k f H)) =
    of_arrows (λ (i : Σ i, j _ (of_arrows.mk i)), W (g i.1) _ i.2)
      (λ ij, k (g ij.1) _ ij.2 ≫ g ij.1) :=
begin
  ext Y f,
  split,
  { rintro ⟨_, _, _, ⟨i⟩, ⟨i'⟩, rfl⟩,
    exact of_arrows.mk (sigma.mk _ _) },
  { rintro ⟨i⟩,
    exact bind_comp _ (of_arrows.mk _) (of_arrows.mk _) }
end

end presieve

/--
For an object `X` of a category `C`, a `sieve X` is a set of morphisms to `X` which is closed under
left-composition.
-/
structure sieve {C : Type u} [category.{v} C] (X : C) :=
(arrows : presieve X)
(downward_closed' : ∀ {Y Z f} (hf : arrows f) (g : Z ⟶ Y), arrows (g ≫ f))

namespace sieve

instance {X : C} : has_coe_to_fun (sieve X) := ⟨_, sieve.arrows⟩

initialize_simps_projections sieve (arrows → apply)

variables {S R : sieve X}

@[simp, priority 100] lemma downward_closed (S : sieve X) {f : Y ⟶ X} (hf : S f)
  (g : Z ⟶ Y) : S (g ≫ f) :=
S.downward_closed' hf g

lemma arrows_ext : Π {R S : sieve X}, R.arrows = S.arrows → R = S
| ⟨Ra, _⟩ ⟨Sa, _⟩ rfl := rfl

@[ext]
protected lemma ext {R S : sieve X}
  (h : ∀ ⦃Y⦄ (f : Y ⟶ X), R f ↔ S f) :
  R = S :=
arrows_ext $ funext $ λ x, funext $ λ f, propext $ h f

protected lemma ext_iff {R S : sieve X} :
  R = S ↔ (∀ ⦃Y⦄ (f : Y ⟶ X), R f ↔ S f) :=
⟨λ h Y f, h ▸ iff.rfl, sieve.ext⟩

open lattice

/-- The supremum of a collection of sieves: the union of them all. -/
protected def Sup (𝒮 : set (sieve X)) : (sieve X) :=
{ arrows := λ Y, {f | ∃ S ∈ 𝒮, sieve.arrows S f},
  downward_closed' := λ Y Z f, by { rintro ⟨S, hS, hf⟩ g, exact ⟨S, hS, S.downward_closed hf _⟩ } }

/-- The infimum of a collection of sieves: the intersection of them all. -/
protected def Inf (𝒮 : set (sieve X)) : (sieve X) :=
{ arrows := λ Y, {f | ∀ S ∈ 𝒮, sieve.arrows S f},
  downward_closed' := λ Y Z f hf g S H, S.downward_closed (hf S H) g }

/-- The union of two sieves is a sieve. -/
protected def union (S R : sieve X) : sieve X :=
{ arrows := λ Y f, S f ∨ R f,
  downward_closed' := by { rintros Y Z f (h | h) g; simp [h] } }

/-- The intersection of two sieves is a sieve. -/
protected def inter (S R : sieve X) : sieve X :=
{ arrows := λ Y f, S f ∧ R f,
  downward_closed' := by { rintros Y Z f ⟨h₁, h₂⟩ g, simp [h₁, h₂] } }

/--
Sieves on an object `X` form a complete lattice.
We generate this directly rather than using the galois insertion for nicer definitional properties.
-/
instance : complete_lattice (sieve X) :=
{ le           := λ S R, ∀ ⦃Y⦄ (f : Y ⟶ X), S f → R f,
  le_refl      := λ S f q, id,
  le_trans     := λ S₁ S₂ S₃ S₁₂ S₂₃ Y f h, S₂₃ _ (S₁₂ _ h),
  le_antisymm  := λ S R p q, sieve.ext (λ Y f, ⟨p _, q _⟩),
  top          := { arrows := λ _, set.univ, downward_closed' := λ Y Z f g h, ⟨⟩ },
  bot          := { arrows := λ _, ∅, downward_closed' := λ _ _ _ p _, false.elim p },
  sup          := sieve.union,
  inf          := sieve.inter,
  Sup          := sieve.Sup,
  Inf          := sieve.Inf,
  le_Sup       := λ 𝒮 S hS Y f hf, ⟨S, hS, hf⟩,
  Sup_le       := λ ℰ S hS Y f, by { rintro ⟨R, hR, hf⟩, apply hS R hR _ hf },
  Inf_le       := λ _ _ hS _ _ h, h _ hS,
  le_Inf       := λ _ _ hS _ _ hf _ hR, hS _ hR _ hf,
  le_sup_left  := λ _ _ _ _, or.inl,
  le_sup_right := λ _ _ _ _, or.inr,
  sup_le       := λ _ _ _ a b _ _ hf, hf.elim (a _) (b _),
  inf_le_left  := λ _ _ _ _, and.left,
  inf_le_right := λ _ _ _ _, and.right,
  le_inf       := λ _ _ _ p q _ _ z, ⟨p _ z, q _ z⟩,
  le_top       := λ _ _ _ _, trivial,
  bot_le       := λ _ _ _, false.elim }

/-- The maximal sieve always exists. -/
instance sieve_inhabited : inhabited (sieve X) := ⟨⊤⟩

@[simp]
lemma Inf_apply {Ss : set (sieve X)} {Y} (f : Y ⟶ X) :
  Inf Ss f ↔ ∀ (S : sieve X) (H : S ∈ Ss), S f :=
iff.rfl

@[simp]
lemma Sup_apply {Ss : set (sieve X)} {Y} (f : Y ⟶ X) :
  Sup Ss f ↔ ∃ (S : sieve X) (H : S ∈ Ss), S f :=
iff.rfl

@[simp]
lemma inter_apply {R S : sieve X} {Y} (f : Y ⟶ X) :
  (R ⊓ S) f ↔ R f ∧ S f :=
iff.rfl

@[simp]
lemma union_apply {R S : sieve X} {Y} (f : Y ⟶ X) :
  (R ⊔ S) f ↔ R f ∨ S f :=
iff.rfl

@[simp]
lemma top_apply (f : Y ⟶ X) : (⊤ : sieve X) f := trivial

/-- Generate the smallest sieve containing the given set of arrows. -/
@[simps]
def generate (R : presieve X) : sieve X :=
{ arrows := λ Z f, ∃ Y (h : Z ⟶ Y) (g : Y ⟶ X), R g ∧ h ≫ g = f,
  downward_closed' :=
  begin
    rintro Y Z _ ⟨W, g, f, hf, rfl⟩ h,
    exact ⟨_, h ≫ g, _, hf, by simp⟩,
  end }

/--
Given a presieve on `X`, and a sieve on each domain of an arrow in the presieve, we can bind to
produce a sieve on `X`.
-/
@[simps]
def bind (S : presieve X) (R : Π ⦃Y⦄ ⦃f : Y ⟶ X⦄, S f → sieve Y) : sieve X :=
{ arrows := S.bind (λ Y f h, R h),
  downward_closed' :=
  begin
    rintro Y Z f ⟨W, f, h, hh, hf, rfl⟩ g,
    exact ⟨_, g ≫ f, _, hh, by simp [hf]⟩,
  end }

open order lattice

lemma sets_iff_generate (R : presieve X) (S : sieve X) :
  generate R ≤ S ↔ R ≤ S :=
⟨λ H Y g hg, H _ ⟨_, 𝟙 _, _, hg, category.id_comp _⟩,
 λ ss Y f,
  begin
    rintro ⟨Z, f, g, hg, rfl⟩,
    exact S.downward_closed (ss Z hg) f,
  end⟩

/-- Show that there is a galois insertion (generate, set_over). -/
def gi_generate : galois_insertion (generate : presieve X → sieve X) arrows :=
{ gc := sets_iff_generate,
  choice := λ 𝒢 _, generate 𝒢,
  choice_eq := λ _ _, rfl,
  le_l_u := λ S Y f hf, ⟨_, 𝟙 _, _, hf, category.id_comp _⟩ }

lemma le_generate (R : presieve X) : R ≤ generate R :=
gi_generate.gc.le_u_l R

@[simp] lemma generate_sieve (S : sieve X) : generate S = S :=
gi_generate.l_u_eq S

/-- If the identity arrow is in a sieve, the sieve is maximal. -/
lemma id_mem_iff_eq_top : S (𝟙 X) ↔ S = ⊤ :=
⟨λ h, top_unique $ λ Y f _, by simpa using downward_closed _ h f,
 λ h, h.symm ▸ trivial⟩

/-- If an arrow set contains a split epi, it generates the maximal sieve. -/
lemma generate_of_contains_split_epi {R : presieve X} (f : Y ⟶ X) [split_epi f]
  (hf : R f) : generate R = ⊤ :=
begin
  rw ← id_mem_iff_eq_top,
  exact ⟨_, section_ f, f, hf, by simp⟩,
end

@[simp]
lemma generate_of_singleton_split_epi (f : Y ⟶ X) [split_epi f] :
  generate (presieve.singleton f) = ⊤ :=
generate_of_contains_split_epi f (presieve.singleton_self _)

@[simp]
lemma generate_top : generate (⊤ : presieve X) = ⊤ :=
generate_of_contains_split_epi (𝟙 _) ⟨⟩

/-- Given a morphism `h : Y ⟶ X`, send a sieve S on X to a sieve on Y
    as the inverse image of S with `_ ≫ h`.
    That is, `sieve.pullback S h := (≫ h) '⁻¹ S`. -/
@[simps]
def pullback (h : Y ⟶ X) (S : sieve X) : sieve Y :=
{ arrows := λ Y sl, S (sl ≫ h),
  downward_closed' := λ Z W f g h, by simp [g] }

@[simp]
lemma pullback_id : S.pullback (𝟙 _) = S :=
by simp [sieve.ext_iff]

@[simp]
lemma pullback_top {f : Y ⟶ X} : (⊤ : sieve X).pullback f = ⊤ :=
top_unique (λ _ g, id)

lemma pullback_comp {f : Y ⟶ X} {g : Z ⟶ Y} (S : sieve X) :
  S.pullback (g ≫ f) = (S.pullback f).pullback g :=
by simp [sieve.ext_iff]

@[simp]
lemma pullback_inter {f : Y ⟶ X} (S R : sieve X) :
 (S ⊓ R).pullback f = S.pullback f ⊓ R.pullback f :=
by simp [sieve.ext_iff]

lemma pullback_eq_top_iff_mem (f : Y ⟶ X) : S f ↔ S.pullback f = ⊤ :=
by rw [← id_mem_iff_eq_top, pullback_apply, category.id_comp]

lemma pullback_eq_top_of_mem (S : sieve X) {f : Y ⟶ X} : S f → S.pullback f = ⊤ :=
(pullback_eq_top_iff_mem f).1

/--
Push a sieve `R` on `Y` forward along an arrow `f : Y ⟶ X`: `gf : Z ⟶ X` is in the sieve if `gf`
factors through some `g : Z ⟶ Y` which is in `R`.
-/
@[simps]
def pushforward (f : Y ⟶ X) (R : sieve Y) : sieve X :=
{ arrows := λ Z gf, ∃ g, g ≫ f = gf ∧ R g,
  downward_closed' := λ Z₁ Z₂ g ⟨j, k, z⟩ h, ⟨h ≫ j, by simp [k], by simp [z]⟩ }

lemma pushforward_apply_comp {R : sieve Y} {Z : C} {g : Z ⟶ Y} (hg : R g) (f : Y ⟶ X) :
  R.pushforward f (g ≫ f) :=
⟨g, rfl, hg⟩

lemma pushforward_comp {f : Y ⟶ X} {g : Z ⟶ Y} (R : sieve Z) :
  R.pushforward (g ≫ f) = (R.pushforward g).pushforward f :=
sieve.ext (λ W h, ⟨λ ⟨f₁, hq, hf₁⟩, ⟨f₁ ≫ g, by simpa, f₁, rfl, hf₁⟩,
                   λ ⟨y, hy, z, hR, hz⟩, ⟨z, by rwa reassoc_of hR, hz⟩⟩)

lemma galois_connection (f : Y ⟶ X) : galois_connection (sieve.pushforward f) (sieve.pullback f) :=
λ S R, ⟨λ hR Z g hg, hR _ ⟨g, rfl, hg⟩, λ hS Z g ⟨h, hg, hh⟩, hg ▸ hS h hh⟩

lemma pullback_monotone (f : Y ⟶ X) : monotone (sieve.pullback f) :=
(galois_connection f).monotone_u

lemma pushforward_monotone (f : Y ⟶ X) : monotone (sieve.pushforward f) :=
(galois_connection f).monotone_l

lemma le_pushforward_pullback (f : Y ⟶ X) (R : sieve Y) :
  R ≤ (R.pushforward f).pullback f :=
(galois_connection f).le_u_l _

lemma pullback_pushforward_le (f : Y ⟶ X) (R : sieve X) :
  (R.pullback f).pushforward f ≤ R :=
(galois_connection f).l_u_le _

lemma pushforward_union {f : Y ⟶ X} (S R : sieve Y) :
  (S ⊔ R).pushforward f = S.pushforward f ⊔ R.pushforward f :=
(galois_connection f).l_sup

lemma pushforward_le_bind_of_mem (S : presieve X)
  (R : Π ⦃Y : C⦄ ⦃f : Y ⟶ X⦄, S f → sieve Y) (f : Y ⟶ X) (h : S f) :
  (R h).pushforward f ≤ bind S R :=
begin
  rintro Z _ ⟨g, rfl, hg⟩,
  exact ⟨_, g, f, h, hg, rfl⟩,
end

lemma le_pullback_bind (S : presieve X) (R : Π ⦃Y : C⦄ ⦃f : Y ⟶ X⦄, S f → sieve Y)
  (f : Y ⟶ X) (h : S f) :
  R h ≤ (bind S R).pullback f :=
begin
  rw ← galois_connection f,
  apply pushforward_le_bind_of_mem,
end

/-- If `f` is a monomorphism, the pushforward-pullback adjunction on sieves is coreflective. -/
def galois_coinsertion_of_mono (f : Y ⟶ X) [mono f] :
  galois_coinsertion (sieve.pushforward f) (sieve.pullback f) :=
begin
  apply (galois_connection f).to_galois_coinsertion,
  rintros S Z g ⟨g₁, hf, hg₁⟩,
  rw cancel_mono f at hf,
  rwa ← hf,
end

/-- If `f` is a split epi, the pushforward-pullback adjunction on sieves is reflective. -/
def galois_insertion_of_split_epi (f : Y ⟶ X) [split_epi f] :
  galois_insertion (sieve.pushforward f) (sieve.pullback f) :=
begin
  apply (galois_connection f).to_galois_insertion,
  intros S Z g hg,
  refine ⟨g ≫ section_ f, by simpa⟩,
end

lemma pullback_arrows_comm [has_pullbacks C] {X Y : C} (f : Y ⟶ X)
  (R : presieve X) :
  sieve.generate (R.pullback_arrows f) = (sieve.generate R).pullback f :=
begin
  ext Z g,
  split,
  { rintro ⟨_, h, k, hk, rfl⟩,
    cases hk with W g hg,
    change (sieve.generate R).pullback f (h ≫ pullback.snd),
    rw [sieve.pullback_apply, assoc, ← pullback.condition, ← assoc],
    exact sieve.downward_closed _ (sieve.le_generate R W hg) (h ≫ pullback.fst)},
  { rintro ⟨W, h, k, hk, comm⟩,
    exact ⟨_, _, _, presieve.pullback_arrows.mk _ _ hk, pullback.lift_snd _ _ comm⟩ },
end

/-- A sieve induces a presheaf. -/
@[simps]
def functor (S : sieve X) : Cᵒᵖ ⥤ Type v :=
{ obj := λ Y, {g : Y.unop ⟶ X // S g},
  map := λ Y Z f g, ⟨f.unop ≫ g.1, downward_closed _ g.2 _⟩ }

/--
If a sieve S is contained in a sieve T, then we have a morphism of presheaves on their induced
presheaves.
-/
@[simps]
def nat_trans_of_le {S T : sieve X} (h : S ≤ T) : S.functor ⟶ T.functor :=
{ app := λ Y f, ⟨f.1, h _ f.2⟩ }.

/-- The natural inclusion from the functor induced by a sieve to the yoneda embedding. -/
@[simps]
def functor_inclusion (S : sieve X) : S.functor ⟶ yoneda.obj X :=
{ app := λ Y f, f.1 }.

lemma nat_trans_of_le_comm {S T : sieve X} (h : S ≤ T) :
  nat_trans_of_le h ≫ functor_inclusion _ = functor_inclusion _ :=
rfl

/-- The presheaf induced by a sieve is a subobject of the yoneda embedding. -/
instance functor_inclusion_is_mono : mono S.functor_inclusion :=
⟨λ Z f g h, by { ext Y y, apply congr_fun (nat_trans.congr_app h Y) y }⟩

/--
A natural transformation to a representable functor induces a sieve. This is the left inverse of
`functor_inclusion`, shown in `sieve_of_functor_inclusion`.
-/
-- TODO: Show that when `f` is mono, this is right inverse to `functor_inclusion` up to isomorphism.
@[simps]
def sieve_of_subfunctor {R} (f : R ⟶ yoneda.obj X) : sieve X :=
{ arrows := λ Y g, ∃ t, f.app (opposite.op Y) t = g,
  downward_closed' := λ Y Z _,
  begin
    rintro ⟨t, rfl⟩ g,
    refine ⟨R.map g.op t, _⟩,
    rw functor_to_types.naturality _ _ f,
    simp,
  end }

lemma sieve_of_subfunctor_functor_inclusion : sieve_of_subfunctor S.functor_inclusion = S :=
begin
  ext,
  simp only [functor_inclusion_app, sieve_of_subfunctor_apply, subtype.val_eq_coe],
  split,
  { rintro ⟨⟨f, hf⟩, rfl⟩,
    exact hf },
  { intro hf,
    exact ⟨⟨_, hf⟩, rfl⟩ }
end

instance functor_inclusion_top_is_iso : is_iso ((⊤ : sieve X).functor_inclusion) :=
⟨⟨{ app := λ Y a, ⟨a, ⟨⟩⟩ }, by tidy⟩⟩

end sieve
end category_theory


import tactic.basic

-- Lean version 3.45.0

@[derive decidable_eq] inductive prop : Type
| and : prop → prop → prop
| true : prop
| impl : prop → prop → prop
| other : ℕ → prop

abbreviation context : Type := list prop

inductive entails₁ : context → prop → Prop
| refl₁ {Γ A} : entails₁ (A :: Γ) A
| trans {Γ A C} : entails₁ (A :: Γ) C → entails₁ Γ A → entails₁ Γ C
| weak {Γ A C} : entails₁ Γ C → entails₁ (A :: Γ) C
| contr {Γ A C} : entails₁ (A :: A :: Γ) C → entails₁ (A :: Γ) C
| exch {Γ A B C} : entails₁ (B :: A :: Γ) C → entails₁ (A :: B :: Γ) C
| and_intro {Γ A B} : entails₁ Γ A → entails₁ Γ B → entails₁ Γ (prop.and A B)
| and_elim₁ {Γ A B} : entails₁ Γ (prop.and A B) → entails₁ Γ A
| and_elim₂ {Γ A B} : entails₁ Γ (prop.and A B) → entails₁ Γ B
| true_intro {Γ} : entails₁ Γ prop.true
| impl_intro {Γ A B} : entails₁ (A :: Γ) B → entails₁ Γ (prop.impl A B)
| impl_elim {Γ A B} : entails₁ Γ (prop.impl A B) → entails₁ Γ A → entails₁ Γ B

inductive entails₂ : context → prop → Prop
| refl₂ {Γ A} : list.mem A Γ → entails₂ Γ A
| and_intro {Γ A B} : entails₂ Γ A → entails₂ Γ B → entails₂ Γ (prop.and A B)
| and_elim₁ {Γ A B} : entails₂ Γ (prop.and A B) → entails₂ Γ A
| and_elim₂ {Γ A B} : entails₂ Γ (prop.and A B) → entails₂ Γ B
| true_intro {Γ} : entails₂ Γ prop.true
| impl_intro {Γ A B} : entails₂ (A :: Γ) B → entails₂ Γ (prop.impl A B)
| impl_elim {Γ A B} : entails₂ Γ (prop.impl A B) → entails₂ Γ A → entails₂ Γ B

lemma entails₁.refl₂ {Γ A} : list.mem A Γ → entails₁ Γ A :=
begin
  intro h,
  induction Γ with B Γ ih,
  { cases h },
  { by_cases h' : A = B,
    { subst h',
      exact entails₁.refl₁ },
    { replace h : list.mem A Γ,
      { cases h, exact false.elim (h' h), exact h },
      specialize ih h, clear h h',
      exact entails₁.weak ih } }
end

lemma entails₂.refl₁ {Γ A} : entails₂ (A :: Γ) A :=
begin
  exact entails₂.refl₂ (list.mem_cons_self A Γ)
end

lemma aux {Γ₁ Γ₂ C} (hΓ : ∀ (A : prop), list.mem A Γ₁ → list.mem A Γ₂) :
  entails₂ Γ₁ C → entails₂ Γ₂ C :=
begin
  intro h,
  induction h with Γ₁ C h Γ₁ A B h₁ h₂ ih₁ ih₂ Γ₁ A B h ih Γ₁ A B h ih Γ₁ Γ₁ A B h ih Γ₁ A B h₁ h₂ ih₁ ih₂ generalizing Γ₂,
  any_goals { specialize ih₁ hΓ, specialize ih₂ hΓ },
  { exact entails₂.refl₂ (hΓ C h) },
  { exact entails₂.and_intro ih₁ ih₂ },
  { exact entails₂.and_elim₁ (ih hΓ) },
  { exact entails₂.and_elim₂ (ih hΓ) },
  { exact entails₂.true_intro },
  { replace hΓ : ∀ B, list.mem B (A :: Γ₁) → list.mem B (A :: Γ₂),
    { intro B,
      by_cases h : B = A,
      { subst h,
        intro h',
        exact or.inl rfl },
      { intro h',
        cases h', exact false.elim (h h'),
        exact or.inr (hΓ B h') } },
    exact entails₂.impl_intro (ih hΓ) },
  { exact entails₂.impl_elim ih₁ ih₂ }
end

lemma entails₂.exch {Γ A B C} :
  entails₂ (B :: A :: Γ) C → entails₂ (A :: B :: Γ) C :=
begin
  apply aux; clear C,
  intro C,
  by_cases h₁ : C = A,
  { subst h₁,
    intro h,
    exact or.inl rfl },
  { by_cases h₂ : C = B,
    { subst h₂,
      intro h,
      exact or.inr (or.inl rfl) },
    { intro h,
      cases h, exact false.elim (h₂ h),
      cases h, exact false.elim (h₁ h),
      exact or.inr (or.inr h) } }
end

lemma entails₂.weak {Γ A C} : entails₂ Γ C → entails₂ (A :: Γ) C :=
begin
  intro h,
  induction h with Γ C h Γ B C h₁ h₂ ih₁ ih₂ Γ C B h ih Γ B C h ih Γ Γ B C h ih Γ B C h₁ h₂ ih₁ ih₂,
  { exact entails₂.refl₂ (or.inr h) },
  { exact entails₂.and_intro ih₁ ih₂ },
  { exact entails₂.and_elim₁ ih },
  { exact entails₂.and_elim₂ ih },
  { exact entails₂.true_intro },
  { exact entails₂.impl_intro (entails₂.exch ih) },
  { exact entails₂.impl_elim ih₁ ih₂ }
end

lemma entails₂.trans {Γ A C} :
  entails₂ (A :: Γ) C → entails₂ Γ A → entails₂ Γ C :=
begin
  intros H₁ H₂,
  have hΓ : ∀ (B : prop), list.mem B (A :: Γ) → B = A ∨ list.mem B Γ,
  { intros B h, exact h },
  induction H₁ with Γ' C h Γ' A' B h₁ h₂ ih₁ ih₂ Γ' A' B h ih Γ' A' B h ih Γ' Γ' A' B h ih Γ' A' B h₁ h₂ ih₁ ih₂ generalizing Γ,
  any_goals { specialize ih₁ H₂ hΓ, specialize ih₂ H₂ hΓ },
  { by_cases h' : C = A,
    { subst h',
      exact H₂ },
    { replace hΓ : list.mem C Γ,
      { specialize hΓ C h,
        cases hΓ,
        { exact false.elim (h' hΓ) },
        { exact hΓ } },
      exact entails₂.refl₂ hΓ } },
  { exact entails₂.and_intro ih₁ ih₂ },
  { exact entails₂.and_elim₁ (ih H₂ hΓ) },
  { exact entails₂.and_elim₂ (ih H₂ hΓ) },
  { exact entails₂.true_intro },
  { replace H₂ : entails₂ (A' :: Γ) A := entails₂.weak H₂,
    replace hΓ : ∀ (B : prop), list.mem B (A' :: Γ') → B = A ∨ list.mem B (A' :: Γ),
    { clear_dependent B,
      intros B h,
      cases h,
      { subst h,
        exact or.inr (or.inl rfl) },
      { specialize hΓ B h,
        cases hΓ,
        { subst hΓ,
          exact or.inl rfl },
        { exact or.inr (or.inr hΓ) } } },
    exact entails₂.impl_intro (ih H₂ hΓ) },
  { exact entails₂.impl_elim ih₁ ih₂ }
end

lemma entails₂.contr {Γ A C} :
  entails₂ (A :: A :: Γ) C → entails₂ (A :: Γ) C :=
begin
  apply aux; clear C,
  intro B,
  by_cases h : B = A,
  { subst h,
    intro h',
    exact or.inl rfl },
  { intro h',
    cases h', exact false.elim (h h'),
    cases h', exact false.elim (h h'),
    exact or.inr h' }
end

theorem entails₁_iff_entails₂ {Γ C} :
  entails₁ Γ C ↔ entails₂ Γ C :=
begin
  split; intro h,
  { induction h with Γ A Γ A C h₁ h₂ ih₁ ih₂ Γ A C h ih Γ A C h ih Γ A B C h ih Γ A B h₁ h₂ ih₁ ih₂ Γ A B h ih Γ A B h ih Γ Γ A B h ih Γ A B h₁ h₂ ih₁ ih₂,
    { exact entails₂.refl₁ },
    { exact entails₂.trans ih₁ ih₂ },
    { exact entails₂.weak ih },
    { exact entails₂.contr ih },
    { exact entails₂.exch ih },
    { exact entails₂.and_intro ih₁ ih₂ },
    { exact entails₂.and_elim₁ ih },
    { exact entails₂.and_elim₂ ih },
    { exact entails₂.true_intro },
    { exact entails₂.impl_intro ih },
    { exact entails₂.impl_elim ih₁ ih₂ } },
  { induction h with Γ C h Γ A B h₁ h₂ ih₁ ih₂ Γ A B h ih Γ A B h ih Γ Γ A B h ih Γ A B h₁ h₂ ih₁ ih₂,
    { exact entails₁.refl₂ h },
    { exact entails₁.and_intro ih₁ ih₂ },
    { exact entails₁.and_elim₁ ih },
    { exact entails₁.and_elim₂ ih },
    { exact entails₁.true_intro },
    { exact entails₁.impl_intro ih },
    { exact entails₁.impl_elim ih₁ ih₂ } }
end

#print axioms entails₁_iff_entails₂ -- no axioms


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.shapes.binary_products
import category_theory.limits.shapes.terminal
import category_theory.subobject.mono_over

/-!
# Subterminal objects

Subterminal objects are the objects which can be thought of as subobjects of the terminal object.
In fact, the definition can be constructed to not require a terminal object, by defining `A` to be
subterminal iff for any `Z`, there is at most one morphism `Z ⟶ A`.
An alternate definition is that the diagonal morphism `A ⟶ A ⨯ A` is an isomorphism.
In this file we define subterminal objects and show the equivalence of these three definitions.

We also construct the subcategory of subterminal objects.

## TODO

* Define exponential ideals, and show this subcategory is an exponential ideal.
* Use the above to show that in a locally cartesian closed category, every subobject lattice
  is cartesian closed (equivalently, a Heyting algebra).

-/
universes v₁ v₂ u₁ u₂

noncomputable theory

namespace category_theory

open limits category

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

/-- An object `A` is subterminal iff for any `Z`, there is at most one morphism `Z ⟶ A`. -/
def is_subterminal (A : C) : Prop := ∀ ⦃Z : C⦄ (f g : Z ⟶ A), f = g

lemma is_subterminal.def : is_subterminal A ↔ ∀ ⦃Z : C⦄ (f g : Z ⟶ A), f = g := iff.rfl

/--
If `A` is subterminal, the unique morphism from it to a terminal object is a monomorphism.
The converse of `is_subterminal_of_mono_is_terminal_from`.
-/
lemma is_subterminal.mono_is_terminal_from (hA : is_subterminal A) {T : C} (hT : is_terminal T) :
  mono (hT.from A) :=
{ right_cancellation := λ Z g h _, hA _ _ }

/--
If `A` is subterminal, the unique morphism from it to the terminal object is a monomorphism.
The converse of `is_subterminal_of_mono_terminal_from`.
-/
lemma is_subterminal.mono_terminal_from [has_terminal C] (hA : is_subterminal A) :
  mono (terminal.from A) :=
hA.mono_is_terminal_from terminal_is_terminal

/--
If the unique morphism from `A` to a terminal object is a monomorphism, `A` is subterminal.
The converse of `is_subterminal.mono_is_terminal_from`.
-/
lemma is_subterminal_of_mono_is_terminal_from {T : C} (hT : is_terminal T) [mono (hT.from A)] :
  is_subterminal A :=
λ Z f g, by { rw ← cancel_mono (hT.from A), apply hT.hom_ext }

/--
If the unique morphism from `A` to the terminal object is a monomorphism, `A` is subterminal.
The converse of `is_subterminal.mono_terminal_from`.
-/
lemma is_subterminal_of_mono_terminal_from [has_terminal C] [mono (terminal.from A)] :
  is_subterminal A :=
λ Z f g, by { rw ← cancel_mono (terminal.from A), apply subsingleton.elim }

lemma is_subterminal_of_is_terminal {T : C} (hT : is_terminal T) : is_subterminal T :=
λ Z f g, hT.hom_ext _ _

lemma is_subterminal_of_terminal [has_terminal C] : is_subterminal (⊤_ C) :=
λ Z f g, subsingleton.elim _ _

/--
If `A` is subterminal, its diagonal morphism is an isomorphism.
The converse of `is_subterminal_of_is_iso_diag`.
-/
lemma is_subterminal.is_iso_diag (hA : is_subterminal A) [has_binary_product A A] :
  is_iso (diag A) :=
⟨⟨limits.prod.fst, ⟨by simp, by { rw is_subterminal.def at hA, tidy }⟩⟩⟩

/--
If the diagonal morphism of `A` is an isomorphism, then it is subterminal.
The converse of `is_subterminal.is_iso_diag`.
-/
lemma is_subterminal_of_is_iso_diag [has_binary_product A A] [is_iso (diag A)] :
  is_subterminal A :=
λ Z f g,
begin
  have : (limits.prod.fst : A ⨯ A ⟶ _) = limits.prod.snd,
  { simp [←cancel_epi (diag A)] },
  rw [←prod.lift_fst f g, this, prod.lift_snd],
end

/-- If `A` is subterminal, it is isomorphic to `A ⨯ A`. -/
@[simps]
def is_subterminal.iso_diag (hA : is_subterminal A) [has_binary_product A A] :
  A ⨯ A ≅ A :=
begin
  letI := is_subterminal.is_iso_diag hA,
  apply (as_iso (diag A)).symm,
end

variables (C)
/--
The (full sub)category of subterminal objects.
TODO: If `C` is the category of sheaves on a topological space `X`, this category is equivalent
to the lattice of open subsets of `X`. More generally, if `C` is a topos, this is the lattice of
"external truth values".
-/
@[derive category]
def subterminals (C : Type u₁) [category.{v₁} C] :=
full_subcategory (λ (A : C), is_subterminal A)

instance [has_terminal C] : inhabited (subterminals C) :=
⟨⟨⊤_ C, is_subterminal_of_terminal⟩⟩

/-- The inclusion of the subterminal objects into the original category. -/
@[derive [full, faithful], simps]
def subterminal_inclusion : subterminals C ⥤ C := full_subcategory_inclusion _

instance subterminals_thin (X Y : subterminals C) : subsingleton (X ⟶ Y) :=
⟨λ f g, Y.2 f g⟩

/--
The category of subterminal objects is equivalent to the category of monomorphisms to the terminal
object (which is in turn equivalent to the subobjects of the terminal object).
-/
@[simps]
def subterminals_equiv_mono_over_terminal [has_terminal C] :
  subterminals C ≌ mono_over (⊤_ C) :=
{ functor :=
  { obj := λ X, ⟨over.mk (terminal.from X.1), X.2.mono_terminal_from⟩,
    map := λ X Y f, mono_over.hom_mk f (by ext1 ⟨⟨⟩⟩) },
  inverse :=
  { obj := λ X, ⟨X.obj.left, λ Z f g, by { rw ← cancel_mono X.arrow, apply subsingleton.elim }⟩,
    map := λ X Y f, f.1 },
  unit_iso :=
  { hom := { app := λ X, 𝟙 _ },
    inv := { app := λ X, 𝟙 _ } },
  counit_iso :=
  { hom := { app := λ X, over.hom_mk (𝟙 _) },
    inv := { app := λ X, over.hom_mk (𝟙 _) } } }

@[simp]
lemma subterminals_to_mono_over_terminal_comp_forget [has_terminal C] :
  (subterminals_equiv_mono_over_terminal C).functor ⋙ mono_over.forget _ ⋙ over.forget _ =
    subterminal_inclusion C :=
rfl

@[simp]
lemma mono_over_terminal_to_subterminals_comp [has_terminal C] :
  (subterminals_equiv_mono_over_terminal C).inverse ⋙ subterminal_inclusion C =
    mono_over.forget _ ⋙ over.forget _ :=
rfl

end category_theory


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov, Eric Wieser
-/
import linear_algebra.span
import order.partial_sups
import algebra.algebra.basic

/-! ### Products of modules

This file defines constructors for linear maps whose domains or codomains are products.

It contains theorems relating these to each other, as well as to `submodule.prod`, `submodule.map`,
`submodule.comap`, `linear_map.range`, and `linear_map.ker`.

## Main definitions

- products in the domain:
  - `linear_map.fst`
  - `linear_map.snd`
  - `linear_map.coprod`
  - `linear_map.prod_ext`
- products in the codomain:
  - `linear_map.inl`
  - `linear_map.inr`
  - `linear_map.prod`
- products in both domain and codomain:
  - `linear_map.prod_map`
  - `linear_equiv.prod_map`
  - `linear_equiv.skew_prod`
-/

universes u v w x y z u' v' w' y'
variables {R : Type u} {K : Type u'} {M : Type v} {V : Type v'} {M₂ : Type w} {V₂ : Type w'}
variables {M₃ : Type y} {V₃ : Type y'} {M₄ : Type z} {ι : Type x}
variables {M₅ M₆ : Type*}

section prod

namespace linear_map

variables (S : Type*) [semiring R] [semiring S]
variables [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃] [add_comm_monoid M₄]
variables [add_comm_monoid M₅] [add_comm_monoid M₆]
variables [module R M] [module R M₂] [module R M₃] [module R M₄]
variables [module R M₅] [module R M₆]
variables (f : M →ₗ[R] M₂)

section
variables (R M M₂)

/-- The first projection of a product is a linear map. -/
def fst : M × M₂ →ₗ[R] M := { to_fun := prod.fst, map_add' := λ x y, rfl, map_smul' := λ x y, rfl }

/-- The second projection of a product is a linear map. -/
def snd : M × M₂ →ₗ[R] M₂ := { to_fun := prod.snd, map_add' := λ x y, rfl, map_smul' := λ x y, rfl }
end

@[simp] theorem fst_apply (x : M × M₂) : fst R M M₂ x = x.1 := rfl
@[simp] theorem snd_apply (x : M × M₂) : snd R M M₂ x = x.2 := rfl

theorem fst_surjective : function.surjective (fst R M M₂) := λ x, ⟨(x, 0), rfl⟩
theorem snd_surjective : function.surjective (snd R M M₂) := λ x, ⟨(0, x), rfl⟩

/-- The prod of two linear maps is a linear map. -/
@[simps] def prod (f : M →ₗ[R] M₂) (g : M →ₗ[R] M₃) : (M →ₗ[R] M₂ × M₃) :=
{ to_fun    := pi.prod f g,
  map_add'  := λ x y, by simp only [pi.prod, prod.mk_add_mk, map_add],
  map_smul' := λ c x, by simp only [pi.prod, prod.smul_mk, map_smul, ring_hom.id_apply] }

lemma coe_prod (f : M →ₗ[R] M₂) (g : M →ₗ[R] M₃) : ⇑(f.prod g) = pi.prod f g := rfl

@[simp] theorem fst_prod (f : M →ₗ[R] M₂) (g : M →ₗ[R] M₃) :
  (fst R M₂ M₃).comp (prod f g) = f := by ext; refl

@[simp] theorem snd_prod (f : M →ₗ[R] M₂) (g : M →ₗ[R] M₃) :
  (snd R M₂ M₃).comp (prod f g) = g := by ext; refl

@[simp] theorem pair_fst_snd : prod (fst R M M₂) (snd R M M₂) = linear_map.id :=
fun_like.coe_injective pi.prod_fst_snd

/-- Taking the product of two maps with the same domain is equivalent to taking the product of
their codomains.

See note [bundled maps over different rings] for why separate `R` and `S` semirings are used. -/
@[simps] def prod_equiv
  [module S M₂] [module S M₃] [smul_comm_class R S M₂] [smul_comm_class R S M₃] :
  ((M →ₗ[R] M₂) × (M →ₗ[R] M₃)) ≃ₗ[S] (M →ₗ[R] M₂ × M₃) :=
{ to_fun := λ f, f.1.prod f.2,
  inv_fun := λ f, ((fst _ _ _).comp f, (snd _ _ _).comp f),
  left_inv := λ f, by ext; refl,
  right_inv := λ f, by ext; refl,
  map_add' := λ a b, rfl,
  map_smul' := λ r a, rfl }

section
variables (R M M₂)

/-- The left injection into a product is a linear map. -/
def inl : M →ₗ[R] M × M₂ := prod linear_map.id 0

/-- The right injection into a product is a linear map. -/
def inr : M₂ →ₗ[R] M × M₂ := prod 0 linear_map.id

theorem range_inl : range (inl R M M₂) = ker (snd R M M₂) :=
begin
  ext x,
  simp only [mem_ker, mem_range],
  split,
  { rintros ⟨y, rfl⟩, refl },
  { intro h, exact ⟨x.fst, prod.ext rfl h.symm⟩ }
end

theorem ker_snd : ker (snd R M M₂) = range (inl R M M₂) :=
eq.symm $ range_inl R M M₂

theorem range_inr : range (inr R M M₂) = ker (fst R M M₂) :=
begin
  ext x,
  simp only [mem_ker, mem_range],
  split,
  { rintros ⟨y, rfl⟩, refl },
  { intro h, exact ⟨x.snd, prod.ext h.symm rfl⟩ }
end

theorem ker_fst : ker (fst R M M₂) = range (inr R M M₂) :=
eq.symm $ range_inr R M M₂

end

@[simp] theorem coe_inl : (inl R M M₂ : M → M × M₂) = λ x, (x, 0) := rfl
theorem inl_apply (x : M) : inl R M M₂ x = (x, 0) := rfl

@[simp] theorem coe_inr : (inr R M M₂ : M₂ → M × M₂) = prod.mk 0 := rfl
theorem inr_apply (x : M₂) : inr R M M₂ x = (0, x) := rfl

theorem inl_eq_prod : inl R M M₂ = prod linear_map.id 0 := rfl

theorem inr_eq_prod : inr R M M₂ = prod 0 linear_map.id := rfl

theorem inl_injective : function.injective (inl R M M₂) :=
λ _, by simp

/-- The coprod function `λ x : M × M₂, f x.1 + g x.2` is a linear map. -/
def coprod (f : M →ₗ[R] M₃) (g : M₂ →ₗ[R] M₃) : M × M₂ →ₗ[R] M₃ :=
f.comp (fst _ _ _) + g.comp (snd _ _ _)

@[simp] theorem coprod_apply (f : M →ₗ[R] M₃) (g : M₂ →ₗ[R] M₃) (x : M × M₂) :
  coprod f g x = f x.1 + g x.2 := rfl

@[simp] theorem coprod_inl (f : M →ₗ[R] M₃) (g : M₂ →ₗ[R] M₃) :
  (coprod f g).comp (inl R M M₂) = f :=
by ext; simp only [map_zero, add_zero, coprod_apply, inl_apply, comp_apply]

@[simp] theorem coprod_inr (f : M →ₗ[R] M₃) (g : M₂ →ₗ[R] M₃) :
  (coprod f g).comp (inr R M M₂) = g :=
by ext; simp only [map_zero, coprod_apply, inr_apply, zero_add, comp_apply]

@[simp] theorem coprod_inl_inr : coprod (inl R M M₂) (inr R M M₂) = linear_map.id :=
by ext; simp only [prod.mk_add_mk, add_zero, id_apply, coprod_apply,
  inl_apply, inr_apply, zero_add]

theorem comp_coprod (f : M₃ →ₗ[R] M₄) (g₁ : M →ₗ[R] M₃) (g₂ : M₂ →ₗ[R] M₃) :
  f.comp (g₁.coprod g₂) = (f.comp g₁).coprod (f.comp g₂) :=
ext $ λ x, f.map_add (g₁ x.1) (g₂ x.2)

theorem fst_eq_coprod : fst R M M₂ = coprod linear_map.id 0 := by ext; simp

theorem snd_eq_coprod : snd R M M₂ = coprod 0 linear_map.id := by ext; simp

@[simp] theorem coprod_comp_prod (f : M₂ →ₗ[R] M₄) (g : M₃ →ₗ[R] M₄)
  (f' : M →ₗ[R] M₂) (g' : M →ₗ[R] M₃) :
  (f.coprod g).comp (f'.prod g') = f.comp f' + g.comp g' :=
rfl

@[simp]
lemma coprod_map_prod (f : M →ₗ[R] M₃) (g : M₂ →ₗ[R] M₃) (S : submodule R M)
  (S' : submodule R M₂) :
  (submodule.prod S S').map (linear_map.coprod f g) = S.map f ⊔ S'.map g :=
set_like.coe_injective $ begin
  simp only [linear_map.coprod_apply, submodule.coe_sup, submodule.map_coe],
  rw [←set.image2_add, set.image2_image_left, set.image2_image_right],
  exact set.image_prod (λ m m₂, f m + g m₂),
end

/-- Taking the product of two maps with the same codomain is equivalent to taking the product of
their domains.

See note [bundled maps over different rings] for why separate `R` and `S` semirings are used. -/
@[simps] def coprod_equiv [module S M₃] [smul_comm_class R S M₃] :
  ((M →ₗ[R] M₃) × (M₂ →ₗ[R] M₃)) ≃ₗ[S] (M × M₂ →ₗ[R] M₃) :=
{ to_fun := λ f, f.1.coprod f.2,
  inv_fun := λ f, (f.comp (inl _ _ _), f.comp (inr _ _ _)),
  left_inv := λ f, by simp only [prod.mk.eta, coprod_inl, coprod_inr],
  right_inv := λ f, by simp only [←comp_coprod, comp_id, coprod_inl_inr],
  map_add' := λ a b,
    by { ext, simp only [prod.snd_add, add_apply, coprod_apply, prod.fst_add, add_add_add_comm] },
  map_smul' := λ r a,
    by { dsimp, ext, simp only [smul_add, smul_apply, prod.smul_snd, prod.smul_fst,
                                coprod_apply] } }

theorem prod_ext_iff {f g : M × M₂ →ₗ[R] M₃} :
  f = g ↔ f.comp (inl _ _ _) = g.comp (inl _ _ _) ∧ f.comp (inr _ _ _) = g.comp (inr _ _ _) :=
(coprod_equiv ℕ).symm.injective.eq_iff.symm.trans prod.ext_iff

/--
Split equality of linear maps from a product into linear maps over each component, to allow `ext`
to apply lemmas specific to `M →ₗ M₃` and `M₂ →ₗ M₃`.

See note [partially-applied ext lemmas]. -/
@[ext] theorem prod_ext {f g : M × M₂ →ₗ[R] M₃}
  (hl : f.comp (inl _ _ _) = g.comp (inl _ _ _))
  (hr : f.comp (inr _ _ _) = g.comp (inr _ _ _)) :
  f = g :=
prod_ext_iff.2 ⟨hl, hr⟩

/-- `prod.map` of two linear maps. -/
def prod_map (f : M →ₗ[R] M₃) (g : M₂ →ₗ[R] M₄) : (M × M₂) →ₗ[R] (M₃ × M₄) :=
(f.comp (fst R M M₂)).prod (g.comp (snd R M M₂))

@[simp] theorem prod_map_apply (f : M →ₗ[R] M₃) (g : M₂ →ₗ[R] M₄) (x) :
  f.prod_map g x = (f x.1, g x.2) := rfl

lemma prod_map_comap_prod (f : M →ₗ[R] M₂) (g : M₃ →ₗ[R] M₄) (S : submodule R M₂)
  (S' : submodule R M₄) :
  (submodule.prod S S').comap (linear_map.prod_map f g) = (S.comap f).prod (S'.comap g) :=
set_like.coe_injective $ set.preimage_prod_map_prod f g _ _

lemma ker_prod_map (f : M →ₗ[R] M₂) (g : M₃ →ₗ[R] M₄) :
  (linear_map.prod_map f g).ker = submodule.prod f.ker g.ker :=
begin
  dsimp only [ker],
  rw [←prod_map_comap_prod, submodule.prod_bot],
end

@[simp]
lemma prod_map_id : (id : M →ₗ[R] M).prod_map (id : M₂ →ₗ[R] M₂) = id :=
linear_map.ext $ λ _, prod.mk.eta

@[simp]
lemma prod_map_one : (1 : M →ₗ[R] M).prod_map (1 : M₂ →ₗ[R] M₂) = 1 :=
linear_map.ext $ λ _, prod.mk.eta

lemma prod_map_comp (f₁₂ : M →ₗ[R] M₂) (f₂₃ : M₂ →ₗ[R] M₃) (g₁₂ : M₄ →ₗ[R] M₅) (g₂₃ : M₅ →ₗ[R] M₆) :
  f₂₃.prod_map g₂₃ ∘ₗ f₁₂.prod_map g₁₂ = (f₂₃ ∘ₗ f₁₂).prod_map (g₂₃ ∘ₗ g₁₂) := rfl

lemma prod_map_mul (f₁₂ : M →ₗ[R] M) (f₂₃ : M →ₗ[R] M) (g₁₂ : M₂ →ₗ[R] M₂) (g₂₃ : M₂ →ₗ[R] M₂) :
  f₂₃.prod_map g₂₃ * f₁₂.prod_map g₁₂ = (f₂₃ * f₁₂).prod_map (g₂₃ * g₁₂) := rfl

lemma prod_map_add (f₁ : M →ₗ[R] M₃) (f₂ : M →ₗ[R] M₃) (g₁ : M₂ →ₗ[R] M₄) (g₂ : M₂ →ₗ[R] M₄) :
  (f₁ + f₂).prod_map (g₁ + g₂) = f₁.prod_map g₁ + f₂.prod_map g₂ := rfl

@[simp] lemma prod_map_zero :
  (0 : M →ₗ[R] M₂).prod_map (0 : M₃ →ₗ[R] M₄) = 0 := rfl

@[simp] lemma prod_map_smul
 [module S M₃] [module S M₄] [smul_comm_class R S M₃] [smul_comm_class R S M₄]
 (s : S) (f : M →ₗ[R] M₃) (g : M₂ →ₗ[R] M₄) : prod_map (s • f) (s • g) = s • prod_map f g := rfl

variables (R M M₂ M₃ M₄)

/-- `linear_map.prod_map` as a `linear_map` -/
@[simps]
def prod_map_linear
 [module S M₃] [module S M₄] [smul_comm_class R S M₃] [smul_comm_class R S M₄] :
 ((M →ₗ[R] M₃) × (M₂ →ₗ[R] M₄)) →ₗ[S] ((M × M₂) →ₗ[R] (M₃ × M₄)) :=
{ to_fun := λ f, prod_map f.1 f.2,
  map_add' := λ _ _, rfl,
  map_smul' := λ _ _, rfl}

/-- `linear_map.prod_map` as a `ring_hom` -/
@[simps]
def prod_map_ring_hom : (M →ₗ[R] M) × (M₂ →ₗ[R] M₂) →+* ((M × M₂) →ₗ[R] (M × M₂)) :=
{ to_fun := λ f, prod_map f.1 f.2,
  map_one' := prod_map_one,
  map_zero' := rfl,
  map_add' := λ _ _, rfl,
  map_mul' := λ _ _, rfl }

variables {R M M₂ M₃ M₄}

section map_mul

variables {A : Type*} [non_unital_non_assoc_semiring A] [module R A]
variables {B : Type*} [non_unital_non_assoc_semiring B] [module R B]

lemma inl_map_mul (a₁ a₂ : A) : linear_map.inl R A B (a₁ * a₂) =
  linear_map.inl R A B a₁ * linear_map.inl R A B a₂ :=
prod.ext rfl (by simp)

lemma inr_map_mul (b₁ b₂ : B) : linear_map.inr R A B (b₁ * b₂) =
  linear_map.inr R A B b₁ * linear_map.inr R A B b₂ :=
prod.ext (by simp) rfl

end map_mul

end linear_map

end prod

namespace linear_map

variables (R M M₂)

variables [comm_semiring R]
variables [add_comm_monoid M] [add_comm_monoid M₂]
variables [module R M] [module R M₂]

/-- `linear_map.prod_map` as an `algebra_hom` -/
@[simps]
def prod_map_alg_hom : (module.End R M) × (module.End R M₂) →ₐ[R] module.End R (M × M₂) :=
{ commutes' := λ _, rfl, ..prod_map_ring_hom R M M₂ }

end linear_map

namespace linear_map
open submodule

variables [semiring R]
  [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃] [add_comm_monoid M₄]
  [module R M] [module R M₂] [module R M₃] [module R M₄]

lemma range_coprod (f : M →ₗ[R] M₃) (g : M₂ →ₗ[R] M₃) :
  (f.coprod g).range = f.range ⊔ g.range :=
submodule.ext $ λ x, by simp [mem_sup]

lemma is_compl_range_inl_inr : is_compl (inl R M M₂).range (inr R M M₂).range :=
begin
  split,
  { rintros ⟨_, _⟩ ⟨⟨x, hx⟩, ⟨y, hy⟩⟩,
    simp only [prod.ext_iff, inl_apply, inr_apply, mem_bot] at hx hy ⊢,
    exact ⟨hy.1.symm, hx.2.symm⟩ },
  { rintros ⟨x, y⟩ -,
    simp only [mem_sup, mem_range, exists_prop],
    refine ⟨(x, 0), ⟨x, rfl⟩, (0, y), ⟨y, rfl⟩, _⟩,
    simp }
end

lemma sup_range_inl_inr : (inl R M M₂).range ⊔ (inr R M M₂).range = ⊤ :=
is_compl_range_inl_inr.sup_eq_top

lemma disjoint_inl_inr : disjoint (inl R M M₂).range (inr R M M₂).range :=
by simp [disjoint_def, @eq_comm M 0, @eq_comm M₂ 0] {contextual := tt}; intros; refl
theorem map_coprod_prod (f : M →ₗ[R] M₃) (g : M₂ →ₗ[R] M₃)
  (p : submodule R M) (q : submodule R M₂) :
  map (coprod f g) (p.prod q) = map f p ⊔ map g q :=
begin
  refine le_antisymm _ (sup_le (map_le_iff_le_comap.2 _) (map_le_iff_le_comap.2 _)),
  { rw set_like.le_def, rintro _ ⟨x, ⟨h₁, h₂⟩, rfl⟩,
    exact mem_sup.2 ⟨_, ⟨_, h₁, rfl⟩, _, ⟨_, h₂, rfl⟩, rfl⟩ },
  { exact λ x hx, ⟨(x, 0), by simp [hx]⟩ },
  { exact λ x hx, ⟨(0, x), by simp [hx]⟩ }
end

theorem comap_prod_prod (f : M →ₗ[R] M₂) (g : M →ₗ[R] M₃)
  (p : submodule R M₂) (q : submodule R M₃) :
  comap (prod f g) (p.prod q) = comap f p ⊓ comap g q :=
submodule.ext $ λ x, iff.rfl

theorem prod_eq_inf_comap (p : submodule R M) (q : submodule R M₂) :
  p.prod q = p.comap (linear_map.fst R M M₂) ⊓ q.comap (linear_map.snd R M M₂) :=
submodule.ext $ λ x, iff.rfl

theorem prod_eq_sup_map (p : submodule R M) (q : submodule R M₂) :
  p.prod q = p.map (linear_map.inl R M M₂) ⊔ q.map (linear_map.inr R M M₂) :=
by rw [← map_coprod_prod, coprod_inl_inr, map_id]

lemma span_inl_union_inr {s : set M} {t : set M₂} :
  span R (inl R M  M₂ '' s ∪ inr R M M₂ '' t) = (span R s).prod (span R t) :=
by rw [span_union, prod_eq_sup_map, ← span_image, ← span_image]

@[simp] lemma ker_prod (f : M →ₗ[R] M₂) (g : M →ₗ[R] M₃) :
  ker (prod f g) = ker f ⊓ ker g :=
by rw [ker, ← prod_bot, comap_prod_prod]; refl

lemma range_prod_le (f : M →ₗ[R] M₂) (g : M →ₗ[R] M₃) :
  range (prod f g) ≤ (range f).prod (range g) :=
begin
  simp only [set_like.le_def, prod_apply, mem_range, set_like.mem_coe, mem_prod,
    exists_imp_distrib],
  rintro _ x rfl,
  exact ⟨⟨x, rfl⟩, ⟨x, rfl⟩⟩
end

lemma ker_prod_ker_le_ker_coprod {M₂ : Type*} [add_comm_group M₂] [module R M₂]
  {M₃ : Type*} [add_comm_group M₃] [module R M₃]
  (f : M →ₗ[R] M₃) (g : M₂ →ₗ[R] M₃) :
  (ker f).prod (ker g) ≤ ker (f.coprod g) :=
by { rintros ⟨y, z⟩, simp {contextual := tt} }

lemma ker_coprod_of_disjoint_range {M₂ : Type*} [add_comm_group M₂] [module R M₂]
  {M₃ : Type*} [add_comm_group M₃] [module R M₃]
  (f : M →ₗ[R] M₃) (g : M₂ →ₗ[R] M₃) (hd : disjoint f.range g.range) :
  ker (f.coprod g) = (ker f).prod (ker g) :=
begin
  apply le_antisymm _ (ker_prod_ker_le_ker_coprod f g),
  rintros ⟨y, z⟩ h,
  simp only [mem_ker, mem_prod, coprod_apply] at h ⊢,
  have : f y ∈ f.range ⊓ g.range,
  { simp only [true_and, mem_range, mem_inf, exists_apply_eq_apply],
    use -z,
    rwa [eq_comm, map_neg, ← sub_eq_zero, sub_neg_eq_add] },
  rw [hd.eq_bot, mem_bot] at this,
  rw [this] at h,
  simpa [this] using h,
end

end linear_map

namespace submodule
open linear_map

variables [semiring R]
variables [add_comm_monoid M] [add_comm_monoid M₂]
variables [module R M] [module R M₂]

lemma sup_eq_range (p q : submodule R M) : p ⊔ q = (p.subtype.coprod q.subtype).range :=
submodule.ext $ λ x, by simp [submodule.mem_sup, set_like.exists]

variables (p : submodule R M) (q : submodule R M₂)

@[simp] theorem map_inl : p.map (inl R M M₂) = prod p ⊥ :=
by { ext ⟨x, y⟩, simp only [and.left_comm, eq_comm, mem_map, prod.mk.inj_iff, inl_apply, mem_bot,
  exists_eq_left', mem_prod] }

@[simp] theorem map_inr : q.map (inr R M M₂) = prod ⊥ q :=
by ext ⟨x, y⟩; simp [and.left_comm, eq_comm]

@[simp] theorem comap_fst : p.comap (fst R M M₂) = prod p ⊤ :=
by ext ⟨x, y⟩; simp

@[simp] theorem comap_snd : q.comap (snd R M M₂) = prod ⊤ q :=
by ext ⟨x, y⟩; simp

@[simp] theorem prod_comap_inl : (prod p q).comap (inl R M M₂) = p := by ext; simp

@[simp] theorem prod_comap_inr : (prod p q).comap (inr R M M₂) = q := by ext; simp

@[simp] theorem prod_map_fst : (prod p q).map (fst R M M₂) = p :=
by ext x; simp [(⟨0, zero_mem _⟩ : ∃ x, x ∈ q)]

@[simp] theorem prod_map_snd : (prod p q).map (snd R M M₂) = q :=
by ext x; simp [(⟨0, zero_mem _⟩ : ∃ x, x ∈ p)]

@[simp] theorem ker_inl : (inl R M M₂).ker = ⊥ :=
by rw [ker, ← prod_bot, prod_comap_inl]

@[simp] theorem ker_inr : (inr R M M₂).ker = ⊥ :=
by rw [ker, ← prod_bot, prod_comap_inr]

@[simp] theorem range_fst : (fst R M M₂).range = ⊤ :=
by rw [range_eq_map, ← prod_top, prod_map_fst]

@[simp] theorem range_snd : (snd R M M₂).range = ⊤ :=
by rw [range_eq_map, ← prod_top, prod_map_snd]

variables (R M M₂)

/-- `M` as a submodule of `M × N`. -/
def fst : submodule R (M × M₂) := (⊥ : submodule R M₂).comap (linear_map.snd R M M₂)

/-- `M` as a submodule of `M × N` is isomorphic to `M`. -/
@[simps] def fst_equiv : submodule.fst R M M₂ ≃ₗ[R] M :=
{ to_fun := λ x, x.1.1,
  inv_fun := λ m, ⟨⟨m, 0⟩, by tidy⟩,
  map_add' := by simp,
  map_smul' := by simp,
  left_inv := by tidy,
  right_inv := by tidy, }

lemma fst_map_fst : (submodule.fst R M M₂).map (linear_map.fst R M M₂) = ⊤ :=
by tidy
lemma fst_map_snd : (submodule.fst R M M₂).map (linear_map.snd R M M₂) = ⊥ :=
by { tidy, exact 0, }

/-- `N` as a submodule of `M × N`. -/
def snd : submodule R (M × M₂) := (⊥ : submodule R M).comap (linear_map.fst R M M₂)

/-- `N` as a submodule of `M × N` is isomorphic to `N`. -/
@[simps] def snd_equiv : submodule.snd R M M₂ ≃ₗ[R] M₂ :=
{ to_fun := λ x, x.1.2,
  inv_fun := λ n, ⟨⟨0, n⟩, by tidy⟩,
  map_add' := by simp,
  map_smul' := by simp,
  left_inv := by tidy,
  right_inv := by tidy, }

lemma snd_map_fst : (submodule.snd R M M₂).map (linear_map.fst R M M₂) = ⊥ :=
by { tidy, exact 0, }
lemma snd_map_snd : (submodule.snd R M M₂).map (linear_map.snd R M M₂) = ⊤ :=
by tidy

lemma fst_sup_snd : submodule.fst R M M₂ ⊔ submodule.snd R M M₂ = ⊤ :=
begin
  rw eq_top_iff,
  rintro ⟨m, n⟩ -,
  rw [show (m, n) = (m, 0) + (0, n), by simp],
  apply submodule.add_mem (submodule.fst R M M₂ ⊔ submodule.snd R M M₂),
  { exact submodule.mem_sup_left (submodule.mem_comap.mpr (by simp)), },
  { exact submodule.mem_sup_right (submodule.mem_comap.mpr (by simp)), },
end

lemma fst_inf_snd : submodule.fst R M M₂ ⊓ submodule.snd R M M₂ = ⊥ := by tidy

lemma le_prod_iff {p₁ : submodule R M} {p₂ : submodule R M₂} {q : submodule R (M × M₂)} :
  q ≤ p₁.prod p₂ ↔ map (linear_map.fst R M M₂) q ≤ p₁ ∧ map (linear_map.snd R M M₂) q ≤ p₂ :=
begin
  split,
  { intros h,
    split,
    { rintros x ⟨⟨y1,y2⟩, ⟨hy1,rfl⟩⟩, exact (h hy1).1 },
    { rintros x ⟨⟨y1,y2⟩, ⟨hy1,rfl⟩⟩, exact (h hy1).2 }, },
  { rintros ⟨hH, hK⟩ ⟨x1, x2⟩ h, exact ⟨hH ⟨_ , h, rfl⟩, hK ⟨ _, h, rfl⟩⟩, }
end

lemma prod_le_iff {p₁ : submodule R M} {p₂ : submodule R M₂} {q : submodule R (M × M₂)} :
  p₁.prod p₂ ≤ q ↔ map (linear_map.inl R M M₂) p₁ ≤ q ∧ map (linear_map.inr R M M₂) p₂ ≤ q :=
begin
  split,
  { intros h,
    split,
    { rintros _ ⟨x, hx, rfl⟩, apply h, exact ⟨hx, zero_mem p₂⟩, },
    { rintros _ ⟨x, hx, rfl⟩, apply h, exact ⟨zero_mem p₁, hx⟩, }, },
  { rintros ⟨hH, hK⟩ ⟨x1, x2⟩ ⟨h1, h2⟩,
    have h1' : (linear_map.inl R _ _) x1 ∈ q, { apply hH, simpa using h1, },
    have h2' : (linear_map.inr R _ _) x2 ∈ q, { apply hK, simpa using h2, },
    simpa using add_mem h1' h2', }
end

lemma prod_eq_bot_iff {p₁ : submodule R M} {p₂ : submodule R M₂} :
  p₁.prod p₂ = ⊥ ↔ p₁ = ⊥ ∧ p₂ = ⊥ :=
by simp only [eq_bot_iff, prod_le_iff, (gc_map_comap _).le_iff_le, comap_bot, ker_inl, ker_inr]

lemma prod_eq_top_iff {p₁ : submodule R M} {p₂ : submodule R M₂} :
  p₁.prod p₂ = ⊤ ↔ p₁ = ⊤ ∧ p₂ = ⊤ :=
by simp only [eq_top_iff, le_prod_iff, ← (gc_map_comap _).le_iff_le, map_top, range_fst, range_snd]

end submodule

namespace linear_equiv

/-- Product of modules is commutative up to linear isomorphism. -/
@[simps apply]
def prod_comm (R M N : Type*) [semiring R] [add_comm_monoid M] [add_comm_monoid N]
  [module R M] [module R N] : (M × N) ≃ₗ[R] (N × M) :=
{ to_fun := prod.swap,
  map_smul' := λ r ⟨m, n⟩, rfl,
  ..add_equiv.prod_comm }

section

variables [semiring R]
variables [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃] [add_comm_monoid M₄]
variables {module_M : module R M} {module_M₂ : module R M₂}
variables {module_M₃ : module R M₃} {module_M₄ : module R M₄}
variables (e₁ : M ≃ₗ[R] M₂) (e₂ : M₃ ≃ₗ[R] M₄)

/-- Product of linear equivalences; the maps come from `equiv.prod_congr`. -/
protected def prod :
  (M × M₃) ≃ₗ[R] (M₂ × M₄) :=
{ map_smul' := λ c x, prod.ext (e₁.map_smulₛₗ c _) (e₂.map_smulₛₗ c _),
  .. e₁.to_add_equiv.prod_congr e₂.to_add_equiv }

lemma prod_symm : (e₁.prod e₂).symm = e₁.symm.prod e₂.symm := rfl

@[simp] lemma prod_apply (p) :
  e₁.prod e₂ p = (e₁ p.1, e₂ p.2) := rfl

@[simp, norm_cast] lemma coe_prod :
  (e₁.prod e₂ : (M × M₃) →ₗ[R] (M₂ × M₄)) = (e₁ : M →ₗ[R] M₂).prod_map (e₂ : M₃ →ₗ[R] M₄) := rfl

end

section
variables [semiring R]
variables [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃] [add_comm_group M₄]
variables {module_M : module R M} {module_M₂ : module R M₂}
variables {module_M₃ : module R M₃} {module_M₄ : module R M₄}
variables (e₁ : M ≃ₗ[R] M₂) (e₂ : M₃ ≃ₗ[R] M₄)

/-- Equivalence given by a block lower diagonal matrix. `e₁` and `e₂` are diagonal square blocks,
  and `f` is a rectangular block below the diagonal. -/
protected def skew_prod (f : M →ₗ[R] M₄) :
  (M × M₃) ≃ₗ[R] M₂ × M₄ :=
{ inv_fun := λ p : M₂ × M₄, (e₁.symm p.1, e₂.symm (p.2 - f (e₁.symm p.1))),
  left_inv := λ p, by simp,
  right_inv := λ p, by simp,
  .. ((e₁ : M →ₗ[R] M₂).comp (linear_map.fst R M M₃)).prod
    ((e₂ : M₃ →ₗ[R] M₄).comp (linear_map.snd R M M₃) +
      f.comp (linear_map.fst R M M₃)) }

@[simp] lemma skew_prod_apply (f : M →ₗ[R] M₄) (x) :
  e₁.skew_prod e₂ f x = (e₁ x.1, e₂ x.2 + f x.1) := rfl

@[simp] lemma skew_prod_symm_apply (f : M →ₗ[R] M₄) (x) :
  (e₁.skew_prod e₂ f).symm x = (e₁.symm x.1, e₂.symm (x.2 - f (e₁.symm x.1))) := rfl

end
end linear_equiv

namespace linear_map
open submodule

variables [ring R]
variables [add_comm_group M] [add_comm_group M₂] [add_comm_group M₃]
variables [module R M] [module R M₂] [module R M₃]

/-- If the union of the kernels `ker f` and `ker g` spans the domain, then the range of
`prod f g` is equal to the product of `range f` and `range g`. -/
lemma range_prod_eq {f : M →ₗ[R] M₂} {g : M →ₗ[R] M₃} (h : ker f ⊔ ker g = ⊤) :
  range (prod f g) = (range f).prod (range g) :=
begin
  refine le_antisymm (f.range_prod_le g) _,
  simp only [set_like.le_def, prod_apply, mem_range, set_like.mem_coe, mem_prod, exists_imp_distrib,
    and_imp, prod.forall, pi.prod],
  rintros _ _ x rfl y rfl,
  simp only [prod.mk.inj_iff, ← sub_mem_ker_iff],
  have : y - x ∈ ker f ⊔ ker g, { simp only [h, mem_top] },
  rcases mem_sup.1 this with ⟨x', hx', y', hy', H⟩,
  refine ⟨x' + x, _, _⟩,
  { rwa add_sub_cancel },
  { rwa [← eq_sub_iff_add_eq.1 H, add_sub_add_right_eq_sub, ← neg_mem_iff, neg_sub,
      add_sub_cancel'] }
end

end linear_map

namespace linear_map
/-!
## Tunnels and tailings

Some preliminary work for establishing the strong rank condition for noetherian rings.

Given a morphism `f : M × N →ₗ[R] M` which is `i : injective f`,
we can find an infinite decreasing `tunnel f i n` of copies of `M` inside `M`,
and sitting beside these, an infinite sequence of copies of `N`.

We picturesquely name these as `tailing f i n` for each individual copy of `N`,
and `tailings f i n` for the supremum of the first `n+1` copies:
they are the pieces left behind, sitting inside the tunnel.

By construction, each `tailing f i (n+1)` is disjoint from `tailings f i n`;
later, when we assume `M` is noetherian, this implies that `N` must be trivial,
and establishes the strong rank condition for any left-noetherian ring.
-/
section tunnel

-- (This doesn't work over a semiring: we need to use that `submodule R M` is a modular lattice,
-- which requires cancellation.)
variables [ring R]
variables {N : Type*} [add_comm_group M] [module R M] [add_comm_group N] [module R N]

open function

/-- An auxiliary construction for `tunnel`.
The composition of `f`, followed by the isomorphism back to `K`,
followed by the inclusion of this submodule back into `M`. -/
def tunnel_aux (f : M × N →ₗ[R] M) (Kφ : Σ K : submodule R M, K ≃ₗ[R] M) :
  M × N →ₗ[R] M :=
(Kφ.1.subtype.comp Kφ.2.symm.to_linear_map).comp f

lemma tunnel_aux_injective
  (f : M × N →ₗ[R] M) (i : injective f) (Kφ : Σ K : submodule R M, K ≃ₗ[R] M) :
  injective (tunnel_aux f Kφ) :=
(subtype.val_injective.comp Kφ.2.symm.injective).comp i

noncomputable theory

/-- Auxiliary definition for `tunnel`. -/
-- Even though we have `noncomputable theory`,
-- we get an error without another `noncomputable` here.
noncomputable def tunnel' (f : M × N →ₗ[R] M) (i : injective f) :
  ℕ → Σ (K : submodule R M), K ≃ₗ[R] M
| 0 := ⟨⊤, linear_equiv.of_top ⊤ rfl⟩
| (n+1) :=
⟨(submodule.fst R M N).map (tunnel_aux f (tunnel' n)),
  ((submodule.fst R M N).equiv_map_of_injective _ (tunnel_aux_injective f i (tunnel' n))).symm.trans
    (submodule.fst_equiv R M N)⟩

/--
Give an injective map `f : M × N →ₗ[R] M` we can find a nested sequence of submodules
all isomorphic to `M`.
-/
def tunnel (f : M × N →ₗ[R] M) (i : injective f) : ℕ →o (submodule R M)ᵒᵈ :=
⟨λ n, (tunnel' f i n).1, monotone_nat_of_le_succ (λ n, begin
    dsimp [tunnel', tunnel_aux],
    rw [submodule.map_comp, submodule.map_comp],
    apply submodule.map_subtype_le,
  end)⟩

/--
Give an injective map `f : M × N →ₗ[R] M` we can find a sequence of submodules
all isomorphic to `N`.
-/
def tailing (f : M × N →ₗ[R] M) (i : injective f) (n : ℕ) : submodule R M :=
(submodule.snd R M N).map (tunnel_aux f (tunnel' f i n))

/-- Each `tailing f i n` is a copy of `N`. -/
def tailing_linear_equiv (f : M × N →ₗ[R] M) (i : injective f) (n : ℕ) : tailing f i n ≃ₗ[R] N :=
((submodule.snd R M N).equiv_map_of_injective _
  (tunnel_aux_injective f i (tunnel' f i n))).symm.trans (submodule.snd_equiv R M N)

lemma tailing_le_tunnel (f : M × N →ₗ[R] M) (i : injective f) (n : ℕ) :
  tailing f i n ≤ tunnel f i n :=
begin
  dsimp [tailing, tunnel_aux],
  rw [submodule.map_comp, submodule.map_comp],
  apply submodule.map_subtype_le,
end

lemma tailing_disjoint_tunnel_succ (f : M × N →ₗ[R] M) (i : injective f) (n : ℕ) :
  disjoint (tailing f i n) (tunnel f i (n+1)) :=
begin
  rw disjoint_iff,
  dsimp [tailing, tunnel, tunnel'],
  rw [submodule.map_inf_eq_map_inf_comap,
    submodule.comap_map_eq_of_injective (tunnel_aux_injective _ i _), inf_comm,
    submodule.fst_inf_snd, submodule.map_bot],
end

lemma tailing_sup_tunnel_succ_le_tunnel (f : M × N →ₗ[R] M) (i : injective f) (n : ℕ) :
  tailing f i n ⊔ tunnel f i (n+1) ≤ tunnel f i n :=
begin
  dsimp [tailing, tunnel, tunnel', tunnel_aux],
  rw [←submodule.map_sup, sup_comm, submodule.fst_sup_snd, submodule.map_comp, submodule.map_comp],
  apply submodule.map_subtype_le,
end

/-- The supremum of all the copies of `N` found inside the tunnel. -/
def tailings (f : M × N →ₗ[R] M) (i : injective f) : ℕ → submodule R M :=
partial_sups (tailing f i)

@[simp] lemma tailings_zero (f : M × N →ₗ[R] M) (i : injective f) :
  tailings f i 0 = tailing f i 0 :=
by simp [tailings]

@[simp] lemma tailings_succ (f : M × N →ₗ[R] M) (i : injective f) (n : ℕ) :
  tailings f i (n+1) = tailings f i n ⊔ tailing f i (n+1) :=
by simp [tailings]

lemma tailings_disjoint_tunnel (f : M × N →ₗ[R] M) (i : injective f) (n : ℕ) :
  disjoint (tailings f i n) (tunnel f i (n+1)) :=
begin
  induction n with n ih,
  { simp only [tailings_zero],
    apply tailing_disjoint_tunnel_succ, },
  { simp only [tailings_succ],
    refine disjoint.disjoint_sup_left_of_disjoint_sup_right _ _,
    apply tailing_disjoint_tunnel_succ,
    apply disjoint.mono_right _ ih,
    apply tailing_sup_tunnel_succ_le_tunnel, },
end

lemma tailings_disjoint_tailing (f : M × N →ₗ[R] M) (i : injective f) (n : ℕ) :
  disjoint (tailings f i n) (tailing f i (n+1)) :=
disjoint.mono_right (tailing_le_tunnel f i _) (tailings_disjoint_tunnel f i _)

end tunnel

section graph

variables [semiring R] [add_comm_monoid M] [add_comm_monoid M₂]
  [add_comm_group M₃] [add_comm_group M₄] [module R M] [module R M₂]
  [module R M₃] [module R M₄] (f : M →ₗ[R] M₂) (g : M₃ →ₗ[R] M₄)

/-- Graph of a linear map. -/
def graph : submodule R (M × M₂) :=
{ carrier := {p | p.2 = f p.1},
  add_mem' := λ a b (ha : _ = _) (hb : _ = _),
  begin
    change _ + _ = f (_ + _),
    rw [map_add, ha, hb]
  end,
  zero_mem' := eq.symm (map_zero f),
  smul_mem' := λ c x (hx : _ = _),
  begin
    change _ • _ = f (_ • _),
    rw [map_smul, hx]
  end }

@[simp] lemma mem_graph_iff (x : M × M₂) : x ∈ f.graph ↔ x.2 = f x.1 := iff.rfl

lemma graph_eq_ker_coprod : g.graph = ((-g).coprod linear_map.id).ker :=
begin
  ext x,
  change _ = _ ↔ -(g x.1) + x.2 = _,
  rw [add_comm, add_neg_eq_zero]
end

lemma graph_eq_range_prod : f.graph = (linear_map.id.prod f).range :=
begin
  ext x,
  exact ⟨λ hx, ⟨x.1, prod.ext rfl hx.symm⟩, λ ⟨u, hu⟩, hu ▸ rfl⟩
end

end graph

end linear_map