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

! This file was ported from Lean 3 source module category_theory.limits.cone_category
! leanprover-community/mathlib commit 69c6a5a12d8a2b159f20933e60115a4f2de62b58
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Adjunction.Comma
import Mathbin.CategoryTheory.Limits.Preserves.Shapes.Terminal
import Mathbin.CategoryTheory.StructuredArrow
import Mathbin.CategoryTheory.Limits.Shapes.Equivalence

/-!
# Limits and the category of (co)cones

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

This files contains results that stem from the limit API. For the definition and the category
instance of `cone`, please refer to `category_theory/limits/cones.lean`.

## Main results
* The category of cones on `F : J ⥤ C` is equivalent to the category
  `costructured_arrow (const J) F`.
* A cone is limiting iff it is terminal in the category of cones. As a corollary, an equivalence of
  categories of cones preserves limiting properties.

-/

namespace CategoryTheory.Limits

open CategoryTheory CategoryTheory.Functor

universe v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

variable {J : Type u₁} [Category.{v₁} J] {K : Type u₂} [Category.{v₂} K]

variable {C : Type u₃} [Category.{v₃} C] {D : Type u₄} [Category.{v₄} D]

#print CategoryTheory.Limits.Cone.toCostructuredArrow /-
/-- Construct an object of the category `(Δ ↓ F)` from a cone on `F`. This is part of an
    equivalence, see `cone.equiv_costructured_arrow`. -/
@[simps]
def Cone.toCostructuredArrow (F : J ⥤ C) : Cone F ⥤ CostructuredArrow (const J) F
    where
  obj c := CostructuredArrow.mk c.π
  map c d f :=
    CostructuredArrow.homMk f.Hom <| by
      ext
      simp
#align category_theory.limits.cone.to_costructured_arrow CategoryTheory.Limits.Cone.toCostructuredArrow
-/

#print CategoryTheory.Limits.Cone.fromCostructuredArrow /-
/-- Construct a cone on `F` from an object of the category `(Δ ↓ F)`. This is part of an
    equivalence, see `cone.equiv_costructured_arrow`. -/
@[simps]
def Cone.fromCostructuredArrow (F : J ⥤ C) : CostructuredArrow (const J) F ⥤ Cone F
    where
  obj c := ⟨c.left, c.Hom⟩
  map c d f :=
    { Hom := f.left
      w' := fun j => by
        convert congr_fun (congr_arg nat_trans.app f.w) j
        dsimp
        simp }
#align category_theory.limits.cone.from_costructured_arrow CategoryTheory.Limits.Cone.fromCostructuredArrow
-/

/- warning: category_theory.limits.cone.equiv_costructured_arrow -> CategoryTheory.Limits.Cone.equivCostructuredArrow is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} J] {C : Type.{u4}} [_inst_3 : CategoryTheory.Category.{u2, u4} C] (F : CategoryTheory.Functor.{u1, u2, u3, u4} J _inst_1 C _inst_3), CategoryTheory.Equivalence.{u2, max u3 u2, max u3 u4 u2, max u4 u3 u2} (CategoryTheory.Limits.Cone.{u1, u2, u3, u4} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u2, u3, u4} J _inst_1 C _inst_3 F) (CategoryTheory.CostructuredArrow.{u2, max u3 u2, u4, max u1 u2 u3 u4} C _inst_3 (CategoryTheory.Functor.{u1, u2, u3, u4} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u3, u4} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u3, u4} J _inst_1 C _inst_3) F) (CategoryTheory.CostructuredArrow.category.{max u3 u2, max u1 u2 u3 u4, u4, u2} C _inst_3 (CategoryTheory.Functor.{u1, u2, u3, u4} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u3, u4} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u3, u4} J _inst_1 C _inst_3) F)
but is expected to have type
  forall {J : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} J] {C : Type.{u4}} [_inst_3 : CategoryTheory.Category.{u2, u4} C] (F : CategoryTheory.Functor.{u1, u2, u3, u4} J _inst_1 C _inst_3), CategoryTheory.Equivalence.{u2, max u3 u2, max (max u4 u3) u2, max u4 u3 u2} (CategoryTheory.Limits.Cone.{u1, u2, u3, u4} J _inst_1 C _inst_3 F) (CategoryTheory.CostructuredArrow.{u2, max u3 u2, u4, max (max (max u3 u1) u4) u2} C _inst_3 (CategoryTheory.Functor.{u1, u2, u3, u4} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u3, u4} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u3, u4} J _inst_1 C _inst_3) F) (CategoryTheory.Limits.Cone.category.{u1, u2, u3, u4} J _inst_1 C _inst_3 F) (CategoryTheory.instCategoryCostructuredArrow.{u2, max u3 u2, u4, max (max (max u3 u4) u1) u2} C _inst_3 (CategoryTheory.Functor.{u1, u2, u3, u4} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u3, u4} J _inst_1 C _inst_3) (CategoryTheory.Functor.const.{u1, u2, u3, u4} J _inst_1 C _inst_3) F)
Case conversion may be inaccurate. Consider using '#align category_theory.limits.cone.equiv_costructured_arrow CategoryTheory.Limits.Cone.equivCostructuredArrowₓ'. -/
/-- The category of cones on `F` is just the comma category `(Δ ↓ F)`, where `Δ` is the constant
    functor. -/
@[simps]
def Cone.equivCostructuredArrow (F : J ⥤ C) : Cone F ≌ CostructuredArrow (const J) F :=
  Equivalence.mk (Cone.toCostructuredArrow F) (Cone.fromCostructuredArrow F)
    (NatIso.ofComponents Cones.eta (by tidy))
    (NatIso.ofComponents (fun c => (CostructuredArrow.eta _).symm) (by tidy))
#align category_theory.limits.cone.equiv_costructured_arrow CategoryTheory.Limits.Cone.equivCostructuredArrow

#print CategoryTheory.Limits.Cone.isLimitEquivIsTerminal /-
/-- A cone is a limit cone iff it is terminal. -/
def Cone.isLimitEquivIsTerminal {F : J ⥤ C} (c : Cone F) : IsLimit c ≃ IsTerminal c :=
  IsLimit.isoUniqueConeMorphism.toEquiv.trans
    { toFun := fun h => is_terminal.of_unique _
      invFun := fun h s => ⟨⟨IsTerminal.from h s⟩, fun a => IsTerminal.hom_ext h a _⟩
      left_inv := by tidy
      right_inv := by tidy }
#align category_theory.limits.cone.is_limit_equiv_is_terminal CategoryTheory.Limits.Cone.isLimitEquivIsTerminal
-/

#print CategoryTheory.Limits.hasLimit_iff_hasTerminal_cone /-
theorem hasLimit_iff_hasTerminal_cone (F : J ⥤ C) : HasLimit F ↔ HasTerminal (Cone F) :=
  ⟨fun h => (cone.is_limit_equiv_is_terminal _ (limit.is_limit F)).HasTerminal, fun h =>
    ⟨⟨⟨⊤_ _, (cone.is_limit_equiv_is_terminal _).symm terminal_is_terminal⟩⟩⟩⟩
#align category_theory.limits.has_limit_iff_has_terminal_cone CategoryTheory.Limits.hasLimit_iff_hasTerminal_cone
-/

#print CategoryTheory.Limits.hasLimitsOfShape_iff_isLeftAdjoint_const /-
theorem hasLimitsOfShape_iff_isLeftAdjoint_const :
    HasLimitsOfShape J C ↔ Nonempty (IsLeftAdjoint (const J : C ⥤ _)) :=
  calc
    HasLimitsOfShape J C ↔ ∀ F : J ⥤ C, HasLimit F :=
      ⟨fun h => h.HasLimit, fun h => has_limits_of_shape.mk⟩
    _ ↔ ∀ F : J ⥤ C, HasTerminal (Cone F) := (forall_congr' hasLimit_iff_hasTerminal_cone)
    _ ↔ ∀ F : J ⥤ C, HasTerminal (CostructuredArrow (const J) F) :=
      (forall_congr' fun F => (Cone.equivCostructuredArrow F).hasTerminal_iff)
    _ ↔ Nonempty (IsLeftAdjoint (const J : C ⥤ _)) :=
      nonempty_isLeftAdjoint_iff_hasTerminal_costructuredArrow.symm

#align category_theory.limits.has_limits_of_shape_iff_is_left_adjoint_const CategoryTheory.Limits.hasLimitsOfShape_iff_isLeftAdjoint_const
-/

#print CategoryTheory.Limits.IsLimit.liftConeMorphism_eq_isTerminal_from /-
theorem IsLimit.liftConeMorphism_eq_isTerminal_from {F : J ⥤ C} {c : Cone F} (hc : IsLimit c)
    (s : Cone F) : hc.liftConeMorphism s = IsTerminal.from (Cone.isLimitEquivIsTerminal _ hc) _ :=
  rfl
#align category_theory.limits.is_limit.lift_cone_morphism_eq_is_terminal_from CategoryTheory.Limits.IsLimit.liftConeMorphism_eq_isTerminal_from
-/

#print CategoryTheory.Limits.IsTerminal.from_eq_liftConeMorphism /-
theorem IsTerminal.from_eq_liftConeMorphism {F : J ⥤ C} {c : Cone F} (hc : IsTerminal c)
    (s : Cone F) :
    IsTerminal.from hc s = ((Cone.isLimitEquivIsTerminal _).symm hc).liftConeMorphism s := by
  convert(is_limit.lift_cone_morphism_eq_is_terminal_from _ s).symm
#align category_theory.limits.is_terminal.from_eq_lift_cone_morphism CategoryTheory.Limits.IsTerminal.from_eq_liftConeMorphism
-/

/- warning: category_theory.limits.is_limit.of_preserves_cone_terminal -> CategoryTheory.Limits.IsLimit.ofPreservesConeTerminal is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u5}} [_inst_1 : CategoryTheory.Category.{u1, u5} J] {K : Type.{u6}} [_inst_2 : CategoryTheory.Category.{u2, u6} K] {C : Type.{u7}} [_inst_3 : CategoryTheory.Category.{u3, u7} C] {D : Type.{u8}} [_inst_4 : CategoryTheory.Category.{u4, u8} D] {F : CategoryTheory.Functor.{u1, u3, u5, u7} J _inst_1 C _inst_3} {F' : CategoryTheory.Functor.{u2, u4, u6, u8} K _inst_2 D _inst_4} (G : CategoryTheory.Functor.{u3, u4, max u5 u7 u3, max u6 u8 u4} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F')) [_inst_5 : CategoryTheory.Limits.PreservesLimit.{0, 0, u3, u4, max u5 u7 u3, max u6 u8 u4} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Discrete.{0} PEmpty.{1}) (CategoryTheory.discreteCategory.{0} PEmpty.{1}) (CategoryTheory.Functor.empty.{0, u3, max u5 u7 u3} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F)) G] {c : CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F}, (CategoryTheory.Limits.IsLimit.{u1, u3, u5, u7} J _inst_1 C _inst_3 F c) -> (CategoryTheory.Limits.IsLimit.{u2, u4, u6, u8} K _inst_2 D _inst_4 F' (CategoryTheory.Functor.obj.{u3, u4, max u5 u7 u3, max u6 u8 u4} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') G c))
but is expected to have type
  forall {J : Type.{u5}} [_inst_1 : CategoryTheory.Category.{u1, u5} J] {K : Type.{u6}} [_inst_2 : CategoryTheory.Category.{u2, u6} K] {C : Type.{u7}} [_inst_3 : CategoryTheory.Category.{u3, u7} C] {D : Type.{u8}} [_inst_4 : CategoryTheory.Category.{u4, u8} D] {F : CategoryTheory.Functor.{u1, u3, u5, u7} J _inst_1 C _inst_3} {F' : CategoryTheory.Functor.{u2, u4, u6, u8} K _inst_2 D _inst_4} (G : CategoryTheory.Functor.{u3, u4, max (max u7 u5) u3, max (max u8 u6) u4} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F')) [_inst_5 : CategoryTheory.Limits.PreservesLimit.{0, 0, u3, u4, max (max u5 u7) u3, max (max u6 u8) u4} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Discrete.{0} PEmpty.{1}) (CategoryTheory.discreteCategory.{0} PEmpty.{1}) (CategoryTheory.Functor.empty.{0, u3, max (max u5 u7) u3} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F)) G] {c : CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F}, (CategoryTheory.Limits.IsLimit.{u1, u3, u5, u7} J _inst_1 C _inst_3 F c) -> (CategoryTheory.Limits.IsLimit.{u2, u4, u6, u8} K _inst_2 D _inst_4 F' (Prefunctor.obj.{succ u3, succ u4, max (max u5 u7) u3, max (max u6 u8) u4} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.CategoryStruct.toQuiver.{u3, max (max u5 u7) u3} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Category.toCategoryStruct.{u3, max (max u5 u7) u3} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F))) (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.CategoryStruct.toQuiver.{u4, max (max u6 u8) u4} (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Category.toCategoryStruct.{u4, max (max u6 u8) u4} (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F'))) (CategoryTheory.Functor.toPrefunctor.{u3, u4, max (max u5 u7) u3, max (max u6 u8) u4} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') G) c))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.is_limit.of_preserves_cone_terminal CategoryTheory.Limits.IsLimit.ofPreservesConeTerminalₓ'. -/
/-- If `G : cone F ⥤ cone F'` preserves terminal objects, it preserves limit cones. -/
def IsLimit.ofPreservesConeTerminal {F : J ⥤ C} {F' : K ⥤ D} (G : Cone F ⥤ Cone F')
    [PreservesLimit (Functor.empty.{0} _) G] {c : Cone F} (hc : IsLimit c) : IsLimit (G.obj c) :=
  (Cone.isLimitEquivIsTerminal _).symm <| (Cone.isLimitEquivIsTerminal _ hc).isTerminalObj _ _
#align category_theory.limits.is_limit.of_preserves_cone_terminal CategoryTheory.Limits.IsLimit.ofPreservesConeTerminal

/- warning: category_theory.limits.is_limit.of_reflects_cone_terminal -> CategoryTheory.Limits.IsLimit.ofReflectsConeTerminal is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u5}} [_inst_1 : CategoryTheory.Category.{u1, u5} J] {K : Type.{u6}} [_inst_2 : CategoryTheory.Category.{u2, u6} K] {C : Type.{u7}} [_inst_3 : CategoryTheory.Category.{u3, u7} C] {D : Type.{u8}} [_inst_4 : CategoryTheory.Category.{u4, u8} D] {F : CategoryTheory.Functor.{u1, u3, u5, u7} J _inst_1 C _inst_3} {F' : CategoryTheory.Functor.{u2, u4, u6, u8} K _inst_2 D _inst_4} (G : CategoryTheory.Functor.{u3, u4, max u5 u7 u3, max u6 u8 u4} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F')) [_inst_5 : CategoryTheory.Limits.ReflectsLimit.{0, 0, u3, u4, max u5 u7 u3, max u6 u8 u4} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Discrete.{0} PEmpty.{1}) (CategoryTheory.discreteCategory.{0} PEmpty.{1}) (CategoryTheory.Functor.empty.{0, u3, max u5 u7 u3} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F)) G] {c : CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F}, (CategoryTheory.Limits.IsLimit.{u2, u4, u6, u8} K _inst_2 D _inst_4 F' (CategoryTheory.Functor.obj.{u3, u4, max u5 u7 u3, max u6 u8 u4} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') G c)) -> (CategoryTheory.Limits.IsLimit.{u1, u3, u5, u7} J _inst_1 C _inst_3 F c)
but is expected to have type
  forall {J : Type.{u5}} [_inst_1 : CategoryTheory.Category.{u1, u5} J] {K : Type.{u6}} [_inst_2 : CategoryTheory.Category.{u2, u6} K] {C : Type.{u7}} [_inst_3 : CategoryTheory.Category.{u3, u7} C] {D : Type.{u8}} [_inst_4 : CategoryTheory.Category.{u4, u8} D] {F : CategoryTheory.Functor.{u1, u3, u5, u7} J _inst_1 C _inst_3} {F' : CategoryTheory.Functor.{u2, u4, u6, u8} K _inst_2 D _inst_4} (G : CategoryTheory.Functor.{u3, u4, max (max u7 u5) u3, max (max u8 u6) u4} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F')) [_inst_5 : CategoryTheory.Limits.ReflectsLimit.{0, 0, u3, u4, max (max u5 u7) u3, max (max u6 u8) u4} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Discrete.{0} PEmpty.{1}) (CategoryTheory.discreteCategory.{0} PEmpty.{1}) (CategoryTheory.Functor.empty.{0, u3, max (max u5 u7) u3} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F)) G] {c : CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F}, (CategoryTheory.Limits.IsLimit.{u2, u4, u6, u8} K _inst_2 D _inst_4 F' (Prefunctor.obj.{succ u3, succ u4, max (max u5 u7) u3, max (max u6 u8) u4} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.CategoryStruct.toQuiver.{u3, max (max u5 u7) u3} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Category.toCategoryStruct.{u3, max (max u5 u7) u3} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F))) (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.CategoryStruct.toQuiver.{u4, max (max u6 u8) u4} (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Category.toCategoryStruct.{u4, max (max u6 u8) u4} (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F'))) (CategoryTheory.Functor.toPrefunctor.{u3, u4, max (max u5 u7) u3, max (max u6 u8) u4} (CategoryTheory.Limits.Cone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') G) c)) -> (CategoryTheory.Limits.IsLimit.{u1, u3, u5, u7} J _inst_1 C _inst_3 F c)
Case conversion may be inaccurate. Consider using '#align category_theory.limits.is_limit.of_reflects_cone_terminal CategoryTheory.Limits.IsLimit.ofReflectsConeTerminalₓ'. -/
/-- If `G : cone F ⥤ cone F'` reflects terminal objects, it reflects limit cones. -/
def IsLimit.ofReflectsConeTerminal {F : J ⥤ C} {F' : K ⥤ D} (G : Cone F ⥤ Cone F')
    [ReflectsLimit (Functor.empty.{0} _) G] {c : Cone F} (hc : IsLimit (G.obj c)) : IsLimit c :=
  (Cone.isLimitEquivIsTerminal _).symm <| (Cone.isLimitEquivIsTerminal _ hc).isTerminalOfObj _ _
#align category_theory.limits.is_limit.of_reflects_cone_terminal CategoryTheory.Limits.IsLimit.ofReflectsConeTerminal

#print CategoryTheory.Limits.Cocone.toStructuredArrow /-
/-- Construct an object of the category `(F ↓ Δ)` from a cocone on `F`. This is part of an
    equivalence, see `cocone.equiv_structured_arrow`. -/
@[simps]
def Cocone.toStructuredArrow (F : J ⥤ C) : Cocone F ⥤ StructuredArrow F (const J)
    where
  obj c := StructuredArrow.mk c.ι
  map c d f :=
    StructuredArrow.homMk f.Hom <| by
      ext
      simp
#align category_theory.limits.cocone.to_structured_arrow CategoryTheory.Limits.Cocone.toStructuredArrow
-/

#print CategoryTheory.Limits.Cocone.fromStructuredArrow /-
/-- Construct a cocone on `F` from an object of the category `(F ↓ Δ)`. This is part of an
    equivalence, see `cocone.equiv_structured_arrow`. -/
@[simps]
def Cocone.fromStructuredArrow (F : J ⥤ C) : StructuredArrow F (const J) ⥤ Cocone F
    where
  obj c := ⟨c.right, c.Hom⟩
  map c d f :=
    { Hom := f.right
      w' := fun j => by
        convert(congr_fun (congr_arg nat_trans.app f.w) j).symm
        dsimp
        simp }
#align category_theory.limits.cocone.from_structured_arrow CategoryTheory.Limits.Cocone.fromStructuredArrow
-/

/- warning: category_theory.limits.cocone.equiv_structured_arrow -> CategoryTheory.Limits.Cocone.equivStructuredArrow is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} J] {C : Type.{u4}} [_inst_3 : CategoryTheory.Category.{u2, u4} C] (F : CategoryTheory.Functor.{u1, u2, u3, u4} J _inst_1 C _inst_3), CategoryTheory.Equivalence.{u2, max u3 u2, max u3 u4 u2, max u4 u3 u2} (CategoryTheory.Limits.Cocone.{u1, u2, u3, u4} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u2, u3, u4} J _inst_1 C _inst_3 F) (CategoryTheory.StructuredArrow.{u2, max u3 u2, u4, max u1 u2 u3 u4} C _inst_3 (CategoryTheory.Functor.{u1, u2, u3, u4} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u3, u4} J _inst_1 C _inst_3) F (CategoryTheory.Functor.const.{u1, u2, u3, u4} J _inst_1 C _inst_3)) (CategoryTheory.StructuredArrow.category.{max u3 u2, max u1 u2 u3 u4, u4, u2} C _inst_3 (CategoryTheory.Functor.{u1, u2, u3, u4} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u3, u4} J _inst_1 C _inst_3) F (CategoryTheory.Functor.const.{u1, u2, u3, u4} J _inst_1 C _inst_3))
but is expected to have type
  forall {J : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u1, u3} J] {C : Type.{u4}} [_inst_3 : CategoryTheory.Category.{u2, u4} C] (F : CategoryTheory.Functor.{u1, u2, u3, u4} J _inst_1 C _inst_3), CategoryTheory.Equivalence.{u2, max u3 u2, max (max u4 u3) u2, max u4 u3 u2} (CategoryTheory.Limits.Cocone.{u1, u2, u3, u4} J _inst_1 C _inst_3 F) (CategoryTheory.StructuredArrow.{u2, max u3 u2, u4, max (max (max u3 u4) u1) u2} C _inst_3 (CategoryTheory.Functor.{u1, u2, u3, u4} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u3, u4} J _inst_1 C _inst_3) F (CategoryTheory.Functor.const.{u1, u2, u3, u4} J _inst_1 C _inst_3)) (CategoryTheory.Limits.Cocone.category.{u1, u2, u3, u4} J _inst_1 C _inst_3 F) (CategoryTheory.instCategoryStructuredArrow.{u2, max u3 u2, u4, max (max (max u3 u4) u1) u2} C _inst_3 (CategoryTheory.Functor.{u1, u2, u3, u4} J _inst_1 C _inst_3) (CategoryTheory.Functor.category.{u1, u2, u3, u4} J _inst_1 C _inst_3) F (CategoryTheory.Functor.const.{u1, u2, u3, u4} J _inst_1 C _inst_3))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.cocone.equiv_structured_arrow CategoryTheory.Limits.Cocone.equivStructuredArrowₓ'. -/
/-- The category of cocones on `F` is just the comma category `(F ↓ Δ)`, where `Δ` is the constant
    functor. -/
@[simps]
def Cocone.equivStructuredArrow (F : J ⥤ C) : Cocone F ≌ StructuredArrow F (const J) :=
  Equivalence.mk (Cocone.toStructuredArrow F) (Cocone.fromStructuredArrow F)
    (NatIso.ofComponents Cocones.eta (by tidy))
    (NatIso.ofComponents (fun c => (StructuredArrow.eta _).symm) (by tidy))
#align category_theory.limits.cocone.equiv_structured_arrow CategoryTheory.Limits.Cocone.equivStructuredArrow

#print CategoryTheory.Limits.Cocone.isColimitEquivIsInitial /-
/-- A cocone is a colimit cocone iff it is initial. -/
def Cocone.isColimitEquivIsInitial {F : J ⥤ C} (c : Cocone F) : IsColimit c ≃ IsInitial c :=
  IsColimit.isoUniqueCoconeMorphism.toEquiv.trans
    { toFun := fun h => is_initial.of_unique _
      invFun := fun h s => ⟨⟨IsInitial.to h s⟩, fun a => IsInitial.hom_ext h a _⟩
      left_inv := by tidy
      right_inv := by tidy }
#align category_theory.limits.cocone.is_colimit_equiv_is_initial CategoryTheory.Limits.Cocone.isColimitEquivIsInitial
-/

#print CategoryTheory.Limits.hasColimit_iff_hasInitial_cocone /-
theorem hasColimit_iff_hasInitial_cocone (F : J ⥤ C) : HasColimit F ↔ HasInitial (Cocone F) :=
  ⟨fun h => (cocone.is_colimit_equiv_is_initial _ (colimit.is_colimit F)).HasInitial, fun h =>
    ⟨⟨⟨⊥_ _, (cocone.is_colimit_equiv_is_initial _).symm initial_is_initial⟩⟩⟩⟩
#align category_theory.limits.has_colimit_iff_has_initial_cocone CategoryTheory.Limits.hasColimit_iff_hasInitial_cocone
-/

#print CategoryTheory.Limits.hasColimitsOfShape_iff_isRightAdjoint_const /-
theorem hasColimitsOfShape_iff_isRightAdjoint_const :
    HasColimitsOfShape J C ↔ Nonempty (IsRightAdjoint (const J : C ⥤ _)) :=
  calc
    HasColimitsOfShape J C ↔ ∀ F : J ⥤ C, HasColimit F :=
      ⟨fun h => h.HasColimit, fun h => has_colimits_of_shape.mk⟩
    _ ↔ ∀ F : J ⥤ C, HasInitial (Cocone F) := (forall_congr' hasColimit_iff_hasInitial_cocone)
    _ ↔ ∀ F : J ⥤ C, HasInitial (StructuredArrow F (const J)) :=
      (forall_congr' fun F => (Cocone.equivStructuredArrow F).hasInitial_iff)
    _ ↔ Nonempty (IsRightAdjoint (const J : C ⥤ _)) :=
      nonempty_isRightAdjoint_iff_hasInitial_structuredArrow.symm

#align category_theory.limits.has_colimits_of_shape_iff_is_right_adjoint_const CategoryTheory.Limits.hasColimitsOfShape_iff_isRightAdjoint_const
-/

#print CategoryTheory.Limits.IsColimit.descCoconeMorphism_eq_isInitial_to /-
theorem IsColimit.descCoconeMorphism_eq_isInitial_to {F : J ⥤ C} {c : Cocone F} (hc : IsColimit c)
    (s : Cocone F) :
    hc.descCoconeMorphism s = IsInitial.to (Cocone.isColimitEquivIsInitial _ hc) _ :=
  rfl
#align category_theory.limits.is_colimit.desc_cocone_morphism_eq_is_initial_to CategoryTheory.Limits.IsColimit.descCoconeMorphism_eq_isInitial_to
-/

#print CategoryTheory.Limits.IsInitial.to_eq_descCoconeMorphism /-
theorem IsInitial.to_eq_descCoconeMorphism {F : J ⥤ C} {c : Cocone F} (hc : IsInitial c)
    (s : Cocone F) :
    IsInitial.to hc s = ((Cocone.isColimitEquivIsInitial _).symm hc).descCoconeMorphism s := by
  convert(is_colimit.desc_cocone_morphism_eq_is_initial_to _ s).symm
#align category_theory.limits.is_initial.to_eq_desc_cocone_morphism CategoryTheory.Limits.IsInitial.to_eq_descCoconeMorphism
-/

/- warning: category_theory.limits.is_colimit.of_preserves_cocone_initial -> CategoryTheory.Limits.IsColimit.ofPreservesCoconeInitial is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u5}} [_inst_1 : CategoryTheory.Category.{u1, u5} J] {K : Type.{u6}} [_inst_2 : CategoryTheory.Category.{u2, u6} K] {C : Type.{u7}} [_inst_3 : CategoryTheory.Category.{u3, u7} C] {D : Type.{u8}} [_inst_4 : CategoryTheory.Category.{u4, u8} D] {F : CategoryTheory.Functor.{u1, u3, u5, u7} J _inst_1 C _inst_3} {F' : CategoryTheory.Functor.{u2, u4, u6, u8} K _inst_2 D _inst_4} (G : CategoryTheory.Functor.{u3, u4, max u5 u7 u3, max u6 u8 u4} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cocone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F')) [_inst_5 : CategoryTheory.Limits.PreservesColimit.{0, 0, u3, u4, max u5 u7 u3, max u6 u8 u4} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cocone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Discrete.{0} PEmpty.{1}) (CategoryTheory.discreteCategory.{0} PEmpty.{1}) (CategoryTheory.Functor.empty.{0, u3, max u5 u7 u3} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F)) G] {c : CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F}, (CategoryTheory.Limits.IsColimit.{u1, u3, u5, u7} J _inst_1 C _inst_3 F c) -> (CategoryTheory.Limits.IsColimit.{u2, u4, u6, u8} K _inst_2 D _inst_4 F' (CategoryTheory.Functor.obj.{u3, u4, max u5 u7 u3, max u6 u8 u4} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cocone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') G c))
but is expected to have type
  forall {J : Type.{u5}} [_inst_1 : CategoryTheory.Category.{u1, u5} J] {K : Type.{u6}} [_inst_2 : CategoryTheory.Category.{u2, u6} K] {C : Type.{u7}} [_inst_3 : CategoryTheory.Category.{u3, u7} C] {D : Type.{u8}} [_inst_4 : CategoryTheory.Category.{u4, u8} D] {F : CategoryTheory.Functor.{u1, u3, u5, u7} J _inst_1 C _inst_3} {F' : CategoryTheory.Functor.{u2, u4, u6, u8} K _inst_2 D _inst_4} (G : CategoryTheory.Functor.{u3, u4, max (max u7 u5) u3, max (max u8 u6) u4} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cocone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F')) [_inst_5 : CategoryTheory.Limits.PreservesColimit.{0, 0, u3, u4, max (max u5 u7) u3, max (max u6 u8) u4} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cocone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Discrete.{0} PEmpty.{1}) (CategoryTheory.discreteCategory.{0} PEmpty.{1}) (CategoryTheory.Functor.empty.{0, u3, max (max u5 u7) u3} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F)) G] {c : CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F}, (CategoryTheory.Limits.IsColimit.{u1, u3, u5, u7} J _inst_1 C _inst_3 F c) -> (CategoryTheory.Limits.IsColimit.{u2, u4, u6, u8} K _inst_2 D _inst_4 F' (Prefunctor.obj.{succ u3, succ u4, max (max u5 u7) u3, max (max u6 u8) u4} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.CategoryStruct.toQuiver.{u3, max (max u5 u7) u3} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Category.toCategoryStruct.{u3, max (max u5 u7) u3} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F))) (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.CategoryStruct.toQuiver.{u4, max (max u6 u8) u4} (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Category.toCategoryStruct.{u4, max (max u6 u8) u4} (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cocone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F'))) (CategoryTheory.Functor.toPrefunctor.{u3, u4, max (max u5 u7) u3, max (max u6 u8) u4} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cocone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') G) c))
Case conversion may be inaccurate. Consider using '#align category_theory.limits.is_colimit.of_preserves_cocone_initial CategoryTheory.Limits.IsColimit.ofPreservesCoconeInitialₓ'. -/
/-- If `G : cocone F ⥤ cocone F'` preserves initial objects, it preserves colimit cocones. -/
def IsColimit.ofPreservesCoconeInitial {F : J ⥤ C} {F' : K ⥤ D} (G : Cocone F ⥤ Cocone F')
    [PreservesColimit (Functor.empty.{0} _) G] {c : Cocone F} (hc : IsColimit c) :
    IsColimit (G.obj c) :=
  (Cocone.isColimitEquivIsInitial _).symm <| (Cocone.isColimitEquivIsInitial _ hc).isInitialObj _ _
#align category_theory.limits.is_colimit.of_preserves_cocone_initial CategoryTheory.Limits.IsColimit.ofPreservesCoconeInitial

/- warning: category_theory.limits.is_colimit.of_reflects_cocone_initial -> CategoryTheory.Limits.IsColimit.ofReflectsCoconeInitial is a dubious translation:
lean 3 declaration is
  forall {J : Type.{u5}} [_inst_1 : CategoryTheory.Category.{u1, u5} J] {K : Type.{u6}} [_inst_2 : CategoryTheory.Category.{u2, u6} K] {C : Type.{u7}} [_inst_3 : CategoryTheory.Category.{u3, u7} C] {D : Type.{u8}} [_inst_4 : CategoryTheory.Category.{u4, u8} D] {F : CategoryTheory.Functor.{u1, u3, u5, u7} J _inst_1 C _inst_3} {F' : CategoryTheory.Functor.{u2, u4, u6, u8} K _inst_2 D _inst_4} (G : CategoryTheory.Functor.{u3, u4, max u5 u7 u3, max u6 u8 u4} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cocone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F')) [_inst_5 : CategoryTheory.Limits.ReflectsColimit.{0, 0, u3, u4, max u5 u7 u3, max u6 u8 u4} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cocone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Discrete.{0} PEmpty.{1}) (CategoryTheory.discreteCategory.{0} PEmpty.{1}) (CategoryTheory.Functor.empty.{0, u3, max u5 u7 u3} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F)) G] {c : CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F}, (CategoryTheory.Limits.IsColimit.{u2, u4, u6, u8} K _inst_2 D _inst_4 F' (CategoryTheory.Functor.obj.{u3, u4, max u5 u7 u3, max u6 u8 u4} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cocone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') G c)) -> (CategoryTheory.Limits.IsColimit.{u1, u3, u5, u7} J _inst_1 C _inst_3 F c)
but is expected to have type
  forall {J : Type.{u5}} [_inst_1 : CategoryTheory.Category.{u1, u5} J] {K : Type.{u6}} [_inst_2 : CategoryTheory.Category.{u2, u6} K] {C : Type.{u7}} [_inst_3 : CategoryTheory.Category.{u3, u7} C] {D : Type.{u8}} [_inst_4 : CategoryTheory.Category.{u4, u8} D] {F : CategoryTheory.Functor.{u1, u3, u5, u7} J _inst_1 C _inst_3} {F' : CategoryTheory.Functor.{u2, u4, u6, u8} K _inst_2 D _inst_4} (G : CategoryTheory.Functor.{u3, u4, max (max u7 u5) u3, max (max u8 u6) u4} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cocone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F')) [_inst_5 : CategoryTheory.Limits.ReflectsColimit.{0, 0, u3, u4, max (max u5 u7) u3, max (max u6 u8) u4} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cocone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Discrete.{0} PEmpty.{1}) (CategoryTheory.discreteCategory.{0} PEmpty.{1}) (CategoryTheory.Functor.empty.{0, u3, max (max u5 u7) u3} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F)) G] {c : CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F}, (CategoryTheory.Limits.IsColimit.{u2, u4, u6, u8} K _inst_2 D _inst_4 F' (Prefunctor.obj.{succ u3, succ u4, max (max u5 u7) u3, max (max u6 u8) u4} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.CategoryStruct.toQuiver.{u3, max (max u5 u7) u3} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Category.toCategoryStruct.{u3, max (max u5 u7) u3} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F))) (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.CategoryStruct.toQuiver.{u4, max (max u6 u8) u4} (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Category.toCategoryStruct.{u4, max (max u6 u8) u4} (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cocone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F'))) (CategoryTheory.Functor.toPrefunctor.{u3, u4, max (max u5 u7) u3, max (max u6 u8) u4} (CategoryTheory.Limits.Cocone.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.category.{u1, u3, u5, u7} J _inst_1 C _inst_3 F) (CategoryTheory.Limits.Cocone.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') (CategoryTheory.Limits.Cocone.category.{u2, u4, u6, u8} K _inst_2 D _inst_4 F') G) c)) -> (CategoryTheory.Limits.IsColimit.{u1, u3, u5, u7} J _inst_1 C _inst_3 F c)
Case conversion may be inaccurate. Consider using '#align category_theory.limits.is_colimit.of_reflects_cocone_initial CategoryTheory.Limits.IsColimit.ofReflectsCoconeInitialₓ'. -/
/-- If `G : cocone F ⥤ cocone F'` reflects initial objects, it reflects colimit cocones. -/
def IsColimit.ofReflectsCoconeInitial {F : J ⥤ C} {F' : K ⥤ D} (G : Cocone F ⥤ Cocone F')
    [ReflectsColimit (Functor.empty.{0} _) G] {c : Cocone F} (hc : IsColimit (G.obj c)) :
    IsColimit c :=
  (Cocone.isColimitEquivIsInitial _).symm <|
    (Cocone.isColimitEquivIsInitial _ hc).isInitialOfObj _ _
#align category_theory.limits.is_colimit.of_reflects_cocone_initial CategoryTheory.Limits.IsColimit.ofReflectsCoconeInitial

end CategoryTheory.Limits


/- Library 3.1: Program Semantics — Operational Semantics -/

/- Some auxiliary lemmas concerning logical connectives and relations -/

@[simp] lemma or_imp_distrib {p q r : Prop} : p ∨ q → r ↔ (p → r) ∧ (q → r) :=
iff.intro
  (assume h, ⟨assume hp, h (or.intro_left _ hp), assume hq, h (or.intro_right _ hq)⟩)
  (assume ⟨hp, hq⟩ h, match h with or.inl h := hp h | or.inr h := hq h end)

@[simp] lemma and_imp_distrib {p q r : Prop} : p ∧ q → r ↔ (p → q → r) :=
iff.intro
  (assume h hp hq, h ⟨hp, hq⟩)
  (assume h ⟨hp, hq⟩, h hp hq)

@[simp] lemma exists_imp_distrib {α : Sort*} {p : α → Prop} {q : Prop} :
  ((∃a, p a) → q) ↔ (∀a, p a → q) :=
iff.intro
  (assume h hp hq, h ⟨hp, hq⟩)
  (assume h ⟨hp, hq⟩, h hp hq)

lemma and_exists {α : Sort*} {p : α → Prop} {q : Prop} :
  (q ∧ (∃a, p a)) ↔ (∃a, q ∧ p a) :=
iff.intro
  (assume ⟨h₁, a, h₂⟩, ⟨a, h₁, h₂⟩)
  (assume ⟨a, h₁, h₂⟩, ⟨h₁, a, h₂⟩)

@[simp] lemma exists_false {α : Sort*} : (∃a:α, false) ↔ false :=
iff.intro (assume ⟨a, f⟩, f) (assume h, h.elim)

/-- `refl_trans r`: relexive and transitive closure of `r` -/
inductive refl_trans {α : Sort*} (r : α → α → Prop) (a : α) : α → Prop
| refl {} : refl_trans a
| tail {b c} : refl_trans b → r b c → refl_trans c

attribute [refl] refl_trans.refl

namespace refl_trans
variables {α : Sort*} {r : α → α → Prop} {a b c d : α}

@[trans] lemma trans (hab : refl_trans r a b) (hbc : refl_trans r b c) : refl_trans r a c :=
begin
  induction hbc,
  case refl_trans.refl { assumption },
  case refl_trans.tail : c d hbc hcd hac { exact hac.tail hcd }
end

lemma single (hab : r a b) : refl_trans r a b :=
refl.tail hab

lemma head (hab : r a b) (hbc : refl_trans r b c) : refl_trans r a c :=
begin
  induction hbc,
  case refl_trans.refl { exact refl.tail hab },
  case refl_trans.tail : c d hbc hcd hac { exact hac.tail hcd }
end

lemma head_induction_on {α : Sort*} {r : α → α → Prop} {b : α}
  {P : ∀(a:α), refl_trans r a b → Prop}
  {a : α} (h : refl_trans r a b)
  (refl : P b refl)
  (head : ∀{a c} (h' : r a c) (h : refl_trans r c b), P c h → P a (h.head h')) :
  P a h :=
begin
  induction h generalizing P,
  case refl_trans.refl { exact refl },
  case refl_trans.tail : b c hab hbc ih {
    apply ih,
    show P b _, from head hbc _ refl,
    show ∀a a', r a a' → refl_trans r a' b → P a' _ → P a _, from assume a a' hab hbc, head hab _
  }
end

lemma trans_induction_on {α : Sort*} {r : α → α → Prop}
  {P : ∀{a b : α}, refl_trans r a b → Prop}
  {a b : α} (h : refl_trans r a b)
  (ih₁ : ∀a, @P a a refl)
  (ih₂ : ∀{a b} (h : r a b), P (single h))
  (ih₃ : ∀{a b c} (h₁ : refl_trans r a b) (h₂ : refl_trans r b c), P h₁ → P h₂ → P (h₁.trans h₂)) :
  P h :=
begin
  induction h,
  case refl_trans.refl { exact ih₁ a },
  case refl_trans.tail : b c hab hbc ih { exact ih₃ hab (single hbc) ih (ih₂ hbc) }
end

lemma lift {β : Sort*} {p : β → β → Prop} (f : α → β) (h : ∀a b, r a b → p (f a) (f b))
  (hab : refl_trans r a b) : refl_trans p (f a) (f b) :=
hab.trans_induction_on (assume a, refl) (assume a b, single ∘ h _ _) (assume a b c _ _, trans)

lemma mono {p : α → α → Prop} :
  (∀a b, r a b → p a b) → refl_trans r a b → refl_trans p a b :=
lift id

lemma refl_trans_refl_trans_eq : refl_trans (refl_trans r) = refl_trans r :=
funext $ assume a, funext $ assume b, propext $
iff.intro
  (assume h, begin induction h, { refl }, { transitivity; assumption } end)
  (refl_trans.mono (assume a b, single))

end refl_trans


/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.constructions
import Mathlib.topology.algebra.group
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Topology on lists and vectors

-/

protected instance list.topological_space {α : Type u_1} [topological_space α] : topological_space (List α) :=
  topological_space.mk_of_nhds (traverse nhds)

theorem nhds_list {α : Type u_1} [topological_space α] (as : List α) : nhds as = traverse nhds as := sorry

@[simp] theorem nhds_nil {α : Type u_1} [topological_space α] : nhds [] = pure [] :=
  eq.mpr (id (Eq._oldrec (Eq.refl (nhds [] = pure [])) (nhds_list [])))
    (eq.mpr (id (Eq._oldrec (Eq.refl (traverse nhds [] = pure [])) (list.traverse_nil nhds))) (Eq.refl (pure [])))

theorem nhds_cons {α : Type u_1} [topological_space α] (a : α) (l : List α) : nhds (a :: l) = List.cons <$> nhds a <*> nhds l := sorry

theorem list.tendsto_cons {α : Type u_1} [topological_space α] {a : α} {l : List α} : filter.tendsto (fun (p : α × List α) => prod.fst p :: prod.snd p) (filter.prod (nhds a) (nhds l)) (nhds (a :: l)) := sorry

theorem filter.tendsto.cons {β : Type u_2} [topological_space β] {α : Type u_1} {f : α → β} {g : α → List β} {a : filter α} {b : β} {l : List β} (hf : filter.tendsto f a (nhds b)) (hg : filter.tendsto g a (nhds l)) : filter.tendsto (fun (a : α) => f a :: g a) a (nhds (b :: l)) :=
  filter.tendsto.comp list.tendsto_cons (filter.tendsto.prod_mk hf hg)

namespace list

theorem tendsto_cons_iff {α : Type u_1} [topological_space α] {β : Type u_2} {f : List α → β} {b : filter β} {a : α} {l : List α} : filter.tendsto f (nhds (a :: l)) b ↔
  filter.tendsto (fun (p : α × List α) => f (prod.fst p :: prod.snd p)) (filter.prod (nhds a) (nhds l)) b := sorry

theorem continuous_cons {α : Type u_1} [topological_space α] : continuous fun (x : α × List α) => prod.fst x :: prod.snd x := sorry

theorem tendsto_nhds {α : Type u_1} [topological_space α] {β : Type u_2} {f : List α → β} {r : List α → filter β} (h_nil : filter.tendsto f (pure []) (r [])) (h_cons : ∀ (l : List α) (a : α),
  filter.tendsto f (nhds l) (r l) →
    filter.tendsto (fun (p : α × List α) => f (prod.fst p :: prod.snd p)) (filter.prod (nhds a) (nhds l)) (r (a :: l))) (l : List α) : filter.tendsto f (nhds l) (r l) := sorry

theorem continuous_at_length {α : Type u_1} [topological_space α] (l : List α) : continuous_at length l := sorry

theorem tendsto_insert_nth' {α : Type u_1} [topological_space α] {a : α} {n : ℕ} {l : List α} : filter.tendsto (fun (p : α × List α) => insert_nth n (prod.fst p) (prod.snd p)) (filter.prod (nhds a) (nhds l))
  (nhds (insert_nth n a l)) := sorry

theorem tendsto_insert_nth {α : Type u_1} [topological_space α] {β : Type u_2} {n : ℕ} {a : α} {l : List α} {f : β → α} {g : β → List α} {b : filter β} (hf : filter.tendsto f b (nhds a)) (hg : filter.tendsto g b (nhds l)) : filter.tendsto (fun (b : β) => insert_nth n (f b) (g b)) b (nhds (insert_nth n a l)) :=
  filter.tendsto.comp tendsto_insert_nth' (filter.tendsto.prod_mk hf hg)

theorem continuous_insert_nth {α : Type u_1} [topological_space α] {n : ℕ} : continuous fun (p : α × List α) => insert_nth n (prod.fst p) (prod.snd p) := sorry

theorem tendsto_remove_nth {α : Type u_1} [topological_space α] {n : ℕ} {l : List α} : filter.tendsto (fun (l : List α) => remove_nth l n) (nhds l) (nhds (remove_nth l n)) := sorry

theorem continuous_remove_nth {α : Type u_1} [topological_space α] {n : ℕ} : continuous fun (l : List α) => remove_nth l n :=
  iff.mpr continuous_iff_continuous_at fun (a : List α) => tendsto_remove_nth

theorem tendsto_sum {α : Type u_1} [topological_space α] [add_monoid α] [has_continuous_add α] {l : List α} : filter.tendsto sum (nhds l) (nhds (sum l)) := sorry

theorem continuous_sum {α : Type u_1} [topological_space α] [add_monoid α] [has_continuous_add α] : continuous sum :=
  iff.mpr continuous_iff_continuous_at fun (l : List α) => tendsto_sum

end list

namespace vector

protected instance topological_space {α : Type u_1} [topological_space α] (n : ℕ) : topological_space (vector α n) :=
  eq.mpr sorry subtype.topological_space

theorem tendsto_cons {α : Type u_1} [topological_space α] {n : ℕ} {a : α} {l : vector α n} : filter.tendsto (fun (p : α × vector α n) => prod.fst p::ᵥprod.snd p) (filter.prod (nhds a) (nhds l)) (nhds (a::ᵥl)) := sorry

theorem tendsto_insert_nth {α : Type u_1} [topological_space α] {n : ℕ} {i : fin (n + 1)} {a : α} {l : vector α n} : filter.tendsto (fun (p : α × vector α n) => insert_nth (prod.fst p) i (prod.snd p)) (filter.prod (nhds a) (nhds l))
  (nhds (insert_nth a i l)) := sorry

theorem continuous_insert_nth' {α : Type u_1} [topological_space α] {n : ℕ} {i : fin (n + 1)} : continuous fun (p : α × vector α n) => insert_nth (prod.fst p) i (prod.snd p) := sorry

theorem continuous_insert_nth {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β] {n : ℕ} {i : fin (n + 1)} {f : β → α} {g : β → vector α n} (hf : continuous f) (hg : continuous g) : continuous fun (b : β) => insert_nth (f b) i (g b) :=
  continuous.comp continuous_insert_nth' (continuous.prod_mk hf hg)

theorem continuous_at_remove_nth {α : Type u_1} [topological_space α] {n : ℕ} {i : fin (n + 1)} {l : vector α (n + 1)} : continuous_at (remove_nth i) l := sorry

--  ∀{l:vector α (n+1)}, tendsto (remove_nth i) (𝓝 l) (𝓝 (remove_nth i l))

--| ⟨l, hl⟩ :=

theorem continuous_remove_nth {α : Type u_1} [topological_space α] {n : ℕ} {i : fin (n + 1)} : continuous (remove_nth i) := sorry


/-
Copyright (c) 2021 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import algebra.pointwise
import order.antichain
import order.order_iso_nat
import order.well_founded

/-!
# Well-founded sets

A well-founded subset of an ordered type is one on which the relation `<` is well-founded.

## Main Definitions
 * `set.well_founded_on s r` indicates that the relation `r` is
  well-founded when restricted to the set `s`.
 * `set.is_wf s` indicates that `<` is well-founded when restricted to `s`.
 * `set.partially_well_ordered_on s r` indicates that the relation `r` is
  partially well-ordered (also known as well quasi-ordered) when restricted to the set `s`.
 * `set.is_pwo s` indicates that any infinite sequence of elements in `s`
  contains an infinite monotone subsequence. Note that

### Definitions for Hahn Series
 * `set.add_antidiagonal s t a` and `set.mul_antidiagonal s t a` are the sets of pairs of elements
  from `s` and `t` that add/multiply to `a`.
 * `finset.add_antidiagonal` and `finset.mul_antidiagonal` are finite versions of
  `set.add_antidiagonal` and `set.mul_antidiagonal` defined when `s` and `t` are well-founded.

## Main Results
 * Higman's Lemma, `set.partially_well_ordered_on.partially_well_ordered_on_sublist_forall₂`,
  shows that if `r` is partially well-ordered on `s`, then `list.sublist_forall₂` is partially
  well-ordered on the set of lists of elements of `s`. The result was originally published by
  Higman, but this proof more closely follows Nash-Williams.
 * `set.well_founded_on_iff` relates `well_founded_on` to the well-foundedness of a relation on the
 original type, to avoid dealing with subtypes.
 * `set.is_wf.mono` shows that a subset of a well-founded subset is well-founded.
 * `set.is_wf.union` shows that the union of two well-founded subsets is well-founded.
 * `finset.is_wf` shows that all `finset`s are well-founded.

## TODO

Prove that `s` is partial well ordered iff it has no infinite descending chain or antichain.

## References
 * [Higman, *Ordering by Divisibility in Abstract Algebras*][Higman52]
 * [Nash-Williams, *On Well-Quasi-Ordering Finite Trees*][Nash-Williams63]
-/

open_locale pointwise

variables {α : Type*}

namespace set

/-- `s.well_founded_on r` indicates that the relation `r` is well-founded when restricted to `s`. -/
def well_founded_on (s : set α) (r : α → α → Prop) : Prop :=
well_founded (λ (a : s) (b : s), r a b)

lemma well_founded_on_iff {s : set α} {r : α → α → Prop} :
  s.well_founded_on r ↔ well_founded (λ (a b : α), r a b ∧ a ∈ s ∧ b ∈ s) :=
begin
  have f : rel_embedding (λ (a : s) (b : s), r a b) (λ (a b : α), r a b ∧ a ∈ s ∧ b ∈ s) :=
    ⟨⟨coe, subtype.coe_injective⟩, λ a b, by simp⟩,
  refine ⟨λ h, _, f.well_founded⟩,
  rw well_founded.well_founded_iff_has_min,
  intros t ht,
  by_cases hst : (s ∩ t).nonempty,
  { rw ← subtype.preimage_coe_nonempty at hst,
    rcases well_founded.well_founded_iff_has_min.1 h (coe ⁻¹' t) hst with ⟨⟨m, ms⟩, mt, hm⟩,
    exact ⟨m, mt, λ x xt ⟨xm, xs, ms⟩, hm ⟨x, xs⟩ xt xm⟩ },
  { rcases ht with ⟨m, mt⟩,
    exact ⟨m, mt, λ x xt ⟨xm, xs, ms⟩, hst ⟨m, ⟨ms, mt⟩⟩⟩ }
end

lemma well_founded_on.induction {s : set α} {r : α → α → Prop} (hs : s.well_founded_on r) {x : α}
  (hx : x ∈ s) {P : α → Prop} (hP : ∀ (y ∈ s), (∀ (z ∈ s), r z y → P z) → P y) :
  P x :=
begin
  let Q : s → Prop := λ y, P y,
  change Q ⟨x, hx⟩,
  refine well_founded.induction hs ⟨x, hx⟩ _,
  rintros ⟨y, ys⟩ ih,
  exact hP _ ys (λ z zs zy, ih ⟨z, zs⟩ zy),
end

instance is_strict_order.subset {s : set α} {r : α → α → Prop} [is_strict_order α r] :
  is_strict_order α (λ (a b : α), r a b ∧ a ∈ s ∧ b ∈ s) :=
{ to_is_irrefl := ⟨λ a con, irrefl_of r a con.1 ⟩,
  to_is_trans := ⟨λ a b c ab bc, ⟨trans_of r ab.1 bc.1, ab.2.1, bc.2.2⟩ ⟩ }

theorem well_founded_on_iff_no_descending_seq {s : set α} {r : α → α → Prop} [is_strict_order α r] :
  s.well_founded_on r ↔ ∀ (f : ((>) : ℕ → ℕ → Prop) ↪r r), ¬ (range f) ⊆ s :=
begin
  rw [well_founded_on_iff, rel_embedding.well_founded_iff_no_descending_seq],
  refine ⟨λ h f con, begin
      refine h.elim' ⟨⟨f, f.injective⟩, λ a b, _⟩,
       simp only [con (mem_range_self a), con (mem_range_self b), and_true, gt_iff_lt,
        function.embedding.coe_fn_mk, f.map_rel_iff]
    end, λ h, ⟨λ con, _⟩⟩,
  rcases con with ⟨f, hf⟩,
  have hfs' : ∀ n : ℕ, f n ∈ s := λ n, (hf.2 n.lt_succ_self).2.2,
  refine h ⟨f, λ a b, _⟩ (λ n hn, _),
  { rw ← hf,
    exact ⟨λ h, ⟨h, hfs' _, hfs' _⟩, λ h, h.1⟩ },
  { rcases set.mem_range.1 hn with ⟨m, hm⟩,
    rw ← hm,
    apply hfs' }
end

section has_lt
variables [has_lt α]

/-- `s.is_wf` indicates that `<` is well-founded when restricted to `s`. -/
def is_wf (s : set α) : Prop := well_founded_on s (<)

lemma is_wf_univ_iff : is_wf (univ : set α) ↔ well_founded ((<) : α → α → Prop) :=
by simp [is_wf, well_founded_on_iff]

variables {s t : set α}

theorem is_wf.mono (h : is_wf t) (st : s ⊆ t) : is_wf s :=
begin
  rw [is_wf, well_founded_on_iff] at *,
  refine subrelation.wf (λ x y xy, _) h,
  exact ⟨xy.1, st xy.2.1, st xy.2.2⟩,
end
end has_lt

section partial_order
variables [partial_order α] {s t : set α} {a : α}

theorem is_wf_iff_no_descending_seq :
  is_wf s ↔ ∀ (f : (order_dual ℕ) ↪o α), ¬ (range f) ⊆ s :=
begin
  haveI : is_strict_order α (λ (a b : α), a < b ∧ a ∈ s ∧ b ∈ s) :=
  { to_is_irrefl := ⟨λ x con, lt_irrefl x con.1⟩,
    to_is_trans := ⟨λ a b c ab bc, ⟨lt_trans ab.1 bc.1, ab.2.1, bc.2.2⟩⟩, },
  rw [is_wf, well_founded_on_iff_no_descending_seq],
  exact ⟨λ h f, h f.lt_embedding, λ h f, h (order_embedding.of_strict_mono
    f (λ _ _, f.map_rel_iff.2))⟩,
end

theorem is_wf.union (hs : is_wf s) (ht : is_wf t) : is_wf (s ∪ t) :=
begin
  classical,
  rw [is_wf_iff_no_descending_seq] at *,
  rintros f fst,
  have h : infinite (f ⁻¹' s) ∨ infinite (f ⁻¹' t),
  { have h : infinite (univ : set ℕ) := infinite_univ,
    have hpre : f ⁻¹' (s ∪ t) = set.univ,
    { rw [← image_univ, image_subset_iff, univ_subset_iff] at fst,
      exact fst },
    rw preimage_union at hpre,
    rw ← hpre at h,
    rw [infinite, infinite],
    rw infinite at h,
    contrapose! h,
    exact finite.union h.1 h.2, },
  rw [← infinite_coe_iff, ← infinite_coe_iff] at h,
  cases h with inf inf; haveI := inf,
  { apply hs ((nat.order_embedding_of_set (f ⁻¹' s)).dual.trans f),
    change range (function.comp f (nat.order_embedding_of_set (f ⁻¹' s))) ⊆ s,
    rw [range_comp, image_subset_iff],
      simp },
  { apply ht ((nat.order_embedding_of_set (f ⁻¹' t)).dual.trans f),
    change range (function.comp f (nat.order_embedding_of_set (f ⁻¹' t))) ⊆ t,
    rw [range_comp, image_subset_iff],
      simp }
end
end partial_order

end set

namespace set

/-- A subset is partially well-ordered by a relation `r` when any infinite sequence contains
  two elements where the first is related to the second by `r`. -/
def partially_well_ordered_on (s) (r : α → α → Prop) : Prop :=
  ∀ (f : ℕ → α), range f ⊆ s → ∃ (m n : ℕ), m < n ∧ r (f m) (f n)

/-- A subset of a preorder is partially well-ordered when any infinite sequence contains
  a monotone subsequence of length 2 (or equivalently, an infinite monotone subsequence). -/
def is_pwo [preorder α] (s) : Prop :=
partially_well_ordered_on s ((≤) : α → α → Prop)

theorem partially_well_ordered_on.mono {s t : set α} {r : α → α → Prop}
  (ht : t.partially_well_ordered_on r) (hsub : s ⊆ t) :
  s.partially_well_ordered_on r :=
λ f hf, ht f (set.subset.trans hf hsub)

theorem is_pwo.mono [preorder α] {s t : set α}
  (ht : t.is_pwo) (hsub : s ⊆ t) :
  s.is_pwo :=
partially_well_ordered_on.mono ht hsub

theorem partially_well_ordered_on.image_of_monotone_on {s : set α}
  {r : α → α → Prop} {β : Type*} {r' : β → β → Prop}
  (hs : s.partially_well_ordered_on r) {f : α → β}
  (hf : ∀ a1 a2 : α, a1 ∈ s → a2 ∈ s → r a1 a2 → r' (f a1) (f a2)) :
  (f '' s).partially_well_ordered_on r' :=
λ g hg, begin
  have h := λ (n : ℕ), ((mem_image _ _ _).1 (hg (mem_range_self n))),
  obtain ⟨m, n, hlt, hmn⟩ := hs (λ n, classical.some (h n)) _,
  { refine ⟨m, n, hlt, _⟩,
    rw [← (classical.some_spec (h m)).2,
      ← (classical.some_spec (h n)).2],
    exact hf _ _ (classical.some_spec (h m)).1 (classical.some_spec (h n)).1 hmn },
  { rintros _ ⟨n, rfl⟩,
    exact (classical.some_spec (h n)).1 }
end

lemma _root_.is_antichain.finite_of_partially_well_ordered_on {s : set α} {r : α → α → Prop}
  (ha : is_antichain r s) (hp : s.partially_well_ordered_on r) :
  s.finite :=
begin
  refine finite_or_infinite.resolve_right (λ hi, _),
  obtain ⟨m, n, hmn, h⟩ := hp (λ n, hi.nat_embedding _ n) (range_subset_iff.2 $
    λ n, (hi.nat_embedding _ n).2),
  exact hmn.ne ((hi.nat_embedding _).injective $ subtype.val_injective $
    ha.eq (hi.nat_embedding _ m).2 (hi.nat_embedding _ n).2 h),
end

lemma finite.partially_well_ordered_on {s : set α} {r : α → α → Prop} [is_refl α r]
  (hs : s.finite) :
  s.partially_well_ordered_on r :=
begin
  intros f hf,
  obtain ⟨m, n, hmn, h⟩ := hs.exists_lt_map_eq_of_range_subset hf,
  exact ⟨m, n, hmn, h.subst $ refl (f m)⟩,
end

lemma _root_.is_antichain.partially_well_ordered_on_iff {s : set α} {r : α → α → Prop} [is_refl α r]
  (hs : is_antichain r s) :
  s.partially_well_ordered_on r ↔ s.finite :=
⟨hs.finite_of_partially_well_ordered_on, finite.partially_well_ordered_on⟩

lemma partially_well_ordered_on_iff_finite_antichains {s : set α} {r : α → α → Prop} [is_refl α r]
  [is_symm α r] :
  s.partially_well_ordered_on r ↔ ∀ t ⊆ s, is_antichain r t → t.finite :=
begin
  refine ⟨λ h t ht hrt, hrt.finite_of_partially_well_ordered_on (h.mono ht), _⟩,
  rintro hs f hf,
  by_contra' H,
  refine set.infinite_range_of_injective (λ m n hmn, _) (hs _ hf _),
  { obtain h | h | h := lt_trichotomy m n,
    { refine (H _ _ h _).elim,
      rw hmn,
      exact refl _ },
    { exact h },
    { refine (H _ _ h _).elim,
      rw hmn,
      exact refl _ } },
  rintro _ ⟨m, hm, rfl⟩ _ ⟨n, hn, rfl⟩ hmn,
  obtain h | h  := (ne_of_apply_ne _ hmn).lt_or_lt,
  { exact H _ _ h },
  { exact mt symm (H _ _ h) }
end

section partial_order
variables {s : set α} {t : set α} {r : α → α → Prop}

theorem partially_well_ordered_on.exists_monotone_subseq [is_refl α r] [is_trans α r]
  (h : s.partially_well_ordered_on r) (f : ℕ → α) (hf : range f ⊆ s) :
  ∃ (g : ℕ ↪o ℕ), ∀ m n : ℕ, m ≤ n → r (f (g m)) (f (g n)) :=
begin
  obtain ⟨g, h1 | h2⟩ := exists_increasing_or_nonincreasing_subseq r f,
  { refine ⟨g, λ m n hle, _⟩,
    obtain hlt | heq := lt_or_eq_of_le hle,
    { exact h1 m n hlt, },
    { rw [heq],
      apply refl_of r } },
  { exfalso,
    obtain ⟨m, n, hlt, hle⟩ := h (f ∘ g) (subset.trans (range_comp_subset_range _ _) hf),
    exact h2 m n hlt hle }
end

theorem partially_well_ordered_on_iff_exists_monotone_subseq [is_refl α r] [is_trans α r] :
  s.partially_well_ordered_on r ↔
    ∀ f : ℕ → α, range f ⊆ s → ∃ (g : ℕ ↪o ℕ), ∀ m n : ℕ, m ≤ n → r (f (g m)) (f (g n)) :=
begin
  classical,
  split; intros h f hf,
  { exact h.exists_monotone_subseq f hf },
  { obtain ⟨g, gmon⟩ := h f hf,
    refine ⟨g 0, g 1, g.lt_iff_lt.2 zero_lt_one, gmon _ _ zero_le_one⟩, }
end

lemma partially_well_ordered_on.well_founded_on [is_partial_order α r]
  (h : s.partially_well_ordered_on r) :
  s.well_founded_on (λ a b, r a b ∧ a ≠ b) :=
begin
  haveI : is_strict_order α (λ a b, r a b ∧ a ≠ b) :=
  { to_is_irrefl := ⟨λ a con, con.2 rfl⟩,
    to_is_trans := ⟨λ a b c ab bc, ⟨trans ab.1 bc.1,
      λ ac, ab.2 (antisymm ab.1 (ac.symm ▸ bc.1))⟩⟩ },
  rw well_founded_on_iff_no_descending_seq,
  intros f con,
  obtain ⟨m, n, hlt, hle⟩ := h f con,
  exact (f.map_rel_iff.2 hlt).2 (antisymm hle (f.map_rel_iff.2 hlt).1).symm,
end

variables [partial_order α]

lemma is_pwo.is_wf (h : s.is_pwo) :
  s.is_wf :=
begin
  rw [is_wf],
  convert h.well_founded_on,
  ext x y,
  rw lt_iff_le_and_ne,
end

theorem is_pwo.exists_monotone_subseq
  (h : s.is_pwo) (f : ℕ → α) (hf : range f ⊆ s) :
  ∃ (g : ℕ ↪o ℕ), monotone (f ∘ g) :=
h.exists_monotone_subseq f hf

theorem is_pwo_iff_exists_monotone_subseq :
  s.is_pwo ↔
    ∀ f : ℕ → α, range f ⊆ s → ∃ (g : ℕ ↪o ℕ), monotone (f ∘ g) :=
partially_well_ordered_on_iff_exists_monotone_subseq

lemma is_pwo.prod (hs : s.is_pwo)
  (ht : t.is_pwo) :
  (s ×ˢ t : set _).is_pwo :=
begin
  classical,
  rw is_pwo_iff_exists_monotone_subseq at *,
  intros f hf,
  obtain ⟨g1, h1⟩ := hs (prod.fst ∘ f) _,
  swap,
  { rw [range_comp, image_subset_iff],
    refine subset.trans hf _,
    rintros ⟨x1, x2⟩ hx,
    simp only [mem_preimage, hx.1] },
  obtain ⟨g2, h2⟩ := ht (prod.snd ∘ f ∘ g1) _,
  refine ⟨g2.trans g1, λ m n mn, _⟩,
  swap,
  { rw [range_comp, image_subset_iff],
    refine subset.trans (range_comp_subset_range _ _) (subset.trans hf _),
    rintros ⟨x1, x2⟩ hx,
    simp only [mem_preimage, hx.2] },
  simp only [rel_embedding.coe_trans, function.comp_app],
  exact ⟨h1 (g2.le_iff_le.2 mn), h2 mn⟩,
end

theorem is_pwo.image_of_monotone {β : Type*} [partial_order β]
  (hs : s.is_pwo) {f : α → β} (hf : monotone f) :
  is_pwo (f '' s) :=
hs.image_of_monotone_on (λ _ _ _ _ ab, hf ab)

theorem is_pwo.union (hs : is_pwo s) (ht : is_pwo t) : is_pwo (s ∪ t) :=
begin
  classical,
  rw [is_pwo_iff_exists_monotone_subseq] at *,
  rintros f fst,
  have h : infinite (f ⁻¹' s) ∨ infinite (f ⁻¹' t),
  { have h : infinite (univ : set ℕ) := infinite_univ,
    have hpre : f ⁻¹' (s ∪ t) = set.univ,
    { rw [← image_univ, image_subset_iff, univ_subset_iff] at fst,
      exact fst },
    rw preimage_union at hpre,
    rw ← hpre at h,
    rw [infinite, infinite],
    rw infinite at h,
    contrapose! h,
    exact finite.union h.1 h.2, },
  rw [← infinite_coe_iff, ← infinite_coe_iff] at h,
  cases h with inf inf; haveI := inf,
  { obtain ⟨g, hg⟩ := hs (f ∘ (nat.order_embedding_of_set (f ⁻¹' s))) _,
    { rw [function.comp.assoc, ← rel_embedding.coe_trans] at hg,
      exact ⟨_, hg⟩ },
    rw [range_comp, image_subset_iff],
    simp },
  { obtain ⟨g, hg⟩ := ht (f ∘ (nat.order_embedding_of_set (f ⁻¹' t))) _,
    { rw [function.comp.assoc, ← rel_embedding.coe_trans] at hg,
      exact ⟨_, hg⟩ },
    rw [range_comp, image_subset_iff],
    simp }
end

end partial_order

theorem is_wf.is_pwo [linear_order α] {s : set α}
  (hs : s.is_wf) : s.is_pwo :=
λ f hf, begin
  rw [is_wf, well_founded_on_iff] at hs,
  have hrange : (range f).nonempty := ⟨f 0, mem_range_self 0⟩,
  let a := hs.min (range f) hrange,
  obtain ⟨m, hm⟩ := hs.min_mem (range f) hrange,
  refine ⟨m, m.succ, m.lt_succ_self, le_of_not_lt (λ con, _)⟩,
  rw hm at con,
  apply hs.not_lt_min (range f) hrange (mem_range_self m.succ)
    ⟨con, hf (mem_range_self m.succ), hf _⟩,
  rw ← hm,
  apply mem_range_self,
end

theorem is_wf_iff_is_pwo [linear_order α] {s : set α} :
  s.is_wf ↔ s.is_pwo :=
⟨is_wf.is_pwo, is_pwo.is_wf⟩

end set

namespace finset

@[simp] lemma partially_well_ordered_on {r : α → α → Prop} [is_refl α r] (s : finset α) :
  (s : set α).partially_well_ordered_on r :=
s.finite_to_set.partially_well_ordered_on

@[simp]
theorem is_pwo [partial_order α] (f : finset α) :
  set.is_pwo (↑f : set α) :=
f.partially_well_ordered_on

@[simp]
theorem well_founded_on {r : α → α → Prop} [is_strict_order α r] (f : finset α) :
  set.well_founded_on (↑f : set α) r :=
begin
  rw [set.well_founded_on_iff_no_descending_seq],
  intros g con,
  apply set.infinite_of_injective_forall_mem g.injective (set.range_subset_iff.1 con),
  exact f.finite_to_set,
end

@[simp]
theorem is_wf [partial_order α] (f : finset α) : set.is_wf (↑f : set α) :=
f.is_pwo.is_wf

end finset

namespace set
variables [partial_order α] {s : set α} {a : α}

theorem finite.is_pwo (h : s.finite) : s.is_pwo :=
begin
  rw ← h.coe_to_finset,
  exact h.to_finset.is_pwo,
end

@[simp]
theorem fintype.is_pwo [fintype α] : s.is_pwo := (finite.of_fintype s).is_pwo

@[simp]
theorem is_pwo_empty : is_pwo (∅ : set α) :=
finite_empty.is_pwo

@[simp]
theorem is_pwo_singleton (a) : is_pwo ({a} : set α) :=
(finite_singleton a).is_pwo

theorem is_pwo.insert (a) (hs : is_pwo s) : is_pwo (insert a s) :=
by { rw ← union_singleton, exact hs.union (is_pwo_singleton a) }

/-- `is_wf.min` returns a minimal element of a nonempty well-founded set. -/
noncomputable def is_wf.min (hs : is_wf s) (hn : s.nonempty) : α :=
hs.min univ (nonempty_iff_univ_nonempty.1 hn.to_subtype)

lemma is_wf.min_mem (hs : is_wf s) (hn : s.nonempty) : hs.min hn ∈ s :=
(well_founded.min hs univ (nonempty_iff_univ_nonempty.1 hn.to_subtype)).2

lemma is_wf.not_lt_min (hs : is_wf s) (hn : s.nonempty) (ha : a ∈ s) : ¬ a < hs.min hn :=
hs.not_lt_min univ (nonempty_iff_univ_nonempty.1 hn.to_subtype) (mem_univ (⟨a, ha⟩ : s))

@[simp]
lemma is_wf_min_singleton (a) {hs : is_wf ({a} : set α)} {hn : ({a} : set α).nonempty} :
  hs.min hn = a :=
eq_of_mem_singleton (is_wf.min_mem hs hn)

end set

@[simp]
theorem finset.is_wf_sup {ι : Type*} [partial_order α] (f : finset ι) (g : ι → set α)
  (hf : ∀ i : ι, i ∈ f → (g i).is_wf) : (f.sup g).is_wf :=
begin
  classical,
  revert hf,
  apply f.induction_on,
  { intro h,
    simp [set.is_pwo_empty.is_wf], },
  { intros s f sf hf hsf,
    rw finset.sup_insert,
    exact (hsf s (finset.mem_insert_self _ _)).union  (hf (λ s' s'f, hsf _
      (finset.mem_insert_of_mem s'f))) }
end

@[simp]
theorem finset.is_pwo_sup {ι : Type*} [partial_order α] (f : finset ι) (g : ι → set α)
  (hf : ∀ i : ι, i ∈ f → (g i).is_pwo) : (f.sup g).is_pwo :=
begin
  classical,
  revert hf,
  apply f.induction_on,
  { intro h,
    simp [set.is_pwo_empty.is_wf], },
  { intros s f sf hf hsf,
    rw finset.sup_insert,
    exact (hsf s (finset.mem_insert_self _ _)).union  (hf (λ s' s'f, hsf _
      (finset.mem_insert_of_mem s'f))) }
end

namespace set
variables [linear_order α] {s t : set α} {a : α}

lemma is_wf.min_le
  (hs : s.is_wf) (hn : s.nonempty) (ha : a ∈ s) : hs.min hn ≤ a :=
le_of_not_lt (hs.not_lt_min hn ha)

lemma is_wf.le_min_iff
  (hs : s.is_wf) (hn : s.nonempty) :
  a ≤ hs.min hn ↔ ∀ b, b ∈ s → a ≤ b :=
⟨λ ha b hb, le_trans ha (hs.min_le hn hb), λ h, h _ (hs.min_mem _)⟩

lemma is_wf.min_le_min_of_subset
  {hs : s.is_wf} {hsn : s.nonempty} {ht : t.is_wf} {htn : t.nonempty} (hst : s ⊆ t) :
  ht.min htn ≤ hs.min hsn :=
(is_wf.le_min_iff _ _).2 (λ b hb, ht.min_le htn (hst hb))

lemma is_wf.min_union (hs : s.is_wf) (hsn : s.nonempty) (ht : t.is_wf) (htn : t.nonempty) :
  (hs.union ht).min (union_nonempty.2 (or.intro_left _ hsn)) = min (hs.min hsn) (ht.min htn) :=
begin
  refine le_antisymm (le_min (is_wf.min_le_min_of_subset (subset_union_left _ _))
      (is_wf.min_le_min_of_subset (subset_union_right _ _))) _,
  rw min_le_iff,
  exact ((mem_union _ _ _).1 ((hs.union ht).min_mem
    (union_nonempty.2 (or.intro_left _ hsn)))).imp (hs.min_le _) (ht.min_le _),
end

end set

namespace set

variables {s : set α} {t : set α}

@[to_additive]
theorem is_pwo.mul [ordered_cancel_comm_monoid α] (hs : s.is_pwo) (ht : t.is_pwo) :
  is_pwo (s * t) :=
begin
  rw ← image_mul_prod,
  exact (is_pwo.prod hs ht).image_of_monotone (λ _ _ h, mul_le_mul' h.1 h.2),
end

variable [linear_ordered_cancel_comm_monoid α]

@[to_additive]
theorem is_wf.mul (hs : s.is_wf) (ht : t.is_wf) : is_wf (s * t) :=
(hs.is_pwo.mul ht.is_pwo).is_wf

@[to_additive]
theorem is_wf.min_mul (hs : s.is_wf) (ht : t.is_wf) (hsn : s.nonempty) (htn : t.nonempty) :
  (hs.mul ht).min (hsn.mul htn) = hs.min hsn * ht.min htn :=
begin
  refine le_antisymm (is_wf.min_le _ _ (mem_mul.2 ⟨_, _, hs.min_mem _, ht.min_mem _, rfl⟩)) _,
  rw is_wf.le_min_iff,
  rintros _ ⟨x, y, hx, hy, rfl⟩,
  exact mul_le_mul' (hs.min_le _ hx) (ht.min_le _ hy),
end

end set

namespace set
namespace partially_well_ordered_on

/-- In the context of partial well-orderings, a bad sequence is a nonincreasing sequence
  whose range is contained in a particular set `s`. One exists if and only if `s` is not
  partially well-ordered. -/
def is_bad_seq (r : α → α → Prop) (s : set α) (f : ℕ → α) : Prop :=
set.range f ⊆ s ∧ ∀ (m n : ℕ), m < n → ¬ r (f m) (f n)

lemma iff_forall_not_is_bad_seq (r : α → α → Prop) (s : set α) :
  s.partially_well_ordered_on r ↔
    ∀ f, ¬ is_bad_seq r s f :=
begin
  rw [set.partially_well_ordered_on],
  apply forall_congr (λ f, _),
  simp [is_bad_seq]
end

/-- This indicates that every bad sequence `g` that agrees with `f` on the first `n`
  terms has `rk (f n) ≤ rk (g n)`. -/
def is_min_bad_seq (r : α → α → Prop) (rk : α → ℕ) (s : set α) (n : ℕ) (f : ℕ → α) : Prop :=
  ∀ g : ℕ → α, (∀ (m : ℕ), m < n → f m = g m) → rk (g n) < rk (f n) → ¬ is_bad_seq r s g

/-- Given a bad sequence `f`, this constructs a bad sequence that agrees with `f` on the first `n`
  terms and is minimal at `n`.
-/
noncomputable def min_bad_seq_of_bad_seq (r : α → α → Prop) (rk : α → ℕ) (s : set α)
  (n : ℕ) (f : ℕ → α) (hf : is_bad_seq r s f) :
  { g : ℕ → α // (∀ (m : ℕ), m < n → f m = g m) ∧ is_bad_seq r s g ∧ is_min_bad_seq r rk s n g } :=
begin
  classical,
  have h : ∃ (k : ℕ) (g : ℕ → α), (∀ m, m < n → f m = g m) ∧ is_bad_seq r s g
        ∧ rk (g n) = k :=
  ⟨_, f, λ _ _, rfl, hf, rfl⟩,
  obtain ⟨h1, h2, h3⟩ := classical.some_spec (nat.find_spec h),
  refine ⟨classical.some (nat.find_spec h), h1, by convert h2, λ g hg1 hg2 con, _⟩,
  refine nat.find_min h _ ⟨g, λ m mn, (h1 m mn).trans (hg1 m mn), by convert con, rfl⟩,
  rwa ← h3,
end

lemma exists_min_bad_of_exists_bad (r : α → α → Prop) (rk : α → ℕ) (s : set α) :
  (∃ f, is_bad_seq r s f) → ∃ f, is_bad_seq r s f ∧ ∀ n, is_min_bad_seq r rk s n f :=
begin
  rintro ⟨f0, (hf0 : is_bad_seq r s f0)⟩,
  let fs : Π (n : ℕ), { f :  ℕ → α // is_bad_seq r s f ∧ is_min_bad_seq r rk s n f },
  { refine nat.rec _ _,
    { exact ⟨(min_bad_seq_of_bad_seq r rk s 0 f0 hf0).1,
        (min_bad_seq_of_bad_seq r rk s 0 f0 hf0).2.2⟩, },
    { exact λ n fn, ⟨(min_bad_seq_of_bad_seq r rk s (n + 1) fn.1 fn.2.1).1,
        (min_bad_seq_of_bad_seq r rk s (n + 1) fn.1 fn.2.1).2.2⟩ } },
  have h : ∀ m n, m ≤ n → (fs m).1 m = (fs n).1 m,
  { intros m n mn,
    obtain ⟨k, rfl⟩ := exists_add_of_le mn,
    clear mn,
    induction k with k ih,
    { refl },
    rw [ih, ((min_bad_seq_of_bad_seq r rk s (m + k).succ (fs (m + k)).1 (fs (m + k)).2.1).2.1 m
        (nat.lt_succ_iff.2 (nat.add_le_add_left k.zero_le m)))],
    refl },
  refine ⟨λ n, (fs n).1 n, ⟨set.range_subset_iff.2 (λ n, ((fs n).2).1.1 (mem_range_self n)),
    λ m n mn, _⟩, λ n g hg1 hg2, _⟩,
  { dsimp,
    rw [← subtype.val_eq_coe, h m n (le_of_lt mn)],
    convert (fs n).2.1.2 m n mn },
  { convert (fs n).2.2 g (λ m mn, eq.trans _ (hg1 m mn)) (lt_of_lt_of_le hg2 le_rfl),
    rw ← h m n (le_of_lt mn) },
end

lemma iff_not_exists_is_min_bad_seq {r : α → α → Prop} (rk : α → ℕ) {s : set α} :
  s.partially_well_ordered_on r ↔ ¬ ∃ f, is_bad_seq r s f ∧ ∀ n, is_min_bad_seq r rk s n f :=
begin
  rw [iff_forall_not_is_bad_seq, ← not_exists, not_congr],
  split,
  { apply exists_min_bad_of_exists_bad },
  rintro ⟨f, hf1, hf2⟩,
  exact ⟨f, hf1⟩,
end

/-- Higman's Lemma, which states that for any reflexive, transitive relation `r` which is
  partially well-ordered on a set `s`, the relation `list.sublist_forall₂ r` is partially
  well-ordered on the set of lists of elements of `s`. That relation is defined so that
  `list.sublist_forall₂ r l₁ l₂` whenever `l₁` related pointwise by `r` to a sublist of `l₂`.  -/
lemma partially_well_ordered_on_sublist_forall₂ (r : α → α → Prop) [is_refl α r] [is_trans α r]
  {s : set α} (h : s.partially_well_ordered_on r) :
  { l : list α | ∀ x, x ∈ l → x ∈ s }.partially_well_ordered_on (list.sublist_forall₂ r) :=
begin
  rcases s.eq_empty_or_nonempty with rfl | ⟨as, has⟩,
  { apply partially_well_ordered_on.mono (finset.partially_well_ordered_on {list.nil}),
    { intros l hl,
      rw [finset.mem_coe, finset.mem_singleton, list.eq_nil_iff_forall_not_mem],
      exact hl, },
    apply_instance },
  haveI : inhabited α := ⟨as⟩,
  rw [iff_not_exists_is_min_bad_seq (list.length)],
  rintro ⟨f, hf1, hf2⟩,
  have hnil : ∀ n, f n ≠ list.nil :=
    λ n con, (hf1).2 n n.succ n.lt_succ_self (con.symm ▸ list.sublist_forall₂.nil),
  obtain ⟨g, hg⟩ := h.exists_monotone_subseq (list.head ∘ f) _,
  swap, { simp only [set.range_subset_iff, function.comp_apply],
    exact λ n, hf1.1 (set.mem_range_self n) _ (list.head_mem_self (hnil n)) },
  have hf' := hf2 (g 0) (λ n, if n < g 0 then f n else list.tail (f (g (n - g 0))))
    (λ m hm, (if_pos hm).symm) _,
  swap, { simp only [if_neg (lt_irrefl (g 0)), tsub_self],
    rw [list.length_tail, ← nat.pred_eq_sub_one],
    exact nat.pred_lt (λ con, hnil _ (list.length_eq_zero.1 con)) },
  rw [is_bad_seq] at hf',
  push_neg at hf',
  obtain ⟨m, n, mn, hmn⟩ := hf' _,
  swap, { rw set.range_subset_iff,
    rintro n x hx,
    split_ifs at hx with hn hn,
    { exact hf1.1 (set.mem_range_self _) _ hx },
    { refine hf1.1 (set.mem_range_self _) _ (list.tail_subset _ hx), } },
  by_cases hn : n < g 0,
  { apply hf1.2 m n mn,
    rwa [if_pos hn, if_pos (mn.trans hn)] at hmn },
  { obtain ⟨n', rfl⟩ := le_iff_exists_add.1 (not_lt.1 hn),
    rw [if_neg hn, add_comm (g 0) n', add_tsub_cancel_right] at hmn,
    split_ifs at hmn with hm hm,
    { apply hf1.2 m (g n') (lt_of_lt_of_le hm (g.monotone n'.zero_le)),
      exact trans hmn (list.tail_sublist_forall₂_self _) },
    { rw [← (tsub_lt_iff_left (le_of_not_lt hm))] at mn,
      apply hf1.2 _ _ (g.lt_iff_lt.2 mn),
      rw [← list.cons_head_tail (hnil (g (m - g 0))), ← list.cons_head_tail (hnil (g n'))],
      exact list.sublist_forall₂.cons (hg _ _ (le_of_lt mn)) hmn, } }
end

end partially_well_ordered_on

namespace is_pwo

@[to_additive]
lemma submonoid_closure [ordered_cancel_comm_monoid α] {s : set α} (hpos : ∀ x : α, x ∈ s → 1 ≤ x)
  (h : s.is_pwo) : is_pwo ((submonoid.closure s) : set α) :=
begin
  have hl : ((submonoid.closure s) : set α) ⊆ list.prod '' { l : list α | ∀ x, x ∈ l → x ∈ s },
  { intros x hx,
    rw set_like.mem_coe at hx,
    refine submonoid.closure_induction hx (λ x hx, ⟨_, λ y hy, _, list.prod_singleton⟩)
      ⟨_, λ y hy, (list.not_mem_nil _ hy).elim, list.prod_nil⟩ _,
    { rwa list.mem_singleton.1 hy },
    rintros _ _ ⟨l, hl, rfl⟩ ⟨l', hl', rfl⟩,
    refine ⟨_, λ y hy, _, list.prod_append⟩,
    cases list.mem_append.1 hy with hy hy,
    { exact hl _ hy },
    { exact hl' _ hy } },
  apply ((h.partially_well_ordered_on_sublist_forall₂ (≤)).image_of_monotone_on _).mono hl,
  intros l1 l2 hl1 hl2 h12,
  obtain ⟨l, hll1, hll2⟩ := list.sublist_forall₂_iff.1 h12,
  refine le_trans (list.rel_prod (le_refl 1) (λ a b ab c d cd, mul_le_mul' ab cd) hll1) _,
  obtain ⟨l', hl'⟩ := hll2.exists_perm_append,
  rw [hl'.prod_eq, list.prod_append, ← mul_one l.prod, mul_assoc, one_mul],
  apply mul_le_mul_left',
  have hl's := λ x hx, hl2 x (list.subset.trans (l.subset_append_right _) hl'.symm.subset hx),
  clear hl',
  induction l' with x1 x2 x3 x4 x5,
  { refl },
  rw [list.prod_cons, ← one_mul (1 : α)],
  exact mul_le_mul' (hpos x1 (hl's x1 (list.mem_cons_self x1 x2)))
    (x3 (λ x hx, hl's x (list.mem_cons_of_mem _ hx)))
end

end is_pwo

/-- `set.mul_antidiagonal s t a` is the set of all pairs of an element in `s` and an element in `t`
  that multiply to `a`. -/
@[to_additive "`set.add_antidiagonal s t a` is the set of all pairs of an element in `s`
  and an element in `t` that add to `a`."]
def mul_antidiagonal [monoid α] (s t : set α) (a : α) : set (α × α) :=
{ x | x.1 * x.2 = a ∧ x.1 ∈ s ∧ x.2 ∈ t }

namespace mul_antidiagonal

@[simp, to_additive]
lemma mem_mul_antidiagonal [monoid α] {s t : set α} {a : α} {x : α × α} :
  x ∈ mul_antidiagonal s t a ↔ x.1 * x.2 = a ∧ x.1 ∈ s ∧ x.2 ∈ t := iff.refl _

section cancel_comm_monoid
variables [cancel_comm_monoid α] {s t : set α} {a : α}

@[to_additive]
lemma fst_eq_fst_iff_snd_eq_snd {x y : (mul_antidiagonal s t a)} :
  (x : α × α).fst = (y : α × α).fst ↔ (x : α × α).snd = (y : α × α).snd :=
⟨λ h, begin
  have hx := x.2.1,
  rw [subtype.val_eq_coe, h] at hx,
  apply mul_left_cancel (hx.trans y.2.1.symm),
end, λ h, begin
  have hx := x.2.1,
  rw [subtype.val_eq_coe, h] at hx,
  apply mul_right_cancel (hx.trans y.2.1.symm),
end⟩

@[to_additive]
lemma eq_of_fst_eq_fst {x y : (mul_antidiagonal s t a)}
  (h : (x : α × α).fst = (y : α × α).fst) : x = y :=
subtype.ext (prod.ext h (mul_antidiagonal.fst_eq_fst_iff_snd_eq_snd.1 h))

@[to_additive]
lemma eq_of_snd_eq_snd {x y : (mul_antidiagonal s t a)}
  (h : (x : α × α).snd = (y : α × α).snd) : x = y :=
subtype.ext (prod.ext (mul_antidiagonal.fst_eq_fst_iff_snd_eq_snd.2 h) h)

end cancel_comm_monoid

section ordered_cancel_comm_monoid
variables [ordered_cancel_comm_monoid α] (s t : set α) (a : α)

@[to_additive]
lemma eq_of_fst_le_fst_of_snd_le_snd {x y : (mul_antidiagonal s t a)}
  (h1 : (x : α × α).fst ≤ (y : α × α).fst) (h2 : (x : α × α).snd ≤ (y : α × α).snd ) :
  x = y :=
begin
  apply eq_of_fst_eq_fst,
  cases eq_or_lt_of_le h1 with heq hlt,
  { exact heq },
  exfalso,
  exact ne_of_lt (mul_lt_mul_of_lt_of_le hlt h2)
    ((mem_mul_antidiagonal.1 x.2).1.trans (mem_mul_antidiagonal.1 y.2).1.symm)
end

variables {s} {t}

@[to_additive]
theorem finite_of_is_pwo (hs : s.is_pwo) (ht : t.is_pwo) (a) :
  (mul_antidiagonal s t a).finite :=
begin
  by_contra h,
  rw [← set.infinite] at h,
  have h1 : (mul_antidiagonal s t a).partially_well_ordered_on (prod.fst ⁻¹'o (≤)),
  { intros f hf,
    refine hs (prod.fst ∘ f) _,
    rw range_comp,
    rintros _ ⟨⟨x, y⟩, hxy, rfl⟩,
    exact (mem_mul_antidiagonal.1 (hf hxy)).2.1 },
  have h2 : (mul_antidiagonal s t a).partially_well_ordered_on (prod.snd ⁻¹'o (≤)),
  { intros f hf,
    refine ht (prod.snd ∘ f) _,
    rw range_comp,
    rintros _ ⟨⟨x, y⟩, hxy, rfl⟩,
    exact (mem_mul_antidiagonal.1 (hf hxy)).2.2 },
  obtain ⟨g, hg⟩ := h1.exists_monotone_subseq (λ x, h.nat_embedding _ x) _,
  swap, { rintro _ ⟨k, rfl⟩,
    exact ((infinite.nat_embedding (s.mul_antidiagonal t a) h) _).2 },
  obtain ⟨m, n, mn, h2'⟩ := h2 (λ x, (h.nat_embedding _) (g x)) _,
  swap, { rintro _ ⟨k, rfl⟩,
    exact ((infinite.nat_embedding (s.mul_antidiagonal t a) h) _).2, },
  apply ne_of_lt mn (g.injective ((h.nat_embedding _).injective _)),
  exact eq_of_fst_le_fst_of_snd_le_snd _ _ _ (hg _ _ (le_of_lt mn)) h2',
end

end ordered_cancel_comm_monoid

@[to_additive]
theorem finite_of_is_wf [linear_ordered_cancel_comm_monoid α] {s t : set α}
  (hs : s.is_wf) (ht : t.is_wf) (a) :
  (mul_antidiagonal s t a).finite :=
finite_of_is_pwo hs.is_pwo ht.is_pwo a

end mul_antidiagonal
end set

namespace finset

variables [ordered_cancel_comm_monoid α]
variables {s t : set α} (hs : s.is_pwo) (ht : t.is_pwo) (a : α)

/-- `finset.mul_antidiagonal_of_is_wf hs ht a` is the set of all pairs of an element in
  `s` and an element in `t` that multiply to `a`, but its construction requires proofs
  `hs` and `ht` that `s` and `t` are well-ordered. -/
@[to_additive "`finset.add_antidiagonal_of_is_wf hs ht a` is the set of all pairs of an element in
  `s` and an element in `t` that add to `a`, but its construction requires proofs
  `hs` and `ht` that `s` and `t` are well-ordered."]
noncomputable def mul_antidiagonal : finset (α × α) :=
(set.mul_antidiagonal.finite_of_is_pwo hs ht a).to_finset

variables {hs} {ht} {u : set α} {hu : u.is_pwo} {a} {x : α × α}

@[simp, to_additive]
lemma mem_mul_antidiagonal :
  x ∈ mul_antidiagonal hs ht a ↔ x.1 * x.2 = a ∧ x.1 ∈ s ∧ x.2 ∈ t :=
by simp [mul_antidiagonal]

@[to_additive]
lemma mul_antidiagonal_mono_left (hus : u ⊆ s) :
  (finset.mul_antidiagonal hu ht a) ⊆ (finset.mul_antidiagonal hs ht a) :=
λ x hx, begin
  rw mem_mul_antidiagonal at *,
  exact ⟨hx.1, hus hx.2.1, hx.2.2⟩,
end

@[to_additive]
lemma mul_antidiagonal_mono_right (hut : u ⊆ t) :
  (finset.mul_antidiagonal hs hu a) ⊆ (finset.mul_antidiagonal hs ht a) :=
λ x hx, begin
  rw mem_mul_antidiagonal at *,
  exact ⟨hx.1, hx.2.1, hut hx.2.2⟩,
end

@[to_additive]
lemma support_mul_antidiagonal_subset_mul :
  { a : α | (mul_antidiagonal hs ht a).nonempty } ⊆ s * t :=
(λ x ⟨⟨a1, a2⟩, ha⟩, begin
  obtain ⟨hmul, h1, h2⟩ := mem_mul_antidiagonal.1 ha,
  exact ⟨a1, a2, h1, h2, hmul⟩,
end)

@[to_additive]
theorem is_pwo_support_mul_antidiagonal :
  { a : α | (mul_antidiagonal hs ht a).nonempty }.is_pwo :=
(hs.mul ht).mono support_mul_antidiagonal_subset_mul

@[to_additive]
theorem mul_antidiagonal_min_mul_min {α} [linear_ordered_cancel_comm_monoid α] {s t : set α}
  (hs : s.is_wf) (ht : t.is_wf)
  (hns : s.nonempty) (hnt : t.nonempty) :
  mul_antidiagonal hs.is_pwo ht.is_pwo ((hs.min hns) * (ht.min hnt)) =
    {(hs.min hns, ht.min hnt)} :=
begin
  ext ⟨a1, a2⟩,
  rw [mem_mul_antidiagonal, finset.mem_singleton, prod.ext_iff],
  split,
  { rintro ⟨hast, has, hat⟩,
    cases eq_or_lt_of_le (hs.min_le hns has) with heq hlt,
    { refine ⟨heq.symm, _⟩,
      rw heq at hast,
      exact mul_left_cancel hast },
    { contrapose hast,
      exact ne_of_gt (mul_lt_mul_of_lt_of_le hlt (ht.min_le hnt hat)) } },
  { rintro ⟨ha1, ha2⟩,
    rw [ha1, ha2],
    exact ⟨rfl, hs.min_mem _, ht.min_mem _⟩ }
end

end finset

lemma well_founded.is_wf [has_lt α] (h : well_founded ((<) : α → α → Prop)) (s : set α) :
  s.is_wf :=
(set.is_wf_univ_iff.2 h).mono (set.subset_univ s)

/-- A version of **Dickson's lemma** any subset of functions `Π s : σ, α s` is partially well
ordered, when `σ` is a `fintype` and each `α s` is a linear well order.
This includes the classical case of Dickson's lemma that `ℕ ^ n` is a well partial order.
Some generalizations would be possible based on this proof, to include cases where the target
is partially well ordered, and also to consider the case of `partially_well_ordered_on` instead of
`is_pwo`. -/
lemma pi.is_pwo {σ : Type*} {α : σ → Type*} [∀ s, linear_order (α s)] [∀ s, is_well_order (α s) (<)]
  [fintype σ] (S : set (Π s : σ, α s)) : S.is_pwo :=
begin
  classical,
  refine set.is_pwo.mono _ (set.subset_univ _),
  rw set.is_pwo_iff_exists_monotone_subseq,
  simp_rw [monotone, pi.le_def],
  suffices : ∀ s : finset σ, ∀ (f : ℕ → (Π s, α s)), set.range f ⊆ set.univ → ∃ (g : ℕ ↪o ℕ),
    ∀ ⦃a b : ℕ⦄, a ≤ b → ∀ (x : σ) (hs : x ∈ s), (f ∘ g) a x ≤ (f ∘ g) b x,
  { simpa only [forall_true_left, finset.mem_univ] using this finset.univ, },
  apply' finset.induction,
  { intros f hf, existsi rel_embedding.refl (≤),
    simp only [forall_false_left, implies_true_iff, forall_const, finset.not_mem_empty], },
  { intros x s hx ih f hf,
    obtain ⟨g, hg⟩ := (is_well_order.wf.is_wf (set.univ : set _)).is_pwo.exists_monotone_subseq
      ((λ mo : Π s : σ, α s, mo x) ∘ f) (set.subset_univ _),
    obtain ⟨g', hg'⟩ := ih (f ∘ g) (set.subset_univ _),
    refine ⟨g'.trans g, λ a b hab, _⟩,
    simp only [finset.mem_insert, rel_embedding.coe_trans, function.comp_app, forall_eq_or_imp],
    exact ⟨hg (order_hom_class.mono g' hab), hg' hab⟩, },
end


/-
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

Extends the theory on functors, applicatives and monads.

! This file was ported from Lean 3 source module control.basic
! leanprover-community/mathlib commit abb3121f210743a930dea73cd766d988079bdf8b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/

universe u v w

variable {α β γ : Type u}

-- mathport name: «expr $< »
notation:1 a " $< " f:1 => f a

section Functor

variable {f : Type u → Type v} [Functor f] [LawfulFunctor f]

run_cmd
  mk_simp_attr `functor_norm

run_cmd
  tactic.add_doc_string `simp_attr.functor_norm "Simp set for functor_norm"

@[functor_norm]
theorem Functor.map_map (m : α → β) (g : β → γ) (x : f α) : g <$> m <$> x = (g ∘ m) <$> x :=
  (comp_map _ _ _).symm
#align functor.map_map Functor.map_mapₓ

@[simp]
theorem id_map' (x : f α) : (fun a => a) <$> x = x :=
  id_map _
#align id_map' id_map'ₓ

end Functor

section Applicative

variable {F : Type u → Type v} [Applicative F]

#print zipWithM /-
def zipWithM {α₁ α₂ φ : Type u} (f : α₁ → α₂ → F φ) : ∀ (ma₁ : List α₁) (ma₂ : List α₂), F (List φ)
  | x :: xs, y :: ys => (· :: ·) <$> f x y <*> zipWithM xs ys
  | _, _ => pure []
#align mzip_with zipWithM
-/

#print zipWithM' /-
def zipWithM' (f : α → β → F γ) : List α → List β → F PUnit
  | x :: xs, y :: ys => f x y *> zipWithM' xs ys
  | [], _ => pure PUnit.unit
  | _, [] => pure PUnit.unit
#align mzip_with' zipWithM'
-/

variable [LawfulApplicative F]

attribute [functor_norm] seq_assoc pure_seq_eq_map

/- warning: pure_id'_seq -> pure_id'_seq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] (x : F α), Eq.{succ u2} (F α) (Seq.seq.{u1, u2} F (Applicative.toHasSeq.{u1, u2} F _inst_1) α α (Pure.pure.{u1, u2} F (Applicative.toHasPure.{u1, u2} F _inst_1) (α -> α) (fun (x : α) => x)) x) x
but is expected to have type
  forall {α : Type.{u1}} {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] (x : F α), Eq.{succ u2} (F α) (Seq.seq.{u1, u2} F (Applicative.toSeq.{u1, u2} F _inst_1) α α (Pure.pure.{u1, u2} F (Applicative.toPure.{u1, u2} F _inst_1) (α -> α) (fun (x : α) => x)) (fun (x._@.Mathlib.Control.Basic._hyg.391 : Unit) => x)) x
Case conversion may be inaccurate. Consider using '#align pure_id'_seq pure_id'_seqₓ'. -/
@[simp]
theorem pure_id'_seq (x : F α) : (pure fun x => x) <*> x = x :=
  pure_id_seq x
#align pure_id'_seq pure_id'_seq

attribute [functor_norm] seq_assoc pure_seq_eq_map

/- warning: seq_map_assoc -> seq_map_assoc is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u1}} {γ : Type.{u1}} {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] (x : F (α -> β)) (f : γ -> α) (y : F γ), Eq.{succ u2} (F β) (Seq.seq.{u1, u2} F (Applicative.toHasSeq.{u1, u2} F _inst_1) α β x (Functor.map.{u1, u2} F (Applicative.toFunctor.{u1, u2} F _inst_1) γ α f y)) (Seq.seq.{u1, u2} F (Applicative.toHasSeq.{u1, u2} F _inst_1) γ β (Functor.map.{u1, u2} F (Applicative.toFunctor.{u1, u2} F _inst_1) (α -> β) (γ -> β) (fun (m : α -> β) => Function.comp.{succ u1, succ u1, succ u1} γ α β m f) x) y)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u1}} {γ : Type.{u1}} {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] (x : F (α -> β)) (f : γ -> α) (y : F γ), Eq.{succ u2} (F β) (Seq.seq.{u1, u2} F (Applicative.toSeq.{u1, u2} F _inst_1) α β x (fun (x._@.Mathlib.Control.Basic._hyg.433 : Unit) => Functor.map.{u1, u2} F (Applicative.toFunctor.{u1, u2} F _inst_1) γ α f y)) (Seq.seq.{u1, u2} F (Applicative.toSeq.{u1, u2} F _inst_1) γ β (Functor.map.{u1, u2} F (Applicative.toFunctor.{u1, u2} F _inst_1) (α -> β) (γ -> β) (fun (m : α -> β) => Function.comp.{succ u1, succ u1, succ u1} γ α β m f) x) (fun (x._@.Mathlib.Control.Basic._hyg.462 : Unit) => y))
Case conversion may be inaccurate. Consider using '#align seq_map_assoc seq_map_assocₓ'. -/
@[functor_norm]
theorem seq_map_assoc (x : F (α → β)) (f : γ → α) (y : F γ) :
    x <*> f <$> y = (fun m : α → β => m ∘ f) <$> x <*> y :=
  by
  simp [(pure_seq_eq_map _ _).symm]
  simp [seq_assoc, (comp_map _ _ _).symm, (· ∘ ·)]
  simp [pure_seq_eq_map]
#align seq_map_assoc seq_map_assoc

/- warning: map_seq -> map_seq is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u1}} {γ : Type.{u1}} {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] (f : β -> γ) (x : F (α -> β)) (y : F α), Eq.{succ u2} (F γ) (Functor.map.{u1, u2} F (Applicative.toFunctor.{u1, u2} F _inst_1) β γ f (Seq.seq.{u1, u2} F (Applicative.toHasSeq.{u1, u2} F _inst_1) α β x y)) (Seq.seq.{u1, u2} F (Applicative.toHasSeq.{u1, u2} F _inst_1) α γ (Functor.map.{u1, u2} F (Applicative.toFunctor.{u1, u2} F _inst_1) (α -> β) (α -> γ) (Function.comp.{succ u1, succ u1, succ u1} α β γ f) x) y)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u1}} {γ : Type.{u1}} {F : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} F] [_inst_2 : LawfulApplicative.{u1, u2} F _inst_1] (f : β -> γ) (x : F (α -> β)) (y : F α), Eq.{succ u2} (F γ) (Functor.map.{u1, u2} F (Applicative.toFunctor.{u1, u2} F _inst_1) β γ f (Seq.seq.{u1, u2} F (Applicative.toSeq.{u1, u2} F _inst_1) α β x (fun (x._@.Mathlib.Control.Basic._hyg.518 : Unit) => y))) (Seq.seq.{u1, u2} F (Applicative.toSeq.{u1, u2} F _inst_1) α γ (Functor.map.{u1, u2} F (Applicative.toFunctor.{u1, u2} F _inst_1) (α -> β) (α -> γ) (fun (x._@.Mathlib.Control.Basic._hyg.529 : α -> β) => Function.comp.{succ u1, succ u1, succ u1} α β γ f x._@.Mathlib.Control.Basic._hyg.529) x) (fun (x._@.Mathlib.Control.Basic._hyg.543 : Unit) => y))
Case conversion may be inaccurate. Consider using '#align map_seq map_seqₓ'. -/
@[functor_norm]
theorem map_seq (f : β → γ) (x : F (α → β)) (y : F α) : f <$> (x <*> y) = (· ∘ ·) f <$> x <*> y :=
  by simp [(pure_seq_eq_map _ _).symm] <;> simp [seq_assoc]
#align map_seq map_seq

end Applicative

-- TODO: setup `functor_norm` for `monad` laws
attribute [functor_norm] pure_bind bind_assoc bind_pure

section Monad

variable {m : Type u → Type v} [Monad m] [LawfulMonad m]

open List

#print List.partitionM /-
def List.partitionM {f : Type → Type} [Monad f] {α : Type} (p : α → f Bool) :
    List α → f (List α × List α)
  | [] => pure ([], [])
  | x :: xs =>
    condM (p x) (Prod.map (cons x) id <$> List.partitionM xs)
      (Prod.map id (cons x) <$> List.partitionM xs)
#align list.mpartition List.partitionM
-/

#print map_bind /-
theorem map_bind (x : m α) {g : α → m β} {f : β → γ} : f <$> (x >>= g) = x >>= fun a => f <$> g a :=
  by rw [← bind_pure_comp_eq_map, bind_assoc] <;> simp [bind_pure_comp_eq_map]
#align map_bind map_bind
-/

#print seq_bind_eq /-
theorem seq_bind_eq (x : m α) {g : β → m γ} {f : α → β} : f <$> x >>= g = x >>= g ∘ f :=
  show bind (f <$> x) g = bind x (g ∘ f) by
    rw [← bind_pure_comp_eq_map, bind_assoc] <;> simp [pure_bind]
#align seq_bind_eq seq_bind_eq
-/

theorem seq_eq_bind_map {x : m α} {f : m (α → β)} : f <*> x = f >>= (· <$> x) :=
  (bind_map_eq_seq f x).symm
#align seq_eq_bind_map seq_eq_bind_mapₓ

/-- This is the Kleisli composition -/
@[reducible]
def fish {m} [Monad m] {α β γ} (f : α → m β) (g : β → m γ) := fun x => f x >>= g
#align fish fish

-- mathport name: «expr >=> »
infixl:55
  " >=> " =>-- >=> is already defined in the core library but it is unusable
  -- because of its precedence (it is defined with precedence 2) and
  -- because it is defined as a lambda instead of having a named
  -- function
  fish

/- warning: fish_pure -> fish_pure is a dubious translation:
lean 3 declaration is
  forall {m : Type.{u1} -> Type.{u2}} [_inst_1 : Monad.{u1, u2} m] [_inst_2 : LawfulMonad.{u1, u2} m _inst_1] {α : Sort.{u3}} {β : Type.{u1}} (f : α -> (m β)), Eq.{max u3 (succ u2)} (α -> (m β)) (fish.{u1, u2, u3} m _inst_1 α β β f (Pure.pure.{u1, u2} m (Applicative.toHasPure.{u1, u2} m (Monad.toApplicative.{u1, u2} m _inst_1)) β)) f
but is expected to have type
  forall {m : Type.{u2} -> Type.{u3}} [_inst_1 : Monad.{u2, u3} m] [_inst_2 : LawfulMonad.{u2, u3} m _inst_1] {α : Type.{u1}} {β : Type.{u2}} (f : α -> (m β)), Eq.{max (succ u3) (succ u1)} (α -> (m β)) (Bind.kleisliRight.{u1, u2, u3} α m β β (Monad.toBind.{u2, u3} m _inst_1) f (Pure.pure.{u2, u3} m (Applicative.toPure.{u2, u3} m (Monad.toApplicative.{u2, u3} m _inst_1)) β)) f
Case conversion may be inaccurate. Consider using '#align fish_pure fish_pureₓ'. -/
@[functor_norm]
theorem fish_pure {α β} (f : α → m β) : f >=> pure = f := by simp only [(· >=> ·), functor_norm]
#align fish_pure fish_pure

#print fish_pipe /-
@[functor_norm]
theorem fish_pipe {α β} (f : α → m β) : pure >=> f = f := by simp only [(· >=> ·), functor_norm]
#align fish_pipe fish_pipe
-/

/- warning: fish_assoc -> fish_assoc is a dubious translation:
lean 3 declaration is
  forall {m : Type.{u1} -> Type.{u2}} [_inst_1 : Monad.{u1, u2} m] [_inst_2 : LawfulMonad.{u1, u2} m _inst_1] {α : Sort.{u3}} {β : Type.{u1}} {γ : Type.{u1}} {φ : Type.{u1}} (f : α -> (m β)) (g : β -> (m γ)) (h : γ -> (m φ)), Eq.{max u3 (succ u2)} (α -> (m φ)) (fish.{u1, u2, u3} m _inst_1 α γ φ (fish.{u1, u2, u3} m _inst_1 α β γ f g) h) (fish.{u1, u2, u3} m _inst_1 α β φ f (fish.{u1, u2, succ u1} m _inst_1 β γ φ g h))
but is expected to have type
  forall {m : Type.{u2} -> Type.{u3}} [_inst_1 : Monad.{u2, u3} m] [_inst_2 : LawfulMonad.{u2, u3} m _inst_1] {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u2}} {φ : Type.{u2}} (f : α -> (m β)) (g : β -> (m γ)) (h : γ -> (m φ)), Eq.{max (succ u3) (succ u1)} (α -> (m φ)) (Bind.kleisliRight.{u1, u2, u3} α m γ φ (Monad.toBind.{u2, u3} m _inst_1) (Bind.kleisliRight.{u1, u2, u3} α m β γ (Monad.toBind.{u2, u3} m _inst_1) f g) h) (Bind.kleisliRight.{u1, u2, u3} α m β φ (Monad.toBind.{u2, u3} m _inst_1) f (Bind.kleisliRight.{u2, u2, u3} β m γ φ (Monad.toBind.{u2, u3} m _inst_1) g h))
Case conversion may be inaccurate. Consider using '#align fish_assoc fish_assocₓ'. -/
@[functor_norm]
theorem fish_assoc {α β γ φ} (f : α → m β) (g : β → m γ) (h : γ → m φ) :
    f >=> g >=> h = f >=> (g >=> h) := by simp only [(· >=> ·), functor_norm]
#align fish_assoc fish_assoc

variable {β' γ' : Type v}

variable {m' : Type v → Type w} [Monad m']

#print List.mapAccumRM /-
def List.mapAccumRM (f : α → β' → m' (β' × γ')) : β' → List α → m' (β' × List γ')
  | a, [] => pure (a, [])
  | a, x :: xs => do
    let (a', ys) ← List.mapAccumRM a xs
    let (a'', y) ← f x a'
    pure (a'', y :: ys)
#align list.mmap_accumr List.mapAccumRM
-/

#print List.mapAccumLM /-
def List.mapAccumLM (f : β' → α → m' (β' × γ')) : β' → List α → m' (β' × List γ')
  | a, [] => pure (a, [])
  | a, x :: xs => do
    let (a', y) ← f a x
    let (a'', ys) ← List.mapAccumLM a' xs
    pure (a'', y :: ys)
#align list.mmap_accuml List.mapAccumLM
-/

end Monad

section

variable {m : Type u → Type u} [Monad m] [LawfulMonad m]

#print joinM_map_map /-
theorem joinM_map_map {α β : Type u} (f : α → β) (a : m (m α)) :
    joinM (Functor.map f <$> a) = f <$> joinM a := by
  simp only [joinM, (· ∘ ·), id.def, (bind_pure_comp_eq_map _ _).symm, bind_assoc, map_bind,
    pure_bind]
#align mjoin_map_map joinM_map_map
-/

#print joinM_map_joinM /-
theorem joinM_map_joinM {α : Type u} (a : m (m (m α))) : joinM (joinM <$> a) = joinM (joinM a) := by
  simp only [joinM, (· ∘ ·), id.def, map_bind, (bind_pure_comp_eq_map _ _).symm, bind_assoc,
    pure_bind]
#align mjoin_map_mjoin joinM_map_joinM
-/

#print joinM_map_pure /-
@[simp]
theorem joinM_map_pure {α : Type u} (a : m α) : joinM (pure <$> a) = a := by
  simp only [joinM, (· ∘ ·), id.def, map_bind, (bind_pure_comp_eq_map _ _).symm, bind_assoc,
    pure_bind, bind_pure]
#align mjoin_map_pure joinM_map_pure
-/

#print joinM_pure /-
@[simp]
theorem joinM_pure {α : Type u} (a : m α) : joinM (pure a) = a :=
  LawfulMonad.pure_bind a id
#align mjoin_pure joinM_pure
-/

end

section Alternative

variable {F : Type → Type v} [Alternative F]

#print succeeds /-
def succeeds {α} (x : F α) : F Bool :=
  x $> true <|> pure false
#align succeeds succeeds
-/

#print tryM /-
def tryM {α} (x : F α) : F Unit :=
  x $> () <|> pure ()
#align mtry tryM
-/

#print guard_true /-
@[simp]
theorem guard_true {h : Decidable True} : @guard F _ True h = pure () := by simp [guard]
#align guard_true guard_true
-/

#print guard_false /-
@[simp]
theorem guard_false {h : Decidable False} : @guard F _ False h = failure := by simp [guard]
#align guard_false guard_false
-/

end Alternative

namespace Sum

variable {e : Type v}

#print Sum.bind /-
protected def bind {α β} : Sum e α → (α → Sum e β) → Sum e β
  | inl x, _ => inl x
  | inr x, f => f x
#align sum.bind Sum.bind
-/

instance : Monad (Sum.{v, u} e) where
  pure := @Sum.inr e
  bind := @Sum.bind e

instance : LawfulFunctor (Sum.{v, u} e) := by refine' { .. } <;> intros <;> casesm Sum _ _ <;> rfl

instance : LawfulMonad (Sum.{v, u} e)
    where
  bind_assoc := by
    intros
    casesm Sum _ _ <;> rfl
  pure_bind := by
    intros
    rfl
  bind_pure_comp_eq_map := by
    intros
    casesm Sum _ _ <;> rfl
  bind_map_eq_seq := by
    intros
    cases f <;> rfl

end Sum

#print CommApplicative /-
class CommApplicative (m : Type _ → Type _) [Applicative m] extends LawfulApplicative m : Prop where
  commutative_prod :
    ∀ {α β} (a : m α) (b : m β), Prod.mk <$> a <*> b = (fun b a => (a, b)) <$> b <*> a
#align is_comm_applicative CommApplicative
-/

open Functor

/- warning: is_comm_applicative.commutative_map -> CommApplicative.commutative_map is a dubious translation:
lean 3 declaration is
  forall {m : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} m] [_inst_2 : CommApplicative.{u1, u2} m _inst_1] {α : Type.{u1}} {β : Type.{u1}} {γ : Type.{u1}} (a : m α) (b : m β) {f : α -> β -> γ}, Eq.{succ u2} (m γ) (Seq.seq.{u1, u2} (fun {α : Type.{u1}} => m α) (Applicative.toHasSeq.{u1, u2} (fun {α : Type.{u1}} => m α) _inst_1) β γ (Functor.map.{u1, u2} (fun {α : Type.{u1}} => m α) (Applicative.toFunctor.{u1, u2} (fun {α : Type.{u1}} => m α) _inst_1) α (β -> γ) f a) b) (Seq.seq.{u1, u2} m (Applicative.toHasSeq.{u1, u2} m _inst_1) α γ (Functor.map.{u1, u2} m (Applicative.toFunctor.{u1, u2} m _inst_1) β (α -> γ) (flip.{succ u1, succ u1, succ u1} α β γ f) b) a)
but is expected to have type
  forall {m : Type.{u1} -> Type.{u2}} [_inst_1 : Applicative.{u1, u2} m] [_inst_2 : CommApplicative.{u1, u2} m _inst_1] {α : Type.{u1}} {β : Type.{u1}} {γ : Type.{u1}} (a : m α) (b : m β) {f : α -> β -> γ}, Eq.{succ u2} (m γ) (Seq.seq.{u1, u2} m (Applicative.toSeq.{u1, u2} m _inst_1) β γ (Functor.map.{u1, u2} m (Applicative.toFunctor.{u1, u2} m _inst_1) α (β -> γ) f a) (fun (x._@.Mathlib.Control.Basic._hyg.2549 : Unit) => b)) (Seq.seq.{u1, u2} m (Applicative.toSeq.{u1, u2} m _inst_1) α γ (Functor.map.{u1, u2} m (Applicative.toFunctor.{u1, u2} m _inst_1) β (α -> γ) (flip.{succ u1, succ u1, succ u1} α β γ f) b) (fun (x._@.Mathlib.Control.Basic._hyg.2564 : Unit) => a))
Case conversion may be inaccurate. Consider using '#align is_comm_applicative.commutative_map CommApplicative.commutative_mapₓ'. -/
theorem CommApplicative.commutative_map {m : Type _ → Type _} [Applicative m] [CommApplicative m]
    {α β γ} (a : m α) (b : m β) {f : α → β → γ} : f <$> a <*> b = flip f <$> b <*> a :=
  calc
    f <$> a <*> b = (fun p : α × β => f p.1 p.2) <$> (Prod.mk <$> a <*> b) := by
      simp [seq_map_assoc, map_seq, seq_assoc, seq_pure, map_map]
    _ = (fun b a => f a b) <$> b <*> a := by
      rw [CommApplicative.commutative_prod] <;>
        simp [seq_map_assoc, map_seq, seq_assoc, seq_pure, map_map]

#align is_comm_applicative.commutative_map CommApplicative.commutative_map