/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz, Scott Morrison
-/
import category_theory.punit
import category_theory.comma
import category_theory.limits.shapes.terminal

/-!
# The category of "structured arrows"

For `T : C ⥤ D`, a `T`-structured arrow with source `S : D`
is just a morphism `S ⟶ T.obj Y`, for some `Y : C`.

These form a category with morphisms `g : Y ⟶ Y'` making the obvious diagram commute.

We prove that `𝟙 (T.obj Y)` is the initial object in `T`-structured objects with source `T.obj Y`.
-/

namespace category_theory

-- morphism levels before object levels. See note [category_theory universes].
universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄
variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D]

/--
The category of `T`-structured arrows with domain `S : D` (here `T : C ⥤ D`),
has as its objects `D`-morphisms of the form `S ⟶ T Y`, for some `Y : C`,
and morphisms `C`-morphisms `Y ⟶ Y'` making the obvious triangle commute.
-/
@[derive category, nolint has_inhabited_instance]
def structured_arrow (S : D) (T : C ⥤ D) := comma (functor.from_punit S) T

namespace structured_arrow

/-- The obvious projection functor from structured arrows. -/
@[simps]
def proj (S : D) (T : C ⥤ D) : structured_arrow S T ⥤ C := comma.snd _ _

variables {S S' S'' : D} {Y Y' : C} {T : C ⥤ D}

/-- Construct a structured arrow from a morphism. -/
def mk (f : S ⟶ T.obj Y) : structured_arrow S T := ⟨⟨⟨⟩⟩, Y, f⟩

@[simp] lemma mk_left (f : S ⟶ T.obj Y) : (mk f).left = ⟨⟨⟩⟩ := rfl
@[simp] lemma mk_right (f : S ⟶ T.obj Y) : (mk f).right = Y := rfl
@[simp] lemma mk_hom_eq_self (f : S ⟶ T.obj Y) : (mk f).hom = f := rfl

@[simp, reassoc] lemma w {A B : structured_arrow S T} (f : A ⟶ B) : A.hom ≫ T.map f.right = B.hom :=
by { have := f.w; tidy }

lemma eq_mk (f : structured_arrow S T) : f = mk f.hom :=
by { cases f, congr, ext, }

/--
To construct a morphism of structured arrows,
we need a morphism of the objects underlying the target,
and to check that the triangle commutes.
-/
@[simps]
def hom_mk {f f' : structured_arrow S T} (g : f.right ⟶ f'.right) (w : f.hom ≫ T.map g = f'.hom) :
  f ⟶ f' :=
{ left := eq_to_hom (by ext),
  right := g,
  w' := by { dsimp, simpa using w.symm, }, }

/--
Given a structured arrow `X ⟶ F(U)`, and an arrow `U ⟶ Y`, we can construct a morphism of
structured arrow given by `(X ⟶ F(U)) ⟶ (X ⟶ F(U) ⟶ F(Y))`.
-/
def hom_mk' {F : C ⥤ D} {X : D} {Y : C}
(U : structured_arrow X F) (f : U.right ⟶ Y) :
U ⟶ mk (U.hom ≫ F.map f) := { right := f }

/--
To construct an isomorphism of structured arrows,
we need an isomorphism of the objects underlying the target,
and to check that the triangle commutes.
-/
@[simps]
def iso_mk {f f' : structured_arrow S T} (g : f.right ≅ f'.right)
  (w : f.hom ≫ T.map g.hom = f'.hom) : f ≅ f' :=
comma.iso_mk (eq_to_iso (by ext)) g (by simpa [eq_to_hom_map] using w.symm)

/--
A morphism between source objects `S ⟶ S'`
contravariantly induces a functor between structured arrows,
`structured_arrow S' T ⥤ structured_arrow S T`.

Ideally this would be described as a 2-functor from `D`
(promoted to a 2-category with equations as 2-morphisms)
to `Cat`.
-/
@[simps]
def map (f : S ⟶ S') : structured_arrow S' T ⥤ structured_arrow S T :=
comma.map_left _ ((functor.const _).map f)

@[simp]

@[simp] lemma map_id {f : structured_arrow S T} : (map (𝟙 S)).obj f = f :=
by { rw eq_mk f, simp, }

@[simp] lemma map_comp {f : S ⟶ S'} {f' : S' ⟶ S''} {h : structured_arrow S'' T} :
  (map (f ≫ f')).obj h = (map f).obj ((map f').obj h) :=
by { rw eq_mk h, simp, }

instance proj_reflects_iso : reflects_isomorphisms (proj S T) :=
{ reflects := λ Y Z f t, by exactI
  ⟨⟨structured_arrow.hom_mk (inv ((proj S T).map f)) (by simp), by tidy⟩⟩ }

open category_theory.limits

local attribute [tidy] tactic.discrete_cases

/-- The identity structured arrow is initial. -/
def mk_id_initial [full T] [faithful T] : is_initial (mk (𝟙 (T.obj Y))) :=
{ desc := λ c, hom_mk (T.preimage c.X.hom) (by { dsimp, simp, }),
  uniq' := λ c m _, begin
    ext,
    apply T.map_injective,
    simpa only [hom_mk_right, T.image_preimage, ←w m] using (category.id_comp _).symm,
  end }

variables {A : Type u₃} [category.{v₃} A] {B : Type u₄} [category.{v₄} B]

/-- The functor `(S, F ⋙ G) ⥤ (S, G)`. -/
@[simps]
def pre (S : D) (F : B ⥤ C) (G : C ⥤ D) : structured_arrow S (F ⋙ G) ⥤ structured_arrow S G :=
comma.pre_right _ F G

/-- The functor `(S, F) ⥤ (G(S), F ⋙ G)`. -/
@[simps] def post (S : C) (F : B ⥤ C) (G : C ⥤ D) :
  structured_arrow S F ⥤ structured_arrow (G.obj S) (F ⋙ G) :=
{ obj := λ X, { right := X.right, hom := G.map X.hom },
  map := λ X Y f, { right := f.right, w' :=
    by { simp [functor.comp_map, ←G.map_comp, ← f.w] } } }

end structured_arrow

/--
The category of `S`-costructured arrows with target `T : D` (here `S : C ⥤ D`),
has as its objects `D`-morphisms of the form `S Y ⟶ T`, for some `Y : C`,
and morphisms `C`-morphisms `Y ⟶ Y'` making the obvious triangle commute.
-/
@[derive category, nolint has_inhabited_instance]
def costructured_arrow (S : C ⥤ D) (T : D) := comma S (functor.from_punit T)

namespace costructured_arrow

/-- The obvious projection functor from costructured arrows. -/
@[simps]
def proj (S : C ⥤ D) (T : D) : costructured_arrow S T ⥤ C := comma.fst _ _

variables {T T' T'' : D} {Y Y' : C} {S : C ⥤ D}

/-- Construct a costructured arrow from a morphism. -/
def mk (f : S.obj Y ⟶ T) : costructured_arrow S T := ⟨Y, ⟨⟨⟩⟩, f⟩

@[simp] lemma mk_left (f : S.obj Y ⟶ T) : (mk f).left = Y := rfl
@[simp] lemma mk_right (f : S.obj Y ⟶ T) : (mk f).right = ⟨⟨⟩⟩ := rfl
@[simp] lemma mk_hom_eq_self (f : S.obj Y ⟶ T) : (mk f).hom = f := rfl

@[simp, reassoc] lemma w {A B : costructured_arrow S T} (f : A ⟶ B) :
  S.map f.left ≫ B.hom = A.hom :=
by tidy

lemma eq_mk (f : costructured_arrow S T) : f = mk f.hom :=
by { cases f, congr, ext, }

/--
To construct a morphism of costructured arrows,
we need a morphism of the objects underlying the source,
and to check that the triangle commutes.
-/
@[simps]
def hom_mk {f f' : costructured_arrow S T} (g : f.left ⟶ f'.left) (w : S.map g ≫ f'.hom = f.hom) :
  f ⟶ f' :=
{ left := g,
  right := eq_to_hom (by ext),
  w' := by simpa [eq_to_hom_map] using w, }

/--
To construct an isomorphism of costructured arrows,
we need an isomorphism of the objects underlying the source,
and to check that the triangle commutes.
-/
@[simps]
def iso_mk {f f' : costructured_arrow S T} (g : f.left ≅ f'.left)
  (w : S.map g.hom ≫ f'.hom = f.hom) : f ≅ f' :=
comma.iso_mk g (eq_to_iso (by ext)) (by simpa [eq_to_hom_map] using w)

/--
A morphism between target objects `T ⟶ T'`
covariantly induces a functor between costructured arrows,
`costructured_arrow S T ⥤ costructured_arrow S T'`.

Ideally this would be described as a 2-functor from `D`
(promoted to a 2-category with equations as 2-morphisms)
to `Cat`.
-/
@[simps]
def map (f : T ⟶ T') : costructured_arrow S T ⥤ costructured_arrow S T' :=
comma.map_right _ ((functor.const _).map f)

@[simp] lemma map_mk {f : S.obj Y ⟶ T} (g : T ⟶ T') :
  (map g).obj (mk f) = mk (f ≫ g) := rfl

@[simp] lemma map_id {f : costructured_arrow S T} : (map (𝟙 T)).obj f = f :=
by { rw eq_mk f, simp, }

@[simp] lemma map_comp {f : T ⟶ T'} {f' : T' ⟶ T''} {h : costructured_arrow S T} :
  (map (f ≫ f')).obj h = (map f').obj ((map f).obj h) :=
by { rw eq_mk h, simp, }

instance proj_reflects_iso : reflects_isomorphisms (proj S T) :=
{ reflects := λ Y Z f t, by exactI
  ⟨⟨costructured_arrow.hom_mk (inv ((proj S T).map f)) (by simp), by tidy⟩⟩ }

open category_theory.limits

local attribute [tidy] tactic.discrete_cases

/-- The identity costructured arrow is terminal. -/
def mk_id_terminal [full S] [faithful S] : is_terminal (mk (𝟙 (S.obj Y))) :=
{ lift := λ c, hom_mk (S.preimage c.X.hom) (by { dsimp, simp, }),
  uniq' := begin
    rintros c m -,
    ext,
    apply S.map_injective,
    simpa only [hom_mk_left, S.image_preimage, ←w m] using (category.comp_id _).symm,
  end }

variables {A : Type u₃} [category.{v₃} A] {B : Type u₄} [category.{v₄} B]

/-- The functor `(F ⋙ G, S) ⥤ (G, S)`. -/
@[simps]
def pre (F : B ⥤ C) (G : C ⥤ D) (S : D) : costructured_arrow (F ⋙ G) S ⥤ costructured_arrow G S :=
comma.pre_left F G _

/-- The functor `(F, S) ⥤ (F ⋙ G, G(S))`. -/
@[simps] def post (F : B ⥤ C) (G : C ⥤ D) (S : C) :
  costructured_arrow F S ⥤ costructured_arrow (F ⋙ G) (G.obj S) :=
{ obj := λ X, { left := X.left, hom := G.map X.hom },
  map := λ X Y f, { left := f.left, w' :=
    by { simp [functor.comp_map, ←G.map_comp, ← f.w] } } }

end costructured_arrow

open opposite

namespace structured_arrow

/--
For a functor `F : C ⥤ D` and an object `d : D`, we obtain a contravariant functor from the
category of structured arrows `d ⟶ F.obj c` to the category of costructured arrows
`F.op.obj c ⟶ (op d)`.
-/
@[simps]
def to_costructured_arrow (F : C ⥤ D) (d : D) :
  (structured_arrow d F)ᵒᵖ ⥤ costructured_arrow F.op (op d) :=
{ obj := λ X, @costructured_arrow.mk _ _ _ _ _ (op X.unop.right) F.op X.unop.hom.op,
  map := λ X Y f, costructured_arrow.hom_mk (f.unop.right.op)
  begin
    dsimp,
    rw [← op_comp, ← f.unop.w, functor.const.obj_map],
    erw category.id_comp,
  end }

/--
For a functor `F : C ⥤ D` and an object `d : D`, we obtain a contravariant functor from the
category of structured arrows `op d ⟶ F.op.obj c` to the category of costructured arrows
`F.obj c ⟶ d`.
-/
@[simps]
def to_costructured_arrow' (F : C ⥤ D) (d : D) :
  (structured_arrow (op d) F.op)ᵒᵖ ⥤ costructured_arrow F d :=
{ obj := λ X, @costructured_arrow.mk _ _ _ _ _ (unop X.unop.right) F X.unop.hom.unop,
  map := λ X Y f, costructured_arrow.hom_mk f.unop.right.unop
  begin
    dsimp,
    rw [← quiver.hom.unop_op (F.map (quiver.hom.unop f.unop.right)), ← unop_comp, ← F.op_map,
      ← f.unop.w, functor.const.obj_map],
    erw category.id_comp,
  end }

end structured_arrow

namespace costructured_arrow

/--
For a functor `F : C ⥤ D` and an object `d : D`, we obtain a contravariant functor from the
category of costructured arrows `F.obj c ⟶ d` to the category of structured arrows
`op d ⟶ F.op.obj c`.
-/
@[simps]
def to_structured_arrow (F : C ⥤ D) (d : D) :
  (costructured_arrow F d)ᵒᵖ ⥤ structured_arrow (op d) F.op :=
{ obj := λ X, @structured_arrow.mk _ _ _ _ _ (op X.unop.left) F.op X.unop.hom.op,
  map := λ X Y f, structured_arrow.hom_mk f.unop.left.op
  begin
    dsimp,
    rw [← op_comp, f.unop.w, functor.const.obj_map],
    erw category.comp_id,
  end }

/--
For a functor `F : C ⥤ D` and an object `d : D`, we obtain a contravariant functor from the
category of costructured arrows `F.op.obj c ⟶ op d` to the category of structured arrows
`d ⟶ F.obj c`.
-/
@[simps]
def to_structured_arrow' (F : C ⥤ D) (d : D) :
  (costructured_arrow F.op (op d))ᵒᵖ ⥤ structured_arrow d F :=
{ obj := λ X, @structured_arrow.mk _ _ _ _ _ (unop X.unop.left) F X.unop.hom.unop,
  map := λ X Y f, structured_arrow.hom_mk (f.unop.left.unop)
  begin
    dsimp,
    rw [← quiver.hom.unop_op (F.map f.unop.left.unop), ← unop_comp, ← F.op_map,
      f.unop.w, functor.const.obj_map],
    erw category.comp_id,
  end }

end costructured_arrow

/--
For a functor `F : C ⥤ D` and an object `d : D`, the category of structured arrows `d ⟶ F.obj c`
is contravariantly equivalent to the category of costructured arrows `F.op.obj c ⟶ op d`.
-/
def structured_arrow_op_equivalence (F : C ⥤ D) (d : D) :
  (structured_arrow d F)ᵒᵖ ≌ costructured_arrow F.op (op d) :=
equivalence.mk (structured_arrow.to_costructured_arrow F d)
  (costructured_arrow.to_structured_arrow' F d).right_op
  (nat_iso.of_components (λ X, (@structured_arrow.iso_mk _ _ _ _ _ _
    (structured_arrow.mk (unop X).hom) (unop X) (iso.refl _) (by tidy)).op)
    (λ X Y f, quiver.hom.unop_inj $ begin ext, dsimp, simp end))
  (nat_iso.of_components (λ X, @costructured_arrow.iso_mk _ _ _ _ _ _
    (costructured_arrow.mk X.hom) X (iso.refl _) (by tidy))
    (λ X Y f, begin ext, dsimp, simp end))

/--
For a functor `F : C ⥤ D` and an object `d : D`, the category of costructured arrows
`F.obj c ⟶ d` is contravariantly equivalent to the category of structured arrows
`op d ⟶ F.op.obj c`.
-/
def costructured_arrow_op_equivalence (F : C ⥤ D) (d : D) :
  (costructured_arrow F d)ᵒᵖ ≌ structured_arrow (op d) F.op :=
equivalence.mk (costructured_arrow.to_structured_arrow F d)
  (structured_arrow.to_costructured_arrow' F d).right_op
  (nat_iso.of_components (λ X, (@costructured_arrow.iso_mk _ _ _ _ _ _
    (costructured_arrow.mk (unop X).hom) (unop X) (iso.refl _) (by tidy)).op)
    (λ X Y f, quiver.hom.unop_inj $ begin ext, dsimp, simp end))
  (nat_iso.of_components (λ X, @structured_arrow.iso_mk _ _ _ _ _ _
    (structured_arrow.mk X.hom) X (iso.refl _) (by tidy))
    (λ X Y f, begin ext, dsimp, simp end))

end category_theory


macro "ext_tactic" t:tactic "=>" newT:tactic : command => `(macro_rules | `(tactic| $t) => `(tactic| $newT))

syntax "trivial'" : tactic

ext_tactic trivial' => apply Eq.refl

theorem tst1 (x : Nat) : x = x :=
by trivial'

-- theorem tst2 (x y : Nat) (h : x = y) : x = y :=
-- by trivial' -- fail as expected

ext_tactic trivial' => assumption

theorem tst1b (x : Nat) : x = x :=
by trivial' -- still works

theorem tst2 (x y : Nat) (h : x = y) : x = y :=
by trivial' -- works too


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.field_theory.finite.basic
import Mathlib.field_theory.mv_polynomial
import Mathlib.data.mv_polynomial.expand
import Mathlib.linear_algebra.basic
import Mathlib.PostPort

universes u_1 u_2 u

namespace Mathlib

/-!
## Polynomials over finite fields
-/

namespace mv_polynomial

/-- A polynomial over the integers is divisible by `n : ℕ`
if and only if it is zero over `zmod n`. -/
theorem C_dvd_iff_zmod {σ : Type u_1} (n : ℕ) (φ : mv_polynomial σ ℤ) :
    coe_fn C ↑n ∣ φ ↔ coe_fn (map (int.cast_ring_hom (zmod n))) φ = 0 :=
  C_dvd_iff_map_hom_eq_zero (int.cast_ring_hom (zmod n)) (↑n)
    (char_p.int_cast_eq_zero_iff (zmod n) n) φ

theorem frobenius_zmod {σ : Type u_1} {p : ℕ} [fact (nat.prime p)] (f : mv_polynomial σ (zmod p)) :
    coe_fn (frobenius (mv_polynomial σ (zmod p)) p) f = coe_fn (expand p) f :=
  sorry

theorem expand_zmod {σ : Type u_1} {p : ℕ} [fact (nat.prime p)] (f : mv_polynomial σ (zmod p)) :
    coe_fn (expand p) f = f ^ p :=
  Eq.symm (frobenius_zmod f)

end mv_polynomial

namespace mv_polynomial

def indicator {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ] (a : σ → K) :
    mv_polynomial σ K :=
  finset.prod finset.univ fun (n : σ) => 1 - (X n - coe_fn C (a n)) ^ (fintype.card K - 1)

theorem eval_indicator_apply_eq_one {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ]
    (a : σ → K) : coe_fn (eval a) (indicator a) = 1 :=
  sorry

theorem eval_indicator_apply_eq_zero {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ]
    (a : σ → K) (b : σ → K) (h : a ≠ b) : coe_fn (eval a) (indicator b) = 0 :=
  sorry

theorem degrees_indicator {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ]
    (c : σ → K) :
    degrees (indicator c) ≤
        finset.sum finset.univ fun (s : σ) => (fintype.card K - 1) •ℕ singleton s :=
  sorry

theorem indicator_mem_restrict_degree {K : Type u_1} {σ : Type u_2} [field K] [fintype K]
    [fintype σ] (c : σ → K) : indicator c ∈ restrict_degree σ K (fintype.card K - 1) :=
  sorry

def evalₗ (K : Type u_1) (σ : Type u_2) [field K] [fintype K] [fintype σ] :
    linear_map K (mv_polynomial σ K) ((σ → K) → K) :=
  linear_map.mk (fun (p : mv_polynomial σ K) (e : σ → K) => coe_fn (eval e) p) sorry sorry

theorem evalₗ_apply {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ]
    (p : mv_polynomial σ K) (e : σ → K) : coe_fn (evalₗ K σ) p e = coe_fn (eval e) p :=
  rfl

theorem map_restrict_dom_evalₗ {K : Type u_1} {σ : Type u_2} [field K] [fintype K] [fintype σ] :
    submodule.map (evalₗ K σ) (restrict_degree σ K (fintype.card K - 1)) = ⊤ :=
  sorry

end mv_polynomial

namespace mv_polynomial

def R (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K] :=
  ↥(restrict_degree σ K (fintype.card K - 1))

protected instance decidable_restrict_degree (σ : Type u) [fintype σ] (m : ℕ) :
    decidable_pred fun (n : σ →₀ ℕ) => n ∈ set_of fun (n : σ →₀ ℕ) => ∀ (i : σ), coe_fn n i ≤ m :=
  eq.mpr sorry fun (a : σ →₀ ℕ) => fintype.decidable_forall_fintype

theorem dim_R (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K] :
    vector_space.dim K (R σ K) = ↑(fintype.card (σ → K)) :=
  sorry

def evalᵢ (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K] :
    linear_map K (R σ K) ((σ → K) → K) :=
  linear_map.comp (evalₗ K σ) (submodule.subtype (restrict_degree σ K (fintype.card K - 1)))

theorem range_evalᵢ (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K] :
    linear_map.range (evalᵢ σ K) = ⊤ :=
  sorry

theorem ker_evalₗ (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K] :
    linear_map.ker (evalᵢ σ K) = ⊥ :=
  sorry

theorem eq_zero_of_eval_eq_zero (σ : Type u) (K : Type u) [fintype σ] [field K] [fintype K]
    (p : mv_polynomial σ K) (h : ∀ (v : σ → K), coe_fn (eval v) p = 0)
    (hp : p ∈ restrict_degree σ K (fintype.card K - 1)) : p = 0 :=
  sorry

end Mathlib


/-
Copyright (c) 2014 Robert Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies

! This file was ported from Lean 3 source module algebra.order.field.pi
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Order.Field.Basic
import Mathbin.Data.Fintype.Lattice

/-!
# Lemmas about (finite domain) functions into fields.

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

We split this from `algebra.order.field.basic` to avoid importing the finiteness hierarchy there.
-/

variable {α ι : Type _} [LinearOrderedSemifield α]

/- warning: pi.exists_forall_pos_add_lt -> Pi.exists_forall_pos_add_lt is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {ι : Type.{u2}} [_inst_1 : LinearOrderedSemifield.{u1} α] [_inst_2 : ExistsAddOfLE.{u1} α (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1)))))))) (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelAddCommMonoid.toPartialOrder.{u1} α (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1)))))))] [_inst_3 : Finite.{succ u2} ι] {x : ι -> α} {y : ι -> α}, (forall (i : ι), LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelAddCommMonoid.toPartialOrder.{u1} α (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))) (x i) (y i)) -> (Exists.{succ u1} α (fun (ε : α) => And (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelAddCommMonoid.toPartialOrder.{u1} α (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))))) ε) (forall (i : ι), LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (OrderedCancelAddCommMonoid.toPartialOrder.{u1} α (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))) (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonAssocSemiring.{u1} α (StrictOrderedSemiring.toSemiring.{u1} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} α _inst_1))))))))) (x i) ε) (y i))))
but is expected to have type
  forall {α : Type.{u2}} {ι : Type.{u1}} [_inst_1 : LinearOrderedSemifield.{u2} α] [_inst_2 : ExistsAddOfLE.{u2} α (Distrib.toAdd.{u2} α (NonUnitalNonAssocSemiring.toDistrib.{u2} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} α (Semiring.toNonAssocSemiring.{u2} α (StrictOrderedSemiring.toSemiring.{u2} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u2} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u2} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u2} α _inst_1)))))))) (Preorder.toLE.{u2} α (PartialOrder.toPreorder.{u2} α (StrictOrderedSemiring.toPartialOrder.{u2} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u2} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u2} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u2} α _inst_1))))))] [_inst_3 : Finite.{succ u1} ι] {x : ι -> α} {y : ι -> α}, (forall (i : ι), LT.lt.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (StrictOrderedSemiring.toPartialOrder.{u2} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u2} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u2} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u2} α _inst_1)))))) (x i) (y i)) -> (Exists.{succ u2} α (fun (ε : α) => And (LT.lt.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (StrictOrderedSemiring.toPartialOrder.{u2} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u2} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u2} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u2} α _inst_1)))))) (OfNat.ofNat.{u2} α 0 (Zero.toOfNat0.{u2} α (CommMonoidWithZero.toZero.{u2} α (CommGroupWithZero.toCommMonoidWithZero.{u2} α (Semifield.toCommGroupWithZero.{u2} α (LinearOrderedSemifield.toSemifield.{u2} α _inst_1)))))) ε) (forall (i : ι), LT.lt.{u2} α (Preorder.toLT.{u2} α (PartialOrder.toPreorder.{u2} α (StrictOrderedSemiring.toPartialOrder.{u2} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u2} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u2} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u2} α _inst_1)))))) (HAdd.hAdd.{u2, u2, u2} α α α (instHAdd.{u2} α (Distrib.toAdd.{u2} α (NonUnitalNonAssocSemiring.toDistrib.{u2} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} α (Semiring.toNonAssocSemiring.{u2} α (StrictOrderedSemiring.toSemiring.{u2} α (LinearOrderedSemiring.toStrictOrderedSemiring.{u2} α (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u2} α (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u2} α _inst_1))))))))) (x i) ε) (y i))))
Case conversion may be inaccurate. Consider using '#align pi.exists_forall_pos_add_lt Pi.exists_forall_pos_add_ltₓ'. -/
theorem Pi.exists_forall_pos_add_lt [ExistsAddOfLE α] [Finite ι] {x y : ι → α}
    (h : ∀ i, x i < y i) : ∃ ε, 0 < ε ∧ ∀ i, x i + ε < y i :=
  by
  cases nonempty_fintype ι
  cases isEmpty_or_nonempty ι
  · exact ⟨1, zero_lt_one, isEmptyElim⟩
  choose ε hε hxε using fun i => exists_pos_add_of_lt' (h i)
  obtain rfl : x + ε = y := funext hxε
  have hε : 0 < finset.univ.inf' Finset.univ_nonempty ε := (Finset.lt_inf'_iff _).2 fun i _ => hε _
  exact
    ⟨_, half_pos hε, fun i =>
      add_lt_add_left ((half_lt_self hε).trans_le <| Finset.inf'_le _ <| Finset.mem_univ _) _⟩
#align pi.exists_forall_pos_add_lt Pi.exists_forall_pos_add_lt


/- Author: E.W.Ayers
   Show that the open covers for a topological space form a basis for a grothendieck topology.
 -/
import topology.category.Top.opens
import category_theory.limits.lattice
import category_theory.limits.limits
import category_theory.limits.shapes.pullbacks
import .grothendieck

universes u
open category_theory
open topological_space
open category_theory.limits

namespace topological_space.opens

/- [TODO] this is probably in mathlib somewhere. -/
/-- `covers X U ℱ` means that ℱ is an open cover of U. -/
def covers (X : Top) : arrow_set (opens X) :=
λ U ℱ, ∀ (x : X) (xU : x ∈ U), ∃ (V : over U), V ∈ ℱ ∧ x ∈ V.left

variables {X : Top}

instance opens_has_limits : @has_limits (opens X) (opens.opens_category) :=
limits.has_limits_of_complete_lattice

instance opens_has_pullbacks : @has_pullbacks (opens X) (opens.opens_category) :=
⟨@has_limits.has_limits_of_shape _ _ opens.opens_has_limits _ _⟩

instance opens_has_cospan_limits {U V W : opens X} {f : U ⟶ W} {g : V ⟶ W} : has_limit (cospan f g) :=
@has_limits_of_shape.has_limit _ _ _ _ (@has_limits.has_limits_of_shape _ _ opens.opens_has_limits _ _) _

variables {U V W : opens X}

/- [todo] this can be moved to category_theory/limits/lattice -/
lemma eq_of_iso (e : U ≅ W) : U = W :=
begin
    rcases e with ⟨⟨⟨_⟩⟩,⟨⟨_⟩⟩,_,_⟩,
    apply partial_order.le_antisymm,
    assumption,
    assumption
end

lemma over_eq_of_left_eq : Π {f g : over U}, f.left = g.left → f = g
| ⟨_,⟨⟩,⟨⟨_⟩⟩⟩ ⟨_,⟨⟩,⟨⟨_⟩⟩⟩ rfl := rfl

open lattice
/- [todo] this can be moved to category_theory/limits/lattice -/
lemma pullback_is_inter {f : U ⟶ W} {g : V ⟶ W} : pullback f g = U ⊓ V :=
begin
    apply eq_of_iso,
    rcases (pullback.fst : pullback f g ⟶ U) with ⟨⟨π1⟩⟩,
    rcases (pullback.snd : pullback f g ⟶ V) with ⟨⟨π2⟩⟩,
    refine ⟨⟨⟨le_inf π1 π2⟩⟩,pullback.lift ⟨⟨inf_le_left⟩⟩ ⟨⟨inf_le_right⟩⟩ rfl,rfl,rfl⟩,
end

instance : grothendieck.basis (covers X) :=
{ has_isos :=
    begin
        -- all isos in opens U are equality.
        intros U V e x xU,
        refine ⟨over.mk e.hom, _,_⟩,
        simp,
        have : U = V, apply eq_of_iso e,
        simpa [this],
    end,
  has_pullbacks :=
    begin
        -- idea: ℱ is covering for U
        -- ⇒ {V ∩ W | W ∈ ℱ} is a covering for V
        intros U V ℱ h₁ g,
        intros x xV,
        rcases g with ⟨⟨g⟩⟩,
        rcases h₁ x (g xV) with ⟨f,fF,xf⟩,
        refine ⟨over.mk ⟨⟨inf_le_right⟩⟩,⟨f,fF,_⟩,⟨xf,xV⟩⟩,
        apply over_eq_of_left_eq,
            simp [over.pullback],
            rw pullback_is_inter,
            rw inf_comm, refl,
    end,
  trans :=
    begin
        -- idea: ℱ covers U and 𝒢 U covers V for each V ∈ ℱ
        -- ⇒ ⋃ 𝒢 covers U
        intros U,
        rintros _ FcU _ GcF x xU,
        rcases FcU x xU with ⟨V,VF,xV⟩,
        rcases GcF VF x xV with ⟨W,WG,xW⟩,
        refine ⟨over.mk (W.hom ≫ V.hom),⟨_,VF,⟨W,WG,rfl⟩⟩,xW⟩,
    end
}

def covering_sieve (X : Top):= sieve_set.generate (covers X)

instance : grothendieck (covering_sieve X) :=
grothendieck.of_basis

end topological_space.opens


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

! This file was ported from Lean 3 source module tactic.expand_exists
! leanprover-community/mathlib commit f9153b8a79eb28d07341706ddb18c02593eeb72a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Meta.Expr

/-!
# `expand_exists`

`expand_exists` is an attribute which takes a proof that something exists with some property, and
outputs a value using `classical.some`, and a proof that it has that property using
`classical.some_spec`. For example:

```lean
@[expand_exists it it_spec]
lemma it_exists (n : ℕ) : ∃ m : ℕ, n < m := sorry
```

produces

```
def it (n : ℕ) : ℕ := classical.some (it_exists n)

lemma it_spec (n : ℕ) : n < it n := classical.some_spec (it_exists n)
```
-/

namespace Tactic

open Expr

namespace ExpandExists

/-- Data known when parsing pi expressions.

`decl`'s arguments are: is_theorem, name, type, value.
-/
unsafe structure parse_ctx where
  original_decl : declaration
  decl : Bool → Name → expr → pexpr → tactic Unit
  names : List Name
  pis_depth : ℕ := 0
#align tactic.expand_exists.parse_ctx tactic.expand_exists.parse_ctx

/-- Data known when parsing exists expressions (after parsing pi expressions).

* `with_args` applies pi arguments to a term (eg `id` -> `id #2 #1 #0`).
* `spec_chain` takes the form of `classical.some_spec^n (it_exists ...)`,
with `n` the depth of `∃` parsed.
* `exists_decls` is a list of declarations containing the value(s) of witnesses.
-/
unsafe structure parse_ctx_exists extends parse_ctx where
  with_args : expr → expr
  spec_chain : pexpr
  exists_decls : List Name := []
#align tactic.expand_exists.parse_ctx_exists tactic.expand_exists.parse_ctx_exists

/-- Data known when parsing the proposition (after parsing exists and pi expressions).

`project_proof` projects a proof of the full proposition (eg `A ∧ B ∧ C`) to a specific proof (eg
`B`).
-/
unsafe structure parse_ctx_props extends parse_ctx_exists where
  project_proof : pexpr → pexpr := id
#align tactic.expand_exists.parse_ctx_props tactic.expand_exists.parse_ctx_props

/-- Replaces free variables with their exists declaration. For example, if:

```lean
def n_value : ℕ := ... -- generated by `expand_exists`
```

then this function converts `#0` in `#0 = #0` from `∃ n : ℕ, n = n` to `n_value = n_value`.
-/
unsafe def instantiate_exists_decls (ctx : parse_ctx_exists) (p : expr) : expr :=
  p.instantiate_vars <|
    ctx.exists_decls.reverse.map fun name =>
      ctx.with_args (const Name ctx.original_decl.univ_levels)
#align tactic.expand_exists.instantiate_exists_decls tactic.expand_exists.instantiate_exists_decls

/-- Parses a proposition and creates the associated specification proof. Does not break down the
proposition further.
-/
unsafe def parse_one_prop (ctx : parse_ctx_props) (p : expr) : tactic Unit := do
  let p : expr := instantiate_exists_decls { ctx with } p
  let val : pexpr := ctx.project_proof ctx.spec_chain
  let n ←
    match ctx.names with
      | [n] => return n
      | [] => fail "missing name for proposition"
      | _ => fail "too many names for propositions (are you missing an and?)"
  ctx True n p val
#align tactic.expand_exists.parse_one_prop tactic.expand_exists.parse_one_prop

/--
Parses a proposition and decides if it should be broken down (eg `P ∧ Q` -> `P` and `Q`) depending
on how many `names` are left. Then creates the associated specification proof(s).
-/
unsafe def parse_props : parse_ctx_props → expr → tactic Unit
  | ctx, app (app (const "and" []) p) q => do
    match ctx with
      | [n] => parse_one_prop ctx (app (app (const `and []) p) q)
      | n :: tail =>
        parse_one_prop
            { ctx with
              names := [n]
              project_proof := (fun p => (const `and.left []) p) ∘ ctx }
            p >>
          parse_props
            { ctx with
              names := tail
              project_proof := (fun p => (const `and.right []) p) ∘ ctx }
            q
      | [] => fail "missing name for proposition"
  | ctx, p => parse_one_prop ctx p
#align tactic.expand_exists.parse_props tactic.expand_exists.parse_props

/--
Parses an `∃ a : α, p a`, and creates an associated definition with a value of `α`. When `p α` is
not an exists statement, it will call `parse_props`.
-/
unsafe def parse_exists : parse_ctx_exists → expr → tactic Unit
  | ctx, app (app (const "Exists" [lvl]) type) (lam var_name bi var_type body) => do
    -- TODO: Is this needed, and/or does this create issues?
        if type = var_type then tactic.skip
      else tactic.fail "exists types should be equal"
    let ⟨n, names⟩ ←
      match ctx.names with
        | n :: tail => return (n, tail)
        | [] => fail "missing name for exists"
    let-- Type may be dependant on earlier arguments.
    type := instantiate_exists_decls ctx type
    let value : pexpr := (const `classical.some [lvl]) ctx.spec_chain
    ctx False n type value
    let exists_decls := ctx.exists_decls.concat n
    let some_spec : pexpr := (const `classical.some_spec [lvl]) ctx.spec_chain
    let ctx : parse_ctx_exists :=
      { ctx with
        names
        spec_chain := some_spec
        exists_decls }
    parse_exists ctx body
  | ctx, e => parse_props { ctx with } e
#align tactic.expand_exists.parse_exists tactic.expand_exists.parse_exists

/-- Parses a `∀ (a : α), p a`. If `p` is not a pi expression, it will call `parse_exists`
-/
unsafe def parse_pis : parse_ctx → expr → tactic Unit
  | ctx,
    pi n bi ty body =>-- When making a declaration, wrap in an equivalent pi expression.
    let decl is_theorem name type val :=
      ctx.decl is_theorem Name (pi n bi ty type) (lam n bi (to_pexpr ty) val)
    parse_pis
      { ctx with
        decl
        pis_depth := ctx.pis_depth + 1 }
      body
  | ctx, app (app (const "Exists" [lvl]) type) p =>
    let with_args := fun e : expr =>
      (List.range ctx.pis_depth).foldr (fun n (e : expr) => e (var n)) e
    parse_exists
      { ctx with
        with_args
        spec_chain :=
          to_pexpr (with_args <| const ctx.original_decl.to_name ctx.original_decl.univ_levels) }
      (app (app (const "Exists" [lvl]) type) p)
  | ctx, e => fail ("unexpected expression " ++ toString e)
#align tactic.expand_exists.parse_pis tactic.expand_exists.parse_pis

end ExpandExists

/-- From a proof that (a) value(s) exist(s) with certain properties, constructs (an) instance(s)
satisfying those properties. For instance:

```lean
@[expand_exists nat_greater nat_greater_spec]
lemma nat_greater_exists (n : ℕ) : ∃ m : ℕ, n < m := ...

#check nat_greater      -- nat_greater : ℕ → ℕ
#check nat_greater_spec -- nat_greater_spec : ∀ (n : ℕ), n < nat_greater n
```

It supports multiple witnesses:

```lean
@[expand_exists nat_greater_m nat_greater_l nat_greater_spec]
lemma nat_greater_exists (n : ℕ) : ∃ (m l : ℕ), n < m ∧ m < l := ...

#check nat_greater_m      -- nat_greater : ℕ → ℕ
#check nat_greater_l      -- nat_greater : ℕ → ℕ
#check nat_greater_spec-- nat_greater_spec : ∀ (n : ℕ),
  n < nat_greater_m n ∧ nat_greater_m n < nat_greater_l n
```

It also supports logical conjunctions:
```lean
@[expand_exists nat_greater nat_greater_lt nat_greater_nonzero]
lemma nat_greater_exists (n : ℕ) : ∃ m : ℕ, n < m ∧ m ≠ 0 := ...

#check nat_greater         -- nat_greater : ℕ → ℕ
#check nat_greater_lt      -- nat_greater_lt : ∀ (n : ℕ), n < nat_greater n
#check nat_greater_nonzero -- nat_greater_nonzero : ∀ (n : ℕ), nat_greater n ≠ 0
```
Note that without the last argument `nat_greater_nonzero`, `nat_greater_lt` would be:
```lean
#check nat_greater_lt -- nat_greater_lt : ∀ (n : ℕ), n < nat_greater n ∧ nat_greater n ≠ 0
```
-/
@[user_attribute]
unsafe def expand_exists_attr : user_attribute Unit (List Name)
    where
  Name := "expand_exists"
  descr :=
    "From a proof that (a) value(s) exist(s) with certain properties, " ++
      "constructs (an) instance(s) satisfying those properties."
  parser := lean.parser.many lean.parser.ident
  after_set :=
    some fun decl prio persistent => do
      let d ← get_decl decl
      let names ← expand_exists_attr.get_param decl
      expand_exists.parse_pis
          { original_decl := d
            decl := fun is_t n ty val =>
              tactic.to_expr val >>= fun val =>
                tactic.add_decl
                  (if is_t then declaration.thm n d ty (pure val)
                  else declaration.defn n d ty val default tt)
            names } d
#align tactic.expand_exists_attr tactic.expand_exists_attr

add_tactic_doc
  { Name := "expand_exists"
    category := DocCategory.attr
    declNames := [`tactic.expand_exists_attr]
    tags := ["lemma derivation", "environment"] }

end Tactic


/-
Copyright (c) 2022 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.limits.shapes.kernels
import category_theory.limits.preserves.shapes.equalizers
import category_theory.limits.preserves.shapes.zero

/-!
# Preserving (co)kernels

Constructions to relate the notions of preserving (co)kernels and reflecting (co)kernels
to concrete (co)forks.

In particular, we show that `kernel_comparison f g G` is an isomorphism iff `G` preserves
the limit of the parallel pair `f,0`, as well as the dual result.
-/

noncomputable theory

universes v u₁ u₂

open category_theory category_theory.category category_theory.limits

variables {C : Type u₁} [category.{v} C] [has_zero_morphisms C]
variables {D : Type u₂} [category.{v} D] [has_zero_morphisms D]
variables (G : C ⥤ D) [functor.preserves_zero_morphisms G]

namespace category_theory.limits

section kernels
variables {X Y Z : C} {f : X ⟶ Y} {h : Z ⟶ X} (w : h ≫ f = 0)

/--
The map of a kernel fork is a limit iff
the kernel fork consisting of the mapped morphisms is a limit.
This essentially lets us commute `kernel_fork.of_ι` with `functor.map_cone`.

This is a variant of `is_limit_map_cone_fork_equiv` for equalizers,
which we can't use directly between `G.map 0 = 0` does not hold definitionally.
-/
def is_limit_map_cone_fork_equiv' :
  is_limit (G.map_cone (kernel_fork.of_ι h w)) ≃
  is_limit (kernel_fork.of_ι (G.map h) (by simp only [←G.map_comp, w, functor.map_zero])
    : fork (G.map f) 0) :=
begin
  refine (is_limit.postcompose_hom_equiv _ _).symm.trans (is_limit.equiv_iso_limit _),
  refine parallel_pair.ext (iso.refl _) (iso.refl _) _ _; simp,
  refine fork.ext (iso.refl _) _,
  simp [fork.ι]
end

/--
The property of preserving kernels expressed in terms of kernel forks.

This is a variant of `is_limit_fork_map_of_is_limit` for equalizers,
which we can't use directly between `G.map 0 = 0` does not hold definitionally.
-/
def is_limit_fork_map_of_is_limit' [preserves_limit (parallel_pair f 0) G]
  (l : is_limit (kernel_fork.of_ι h w)) :
  is_limit (kernel_fork.of_ι (G.map h) (by simp only [←G.map_comp, w, functor.map_zero]) :
    fork (G.map f) 0) :=
is_limit_map_cone_fork_equiv' G w (preserves_limit.preserves l)

variables (f) [has_kernel f]

/--
If `G` preserves kernels and `C` has them, then the fork constructed of the mapped morphisms of
a kernel fork is a limit.
-/
def is_limit_of_has_kernel_of_preserves_limit [preserves_limit (parallel_pair f 0) G] :
  is_limit (fork.of_ι (G.map (kernel.ι f))
    (by simp only [←G.map_comp, equalizer.condition, comp_zero, functor.map_zero])
      : fork (G.map f) 0) :=
is_limit_fork_map_of_is_limit' G (kernel.condition f) (kernel_is_kernel f)

instance [preserves_limit (parallel_pair f 0) G] : has_kernel (G.map f) :=
{ exists_limit := ⟨⟨_, is_limit_of_has_kernel_of_preserves_limit G f⟩⟩, }

variables [has_kernel (G.map f)]

/--
If the kernel comparison map for `G` at `f` is an isomorphism, then `G` preserves the
kernel of `f`.
-/
def preserves_kernel.of_iso_comparison [i : is_iso (kernel_comparison f G)] :
  preserves_limit (parallel_pair f 0) G :=
begin
  apply preserves_limit_of_preserves_limit_cone (kernel_is_kernel f),
  apply (is_limit_map_cone_fork_equiv' G (kernel.condition f)).symm _,
  apply is_limit.of_point_iso (limit.is_limit (parallel_pair (G.map f) 0)),
  apply i,
end

variables [preserves_limit (parallel_pair f 0) G]
/--
If `G` preserves the kernel of `f`, then the kernel comparison map for `G` at `f` is
an isomorphism.
-/
def preserves_kernel.iso :
  G.obj (kernel f) ≅ kernel (G.map f) :=
is_limit.cone_point_unique_up_to_iso
  (is_limit_of_has_kernel_of_preserves_limit G f)
  (limit.is_limit _)

@[simp]
lemma preserves_kernel.iso_hom :
  (preserves_kernel.iso G f).hom = kernel_comparison f G :=
rfl

instance : is_iso (kernel_comparison f G) :=
begin
  rw ← preserves_kernel.iso_hom,
  apply_instance
end

end kernels

section cokernels

variables {X Y Z : C} {f : X ⟶ Y} {h : Y ⟶ Z} (w : f ≫ h = 0)

/--
The map of a cokernel cofork is a colimit iff
the cokernel cofork consisting of the mapped morphisms is a colimit.
This essentially lets us commute `cokernel_cofork.of_π` with `functor.map_cocone`.

This is a variant of `is_colimit_map_cocone_cofork_equiv` for equalizers,
which we can't use directly between `G.map 0 = 0` does not hold definitionally.
-/
def is_colimit_map_cocone_cofork_equiv' :
  is_colimit (G.map_cocone (cokernel_cofork.of_π h w)) ≃
  is_colimit (cokernel_cofork.of_π (G.map h) (by simp only [←G.map_comp, w, functor.map_zero])
    : cofork (G.map f) 0) :=
begin
  refine (is_colimit.precompose_hom_equiv _ _).symm.trans (is_colimit.equiv_iso_colimit _),
  refine parallel_pair.ext (iso.refl _) (iso.refl _) _ _; simp,
  refine cofork.ext (iso.refl _) _,
  simp only [cofork.π, iso.refl_hom, id_comp, cocones.precompose_obj_ι,
    nat_trans.comp_app, parallel_pair.ext_hom_app, functor.map_cocone_ι_app,
    cofork.of_π_ι_app],
  apply category.comp_id
end

/--
The property of preserving cokernels expressed in terms of cokernel coforks.

This is a variant of `is_colimit_cofork_map_of_is_colimit` for equalizers,
which we can't use directly between `G.map 0 = 0` does not hold definitionally.
-/
def is_colimit_cofork_map_of_is_colimit' [preserves_colimit (parallel_pair f 0) G]
  (l : is_colimit (cokernel_cofork.of_π h w)) :
  is_colimit (cokernel_cofork.of_π (G.map h) (by simp only [←G.map_comp, w, functor.map_zero]) :
    cofork (G.map f) 0) :=
is_colimit_map_cocone_cofork_equiv' G w (preserves_colimit.preserves l)

variables (f) [has_cokernel f]

/--
If `G` preserves cokernels and `C` has them, then the cofork constructed of the mapped morphisms of
a cokernel cofork is a colimit.
-/
def is_colimit_of_has_cokernel_of_preserves_colimit [preserves_colimit (parallel_pair f 0) G] :
  is_colimit (cofork.of_π (G.map (cokernel.π f))
    (by simp only [←G.map_comp, coequalizer.condition, zero_comp, functor.map_zero])
      : cofork (G.map f) 0) :=
is_colimit_cofork_map_of_is_colimit' G (cokernel.condition f) (cokernel_is_cokernel f)

instance [preserves_colimit (parallel_pair f 0) G] : has_cokernel (G.map f) :=
{ exists_colimit := ⟨⟨_, is_colimit_of_has_cokernel_of_preserves_colimit G f⟩⟩, }

variables [has_cokernel (G.map f)]

/--
If the cokernel comparison map for `G` at `f` is an isomorphism, then `G` preserves the
cokernel of `f`.
-/
def preserves_cokernel.of_iso_comparison [i : is_iso (cokernel_comparison f G)] :
  preserves_colimit (parallel_pair f 0) G :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone (cokernel_is_cokernel f),
  apply (is_colimit_map_cocone_cofork_equiv' G (cokernel.condition f)).symm _,
  apply is_colimit.of_point_iso (colimit.is_colimit (parallel_pair (G.map f) 0)),
  apply i,
end

variables [preserves_colimit (parallel_pair f 0) G]
/--
If `G` preserves the cokernel of `f`, then the cokernel comparison map for `G` at `f` is
an isomorphism.
-/
def preserves_cokernel.iso :
  G.obj (cokernel f) ≅ cokernel (G.map f) :=
is_colimit.cocone_point_unique_up_to_iso
  (is_colimit_of_has_cokernel_of_preserves_colimit G f)
  (colimit.is_colimit _)

@[simp]
lemma preserves_cokernel.iso_inv :
  (preserves_cokernel.iso G f).inv = cokernel_comparison f G :=
rfl

instance : is_iso (cokernel_comparison f G) :=
begin
  rw ← preserves_cokernel.iso_inv,
  apply_instance
end

end cokernels

end category_theory.limits


import tactic.lint

def f : ℕ → ℕ := default _
def c : ℕ := default _
def d : ℕ := default _

@[simp] lemma c_eq_d : c = d := rfl

-- The following lemma never applies when using simp, because c is first rewritten to d
@[simp] lemma f_c : f c = 0 := rfl

example : f c = 0 :=
begin
  simp,
  guard_target f d = 0, -- does not apply f_c
  refl
end

open tactic
run_cmd do
decl ← get_decl ``f_c,
res ← linter.simp_nf.test decl,
-- linter complains
guard $ res.is_some

-- also works with `coe_to_fun`

structure morphism :=
(f : ℕ → ℕ)

instance : has_coe_to_fun morphism :=
⟨_, morphism.f⟩

def h : morphism := ⟨default _⟩

-- Also never applies
@[simp] lemma h_c : h c = 0 := rfl

example : h c = 0 :=
begin
  simp,
  guard_target h d = 0, -- does not apply h_c
  refl
end

open tactic
run_cmd do
decl ← get_decl ``h_c,
res ← linter.simp_nf.test decl,
-- linter complains
guard $ res.is_some


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.basic
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4 u_5 u_6

namespace Mathlib

/-!
# Extra facts about `prod`

This file defines `prod.swap : α × β → β × α` and proves various simple lemmas about `prod`.
-/

@[simp] theorem prod_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} (f : α → γ)
    (g : β → δ) (p : α × β) : prod.map f g p = (f (prod.fst p), g (prod.snd p)) :=
  rfl

namespace prod

@[simp] theorem forall {α : Type u_1} {β : Type u_2} {p : α × β → Prop} :
    (∀ (x : α × β), p x) ↔ ∀ (a : α) (b : β), p (a, b) :=
  sorry

@[simp] theorem exists {α : Type u_1} {β : Type u_2} {p : α × β → Prop} :
    (∃ (x : α × β), p x) ↔ ∃ (a : α), ∃ (b : β), p (a, b) :=
  sorry

theorem forall' {α : Type u_1} {β : Type u_2} {p : α → β → Prop} :
    (∀ (x : α × β), p (fst x) (snd x)) ↔ ∀ (a : α) (b : β), p a b :=
  forall

theorem exists' {α : Type u_1} {β : Type u_2} {p : α → β → Prop} :
    (∃ (x : α × β), p (fst x) (snd x)) ↔ ∃ (a : α), ∃ (b : β), p a b :=
  exists

@[simp] theorem map_mk {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} (f : α → γ)
    (g : β → δ) (a : α) (b : β) : map f g (a, b) = (f a, g b) :=
  rfl

theorem map_fst {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} (f : α → γ) (g : β → δ)
    (p : α × β) : fst (map f g p) = f (fst p) :=
  rfl

theorem map_snd {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} (f : α → γ) (g : β → δ)
    (p : α × β) : snd (map f g p) = g (snd p) :=
  rfl

theorem map_fst' {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} (f : α → γ)
    (g : β → δ) : fst ∘ map f g = f ∘ fst :=
  funext (map_fst f g)

theorem map_snd' {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} (f : α → γ)
    (g : β → δ) : snd ∘ map f g = g ∘ snd :=
  funext (map_snd f g)

/--
Composing a `prod.map` with another `prod.map` is equal to
a single `prod.map` of composed functions.
-/
theorem map_comp_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} {ε : Type u_5}
    {ζ : Type u_6} (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) :
    map g g' ∘ map f f' = map (g ∘ f) (g' ∘ f') :=
  rfl

/--
Composing a `prod.map` with another `prod.map` is equal to
a single `prod.map` of composed functions, fully applied.
-/
theorem map_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} {ε : Type u_5}
    {ζ : Type u_6} (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) (x : α × γ) :
    map g g' (map f f' x) = map (g ∘ f) (g' ∘ f') x :=
  rfl

@[simp] theorem mk.inj_iff {α : Type u_1} {β : Type u_2} {a₁ : α} {a₂ : α} {b₁ : β} {b₂ : β} :
    (a₁, b₁) = (a₂, b₂) ↔ a₁ = a₂ ∧ b₁ = b₂ :=
  sorry

theorem mk.inj_left {α : Type u_1} {β : Type u_2} (a : α) : function.injective (Prod.mk a) := sorry

theorem mk.inj_right {α : Type u_1} {β : Type u_2} (b : β) :
    function.injective fun (a : α) => (a, b) :=
  sorry

theorem ext_iff {α : Type u_1} {β : Type u_2} {p : α × β} {q : α × β} :
    p = q ↔ fst p = fst q ∧ snd p = snd q :=
  sorry

theorem ext {α : Type u_1} {β : Type u_2} {p : α × β} {q : α × β} (h₁ : fst p = fst q)
    (h₂ : snd p = snd q) : p = q :=
  iff.mpr ext_iff { left := h₁, right := h₂ }

theorem map_def {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} {f : α → γ}
    {g : β → δ} : map f g = fun (p : α × β) => (f (fst p), g (snd p)) :=
  funext fun (p : α × β) => ext (map_fst f g p) (map_snd f g p)

theorem id_prod {α : Type u_1} : (fun (p : α × α) => (fst p, snd p)) = id := sorry

theorem fst_surjective {α : Type u_1} {β : Type u_2} [h : Nonempty β] : function.surjective fst :=
  fun (x : α) => nonempty.elim h fun (y : β) => Exists.intro (x, y) rfl

theorem snd_surjective {α : Type u_1} {β : Type u_2} [h : Nonempty α] : function.surjective snd :=
  fun (y : β) => nonempty.elim h fun (x : α) => Exists.intro (x, y) rfl

theorem fst_injective {α : Type u_1} {β : Type u_2} [subsingleton β] : function.injective fst :=
  fun (x y : α × β) (h : fst x = fst y) => ext h (subsingleton.elim (snd x) (snd y))

theorem snd_injective {α : Type u_1} {β : Type u_2} [subsingleton α] : function.injective snd :=
  fun (x y : α × β) (h : snd x = snd y) => ext (subsingleton.elim (fst x) (fst y)) h

/-- Swap the factors of a product. `swap (a, b) = (b, a)` -/
def swap {α : Type u_1} {β : Type u_2} : α × β → β × α := fun (p : α × β) => (snd p, fst p)

@[simp] theorem swap_swap {α : Type u_1} {β : Type u_2} (x : α × β) : swap (swap x) = x :=
  cases_on x
    fun (x_fst : α) (x_snd : β) =>
      idRhs (swap (swap (x_fst, x_snd)) = swap (swap (x_fst, x_snd))) rfl

@[simp] theorem fst_swap {α : Type u_1} {β : Type u_2} {p : α × β} : fst (swap p) = snd p := rfl

@[simp] theorem snd_swap {α : Type u_1} {β : Type u_2} {p : α × β} : snd (swap p) = fst p := rfl

@[simp] theorem swap_prod_mk {α : Type u_1} {β : Type u_2} {a : α} {b : β} : swap (a, b) = (b, a) :=
  rfl

@[simp] theorem swap_swap_eq {α : Type u_1} {β : Type u_2} : swap ∘ swap = id := funext swap_swap

@[simp] theorem swap_left_inverse {α : Type u_1} {β : Type u_2} : function.left_inverse swap swap :=
  swap_swap

@[simp] theorem swap_right_inverse {α : Type u_1} {β : Type u_2} :
    function.right_inverse swap swap :=
  swap_swap

theorem swap_injective {α : Type u_1} {β : Type u_2} : function.injective swap :=
  function.left_inverse.injective swap_left_inverse

theorem swap_surjective {α : Type u_1} {β : Type u_2} : function.surjective swap :=
  function.left_inverse.surjective swap_left_inverse

theorem swap_bijective {α : Type u_1} {β : Type u_2} : function.bijective swap :=
  { left := swap_injective, right := swap_surjective }

@[simp] theorem swap_inj {α : Type u_1} {β : Type u_2} {p : α × β} {q : α × β} :
    swap p = swap q ↔ p = q :=
  function.injective.eq_iff swap_injective

theorem eq_iff_fst_eq_snd_eq {α : Type u_1} {β : Type u_2} {p : α × β} {q : α × β} :
    p = q ↔ fst p = fst q ∧ snd p = snd q :=
  sorry

theorem fst_eq_iff {α : Type u_1} {β : Type u_2} {p : α × β} {x : α} : fst p = x ↔ p = (x, snd p) :=
  sorry

theorem snd_eq_iff {α : Type u_1} {β : Type u_2} {p : α × β} {x : β} : snd p = x ↔ p = (fst p, x) :=
  sorry

theorem lex_def {α : Type u_1} {β : Type u_2} (r : α → α → Prop) (s : β → β → Prop) {p : α × β}
    {q : α × β} : lex r s p q ↔ r (fst p) (fst q) ∨ fst p = fst q ∧ s (snd p) (snd q) :=
  sorry

protected instance lex.decidable {α : Type u_1} {β : Type u_2} [DecidableEq α] (r : α → α → Prop)
    (s : β → β → Prop) [DecidableRel r] [DecidableRel s] : DecidableRel (lex r s) :=
  fun (p q : α × β) => decidable_of_decidable_of_iff or.decidable sorry

end prod

theorem function.injective.prod_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4}
    {f : α → γ} {g : β → δ} (hf : function.injective f) (hg : function.injective g) :
    function.injective (prod.map f g) :=
  fun (x y : α × β) (h : prod.map f g x = prod.map f g y) =>
    prod.ext (hf (and.left (iff.mp prod.ext_iff h))) (hg (and.right (iff.mp prod.ext_iff h)))

theorem function.surjective.prod_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4}
    {f : α → γ} {g : β → δ} (hf : function.surjective f) (hg : function.surjective g) :
    function.surjective (prod.map f g) :=
  sorry

end Mathlib


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.monoidal.functor
import Mathlib.category_theory.full_subcategory
import Mathlib.PostPort

universes v₁ v₂ u₁ u₂ l u₃ v₃

namespace Mathlib

/-!
# Monoidal natural transformations

Natural transformations between (lax) monoidal functors must satisfy
an additional compatibility relation with the tensorators:
`F.μ X Y ≫ app (X ⊗ Y) = (app X ⊗ app Y) ≫ G.μ X Y`.

(Lax) monoidal functors between a fixed pair of monoidal categories
themselves form a category.
-/

namespace category_theory

/--
A monoidal natural transformation is a natural transformation between (lax) monoidal functors
additionally satisfying:
`F.μ X Y ≫ app (X ⊗ Y) = (app X ⊗ app Y) ≫ G.μ X Y`
-/
structure monoidal_nat_trans {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] (F : lax_monoidal_functor C D) (G : lax_monoidal_functor C D)
extends nat_trans (lax_monoidal_functor.to_functor F) (lax_monoidal_functor.to_functor G)
where
  unit' : autoParam (lax_monoidal_functor.ε F ≫ nat_trans.app _to_nat_trans 𝟙_ = lax_monoidal_functor.ε G)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  tensor' : autoParam
  (∀ (X Y : C),
    lax_monoidal_functor.μ F X Y ≫ nat_trans.app _to_nat_trans (X ⊗ Y) =
      (nat_trans.app _to_nat_trans X ⊗ nat_trans.app _to_nat_trans Y) ≫ lax_monoidal_functor.μ G X Y)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem monoidal_nat_trans.tensor {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} (c : monoidal_nat_trans F G) (X : C) (Y : C) : lax_monoidal_functor.μ F X Y ≫ nat_trans.app (monoidal_nat_trans.to_nat_trans c) (X ⊗ Y) =
  (nat_trans.app (monoidal_nat_trans.to_nat_trans c) X ⊗ nat_trans.app (monoidal_nat_trans.to_nat_trans c) Y) ≫
    lax_monoidal_functor.μ G X Y := sorry

@[simp] theorem monoidal_nat_trans.tensor_assoc {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} (c : monoidal_nat_trans F G) (X : C) (Y : C) {X' : D} (f' : functor.obj (lax_monoidal_functor.to_functor G) (X ⊗ Y) ⟶ X') : lax_monoidal_functor.μ F X Y ≫ nat_trans.app (monoidal_nat_trans.to_nat_trans c) (X ⊗ Y) ≫ f' =
  (nat_trans.app (monoidal_nat_trans.to_nat_trans c) X ⊗ nat_trans.app (monoidal_nat_trans.to_nat_trans c) Y) ≫
    lax_monoidal_functor.μ G X Y ≫ f' := sorry

@[simp] theorem monoidal_nat_trans.unit {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} (c : monoidal_nat_trans F G) : lax_monoidal_functor.ε F ≫ nat_trans.app (monoidal_nat_trans.to_nat_trans c) 𝟙_ = lax_monoidal_functor.ε G := sorry

@[simp] theorem monoidal_nat_trans.unit_assoc {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} (c : monoidal_nat_trans F G) {X' : D} (f' : functor.obj (lax_monoidal_functor.to_functor G) 𝟙_ ⟶ X') : lax_monoidal_functor.ε F ≫ nat_trans.app (monoidal_nat_trans.to_nat_trans c) 𝟙_ ≫ f' = lax_monoidal_functor.ε G ≫ f' := sorry

namespace monoidal_nat_trans

/--
The identity monoidal natural transformation.
-/
def id {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] (F : lax_monoidal_functor C D) : monoidal_nat_trans F F :=
  mk (nat_trans.mk (nat_trans.app 𝟙))

protected instance inhabited {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] (F : lax_monoidal_functor C D) : Inhabited (monoidal_nat_trans F F) :=
  { default := id F }

/--
Vertical composition of monoidal natural transformations.
-/
def vcomp {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} {H : lax_monoidal_functor C D} (α : monoidal_nat_trans F G) (β : monoidal_nat_trans G H) : monoidal_nat_trans F H :=
  mk (nat_trans.mk (nat_trans.app (nat_trans.vcomp (to_nat_trans α) (to_nat_trans β))))

protected instance category_lax_monoidal_functor {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] : category (lax_monoidal_functor C D) :=
  category.mk

@[simp] theorem comp_to_nat_trans' {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} {H : lax_monoidal_functor C D} {α : F ⟶ G} {β : G ⟶ H} : to_nat_trans (α ≫ β) = to_nat_trans α ≫ to_nat_trans β :=
  rfl

protected instance category_monoidal_functor {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] : category (monoidal_functor C D) :=
  induced_category.category monoidal_functor.to_lax_monoidal_functor

@[simp] theorem comp_to_nat_trans'' {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : monoidal_functor C D} {G : monoidal_functor C D} {H : monoidal_functor C D} {α : F ⟶ G} {β : G ⟶ H} : to_nat_trans (α ≫ β) = to_nat_trans α ≫ to_nat_trans β :=
  rfl

/--
Horizontal composition of monoidal natural transformations.
-/
@[simp] theorem hcomp_to_nat_trans {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {E : Type u₃} [category E] [monoidal_category E] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} {H : lax_monoidal_functor D E} {K : lax_monoidal_functor D E} (α : monoidal_nat_trans F G) (β : monoidal_nat_trans H K) : to_nat_trans (hcomp α β) = to_nat_trans α ◫ to_nat_trans β :=
  Eq.refl (to_nat_trans (hcomp α β))

end monoidal_nat_trans

namespace monoidal_nat_iso

protected instance is_iso_of_is_iso_app {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} (α : F ⟶ G) [(X : C) → is_iso (nat_trans.app (monoidal_nat_trans.to_nat_trans α) X)] : is_iso α :=
  is_iso.mk
    (monoidal_nat_trans.mk (nat_trans.mk fun (X : C) => inv (nat_trans.app (monoidal_nat_trans.to_nat_trans α) X)))

/--
Construct a monoidal natural isomorphism from object level isomorphisms,
and the monoidal naturality in the forward direction.
-/
def of_components {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} (app : (X : C) → functor.obj (lax_monoidal_functor.to_functor F) X ≅ functor.obj (lax_monoidal_functor.to_functor G) X) (naturality : ∀ {X Y : C} (f : X ⟶ Y),
  functor.map (lax_monoidal_functor.to_functor F) f ≫ iso.hom (app Y) =
    iso.hom (app X) ≫ functor.map (lax_monoidal_functor.to_functor G) f) (unit : lax_monoidal_functor.ε F ≫ iso.hom (app 𝟙_) = lax_monoidal_functor.ε G) (tensor : ∀ (X Y : C),
  lax_monoidal_functor.μ F X Y ≫ iso.hom (app (X ⊗ Y)) =
    (iso.hom (app X) ⊗ iso.hom (app Y)) ≫ lax_monoidal_functor.μ G X Y) : F ≅ G :=
  as_iso (monoidal_nat_trans.mk (nat_trans.mk fun (X : C) => iso.hom (app X)))

@[simp] theorem of_components.hom_app {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} (app : (X : C) → functor.obj (lax_monoidal_functor.to_functor F) X ≅ functor.obj (lax_monoidal_functor.to_functor G) X) (naturality : ∀ {X Y : C} (f : X ⟶ Y),
  functor.map (lax_monoidal_functor.to_functor F) f ≫ iso.hom (app Y) =
    iso.hom (app X) ≫ functor.map (lax_monoidal_functor.to_functor G) f) (unit : lax_monoidal_functor.ε F ≫ iso.hom (app 𝟙_) = lax_monoidal_functor.ε G) (tensor : ∀ (X Y : C),
  lax_monoidal_functor.μ F X Y ≫ iso.hom (app (X ⊗ Y)) =
    (iso.hom (app X) ⊗ iso.hom (app Y)) ≫ lax_monoidal_functor.μ G X Y) (X : C) : nat_trans.app (monoidal_nat_trans.to_nat_trans (iso.hom (of_components app naturality unit tensor))) X = iso.hom (app X) :=
  rfl

@[simp] theorem of_components.inv_app {C : Type u₁} [category C] [monoidal_category C] {D : Type u₂} [category D] [monoidal_category D] {F : lax_monoidal_functor C D} {G : lax_monoidal_functor C D} (app : (X : C) → functor.obj (lax_monoidal_functor.to_functor F) X ≅ functor.obj (lax_monoidal_functor.to_functor G) X) (naturality : ∀ {X Y : C} (f : X ⟶ Y),
  functor.map (lax_monoidal_functor.to_functor F) f ≫ iso.hom (app Y) =
    iso.hom (app X) ≫ functor.map (lax_monoidal_functor.to_functor G) f) (unit : lax_monoidal_functor.ε F ≫ iso.hom (app 𝟙_) = lax_monoidal_functor.ε G) (tensor : ∀ (X Y : C),
  lax_monoidal_functor.μ F X Y ≫ iso.hom (app (X ⊗ Y)) =
    (iso.hom (app X) ⊗ iso.hom (app Y)) ≫ lax_monoidal_functor.μ G X Y) (X : C) : nat_trans.app (monoidal_nat_trans.to_nat_trans (iso.inv (of_components app naturality unit tensor))) X = iso.inv (app X) :=
  rfl