/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Floris van Doorn

! This file was ported from Lean 3 source module category_theory.limits.opposites
! leanprover-community/mathlib commit ac3ae212f394f508df43e37aa093722fa9b65d31
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Limits.Filtered
import Mathlib.CategoryTheory.Limits.Shapes.FiniteProducts
import Mathlib.CategoryTheory.DiscreteCategory

/-!
# Limits in `C` give colimits in `Cᵒᵖ`.

We also give special cases for (co)products,
(co)equalizers, and pullbacks / pushouts.

-/

universe v₁ v₂ u₁ u₂

noncomputable section

open CategoryTheory

open CategoryTheory.Functor

open Opposite

namespace CategoryTheory.Limits

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

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

/-- Turn a colimit for `F : J ⥤ C` into a limit for `F.op : Jᵒᵖ ⥤ Cᵒᵖ`. -/
@[simps]
def isLimitCoconeOp (F : J ⥤ C) {c : Cocone F} (hc : IsColimit c) : IsLimit c.op
    where
  lift s := (hc.desc s.unop).op
  fac s j := Quiver.Hom.unop_inj (by simp)
  uniq s m w := by
    refine' Quiver.Hom.unop_inj (hc.hom_ext fun j => Quiver.Hom.op_inj _)
    simpa only [Quiver.Hom.unop_op, IsColimit.fac] using w (op j)
#align category_theory.limits.is_limit_cocone_op CategoryTheory.Limits.isLimitCoconeOp

/-- Turn a limit for `F : J ⥤ C` into a colimit for `F.op : Jᵒᵖ ⥤ Cᵒᵖ`. -/
@[simps]
def isColimitConeOp (F : J ⥤ C) {c : Cone F} (hc : IsLimit c) : IsColimit c.op
    where
  desc s := (hc.lift s.unop).op
  fac s j := Quiver.Hom.unop_inj (by simp)
  uniq s m w := by
    refine' Quiver.Hom.unop_inj (hc.hom_ext fun j => Quiver.Hom.op_inj _)
    simpa only [Quiver.Hom.unop_op, IsLimit.fac] using w (op j)
#align category_theory.limits.is_colimit_cone_op CategoryTheory.Limits.isColimitConeOp

/-- Turn a colimit for `F : J ⥤ Cᵒᵖ` into a limit for `F.leftOp : Jᵒᵖ ⥤ C`. -/
@[simps]
def isLimitConeLeftOpOfCocone (F : J ⥤ Cᵒᵖ) {c : Cocone F} (hc : IsColimit c) :
    IsLimit (coneLeftOpOfCocone c)
    where
  lift s := (hc.desc (coconeOfConeLeftOp s)).unop
  fac s j :=
    Quiver.Hom.op_inj <| by
      simp only [coneLeftOpOfCocone_π_app, op_comp, Quiver.Hom.op_unop, IsColimit.fac,
        coconeOfConeLeftOp_ι_app, op_unop]
  uniq s m w := by
    refine' Quiver.Hom.op_inj (hc.hom_ext fun j => Quiver.Hom.unop_inj _)
    simpa only [Quiver.Hom.op_unop, IsColimit.fac, coconeOfConeLeftOp_ι_app] using w (op j)
#align category_theory.limits.is_limit_cone_left_op_of_cocone CategoryTheory.Limits.isLimitConeLeftOpOfCocone

/-- Turn a limit of `F : J ⥤ Cᵒᵖ` into a colimit of `F.leftOp : Jᵒᵖ ⥤ C`. -/
@[simps]
def isColimitCoconeLeftOpOfCone (F : J ⥤ Cᵒᵖ) {c : Cone F} (hc : IsLimit c) :
    IsColimit (coconeLeftOpOfCone c)
    where
  desc s := (hc.lift (coneOfCoconeLeftOp s)).unop
  fac s j :=
    Quiver.Hom.op_inj <| by
      simp only [coconeLeftOpOfCone_ι_app, op_comp, Quiver.Hom.op_unop, IsLimit.fac,
        coneOfCoconeLeftOp_π_app, op_unop]
  uniq s m w := by
    refine' Quiver.Hom.op_inj (hc.hom_ext fun j => Quiver.Hom.unop_inj _)
    simpa only [Quiver.Hom.op_unop, IsLimit.fac, coneOfCoconeLeftOp_π_app] using w (op j)
#align category_theory.limits.is_colimit_cocone_left_op_of_cone CategoryTheory.Limits.isColimitCoconeLeftOpOfCone

/-- Turn a colimit for `F : Jᵒᵖ ⥤ C` into a limit for `F.rightOp : J ⥤ Cᵒᵖ`. -/
@[simps]
def isLimitConeRightOpOfCocone (F : Jᵒᵖ ⥤ C) {c : Cocone F} (hc : IsColimit c) :
    IsLimit (coneRightOpOfCocone c)
    where
  lift s := (hc.desc (coconeOfConeRightOp s)).op
  fac s j := Quiver.Hom.unop_inj (by simp)
  uniq s m w := by
    refine' Quiver.Hom.unop_inj (hc.hom_ext fun j => Quiver.Hom.op_inj _)
    simpa only [Quiver.Hom.unop_op, IsColimit.fac] using w (unop j)
#align category_theory.limits.is_limit_cone_right_op_of_cocone CategoryTheory.Limits.isLimitConeRightOpOfCocone

/-- Turn a limit for `F : Jᵒᵖ ⥤ C` into a colimit for `F.rightOp : J ⥤ Cᵒᵖ`. -/
@[simps]
def isColimitCoconeRightOpOfCone (F : Jᵒᵖ ⥤ C) {c : Cone F} (hc : IsLimit c) :
    IsColimit (coconeRightOpOfCone c)
    where
  desc s := (hc.lift (coneOfCoconeRightOp s)).op
  fac s j := Quiver.Hom.unop_inj (by simp)
  uniq s m w := by
    refine' Quiver.Hom.unop_inj (hc.hom_ext fun j => Quiver.Hom.op_inj _)
    simpa only [Quiver.Hom.unop_op, IsLimit.fac] using w (unop j)
#align category_theory.limits.is_colimit_cocone_right_op_of_cone CategoryTheory.Limits.isColimitCoconeRightOpOfCone

/-- Turn a colimit for `F : Jᵒᵖ ⥤ Cᵒᵖ` into a limit for `F.unop : J ⥤ C`. -/
@[simps]
def isLimitConeUnopOfCocone (F : Jᵒᵖ ⥤ Cᵒᵖ) {c : Cocone F} (hc : IsColimit c) :
    IsLimit (coneUnopOfCocone c)
    where
  lift s := (hc.desc (coconeOfConeUnop s)).unop
  fac s j := Quiver.Hom.op_inj (by simp)
  uniq s m w := by
    refine' Quiver.Hom.op_inj (hc.hom_ext fun j => Quiver.Hom.unop_inj _)
    simpa only [Quiver.Hom.op_unop, IsColimit.fac] using w (unop j)
#align category_theory.limits.is_limit_cone_unop_of_cocone CategoryTheory.Limits.isLimitConeUnopOfCocone

/-- Turn a limit of `F : Jᵒᵖ ⥤ Cᵒᵖ` into a colimit of `F.unop : J ⥤ C`. -/
@[simps]
def isColimitCoconeUnopOfCone (F : Jᵒᵖ ⥤ Cᵒᵖ) {c : Cone F} (hc : IsLimit c) :
    IsColimit (coconeUnopOfCone c)
    where
  desc s := (hc.lift (coneOfCoconeUnop s)).unop
  fac s j := Quiver.Hom.op_inj (by simp)
  uniq s m w := by
    refine' Quiver.Hom.op_inj (hc.hom_ext fun j => Quiver.Hom.unop_inj _)
    simpa only [Quiver.Hom.op_unop, IsLimit.fac] using w (unop j)
#align category_theory.limits.is_colimit_cocone_unop_of_cone CategoryTheory.Limits.isColimitCoconeUnopOfCone

/-- Turn a colimit for `F.op : Jᵒᵖ ⥤ Cᵒᵖ` into a limit for `F : J ⥤ C`. -/
@[simps]
def isLimitCoconeUnop (F : J ⥤ C) {c : Cocone F.op} (hc : IsColimit c) : IsLimit c.unop
    where
  lift s := (hc.desc s.op).unop
  fac s j := Quiver.Hom.op_inj (by simp)
  uniq s m w := by
    refine' Quiver.Hom.op_inj (hc.hom_ext fun j => Quiver.Hom.unop_inj _)
    simpa only [Quiver.Hom.op_unop, IsColimit.fac] using w (unop j)
#align category_theory.limits.is_limit_cocone_unop CategoryTheory.Limits.isLimitCoconeUnop

/-- Turn a limit for `F.op : Jᵒᵖ ⥤ Cᵒᵖ` into a colimit for `F : J ⥤ C`. -/
@[simps]
def isColimitConeUnop (F : J ⥤ C) {c : Cone F.op} (hc : IsLimit c) : IsColimit c.unop
    where
  desc s := (hc.lift s.op).unop
  fac s j := Quiver.Hom.op_inj (by simp)
  uniq s m w := by
    refine' Quiver.Hom.op_inj (hc.hom_ext fun j => Quiver.Hom.unop_inj _)
    simpa only [Quiver.Hom.op_unop, IsLimit.fac] using w (unop j)
#align category_theory.limits.is_colimit_cone_unop CategoryTheory.Limits.isColimitConeUnop

/-- Turn a colimit for `F.leftOp : Jᵒᵖ ⥤ C` into a limit for `F : J ⥤ Cᵒᵖ`. -/
@[simps]
def isLimitConeOfCoconeLeftOp (F : J ⥤ Cᵒᵖ) {c : Cocone F.leftOp} (hc : IsColimit c) :
    IsLimit (coneOfCoconeLeftOp c)
    where
  lift s := (hc.desc (coconeLeftOpOfCone s)).op
  fac s j :=
    Quiver.Hom.unop_inj <| by
      simp only [coneOfCoconeLeftOp_π_app, unop_comp, Quiver.Hom.unop_op, IsColimit.fac,
        coconeLeftOpOfCone_ι_app, unop_op]
  uniq s m w := by
    refine' Quiver.Hom.unop_inj (hc.hom_ext fun j => Quiver.Hom.op_inj _)
    simpa only [Quiver.Hom.unop_op, IsColimit.fac, coneOfCoconeLeftOp_π_app] using w (unop j)
#align category_theory.limits.is_limit_cone_of_cocone_left_op CategoryTheory.Limits.isLimitConeOfCoconeLeftOp

/-- Turn a limit of `F.leftOp : Jᵒᵖ ⥤ C` into a colimit of `F : J ⥤ Cᵒᵖ`. -/
@[simps]
def isColimitCoconeOfConeLeftOp (F : J ⥤ Cᵒᵖ) {c : Cone F.leftOp} (hc : IsLimit c) :
    IsColimit (coconeOfConeLeftOp c)
    where
  desc s := (hc.lift (coneLeftOpOfCocone s)).op
  fac s j :=
    Quiver.Hom.unop_inj <| by
      simp only [coconeOfConeLeftOp_ι_app, unop_comp, Quiver.Hom.unop_op, IsLimit.fac,
        coneLeftOpOfCocone_π_app, unop_op]
  uniq s m w := by
    refine' Quiver.Hom.unop_inj (hc.hom_ext fun j => Quiver.Hom.op_inj _)
    simpa only [Quiver.Hom.unop_op, IsLimit.fac, coconeOfConeLeftOp_ι_app] using w (unop j)
#align category_theory.limits.is_colimit_cocone_of_cone_left_op CategoryTheory.Limits.isColimitCoconeOfConeLeftOp

/-- Turn a colimit for `F.rightOp : J ⥤ Cᵒᵖ` into a limit for `F : Jᵒᵖ ⥤ C`. -/
@[simps]
def isLimitConeOfCoconeRightOp (F : Jᵒᵖ ⥤ C) {c : Cocone F.rightOp} (hc : IsColimit c) :
    IsLimit (coneOfCoconeRightOp c)
    where
  lift s := (hc.desc (coconeRightOpOfCone s)).unop
  fac s j := Quiver.Hom.op_inj (by simp)
  uniq s m w := by
    refine' Quiver.Hom.op_inj (hc.hom_ext fun j => Quiver.Hom.unop_inj _)
    simpa only [Quiver.Hom.op_unop, IsColimit.fac] using w (op j)
#align category_theory.limits.is_limit_cone_of_cocone_right_op CategoryTheory.Limits.isLimitConeOfCoconeRightOp

/-- Turn a limit for `F.rightOp : J ⥤ Cᵒᵖ` into a limit for `F : Jᵒᵖ ⥤ C`. -/
@[simps]
def isColimitCoconeOfConeRightOp (F : Jᵒᵖ ⥤ C) {c : Cone F.rightOp} (hc : IsLimit c) :
    IsColimit (coconeOfConeRightOp c)
    where
  desc s := (hc.lift (coneRightOpOfCocone s)).unop
  fac s j := Quiver.Hom.op_inj (by simp)
  uniq s m w := by
    refine' Quiver.Hom.op_inj (hc.hom_ext fun j => Quiver.Hom.unop_inj _)
    simpa only [Quiver.Hom.op_unop, IsLimit.fac] using w (op j)
#align category_theory.limits.is_colimit_cocone_of_cone_right_op CategoryTheory.Limits.isColimitCoconeOfConeRightOp

/-- Turn a colimit for `F.unop : J ⥤ C` into a limit for `F : Jᵒᵖ ⥤ Cᵒᵖ`. -/
@[simps]
def isLimitConeOfCoconeUnop (F : Jᵒᵖ ⥤ Cᵒᵖ) {c : Cocone F.unop} (hc : IsColimit c) :
    IsLimit (coneOfCoconeUnop c)
    where
  lift s := (hc.desc (coconeUnopOfCone s)).op
  fac s j := Quiver.Hom.unop_inj (by simp)
  uniq s m w := by
    refine' Quiver.Hom.unop_inj (hc.hom_ext fun j => Quiver.Hom.op_inj _)
    simpa only [Quiver.Hom.unop_op, IsColimit.fac] using w (op j)
#align category_theory.limits.is_limit_cone_of_cocone_unop CategoryTheory.Limits.isLimitConeOfCoconeUnop

/-- Turn a limit for `F.unop : J ⥤ C` into a colimit for `F : Jᵒᵖ ⥤ Cᵒᵖ`. -/
@[simps]
def isColimitConeOfCoconeUnop (F : Jᵒᵖ ⥤ Cᵒᵖ) {c : Cone F.unop} (hc : IsLimit c) :
    IsColimit (coconeOfConeUnop c)
    where
  desc s := (hc.lift (coneUnopOfCocone s)).op
  fac s j := Quiver.Hom.unop_inj (by simp)
  uniq s m w := by
    refine' Quiver.Hom.unop_inj (hc.hom_ext fun j => Quiver.Hom.op_inj _)
    simpa only [Quiver.Hom.unop_op, IsLimit.fac] using w (op j)
#align category_theory.limits.is_colimit_cone_of_cocone_unop CategoryTheory.Limits.isColimitConeOfCoconeUnop

/-- If `F.leftOp : Jᵒᵖ ⥤ C` has a colimit, we can construct a limit for `F : J ⥤ Cᵒᵖ`.
-/
theorem hasLimit_of_hasColimit_leftOp (F : J ⥤ Cᵒᵖ) [HasColimit F.leftOp] : HasLimit F :=
  HasLimit.mk
    { cone := coneOfCoconeLeftOp (colimit.cocone F.leftOp)
      isLimit := isLimitConeOfCoconeLeftOp _ (colimit.isColimit _) }
#align category_theory.limits.has_limit_of_has_colimit_left_op CategoryTheory.Limits.hasLimit_of_hasColimit_leftOp

theorem hasLimit_of_hasColimit_op (F : J ⥤ C) [HasColimit F.op] : HasLimit F :=
  HasLimit.mk
    { cone := (colimit.cocone F.op).unop
      isLimit := isLimitCoconeUnop _ (colimit.isColimit _) }
#align category_theory.limits.has_limit_of_has_colimit_op CategoryTheory.Limits.hasLimit_of_hasColimit_op

/-- If `C` has colimits of shape `Jᵒᵖ`, we can construct limits in `Cᵒᵖ` of shape `J`.
-/
theorem hasLimitsOfShape_op_of_hasColimitsOfShape [HasColimitsOfShape Jᵒᵖ C] :
    HasLimitsOfShape J Cᵒᵖ :=
  { has_limit := fun F => hasLimit_of_hasColimit_leftOp F }
#align category_theory.limits.has_limits_of_shape_op_of_has_colimits_of_shape CategoryTheory.Limits.hasLimitsOfShape_op_of_hasColimitsOfShape

theorem hasLimitsOfShape_of_hasColimitsOfShape_op [HasColimitsOfShape Jᵒᵖ Cᵒᵖ] :
    HasLimitsOfShape J C :=
  { has_limit := fun F => hasLimit_of_hasColimit_op F }
#align category_theory.limits.has_limits_of_shape_of_has_colimits_of_shape_op CategoryTheory.Limits.hasLimitsOfShape_of_hasColimitsOfShape_op

attribute [local instance] hasLimitsOfShape_op_of_hasColimitsOfShape

/-- If `C` has colimits, we can construct limits for `Cᵒᵖ`.
-/
instance hasLimits_op_of_hasColimits [HasColimits C] : HasLimits Cᵒᵖ :=
  ⟨fun _ => inferInstance⟩
#align category_theory.limits.has_limits_op_of_has_colimits CategoryTheory.Limits.hasLimits_op_of_hasColimits

theorem hasLimits_of_hasColimits_op [HasColimits Cᵒᵖ] : HasLimits C :=
  { has_limits_of_shape := fun _ _ => hasLimitsOfShape_of_hasColimitsOfShape_op }
#align category_theory.limits.has_limits_of_has_colimits_op CategoryTheory.Limits.hasLimits_of_hasColimits_op

instance has_cofiltered_limits_op_of_has_filtered_colimits [HasFilteredColimitsOfSize.{v₂, u₂} C] :
    HasCofilteredLimitsOfSize.{v₂, u₂} Cᵒᵖ
    where HasLimitsOfShape _ _ _ := hasLimitsOfShape_op_of_hasColimitsOfShape
#align category_theory.limits.has_cofiltered_limits_op_of_has_filtered_colimits CategoryTheory.Limits.has_cofiltered_limits_op_of_has_filtered_colimits

theorem has_cofiltered_limits_of_has_filtered_colimits_op [HasFilteredColimitsOfSize.{v₂, u₂} Cᵒᵖ] :
    HasCofilteredLimitsOfSize.{v₂, u₂} C :=
  { HasLimitsOfShape := fun _ _ _ => hasLimitsOfShape_of_hasColimitsOfShape_op }
#align category_theory.limits.has_cofiltered_limits_of_has_filtered_colimits_op CategoryTheory.Limits.has_cofiltered_limits_of_has_filtered_colimits_op

/-- If `F.leftOp : Jᵒᵖ ⥤ C` has a limit, we can construct a colimit for `F : J ⥤ Cᵒᵖ`.
-/
theorem hasColimit_of_hasLimit_leftOp (F : J ⥤ Cᵒᵖ) [HasLimit F.leftOp] : HasColimit F :=
  HasColimit.mk
    { cocone := coconeOfConeLeftOp (limit.cone F.leftOp)
      isColimit := isColimitCoconeOfConeLeftOp _ (limit.isLimit _) }
#align category_theory.limits.has_colimit_of_has_limit_left_op CategoryTheory.Limits.hasColimit_of_hasLimit_leftOp

theorem hasColimit_of_hasLimit_op (F : J ⥤ C) [HasLimit F.op] : HasColimit F :=
  HasColimit.mk
    { cocone := (limit.cone F.op).unop
      isColimit := isColimitConeUnop _ (limit.isLimit _) }
#align category_theory.limits.has_colimit_of_has_limit_op CategoryTheory.Limits.hasColimit_of_hasLimit_op

/-- If `C` has colimits of shape `Jᵒᵖ`, we can construct limits in `Cᵒᵖ` of shape `J`.
-/
instance hasColimitsOfShape_op_of_hasLimitsOfShape [HasLimitsOfShape Jᵒᵖ C] :
    HasColimitsOfShape J Cᵒᵖ where has_colimit F := hasColimit_of_hasLimit_leftOp F
#align category_theory.limits.has_colimits_of_shape_op_of_has_limits_of_shape CategoryTheory.Limits.hasColimitsOfShape_op_of_hasLimitsOfShape

theorem hasColimitsOfShape_of_hasLimitsOfShape_op [HasLimitsOfShape Jᵒᵖ Cᵒᵖ] :
    HasColimitsOfShape J C :=
  { has_colimit := fun F => hasColimit_of_hasLimit_op F }
#align category_theory.limits.has_colimits_of_shape_of_has_limits_of_shape_op CategoryTheory.Limits.hasColimitsOfShape_of_hasLimitsOfShape_op

/-- If `C` has limits, we can construct colimits for `Cᵒᵖ`.
-/
instance hasColimits_op_of_hasLimits [HasLimits C] : HasColimits Cᵒᵖ :=
  ⟨fun _ => inferInstance⟩
#align category_theory.limits.has_colimits_op_of_has_limits CategoryTheory.Limits.hasColimits_op_of_hasLimits

theorem hasColimits_of_hasLimits_op [HasLimits Cᵒᵖ] : HasColimits C :=
  { has_colimits_of_shape := fun _ _ => hasColimitsOfShape_of_hasLimitsOfShape_op }
#align category_theory.limits.has_colimits_of_has_limits_op CategoryTheory.Limits.hasColimits_of_hasLimits_op

instance has_filtered_colimits_op_of_has_cofiltered_limits [HasCofilteredLimitsOfSize.{v₂, u₂} C] :
    HasFilteredColimitsOfSize.{v₂, u₂} Cᵒᵖ where HasColimitsOfShape _ _ _ := inferInstance
#align category_theory.limits.has_filtered_colimits_op_of_has_cofiltered_limits CategoryTheory.Limits.has_filtered_colimits_op_of_has_cofiltered_limits

theorem has_filtered_colimits_of_has_cofiltered_limits_op [HasCofilteredLimitsOfSize.{v₂, u₂} Cᵒᵖ] :
    HasFilteredColimitsOfSize.{v₂, u₂} C :=
  { HasColimitsOfShape := fun _ _ _ => hasColimitsOfShape_of_hasLimitsOfShape_op }
#align category_theory.limits.has_filtered_colimits_of_has_cofiltered_limits_op CategoryTheory.Limits.has_filtered_colimits_of_has_cofiltered_limits_op

variable (X : Type v₂)

/-- If `C` has products indexed by `X`, then `Cᵒᵖ` has coproducts indexed by `X`.
-/
instance hasCoproductsOfShape_opposite [HasProductsOfShape X C] : HasCoproductsOfShape X Cᵒᵖ := by
  haveI : HasLimitsOfShape (Discrete X)ᵒᵖ C :=
    hasLimitsOfShape_of_equivalence (Discrete.opposite X).symm
  infer_instance
#align category_theory.limits.has_coproducts_of_shape_opposite CategoryTheory.Limits.hasCoproductsOfShape_opposite

theorem hasCoproductsOfShape_of_opposite [HasProductsOfShape X Cᵒᵖ] : HasCoproductsOfShape X C :=
  haveI : HasLimitsOfShape (Discrete X)ᵒᵖ Cᵒᵖ :=
    hasLimitsOfShape_of_equivalence (Discrete.opposite X).symm
  hasColimitsOfShape_of_hasLimitsOfShape_op
#align category_theory.limits.has_coproducts_of_shape_of_opposite CategoryTheory.Limits.hasCoproductsOfShape_of_opposite

/-- If `C` has coproducts indexed by `X`, then `Cᵒᵖ` has products indexed by `X`.
-/
instance hasProductsOfShape_opposite [HasCoproductsOfShape X C] : HasProductsOfShape X Cᵒᵖ := by
  haveI : HasColimitsOfShape (Discrete X)ᵒᵖ C :=
    hasColimitsOfShape_of_equivalence (Discrete.opposite X).symm
  infer_instance
#align category_theory.limits.has_products_of_shape_opposite CategoryTheory.Limits.hasProductsOfShape_opposite

theorem hasProductsOfShape_of_opposite [HasCoproductsOfShape X Cᵒᵖ] : HasProductsOfShape X C :=
  haveI : HasColimitsOfShape (Discrete X)ᵒᵖ Cᵒᵖ :=
    hasColimitsOfShape_of_equivalence (Discrete.opposite X).symm
  hasLimitsOfShape_of_hasColimitsOfShape_op
#align category_theory.limits.has_products_of_shape_of_opposite CategoryTheory.Limits.hasProductsOfShape_of_opposite

instance hasProducts_opposite [HasCoproducts.{v₂} C] : HasProducts.{v₂} Cᵒᵖ := fun _ =>
  inferInstance
#align category_theory.limits.has_products_opposite CategoryTheory.Limits.hasProducts_opposite

theorem hasProducts_of_opposite [HasCoproducts.{v₂} Cᵒᵖ] : HasProducts.{v₂} C := fun X =>
  hasProductsOfShape_of_opposite X
#align category_theory.limits.has_products_of_opposite CategoryTheory.Limits.hasProducts_of_opposite

instance hasCoproducts_opposite [HasProducts.{v₂} C] : HasCoproducts.{v₂} Cᵒᵖ := fun _ =>
  inferInstance
#align category_theory.limits.has_coproducts_opposite CategoryTheory.Limits.hasCoproducts_opposite

theorem hasCoproducts_of_opposite [HasProducts.{v₂} Cᵒᵖ] : HasCoproducts.{v₂} C := fun X =>
  hasCoproductsOfShape_of_opposite X
#align category_theory.limits.has_coproducts_of_opposite CategoryTheory.Limits.hasCoproducts_of_opposite

instance hasFiniteCoproducts_opposite [HasFiniteProducts C] : HasFiniteCoproducts Cᵒᵖ
    where out _ := Limits.hasCoproductsOfShape_opposite _
#align category_theory.limits.has_finite_coproducts_opposite CategoryTheory.Limits.hasFiniteCoproducts_opposite

theorem hasFiniteCoproducts_of_opposite [HasFiniteProducts Cᵒᵖ] : HasFiniteCoproducts C :=
  { out := fun _ => hasCoproductsOfShape_of_opposite _ }
#align category_theory.limits.has_finite_coproducts_of_opposite CategoryTheory.Limits.hasFiniteCoproducts_of_opposite

instance hasFiniteProducts_opposite [HasFiniteCoproducts C] : HasFiniteProducts Cᵒᵖ
    where out _ := inferInstance
#align category_theory.limits.has_finite_products_opposite CategoryTheory.Limits.hasFiniteProducts_opposite

theorem hasFiniteProducts_of_opposite [HasFiniteCoproducts Cᵒᵖ] : HasFiniteProducts C :=
  { out := fun _ => hasProductsOfShape_of_opposite _ }
#align category_theory.limits.has_finite_products_of_opposite CategoryTheory.Limits.hasFiniteProducts_of_opposite

instance hasEqualizers_opposite [HasCoequalizers C] : HasEqualizers Cᵒᵖ := by
  haveI : HasColimitsOfShape WalkingParallelPairᵒᵖ C :=
    hasColimitsOfShape_of_equivalence walkingParallelPairOpEquiv
  infer_instance
#align category_theory.limits.has_equalizers_opposite CategoryTheory.Limits.hasEqualizers_opposite

instance hasCoequalizers_opposite [HasEqualizers C] : HasCoequalizers Cᵒᵖ := by
  haveI : HasLimitsOfShape WalkingParallelPairᵒᵖ C :=
    hasLimitsOfShape_of_equivalence walkingParallelPairOpEquiv
  infer_instance
#align category_theory.limits.has_coequalizers_opposite CategoryTheory.Limits.hasCoequalizers_opposite

instance hasFiniteColimits_opposite [HasFiniteLimits C] : HasFiniteColimits Cᵒᵖ :=
  ⟨fun _ _ _ => inferInstance⟩
#align category_theory.limits.has_finite_colimits_opposite CategoryTheory.Limits.hasFiniteColimits_opposite

instance hasFiniteLimits_opposite [HasFiniteColimits C] : HasFiniteLimits Cᵒᵖ :=
  ⟨fun _ _ _ => inferInstance⟩
#align category_theory.limits.has_finite_limits_opposite CategoryTheory.Limits.hasFiniteLimits_opposite

instance hasPullbacks_opposite [HasPushouts C] : HasPullbacks Cᵒᵖ := by
  haveI : HasColimitsOfShape WalkingCospanᵒᵖ C :=
    hasColimitsOfShape_of_equivalence walkingCospanOpEquiv.symm
  apply hasLimitsOfShape_op_of_hasColimitsOfShape
#align category_theory.limits.has_pullbacks_opposite CategoryTheory.Limits.hasPullbacks_opposite

instance hasPushouts_opposite [HasPullbacks C] : HasPushouts Cᵒᵖ := by
  haveI : HasLimitsOfShape WalkingSpanᵒᵖ C :=
    hasLimitsOfShape_of_equivalence walkingSpanOpEquiv.symm
  infer_instance
#align category_theory.limits.has_pushouts_opposite CategoryTheory.Limits.hasPushouts_opposite

/-- The canonical isomorphism relating `Span f.op g.op` and `(Cospan f g).op` -/
@[simps!]
def spanOp {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) :
    span f.op g.op ≅ walkingCospanOpEquiv.inverse ⋙ (cospan f g).op :=
  NatIso.ofComponents (by rintro (_ | _ | _) <;> rfl)
    (by rintro (_ | _ | _) (_ | _ | _) f <;> cases f <;> aesop_cat)
#align category_theory.limits.span_op CategoryTheory.Limits.spanOp

/-- The canonical isomorphism relating `(Cospan f g).op` and `Span f.op g.op` -/
@[simps!]
def opCospan {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) :
    (cospan f g).op ≅ walkingCospanOpEquiv.functor ⋙ span f.op g.op :=
  calc
    (cospan f g).op ≅ 𝟭 _ ⋙ (cospan f g).op := by rfl
    _ ≅ (walkingCospanOpEquiv.functor ⋙ walkingCospanOpEquiv.inverse) ⋙ (cospan f g).op :=
      (isoWhiskerRight walkingCospanOpEquiv.unitIso _)
    _ ≅ walkingCospanOpEquiv.functor ⋙ walkingCospanOpEquiv.inverse ⋙ (cospan f g).op :=
      (Functor.associator _ _ _)
    _ ≅ walkingCospanOpEquiv.functor ⋙ span f.op g.op := isoWhiskerLeft _ (spanOp f g).symm
#align category_theory.limits.op_cospan CategoryTheory.Limits.opCospan

/-- The canonical isomorphism relating `Cospan f.op g.op` and `(Span f g).op` -/
@[simps!]
def cospanOp {X Y Z : C} (f : X ⟶ Y) (g : X ⟶ Z) :
    cospan f.op g.op ≅ walkingSpanOpEquiv.inverse ⋙ (span f g).op :=
  NatIso.ofComponents (by rintro (_ | _ | _) <;> rfl)
    (by rintro (_ | _ | _) (_ | _ | _) f <;> cases f <;> aesop_cat)
#align category_theory.limits.cospan_op CategoryTheory.Limits.cospanOp

/-- The canonical isomorphism relating `(Span f g).op` and `Cospan f.op g.op` -/
@[simps!]
def opSpan {X Y Z : C} (f : X ⟶ Y) (g : X ⟶ Z) :
    (span f g).op ≅ walkingSpanOpEquiv.functor ⋙ cospan f.op g.op :=
  calc
    (span f g).op ≅ 𝟭 _ ⋙ (span f g).op := by rfl
    _ ≅ (walkingSpanOpEquiv.functor ⋙ walkingSpanOpEquiv.inverse) ⋙ (span f g).op :=
      (isoWhiskerRight walkingSpanOpEquiv.unitIso _)
    _ ≅ walkingSpanOpEquiv.functor ⋙ walkingSpanOpEquiv.inverse ⋙ (span f g).op :=
      (Functor.associator _ _ _)
    _ ≅ walkingSpanOpEquiv.functor ⋙ cospan f.op g.op := isoWhiskerLeft _ (cospanOp f g).symm

#align category_theory.limits.op_span CategoryTheory.Limits.opSpan

namespace PushoutCocone

-- porting note: it was originally @[simps (config := lemmasOnly)]
/-- The obvious map `PushoutCocone f g → PullbackCone f.unop g.unop` -/
@[simps!]
def unop {X Y Z : Cᵒᵖ} {f : X ⟶ Y} {g : X ⟶ Z} (c : PushoutCocone f g) :
    PullbackCone f.unop g.unop :=
  Cocone.unop
    ((Cocones.precompose (opCospan f.unop g.unop).hom).obj
      (Cocone.whisker walkingCospanOpEquiv.functor c))
#align category_theory.limits.pushout_cocone.unop CategoryTheory.Limits.PushoutCocone.unop

-- porting note: removed simp attribute as the equality can already be obtained by simp
theorem unop_fst {X Y Z : Cᵒᵖ} {f : X ⟶ Y} {g : X ⟶ Z} (c : PushoutCocone f g) :
    c.unop.fst = c.inl.unop := by simp
#align category_theory.limits.pushout_cocone.unop_fst CategoryTheory.Limits.PushoutCocone.unop_fst

-- porting note: removed simp attribute as the equality can already be obtained by simp
theorem unop_snd {X Y Z : Cᵒᵖ} {f : X ⟶ Y} {g : X ⟶ Z} (c : PushoutCocone f g) :
    c.unop.snd = c.inr.unop := by aesop_cat
#align category_theory.limits.pushout_cocone.unop_snd CategoryTheory.Limits.PushoutCocone.unop_snd

-- porting note: it was originally @[simps (config := lemmasOnly)]
/-- The obvious map `PushoutCocone f.op g.op → PullbackCone f g` -/
@[simps!]
def op {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (c : PushoutCocone f g) : PullbackCone f.op g.op :=
  (Cones.postcompose (cospanOp f g).symm.hom).obj
    (Cone.whisker walkingSpanOpEquiv.inverse (Cocone.op c))
#align category_theory.limits.pushout_cocone.op CategoryTheory.Limits.PushoutCocone.op

-- porting note: removed simp attribute as the equality can already be obtained by simp

-- porting note: removed simp attribute as the equality can already be obtained by simp
theorem op_snd {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (c : PushoutCocone f g) : c.op.snd = c.inr.op :=
  by aesop_cat
#align category_theory.limits.pushout_cocone.op_snd CategoryTheory.Limits.PushoutCocone.op_snd

end PushoutCocone

namespace PullbackCone

-- porting note: it was originally @[simps (config := lemmasOnly)]
/-- The obvious map `PullbackCone f g → PushoutCocone f.unop g.unop` -/
@[simps!]
def unop {X Y Z : Cᵒᵖ} {f : X ⟶ Z} {g : Y ⟶ Z} (c : PullbackCone f g) :
    PushoutCocone f.unop g.unop :=
  Cone.unop
    ((Cones.postcompose (opSpan f.unop g.unop).symm.hom).obj
      (Cone.whisker walkingSpanOpEquiv.functor c))
#align category_theory.limits.pullback_cone.unop CategoryTheory.Limits.PullbackCone.unop

-- porting note: removed simp attribute as the equality can already be obtained by simp
theorem unop_inl {X Y Z : Cᵒᵖ} {f : X ⟶ Z} {g : Y ⟶ Z} (c : PullbackCone f g) :
    c.unop.inl = c.fst.unop := by aesop_cat
#align category_theory.limits.pullback_cone.unop_inl CategoryTheory.Limits.PullbackCone.unop_inl

-- porting note: removed simp attribute as the equality can already be obtained by simp
theorem unop_inr {X Y Z : Cᵒᵖ} {f : X ⟶ Z} {g : Y ⟶ Z} (c : PullbackCone f g) :
    c.unop.inr = c.snd.unop := by aesop_cat
#align category_theory.limits.pullback_cone.unop_inr CategoryTheory.Limits.PullbackCone.unop_inr

/-- The obvious map `PullbackCone f g → PushoutCocone f.op g.op` -/
@[simps!]
def op {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (c : PullbackCone f g) : PushoutCocone f.op g.op :=
  (Cocones.precompose (spanOp f g).hom).obj
    (Cocone.whisker walkingCospanOpEquiv.inverse (Cone.op c))
#align category_theory.limits.pullback_cone.op CategoryTheory.Limits.PullbackCone.op

-- porting note: removed simp attribute as the equality can already be obtained by simp
theorem op_inl {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (c : PullbackCone f g) : c.op.inl = c.fst.op :=
  by aesop_cat
#align category_theory.limits.pullback_cone.op_inl CategoryTheory.Limits.PullbackCone.op_inl

-- porting note: removed simp attribute as the equality can already be obtained by simp
theorem op_inr {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (c : PullbackCone f g) : c.op.inr = c.snd.op :=
  by aesop_cat
#align category_theory.limits.pullback_cone.op_inr CategoryTheory.Limits.PullbackCone.op_inr

/-- If `c` is a pullback cone, then `c.op.unop` is isomorphic to `c`. -/
def opUnop {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (c : PullbackCone f g) : c.op.unop ≅ c :=
  PullbackCone.ext (Iso.refl _) (by simp) (by simp)
#align category_theory.limits.pullback_cone.op_unop CategoryTheory.Limits.PullbackCone.opUnop

/-- If `c` is a pullback cone in `Cᵒᵖ`, then `c.unop.op` is isomorphic to `c`. -/
def unopOp {X Y Z : Cᵒᵖ} {f : X ⟶ Z} {g : Y ⟶ Z} (c : PullbackCone f g) : c.unop.op ≅ c :=
  PullbackCone.ext (Iso.refl _) (by simp) (by simp)
#align category_theory.limits.pullback_cone.unop_op CategoryTheory.Limits.PullbackCone.unopOp

end PullbackCone

namespace PushoutCocone

/-- If `c` is a pushout cocone, then `c.op.unop` is isomorphic to `c`. -/
def opUnop {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (c : PushoutCocone f g) : c.op.unop ≅ c :=
  PushoutCocone.ext (Iso.refl _) (by simp) (by simp)
#align category_theory.limits.pushout_cocone.op_unop CategoryTheory.Limits.PushoutCocone.opUnop

/-- If `c` is a pushout cocone in `Cᵒᵖ`, then `c.unop.op` is isomorphic to `c`. -/
def unopOp {X Y Z : Cᵒᵖ} {f : X ⟶ Y} {g : X ⟶ Z} (c : PushoutCocone f g) : c.unop.op ≅ c :=
  PushoutCocone.ext (Iso.refl _) (by simp) (by simp)
#align category_theory.limits.pushout_cocone.unop_op CategoryTheory.Limits.PushoutCocone.unopOp

/-- A pushout cone is a colimit cocone if and only if the corresponding pullback cone
in the opposite category is a limit cone. -/
def isColimitEquivIsLimitOp {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (c : PushoutCocone f g) :
    IsColimit c ≃ IsLimit c.op := by
  apply equivOfSubsingletonOfSubsingleton
  . intro h
    exact (IsLimit.postcomposeHomEquiv _ _).invFun
      ((IsLimit.whiskerEquivalenceEquiv walkingSpanOpEquiv.symm).toFun (isLimitCoconeOp _ h))
  . intro h
    exact (IsColimit.equivIsoColimit c.opUnop).toFun
      (isColimitConeUnop _ ((IsLimit.postcomposeHomEquiv _ _).invFun
        ((IsLimit.whiskerEquivalenceEquiv _).toFun h)))
#align category_theory.limits.pushout_cocone.is_colimit_equiv_is_limit_op CategoryTheory.Limits.PushoutCocone.isColimitEquivIsLimitOp

/-- A pushout cone is a colimit cocone in `Cᵒᵖ` if and only if the corresponding pullback cone
in `C` is a limit cone. -/
def isColimitEquivIsLimitUnop {X Y Z : Cᵒᵖ} {f : X ⟶ Y} {g : X ⟶ Z} (c : PushoutCocone f g) :
    IsColimit c ≃ IsLimit c.unop := by
  apply equivOfSubsingletonOfSubsingleton
  . intro h
    exact isLimitCoconeOp _ ((IsColimit.precomposeHomEquiv _ _).invFun
      ((IsColimit.whiskerEquivalenceEquiv _).toFun h))
  . intro h
    exact (IsColimit.equivIsoColimit c.unopOp).toFun
      ((IsColimit.precomposeHomEquiv _ _).invFun
      ((IsColimit.whiskerEquivalenceEquiv walkingCospanOpEquiv.symm).toFun (isColimitConeOp _ h)))
#align category_theory.limits.pushout_cocone.is_colimit_equiv_is_limit_unop CategoryTheory.Limits.PushoutCocone.isColimitEquivIsLimitUnop

end PushoutCocone

namespace PullbackCone

/-- A pullback cone is a limit cone if and only if the corresponding pushout cocone
in the opposite category is a colimit cocone. -/
def isLimitEquivIsColimitOp {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (c : PullbackCone f g) :
    IsLimit c ≃ IsColimit c.op :=
  (IsLimit.equivIsoLimit c.opUnop).symm.trans c.op.isColimitEquivIsLimitUnop.symm
#align category_theory.limits.pullback_cone.is_limit_equiv_is_colimit_op CategoryTheory.Limits.PullbackCone.isLimitEquivIsColimitOp

/-- A pullback cone is a limit cone in `Cᵒᵖ` if and only if the corresponding pushout cocone
in `C` is a colimit cocone. -/
def isLimitEquivIsColimitUnop {X Y Z : Cᵒᵖ} {f : X ⟶ Z} {g : Y ⟶ Z} (c : PullbackCone f g) :
    IsLimit c ≃ IsColimit c.unop :=
  (IsLimit.equivIsoLimit c.unopOp).symm.trans c.unop.isColimitEquivIsLimitOp.symm
#align category_theory.limits.pullback_cone.is_limit_equiv_is_colimit_unop CategoryTheory.Limits.PullbackCone.isLimitEquivIsColimitUnop

end PullbackCone

section Pullback

open Opposite

/-- The pullback of `f` and `g` in `C` is isomorphic to the pushout of
`f.op` and `g.op` in `Cᵒᵖ`. -/
noncomputable def pullbackIsoUnopPushout {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) [h : HasPullback f g]
    [HasPushout f.op g.op] : pullback f g ≅ unop (pushout f.op g.op) :=
  IsLimit.conePointUniqueUpToIso (@limit.isLimit _ _ _ _ _ h)
    ((PushoutCocone.isColimitEquivIsLimitUnop _) (colimit.isColimit (span f.op g.op)))
#align category_theory.limits.pullback_iso_unop_pushout CategoryTheory.Limits.pullbackIsoUnopPushout

@[reassoc (attr := simp)]
theorem pullbackIsoUnopPushout_inv_fst {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) [HasPullback f g]
    [HasPushout f.op g.op] :
    (pullbackIsoUnopPushout f g).inv ≫ pullback.fst = (pushout.inl : _ ⟶ pushout f.op g.op).unop :=
  (IsLimit.conePointUniqueUpToIso_inv_comp _ _ _).trans (by simp)
#align category_theory.limits.pullback_iso_unop_pushout_inv_fst CategoryTheory.Limits.pullbackIsoUnopPushout_inv_fst

@[reassoc (attr := simp)]
theorem pullbackIsoUnopPushout_inv_snd {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) [HasPullback f g]
    [HasPushout f.op g.op] :
    (pullbackIsoUnopPushout f g).inv ≫ pullback.snd = (pushout.inr : _ ⟶ pushout f.op g.op).unop :=
  (IsLimit.conePointUniqueUpToIso_inv_comp _ _ _).trans (by simp)
#align category_theory.limits.pullback_iso_unop_pushout_inv_snd CategoryTheory.Limits.pullbackIsoUnopPushout_inv_snd

@[reassoc (attr := simp)]
theorem pullbackIsoUnopPushout_hom_inl {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) [HasPullback f g]
    [HasPushout f.op g.op] : pushout.inl ≫ (pullbackIsoUnopPushout f g).hom.op = pullback.fst.op :=
  by
  apply Quiver.Hom.unop_inj
  dsimp
  rw [← pullbackIsoUnopPushout_inv_fst, Iso.hom_inv_id_assoc]
#align category_theory.limits.pullback_iso_unop_pushout_hom_inl CategoryTheory.Limits.pullbackIsoUnopPushout_hom_inl

@[reassoc (attr := simp)]
theorem pullbackIsoUnopPushout_hom_inr {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) [HasPullback f g]
    [HasPushout f.op g.op] : pushout.inr ≫ (pullbackIsoUnopPushout f g).hom.op = pullback.snd.op :=
  by
  apply Quiver.Hom.unop_inj
  dsimp
  rw [← pullbackIsoUnopPushout_inv_snd, Iso.hom_inv_id_assoc]
#align category_theory.limits.pullback_iso_unop_pushout_hom_inr CategoryTheory.Limits.pullbackIsoUnopPushout_hom_inr

end Pullback

section Pushout

/-- The pushout of `f` and `g` in `C` is isomorphic to the pullback of
 `f.op` and `g.op` in `Cᵒᵖ`. -/
noncomputable def pushoutIsoUnopPullback {X Y Z : C} (f : X ⟶ Z) (g : X ⟶ Y) [h : HasPushout f g]
    [HasPullback f.op g.op] : pushout f g ≅ unop (pullback f.op g.op) :=
  IsColimit.coconePointUniqueUpToIso (@colimit.isColimit _ _ _ _ _ h)
    ((PullbackCone.isLimitEquivIsColimitUnop _) (limit.isLimit (cospan f.op g.op)))
#align category_theory.limits.pushout_iso_unop_pullback CategoryTheory.Limits.pushoutIsoUnopPullback

@[reassoc (attr := simp)]
theorem pushoutIsoUnopPullback_inl_hom {X Y Z : C} (f : X ⟶ Z) (g : X ⟶ Y) [HasPushout f g]
    [HasPullback f.op g.op] :
    pushout.inl ≫ (pushoutIsoUnopPullback f g).hom =
      (pullback.fst : pullback f.op g.op ⟶ _).unop :=
  (IsColimit.comp_coconePointUniqueUpToIso_hom _ _ _).trans (by simp)
#align category_theory.limits.pushout_iso_unop_pullback_inl_hom CategoryTheory.Limits.pushoutIsoUnopPullback_inl_hom

@[reassoc (attr := simp)]
theorem pushoutIsoUnopPullback_inr_hom {X Y Z : C} (f : X ⟶ Z) (g : X ⟶ Y) [HasPushout f g]
    [HasPullback f.op g.op] :
    pushout.inr ≫ (pushoutIsoUnopPullback f g).hom =
      (pullback.snd : pullback f.op g.op ⟶ _).unop :=
  (IsColimit.comp_coconePointUniqueUpToIso_hom _ _ _).trans (by simp)
#align category_theory.limits.pushout_iso_unop_pullback_inr_hom CategoryTheory.Limits.pushoutIsoUnopPullback_inr_hom

@[simp]
theorem pushoutIsoUnopPullback_inv_fst {X Y Z : C} (f : X ⟶ Z) (g : X ⟶ Y) [HasPushout f g]
    [HasPullback f.op g.op] :
      (pushoutIsoUnopPullback f g).inv.op ≫ pullback.fst = pushout.inl.op :=
  by
  apply Quiver.Hom.unop_inj
  dsimp
  rw [← pushoutIsoUnopPullback_inl_hom, Category.assoc, Iso.hom_inv_id, Category.comp_id]
#align category_theory.limits.pushout_iso_unop_pullback_inv_fst CategoryTheory.Limits.pushoutIsoUnopPullback_inv_fst

@[simp]
theorem pushoutIsoUnopPullback_inv_snd {X Y Z : C} (f : X ⟶ Z) (g : X ⟶ Y) [HasPushout f g]
    [HasPullback f.op g.op] :
      (pushoutIsoUnopPullback f g).inv.op ≫ pullback.snd = pushout.inr.op :=
  by
  apply Quiver.Hom.unop_inj
  dsimp
  rw [← pushoutIsoUnopPullback_inr_hom, Category.assoc, Iso.hom_inv_id, Category.comp_id]
#align category_theory.limits.pushout_iso_unop_pullback_inv_snd CategoryTheory.Limits.pushoutIsoUnopPullback_inv_snd

end Pushout

end CategoryTheory.Limits


import data.real.basic
import data.polynomial.basic
import data.polynomial.induction
import data.real.cau_seq

import abvs_equiv
import valuations.basic
import valuations.abv_pid
import valuations.bounded

import for_mathlib.degree

open is_absolute_value
open_locale classical
noncomputable theory

def degree_norm {R} [field R] (c: ℝ) (one_lt_c: 1 < c): polynomial R → ℝ :=
  λ p, if p = 0 then 0 else c ^ p.nat_degree

instance degree_norm.is_absolute_value {R} [field R] (c: ℝ) (one_lt_c: 1 < c):
  is_absolute_value (@degree_norm R _ c one_lt_c) :=
begin
  have c_pos := (lt_trans zero_lt_one one_lt_c),
  exact { abv_nonneg := λ p, if h: p = 0
      then by simp [degree_norm, h, int.zero_nonneg]
      else by simp [degree_norm, h, pow_nonneg (le_of_lt c_pos) p.nat_degree],
    abv_eq_zero := λ p, if h: p = 0
      then by simp [degree_norm, h]
      else by { simp [degree_norm, h], exact (ne.symm $ ne_of_lt $ pow_pos c_pos _), },
    abv_add := λ p q, if hp: p = 0
      then by { simp [degree_norm, hp], }
      else if hq: q = 0
      then by { simp [degree_norm, hq], }
      else if hpq: p + q = 0
      then by {
        simp [degree_norm, hpq, hp, hq],
        exact (λ p₁: (Π (n: ℕ), 0 ≤ c ^ n),
            add_nonneg (p₁ p.nat_degree) (p₁ q.nat_degree))
          (pow_nonneg $ le_of_lt c_pos),
      }
      else by {
        simp [degree_norm, hpq, hp, hq],
        cases le_max_iff.1 (polynomial.degree_add_le p q) with h₀ h₀;
        have h := polynomial.nat_degree_le_nat_degree h₀;
        apply le_trans (pow_le_pow (le_of_lt one_lt_c) h);
        linarith [pow_nonneg (le_of_lt c_pos) p.nat_degree,
          pow_nonneg (le_of_lt c_pos) q.nat_degree],
      },
    abv_mul := λ p q, if hp: p = 0
      then by { simp [degree_norm, hp], }
      else if hq: q = 0
      then by { simp [degree_norm, hq], }
      else by {
        simp [degree_norm, hp, hq],
        have hpq: p * q ≠ 0,
        {
          by_contra hpq,
          push_neg at hpq,
          cases eq_zero_or_eq_zero_of_mul_eq_zero hpq,
          exact hp h, exact hq h,
        },
        have := (@polynomial.degree_mul _ _ _ p q),
        rw polynomial.degree_eq_nat_degree hp at this,
        rw polynomial.degree_eq_nat_degree hq at this,
        rw polynomial.degree_eq_nat_degree hpq at this,
        norm_cast at this,
        rw this,
        rw pow_add,
      }, },
end

def sample_degree_norm {R} [field R]: polynomial R → ℝ := degree_norm 2 one_lt_two

instance sample_degree_norm.is_absolute_value {R} [hR: field R]:
  is_absolute_value (@sample_degree_norm R hR) :=
    degree_norm.is_absolute_value 2 one_lt_two

lemma polynomial_abv_nonarchimedian {R} [field R] [normalization_monoid R]
  (abv: polynomial R → ℝ) [is_absolute_value abv]
  (trivial_on_base: ∀ x: R, x ≠ 0 → abv (polynomial.C x) = 1):
    ∀ a b: polynomial R, abv (a + b) ≤ max (abv a) (abv b) :=
begin
  have bounded_on_base: ∀ a: R, abv (polynomial.C a) ≤ 1,
    from λ p, if hp: p = 0
      then by simp [hp, abv_zero abv, zero_le_one]
      else (le_of_eq $ trivial_on_base p hp),
  rw ← nonarchimedian_iff_integers_bounded,
  use [1, zero_lt_one],
  intro n,
  rw show (n: polynomial R) = (polynomial.C (n: R)), by simp,
  exact bounded_on_base n,
end

theorem polynomial_abv_is_degree {R} [field R] [normalization_monoid R]
  (abv: polynomial R → ℝ) [is_absolute_value abv]
  (one_lt_abvx: 1 < abv polynomial.X)
  (trivial_on_base: ∀ x: R, x ≠ 0 → abv (polynomial.C x) = 1):
    abvs_equiv abv sample_degree_norm :=
begin
  have nonarchimedian := polynomial_abv_nonarchimedian abv trivial_on_base,

  have abv_sum_of_abv_ne: ∀ p q: polynomial R, abv p < abv q → abv (p + q) = abv q,
  {
    intros a b hab,
    apply le_antisymm,
    calc abv (a + b) ≤ max (abv a) (abv b) : nonarchimedian _ _
      ... = abv b : max_eq_right (le_of_lt hab),
    have h₀: abv b ≤ max (abv a) (abv (a + b)),
    {
      calc abv b = abv (-a + (a + b)) : by ring_nf
        ... ≤ max (abv (-a)) (abv (a + b)) : nonarchimedian _ _
        ... = max (abv a) (abv (a + b)) : by rw abv_neg abv
    },
    have h₁: max (abv a) (abv (a + b)) = abv (a + b) :=
      (max_choice (abv a) (abv (a + b)))
      .resolve_left (ne_of_lt (lt_of_lt_of_le hab h₀)).symm,
    rwa h₁ at h₀,
  },

  suffices: abvs_equiv abv (degree_norm (abv polynomial.X) one_lt_abvx),
  {
    apply abvs_equiv_transitive
      abv (degree_norm (abv polynomial.X) one_lt_abvx) sample_degree_norm this,
    set α := real.log 2 / real.log (abv polynomial.X) with α_def,
    have α_pos: 0 < α,
    from div_pos (real.log_pos one_lt_two) (real.log_pos one_lt_abvx),
    use [α, α_pos],
    unfold sample_degree_norm,
    unfold degree_norm,
    ext p,
    by_cases hp: p = 0,
    simp [hp, abv_zero abv, real.zero_rpow (ne_of_lt α_pos).symm],
    suffices: ((abv polynomial.X) ^ (p.nat_degree: ℝ)) ^ α = 2 ^ (p.nat_degree: ℝ),
    {
      simp [hp],
      rw ← real.rpow_nat_cast _ p.nat_degree,
      rw ← real.rpow_nat_cast _ p.nat_degree,
      exact this,
    },
    rw ← real.rpow_mul (le_of_lt $ lt_trans zero_lt_one one_lt_abvx),
    apply log_inj_pos
      (real.rpow_pos_of_pos (lt_trans zero_lt_one one_lt_abvx) _)
      (real.rpow_pos_of_pos zero_lt_two _),
    rw real.log_rpow (lt_trans zero_lt_one one_lt_abvx),
    rw real.log_rpow zero_lt_two,
    rw α_def,
    calc (p.nat_degree: ℝ) * (real.log 2 / real.log (abv polynomial.X))
      * real.log (abv polynomial.X)
      = (p.nat_degree: ℝ) * real.log 2 *
        (real.log (abv polynomial.X) / real.log (abv polynomial.X)) : by ring
      ... = (p.nat_degree: ℝ) * real.log 2 : by rw [div_self
        (real.log_ne_zero_of_ne_one _ (lt_trans zero_lt_one one_lt_abvx)
        (ne_of_lt one_lt_abvx).symm), mul_one],
  },

  use [1, zero_lt_one],
  simp [degree_norm],
  ext p,
  refine p.rec_on_horner _ _ _,
  {
    simp [abv_zero abv],
  },
  {
    intros q c hq_coeff hc_ne_zero hq_eq_abv,
    by_cases hq_zero: q = 0,
    {
      simp [hq_zero, trivial_on_base c hc_ne_zero, if_neg hc_ne_zero],
    },
    have zero_lt_deg_q: 0 < q.degree,
    {
      -- TODO: avoid naturals and just use with_bot ℕ, it's simpler.
      apply polynomial.nat_degree_pos_iff_degree_pos.1,
      apply nat.succ_le_of_lt,
      apply nat.lt_of_le_and_ne,
      exact polynomial.zero_le_nat_degree hq_zero,
      by_contra, push_neg at h,
      rw [polynomial.eq_C_of_nat_degree_eq_zero h.symm, hq_coeff] at hq_zero,
      simp at hq_zero,
      exact hq_zero,
    },
    {
      rw [if_neg hq_zero] at hq_eq_abv,
      rw [add_comm q _, abv_sum_of_abv_ne, hq_eq_abv, add_comm _ q,
      polynomial.nat_degree_add_C],
      have hq_add_const_ne_zero: q + polynomial.C c ≠ 0,
      {
        apply mt polynomial.degree_eq_bot.2,
        rw [polynomial.degree_add_C zero_lt_deg_q],
        exact (mt polynomial.degree_eq_bot.1) hq_zero,
      },
      rw [if_neg hq_add_const_ne_zero],
      {
        intro h_deg_q,
        rw [polynomial.eq_C_of_nat_degree_eq_zero h_deg_q, hq_coeff],
        simp [hc_ne_zero],
      },
      {
        rw [trivial_on_base c hc_ne_zero, hq_eq_abv],
        refine one_lt_pow one_lt_abvx _,
        exact
        (nat.succ_le_of_lt
          (polynomial.nat_degree_pos_iff_degree_pos.2 zero_lt_deg_q)),
      },
    },
  },
  {
    intros q hq_ne_zero habv_q,
    rw [if_neg hq_ne_zero] at habv_q,
    rw [if_neg (mul_ne_zero hq_ne_zero polynomial.X_ne_zero),
      polynomial.nat_degree_mul hq_ne_zero polynomial.X_ne_zero, abv_mul abv,
      habv_q, ← pow_succ'],
    simp,
  },

end

theorem polynomial_abv_is_padic {R} [field R] [normalization_monoid R]
  (abv: polynomial R → ℝ) [is_absolute_value abv]
  (nontrivial: abv ≠ (λ x, if x = 0 then 0 else 1))
  (abvx_le_one: abv polynomial.X ≤ 1)
  (trivial_on_base: ∀ x: R, x ≠ 0 → abv (polynomial.C x) = 1):
    ∃ (p: polynomial R) [p_prime: fact (prime p)], abvs_equiv abv (@sample_padic_abv _ _ _ _ p p_prime) :=
begin
  apply abv_bounded_padic abv,
  {
    have nonarchimedian := polynomial_abv_nonarchimedian abv trivial_on_base,
    have bounded_on_base: ∀ a: R, abv (polynomial.C a) ≤ 1,
      from λ p, if hp: p = 0
        then by simp [hp, abv_zero abv, zero_le_one]
        else (le_of_eq $ trivial_on_base p hp),
    intro p,
    apply polynomial.induction_on p,
    from bounded_on_base,
    from λ p q hp hq,
      by { calc abv (p + q) ≤ max (abv p) (abv q) : nonarchimedian p q
        ... ≤ 1 : max_le_iff.2 ⟨ hp, hq ⟩, },
    from λ n a h, by {
      rw pow_succ,
      rw mul_comm (polynomial.X) _,
      rw ← mul_assoc,
      rw abv_mul abv,
      convert mul_le_mul h abvx_le_one (abv_nonneg abv polynomial.X) zero_le_one,
      rw mul_one,
    },
  },
  {
    by_contra h,
    push_neg at h,
    apply nontrivial,
    ext,
    exact if hx: x = 0
      then by { simp [hx, abv_zero abv], }
      else by { simp [hx, h x hx], },
  },
end


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import analysis.convex.function

/-!
# Quasiconvex and quasiconcave functions

This file defines quasiconvexity, quasiconcavity and quasilinearity of functions, which are
generalizations of unimodality and monotonicity. Convexity implies quasiconvexity, concavity implies
quasiconcavity, and monotonicity implies quasilinearity.

## Main declarations

* `quasiconvex_on 𝕜 s f`: Quasiconvexity of the function `f` on the set `s` with scalars `𝕜`. This
  means that, for all `r`, `{x ∈ s | f x ≤ r}` is `𝕜`-convex.
* `quasiconcave_on 𝕜 s f`: Quasiconcavity of the function `f` on the set `s` with scalars `𝕜`. This
  means that, for all `r`, `{x ∈ s | r ≤ f x}` is `𝕜`-convex.
* `quasilinear_on 𝕜 s f`: Quasilinearity of the function `f` on the set `s` with scalars `𝕜`. This
  means that `f` is both quasiconvex and quasiconcave.

## TODO

Prove that a quasilinear function between two linear orders is either monotone or antitone. This is
not hard but quite a pain to go about as there are many cases to consider.

## References

* https://en.wikipedia.org/wiki/Quasiconvex_function
-/

open function order_dual set

variables {𝕜 E F β : Type*}

section ordered_semiring
variables [ordered_semiring 𝕜]

section add_comm_monoid
variables [add_comm_monoid E] [add_comm_monoid F]

section ordered_add_comm_monoid
variables (𝕜) [ordered_add_comm_monoid β] [has_scalar 𝕜 E] (s : set E) (f : E → β)

/-- A function is quasiconvex if all its sublevels are convex.
This means that, for all `r`, `{x ∈ s | f x ≤ r}` is `𝕜`-convex. -/
def quasiconvex_on : Prop :=
∀ r, convex 𝕜 {x ∈ s | f x ≤ r}

/-- A function is quasiconcave if all its superlevels are convex.
This means that, for all `r`, `{x ∈ s | r ≤ f x}` is `𝕜`-convex. -/
def quasiconcave_on : Prop :=
∀ r, convex 𝕜 {x ∈ s | r ≤ f x}

/-- A function is quasilinear if it is both quasiconvex and quasiconcave.
This means that, for all `r`,
the sets `{x ∈ s | f x ≤ r}` and `{x ∈ s | r ≤ f x}` are `𝕜`-convex. -/
def quasilinear_on : Prop :=
quasiconvex_on 𝕜 s f ∧ quasiconcave_on 𝕜 s f

variables {𝕜 s f}

lemma quasiconvex_on.dual : quasiconvex_on 𝕜 s f → quasiconcave_on 𝕜 s (to_dual ∘ f) := id
lemma quasiconcave_on.dual : quasiconcave_on 𝕜 s f → quasiconvex_on 𝕜 s (to_dual ∘ f) := id
lemma quasilinear_on.dual : quasilinear_on 𝕜 s f → quasilinear_on 𝕜 s (to_dual ∘ f) := and.swap

lemma convex.quasiconvex_on_of_convex_le (hs : convex 𝕜 s) (h : ∀ r, convex 𝕜 {x | f x ≤ r}) :
  quasiconvex_on 𝕜 s f :=
λ r, hs.inter (h r)

lemma convex.quasiconcave_on_of_convex_ge (hs : convex 𝕜 s) (h : ∀ r, convex 𝕜 {x | r ≤ f x}) :
  quasiconcave_on 𝕜 s f :=
@convex.quasiconvex_on_of_convex_le 𝕜 E βᵒᵈ _ _ _ _ _ _ hs h

lemma quasiconvex_on.convex [is_directed β (≤)] (hf : quasiconvex_on 𝕜 s f) : convex 𝕜 s :=
λ x y hx hy a b ha hb hab,
  let ⟨z, hxz, hyz⟩ := exists_ge_ge (f x) (f y) in (hf _ ⟨hx, hxz⟩ ⟨hy, hyz⟩ ha hb hab).1

lemma quasiconcave_on.convex [is_directed β (≥)] (hf : quasiconcave_on 𝕜 s f) : convex 𝕜 s :=
hf.dual.convex

end ordered_add_comm_monoid

section linear_ordered_add_comm_monoid
variables [linear_ordered_add_comm_monoid β]

section has_scalar
variables [has_scalar 𝕜 E] {s : set E} {f g : E → β}

lemma quasiconvex_on.sup (hf : quasiconvex_on 𝕜 s f) (hg : quasiconvex_on 𝕜 s g) :
  quasiconvex_on 𝕜 s (f ⊔ g) :=
begin
  intro r,
  simp_rw [pi.sup_def, sup_le_iff, ←set.sep_inter_sep],
  exact (hf r).inter (hg r),
end

lemma quasiconcave_on.inf (hf : quasiconcave_on 𝕜 s f) (hg : quasiconcave_on 𝕜 s g) :
  quasiconcave_on 𝕜 s (f ⊓ g) :=
hf.dual.sup hg

lemma quasiconvex_on_iff_le_max :
  quasiconvex_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 →
      f (a • x + b • y) ≤ max (f x) (f y) :=
⟨λ hf, ⟨hf.convex, λ x y hx hy a b ha hb hab,
  (hf _ ⟨hx, le_max_left _ _⟩ ⟨hy, le_max_right _ _⟩ ha hb hab).2⟩,
  λ hf r x y hx hy a b ha hb hab,
  ⟨hf.1 hx.1 hy.1 ha hb hab, (hf.2 hx.1 hy.1 ha hb hab).trans $ max_le hx.2 hy.2⟩⟩

lemma quasiconcave_on_iff_min_le :
  quasiconcave_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 →
      min (f x) (f y) ≤ f (a • x + b • y) :=
@quasiconvex_on_iff_le_max 𝕜 E βᵒᵈ _ _ _ _ _ _

lemma quasilinear_on_iff_mem_interval :
  quasilinear_on 𝕜 s f ↔ convex 𝕜 s ∧
    ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 →
      f (a • x + b • y) ∈ interval (f x) (f y) :=
begin
  rw [quasilinear_on, quasiconvex_on_iff_le_max, quasiconcave_on_iff_min_le, and_and_and_comm,
    and_self],
  apply and_congr_right',
  simp_rw [←forall_and_distrib, interval, mem_Icc, and_comm],
end

lemma quasiconvex_on.convex_lt (hf : quasiconvex_on 𝕜 s f) (r : β) : convex 𝕜 {x ∈ s | f x < r} :=
begin
  refine λ x y hx hy a b ha hb hab, _,
  have h := hf _ ⟨hx.1, le_max_left _ _⟩ ⟨hy.1, le_max_right _ _⟩ ha hb hab,
  exact ⟨h.1, h.2.trans_lt $ max_lt hx.2 hy.2⟩,
end

lemma quasiconcave_on.convex_gt (hf : quasiconcave_on 𝕜 s f) (r : β) : convex 𝕜 {x ∈ s | r < f x} :=
hf.dual.convex_lt r

end has_scalar

section ordered_smul
variables [has_scalar 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f : E → β}

lemma convex_on.quasiconvex_on (hf : convex_on 𝕜 s f) : quasiconvex_on 𝕜 s f :=
hf.convex_le

lemma concave_on.quasiconcave_on (hf : concave_on 𝕜 s f) : quasiconcave_on 𝕜 s f :=
hf.convex_ge

end ordered_smul
end linear_ordered_add_comm_monoid
end add_comm_monoid

section linear_ordered_add_comm_monoid
variables [linear_ordered_add_comm_monoid E] [ordered_add_comm_monoid β] [module 𝕜 E]
  [ordered_smul 𝕜 E] {s : set E} {f : E → β}

lemma monotone_on.quasiconvex_on (hf : monotone_on f s) (hs : convex 𝕜 s) : quasiconvex_on 𝕜 s f :=
hf.convex_le hs

lemma monotone_on.quasiconcave_on (hf : monotone_on f s) (hs : convex 𝕜 s) :
  quasiconcave_on 𝕜 s f :=
hf.convex_ge hs

lemma monotone_on.quasilinear_on (hf : monotone_on f s) (hs : convex 𝕜 s) : quasilinear_on 𝕜 s f :=
⟨hf.quasiconvex_on hs, hf.quasiconcave_on hs⟩

lemma antitone_on.quasiconvex_on (hf : antitone_on f s) (hs : convex 𝕜 s) : quasiconvex_on 𝕜 s f :=
hf.convex_le hs

lemma antitone_on.quasiconcave_on (hf : antitone_on f s) (hs : convex 𝕜 s) :
  quasiconcave_on 𝕜 s f :=
hf.convex_ge hs

lemma antitone_on.quasilinear_on (hf : antitone_on f s) (hs : convex 𝕜 s) : quasilinear_on 𝕜 s f :=
⟨hf.quasiconvex_on hs, hf.quasiconcave_on hs⟩

lemma monotone.quasiconvex_on (hf : monotone f) : quasiconvex_on 𝕜 univ f :=
(hf.monotone_on _).quasiconvex_on convex_univ

lemma monotone.quasiconcave_on (hf : monotone f) : quasiconcave_on 𝕜 univ f :=
(hf.monotone_on _).quasiconcave_on convex_univ

lemma monotone.quasilinear_on (hf : monotone f) : quasilinear_on 𝕜 univ f :=
⟨hf.quasiconvex_on, hf.quasiconcave_on⟩

lemma antitone.quasiconvex_on (hf : antitone f) : quasiconvex_on 𝕜 univ f :=
(hf.antitone_on _).quasiconvex_on convex_univ

lemma antitone.quasiconcave_on (hf : antitone f) : quasiconcave_on 𝕜 univ f :=
(hf.antitone_on _).quasiconcave_on convex_univ

lemma antitone.quasilinear_on (hf : antitone f) : quasilinear_on 𝕜 univ f :=
⟨hf.quasiconvex_on, hf.quasiconcave_on⟩

end linear_ordered_add_comm_monoid
end ordered_semiring


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Robert Y. Lewis
-/

import algebra.ring.ulift
import ring_theory.witt_vector.basic
import data.mv_polynomial.funext

/-!
# The `is_poly` predicate

`witt_vector.is_poly` is a (type-valued) predicate on functions `f : Π R, 𝕎 R → 𝕎 R`.
It asserts that there is a family of polynomials `φ : ℕ → mv_polynomial ℕ ℤ`,
such that the `n`th coefficient of `f x` is equal to `φ n` evaluated on the coefficients of `x`.
Many operations on Witt vectors satisfy this predicate (or an analogue for higher arity functions).
We say that such a function `f` is a *polynomial function*.

The power of satisfying this predicate comes from `is_poly.ext`.
It shows that if `φ` and `ψ` witness that `f` and `g` are polynomial functions,
then `f = g` not merely when `φ = ψ`, but in fact it suffices to prove
```
∀ n, bind₁ φ (witt_polynomial p _ n) = bind₁ ψ (witt_polynomial p _ n)
```
(in other words, when evaluating the Witt polynomials on `φ` and `ψ`, we get the same values)
which will then imply `φ = ψ` and hence `f = g`.

Even though this sufficient condition looks somewhat intimidating,
it is rather pleasant to check in practice;
more so than direct checking of `φ = ψ`.

In practice, we apply this technique to show that the composition of `witt_vector.frobenius`
and `witt_vector.verschiebung` is equal to multiplication by `p`.

## Main declarations

* `witt_vector.is_poly`, `witt_vector.is_poly₂`:
  two predicates that assert that a unary/binary function on Witt vectors
  is polynomial in the coefficients of the input values.
* `witt_vector.is_poly.ext`, `witt_vector.is_poly₂.ext`:
  two polynomial functions are equal if their families of polynomials are equal
  after evaluating the Witt polynomials on them.
* `witt_vector.is_poly.comp` (+ many variants) show that unary/binary compositions
  of polynomial functions are polynomial.
* `witt_vector.id_is_poly`, `witt_vector.neg_is_poly`,
  `witt_vector.add_is_poly₂`, `witt_vector.mul_is_poly₂`:
  several well-known operations are polynomial functions
  (for Verschiebung, Frobenius, and multiplication by `p`, see their respective files).

## On higher arity analogues

Ideally, there should be a predicate `is_polyₙ` for functions of higher arity,
together with `is_polyₙ.comp` that shows how such functions compose.
Since mathlib does not have a library on composition of higher arity functions,
we have only implemented the unary and binary variants so far.
Nullary functions (a.k.a. constants) are treated
as constant functions and fall under the unary case.

## Tactics

There are important metaprograms defined in this file:
the tactics `ghost_simp` and `ghost_calc` and the attributes `@[is_poly]` and `@[ghost_simps]`.
These are used in combination to discharge proofs of identities between polynomial functions.

Any atomic proof of `is_poly` or `is_poly₂` (i.e. not taking additional `is_poly` arguments)
should be tagged as `@[is_poly]`.

Any lemma doing "ring equation rewriting" with polynomial functions should be tagged
`@[ghost_simps]`, e.g.
```lean
@[ghost_simps]
lemma bind₁_frobenius_poly_witt_polynomial (n : ℕ) :
  bind₁ (frobenius_poly p) (witt_polynomial p ℤ n) = (witt_polynomial p ℤ (n+1))
```

Proofs of identities between polynomial functions will often follow the pattern
```lean
begin
  ghost_calc _,
  <minor preprocessing>,
  ghost_simp
end
```

## References

* [Hazewinkel, *Witt Vectors*][Haze09]

* [Commelin and Lewis, *Formalizing the Ring of Witt Vectors*][CL21]
-/

/-
### Simplification tactics

`ghost_simp` is used later in the development for certain simplifications.
We define it here so it is a shared import.
-/

mk_simp_attribute ghost_simps
"Simplification rules for ghost equations"

namespace tactic
namespace interactive
setup_tactic_parser

/-- A macro for a common simplification when rewriting with ghost component equations. -/
meta def ghost_simp (lems : parse simp_arg_list) : tactic unit :=
do tactic.try tactic.intro1,
   simp none none tt
     (lems ++ [simp_arg_type.symm_expr ``(sub_eq_add_neg)])
     [`ghost_simps] (loc.ns [none])

/--
`ghost_calc` is a tactic for proving identities between polynomial functions.
Typically, when faced with a goal like
```lean
∀ (x y : 𝕎 R), verschiebung (x * frobenius y) = verschiebung x * y
```
you can
1. call `ghost_calc`
2. do a small amount of manual work -- maybe nothing, maybe `rintro`, etc
3. call `ghost_simp`

and this will close the goal.

`ghost_calc` cannot detect whether you are dealing with unary or binary polynomial functions.
You must give it arguments to determine this.
If you are proving a universally quantified goal like the above,
call `ghost_calc _ _`.
If the variables are introduced already, call `ghost_calc x y`.
In the unary case, use `ghost_calc _` or `ghost_calc x`.

`ghost_calc` is a light wrapper around type class inference.
All it does is apply the appropriate extensionality lemma and try to infer the resulting goals.
This is subtle and Lean's elaborator doesn't like it because of the HO unification involved,
so it is easier (and prettier) to put it in a tactic script.
-/
meta def ghost_calc (ids' : parse ident_*) : tactic unit :=
do ids ← ids'.mmap $ λ n, get_local n <|> tactic.intro n,
   `(@eq (witt_vector _ %%R) _ _) ← target,
   match ids with
   | [x] := refine ```(is_poly.ext _ _ _ _ %%x)
   | [x, y] := refine ```(is_poly₂.ext _ _ _ _ %%x %%y)
   | _ := fail "ghost_calc takes one or two arguments"
   end,
   nm ← match R with
   | expr.local_const _ nm _ _ := return nm
   | _ := get_unused_name `R
   end,
   iterate_exactly 2 apply_instance,
   unfreezingI (tactic.clear' tt [R]),
   introsI $ [nm, nm<.>"_inst"] ++ ids',
   skip

end interactive

end tactic

namespace witt_vector
universe u

variables {p : ℕ} {R S : Type u} {σ idx : Type*} [hp : fact p.prime] [comm_ring R] [comm_ring S]

local notation `𝕎` := witt_vector p -- type as `\bbW`

open mv_polynomial
open function (uncurry)

include hp
variables (p)

noncomputable theory

/-!
### The `is_poly` predicate
-/

lemma poly_eq_of_witt_polynomial_bind_eq (f g : ℕ → mv_polynomial ℕ ℤ)
  (h : ∀ n, bind₁ f (witt_polynomial p _ n) = bind₁ g (witt_polynomial p _ n)) :
  f = g :=
begin
  ext1 n,
  apply mv_polynomial.map_injective (int.cast_ring_hom ℚ) int.cast_injective,
  rw ← function.funext_iff at h,
  replace h := congr_arg
    (λ fam, bind₁ (mv_polynomial.map (int.cast_ring_hom ℚ) ∘ fam)
    (X_in_terms_of_W p ℚ n)) h,
  simpa only [function.comp, map_bind₁, map_witt_polynomial,
    ← bind₁_bind₁, bind₁_witt_polynomial_X_in_terms_of_W, bind₁_X_right] using h
end

omit hp

-- Ideally, we would generalise this to n-ary functions
-- But we don't have a good theory of n-ary compositions in mathlib

/--
A function `f : Π R, 𝕎 R → 𝕎 R` that maps Witt vectors to Witt vectors over arbitrary base rings
is said to be *polynomial* if there is a family of polynomials `φₙ` over `ℤ` such that the `n`th
coefficient of `f x` is given by evaluating `φₙ` at the coefficients of `x`.

See also `witt_vector.is_poly₂` for the binary variant.

The `ghost_calc` tactic treats `is_poly` as a type class,
and the `@[is_poly]` attribute derives certain specialized composition instances
for declarations of type `is_poly f`.
For the most part, users are not expected to treat `is_poly` as a class.
-/
class is_poly (f : Π ⦃R⦄ [comm_ring R], witt_vector p R → 𝕎 R) : Prop :=
mk' :: (poly : ∃ φ : ℕ → mv_polynomial ℕ ℤ, ∀ ⦃R⦄ [comm_ring R] (x : 𝕎 R),
  by exactI (f x).coeff = λ n, aeval x.coeff (φ n))

/-- The identity function on Witt vectors is a polynomial function. -/
instance id_is_poly : is_poly p (λ _ _, id) :=
⟨⟨X, by { introsI, simp only [aeval_X, id] }⟩⟩

instance id_is_poly_i' : is_poly p (λ _ _ a, a) :=
witt_vector.id_is_poly _

namespace is_poly

instance : inhabited (is_poly p (λ _ _, id)) :=
⟨witt_vector.id_is_poly p⟩

variables {p}
include hp
lemma ext {f g} (hf : is_poly p f) (hg : is_poly p g)
  (h : ∀ (R : Type u) [_Rcr : comm_ring R] (x : 𝕎 R) (n : ℕ),
    by exactI ghost_component n (f x) = ghost_component n (g x)) :
  ∀ (R : Type u) [_Rcr : comm_ring R] (x : 𝕎 R), by exactI f x = g x :=
begin
  unfreezingI
  { obtain ⟨φ, hf⟩ := hf,
    obtain ⟨ψ, hg⟩ := hg },
  intros,
  ext n,
  rw [hf, hg, poly_eq_of_witt_polynomial_bind_eq p φ ψ],
  intro k,
  apply mv_polynomial.funext,
  intro x,
  simp only [hom_bind₁],
  specialize h (ulift ℤ) (mk p $ λ i, ⟨x i⟩) k,
  simp only [ghost_component_apply, aeval_eq_eval₂_hom] at h,
  apply (ulift.ring_equiv.symm : ℤ ≃+* _).injective,
  simp only [←ring_equiv.coe_to_ring_hom, map_eval₂_hom],
  convert h using 1,
  all_goals
  { funext i,
    simp only [hf, hg, mv_polynomial.eval, map_eval₂_hom],
    apply eval₂_hom_congr (ring_hom.ext_int _ _) _ rfl,
    ext1,
    apply eval₂_hom_congr (ring_hom.ext_int _ _) _ rfl,
    simp only [coeff_mk], refl }
end

omit hp

/-- The composition of polynomial functions is polynomial. -/
lemma comp {g f} (hg : is_poly p g) (hf : is_poly p f) :
  is_poly p (λ R _Rcr, @g R _Rcr ∘ @f R _Rcr) :=
begin
  unfreezingI
  { obtain ⟨φ, hf⟩ := hf,
    obtain ⟨ψ, hg⟩ := hg },
  use (λ n, bind₁ φ (ψ n)),
  intros,
  simp only [aeval_bind₁, function.comp, hg, hf]
end

end is_poly

/--
A binary function `f : Π R, 𝕎 R → 𝕎 R → 𝕎 R` on Witt vectors
is said to be *polynomial* if there is a family of polynomials `φₙ` over `ℤ` such that the `n`th
coefficient of `f x y` is given by evaluating `φₙ` at the coefficients of `x` and `y`.

See also `witt_vector.is_poly` for the unary variant.

The `ghost_calc` tactic treats `is_poly₂` as a type class,
and the `@[is_poly]` attribute derives certain specialized composition instances
for declarations of type `is_poly₂ f`.
For the most part, users are not expected to treat `is_poly₂` as a class.
-/
class is_poly₂ (f : Π ⦃R⦄ [comm_ring R], witt_vector p R → 𝕎 R → 𝕎 R) : Prop :=
mk' :: (poly : ∃ φ : ℕ → mv_polynomial (fin 2 × ℕ) ℤ, ∀ ⦃R⦄ [comm_ring R] (x y : 𝕎 R),
  by exactI (f x y).coeff = λ n, peval (φ n) ![x.coeff, y.coeff])

variable {p}

/-- The composition of polynomial functions is polynomial. -/
lemma is_poly₂.comp {h f g} (hh : is_poly₂ p h) (hf : is_poly p f) (hg : is_poly p g) :
  is_poly₂ p (λ R _Rcr x y, by exactI h (f x) (g y)) :=
begin
  unfreezingI
  { obtain ⟨φ, hf⟩ := hf,
    obtain ⟨ψ, hg⟩ := hg,
    obtain ⟨χ, hh⟩ := hh },
  refine ⟨⟨(λ n, bind₁ (uncurry $
          ![λ k, rename (prod.mk (0 : fin 2)) (φ k),
            λ k, rename (prod.mk (1 : fin 2)) (ψ k)]) (χ n)), _⟩⟩,
  intros,
  funext n,
  simp only [peval, aeval_bind₁, function.comp, hh, hf, hg, uncurry],
  apply eval₂_hom_congr rfl _ rfl,
  ext ⟨i, n⟩,
  fin_cases i;
  simp only [aeval_eq_eval₂_hom, eval₂_hom_rename, function.comp, matrix.cons_val_zero,
    matrix.head_cons, matrix.cons_val_one],
end

/-- The composition of a polynomial function with a binary polynomial function is polynomial. -/
lemma is_poly.comp₂ {g f} (hg : is_poly p g) (hf : is_poly₂ p f) :
  is_poly₂ p (λ R _Rcr x y, by exactI g (f x y)) :=
begin
  unfreezingI
  { obtain ⟨φ, hf⟩ := hf,
    obtain ⟨ψ, hg⟩ := hg },
  use (λ n, bind₁ φ (ψ n)),
  intros,
  simp only [peval, aeval_bind₁, function.comp, hg, hf]
end

/-- The diagonal `λ x, f x x` of a polynomial function `f` is polynomial. -/
lemma is_poly₂.diag {f} (hf : is_poly₂ p f) :
  is_poly p (λ R _Rcr x, by exactI f x x) :=
begin
  unfreezingI {obtain ⟨φ, hf⟩ := hf},
  refine ⟨⟨λ n, bind₁ (uncurry ![X, X]) (φ n), _⟩⟩,
  intros, funext n,
  simp only [hf, peval, uncurry, aeval_bind₁],
  apply eval₂_hom_congr rfl _ rfl,
  ext ⟨i, k⟩, fin_cases i;
  simp only [matrix.head_cons, aeval_X, matrix.cons_val_zero, matrix.cons_val_one],
end

open tactic

namespace tactic

/-!
### The `@[is_poly]` attribute

This attribute is used to derive specialized composition instances
for `is_poly` and `is_poly₂` declarations.
-/

/--
If `n` is the name of a lemma with opened type `∀ vars, is_poly p _`,
`mk_poly_comp_lemmas n vars p` adds composition instances to the environment
`n.comp_i` and `n.comp₂_i`.
-/
meta def mk_poly_comp_lemmas (n : name) (vars : list expr) (p : expr) : tactic unit :=
do c ← mk_const n,
   let appd := vars.foldl expr.app c,

   tgt_bod ← to_expr ``(λ f [hf : is_poly %%p f], is_poly.comp %%appd hf) >>=
     replace_univ_metas_with_univ_params,
   tgt_bod ← lambdas vars tgt_bod,
   tgt_tp ← infer_type tgt_bod,
   let nm := n <.> "comp_i",
   add_decl $ mk_definition nm tgt_tp.collect_univ_params tgt_tp tgt_bod,
   set_attribute `instance nm,

   tgt_bod ← to_expr ``(λ f [hf : is_poly₂ %%p f], is_poly.comp₂ %%appd hf) >>=
     replace_univ_metas_with_univ_params,
   tgt_bod ← lambdas vars tgt_bod,
   tgt_tp ← infer_type tgt_bod,
   let nm := n <.> "comp₂_i",
   add_decl $ mk_definition nm tgt_tp.collect_univ_params tgt_tp tgt_bod,
   set_attribute `instance nm

/--
If `n` is the name of a lemma with opened type `∀ vars, is_poly₂ p _`,
`mk_poly₂_comp_lemmas n vars p` adds composition instances to the environment
`n.comp₂_i` and `n.comp_diag`.
-/
meta def mk_poly₂_comp_lemmas (n : name) (vars : list expr) (p : expr) : tactic unit :=
do c ← mk_const n,
   let appd := vars.foldl expr.app c,

   tgt_bod ← to_expr ``(λ {f g} [hf : is_poly %%p f] [hg : is_poly %%p g],
     is_poly₂.comp %%appd hf hg) >>= replace_univ_metas_with_univ_params,
   tgt_bod ← lambdas vars tgt_bod,
   tgt_tp ← infer_type tgt_bod >>= simp_lemmas.mk.dsimplify,
   let nm := n <.> "comp₂_i",
   add_decl $ mk_definition nm tgt_tp.collect_univ_params tgt_tp tgt_bod,
   set_attribute `instance nm,

   tgt_bod ← to_expr ``(λ {f g} [hf : is_poly %%p f] [hg : is_poly %%p g],
     (is_poly₂.comp %%appd hf hg).diag) >>= replace_univ_metas_with_univ_params,
   tgt_bod ← lambdas vars tgt_bod,
   tgt_tp ← infer_type tgt_bod >>= simp_lemmas.mk.dsimplify,
   let nm := n <.> "comp_diag",
   add_decl $ mk_definition nm tgt_tp.collect_univ_params tgt_tp tgt_bod,
   set_attribute `instance nm

/--
The `after_set` function for `@[is_poly]`. Calls `mk_poly(₂)_comp_lemmas`.
-/
meta def mk_comp_lemmas (n : name) : tactic unit :=
do d ← get_decl n,
   (vars, tp) ← open_pis d.type,
   match tp with
   | `(is_poly %%p _) := mk_poly_comp_lemmas n vars p
   | `(is_poly₂ %%p _) := mk_poly₂_comp_lemmas n vars p
   | _ := fail "@[is_poly] should only be applied to terms of type `is_poly _ _` or `is_poly₂ _ _`"
   end

/--
`@[is_poly]` is applied to lemmas of the form `is_poly f φ` or `is_poly₂ f φ`.
These lemmas should *not* be tagged as instances, and only atomic `is_poly` defs should be tagged:
composition lemmas should not. Roughly speaking, lemmas that take `is_poly` proofs as arguments
should not be tagged.

Type class inference struggles with function composition, and the higher order unification problems
involved in inferring `is_poly` proofs are complex. The standard style writing these proofs by hand
doesn't work very well. Instead, we construct the type class hierarchy "under the hood", with
limited forms of composition.

Applying `@[is_poly]` to a lemma creates a number of instances. Roughly, if the tagged lemma is a
proof of `is_poly f φ`, the instances added have the form
```lean
∀ g ψ, [is_poly g ψ] → is_poly (f ∘ g) _
```
Since `f` is fixed in this instance, it restricts the HO unification needed when the instance is
applied. Composition lemmas relating `is_poly` with `is_poly₂` are also added.
`id_is_poly` is an atomic instance.

The user-written lemmas are not instances. Users should be able to assemble `is_poly` proofs by hand
"as normal" if the tactic fails.
-/
@[user_attribute] meta def is_poly_attr : user_attribute :=
{ name := `is_poly,
  descr := "Lemmas with this attribute describe the polynomial structure of functions",
  after_set := some $ λ n _ _, mk_comp_lemmas n }

end tactic

include hp

/-!
### `is_poly` instances

These are not declared as instances at the top level,
but the `@[is_poly]` attribute adds instances based on each one.
Users are expected to use the non-instance versions manually.
-/

/-- The additive negation is a polynomial function on Witt vectors. -/
@[is_poly]
lemma neg_is_poly : is_poly p (λ R _, by exactI @has_neg.neg (𝕎 R) _) :=
⟨⟨λ n, rename prod.snd (witt_neg p n),
begin
  introsI, funext n,
  rw [neg_coeff, aeval_eq_eval₂_hom, eval₂_hom_rename],
  apply eval₂_hom_congr rfl _ rfl,
  ext ⟨i, k⟩, fin_cases i, refl,
end⟩⟩

section zero_one
/- To avoid a theory of 0-ary functions (a.k.a. constants)
we model them as constant unary functions. -/

/-- The function that is constantly zero on Witt vectors is a polynomial function. -/
instance zero_is_poly : is_poly p (λ _ _ _, by exactI 0) :=
⟨⟨0, by { introsI, funext n, simp only [pi.zero_apply, alg_hom.map_zero, zero_coeff] }⟩⟩

@[simp] lemma bind₁_zero_witt_polynomial (n : ℕ) :
  bind₁ (0 : ℕ → mv_polynomial ℕ R) (witt_polynomial p R n) = 0 :=
by rw [← aeval_eq_bind₁, aeval_zero, constant_coeff_witt_polynomial, ring_hom.map_zero]

omit hp

/-- The coefficients of `1 : 𝕎 R` as polynomials. -/
def one_poly (n : ℕ) : mv_polynomial ℕ ℤ := if n = 0 then 1 else 0

include hp

@[simp] lemma bind₁_one_poly_witt_polynomial (n : ℕ) :
  bind₁ one_poly (witt_polynomial p ℤ n) = 1 :=
begin
  rw [witt_polynomial_eq_sum_C_mul_X_pow, alg_hom.map_sum, finset.sum_eq_single 0],
  { simp only [one_poly, one_pow, one_mul, alg_hom.map_pow, C_1, pow_zero, bind₁_X_right,
      if_true, eq_self_iff_true], },
  { intros i hi hi0,
    simp only [one_poly, if_neg hi0, zero_pow (pow_pos hp.1.pos _), mul_zero,
      alg_hom.map_pow, bind₁_X_right, alg_hom.map_mul], },
  { rw finset.mem_range, dec_trivial }
end

/-- The function that is constantly one on Witt vectors is a polynomial function. -/
instance one_is_poly : is_poly p (λ _ _ _, by exactI 1) :=
⟨⟨one_poly,
begin
  introsI, funext n, cases n,
  { simp only [one_poly, if_true, eq_self_iff_true, one_coeff_zero, alg_hom.map_one], },
  { simp only [one_poly, nat.succ_pos', one_coeff_eq_of_pos,
      if_neg n.succ_ne_zero, alg_hom.map_zero] }
end⟩⟩

end zero_one

omit hp

/-- Addition of Witt vectors is a polynomial function. -/
@[is_poly] lemma add_is_poly₂ [fact p.prime] : is_poly₂ p (λ _ _, by exactI (+)) :=
⟨⟨witt_add p, by { introsI, dunfold witt_vector.has_add, simp [eval] }⟩⟩

/-- Multiplication of Witt vectors is a polynomial function. -/
@[is_poly] lemma mul_is_poly₂ [fact p.prime] : is_poly₂ p (λ _ _, by exactI (*)) :=
⟨⟨witt_mul p, by { introsI, dunfold witt_vector.has_mul, simp [eval] }⟩⟩

include hp

-- unfortunately this is not universe polymorphic, merely because `f` isn't
lemma is_poly.map {f} (hf : is_poly p f) (g : R →+* S) (x : 𝕎 R) :
  map g (f x) = f (map g x) :=
begin
  -- this could be turned into a tactic “macro” (taking `hf` as parameter)
  -- so that applications do not have to worry about the universe issue
  -- see `is_poly₂.map` for a slightly more general proof strategy
  unfreezingI {obtain ⟨φ, hf⟩ := hf},
  ext n,
  simp only [map_coeff, hf, map_aeval],
  apply eval₂_hom_congr (ring_hom.ext_int _ _) _ rfl,
  simp only [map_coeff]
end

namespace is_poly₂
omit hp
instance [fact p.prime] : inhabited (is_poly₂ p _) := ⟨add_is_poly₂⟩

variables {p}

/-- The composition of a binary polynomial function
 with a unary polynomial function in the first argument is polynomial. -/
lemma comp_left {g f} (hg : is_poly₂ p g) (hf : is_poly p f) :
  is_poly₂ p (λ R _Rcr x y, by exactI g (f x) y) :=
hg.comp hf (witt_vector.id_is_poly _)

/-- The composition of a binary polynomial function
 with a unary polynomial function in the second argument is polynomial. -/
lemma comp_right {g f} (hg : is_poly₂ p g) (hf : is_poly p f) :
  is_poly₂ p (λ R _Rcr x y, by exactI g x (f y)) :=
hg.comp (witt_vector.id_is_poly p) hf

include hp

lemma ext {f g} (hf : is_poly₂ p f) (hg : is_poly₂ p g)
  (h : ∀ (R : Type u) [_Rcr : comm_ring R] (x y : 𝕎 R) (n : ℕ),
    by exactI ghost_component n (f x y) = ghost_component n (g x y)) :
  ∀ (R) [_Rcr : comm_ring R] (x y : 𝕎 R), by exactI f x y = g x y :=
begin
  unfreezingI
  { obtain ⟨φ, hf⟩ := hf,
    obtain ⟨ψ, hg⟩ := hg },
  intros,
  ext n,
  rw [hf, hg, poly_eq_of_witt_polynomial_bind_eq' p φ ψ],
  clear x y,
  intro k,
  apply mv_polynomial.funext,
  intro x,
  simp only [hom_bind₁],
  specialize h (ulift ℤ) (mk p $ λ i, ⟨x (0, i)⟩) (mk p $ λ i, ⟨x (1, i)⟩) k,
  simp only [ghost_component_apply, aeval_eq_eval₂_hom] at h,
  apply (ulift.ring_equiv.symm : ℤ ≃+* _).injective,
  simp only [←ring_equiv.coe_to_ring_hom, map_eval₂_hom],
  convert h using 1,
  all_goals
  { funext i,
    simp only [hf, hg, mv_polynomial.eval, map_eval₂_hom],
    apply eval₂_hom_congr (ring_hom.ext_int _ _) _ rfl,
    ext1,
    apply eval₂_hom_congr (ring_hom.ext_int _ _) _ rfl,
    ext ⟨b, _⟩,
    fin_cases b; simp only [coeff_mk, uncurry]; refl }
end

-- unfortunately this is not universe polymorphic, merely because `f` isn't
lemma map {f} (hf : is_poly₂ p f) (g : R →+* S) (x y : 𝕎 R) :
  map g (f x y) = f (map g x) (map g y) :=
begin
  -- this could be turned into a tactic “macro” (taking `hf` as parameter)
  -- so that applications do not have to worry about the universe issue
  unfreezingI {obtain ⟨φ, hf⟩ := hf},
  ext n,
  simp only [map_coeff, hf, map_aeval, peval, uncurry],
  apply eval₂_hom_congr (ring_hom.ext_int _ _) _ rfl,
  try { ext ⟨i, k⟩, fin_cases i },
  all_goals
  { simp only [map_coeff, matrix.cons_val_zero, matrix.head_cons, matrix.cons_val_one] },
end

end is_poly₂

attribute [ghost_simps]
      alg_hom.map_zero alg_hom.map_one alg_hom.map_add alg_hom.map_mul
      alg_hom.map_sub alg_hom.map_neg alg_hom.id_apply map_nat_cast
      ring_hom.map_zero ring_hom.map_one ring_hom.map_mul ring_hom.map_add
      ring_hom.map_sub ring_hom.map_neg ring_hom.id_apply
      mul_add add_mul add_zero zero_add mul_one one_mul mul_zero zero_mul
      nat.succ_ne_zero add_tsub_cancel_right nat.succ_eq_add_one
      if_true eq_self_iff_true if_false forall_true_iff forall_2_true_iff forall_3_true_iff

end witt_vector


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

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

/-!
# `lim : (J ⥤ C) ⥤ C` is lax monoidal when `C` is a monoidal category.

When `C` is a monoidal category, the functorial association `F ↦ limit F` is lax monoidal,
i.e. there are morphisms
* `lim_lax.ε : (𝟙_ C) → limit (𝟙_ (J ⥤ C))`
* `lim_lax.μ : limit F ⊗ limit G ⟶ limit (F ⊗ G)`
satisfying the laws of a lax monoidal functor.
-/

open CategoryTheory

open CategoryTheory.MonoidalCategory

namespace CategoryTheory.Limits

universe v u

noncomputable section

variable {J : Type v} [SmallCategory J]

variable {C : Type u} [Category.{v} C] [HasLimits C]

instance limitFunctorial : Functorial fun F : J ⥤ C => limit F :=
  { Limits.lim with }
#align category_theory.limits.limit_functorial CategoryTheory.Limits.limitFunctorial

@[simp]
theorem limitFunctorial_map {F G : J ⥤ C} (α : F ⟶ G) :
    map (fun F : J ⥤ C => limit F) α = Limits.lim.map α :=
  rfl
#align category_theory.limits.limit_functorial_map CategoryTheory.Limits.limitFunctorial_map

variable [MonoidalCategory.{v} C]

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simps]
instance limitLaxMonoidal : LaxMonoidal fun F : J ⥤ C => limit F
    where
  ε :=
    limit.lift _
      { pt := _
        π := { app := fun j => 𝟙 _ } }
  μ F G :=
    limit.lift (F ⊗ G)
      { pt := limit F ⊗ limit G
        π :=
          { app := fun j => limit.π F j ⊗ limit.π G j
            naturality' := fun j j' f => by
              dsimp
              simp only [category.id_comp, ← tensor_comp, limit.w] } }
  μ_natural' X Y X' Y' f g := by
    ext; dsimp
    simp only [limit.lift_π, cones.postcompose_obj_π, monoidal.tensor_hom_app, limit.lift_map,
      nat_trans.comp_app, category.assoc, ← tensor_comp, lim_map_π]
  associativity' X Y Z := by
    ext; dsimp
    simp only [limit.lift_π, cones.postcompose_obj_π, monoidal.associator_hom_app, limit.lift_map,
      nat_trans.comp_app, category.assoc]
    slice_lhs 2 2 => rw [← tensor_id_comp_id_tensor]
    slice_lhs 1 2 =>
      rw [← comp_tensor_id, limit.lift_π]
      dsimp
    slice_lhs 1 2 => rw [tensor_id_comp_id_tensor]
    conv_lhs => rw [associator_naturality]
    conv_rhs => rw [← id_tensor_comp_tensor_id (limit.π (Y ⊗ Z) j)]
    slice_rhs 2 3 =>
      rw [← id_tensor_comp, limit.lift_π]
      dsimp
    dsimp; simp
  left_unitality' X := by
    ext; dsimp
    simp
    conv_rhs => rw [← tensor_id_comp_id_tensor (limit.π X j)]
    slice_rhs 1 2 =>
      rw [← comp_tensor_id]
      erw [limit.lift_π]
      dsimp
    slice_rhs 2 3 => rw [left_unitor_naturality]
    simp
  right_unitality' X := by
    ext; dsimp
    simp
    conv_rhs => rw [← id_tensor_comp_tensor_id _ (limit.π X j)]
    slice_rhs 1 2 =>
      rw [← id_tensor_comp]
      erw [limit.lift_π]
      dsimp
    slice_rhs 2 3 => rw [right_unitor_naturality]
    simp
#align category_theory.limits.limit_lax_monoidal CategoryTheory.Limits.limitLaxMonoidal

/-- The limit functor `F ↦ limit F` bundled as a lax monoidal functor. -/
def limLax : LaxMonoidalFunctor (J ⥤ C) C :=
  LaxMonoidalFunctor.of fun F : J ⥤ C => limit F
#align category_theory.limits.lim_lax CategoryTheory.Limits.limLax

@[simp]
theorem limLax_obj (F : J ⥤ C) : limLax.obj F = limit F :=
  rfl
#align category_theory.limits.lim_lax_obj CategoryTheory.Limits.limLax_obj

theorem limLax_obj' (F : J ⥤ C) : limLax.obj F = lim.obj F :=
  rfl
#align category_theory.limits.lim_lax_obj' CategoryTheory.Limits.limLax_obj'

@[simp]
theorem limLax_map {F G : J ⥤ C} (α : F ⟶ G) : limLax.map α = lim.map α :=
  rfl
#align category_theory.limits.lim_lax_map CategoryTheory.Limits.limLax_map

@[simp]
theorem limLax_ε :
    (@limLax J _ C _ _ _).ε =
      limit.lift _
        { pt := _
          π := { app := fun j => 𝟙 _ } } :=
  rfl
#align category_theory.limits.lim_lax_ε CategoryTheory.Limits.limLax_ε

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem limLax_μ (F G : J ⥤ C) :
    (@limLax J _ C _ _ _).μ F G =
      limit.lift (F ⊗ G)
        { pt := limit F ⊗ limit G
          π :=
            { app := fun j => limit.π F j ⊗ limit.π G j
              naturality' := fun j j' f => by
                dsimp
                simp only [category.id_comp, ← tensor_comp, limit.w] } } :=
  rfl
#align category_theory.limits.lim_lax_μ CategoryTheory.Limits.limLax_μ

end CategoryTheory.Limits