/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.basic
import Mathlib.algebra.ordered_group
import Mathlib.PostPort

namespace Mathlib

/-!
# `with_bot ℕ`

Lemmas about the type of natural numbers with a bottom element adjoined.
-/

namespace nat

theorem with_bot.add_eq_zero_iff {n : with_bot ℕ} {m : with_bot ℕ} : n + m = 0 ↔ n = 0 ∧ m = 0 :=
  sorry

theorem with_bot.add_eq_one_iff {n : with_bot ℕ} {m : with_bot ℕ} :
    n + m = 1 ↔ n = 0 ∧ m = 1 ∨ n = 1 ∧ m = 0 :=
  sorry

@[simp] theorem with_bot.coe_nonneg {n : ℕ} : 0 ≤ ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 ≤ ↑n)) (Eq.symm with_bot.coe_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑0 ≤ ↑n)) (propext with_bot.coe_le_coe))) (zero_le n))

@[simp] theorem with_bot.lt_zero_iff (n : with_bot ℕ) : n < 0 ↔ n = ⊥ := sorry

end Mathlib


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

! This file was ported from Lean 3 source module logic.equiv.transfer_instance
! leanprover-community/mathlib commit ec1c7d810034d4202b0dd239112d1792be9f6fdc
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Algebra.Equiv
import Mathbin.Algebra.Field.Basic
import Mathbin.Logic.Equiv.Defs

/-!
# Transfer algebraic structures across `equiv`s

In this file we prove theorems of the following form: if `β` has a
group structure and `α ≃ β` then `α` has a group structure, and
similarly for monoids, semigroups, rings, integral domains, fields and
so on.

Note that most of these constructions can also be obtained using the `transport` tactic.

### Implementation details

When adding new definitions that transfer type-classes across an equivalence, please mark them
`@[reducible]`. See note [reducible non-instances].

## Tags

equiv, group, ring, field, module, algebra
-/

universe u v

variable {α : Type u} {β : Type v}

namespace Equiv

section Instances

variable (e : α ≃ β)

/-- Transfer `has_one` across an `equiv` -/
@[reducible, to_additive "Transfer `has_zero` across an `equiv`"]
protected def hasOne [One β] : One α :=
  ⟨e.symm 1⟩
#align equiv.has_one Equiv.hasOne
#align equiv.has_zero Equiv.hasZero

@[to_additive]
theorem one_def [One β] : @One.one _ (Equiv.hasOne e) = e.symm 1 :=
  rfl
#align equiv.one_def Equiv.one_def
#align equiv.zero_def Equiv.zero_def

/-- Transfer `has_mul` across an `equiv` -/
@[reducible, to_additive "Transfer `has_add` across an `equiv`"]
protected def hasMul [Mul β] : Mul α :=
  ⟨fun x y => e.symm (e x * e y)⟩
#align equiv.has_mul Equiv.hasMul
#align equiv.has_add Equiv.hasAdd

@[to_additive]
theorem mul_def [Mul β] (x y : α) : @Mul.mul _ (Equiv.hasMul e) x y = e.symm (e x * e y) :=
  rfl
#align equiv.mul_def Equiv.mul_def
#align equiv.add_def Equiv.add_def

/-- Transfer `has_div` across an `equiv` -/
@[reducible, to_additive "Transfer `has_sub` across an `equiv`"]
protected def hasDiv [Div β] : Div α :=
  ⟨fun x y => e.symm (e x / e y)⟩
#align equiv.has_div Equiv.hasDiv
#align equiv.has_sub Equiv.hasSub

@[to_additive]
theorem div_def [Div β] (x y : α) : @Div.div _ (Equiv.hasDiv e) x y = e.symm (e x / e y) :=
  rfl
#align equiv.div_def Equiv.div_def
#align equiv.sub_def Equiv.sub_def

/-- Transfer `has_inv` across an `equiv` -/
@[reducible, to_additive "Transfer `has_neg` across an `equiv`"]
protected def hasInv [Inv β] : Inv α :=
  ⟨fun x => e.symm (e x)⁻¹⟩
#align equiv.has_inv Equiv.hasInv
#align equiv.has_neg Equiv.hasNeg

@[to_additive]
theorem inv_def [Inv β] (x : α) : @Inv.inv _ (Equiv.hasInv e) x = e.symm (e x)⁻¹ :=
  rfl
#align equiv.inv_def Equiv.inv_def
#align equiv.neg_def Equiv.neg_def

/-- Transfer `has_smul` across an `equiv` -/
@[reducible]
protected def hasSmul (R : Type _) [SMul R β] : SMul R α :=
  ⟨fun r x => e.symm (r • e x)⟩
#align equiv.has_smul Equiv.hasSmul

theorem smul_def {R : Type _} [SMul R β] (r : R) (x : α) :
    @SMul.smul _ _ (e.SMul R) r x = e.symm (r • e x) :=
  rfl
#align equiv.smul_def Equiv.smul_def

/-- Transfer `has_pow` across an `equiv` -/
@[reducible, to_additive SMul]
protected def hasPow (N : Type _) [Pow β N] : Pow α N :=
  ⟨fun x n => e.symm (e x ^ n)⟩
#align equiv.has_pow Equiv.hasPow
#align equiv.has_smul Equiv.hasSmul

theorem pow_def {N : Type _} [Pow β N] (n : N) (x : α) :
    @Pow.pow _ _ (e.Pow N) x n = e.symm (e x ^ n) :=
  rfl
#align equiv.pow_def Equiv.pow_def

/-- An equivalence `e : α ≃ β` gives a multiplicative equivalence `α ≃* β`
where the multiplicative structure on `α` is
the one obtained by transporting a multiplicative structure on `β` back along `e`.
-/
@[to_additive
      "An equivalence `e : α ≃ β` gives a additive equivalence `α ≃+ β`\nwhere the additive structure on `α` is\nthe one obtained by transporting an additive structure on `β` back along `e`."]
def mulEquiv (e : α ≃ β) [Mul β] :
    letI := Equiv.hasMul e
    α ≃* β :=
  by
  intros
  exact
    { e with
      map_mul' := fun x y => by
        apply e.symm.injective
        simp }
#align equiv.mul_equiv Equiv.mulEquiv
#align equiv.add_equiv Equiv.addEquiv

@[simp, to_additive]
theorem mulEquiv_apply (e : α ≃ β) [Mul β] (a : α) : (mulEquiv e) a = e a :=
  rfl
#align equiv.mul_equiv_apply Equiv.mulEquiv_apply
#align equiv.add_equiv_apply Equiv.add_equiv_apply

@[to_additive]
theorem mulEquiv_symm_apply (e : α ≃ β) [Mul β] (b : β) :
    letI := Equiv.hasMul e
    (MulEquiv e).symm b = e.symm b :=
  by intros ; rfl
#align equiv.mul_equiv_symm_apply Equiv.mulEquiv_symm_apply
#align equiv.add_equiv_symm_apply Equiv.add_equiv_symm_apply

/-- An equivalence `e : α ≃ β` gives a ring equivalence `α ≃+* β`
where the ring structure on `α` is
the one obtained by transporting a ring structure on `β` back along `e`.
-/
def ringEquiv (e : α ≃ β) [Add β] [Mul β] :
    by
    letI := Equiv.hasAdd e
    letI := Equiv.hasMul e
    exact α ≃+* β := by
  intros
  exact
    {
      e with
      map_add' := fun x y => by
        apply e.symm.injective
        simp
      map_mul' := fun x y => by
        apply e.symm.injective
        simp }
#align equiv.ring_equiv Equiv.ringEquiv

@[simp]
theorem ringEquiv_apply (e : α ≃ β) [Add β] [Mul β] (a : α) : (ringEquiv e) a = e a :=
  rfl
#align equiv.ring_equiv_apply Equiv.ringEquiv_apply

theorem ringEquiv_symm_apply (e : α ≃ β) [Add β] [Mul β] (b : β) :
    by
    letI := Equiv.hasAdd e
    letI := Equiv.hasMul e
    exact (RingEquiv e).symm b = e.symm b := by intros ; rfl
#align equiv.ring_equiv_symm_apply Equiv.ringEquiv_symm_apply

/-- Transfer `semigroup` across an `equiv` -/
@[reducible, to_additive "Transfer `add_semigroup` across an `equiv`"]
protected def semigroup [Semigroup β] : Semigroup α :=
  by
  let mul := e.Mul
  skip <;> apply e.injective.semigroup _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.semigroup Equiv.semigroup
#align equiv.add_semigroup Equiv.addSemigroup

/-- Transfer `semigroup_with_zero` across an `equiv` -/
@[reducible]
protected def semigroupWithZero [SemigroupWithZero β] : SemigroupWithZero α :=
  by
  let mul := e.Mul
  let zero := e.Zero
  skip <;> apply e.injective.semigroup_with_zero _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.semigroup_with_zero Equiv.semigroupWithZero

/-- Transfer `comm_semigroup` across an `equiv` -/
@[reducible, to_additive "Transfer `add_comm_semigroup` across an `equiv`"]
protected def commSemigroup [CommSemigroup β] : CommSemigroup α :=
  by
  let mul := e.Mul
  skip <;> apply e.injective.comm_semigroup _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.comm_semigroup Equiv.commSemigroup
#align equiv.add_comm_semigroup Equiv.addCommSemigroup

/-- Transfer `mul_zero_class` across an `equiv` -/
@[reducible]
protected def mulZeroClass [MulZeroClass β] : MulZeroClass α :=
  by
  let zero := e.Zero
  let mul := e.Mul
  skip <;> apply e.injective.mul_zero_class _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.mul_zero_class Equiv.mulZeroClass

/-- Transfer `mul_one_class` across an `equiv` -/
@[reducible, to_additive "Transfer `add_zero_class` across an `equiv`"]
protected def mulOneClass [MulOneClass β] : MulOneClass α :=
  by
  let one := e.One
  let mul := e.Mul
  skip <;> apply e.injective.mul_one_class _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.mul_one_class Equiv.mulOneClass
#align equiv.add_zero_class Equiv.addZeroClass

/-- Transfer `mul_zero_one_class` across an `equiv` -/
@[reducible]
protected def mulZeroOneClass [MulZeroOneClass β] : MulZeroOneClass α :=
  by
  let zero := e.Zero
  let one := e.One
  let mul := e.Mul
  skip <;> apply e.injective.mul_zero_one_class _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.mul_zero_one_class Equiv.mulZeroOneClass

/-- Transfer `monoid` across an `equiv` -/
@[reducible, to_additive "Transfer `add_monoid` across an `equiv`"]
protected def monoid [Monoid β] : Monoid α :=
  by
  let one := e.One
  let mul := e.Mul
  let pow := e.Pow ℕ
  skip <;> apply e.injective.monoid _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.monoid Equiv.monoid
#align equiv.add_monoid Equiv.addMonoid

/-- Transfer `comm_monoid` across an `equiv` -/
@[reducible, to_additive "Transfer `add_comm_monoid` across an `equiv`"]
protected def commMonoid [CommMonoid β] : CommMonoid α :=
  by
  let one := e.One
  let mul := e.Mul
  let pow := e.Pow ℕ
  skip <;> apply e.injective.comm_monoid _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.comm_monoid Equiv.commMonoid
#align equiv.add_comm_monoid Equiv.addCommMonoid

/-- Transfer `group` across an `equiv` -/
@[reducible, to_additive "Transfer `add_group` across an `equiv`"]
protected def group [Group β] : Group α :=
  by
  let one := e.One
  let mul := e.Mul
  let inv := e.Inv
  let div := e.Div
  let npow := e.Pow ℕ
  let zpow := e.Pow ℤ
  skip <;> apply e.injective.group _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.group Equiv.group
#align equiv.add_group Equiv.addGroup

/-- Transfer `comm_group` across an `equiv` -/
@[reducible, to_additive "Transfer `add_comm_group` across an `equiv`"]
protected def commGroup [CommGroup β] : CommGroup α :=
  by
  let one := e.One
  let mul := e.Mul
  let inv := e.Inv
  let div := e.Div
  let npow := e.Pow ℕ
  let zpow := e.Pow ℤ
  skip <;> apply e.injective.comm_group _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.comm_group Equiv.commGroup
#align equiv.add_comm_group Equiv.addCommGroup

/-- Transfer `non_unital_non_assoc_semiring` across an `equiv` -/
@[reducible]
protected def nonUnitalNonAssocSemiring [NonUnitalNonAssocSemiring β] :
    NonUnitalNonAssocSemiring α := by
  let zero := e.Zero
  let add := e.Add
  let mul := e.Mul
  let nsmul := e.SMul ℕ
  skip <;> apply e.injective.non_unital_non_assoc_semiring _ <;> intros <;>
    exact e.apply_symm_apply _
#align equiv.non_unital_non_assoc_semiring Equiv.nonUnitalNonAssocSemiring

/-- Transfer `non_unital_semiring` across an `equiv` -/
@[reducible]
protected def nonUnitalSemiring [NonUnitalSemiring β] : NonUnitalSemiring α :=
  by
  let zero := e.Zero
  let add := e.Add
  let mul := e.Mul
  let nsmul := e.SMul ℕ
  skip <;> apply e.injective.non_unital_semiring _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.non_unital_semiring Equiv.nonUnitalSemiring

/-- Transfer `add_monoid_with_one` across an `equiv` -/
@[reducible]
protected def addMonoidWithOne [AddMonoidWithOne β] : AddMonoidWithOne α :=
  { e.AddMonoid, e.One with
    natCast := fun n => e.symm n
    natCast_zero := show e.symm _ = _ by simp [zero_def]
    natCast_succ := fun n => show e.symm _ = e.symm (e (e.symm _) + _) by simp [add_def, one_def] }
#align equiv.add_monoid_with_one Equiv.addMonoidWithOne

/-- Transfer `add_group_with_one` across an `equiv` -/
@[reducible]
protected def addGroupWithOne [AddGroupWithOne β] : AddGroupWithOne α :=
  { e.AddMonoidWithOne,
    e.AddGroup with
    intCast := fun n => e.symm n
    intCast_ofNat := fun n => by rw [Int.cast_ofNat] <;> rfl
    intCast_negSucc := fun n =>
      congr_arg e.symm <| (Int.cast_negSucc _).trans <| congr_arg _ (e.apply_symm_apply _).symm }
#align equiv.add_group_with_one Equiv.addGroupWithOne

/-- Transfer `non_assoc_semiring` across an `equiv` -/
@[reducible]
protected def nonAssocSemiring [NonAssocSemiring β] : NonAssocSemiring α :=
  by
  let mul := e.Mul
  let add_monoid_with_one := e.AddMonoidWithOne
  skip <;> apply e.injective.non_assoc_semiring _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.non_assoc_semiring Equiv.nonAssocSemiring

/-- Transfer `semiring` across an `equiv` -/
@[reducible]
protected def semiring [Semiring β] : Semiring α :=
  by
  let mul := e.Mul
  let add_monoid_with_one := e.AddMonoidWithOne
  let npow := e.Pow ℕ
  skip <;> apply e.injective.semiring _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.semiring Equiv.semiring

/-- Transfer `non_unital_comm_semiring` across an `equiv` -/
@[reducible]
protected def nonUnitalCommSemiring [NonUnitalCommSemiring β] : NonUnitalCommSemiring α :=
  by
  let zero := e.Zero
  let add := e.Add
  let mul := e.Mul
  let nsmul := e.SMul ℕ
  skip <;> apply e.injective.non_unital_comm_semiring _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.non_unital_comm_semiring Equiv.nonUnitalCommSemiring

/-- Transfer `comm_semiring` across an `equiv` -/
@[reducible]
protected def commSemiring [CommSemiring β] : CommSemiring α :=
  by
  let mul := e.Mul
  let add_monoid_with_one := e.AddMonoidWithOne
  let npow := e.Pow ℕ
  skip <;> apply e.injective.comm_semiring _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.comm_semiring Equiv.commSemiring

/-- Transfer `non_unital_non_assoc_ring` across an `equiv` -/
@[reducible]
protected def nonUnitalNonAssocRing [NonUnitalNonAssocRing β] : NonUnitalNonAssocRing α :=
  by
  let zero := e.Zero
  let add := e.Add
  let mul := e.Mul
  let neg := e.Neg
  let sub := e.Sub
  let nsmul := e.SMul ℕ
  let zsmul := e.SMul ℤ
  skip <;> apply e.injective.non_unital_non_assoc_ring _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.non_unital_non_assoc_ring Equiv.nonUnitalNonAssocRing

/-- Transfer `non_unital_ring` across an `equiv` -/
@[reducible]
protected def nonUnitalRing [NonUnitalRing β] : NonUnitalRing α :=
  by
  let zero := e.Zero
  let add := e.Add
  let mul := e.Mul
  let neg := e.Neg
  let sub := e.Sub
  let nsmul := e.SMul ℕ
  let zsmul := e.SMul ℤ
  skip <;> apply e.injective.non_unital_ring _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.non_unital_ring Equiv.nonUnitalRing

/-- Transfer `non_assoc_ring` across an `equiv` -/
@[reducible]
protected def nonAssocRing [NonAssocRing β] : NonAssocRing α :=
  by
  let add_group_with_one := e.AddGroupWithOne
  let mul := e.Mul
  skip <;> apply e.injective.non_assoc_ring _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.non_assoc_ring Equiv.nonAssocRing

/-- Transfer `ring` across an `equiv` -/
@[reducible]
protected def ring [Ring β] : Ring α := by
  let mul := e.Mul
  let add_group_with_one := e.AddGroupWithOne
  let npow := e.Pow ℕ
  skip <;> apply e.injective.ring _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.ring Equiv.ring

/-- Transfer `non_unital_comm_ring` across an `equiv` -/
@[reducible]
protected def nonUnitalCommRing [NonUnitalCommRing β] : NonUnitalCommRing α :=
  by
  let zero := e.Zero
  let add := e.Add
  let mul := e.Mul
  let neg := e.Neg
  let sub := e.Sub
  let nsmul := e.SMul ℕ
  let zsmul := e.SMul ℤ
  skip <;> apply e.injective.non_unital_comm_ring _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.non_unital_comm_ring Equiv.nonUnitalCommRing

/-- Transfer `comm_ring` across an `equiv` -/
@[reducible]
protected def commRing [CommRing β] : CommRing α :=
  by
  let mul := e.Mul
  let add_group_with_one := e.AddGroupWithOne
  let npow := e.Pow ℕ
  skip <;> apply e.injective.comm_ring _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.comm_ring Equiv.commRing

/-- Transfer `nontrivial` across an `equiv` -/
@[reducible]
protected theorem nontrivial [Nontrivial β] : Nontrivial α :=
  e.Surjective.Nontrivial
#align equiv.nontrivial Equiv.nontrivial

/-- Transfer `is_domain` across an `equiv` -/
@[reducible]
protected theorem isDomain [Ring α] [Ring β] [IsDomain β] (e : α ≃+* β) : IsDomain α :=
  Function.Injective.isDomain e.toRingHom e.Injective
#align equiv.is_domain Equiv.isDomain

/-- Transfer `has_rat_cast` across an `equiv` -/
@[reducible]
protected def hasRatCast [HasRatCast β] : HasRatCast α where ratCast n := e.symm n
#align equiv.has_rat_cast Equiv.hasRatCast

/-- Transfer `division_ring` across an `equiv` -/
@[reducible]
protected def divisionRing [DivisionRing β] : DivisionRing α :=
  by
  let add_group_with_one := e.AddGroupWithOne
  let mul := e.Mul
  let inv := e.Inv
  let div := e.Div
  let mul := e.Mul
  let npow := e.Pow ℕ
  let zpow := e.Pow ℤ
  let rat_cast := e.HasRatCast
  let qsmul := e.SMul ℚ
  skip <;> apply e.injective.division_ring _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.division_ring Equiv.divisionRing

/-- Transfer `field` across an `equiv` -/
@[reducible]
protected def field [Field β] : Field α :=
  by
  let add_group_with_one := e.AddGroupWithOne
  let mul := e.Mul
  let neg := e.Neg
  let inv := e.Inv
  let div := e.Div
  let mul := e.Mul
  let npow := e.Pow ℕ
  let zpow := e.Pow ℤ
  let rat_cast := e.HasRatCast
  let qsmul := e.SMul ℚ
  skip <;> apply e.injective.field _ <;> intros <;> exact e.apply_symm_apply _
#align equiv.field Equiv.field

section R

variable (R : Type _)

include R

section

variable [Monoid R]

/-- Transfer `mul_action` across an `equiv` -/
@[reducible]
protected def mulAction (e : α ≃ β) [MulAction R β] : MulAction R α :=
  { e.SMul R with
    one_smul := by simp [smul_def]
    mul_smul := by simp [smul_def, mul_smul] }
#align equiv.mul_action Equiv.mulAction

/-- Transfer `distrib_mul_action` across an `equiv` -/
@[reducible]
protected def distribMulAction (e : α ≃ β) [AddCommMonoid β] :
    letI := Equiv.addCommMonoid e
    ∀ [DistribMulAction R β], DistribMulAction R α :=
  by
  intros
  letI := Equiv.addCommMonoid e
  exact
    ({ Equiv.mulAction R e with
        smul_zero := by simp [zero_def, smul_def]
        smul_add := by simp [add_def, smul_def, smul_add] } :
      DistribMulAction R α)
#align equiv.distrib_mul_action Equiv.distribMulAction

end

section

variable [Semiring R]

/-- Transfer `module` across an `equiv` -/
@[reducible]
protected def module (e : α ≃ β) [AddCommMonoid β] :
    letI := Equiv.addCommMonoid e
    ∀ [Module R β], Module R α :=
  by
  intros
  exact
    ({
        Equiv.distribMulAction R
          e with
        zero_smul := by simp [zero_def, smul_def]
        add_smul := by simp [add_def, smul_def, add_smul] } :
      Module R α)
#align equiv.module Equiv.module

/-- An equivalence `e : α ≃ β` gives a linear equivalence `α ≃ₗ[R] β`
where the `R`-module structure on `α` is
the one obtained by transporting an `R`-module structure on `β` back along `e`.
-/
def linearEquiv (e : α ≃ β) [AddCommMonoid β] [Module R β] :
    by
    letI := Equiv.addCommMonoid e
    letI := Equiv.module R e
    exact α ≃ₗ[R] β := by
  intros
  exact
    { Equiv.addEquiv e with
      map_smul' := fun r x => by
        apply e.symm.injective
        simp
        rfl }
#align equiv.linear_equiv Equiv.linearEquiv

end

section

variable [CommSemiring R]

/-- Transfer `algebra` across an `equiv` -/
@[reducible]
protected def algebra (e : α ≃ β) [Semiring β] :
    letI := Equiv.semiring e
    ∀ [Algebra R β], Algebra R α :=
  by
  intros
  fapply RingHom.toAlgebra'
  · exact ((RingEquiv e).symm : β →+* α).comp (algebraMap R β)
  · intro r x
    simp only [Function.comp_apply, RingHom.coe_comp]
    have p := ring_equiv_symm_apply e
    dsimp at p
    erw [p]
    clear p
    apply (RingEquiv e).Injective
    simp only [(RingEquiv e).map_mul]
    simp [Algebra.commutes]
#align equiv.algebra Equiv.algebra

/-- An equivalence `e : α ≃ β` gives an algebra equivalence `α ≃ₐ[R] β`
where the `R`-algebra structure on `α` is
the one obtained by transporting an `R`-algebra structure on `β` back along `e`.
-/
def algEquiv (e : α ≃ β) [Semiring β] [Algebra R β] :
    by
    letI := Equiv.semiring e
    letI := Equiv.algebra R e
    exact α ≃ₐ[R] β := by
  intros
  exact
    { Equiv.ringEquiv e with
      commutes' := fun r => by
        apply e.symm.injective
        simp
        rfl }
#align equiv.alg_equiv Equiv.algEquiv

end

end R

end Instances

end Equiv


/- Author: E.W.Ayers © 2019 -/
import ..equate
open robot
universe u

attribute [equate] is_group_hom.mul

section additive_groups
    variables {α : Type u} [add_comm_group α] {u v w x y z : α}
    example : (x + y) + z = (z + x) + y :=
    by equate
    example : x + y + z = z + x + y :=
    by equate
    example : x + (y - z) = -z + y + x :=
    by equate
    example : x - (y + z) = x - y - z :=
    by equate
    example : - (x - y) = y + - x :=
    by equate
    example : - (x - y) = y - x :=
    by equate
    example : (x - y) = -(y - x) := -- [FIXME]
    by equate
    example : (x - y) = -(y + - x) := -- [FIXME]
    by equate
    example : (- - x) + - y = -(y - x) :=
    by equate
    example : (- - x) - y = -(y - x) := -- [FIXME]
    by equate
    example : (x + y) + (z + w) = (x + z) + (y + w) :=
    by equate
    example : v + u + (x + y) + (z + w) = (x + z) + (y + w) + v + u :=
    by equate
    lemma X1 : x + y + z + u + v + w = w + (x + y + z + u + v) :=
    by equate
    #print X1
    lemma X2 : x + y + z + u + v + w = w + (x + y + z + u + v) :=
    by (tactic.timetac "ac_refl" $ tactic.ac_refl)
    #print X2
end additive_groups

section powers
    variables {M : Type u} [monoid M] {a : M} {n m : ℕ}

    @[equate] lemma my_pow_mul_comm' : a^n * a = a * a^n :=
    begin
        induction n,
        simp,
        equate -- [FIXME]
    end
    @[equate] lemma my_pow_succ' : a^(nat.succ n) = a^n * a :=
    by equate
    -- set_option pp.notation false
    @[equate] lemma my_pow_1 : a^1 = a := by equate -- [FIXME]
    @[equate] lemma my_pow_2 : a^2 = a * a := by equate -- [FIXME]
    @[equate] lemma my_pow_add : a^(m + n) = a^m * a^n :=
    begin
        induction m,
        simp,
        equate
    end
    @[equate] lemma my_one_pow : (1:M)^n = (1:M) :=
    begin
        induction n,
        equate,
        equate
    end
    @[equate] lemma my_pow_mul : (a^n)^m = a^(n * m) :=
    begin
        induction m,
        equate,
        equate
    end
    @[equate] lemma my_pow_mul_comm : (a^n) * (a^m) = (a^m) * (a^n)
    := by equate
end powers

section comm_monoid_powers
    variables {M:Type u} [comm_monoid M] {a b c : M} {n m : ℕ}
    @[equate] lemma my_mul_pow : (a * b)^n = a^n * b^n
    := begin
        induction n,
        simp,
        equate -- [FIXME]
    end
end comm_monoid_powers

section group_powers
    variables {G : Type u} [group G] {a b c : G} {n m : ℕ}
    @[equate] lemma my_inv_pow : (a⁻¹)^n = (a^n)⁻¹ :=
    begin
        induction n,
        simp,
        equate
    end
end group_powers

section group_homs1
    variables {H G : Type u} [group H] [group G] {φ : H → G} {ψ : G → H} {x y z h : G}
    example : (x * z) * (z⁻¹ * y) = x * y -- [FIXME] finds an overly long soln
    := by equate
    example : x * y = (x * z) * (z⁻¹ * y) -- [NOTE] this is an out-of-scope problem
    := by equate
    -- example : x * y = (x * z²) * (z⁻² * y)
    -- := by equate
    def conj (h x : G) := h * x * h ⁻¹
    @[equate] lemma conj_def : conj h x = h * x * h ⁻¹ := rfl
    example {h : G} : conj h (x) * conj h (y) = conj h (x * y) :=
    by equate
    example {h : G} : conj h (x * y) = conj h x * conj h y :=
    by equate -- [FIXME]
    example {h : G} : (conj h x)⁻¹ = conj h (x⁻¹):=
    by equate
    example {h : G} : (conj h x⁻¹) = (conj h x)⁻¹ :=
    by equate -- [FIXME]
    example : x * y⁻¹ = (y * x⁻¹)⁻¹
    := by equate
    example :  (y * x⁻¹)⁻¹ = x * y⁻¹
    := by equate
    example [is_group_hom φ] [is_group_hom ψ] {x y : G}
        : is_group_hom (φ ∘ ψ) := ⟨λ x y, by equate⟩
    example
        [is_group_hom φ]
        (i1 : ∀ x, φ(ψ x) = x)
        (i2 : ∀ x, ψ(φ x) = x) {x y : G}
        : is_group_hom ψ :=
    ⟨λ a b, by equate⟩
end group_homs1

section group_homs3
    lemma is_group_hom_mul_2 {α β} [group α] [comm_group β]
    (f g : α → β) [is_group_hom f] [is_group_hom g] :
    is_group_hom (λa, f a * g a) :=
    ⟨assume a b, by equate⟩
end group_homs3


import tactic
import data.real.basic
import measure_theory.function.locally_integrable
import measure_theory.measure.lebesgue
import measure_theory.integral.interval_integral

/-
  If some statement holds for almost all x and it always implies another statement
  then the other statement also holds almost everywhere
 -/
lemma ae_of_implies_and_ae {p : ℝ → Prop} {q : ℝ → Prop} :
  (∀ x, p x → q x) → (∀ᵐ x : ℝ, p x) → (∀ᵐ x : ℝ, q x) :=
begin
  intros hpq hpae,
  have h : {x | ¬ q x} ⊆ {x | ¬ p x} := begin
    simp,
    intro x,
    specialize hpq x,
    intro hnq,
    intro hp,
    apply hnq,
    apply hpq,
    assumption
  end,
  apply measure_theory.outer_measure.mono_null _ h (measure_theory.ae_iff.1 hpae),
end

lemma interval_integrable_of_locally_integrable (f: ℝ → ℝ) (a : ℝ) (b : ℝ) {μ : measure_theory.measure ℝ}:
  measure_theory.locally_integrable f μ → interval_integrable f μ a b :=
begin
  sorry,
end

lemma lebesgue_measure_translation_invariant {μ : measure_theory.outer_measure ℝ} (p : ℝ → Prop) {x : ℝ} :
  μ {y : ℝ | p y} = μ {y : ℝ | p (y - x)} :=
begin
  sorry,
end


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.norm_num
import Mathlib.data.int.range
import Mathlib.PostPort

universes u_1 l

namespace Mathlib

/-!
# `ring`

Evaluate expressions in the language of commutative (semi)rings.
Based on <http://www.cs.ru.nl/~freek/courses/tt-2014/read/10.1.1.61.3041.pdf> .
-/

namespace tactic

namespace ring

/-- The normal form that `ring` uses is mediated by the function `horner a x n b := a * x ^ n + b`.
The reason we use a definition rather than the (more readable) expression on the right is because
this expression contains a number of typeclass arguments in different positions, while `horner`
contains only one `comm_semiring` instance at the top level. See also `horner_expr` for a
description of normal form. -/
def horner {α : Type u_1} [comm_semiring α] (a : α) (x : α) (n : ℕ) (b : α) : α :=
  a * x ^ n + b

/-- This cache contains data required by the `ring` tactic during execution. -/
/-- The monad that `ring` works in. This is a reader monad containing a mutable cache (using `ref`
for mutability), as well as the list of atoms-up-to-defeq encountered thus far, used for atom
sorting. -/
/-- Get the `ring` data from the monad. -/
/-- Get an already encountered atom by its index. -/
/-- Get the index corresponding to an atomic expression, if it has already been encountered, or
put it in the list of atoms and return the new index, otherwise. -/
/-- Lift a tactic into the `ring_m` monad. -/
/-- Run a `ring_m` tactic in the tactic monad. This version of `ring_m.run` uses an external
atoms ref, so that subexpressions can be named across multiple `ring_m` calls. -/
/-- Run a `ring_m` tactic in the tactic monad. -/
/-- Lift an instance cache tactic (probably from `norm_num`) to the `ring_m` monad. This version
is abstract over the instance cache in question (either the ring `α`, or `ℕ` for exponents). -/
/-- Lift an instance cache tactic (probably from `norm_num`) to the `ring_m` monad. This uses
the instance cache corresponding to the ring `α`. -/
/-- Lift an instance cache tactic (probably from `norm_num`) to the `ring_m` monad. This uses
the instance cache corresponding to `ℕ`, which is used for computations in the exponent. -/
/-- Apply a theorem that expects a `comm_semiring` instance. This is a special case of
`ic_lift mk_app`, but it comes up often because `horner` and all its theorems have this assumption;
it also does not require the tactic monad which improves access speed a bit. -/
/-- Every expression in the language of commutative semirings can be viewed as a sum of monomials,
where each monomial is a product of powers of atoms. We fix a global order on atoms (up to
definitional equality), and then separate the terms according to their smallest atom. So the top
level expression is `a * x^n + b` where `x` is the smallest atom and `n > 0` is a numeral, and
`n` is maximal (so `a` contains at least one monomial not containing an `x`), and `b` contains no
monomials with an `x` (hence all atoms in `b` are larger than `x`).

If there is no `x` satisfying these constraints, then the expression must be a numeral. Even though
we are working over rings, we allow rational constants when these can be interpreted in the ring,
so we can solve problems like `x / 3 = 1 / 3 * x` even though these are not technically in the
language of rings.

These constraints ensure that there is a unique normal form for each ring expression, and so the
algorithm is simply to calculate the normal form of each side and compare for equality.

To allow us to efficiently pattern match on normal forms, we maintain this inductive type that
holds a normalized expression together with its structure. All the `expr`s in this type could be
removed without loss of information, and conversely the `horner_expr` structure and the `ℕ` and
`ℚ` values can be recovered from the top level `expr`, but we keep both in order to keep proof
 producing normalization functions efficient. -/
/-- Get the expression corresponding to a `horner_expr`. This can be calculated recursively from
the structure, but we cache the exprs in all subterms so that this function can be computed in
constant time. -/
/-- Is this expr the constant `0`? -/
/-- Construct a `xadd` node, generating the cached expr using the input cache. -/
/-- Pretty printer for `horner_expr`. -/
/-- Pretty printer for `horner_expr`. -/
/-- Reflexivity conversion for a `horner_expr`. -/
theorem zero_horner {α : Type u_1} [comm_semiring α] (x : α) (n : ℕ) (b : α) : horner 0 x n b = b := sorry

theorem horner_horner {α : Type u_1} [comm_semiring α] (a₁ : α) (x : α) (n₁ : ℕ) (n₂ : ℕ) (b : α) (n' : ℕ) (h : n₁ + n₂ = n') : horner (horner a₁ x n₁ 0) x n₂ b = horner a₁ x n' b := sorry

/-- Evaluate `horner a n x b` where `a` and `b` are already in normal form. -/
theorem const_add_horner {α : Type u_1} [comm_semiring α] (k : α) (a : α) (x : α) (n : ℕ) (b : α) (b' : α) (h : k + b = b') : k + horner a x n b = horner a x n b' := sorry

theorem horner_add_const {α : Type u_1} [comm_semiring α] (a : α) (x : α) (n : ℕ) (b : α) (k : α) (b' : α) (h : b + k = b') : horner a x n b + k = horner a x n b' := sorry

theorem horner_add_horner_lt {α : Type u_1} [comm_semiring α] (a₁ : α) (x : α) (n₁ : ℕ) (b₁ : α) (a₂ : α) (n₂ : ℕ) (b₂ : α) (k : ℕ) (a' : α) (b' : α) (h₁ : n₁ + k = n₂) (h₂ : a₁ + horner a₂ x k 0 = a') (h₃ : b₁ + b₂ = b') : horner a₁ x n₁ b₁ + horner a₂ x n₂ b₂ = horner a' x n₁ b' := sorry

theorem horner_add_horner_gt {α : Type u_1} [comm_semiring α] (a₁ : α) (x : α) (n₁ : ℕ) (b₁ : α) (a₂ : α) (n₂ : ℕ) (b₂ : α) (k : ℕ) (a' : α) (b' : α) (h₁ : n₂ + k = n₁) (h₂ : horner a₁ x k 0 + a₂ = a') (h₃ : b₁ + b₂ = b') : horner a₁ x n₁ b₁ + horner a₂ x n₂ b₂ = horner a' x n₂ b' := sorry

theorem horner_add_horner_eq {α : Type u_1} [comm_semiring α] (a₁ : α) (x : α) (n : ℕ) (b₁ : α) (a₂ : α) (b₂ : α) (a' : α) (b' : α) (t : α) (h₁ : a₁ + a₂ = a') (h₂ : b₁ + b₂ = b') (h₃ : horner a' x n b' = t) : horner a₁ x n b₁ + horner a₂ x n b₂ = t := sorry

/-- Evaluate `a + b` where `a` and `b` are already in normal form. -/
theorem horner_neg {α : Type u_1} [comm_ring α] (a : α) (x : α) (n : ℕ) (b : α) (a' : α) (b' : α) (h₁ : -a = a') (h₂ : -b = b') : -horner a x n b = horner a' x n b' := sorry

/-- Evaluate `-a` where `a` is already in normal form. -/
theorem horner_const_mul {α : Type u_1} [comm_semiring α] (c : α) (a : α) (x : α) (n : ℕ) (b : α) (a' : α) (b' : α) (h₁ : c * a = a') (h₂ : c * b = b') : c * horner a x n b = horner a' x n b' := sorry

theorem horner_mul_const {α : Type u_1} [comm_semiring α] (a : α) (x : α) (n : ℕ) (b : α) (c : α) (a' : α) (b' : α) (h₁ : a * c = a') (h₂ : b * c = b') : horner a x n b * c = horner a' x n b' := sorry

/-- Evaluate `k * a` where `k` is a rational numeral and `a` is in normal form. -/
theorem horner_mul_horner_zero {α : Type u_1} [comm_semiring α] (a₁ : α) (x : α) (n₁ : ℕ) (b₁ : α) (a₂ : α) (n₂ : ℕ) (aa : α) (t : α) (h₁ : horner a₁ x n₁ b₁ * a₂ = aa) (h₂ : horner aa x n₂ 0 = t) : horner a₁ x n₁ b₁ * horner a₂ x n₂ 0 = t := sorry

theorem horner_mul_horner {α : Type u_1} [comm_semiring α] (a₁ : α) (x : α) (n₁ : ℕ) (b₁ : α) (a₂ : α) (n₂ : ℕ) (b₂ : α) (aa : α) (haa : α) (ab : α) (bb : α) (t : α) (h₁ : horner a₁ x n₁ b₁ * a₂ = aa) (h₂ : horner aa x n₂ 0 = haa) (h₃ : a₁ * b₂ = ab) (h₄ : b₁ * b₂ = bb) (H : haa + horner ab x n₁ bb = t) : horner a₁ x n₁ b₁ * horner a₂ x n₂ b₂ = t := sorry

/-- Evaluate `a * b` where `a` and `b` are in normal form. -/
theorem horner_pow {α : Type u_1} [comm_semiring α] (a : α) (x : α) (n : ℕ) (m : ℕ) (n' : ℕ) (a' : α) (h₁ : n * m = n') (h₂ : a ^ m = a') : horner a x n 0 ^ m = horner a' x n' 0 := sorry

theorem pow_succ {α : Type u_1} [comm_semiring α] (a : α) (n : ℕ) (b : α) (c : α) (h₁ : a ^ n = b) (h₂ : b * a = c) : a ^ (n + 1) = c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (n + 1) = c)) (Eq.symm h₂)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (n + 1) = b * a)) (Eq.symm h₁)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (n + 1) = a ^ n * a)) (pow_succ' a n))) (Eq.refl (a ^ n * a))))

/-- Evaluate `a ^ n` where `a` is in normal form and `n` is a natural numeral. -/
theorem horner_atom {α : Type u_1} [comm_semiring α] (x : α) : x = horner 1 x 1 0 := sorry

/-- Evaluate `a` where `a` is an atom. -/
theorem subst_into_pow {α : Type u_1} [monoid α] (l : α) (r : ℕ) (tl : α) (tr : ℕ) (t : α) (prl : l = tl) (prr : r = tr) (prt : tl ^ tr = t) : l ^ r = t :=
  eq.mpr (id (Eq._oldrec (Eq.refl (l ^ r = t)) prl))
    (eq.mpr (id (Eq._oldrec (Eq.refl (tl ^ r = t)) prr))
      (eq.mpr (id (Eq._oldrec (Eq.refl (tl ^ tr = t)) prt)) (Eq.refl t)))

theorem unfold_sub {α : Type u_1} [add_group α] (a : α) (b : α) (c : α) (h : a + -b = c) : a - b = c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a - b = c)) (sub_eq_add_neg a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a + -b = c)) h)) (Eq.refl c))

theorem unfold_div {α : Type u_1} [division_ring α] (a : α) (b : α) (c : α) (h : a * (b⁻¹) = c) : a / b = c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a / b = c)) (div_eq_mul_inv a b)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (b⁻¹) = c)) h)) (Eq.refl c))

/-- Evaluate a ring expression `e` recursively to normal form, together with a proof of
equality. -/
/-- Evaluate a ring expression `e` recursively to normal form, together with a proof of
equality. -/
theorem horner_def' {α : Type u_1} [comm_semiring α] (a : α) (x : α) (n : ℕ) (b : α) : horner a x n b = x ^ n * a + b := sorry

theorem mul_assoc_rev {α : Type u_1} [semigroup α] (a : α) (b : α) (c : α) : a * (b * c) = a * b * c := sorry

theorem pow_add_rev {α : Type u_1} [monoid α] (a : α) (m : ℕ) (n : ℕ) : a ^ m * a ^ n = a ^ (m + n) := sorry

theorem pow_add_rev_right {α : Type u_1} [monoid α] (a : α) (b : α) (m : ℕ) (n : ℕ) : b * a ^ m * a ^ n = b * a ^ (m + n) := sorry

theorem add_neg_eq_sub {α : Type u_1} [add_group α] (a : α) (b : α) : a + -b = a - b :=
  Eq.symm (sub_eq_add_neg a b)

/-- If `ring` fails to close the goal, it falls back on normalizing the expression to a "pretty"
form so that you can see why it failed. This setting adjusts the resulting form:

  * `raw` is the form that `ring` actually uses internally, with iterated applications of `horner`.
    Not very readable but useful if you don't want any postprocessing.
    This results in terms like `horner (horner (horner 3 y 1 0) x 2 1) x 1 (horner 1 y 1 0)`.
  * `horner` maintains the Horner form structure, but it unfolds the `horner` definition itself,
    and tries to otherwise minimize parentheses.
    This results in terms like `(3 * x ^ 2 * y + 1) * x + y`.
  * `SOP` means sum of products form, expanding everything to monomials.
    This results in terms like `3 * x ^ 3 * y + x + y`. -/
inductive normalize_mode
where
| raw : normalize_mode
| SOP : normalize_mode
| horner : normalize_mode

protected instance normalize_mode.inhabited : Inhabited normalize_mode :=
  { default := normalize_mode.horner }

/-- A `ring`-based normalization simplifier that rewrites ring expressions into the specified mode.

  * `raw` is the form that `ring` actually uses internally, with iterated applications of `horner`.
    Not very readable but useful if you don't want any postprocessing.
    This results in terms like `horner (horner (horner 3 y 1 0) x 2 1) x 1 (horner 1 y 1 0)`.
  * `horner` maintains the Horner form structure, but it unfolds the `horner` definition itself,
    and tries to otherwise minimize parentheses.
    This results in terms like `(3 * x ^ 2 * y + 1) * x + y`.
  * `SOP` means sum of products form, expanding everything to monomials.
    This results in terms like `3 * x ^ 3 * y + x + y`. -/
end ring

namespace interactive

/-- Tactic for solving equations in the language of *commutative* (semi)rings.
  This version of `ring` fails if the target is not an equality
  that is provable by the axioms of commutative (semi)rings. -/
/-- Parser for `ring`'s `mode` argument, which can only be the "keywords" `raw`, `horner` or `SOP`.
(Because these are not actually keywords we use a name parser and postprocess the result.) -/
/-- Tactic for solving equations in the language of *commutative* (semi)rings.
Attempts to prove the goal outright if there is no `at`
specifier and the target is an equality, but if this
fails it falls back to rewriting all ring expressions
into a normal form. When writing a normal form,
`ring SOP` will use sum-of-products form instead of horner form.
`ring!` will use a more aggressive reducibility setting to identify atoms.

Based on [Proving Equalities in a Commutative Ring Done Right
in Coq](http://www.cs.ru.nl/~freek/courses/tt-2014/read/10.1.1.61.3041.pdf) by Benjamin Grégoire
and Assia Mahboubi.
-/


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Mario Carneiro, Scott Morrison, Floris van Doorn
-/
import category_theory.adjunction.basic
import category_theory.limits.cones
import category_theory.reflects_isomorphisms

/-!
# Limits and colimits

We set up the general theory of limits and colimits in a category.
In this introduction we only describe the setup for limits;
it is repeated, with slightly different names, for colimits.

The main structures defined in this file is
* `is_limit c`, for `c : cone F`, `F : J ⥤ C`, expressing that `c` is a limit cone,

See also `category_theory.limits.limits` which further builds:
* `limit_cone F`, which consists of a choice of cone for `F` and the fact it is a limit cone, and
* `has_limit F`, asserting the mere existence of some limit cone for `F`.

## Implementation
At present we simply say everything twice, in order to handle both limits and colimits.
It would be highly desirable to have some automation support,
e.g. a `@[dualize]` attribute that behaves similarly to `@[to_additive]`.

## References
* [Stacks: Limits and colimits](https://stacks.math.columbia.edu/tag/002D)

-/

noncomputable theory

open category_theory category_theory.category category_theory.functor opposite

namespace category_theory.limits

universes v u u' u'' w -- declare the `v`'s first; see `category_theory.category` for an explanation

variables {J K : Type v} [small_category J] [small_category K]
variables {C : Type u} [category.{v} C]

variables {F : J ⥤ C}

/--
A cone `t` on `F` is a limit cone if each cone on `F` admits a unique
cone morphism to `t`.

See https://stacks.math.columbia.edu/tag/002E.
  -/
@[nolint has_inhabited_instance]
structure is_limit (t : cone F) :=
(lift  : Π (s : cone F), s.X ⟶ t.X)
(fac'  : ∀ (s : cone F) (j : J), lift s ≫ t.π.app j = s.π.app j . obviously)
(uniq' : ∀ (s : cone F) (m : s.X ⟶ t.X) (w : ∀ j : J, m ≫ t.π.app j = s.π.app j),
  m = lift s . obviously)

restate_axiom is_limit.fac'
attribute [simp, reassoc] is_limit.fac
restate_axiom is_limit.uniq'

namespace is_limit

instance subsingleton {t : cone F} : subsingleton (is_limit t) :=
⟨by intros P Q; cases P; cases Q; congr; ext; solve_by_elim⟩

/-- Given a natural transformation `α : F ⟶ G`, we give a morphism from the cone point
of any cone over `F` to the cone point of a limit cone over `G`. -/
def map {F G : J ⥤ C} (s : cone F) {t : cone G} (P : is_limit t)
  (α : F ⟶ G) : s.X ⟶ t.X :=
P.lift ((cones.postcompose α).obj s)

@[simp, reassoc] lemma map_π {F G : J ⥤ C} (c : cone F) {d : cone G} (hd : is_limit d)
  (α : F ⟶ G) (j : J) : hd.map c α ≫ d.π.app j = c.π.app j ≫ α.app j :=
fac _ _ _

lemma lift_self {c : cone F} (t : is_limit c) : t.lift c = 𝟙 c.X :=
(t.uniq _ _ (λ j, id_comp _)).symm

/- Repackaging the definition in terms of cone morphisms. -/

/-- The universal morphism from any other cone to a limit cone. -/
@[simps]
def lift_cone_morphism {t : cone F} (h : is_limit t) (s : cone F) : s ⟶ t :=
{ hom := h.lift s }

lemma uniq_cone_morphism {s t : cone F} (h : is_limit t) {f f' : s ⟶ t} :
  f = f' :=
have ∀ {g : s ⟶ t}, g = h.lift_cone_morphism s, by intro g; ext; exact h.uniq _ _ g.w,
this.trans this.symm

/--
Alternative constructor for `is_limit`,
providing a morphism of cones rather than a morphism between the cone points
and separately the factorisation condition.
-/
@[simps]
def mk_cone_morphism {t : cone F}
  (lift : Π (s : cone F), s ⟶ t)
  (uniq' : ∀ (s : cone F) (m : s ⟶ t), m = lift s) : is_limit t :=
{ lift := λ s, (lift s).hom,
  uniq' := λ s m w,
    have cone_morphism.mk m w = lift s, by apply uniq',
    congr_arg cone_morphism.hom this }

/-- Limit cones on `F` are unique up to isomorphism. -/
@[simps]
def unique_up_to_iso {s t : cone F} (P : is_limit s) (Q : is_limit t) : s ≅ t :=
{ hom := Q.lift_cone_morphism s,
  inv := P.lift_cone_morphism t,
  hom_inv_id' := P.uniq_cone_morphism,
  inv_hom_id' := Q.uniq_cone_morphism }

/-- Any cone morphism between limit cones is an isomorphism. -/
lemma hom_is_iso {s t : cone F} (P : is_limit s) (Q : is_limit t) (f : s ⟶ t) : is_iso f :=
⟨⟨P.lift_cone_morphism t, ⟨P.uniq_cone_morphism, Q.uniq_cone_morphism⟩⟩⟩

/-- Limits of `F` are unique up to isomorphism. -/
def cone_point_unique_up_to_iso {s t : cone F} (P : is_limit s) (Q : is_limit t) : s.X ≅ t.X :=
(cones.forget F).map_iso (unique_up_to_iso P Q)

@[simp, reassoc] lemma cone_point_unique_up_to_iso_hom_comp {s t : cone F} (P : is_limit s)
  (Q : is_limit t) (j : J) : (cone_point_unique_up_to_iso P Q).hom ≫ t.π.app j = s.π.app j :=
(unique_up_to_iso P Q).hom.w _

@[simp, reassoc] lemma cone_point_unique_up_to_iso_inv_comp {s t : cone F} (P : is_limit s)
  (Q : is_limit t) (j : J) : (cone_point_unique_up_to_iso P Q).inv ≫ s.π.app j = t.π.app j :=
(unique_up_to_iso P Q).inv.w _

@[simp, reassoc] lemma lift_comp_cone_point_unique_up_to_iso_hom {r s t : cone F}
  (P : is_limit s) (Q : is_limit t) :
  P.lift r ≫ (cone_point_unique_up_to_iso P Q).hom = Q.lift r :=
Q.uniq _ _ (by simp)

@[simp, reassoc] lemma lift_comp_cone_point_unique_up_to_iso_inv {r s t : cone F}
  (P : is_limit s) (Q : is_limit t) :
  Q.lift r ≫ (cone_point_unique_up_to_iso P Q).inv = P.lift r :=
P.uniq _ _ (by simp)

/-- Transport evidence that a cone is a limit cone across an isomorphism of cones. -/
def of_iso_limit {r t : cone F} (P : is_limit r) (i : r ≅ t) : is_limit t :=
is_limit.mk_cone_morphism
  (λ s, P.lift_cone_morphism s ≫ i.hom)
  (λ s m, by rw ←i.comp_inv_eq; apply P.uniq_cone_morphism)

@[simp] lemma of_iso_limit_lift {r t : cone F} (P : is_limit r) (i : r ≅ t) (s) :
  (P.of_iso_limit i).lift s = P.lift s ≫ i.hom.hom :=
rfl

/-- Isomorphism of cones preserves whether or not they are limiting cones. -/
def equiv_iso_limit {r t : cone F} (i : r ≅ t) : is_limit r ≃ is_limit t :=
{ to_fun := λ h, h.of_iso_limit i,
  inv_fun := λ h, h.of_iso_limit i.symm,
  left_inv := by tidy,
  right_inv := by tidy }

@[simp] lemma equiv_iso_limit_apply {r t : cone F} (i : r ≅ t) (P : is_limit r) :
  equiv_iso_limit i P = P.of_iso_limit i := rfl

@[simp] lemma equiv_iso_limit_symm_apply {r t : cone F} (i : r ≅ t) (P : is_limit t) :
  (equiv_iso_limit i).symm P = P.of_iso_limit i.symm := rfl

/--
If the canonical morphism from a cone point to a limiting cone point is an iso, then the
first cone was limiting also.
-/
def of_point_iso {r t : cone F} (P : is_limit r) [i : is_iso (P.lift t)] : is_limit t :=
of_iso_limit P
begin
  haveI : is_iso (P.lift_cone_morphism t).hom := i,
  haveI : is_iso (P.lift_cone_morphism t) := cones.cone_iso_of_hom_iso _,
  symmetry,
  apply as_iso (P.lift_cone_morphism t),
end

variables {t : cone F}

lemma hom_lift (h : is_limit t) {W : C} (m : W ⟶ t.X) :
  m = h.lift { X := W, π := { app := λ b, m ≫ t.π.app b } } :=
h.uniq { X := W, π := { app := λ b, m ≫ t.π.app b } } m (λ b, rfl)

/-- Two morphisms into a limit are equal if their compositions with
  each cone morphism are equal. -/
lemma hom_ext (h : is_limit t) {W : C} {f f' : W ⟶ t.X}
  (w : ∀ j, f ≫ t.π.app j = f' ≫ t.π.app j) : f = f' :=
by rw [h.hom_lift f, h.hom_lift f']; congr; exact funext w

/--
Given a right adjoint functor between categories of cones,
the image of a limit cone is a limit cone.
-/
def of_right_adjoint {D : Type u'} [category.{v} D] {G : K ⥤ D}
  (h : cone G ⥤ cone F) [is_right_adjoint h] {c : cone G} (t : is_limit c) :
  is_limit (h.obj c) :=
mk_cone_morphism
  (λ s, (adjunction.of_right_adjoint h).hom_equiv s c (t.lift_cone_morphism _))
  (λ s m, (adjunction.eq_hom_equiv_apply _ _ _).2 t.uniq_cone_morphism)

/--
Given two functors which have equivalent categories of cones, we can transport a limiting cone
across the equivalence.
-/
def of_cone_equiv {D : Type u'} [category.{v} D] {G : K ⥤ D}
  (h : cone G ≌ cone F) {c : cone G} :
  is_limit (h.functor.obj c) ≃ is_limit c :=
{ to_fun := λ P, of_iso_limit (of_right_adjoint h.inverse P) (h.unit_iso.symm.app c),
  inv_fun := of_right_adjoint h.functor,
  left_inv := by tidy,
  right_inv := by tidy, }

@[simp] lemma of_cone_equiv_apply_desc {D : Type u'} [category.{v} D] {G : K ⥤ D}
  (h : cone G ≌ cone F) {c : cone G} (P : is_limit (h.functor.obj c)) (s) :
  (of_cone_equiv h P).lift s =
    ((h.unit_iso.hom.app s).hom ≫
      (h.functor.inv.map (P.lift_cone_morphism (h.functor.obj s))).hom) ≫
      (h.unit_iso.inv.app c).hom :=
rfl

@[simp]

/--
A cone postcomposed with a natural isomorphism is a limit cone if and only if the original cone is.
-/
def postcompose_hom_equiv {F G : J ⥤ C} (α : F ≅ G) (c : cone F) :
  is_limit ((cones.postcompose α.hom).obj c) ≃ is_limit c :=
of_cone_equiv (cones.postcompose_equivalence α)

/--
A cone postcomposed with the inverse of a natural isomorphism is a limit cone if and only if
the original cone is.
-/
def postcompose_inv_equiv {F G : J ⥤ C} (α : F ≅ G) (c : cone G) :
  is_limit ((cones.postcompose α.inv).obj c) ≃ is_limit c :=
postcompose_hom_equiv α.symm c

/--
The cone points of two limit cones for naturally isomorphic functors
are themselves isomorphic.
-/
@[simps]
def cone_points_iso_of_nat_iso {F G : J ⥤ C} {s : cone F} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (w : F ≅ G) : s.X ≅ t.X :=
{ hom := Q.map s w.hom,
  inv := P.map t w.inv,
  hom_inv_id' := P.hom_ext (by tidy),
  inv_hom_id' := Q.hom_ext (by tidy), }

@[reassoc]
lemma cone_points_iso_of_nat_iso_hom_comp {F G : J ⥤ C} {s : cone F} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (w : F ≅ G) (j : J) :
  (cone_points_iso_of_nat_iso P Q w).hom ≫ t.π.app j = s.π.app j ≫ w.hom.app j :=
by simp

@[reassoc]
lemma cone_points_iso_of_nat_iso_inv_comp {F G : J ⥤ C} {s : cone F} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (w : F ≅ G) (j : J) :
  (cone_points_iso_of_nat_iso P Q w).inv ≫ s.π.app j = t.π.app j ≫ w.inv.app j :=
by simp

@[reassoc]
lemma lift_comp_cone_points_iso_of_nat_iso_hom {F G : J ⥤ C} {r s : cone F} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (w : F ≅ G) :
  P.lift r ≫ (cone_points_iso_of_nat_iso P Q w).hom = Q.map r w.hom :=
Q.hom_ext (by simp)

section equivalence
open category_theory.equivalence

/--
If `s : cone F` is a limit cone, so is `s` whiskered by an equivalence `e`.
-/
def whisker_equivalence {s : cone F} (P : is_limit s) (e : K ≌ J) :
  is_limit (s.whisker e.functor) :=
of_right_adjoint (cones.whiskering_equivalence e).functor P

/--
We can prove two cone points `(s : cone F).X` and `(t.cone F).X` are isomorphic if
* both cones are limit cones
* their indexing categories are equivalent via some `e : J ≌ K`,
* the triangle of functors commutes up to a natural isomorphism: `e.functor ⋙ G ≅ F`.

This is the most general form of uniqueness of cone points,
allowing relabelling of both the indexing category (up to equivalence)
and the functor (up to natural isomorphism).
-/
@[simps]
def cone_points_iso_of_equivalence {F : J ⥤ C} {s : cone F} {G : K ⥤ C} {t : cone G}
  (P : is_limit s) (Q : is_limit t) (e : J ≌ K) (w : e.functor ⋙ G ≅ F) : s.X ≅ t.X :=
let w' : e.inverse ⋙ F ≅ G := (iso_whisker_left e.inverse w).symm ≪≫ inv_fun_id_assoc e G in
{ hom := Q.lift ((cones.equivalence_of_reindexing e.symm w').functor.obj s),
  inv := P.lift ((cones.equivalence_of_reindexing e w).functor.obj t),
  hom_inv_id' :=
  begin
    apply hom_ext P, intros j,
    dsimp,
    simp only [limits.cone.whisker_π, limits.cones.postcompose_obj_π, fac, whisker_left_app,
      assoc, id_comp, inv_fun_id_assoc_hom_app, fac_assoc, nat_trans.comp_app],
    rw [counit_app_functor, ←functor.comp_map, w.hom.naturality],
    simp,
  end,
  inv_hom_id' := by { apply hom_ext Q, tidy, }, }

end equivalence

/-- The universal property of a limit cone: a map `W ⟶ X` is the same as
  a cone on `F` with vertex `W`. -/
def hom_iso (h : is_limit t) (W : C) : (W ⟶ t.X) ≅ ((const J).obj W ⟶ F) :=
{ hom := λ f, (t.extend f).π,
  inv := λ π, h.lift { X := W, π := π },
  hom_inv_id' := by ext f; apply h.hom_ext; intro j; simp; dsimp; refl }

@[simp] lemma hom_iso_hom (h : is_limit t) {W : C} (f : W ⟶ t.X) :
  (is_limit.hom_iso h W).hom f = (t.extend f).π := rfl

/-- The limit of `F` represents the functor taking `W` to
  the set of cones on `F` with vertex `W`. -/
def nat_iso (h : is_limit t) : yoneda.obj t.X ≅ F.cones :=
nat_iso.of_components (λ W, is_limit.hom_iso h (unop W)) (by tidy).

/--
Another, more explicit, formulation of the universal property of a limit cone.
See also `hom_iso`.
-/
def hom_iso' (h : is_limit t) (W : C) :
  ((W ⟶ t.X) : Type v) ≅ { p : Π j, W ⟶ F.obj j // ∀ {j j'} (f : j ⟶ j'), p j ≫ F.map f = p j' } :=
h.hom_iso W ≪≫
{ hom := λ π,
  ⟨λ j, π.app j, λ j j' f,
   by convert ←(π.naturality f).symm; apply id_comp⟩,
  inv := λ p,
  { app := λ j, p.1 j,
    naturality' := λ j j' f, begin dsimp, rw [id_comp], exact (p.2 f).symm end } }

/-- If G : C → D is a faithful functor which sends t to a limit cone,
  then it suffices to check that the induced maps for the image of t
  can be lifted to maps of C. -/
def of_faithful {t : cone F} {D : Type u'} [category.{v} D] (G : C ⥤ D) [faithful G]
  (ht : is_limit (G.map_cone t)) (lift : Π (s : cone F), s.X ⟶ t.X)
  (h : ∀ s, G.map (lift s) = ht.lift (G.map_cone s)) : is_limit t :=
{ lift := lift,
  fac' := λ s j, by apply G.map_injective; rw [G.map_comp, h]; apply ht.fac,
  uniq' := λ s m w, begin
    apply G.map_injective, rw h,
    refine ht.uniq (G.map_cone s) _ (λ j, _),
    convert ←congr_arg (λ f, G.map f) (w j),
    apply G.map_comp
  end }

/--
If `F` and `G` are naturally isomorphic, then `F.map_cone c` being a limit implies
`G.map_cone c` is also a limit.
-/
def map_cone_equiv {D : Type u'} [category.{v} D] {K : J ⥤ C} {F G : C ⥤ D} (h : F ≅ G) {c : cone K}
  (t : is_limit (F.map_cone c)) : is_limit (G.map_cone c) :=
begin
  apply postcompose_inv_equiv (iso_whisker_left K h : _) (G.map_cone c) _,
  apply t.of_iso_limit (postcompose_whisker_left_map_cone h.symm c).symm,
end

/--
A cone is a limit cone exactly if
there is a unique cone morphism from any other cone.
-/
def iso_unique_cone_morphism {t : cone F} :
  is_limit t ≅ Π s, unique (s ⟶ t) :=
{ hom := λ h s,
  { default := h.lift_cone_morphism s,
    uniq := λ _, h.uniq_cone_morphism },
  inv := λ h,
  { lift := λ s, (h s).default.hom,
    uniq' := λ s f w, congr_arg cone_morphism.hom ((h s).uniq ⟨f, w⟩) } }

namespace of_nat_iso
variables {X : C} (h : yoneda.obj X ≅ F.cones)

/-- If `F.cones` is represented by `X`, each morphism `f : Y ⟶ X` gives a cone with cone point
`Y`. -/
def cone_of_hom {Y : C} (f : Y ⟶ X) : cone F :=
{ X := Y, π := h.hom.app (op Y) f }

/-- If `F.cones` is represented by `X`, each cone `s` gives a morphism `s.X ⟶ X`. -/
def hom_of_cone (s : cone F) : s.X ⟶ X := h.inv.app (op s.X) s.π

@[simp] lemma cone_of_hom_of_cone (s : cone F) : cone_of_hom h (hom_of_cone h s) = s :=
begin
  dsimp [cone_of_hom, hom_of_cone], cases s, congr, dsimp,
  exact congr_fun (congr_fun (congr_arg nat_trans.app h.inv_hom_id) (op s_X)) s_π,
end

@[simp] lemma hom_of_cone_of_hom {Y : C} (f : Y ⟶ X) : hom_of_cone h (cone_of_hom h f) = f :=
congr_fun (congr_fun (congr_arg nat_trans.app h.hom_inv_id) (op Y)) f

/-- If `F.cones` is represented by `X`, the cone corresponding to the identity morphism on `X`
will be a limit cone. -/
def limit_cone : cone F :=
cone_of_hom h (𝟙 X)

/-- If `F.cones` is represented by `X`, the cone corresponding to a morphism `f : Y ⟶ X` is
the limit cone extended by `f`. -/
lemma cone_of_hom_fac {Y : C} (f : Y ⟶ X) :
cone_of_hom h f = (limit_cone h).extend f :=
begin
  dsimp [cone_of_hom, limit_cone, cone.extend],
  congr' with j,
  have t := congr_fun (h.hom.naturality f.op) (𝟙 X),
  dsimp at t,
  simp only [comp_id] at t,
  rw congr_fun (congr_arg nat_trans.app t) j,
  refl,
end

/-- If `F.cones` is represented by `X`, any cone is the extension of the limit cone by the
corresponding morphism. -/
lemma cone_fac (s : cone F) : (limit_cone h).extend (hom_of_cone h s) = s :=
begin
  rw ←cone_of_hom_of_cone h s,
  conv_lhs { simp only [hom_of_cone_of_hom] },
  apply (cone_of_hom_fac _ _).symm,
end

end of_nat_iso

section
open of_nat_iso

/--
If `F.cones` is representable, then the cone corresponding to the identity morphism on
the representing object is a limit cone.
-/
def of_nat_iso {X : C} (h : yoneda.obj X ≅ F.cones) :
  is_limit (limit_cone h) :=
{ lift := λ s, hom_of_cone h s,
  fac' := λ s j,
  begin
    have h := cone_fac h s,
    cases s,
    injection h with h₁ h₂,
    simp only [heq_iff_eq] at h₂,
    conv_rhs { rw ← h₂ }, refl,
  end,
  uniq' := λ s m w,
  begin
    rw ←hom_of_cone_of_hom h m,
    congr,
    rw cone_of_hom_fac,
    dsimp [cone.extend], cases s, congr' with j, exact w j,
  end }
end

end is_limit

/--
A cocone `t` on `F` is a colimit cocone if each cocone on `F` admits a unique
cocone morphism from `t`.

See https://stacks.math.columbia.edu/tag/002F.
-/
@[nolint has_inhabited_instance]
structure is_colimit (t : cocone F) :=
(desc  : Π (s : cocone F), t.X ⟶ s.X)
(fac'  : ∀ (s : cocone F) (j : J), t.ι.app j ≫ desc s = s.ι.app j . obviously)
(uniq' : ∀ (s : cocone F) (m : t.X ⟶ s.X) (w : ∀ j : J, t.ι.app j ≫ m = s.ι.app j),
  m = desc s . obviously)

restate_axiom is_colimit.fac'
attribute [simp,reassoc] is_colimit.fac
restate_axiom is_colimit.uniq'

namespace is_colimit

instance subsingleton {t : cocone F} : subsingleton (is_colimit t) :=
⟨by intros P Q; cases P; cases Q; congr; ext; solve_by_elim⟩

/-- Given a natural transformation `α : F ⟶ G`, we give a morphism from the cocone point
of a colimit cocone over `F` to the cocone point of any cocone over `G`. -/
def map {F G : J ⥤ C} {s : cocone F} (P : is_colimit s) (t : cocone G)
  (α : F ⟶ G) : s.X ⟶ t.X :=
P.desc ((cocones.precompose α).obj t)

@[simp, reassoc]
lemma ι_map {F G : J ⥤ C} {c : cocone F} (hc : is_colimit c) (d : cocone G) (α : F ⟶ G)
  (j : J) : c.ι.app j ≫ is_colimit.map hc d α = α.app j ≫ d.ι.app j :=
fac _ _ _

@[simp]
lemma desc_self {t : cocone F} (h : is_colimit t) : h.desc t = 𝟙 t.X :=
(h.uniq _ _ (λ j, comp_id _)).symm

/- Repackaging the definition in terms of cocone morphisms. -/

/-- The universal morphism from a colimit cocone to any other cocone. -/
@[simps]
def desc_cocone_morphism {t : cocone F} (h : is_colimit t) (s : cocone F) : t ⟶ s :=
{ hom := h.desc s }

lemma uniq_cocone_morphism {s t : cocone F} (h : is_colimit t) {f f' : t ⟶ s} :
  f = f' :=
have ∀ {g : t ⟶ s}, g = h.desc_cocone_morphism s, by intro g; ext; exact h.uniq _ _ g.w,
this.trans this.symm

/--
Alternative constructor for `is_colimit`,
providing a morphism of cocones rather than a morphism between the cocone points
and separately the factorisation condition.
-/
@[simps]
def mk_cocone_morphism {t : cocone F}
  (desc : Π (s : cocone F), t ⟶ s)
  (uniq' : ∀ (s : cocone F) (m : t ⟶ s), m = desc s) : is_colimit t :=
{ desc := λ s, (desc s).hom,
  uniq' := λ s m w,
    have cocone_morphism.mk m w = desc s, by apply uniq',
    congr_arg cocone_morphism.hom this }

/-- Colimit cocones on `F` are unique up to isomorphism. -/
@[simps]
def unique_up_to_iso {s t : cocone F} (P : is_colimit s) (Q : is_colimit t) : s ≅ t :=
{ hom := P.desc_cocone_morphism t,
  inv := Q.desc_cocone_morphism s,
  hom_inv_id' := P.uniq_cocone_morphism,
  inv_hom_id' := Q.uniq_cocone_morphism }

/-- Any cocone morphism between colimit cocones is an isomorphism. -/
lemma hom_is_iso {s t : cocone F} (P : is_colimit s) (Q : is_colimit t) (f : s ⟶ t) : is_iso f :=
⟨⟨Q.desc_cocone_morphism s, ⟨P.uniq_cocone_morphism, Q.uniq_cocone_morphism⟩⟩⟩

/-- Colimits of `F` are unique up to isomorphism. -/
def cocone_point_unique_up_to_iso {s t : cocone F} (P : is_colimit s) (Q : is_colimit t) :
  s.X ≅ t.X :=
(cocones.forget F).map_iso (unique_up_to_iso P Q)

@[simp, reassoc] lemma comp_cocone_point_unique_up_to_iso_hom {s t : cocone F} (P : is_colimit s)
  (Q : is_colimit t) (j : J) : s.ι.app j ≫ (cocone_point_unique_up_to_iso P Q).hom = t.ι.app j :=
(unique_up_to_iso P Q).hom.w _

@[simp, reassoc] lemma comp_cocone_point_unique_up_to_iso_inv {s t : cocone F} (P : is_colimit s)
  (Q : is_colimit t) (j : J) : t.ι.app j ≫ (cocone_point_unique_up_to_iso P Q).inv = s.ι.app j :=
(unique_up_to_iso P Q).inv.w _

@[simp, reassoc] lemma cocone_point_unique_up_to_iso_hom_desc {r s t : cocone F} (P : is_colimit s)
  (Q : is_colimit t) : (cocone_point_unique_up_to_iso P Q).hom ≫ Q.desc r = P.desc r :=
P.uniq _ _ (by simp)

@[simp, reassoc] lemma cocone_point_unique_up_to_iso_inv_desc {r s t : cocone F} (P : is_colimit s)
  (Q : is_colimit t) : (cocone_point_unique_up_to_iso P Q).inv ≫ P.desc r = Q.desc r :=
Q.uniq _ _ (by simp)

/-- Transport evidence that a cocone is a colimit cocone across an isomorphism of cocones. -/
def of_iso_colimit {r t : cocone F} (P : is_colimit r) (i : r ≅ t) : is_colimit t :=
is_colimit.mk_cocone_morphism
  (λ s, i.inv ≫ P.desc_cocone_morphism s)
  (λ s m, by rw i.eq_inv_comp; apply P.uniq_cocone_morphism)

@[simp] lemma of_iso_colimit_desc {r t : cocone F} (P : is_colimit r) (i : r ≅ t) (s) :
  (P.of_iso_colimit i).desc s = i.inv.hom ≫ P.desc s :=
rfl

/-- Isomorphism of cocones preserves whether or not they are colimiting cocones. -/
def equiv_iso_colimit {r t : cocone F} (i : r ≅ t) : is_colimit r ≃ is_colimit t :=
{ to_fun := λ h, h.of_iso_colimit i,
  inv_fun := λ h, h.of_iso_colimit i.symm,
  left_inv := by tidy,
  right_inv := by tidy }

@[simp] lemma equiv_iso_colimit_apply {r t : cocone F} (i : r ≅ t) (P : is_colimit r) :
  equiv_iso_colimit i P = P.of_iso_colimit i := rfl

@[simp] lemma equiv_iso_colimit_symm_apply {r t : cocone F} (i : r ≅ t) (P : is_colimit t) :
  (equiv_iso_colimit i).symm P = P.of_iso_colimit i.symm := rfl

/--
If the canonical morphism to a cocone point from a colimiting cocone point is an iso, then the
first cocone was colimiting also.
-/
def of_point_iso {r t : cocone F} (P : is_colimit r) [i : is_iso (P.desc t)] : is_colimit t :=
of_iso_colimit P
begin
  haveI : is_iso (P.desc_cocone_morphism t).hom := i,
  haveI : is_iso (P.desc_cocone_morphism t) := cocones.cocone_iso_of_hom_iso _,
  apply as_iso (P.desc_cocone_morphism t),
end

variables {t : cocone F}

lemma hom_desc (h : is_colimit t) {W : C} (m : t.X ⟶ W) :
  m = h.desc { X := W, ι := { app := λ b, t.ι.app b ≫ m,
    naturality' := by intros; erw [←assoc, t.ι.naturality, comp_id, comp_id] } } :=
h.uniq { X := W, ι := { app := λ b, t.ι.app b ≫ m, naturality' := _ } } m (λ b, rfl)

/-- Two morphisms out of a colimit are equal if their compositions with
  each cocone morphism are equal. -/
lemma hom_ext (h : is_colimit t) {W : C} {f f' : t.X ⟶ W}
  (w : ∀ j, t.ι.app j ≫ f = t.ι.app j ≫ f') : f = f' :=
by rw [h.hom_desc f, h.hom_desc f']; congr; exact funext w

/--
Given a left adjoint functor between categories of cocones,
the image of a colimit cocone is a colimit cocone.
-/
def of_left_adjoint {D : Type u'} [category.{v} D] {G : K ⥤ D}
  (h : cocone G ⥤ cocone F) [is_left_adjoint h] {c : cocone G} (t : is_colimit c) :
  is_colimit (h.obj c) :=
mk_cocone_morphism
  (λ s, ((adjunction.of_left_adjoint h).hom_equiv c s).symm (t.desc_cocone_morphism _))
  (λ s m, (adjunction.hom_equiv_apply_eq _ _ _).1 t.uniq_cocone_morphism)

/--
Given two functors which have equivalent categories of cocones,
we can transport a colimiting cocone across the equivalence.
-/
def of_cocone_equiv {D : Type u'} [category.{v} D] {G : K ⥤ D}
  (h : cocone G ≌ cocone F) {c : cocone G} :
  is_colimit (h.functor.obj c) ≃ is_colimit c :=
{ to_fun := λ P, of_iso_colimit (of_left_adjoint h.inverse P) (h.unit_iso.symm.app c),
  inv_fun := of_left_adjoint h.functor,
  left_inv := by tidy,
  right_inv := by tidy, }

@[simp] lemma of_cocone_equiv_apply_desc {D : Type u'} [category.{v} D] {G : K ⥤ D}
  (h : cocone G ≌ cocone F) {c : cocone G} (P : is_colimit (h.functor.obj c)) (s) :
  (of_cocone_equiv h P).desc s =
    (h.unit.app c).hom ≫
    (h.inverse.map (P.desc_cocone_morphism (h.functor.obj s))).hom ≫
    (h.unit_inv.app s).hom :=
rfl

@[simp] lemma of_cocone_equiv_symm_apply_desc {D : Type u'} [category.{v} D] {G : K ⥤ D}
  (h : cocone G ≌ cocone F) {c : cocone G} (P : is_colimit c) (s) :
  ((of_cocone_equiv h).symm P).desc s =
    (h.functor.map (P.desc_cocone_morphism (h.inverse.obj s))).hom ≫ (h.counit.app s).hom :=
rfl

/--
A cocone precomposed with a natural isomorphism is a colimit cocone
if and only if the original cocone is.
-/
def precompose_hom_equiv {F G : J ⥤ C} (α : F ≅ G) (c : cocone G) :
  is_colimit ((cocones.precompose α.hom).obj c) ≃ is_colimit c :=
of_cocone_equiv (cocones.precompose_equivalence α)

/--
A cocone precomposed with the inverse of a natural isomorphism is a colimit cocone
if and only if the original cocone is.
-/
def precompose_inv_equiv {F G : J ⥤ C} (α : F ≅ G) (c : cocone F) :
  is_colimit ((cocones.precompose α.inv).obj c) ≃ is_colimit c :=
precompose_hom_equiv α.symm c

/--
The cocone points of two colimit cocones for naturally isomorphic functors
are themselves isomorphic.
-/
@[simps]
def cocone_points_iso_of_nat_iso {F G : J ⥤ C} {s : cocone F} {t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (w : F ≅ G) : s.X ≅ t.X :=
{ hom := P.map t w.hom,
  inv := Q.map s w.inv,
  hom_inv_id' := P.hom_ext (by tidy),
  inv_hom_id' := Q.hom_ext (by tidy) }

@[reassoc]
lemma comp_cocone_points_iso_of_nat_iso_hom {F G : J ⥤ C} {s : cocone F} {t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (w : F ≅ G) (j : J) :
  s.ι.app j ≫ (cocone_points_iso_of_nat_iso P Q w).hom = w.hom.app j ≫ t.ι.app j :=
by simp

@[reassoc]
lemma comp_cocone_points_iso_of_nat_iso_inv {F G : J ⥤ C} {s : cocone F} {t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (w : F ≅ G) (j : J) :
  t.ι.app j ≫ (cocone_points_iso_of_nat_iso P Q w).inv = w.inv.app j ≫ s.ι.app j :=
by simp

@[reassoc]
lemma cocone_points_iso_of_nat_iso_hom_desc {F G : J ⥤ C} {s : cocone F} {r t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (w : F ≅ G) :
  (cocone_points_iso_of_nat_iso P Q w).hom ≫ Q.desc r = P.map _ w.hom :=
P.hom_ext (by simp)

section equivalence
open category_theory.equivalence

/--
If `s : cone F` is a limit cone, so is `s` whiskered by an equivalence `e`.
-/
def whisker_equivalence {s : cocone F} (P : is_colimit s) (e : K ≌ J) :
  is_colimit (s.whisker e.functor) :=
of_left_adjoint (cocones.whiskering_equivalence e).functor P

/--
We can prove two cocone points `(s : cocone F).X` and `(t.cocone F).X` are isomorphic if
* both cocones are colimit ccoones
* their indexing categories are equivalent via some `e : J ≌ K`,
* the triangle of functors commutes up to a natural isomorphism: `e.functor ⋙ G ≅ F`.

This is the most general form of uniqueness of cocone points,
allowing relabelling of both the indexing category (up to equivalence)
and the functor (up to natural isomorphism).
-/
@[simps]
def cocone_points_iso_of_equivalence {F : J ⥤ C} {s : cocone F} {G : K ⥤ C} {t : cocone G}
  (P : is_colimit s) (Q : is_colimit t) (e : J ≌ K) (w : e.functor ⋙ G ≅ F) : s.X ≅ t.X :=
let w' : e.inverse ⋙ F ≅ G := (iso_whisker_left e.inverse w).symm ≪≫ inv_fun_id_assoc e G in
{ hom := P.desc ((cocones.equivalence_of_reindexing e w).functor.obj t),
  inv := Q.desc ((cocones.equivalence_of_reindexing e.symm w').functor.obj s),
  hom_inv_id' :=
  begin
    apply hom_ext P, intros j,
    dsimp,
    simp only [limits.cocone.whisker_ι, fac, inv_fun_id_assoc_inv_app, whisker_left_app, assoc,
      comp_id, limits.cocones.precompose_obj_ι, fac_assoc, nat_trans.comp_app],
    rw [counit_inv_app_functor, ←functor.comp_map, ←w.inv.naturality_assoc],
    dsimp,
    simp,
  end,
  inv_hom_id' := by { apply hom_ext Q, tidy, }, }

end equivalence

/-- The universal property of a colimit cocone: a map `X ⟶ W` is the same as
  a cocone on `F` with vertex `W`. -/
def hom_iso (h : is_colimit t) (W : C) : (t.X ⟶ W) ≅ (F ⟶ (const J).obj W) :=
{ hom := λ f, (t.extend f).ι,
  inv := λ ι, h.desc { X := W, ι := ι },
  hom_inv_id' := by ext f; apply h.hom_ext; intro j; simp; dsimp; refl }

@[simp] lemma hom_iso_hom (h : is_colimit t) {W : C} (f : t.X ⟶ W) :
  (is_colimit.hom_iso h W).hom f = (t.extend f).ι := rfl

/-- The colimit of `F` represents the functor taking `W` to
  the set of cocones on `F` with vertex `W`. -/
def nat_iso (h : is_colimit t) : coyoneda.obj (op t.X) ≅ F.cocones :=
nat_iso.of_components (is_colimit.hom_iso h) (by intros; ext; dsimp; rw ←assoc; refl)

/--
Another, more explicit, formulation of the universal property of a colimit cocone.
See also `hom_iso`.
-/
def hom_iso' (h : is_colimit t) (W : C) :
  ((t.X ⟶ W) : Type v) ≅
    { p : Π j, F.obj j ⟶ W // ∀ {j j' : J} (f : j ⟶ j'), F.map f ≫ p j' = p j } :=
h.hom_iso W ≪≫
{ hom := λ ι,
  ⟨λ j, ι.app j, λ j j' f,
   by convert ←(ι.naturality f); apply comp_id⟩,
  inv := λ p,
  { app := λ j, p.1 j,
    naturality' := λ j j' f, begin dsimp, rw [comp_id], exact (p.2 f) end } }

/-- If G : C → D is a faithful functor which sends t to a colimit cocone,
  then it suffices to check that the induced maps for the image of t
  can be lifted to maps of C. -/
def of_faithful {t : cocone F} {D : Type u'} [category.{v} D] (G : C ⥤ D) [faithful G]
  (ht : is_colimit (G.map_cocone t)) (desc : Π (s : cocone F), t.X ⟶ s.X)
  (h : ∀ s, G.map (desc s) = ht.desc (G.map_cocone s)) : is_colimit t :=
{ desc := desc,
  fac' := λ s j, by apply G.map_injective; rw [G.map_comp, h]; apply ht.fac,
  uniq' := λ s m w, begin
    apply G.map_injective, rw h,
    refine ht.uniq (G.map_cocone s) _ (λ j, _),
    convert ←congr_arg (λ f, G.map f) (w j),
    apply G.map_comp
  end }

/--
If `F` and `G` are naturally isomorphic, then `F.map_cone c` being a colimit implies
`G.map_cone c` is also a colimit.
-/
def map_cocone_equiv {D : Type u'} [category.{v} D] {K : J ⥤ C} {F G : C ⥤ D} (h : F ≅ G)
  {c : cocone K} (t : is_colimit (F.map_cocone c)) : is_colimit (G.map_cocone c) :=
begin
  apply is_colimit.of_iso_colimit _ (precompose_whisker_left_map_cocone h c),
  apply (precompose_inv_equiv (iso_whisker_left K h : _) _).symm t,
end

/--
A cocone is a colimit cocone exactly if
there is a unique cocone morphism from any other cocone.
-/
def iso_unique_cocone_morphism {t : cocone F} :
  is_colimit t ≅ Π s, unique (t ⟶ s) :=
{ hom := λ h s,
  { default := h.desc_cocone_morphism s,
    uniq := λ _, h.uniq_cocone_morphism },
  inv := λ h,
  { desc := λ s, (h s).default.hom,
    uniq' := λ s f w, congr_arg cocone_morphism.hom ((h s).uniq ⟨f, w⟩) } }

namespace of_nat_iso
variables {X : C} (h : coyoneda.obj (op X) ≅ F.cocones)

/-- If `F.cocones` is corepresented by `X`, each morphism `f : X ⟶ Y` gives a cocone with cone
point `Y`. -/
def cocone_of_hom {Y : C} (f : X ⟶ Y) : cocone F :=
{ X := Y, ι := h.hom.app Y f }

/-- If `F.cocones` is corepresented by `X`, each cocone `s` gives a morphism `X ⟶ s.X`. -/
def hom_of_cocone (s : cocone F) : X ⟶ s.X := h.inv.app s.X s.ι

@[simp] lemma cocone_of_hom_of_cocone (s : cocone F) : cocone_of_hom h (hom_of_cocone h s) = s :=
begin
  dsimp [cocone_of_hom, hom_of_cocone], cases s, congr, dsimp,
  exact congr_fun (congr_fun (congr_arg nat_trans.app h.inv_hom_id) s_X) s_ι,
end

@[simp] lemma hom_of_cocone_of_hom {Y : C} (f : X ⟶ Y) : hom_of_cocone h (cocone_of_hom h f) = f :=
congr_fun (congr_fun (congr_arg nat_trans.app h.hom_inv_id) Y) f

/-- If `F.cocones` is corepresented by `X`, the cocone corresponding to the identity morphism on `X`
will be a colimit cocone. -/
def colimit_cocone : cocone F :=
cocone_of_hom h (𝟙 X)

/-- If `F.cocones` is corepresented by `X`, the cocone corresponding to a morphism `f : Y ⟶ X` is
the colimit cocone extended by `f`. -/
lemma cocone_of_hom_fac {Y : C} (f : X ⟶ Y) :
cocone_of_hom h f = (colimit_cocone h).extend f :=
begin
  dsimp [cocone_of_hom, colimit_cocone, cocone.extend],
  congr' with j,
  have t := congr_fun (h.hom.naturality f) (𝟙 X),
  dsimp at t,
  simp only [id_comp] at t,
  rw congr_fun (congr_arg nat_trans.app t) j,
  refl,
end

/-- If `F.cocones` is corepresented by `X`, any cocone is the extension of the colimit cocone by the
corresponding morphism. -/
lemma cocone_fac (s : cocone F) : (colimit_cocone h).extend (hom_of_cocone h s) = s :=
begin
  rw ←cocone_of_hom_of_cocone h s,
  conv_lhs { simp only [hom_of_cocone_of_hom] },
  apply (cocone_of_hom_fac _ _).symm,
end

end of_nat_iso

section
open of_nat_iso

/--
If `F.cocones` is corepresentable, then the cocone corresponding to the identity morphism on
the representing object is a colimit cocone.
-/
def of_nat_iso {X : C} (h : coyoneda.obj (op X) ≅ F.cocones) :
  is_colimit (colimit_cocone h) :=
{ desc := λ s, hom_of_cocone h s,
  fac' := λ s j,
  begin
    have h := cocone_fac h s,
    cases s,
    injection h with h₁ h₂,
    simp only [heq_iff_eq] at h₂,
    conv_rhs { rw ← h₂ }, refl,
  end,
  uniq' := λ s m w,
  begin
    rw ←hom_of_cocone_of_hom h m,
    congr,
    rw cocone_of_hom_fac,
    dsimp [cocone.extend], cases s, congr' with j, exact w j,
  end }
end

end is_colimit

end category_theory.limits