import category_theory.monoidal.End

noncomputable theory

namespace category_theory

open category

section

variables {C₁ C₂ C₃ : Type*} [category C₁] [category C₂] [category C₃]
  {F F' : C₁ ⥤ C₂} (G : C₂ ⥤ C₃) [full G] [faithful G]

@[simps]
def nat_trans.equiv_hcomp_id_of_fully_faithful :
  (F ⟶ F') ≃ (F ⋙ G ⟶ F' ⋙ G) :=
{ to_fun := λ τ, τ ◫ 𝟙 G,
  inv_fun := λ τ,
  { app := λ X, G.preimage (τ.app X),
    naturality' := λ X Y f, G.map_injective
      (by simpa only [functor.map_comp, functor.image_preimage] using τ.naturality f), },
  left_inv := by tidy,
  right_inv := by tidy, }

@[simps]
def nat_iso.equiv_hcomp_refl_of_fully_faithful :
  (F ≅ F') ≃ (F ⋙ G ≅ F' ⋙ G) :=
{ to_fun := λ e, nat_iso.hcomp e (iso.refl G),
  inv_fun := λ e,
  { hom := (nat_trans.equiv_hcomp_id_of_fully_faithful G).inv_fun e.hom,
    inv := (nat_trans.equiv_hcomp_id_of_fully_faithful G).inv_fun e.inv,
    hom_inv_id' := begin
      ext X,
      apply G.map_injective,
      simpa only [equiv.inv_fun_as_coe, nat_trans.comp_app,
        nat_trans.equiv_hcomp_id_of_fully_faithful_symm_apply_app, functor.map_comp,
        functor.image_preimage, iso.hom_inv_id_app, nat_trans.id_app, functor.map_id],
    end,
    inv_hom_id' := begin
      ext X,
      apply G.map_injective,
      simpa only [equiv.inv_fun_as_coe, nat_trans.comp_app,
        nat_trans.equiv_hcomp_id_of_fully_faithful_symm_apply_app, functor.map_comp,
        functor.image_preimage, iso.inv_hom_id_app, nat_trans.id_app, functor.map_id],
    end, },
  left_inv := λ e, begin
    ext X,
    apply G.map_injective,
    simp only [equiv.inv_fun_as_coe, nat_trans.equiv_hcomp_id_of_fully_faithful_symm_apply_app,
      functor.image_preimage, nat_iso.hcomp, iso.refl_hom, nat_trans.hcomp_id_app],
  end,
  right_inv := λ e, begin
    ext X,
    simp only [nat_iso.hcomp, equiv.inv_fun_as_coe, iso.refl_hom, nat_trans.hcomp_id_app,
      nat_trans.equiv_hcomp_id_of_fully_faithful_symm_apply_app, functor.image_preimage],
  end, }

end

namespace shift

namespace compatibility

local attribute [instance, reducible] endofunctor_monoidal_category

variables {C D₁ D₂ : Type*} [category C] [category D₁] [category D₂]
  [monoidal_category C]
  (S₁ : monoidal_functor C (D₁ ⥤ D₁))
  (S₂ : monoidal_functor C (D₂ ⥤ D₂))
  (F : D₁ ⥤ D₂)

include F S₁ S₂

@[simp]
def comm_shift (a : C) := S₁.obj a ⋙ F ≅ F ⋙ S₂.obj a

namespace comm_shift

@[simps]
def unit : comm_shift S₁ S₂ F (𝟙_ C) :=
iso_whisker_right S₁.ε_iso.symm F ≪≫ F.left_unitor ≪≫
  F.right_unitor.symm ≪≫ iso_whisker_left F S₂.ε_iso

variables {S₁ S₂ F}

@[simps]
def change {a b : C} (e : comm_shift S₁ S₂ F a) (f : a ≅ b) :
  comm_shift S₁ S₂ F b :=
iso_whisker_right (S₁.map_iso f.symm) _ ≪≫ e ≪≫ iso_whisker_left _ (S₂.map_iso f)

@[simp]
lemma change_refl {a : C} (e : comm_shift S₁ S₂ F a) :
  e.change (iso.refl a) = e := by tidy

@[simp]
lemma change_comp {a b c : C} (e : comm_shift S₁ S₂ F a) (f : a ≅ b) (g : b ≅ c) :
  (e.change f).change g = e.change (f ≪≫ g) := by tidy

variables (S₁ S₂ F)

@[simps]
def change_equiv {a b : C} (f : a ≅ b) :
  comm_shift S₁ S₂ F a ≃ comm_shift S₁ S₂ F b :=
{ to_fun := λ e, e.change f,
  inv_fun := λ e, e.change f.symm,
  left_inv := by tidy,
  right_inv := by tidy, }

lemma change_injective {a b : C} (f : a ≅ b) :
  function.injective (λ (e : comm_shift S₁ S₂ F a), e.change f) :=
(change_equiv S₁ S₂ F f).injective

variables {S₁ S₂ F}

@[simps]
def comp {a b : C} (e₁ : comm_shift S₁ S₂ F a) (e₂ : comm_shift S₁ S₂ F b) :
  comm_shift S₁ S₂ F (a ⊗ b) :=
iso_whisker_right (S₁.μ_iso a b).symm F ≪≫ functor.associator _ _ _ ≪≫
  iso_whisker_left _ e₂ ≪≫ (functor.associator _ _ _).symm ≪≫
  iso_whisker_right e₁ _ ≪≫ functor.associator _ _ _ ≪≫ iso_whisker_left _ (S₂.μ_iso a b)

lemma comp_unit {a : C } (e : comm_shift S₁ S₂ F a) :
  e.comp (unit _ _ _) = e.change (ρ_ a).symm :=
begin
  ext X,
  dsimp [comp, unit],
  simp only [id_comp, assoc, μ_inv_hom_app_assoc, ← F.map_comp_assoc,
    ε_inv_app_obj, obj_zero_map_μ_app, ε_hom_inv_app_assoc],
end

lemma unit_comp {a : C} (e : comm_shift S₁ S₂ F a) :
  (unit _ _ _).comp e = e.change (λ_ a).symm :=
begin
  apply change_injective S₁ S₂ F (λ_ a),
  simp only [change_comp, iso.symm_self_id, change_refl],
  ext X,
  dsimp [comp, unit, functor.comp],
  simp only [id_comp, assoc, obj_ε_app, μ_inv_hom_app_assoc, map_inv_hom_app,
    map_inv_hom_app, comp_id, ← nat_trans.naturality, (S₂.obj a).map_comp,
    ← F.map_comp_assoc, obj_ε_inv_app, μ_inv_hom_app_assoc, F.map_id, id_comp],
end

lemma comp_assoc {a b c : C} (e₁ : comm_shift S₁ S₂ F a) (e₂ : comm_shift S₁ S₂ F b)
  (e₃ : comm_shift S₁ S₂ F c) :
  (e₁.comp e₂).comp e₃ = (e₁.comp (e₂.comp e₃)).change (α_ _ _ _).symm :=
begin
  ext X,
  dsimp [comp],
  simpa only [id_comp, obj_μ_app, μ_naturality_assoc, assoc, μ_inv_hom_app, comp_id,
    ← cancel_epi (F.map ((S₁.μ_iso (a ⊗ b) c).hom.app X)), (S₂.obj c).map_comp,
    ← F.map_comp_assoc, iso.hom_inv_id_app, F.map_id, monoidal_functor.μ_iso_hom,
    ← obj_μ_inv_app, μ_hom_inv_app] using (e₃.hom.naturality_assoc _ _).symm,
end

@[simps]
def comp_cancel {a b : C} (e₁ : comm_shift S₁ S₂ F (a ⊗ b)) (e₂ : comm_shift S₁ S₂ F b)
  [is_equivalence (S₂.obj b)] :
  comm_shift S₁ S₂ F a :=
(nat_iso.equiv_hcomp_refl_of_fully_faithful (S₂.obj b)).symm
(functor.associator _ _ _ ≪≫ iso_whisker_left _ e₂.symm ≪≫
    (functor.associator _ _ _).symm ≪≫ iso_whisker_right (S₁.μ_iso a b) _ ≪≫
    e₁ ≪≫ iso_whisker_left F (S₂.μ_iso a b).symm ≪≫ (functor.associator _ _ _).symm)

@[simps]
def comp_equiv {b : C} (f : comm_shift S₁ S₂ F b) [is_equivalence (S₂.obj b)] (a : C) :
  comm_shift S₁ S₂ F a ≃ comm_shift S₁ S₂ F (a ⊗ b) :=
{ to_fun := λ e, e.comp f,
  inv_fun := λ e, e.comp_cancel f,
  left_inv := λ e, begin
    apply (nat_iso.equiv_hcomp_refl_of_fully_faithful (S₂.obj b)).injective,
    simp only [comp_cancel, equiv.apply_symm_apply],
    ext X,
    simp only [iso.trans_hom, iso_whisker_left_hom, iso.symm_hom, iso_whisker_right_hom,
      monoidal_functor.μ_iso_hom, nat_trans.comp_app, functor.associator_hom_app,
      whisker_left_app, functor.associator_inv_app, whisker_right_app,
      comp_hom_app, comp_id, assoc, μ_hom_inv_app, id_comp, nat_trans.hcomp_id_app,
      nat_iso.equiv_hcomp_refl_of_fully_faithful_apply, ← F.map_comp_assoc, F.map_id,
      f.inv_hom_id_app_assoc, nat_iso.hcomp, iso.refl_hom],
    apply comp_id,
  end,
  right_inv := λ e, begin
    ext X,
    simp only [comp_hom_app, comp_cancel_hom_app, functor.image_preimage, assoc, μ_inv_hom_app,
      comp_id, iso.hom_inv_id_app_assoc, ← F.map_comp_assoc, F.map_id, id_comp],
  end, }

end comm_shift

end compatibility

end shift

end category_theory


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (hα : ¬ is_rat α) : ∀ y ∈ Icc 0 1, ∃ x ∈ Icc 0 1, x ≠ y :=
begin
  assume y h1,
  have h2 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α - (i : ℝ) ≠ (j : ℝ) * α - (j : ℝ), from by {
    assume i j h3,
    assume h4 : (i : ℝ) * α - (i : ℝ) = (j : ℝ) * α - (j : ℝ),
    have h5 : (i : ℝ) * α = (j : ℝ) * α, from by {
      rw ← h4,
      ring,
    },
    have h6 : (i : ℝ) = (j : ℝ), from by {
      rw ← h5,
      rw ← mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ),
      rw mul_assoc,
      rw mul_comm α (j : ℝ),
      rw mul_assoc,
      rw mul_comm α (i : ℝ
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Squeeze Theorem for Real Numbers
Let $\sequence {x_n}$, $\sequence {y_n}$ and $\sequence {z_n}$ be sequences in $\R$.

Let $\sequence {y_n}$ and $\sequence {z_n}$ both be convergent to the following limit:
:$\ds \lim_{n \mathop \to \infty} y_n = l, \lim_{n \mathop \to \infty} z_n = l$

Suppose that:
:$\forall n \in \N: y_n \le x_n \le z_n$

Then:
:$x_n \to l$ as $n \to \infty$
that is:
:$\ds \lim_{n \mathop \to \infty} x_n = l$

`proof`
From Negative of Absolute Value:
:$\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$

Let $\epsilon > 0$.

We need to prove that:
:$\exists N: \forall n > N: \size {x_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that:
:$\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that:
:$\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$

Let $N = \max \set {N_1, N_2}$.

Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.

So:
:$\forall n > N: l - \epsilon < y_n < l + \epsilon$
:$\forall n > N: l - \epsilon < z_n < l + \epsilon$

But:
:$\forall n \in \N: y_n \le x_n \le z_n$

So:
:$\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$

and so:
:$\forall n > N: l - \epsilon < x_n < l + \epsilon$

So:
:$\forall n > N: \size {x_n - l} < \epsilon$

Hence the result.
{{qed}}

-/
theorem squeeze_theorem_real_numbers (x y z : ℕ → ℝ) (l : ℝ) :
let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
 seq_limit y l → seq_limit z l →  (∀ n : ℕ, (y n) ≤ (x n) ∧ (x n) ≤ (z n)) → seq_limit x l :=
begin
  assume seq_limit (h2 : seq_limit y l) (h3 : seq_limit z l) (h4 : ∀ (n : ℕ), y n ≤ x n ∧ x n ≤ z n) (ε),

  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from by
  {
    intro x0,
    have h6 : |x0 - l| < ε ↔ ((x0 - l) < ε) ∧ ((l - x0) < ε),
    from abs_sub_lt_iff, rw h6,
    split,
    rintro ⟨ S_1, S_2 ⟩,
    split; linarith,
    rintro ⟨ S_3, S_4 ⟩,
    split; linarith,
    },

  assume (h7 : ε > 0),
  cases h2 ε h7 with N1 h8,
  cases h3 ε h7 with N2 h9,

  let N := max N1 N2,
  use N,

  have h10 : ∀ n > N, n > N1 ∧ n > N2 := by {
    assume n h,
    split,
    exact lt_of_le_of_lt (le_max_left N1 N2) h,
    exact lt_of_le_of_lt (le_max_right N1 N2) h,
  },

  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from by {
    intros n h12,
    split,
    {

      have h13 := (h8 n (h10 n h12).left), rw h5 (y n) at h13,
      split,
      exact h13.left,
      exact (h4 n).left,
    },
    {
      have h14 := (h9 n (h10 n h12).right),rw h5 (z n) at h14,
      split,
      exact (h4 n).right,
      exact h14.right,
    },

  },

  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from by {
    intros n1 h16, cases (h11 n1 h16);
    split; linarith,
  },

  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from by {
    intros n h17,
    cases h5 (x n) with h18 h19,
    apply h19, exact h15 n h17,
  },
end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


example (G : Type) [group G] (g h k : G) : (g * h * k⁻¹)⁻¹ = k * h⁻¹ * g⁻¹ :=
begin
  sorry
end


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Scott Morrison
-/
import tactic data.set.lattice data.prod data.vector
       tactic.rewrite data.stream.basic

example {a b : Prop} (h₀ : a → b) (h₁ : a) : b :=
begin
  apply_assumption,
  apply_assumption,
end

example {a b : Prop} (h₀ : a → b) (h₁ : a) : b :=
by solve_by_elim

example {α : Type} {a b : α → Prop} (h₀ : ∀ x : α, b x = a x) (y : α) : a y = b y :=
by solve_by_elim

example {α : Type} {a b : α → Prop} (h₀ : b = a) (y : α) : a y = b y :=
by solve_by_elim

example {α : Type} {a b : α → Prop} (h₀ : b = a) (y : α) : a y = b y :=
begin
  success_if_fail { solve_by_elim only [] },
  success_if_fail { solve_by_elim only [h₀] },
  solve_by_elim only [h₀, congr_fun]
end

example {α : Type} {a b : α → Prop} (h₀ : b = a) (y : α) : a y = b y :=
by solve_by_elim [h₀]

example {α : Type} {a b : α → Prop} (h₀ : b = a) (y : α) : a y = b y :=
begin
 success_if_fail { solve_by_elim [*, -h₀] },
 solve_by_elim [*]
end

example {α β : Type} (a b : α) (f : α → β) (i : function.injective f) (h : f a = f b) : a = b :=
begin
  success_if_fail { solve_by_elim only [i] },
  success_if_fail { solve_by_elim only [h] },
  solve_by_elim only [i,h]
end

@[user_attribute]
meta def ex : user_attribute := {
  name := `ex,
  descr := "An example attribute for testing solve_by_elim."
}

@[ex] def f : ℕ := 0

example : ℕ := by solve_by_elim [f]

example : ℕ :=
begin
  success_if_fail { solve_by_elim },
  success_if_fail { solve_by_elim [-f] with ex },
  solve_by_elim with ex,
end

example {α : Type} {p : α → Prop} (h₀ : ∀ x, p x) (y : α) : p y :=
begin
  apply_assumption,
end

open tactic

example : true :=
begin
  (do gs ← get_goals,
     set_goals [],
     success_if_fail `[solve_by_elim],
     set_goals gs),
  trivial
end

example {α : Type} (r : α → α → Prop) (f : α → α → α)
  (l : ∀ a b c : α, r a b → r a (f b c) → r a c)
  (a b c : α) (h₁ : r a b) (h₂ : r a (f b c)) : r a c :=
begin
  solve_by_elim,
end

-- Verifying that `solve_by_elim*` acts on all remaining goals.
example (n : ℕ) : ℕ × ℕ :=
begin
  split,
  solve_by_elim*,
end

-- Verifying that `solve_by_elim*` backtracks when given multiple goals.
example (n m : ℕ) (f : ℕ → ℕ → Prop) (h : f n m): ∃ p : ℕ × ℕ, f p.1 p.2 :=
begin
  repeat { split },
  solve_by_elim*,
end


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

! This file was ported from Lean 3 source module control.traversable.instances
! 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.Control.Applicative
import Mathbin.Data.List.Forall2
import Mathbin.Data.Set.Functor

/-!
# Traversable instances

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

This file provides instances of `traversable` for types from the core library: `option`, `list` and
`sum`.
-/

universe u v

section Option

open Functor

variable {F G : Type u → Type u}

variable [Applicative F] [Applicative G]

variable [LawfulApplicative F] [LawfulApplicative G]

/- warning: option.id_traverse -> Option.id_traverse is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (x : Option.{u1} α), Eq.{succ u1} (id.{succ (succ u1)} Type.{u1} (Option.{u1} α)) (Option.traverse.{u1, u1, u1} (id.{succ (succ u1)} Type.{u1}) (Monad.toApplicative.{u1, u1} (id.{succ (succ u1)} Type.{u1}) id.monad.{u1}) α α (id.mk.{succ u1} α) x) x
but is expected to have type
  forall {α : Type.{u1}} (x : Option.{u1} α), Eq.{succ u1} (Id.{u1} (Option.{u1} α)) (Option.traverse.{u1, u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1}) α α (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) α) x) x
Case conversion may be inaccurate. Consider using '#align option.id_traverse Option.id_traverseₓ'. -/
theorem Option.id_traverse {α} (x : Option α) : Option.traverse id.mk x = x := by cases x <;> rfl
#align option.id_traverse Option.id_traverse

/- warning: option.comp_traverse -> Option.comp_traverse is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] [_inst_2 : Applicative.{u1, u1} G] [_inst_3 : LawfulApplicative.{u1, u1} F _inst_1] [_inst_4 : LawfulApplicative.{u1, u1} G _inst_2] {α : Type.{u2}} {β : Type.{u1}} {γ : Type.{u1}} (f : β -> (F γ)) (g : α -> (G β)) (x : Option.{u2} α), Eq.{succ u1} (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F (Option.{u1} γ)) (Option.traverse.{u1, u1, u2} (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F) (Functor.Comp.applicative.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F _inst_2 _inst_1) α γ (Function.comp.{succ u2, succ u1, succ u1} α (G (F γ)) (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F γ) (Functor.Comp.mk.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F γ) (Function.comp.{succ u2, succ u1, succ u1} α (G β) (G (F γ)) (Functor.map.{u1, u1} (fun {β : Type.{u1}} => G β) (Applicative.toFunctor.{u1, u1} (fun {β : Type.{u1}} => G β) _inst_2) β (F γ) f) g)) x) (Functor.Comp.mk.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F (Option.{u1} γ) (Functor.map.{u1, u1} G (Applicative.toFunctor.{u1, u1} G _inst_2) (Option.{u1} β) (F (Option.{u1} γ)) (Option.traverse.{u1, u1, u1} F _inst_1 β γ f) (Option.traverse.{u1, u1, u2} G _inst_2 α β g x)))
but is expected to have type
  forall {F : Type.{u2} -> Type.{u2}} {G : Type.{u2} -> Type.{u2}} [_inst_1 : Applicative.{u2, u2} F] [_inst_2 : Applicative.{u2, u2} G] [_inst_3 : LawfulApplicative.{u2, u2} G _inst_2] {_inst_4 : Type.{u1}} {α : Type.{u2}} {β : Type.{u2}} (γ : α -> (F β)) (f : _inst_4 -> (G α)) (g : Option.{u1} _inst_4), Eq.{succ u2} (Functor.Comp.{u2, u2, u2} G F (Option.{u2} β)) (Option.traverse.{u2, u2, u1} (Functor.Comp.{u2, u2, u2} G F) (Functor.Comp.instApplicativeComp.{u2, u2, u2} G F _inst_2 _inst_1) _inst_4 β (Function.comp.{succ u1, succ u2, succ u2} _inst_4 (G (F β)) (Functor.Comp.{u2, u2, u2} G F β) (Functor.Comp.mk.{u2, u2, u2} G F β) (Function.comp.{succ u1, succ u2, succ u2} _inst_4 (G α) (G (F β)) ((fun (x._@.Mathlib.Control.Traversable.Instances._hyg.175 : α -> (F β)) (x._@.Mathlib.Control.Traversable.Instances._hyg.177 : G α) => Functor.map.{u2, u2} G (Applicative.toFunctor.{u2, u2} G _inst_2) α (F β) x._@.Mathlib.Control.Traversable.Instances._hyg.175 x._@.Mathlib.Control.Traversable.Instances._hyg.177) γ) f)) g) (Functor.Comp.mk.{u2, u2, u2} G F (Option.{u2} β) (Functor.map.{u2, u2} G (Applicative.toFunctor.{u2, u2} G _inst_2) (Option.{u2} α) (F (Option.{u2} β)) (Option.traverse.{u2, u2, u2} F _inst_1 α β γ) (Option.traverse.{u2, u2, u1} G _inst_2 _inst_4 α f g)))
Case conversion may be inaccurate. Consider using '#align option.comp_traverse Option.comp_traverseₓ'. -/
@[nolint unused_arguments]
theorem Option.comp_traverse {α β γ} (f : β → F γ) (g : α → G β) (x : Option α) :
    Option.traverse (Comp.mk ∘ (· <$> ·) f ∘ g) x =
      Comp.mk (Option.traverse f <$> Option.traverse g x) :=
  by cases x <;> simp! [functor_norm] <;> rfl
#align option.comp_traverse Option.comp_traverse

/- warning: option.traverse_eq_map_id -> Option.traverse_eq_map_id is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u1}} (f : α -> β) (x : Option.{u1} α), Eq.{succ u1} (id.{succ (succ u1)} Type.{u1} (Option.{u1} β)) (Traversable.traverse.{u1} (fun {α : Type.{u1}} => Option.{u1} α) Option.traversable.{u1} (id.{succ (succ u1)} Type.{u1}) (Monad.toApplicative.{u1, u1} (id.{succ (succ u1)} Type.{u1}) id.monad.{u1}) α β (Function.comp.{succ u1, succ u1, succ u1} α β (id.{succ (succ u1)} Type.{u1} β) (id.mk.{succ u1} β) f) x) (id.mk.{succ u1} (Option.{u1} β) (Functor.map.{u1, u1} Option.{u1} (Traversable.toFunctor.{u1} Option.{u1} Option.traversable.{u1}) α β f x))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u1}} (f : α -> β) (x : Option.{u1} α), Eq.{succ u1} (Id.{u1} (Option.{u1} β)) (Option.traverse.{u1, u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1}) α β (Function.comp.{succ u1, succ u1, succ u1} α β (Id.{u1} β) (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) β) f) x) (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) (Option.{u1} β) (Functor.map.{u1, u1} Option.{u1} instFunctorOption.{u1} α β f x))
Case conversion may be inaccurate. Consider using '#align option.traverse_eq_map_id Option.traverse_eq_map_idₓ'. -/
theorem Option.traverse_eq_map_id {α β} (f : α → β) (x : Option α) :
    traverse (id.mk ∘ f) x = id.mk (f <$> x) := by cases x <;> rfl
#align option.traverse_eq_map_id Option.traverse_eq_map_id

variable (η : ApplicativeTransformation F G)

/- warning: option.naturality -> Option.naturality is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] [_inst_2 : Applicative.{u1, u1} G] [_inst_3 : LawfulApplicative.{u1, u1} F _inst_1] [_inst_4 : LawfulApplicative.{u1, u1} G _inst_2] (η : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) {α : Type.{u2}} {β : Type.{u1}} (f : α -> (F β)) (x : Option.{u2} α), Eq.{succ u1} (G (Option.{u1} β)) (coeFn.{succ (succ u1), succ (succ u1)} (ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) η (Option.{u1} β) (Option.traverse.{u1, u1, u2} F _inst_1 α β f x)) (Option.traverse.{u1, u1, u2} G _inst_2 α β (Function.comp.{succ u2, succ u1, succ u1} α (F β) (G β) (coeFn.{succ (succ u1), succ (succ u1)} (ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) η β) f) x)
but is expected to have type
  forall {F : Type.{u2} -> Type.{u2}} {G : Type.{u2} -> Type.{u2}} [_inst_1 : Applicative.{u2, u2} F] [_inst_2 : Applicative.{u2, u2} G] [_inst_3 : LawfulApplicative.{u2, u2} F _inst_1] [_inst_4 : LawfulApplicative.{u2, u2} G _inst_2] (η : ApplicativeTransformation.{u2, u2, u2} F _inst_1 G _inst_2) {α : Type.{u1}} {β : Type.{u2}} (f : α -> (F β)) (x : Option.{u1} α), Eq.{succ u2} (G (Option.{u2} β)) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u2}} => ApplicativeTransformation.app.{u2, u2, u2} F _inst_1 G _inst_2 η α._@.Mathlib.Control.Traversable.Basic._hyg.243) (Option.{u2} β) (Option.traverse.{u2, u2, u1} F _inst_1 α β f x)) (Option.traverse.{u2, u2, u1} G _inst_2 α β (Function.comp.{succ u1, succ u2, succ u2} α (F β) (G β) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u2}} => ApplicativeTransformation.app.{u2, u2, u2} F _inst_1 G _inst_2 η α._@.Mathlib.Control.Traversable.Basic._hyg.243) β) f) x)
Case conversion may be inaccurate. Consider using '#align option.naturality Option.naturalityₓ'. -/
theorem Option.naturality {α β} (f : α → F β) (x : Option α) :
    η (Option.traverse f x) = Option.traverse (@η _ ∘ f) x := by
  cases' x with x <;> simp! [*, functor_norm]
#align option.naturality Option.naturality

end Option

instance : IsLawfulTraversable Option :=
  { Option.lawfulMonad with
    id_traverse := @Option.id_traverse
    comp_traverse := @Option.comp_traverse
    traverse_eq_map_id := @Option.traverse_eq_map_id
    naturality := @Option.naturality }

namespace List

variable {F G : Type u → Type u}

variable [Applicative F] [Applicative G]

section

variable [LawfulApplicative F] [LawfulApplicative G]

open Applicative Functor List

/- warning: list.id_traverse -> List.id_traverse is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (xs : List.{u1} α), Eq.{succ u1} (id.{succ (succ u1)} Type.{u1} (List.{u1} α)) (List.traverse.{u1, u1, u1} (id.{succ (succ u1)} Type.{u1}) (Monad.toApplicative.{u1, u1} (id.{succ (succ u1)} Type.{u1}) id.monad.{u1}) α α (id.mk.{succ u1} α) xs) xs
but is expected to have type
  forall {α : Type.{u1}} (xs : List.{u1} α), Eq.{succ u1} (Id.{u1} (List.{u1} α)) (List.traverse.{u1, u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1}) α α (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) α) xs) xs
Case conversion may be inaccurate. Consider using '#align list.id_traverse List.id_traverseₓ'. -/
protected theorem id_traverse {α} (xs : List α) : List.traverse id.mk xs = xs := by
  induction xs <;> simp! [*, functor_norm] <;> rfl
#align list.id_traverse List.id_traverse

/- warning: list.comp_traverse -> List.comp_traverse is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] [_inst_2 : Applicative.{u1, u1} G] [_inst_3 : LawfulApplicative.{u1, u1} F _inst_1] [_inst_4 : LawfulApplicative.{u1, u1} G _inst_2] {α : Type.{u2}} {β : Type.{u1}} {γ : Type.{u1}} (f : β -> (F γ)) (g : α -> (G β)) (x : List.{u2} α), Eq.{succ u1} (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F (List.{u1} γ)) (List.traverse.{u1, u1, u2} (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F) (Functor.Comp.applicative.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F _inst_2 _inst_1) α γ (Function.comp.{succ u2, succ u1, succ u1} α (G (F γ)) (Functor.Comp.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F γ) (Functor.Comp.mk.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F γ) (Function.comp.{succ u2, succ u1, succ u1} α (G β) (G (F γ)) (Functor.map.{u1, u1} (fun {β : Type.{u1}} => G β) (Applicative.toFunctor.{u1, u1} (fun {β : Type.{u1}} => G β) _inst_2) β (F γ) f) g)) x) (Functor.Comp.mk.{u1, u1, u1} (fun {β : Type.{u1}} => G β) F (List.{u1} γ) (Functor.map.{u1, u1} G (Applicative.toFunctor.{u1, u1} G _inst_2) (List.{u1} β) (F (List.{u1} γ)) (List.traverse.{u1, u1, u1} F _inst_1 β γ f) (List.traverse.{u1, u1, u2} G _inst_2 α β g x)))
but is expected to have type
  forall {F : Type.{u2} -> Type.{u2}} {G : Type.{u2} -> Type.{u2}} [_inst_1 : Applicative.{u2, u2} F] [_inst_2 : Applicative.{u2, u2} G] [_inst_3 : LawfulApplicative.{u2, u2} G _inst_2] {_inst_4 : Type.{u1}} {α : Type.{u2}} {β : Type.{u2}} (γ : α -> (F β)) (f : _inst_4 -> (G α)) (g : List.{u1} _inst_4), Eq.{succ u2} (Functor.Comp.{u2, u2, u2} G F (List.{u2} β)) (List.traverse.{u2, u2, u1} (Functor.Comp.{u2, u2, u2} G F) (Functor.Comp.instApplicativeComp.{u2, u2, u2} G F _inst_2 _inst_1) _inst_4 β (Function.comp.{succ u1, succ u2, succ u2} _inst_4 (G (F β)) (Functor.Comp.{u2, u2, u2} G F β) (Functor.Comp.mk.{u2, u2, u2} G F β) (Function.comp.{succ u1, succ u2, succ u2} _inst_4 (G α) (G (F β)) ((fun (x._@.Mathlib.Control.Traversable.Instances._hyg.982 : α -> (F β)) (x._@.Mathlib.Control.Traversable.Instances._hyg.984 : G α) => Functor.map.{u2, u2} G (Applicative.toFunctor.{u2, u2} G _inst_2) α (F β) x._@.Mathlib.Control.Traversable.Instances._hyg.982 x._@.Mathlib.Control.Traversable.Instances._hyg.984) γ) f)) g) (Functor.Comp.mk.{u2, u2, u2} G F (List.{u2} β) (Functor.map.{u2, u2} G (Applicative.toFunctor.{u2, u2} G _inst_2) (List.{u2} α) (F (List.{u2} β)) (List.traverse.{u2, u2, u2} F _inst_1 α β γ) (List.traverse.{u2, u2, u1} G _inst_2 _inst_4 α f g)))
Case conversion may be inaccurate. Consider using '#align list.comp_traverse List.comp_traverseₓ'. -/
@[nolint unused_arguments]
protected theorem comp_traverse {α β γ} (f : β → F γ) (g : α → G β) (x : List α) :
    List.traverse (Comp.mk ∘ (· <$> ·) f ∘ g) x = Comp.mk (List.traverse f <$> List.traverse g x) :=
  by induction x <;> simp! [*, functor_norm] <;> rfl
#align list.comp_traverse List.comp_traverse

/- warning: list.traverse_eq_map_id -> List.traverse_eq_map_id is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u1}} (f : α -> β) (x : List.{u1} α), Eq.{succ u1} (id.{succ (succ u1)} Type.{u1} (List.{u1} β)) (List.traverse.{u1, u1, u1} (id.{succ (succ u1)} Type.{u1}) (Monad.toApplicative.{u1, u1} (id.{succ (succ u1)} Type.{u1}) id.monad.{u1}) α β (Function.comp.{succ u1, succ u1, succ u1} α β (id.{succ (succ u1)} Type.{u1} β) (id.mk.{succ u1} β) f) x) (id.mk.{succ u1} (List.{u1} β) (Functor.map.{u1, u1} List.{u1} (Traversable.toFunctor.{u1} List.{u1} List.traversable.{u1}) α β f x))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u1}} (f : α -> β) (x : List.{u1} α), Eq.{succ u1} (Id.{u1} (List.{u1} β)) (List.traverse.{u1, u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1}) α β (Function.comp.{succ u1, succ u1, succ u1} α β (Id.{u1} β) (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) β) f) x) (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) (List.{u1} β) (Functor.map.{u1, u1} List.{u1} List.instFunctorList.{u1} α β f x))
Case conversion may be inaccurate. Consider using '#align list.traverse_eq_map_id List.traverse_eq_map_idₓ'. -/
protected theorem traverse_eq_map_id {α β} (f : α → β) (x : List α) :
    List.traverse (id.mk ∘ f) x = id.mk (f <$> x) := by
  induction x <;> simp! [*, functor_norm] <;> rfl
#align list.traverse_eq_map_id List.traverse_eq_map_id

variable (η : ApplicativeTransformation F G)

/- warning: list.naturality -> List.naturality is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] [_inst_2 : Applicative.{u1, u1} G] [_inst_3 : LawfulApplicative.{u1, u1} F _inst_1] [_inst_4 : LawfulApplicative.{u1, u1} G _inst_2] (η : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) {α : Type.{u2}} {β : Type.{u1}} (f : α -> (F β)) (x : List.{u2} α), Eq.{succ u1} (G (List.{u1} β)) (coeFn.{succ (succ u1), succ (succ u1)} (ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) η (List.{u1} β) (List.traverse.{u1, u1, u2} F _inst_1 α β f x)) (List.traverse.{u1, u1, u2} G _inst_2 α β (Function.comp.{succ u2, succ u1, succ u1} α (F β) (G β) (coeFn.{succ (succ u1), succ (succ u1)} (ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) η β) f) x)
but is expected to have type
  forall {F : Type.{u2} -> Type.{u2}} {G : Type.{u2} -> Type.{u2}} [_inst_1 : Applicative.{u2, u2} F] [_inst_2 : Applicative.{u2, u2} G] [_inst_3 : LawfulApplicative.{u2, u2} F _inst_1] [_inst_4 : LawfulApplicative.{u2, u2} G _inst_2] (η : ApplicativeTransformation.{u2, u2, u2} F _inst_1 G _inst_2) {α : Type.{u1}} {β : Type.{u2}} (f : α -> (F β)) (x : List.{u1} α), Eq.{succ u2} (G (List.{u2} β)) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u2}} => ApplicativeTransformation.app.{u2, u2, u2} F _inst_1 G _inst_2 η α._@.Mathlib.Control.Traversable.Basic._hyg.243) (List.{u2} β) (List.traverse.{u2, u2, u1} F _inst_1 α β f x)) (List.traverse.{u2, u2, u1} G _inst_2 α β (Function.comp.{succ u1, succ u2, succ u2} α (F β) (G β) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u2}} => ApplicativeTransformation.app.{u2, u2, u2} F _inst_1 G _inst_2 η α._@.Mathlib.Control.Traversable.Basic._hyg.243) β) f) x)
Case conversion may be inaccurate. Consider using '#align list.naturality List.naturalityₓ'. -/
protected theorem naturality {α β} (f : α → F β) (x : List α) :
    η (List.traverse f x) = List.traverse (@η _ ∘ f) x := by induction x <;> simp! [*, functor_norm]
#align list.naturality List.naturality

open Nat

instance : IsLawfulTraversable.{u} List :=
  { List.lawfulMonad with
    id_traverse := @List.id_traverse
    comp_traverse := @List.comp_traverse
    traverse_eq_map_id := @List.traverse_eq_map_id
    naturality := @List.naturality }

end

section Traverse

variable {α' β' : Type u} (f : α' → F β')

#print List.traverse_nil /-
@[simp]
theorem traverse_nil : traverse f ([] : List α') = (pure [] : F (List β')) :=
  rfl
#align list.traverse_nil List.traverse_nil
-/

/- warning: list.traverse_cons -> List.traverse_cons is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] {α' : Type.{u1}} {β' : Type.{u1}} (f : α' -> (F β')) (a : α') (l : List.{u1} α'), Eq.{succ u1} (F (List.{u1} β')) (Traversable.traverse.{u1} List.{u1} List.traversable.{u1} F _inst_1 α' β' f (List.cons.{u1} α' a l)) (Seq.seq.{u1, u1} F (Applicative.toHasSeq.{u1, u1} F _inst_1) (List.{u1} β') (List.{u1} β') (Functor.map.{u1, u1} F (Applicative.toFunctor.{u1, u1} F _inst_1) β' ((List.{u1} β') -> (List.{u1} β')) (fun (_x : β') (_y : List.{u1} β') => List.cons.{u1} β' _x _y) (f a)) (Traversable.traverse.{u1} List.{u1} List.traversable.{u1} F _inst_1 α' β' f l))
but is expected to have type
  forall {F : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] {α' : Type.{u1}} {β' : Type.{u1}} (f : α' -> (F β')) (a : α') (l : List.{u1} α'), Eq.{succ u1} (F (List.{u1} β')) (Traversable.traverse.{u1} List.{u1} instTraversableList.{u1} F _inst_1 α' β' f (List.cons.{u1} α' a l)) (Seq.seq.{u1, u1} F (Applicative.toSeq.{u1, u1} F _inst_1) (List.{u1} β') (List.{u1} β') (Functor.map.{u1, u1} F (Applicative.toFunctor.{u1, u1} F _inst_1) β' ((List.{u1} β') -> (List.{u1} β')) (fun (_x : β') (_y : List.{u1} β') => List.cons.{u1} β' _x _y) (f a)) (fun (x._@.Mathlib.Control.Traversable.Instances._hyg.1745 : Unit) => Traversable.traverse.{u1} List.{u1} instTraversableList.{u1} F _inst_1 α' β' f l))
Case conversion may be inaccurate. Consider using '#align list.traverse_cons List.traverse_consₓ'. -/
@[simp]
theorem traverse_cons (a : α') (l : List α') :
    traverse f (a :: l) = (· :: ·) <$> f a <*> traverse f l :=
  rfl
#align list.traverse_cons List.traverse_cons

variable [LawfulApplicative F]

/- warning: list.traverse_append -> List.traverse_append is a dubious translation:
lean 3 declaration is
  forall {F : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] {α' : Type.{u1}} {β' : Type.{u1}} (f : α' -> (F β')) [_inst_3 : LawfulApplicative.{u1, u1} F _inst_1] (as : List.{u1} α') (bs : List.{u1} α'), Eq.{succ u1} (F (List.{u1} β')) (Traversable.traverse.{u1} (fun {α' : Type.{u1}} => List.{u1} α') List.traversable.{u1} F _inst_1 α' β' f (Append.append.{u1} (List.{u1} α') (List.hasAppend.{u1} α') as bs)) (Seq.seq.{u1, u1} F (Applicative.toHasSeq.{u1, u1} F _inst_1) (List.{u1} β') (List.{u1} β') (Functor.map.{u1, u1} F (Applicative.toFunctor.{u1, u1} F _inst_1) (List.{u1} β') ((List.{u1} β') -> (List.{u1} β')) (Append.append.{u1} (List.{u1} β') (List.hasAppend.{u1} β')) (Traversable.traverse.{u1} List.{u1} List.traversable.{u1} F _inst_1 α' β' f as)) (Traversable.traverse.{u1} List.{u1} List.traversable.{u1} F _inst_1 α' β' f bs))
but is expected to have type
  forall {F : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] {α' : Type.{u1}} {β' : Type.{u1}} (f : α' -> (F β')) [_inst_3 : LawfulApplicative.{u1, u1} F _inst_1] (as : List.{u1} α') (bs : List.{u1} α'), Eq.{succ u1} (F (List.{u1} β')) (Traversable.traverse.{u1} List.{u1} instTraversableList.{u1} F _inst_1 α' β' f (HAppend.hAppend.{u1, u1, u1} (List.{u1} α') (List.{u1} α') (List.{u1} α') (instHAppend.{u1} (List.{u1} α') (List.instAppendList.{u1} α')) as bs)) (Seq.seq.{u1, u1} F (Applicative.toSeq.{u1, u1} F _inst_1) (List.{u1} β') (List.{u1} β') (Functor.map.{u1, u1} F (Applicative.toFunctor.{u1, u1} F _inst_1) (List.{u1} β') ((List.{u1} β') -> (List.{u1} β')) (fun (x._@.Mathlib.Control.Traversable.Instances._hyg.1825 : List.{u1} β') (x._@.Mathlib.Control.Traversable.Instances._hyg.1827 : List.{u1} β') => HAppend.hAppend.{u1, u1, u1} (List.{u1} β') (List.{u1} β') (List.{u1} β') (instHAppend.{u1} (List.{u1} β') (List.instAppendList.{u1} β')) x._@.Mathlib.Control.Traversable.Instances._hyg.1825 x._@.Mathlib.Control.Traversable.Instances._hyg.1827) (Traversable.traverse.{u1} List.{u1} instTraversableList.{u1} F _inst_1 α' β' f as)) (fun (x._@.Mathlib.Control.Traversable.Instances._hyg.1844 : Unit) => Traversable.traverse.{u1} List.{u1} instTraversableList.{u1} F _inst_1 α' β' f bs))
Case conversion may be inaccurate. Consider using '#align list.traverse_append List.traverse_appendₓ'. -/
@[simp]
theorem traverse_append :
    ∀ as bs : List α', traverse f (as ++ bs) = (· ++ ·) <$> traverse f as <*> traverse f bs
  | [], bs => by
    have : Append.append ([] : List β') = id := by funext <;> rfl
    simp [this, functor_norm]
  | a :: as, bs => by simp [traverse_append as bs, functor_norm] <;> congr
#align list.traverse_append List.traverse_append

#print List.mem_traverse /-
theorem mem_traverse {f : α' → Set β'} :
    ∀ (l : List α') (n : List β'), n ∈ traverse f l ↔ Forall₂ (fun b a => b ∈ f a) n l
  | [], [] => by simp
  | a :: as, [] => by simp
  | [], b :: bs => by simp
  | a :: as, b :: bs => by simp [mem_traverse as bs]
#align list.mem_traverse List.mem_traverse
-/

end Traverse

end List

namespace Sum

section Traverse

variable {σ : Type u}

variable {F G : Type u → Type u}

variable [Applicative F] [Applicative G]

open Applicative Functor

open List (cons)

/- warning: sum.traverse_map -> Sum.traverse_map is a dubious translation:
lean 3 declaration is
  forall {σ : Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_2 : Applicative.{u1, u1} G] {α : Type.{u1}} {β : Type.{u1}} {γ : Type.{u1}} (g : α -> β) (f : β -> (G γ)) (x : Sum.{u1, u1} σ α), Eq.{succ u1} (G (Sum.{u1, u1} σ γ)) (Sum.traverse.{u1, u1} σ G _inst_2 β γ f (Functor.map.{u1, u1} (Sum.{u1, u1} σ) (Traversable.toFunctor.{u1} (Sum.{u1, u1} σ) (Sum.traversable.{u1} σ)) α β g x)) (Sum.traverse.{u1, u1} σ G _inst_2 α γ (Function.comp.{succ u1, succ u1, succ u1} α β (G γ) f g) x)
but is expected to have type
  forall {σ : Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_2 : Applicative.{u1, u1} G] {α : Type.{u1}} {β : Type.{u1}} {γ : Type.{u1}} (g : α -> β) (f : β -> (G γ)) (x : Sum.{u1, u1} σ α), Eq.{succ u1} (G (Sum.{u1, u1} σ γ)) (Sum.traverse.{u1, u1} σ G _inst_2 β γ f (Functor.map.{u1, u1} (Sum.{u1, u1} σ) (Traversable.toFunctor.{u1} (Sum.{u1, u1} σ) (instTraversableSum.{u1} σ)) α β g x)) (Sum.traverse.{u1, u1} σ G _inst_2 α γ (Function.comp.{succ u1, succ u1, succ u1} α β (G γ) f g) x)
Case conversion may be inaccurate. Consider using '#align sum.traverse_map Sum.traverse_mapₓ'. -/
protected theorem traverse_map {α β γ : Type u} (g : α → β) (f : β → G γ) (x : Sum σ α) :
    Sum.traverse f (g <$> x) = Sum.traverse (f ∘ g) x := by
  cases x <;> simp [Sum.traverse, id_map, functor_norm] <;> rfl
#align sum.traverse_map Sum.traverse_map

variable [LawfulApplicative F] [LawfulApplicative G]

/- warning: sum.id_traverse -> Sum.id_traverse is a dubious translation:
lean 3 declaration is
  forall {σ : Type.{u1}} {α : Type.{u1}} (x : Sum.{u1, u1} σ α), Eq.{succ u1} (id.{succ (succ u1)} Type.{u1} (Sum.{u1, u1} σ α)) (Sum.traverse.{u1, u1} σ (id.{succ (succ u1)} Type.{u1}) (Monad.toApplicative.{u1, u1} (id.{succ (succ u1)} Type.{u1}) id.monad.{u1}) α α (id.mk.{succ u1} α) x) x
but is expected to have type
  forall {σ : Type.{u1}} {α : Type.{u1}} (x : Sum.{u1, u1} σ α), Eq.{succ u1} (Id.{u1} (Sum.{u1, u1} σ α)) (Sum.traverse.{u1, u1} σ Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1}) α α (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) α) x) x
Case conversion may be inaccurate. Consider using '#align sum.id_traverse Sum.id_traverseₓ'. -/
protected theorem id_traverse {σ α} (x : Sum σ α) : Sum.traverse id.mk x = x := by cases x <;> rfl
#align sum.id_traverse Sum.id_traverse

/- warning: sum.comp_traverse -> Sum.comp_traverse is a dubious translation:
lean 3 declaration is
  forall {σ : Type.{u}} {F : Type.{u} -> Type.{u}} {G : Type.{u} -> Type.{u}} [_inst_1 : Applicative.{u, u} F] [_inst_2 : Applicative.{u, u} G] [_inst_3 : LawfulApplicative.{u, u} F _inst_1] [_inst_4 : LawfulApplicative.{u, u} G _inst_2] {α : Type.{u_1}} {β : Type.{u}} {γ : Type.{u}} (f : β -> (F γ)) (g : α -> (G β)) (x : Sum.{u, u_1} σ α), Eq.{succ u} (Functor.Comp.{u, u, u} (fun {β : Type.{u}} => G β) F (Sum.{u, u} σ γ)) (Sum.traverse.{u, u_1} σ (Functor.Comp.{u, u, u} (fun {β : Type.{u}} => G β) F) (Functor.Comp.applicative.{u, u, u} (fun {β : Type.{u}} => G β) F _inst_2 _inst_1) α γ (Function.comp.{succ u_1, succ u, succ u} α (G (F γ)) (Functor.Comp.{u, u, u} (fun {β : Type.{u}} => G β) F γ) (Functor.Comp.mk.{u, u, u} (fun {β : Type.{u}} => G β) F γ) (Function.comp.{succ u_1, succ u, succ u} α (G β) (G (F γ)) (Functor.map.{u, u} (fun {β : Type.{u}} => G β) (Applicative.toFunctor.{u, u} (fun {β : Type.{u}} => G β) _inst_2) β (F γ) f) g)) x) (Functor.Comp.mk.{u, u, u} (fun {β : Type.{u}} => G β) F (Sum.{u, u} σ γ) (Functor.map.{u, u} G (Applicative.toFunctor.{u, u} G _inst_2) (Sum.{u, u} σ β) (F (Sum.{u, u} σ γ)) (Sum.traverse.{u, u} σ F _inst_1 β γ f) (Sum.traverse.{u, u_1} σ G _inst_2 α β g x)))
but is expected to have type
  forall {σ : Type.{u}} {F : Type.{u} -> Type.{u}} {G : Type.{u} -> Type.{u}} [_inst_1 : Applicative.{u, u} F] [_inst_2 : Applicative.{u, u} G] [_inst_3 : LawfulApplicative.{u, u} G _inst_2] {_inst_4 : Type.{u}} {α : Type.{u}} {β : Type.{u}} (γ : α -> (F β)) (f : _inst_4 -> (G α)) (g : Sum.{u, u} σ _inst_4), Eq.{succ u} (Functor.Comp.{u, u, u} G F (Sum.{u, u} σ β)) (Sum.traverse.{u, u} σ (Functor.Comp.{u, u, u} G F) (Functor.Comp.instApplicativeComp.{u, u, u} G F _inst_2 _inst_1) _inst_4 β (Function.comp.{succ u, succ u, succ u} _inst_4 (G (F β)) (Functor.Comp.{u, u, u} G F β) (Functor.Comp.mk.{u, u, u} G F β) (Function.comp.{succ u, succ u, succ u} _inst_4 (G α) (G (F β)) ((fun (x._@.Mathlib.Control.Traversable.Instances._hyg.2374 : α -> (F β)) (x._@.Mathlib.Control.Traversable.Instances._hyg.2376 : G α) => Functor.map.{u, u} G (Applicative.toFunctor.{u, u} G _inst_2) α (F β) x._@.Mathlib.Control.Traversable.Instances._hyg.2374 x._@.Mathlib.Control.Traversable.Instances._hyg.2376) γ) f)) g) (Functor.Comp.mk.{u, u, u} G F (Sum.{u, u} σ β) (Functor.map.{u, u} G (Applicative.toFunctor.{u, u} G _inst_2) (Sum.{u, u} σ α) (F (Sum.{u, u} σ β)) (Sum.traverse.{u, u} σ F _inst_1 α β γ) (Sum.traverse.{u, u} σ G _inst_2 _inst_4 α f g)))
Case conversion may be inaccurate. Consider using '#align sum.comp_traverse Sum.comp_traverseₓ'. -/
@[nolint unused_arguments]
protected theorem comp_traverse {α β γ} (f : β → F γ) (g : α → G β) (x : Sum σ α) :
    Sum.traverse (Comp.mk ∘ (· <$> ·) f ∘ g) x = Comp.mk (Sum.traverse f <$> Sum.traverse g x) := by
  cases x <;> simp! [Sum.traverse, map_id, functor_norm] <;> rfl
#align sum.comp_traverse Sum.comp_traverse

/- warning: sum.traverse_eq_map_id -> Sum.traverse_eq_map_id is a dubious translation:
lean 3 declaration is
  forall {σ : Type.{u1}} {α : Type.{u1}} {β : Type.{u1}} (f : α -> β) (x : Sum.{u1, u1} σ α), Eq.{succ u1} (id.{succ (succ u1)} Type.{u1} (Sum.{u1, u1} σ β)) (Sum.traverse.{u1, u1} σ (id.{succ (succ u1)} Type.{u1}) (Monad.toApplicative.{u1, u1} (id.{succ (succ u1)} Type.{u1}) id.monad.{u1}) α β (Function.comp.{succ u1, succ u1, succ u1} α β (id.{succ (succ u1)} Type.{u1} β) (id.mk.{succ u1} β) f) x) (id.mk.{succ u1} (Sum.{u1, u1} σ β) (Functor.map.{u1, u1} (Sum.{u1, u1} σ) (Traversable.toFunctor.{u1} (Sum.{u1, u1} σ) (Sum.traversable.{u1} σ)) α β f x))
but is expected to have type
  forall {σ : Type.{u1}} {α : Type.{u1}} {β : Type.{u1}} (f : α -> β) (x : Sum.{u1, u1} σ α), Eq.{succ u1} (Id.{u1} (Sum.{u1, u1} σ β)) (Sum.traverse.{u1, u1} σ Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1}) α β (Function.comp.{succ u1, succ u1, succ u1} α β (Id.{u1} β) (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) β) f) x) (Pure.pure.{u1, u1} Id.{u1} (Applicative.toPure.{u1, u1} Id.{u1} (Monad.toApplicative.{u1, u1} Id.{u1} Id.instMonadId.{u1})) (Sum.{u1, u1} σ β) (Functor.map.{u1, u1} (Sum.{u1, u1} σ) (Traversable.toFunctor.{u1} (Sum.{u1, u1} σ) (instTraversableSum.{u1} σ)) α β f x))
Case conversion may be inaccurate. Consider using '#align sum.traverse_eq_map_id Sum.traverse_eq_map_idₓ'. -/
protected theorem traverse_eq_map_id {α β} (f : α → β) (x : Sum σ α) :
    Sum.traverse (id.mk ∘ f) x = id.mk (f <$> x) := by
  induction x <;> simp! [*, functor_norm] <;> rfl
#align sum.traverse_eq_map_id Sum.traverse_eq_map_id

/- warning: sum.map_traverse -> Sum.map_traverse is a dubious translation:
lean 3 declaration is
  forall {σ : Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_2 : Applicative.{u1, u1} G] [_inst_4 : LawfulApplicative.{u1, u1} G _inst_2] {α : Type.{u2}} {β : Type.{u1}} {γ : Type.{u1}} (g : α -> (G β)) (f : β -> γ) (x : Sum.{u1, u2} σ α), Eq.{succ u1} (G (Sum.{u1, u1} σ γ)) (Functor.map.{u1, u1} (fun {β : Type.{u1}} => G β) (Applicative.toFunctor.{u1, u1} (fun {β : Type.{u1}} => G β) _inst_2) (Sum.{u1, u1} σ β) (Sum.{u1, u1} σ γ) (Functor.map.{u1, u1} (Sum.{u1, u1} σ) (Traversable.toFunctor.{u1} (Sum.{u1, u1} σ) (Sum.traversable.{u1} σ)) β γ f) (Sum.traverse.{u1, u2} σ (fun {β : Type.{u1}} => G β) _inst_2 α β g x)) (Sum.traverse.{u1, u2} σ G _inst_2 α γ (Function.comp.{succ u2, succ u1, succ u1} α (G β) (G γ) (Functor.map.{u1, u1} G (Applicative.toFunctor.{u1, u1} G _inst_2) β γ f) g) x)
but is expected to have type
  forall {σ : Type.{u2}} {G : Type.{u2} -> Type.{u2}} [_inst_2 : Applicative.{u2, u2} G] [_inst_4 : LawfulApplicative.{u2, u2} G _inst_2] {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u2}} (g : α -> (G β)) (f : β -> γ) (x : Sum.{u2, u1} σ α), Eq.{succ u2} (G (Sum.{u2, u2} σ γ)) (Functor.map.{u2, u2} G (Applicative.toFunctor.{u2, u2} G _inst_2) (Sum.{u2, u2} σ β) (Sum.{u2, u2} σ γ) ((fun (x._@.Mathlib.Control.Traversable.Instances._hyg.2806 : β -> γ) (x._@.Mathlib.Control.Traversable.Instances._hyg.2808 : Sum.{u2, u2} σ β) => Functor.map.{u2, u2} (Sum.{u2, u2} σ) (Traversable.toFunctor.{u2} (Sum.{u2, u2} σ) (instTraversableSum.{u2} σ)) β γ x._@.Mathlib.Control.Traversable.Instances._hyg.2806 x._@.Mathlib.Control.Traversable.Instances._hyg.2808) f) (Sum.traverse.{u2, u1} σ G _inst_2 α β g x)) (Sum.traverse.{u2, u1} σ G _inst_2 α γ (Function.comp.{succ u1, succ u2, succ u2} α (G β) (G γ) ((fun (x._@.Mathlib.Control.Traversable.Instances._hyg.2832 : β -> γ) (x._@.Mathlib.Control.Traversable.Instances._hyg.2834 : G β) => Functor.map.{u2, u2} G (Applicative.toFunctor.{u2, u2} G _inst_2) β γ x._@.Mathlib.Control.Traversable.Instances._hyg.2832 x._@.Mathlib.Control.Traversable.Instances._hyg.2834) f) g) x)
Case conversion may be inaccurate. Consider using '#align sum.map_traverse Sum.map_traverseₓ'. -/
protected theorem map_traverse {α β γ} (g : α → G β) (f : β → γ) (x : Sum σ α) :
    (· <$> ·) f <$> Sum.traverse g x = Sum.traverse ((· <$> ·) f ∘ g) x := by
  cases x <;> simp [Sum.traverse, id_map, functor_norm] <;> congr <;> rfl
#align sum.map_traverse Sum.map_traverse

variable (η : ApplicativeTransformation F G)

/- warning: sum.naturality -> Sum.naturality is a dubious translation:
lean 3 declaration is
  forall {σ : Type.{u1}} {F : Type.{u1} -> Type.{u1}} {G : Type.{u1} -> Type.{u1}} [_inst_1 : Applicative.{u1, u1} F] [_inst_2 : Applicative.{u1, u1} G] [_inst_3 : LawfulApplicative.{u1, u1} F _inst_1] [_inst_4 : LawfulApplicative.{u1, u1} G _inst_2] (η : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) {α : Type.{u2}} {β : Type.{u1}} (f : α -> (F β)) (x : Sum.{u1, u2} σ α), Eq.{succ u1} (G (Sum.{u1, u1} σ β)) (coeFn.{succ (succ u1), succ (succ u1)} (ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) η (Sum.{u1, u1} σ β) (Sum.traverse.{u1, u2} σ F _inst_1 α β f x)) (Sum.traverse.{u1, u2} σ G _inst_2 α β (Function.comp.{succ u2, succ u1, succ u1} α (F β) (G β) (coeFn.{succ (succ u1), succ (succ u1)} (ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) (fun (_x : ApplicativeTransformation.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) => forall {α : Type.{u1}}, (F α) -> (G α)) (ApplicativeTransformation.hasCoeToFun.{u1, u1, u1} F _inst_1 _inst_3 G _inst_2 _inst_4) η β) f) x)
but is expected to have type
  forall {σ : Type.{u2}} {F : Type.{u2} -> Type.{u2}} {G : Type.{u2} -> Type.{u2}} [_inst_1 : Applicative.{u2, u2} F] [_inst_2 : Applicative.{u2, u2} G] [_inst_3 : LawfulApplicative.{u2, u2} F _inst_1] [_inst_4 : LawfulApplicative.{u2, u2} G _inst_2] (η : ApplicativeTransformation.{u2, u2, u2} F _inst_1 G _inst_2) {α : Type.{u1}} {β : Type.{u2}} (f : α -> (F β)) (x : Sum.{u2, u1} σ α), Eq.{succ u2} (G (Sum.{u2, u2} σ β)) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u2}} => ApplicativeTransformation.app.{u2, u2, u2} F _inst_1 G _inst_2 η α._@.Mathlib.Control.Traversable.Basic._hyg.243) (Sum.{u2, u2} σ β) (Sum.traverse.{u2, u1} σ F _inst_1 α β f x)) (Sum.traverse.{u2, u1} σ G _inst_2 α β (Function.comp.{succ u1, succ u2, succ u2} α (F β) (G β) ((fun {α._@.Mathlib.Control.Traversable.Basic._hyg.243 : Type.{u2}} => ApplicativeTransformation.app.{u2, u2, u2} F _inst_1 G _inst_2 η α._@.Mathlib.Control.Traversable.Basic._hyg.243) β) f) x)
Case conversion may be inaccurate. Consider using '#align sum.naturality Sum.naturalityₓ'. -/
protected theorem naturality {α β} (f : α → F β) (x : Sum σ α) :
    η (Sum.traverse f x) = Sum.traverse (@η _ ∘ f) x := by
  cases x <;> simp! [Sum.traverse, functor_norm]
#align sum.naturality Sum.naturality

end Traverse

instance {σ : Type u} : IsLawfulTraversable.{u} (Sum σ) :=
  { Sum.lawfulMonad with
    id_traverse := @Sum.id_traverse σ
    comp_traverse := @Sum.comp_traverse σ
    traverse_eq_map_id := @Sum.traverse_eq_map_id σ
    naturality := @Sum.naturality σ }

end Sum


/-
Copyright (c) 2019 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.products
import category_theory.limits.shapes.images
import category_theory.isomorphism_classes

/-!
# Zero morphisms and zero objects

A category "has zero morphisms" if there is a designated "zero morphism" in each morphism space,
and compositions of zero morphisms with anything give the zero morphism. (Notice this is extra
structure, not merely a property.)

A category "has a zero object" if it has an object which is both initial and terminal. Having a
zero object provides zero morphisms, as the unique morphisms factoring through the zero object.

## References

* https://en.wikipedia.org/wiki/Zero_morphism
* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2]
-/

noncomputable theory

universes v u

open category_theory
open category_theory.category

namespace category_theory.limits

variables (C : Type u) [category.{v} C]

/-- A category "has zero morphisms" if there is a designated "zero morphism" in each morphism space,
and compositions of zero morphisms with anything give the zero morphism. -/
class has_zero_morphisms :=
[has_zero : Π X Y : C, has_zero (X ⟶ Y)]
(comp_zero' : ∀ {X Y : C} (f : X ⟶ Y) (Z : C), f ≫ (0 : Y ⟶ Z) = (0 : X ⟶ Z) . obviously)
(zero_comp' : ∀ (X : C) {Y Z : C} (f : Y ⟶ Z), (0 : X ⟶ Y) ≫ f = (0 : X ⟶ Z) . obviously)

attribute [instance] has_zero_morphisms.has_zero
restate_axiom has_zero_morphisms.comp_zero'
restate_axiom has_zero_morphisms.zero_comp'

variables {C}

@[simp] lemma comp_zero [has_zero_morphisms C] {X Y : C} {f : X ⟶ Y} {Z : C} :
  f ≫ (0 : Y ⟶ Z) = (0 : X ⟶ Z) := has_zero_morphisms.comp_zero f Z
@[simp] lemma zero_comp [has_zero_morphisms C] {X : C} {Y Z : C} {f : Y ⟶ Z} :
  (0 : X ⟶ Y) ≫ f = (0 : X ⟶ Z) := has_zero_morphisms.zero_comp X f

instance has_zero_morphisms_pempty : has_zero_morphisms (discrete pempty) :=
{ has_zero := by tidy }

instance has_zero_morphisms_punit : has_zero_morphisms (discrete punit) :=
{ has_zero := by tidy }

namespace has_zero_morphisms
variables {C}

/-- This lemma will be immediately superseded by `ext`, below. -/
private lemma ext_aux (I J : has_zero_morphisms C)
  (w : ∀ X Y : C, (@has_zero_morphisms.has_zero _ _ I X Y).zero =
    (@has_zero_morphisms.has_zero _ _ J X Y).zero) : I = J :=
begin
  casesI I, casesI J,
  congr,
  { ext X Y,
    exact w X Y },
  { apply proof_irrel_heq, },
  { apply proof_irrel_heq, }
end

/--
If you're tempted to use this lemma "in the wild", you should probably
carefully consider whether you've made a mistake in allowing two
instances of `has_zero_morphisms` to exist at all.

See, particularly, the note on `zero_morphisms_of_zero_object` below.
-/
lemma ext (I J : has_zero_morphisms C) : I = J :=
begin
  apply ext_aux,
  intros X Y,
  rw ←@has_zero_morphisms.comp_zero _ _ I X X (@has_zero_morphisms.has_zero _ _ J X X).zero,
  rw @has_zero_morphisms.zero_comp _ _ J,
end

instance : subsingleton (has_zero_morphisms C) :=
⟨ext⟩

end has_zero_morphisms

open opposite has_zero_morphisms

instance has_zero_morphisms_opposite [has_zero_morphisms C] :
  has_zero_morphisms Cᵒᵖ :=
{ has_zero := λ X Y, ⟨(0 : unop Y ⟶ unop X).op⟩,
  comp_zero' := λ X Y f Z, congr_arg quiver.hom.op (has_zero_morphisms.zero_comp (unop Z) f.unop),
  zero_comp' := λ X Y Z f, congr_arg quiver.hom.op (has_zero_morphisms.comp_zero f.unop (unop X)), }

section
variables {C} [has_zero_morphisms C]

lemma zero_of_comp_mono {X Y Z : C} {f : X ⟶ Y} (g : Y ⟶ Z) [mono g] (h : f ≫ g = 0) : f = 0 :=
by { rw [←zero_comp, cancel_mono] at h, exact h }

lemma zero_of_epi_comp {X Y Z : C} (f : X ⟶ Y) {g : Y ⟶ Z} [epi f] (h : f ≫ g = 0) : g = 0 :=
by { rw [←comp_zero, cancel_epi] at h, exact h }

lemma eq_zero_of_image_eq_zero {X Y : C} {f : X ⟶ Y} [has_image f] (w : image.ι f = 0) : f = 0 :=
by rw [←image.fac f, w, has_zero_morphisms.comp_zero]

lemma nonzero_image_of_nonzero {X Y : C} {f : X ⟶ Y} [has_image f] (w : f ≠ 0) : image.ι f ≠ 0 :=
λ h, w (eq_zero_of_image_eq_zero h)
end

section
universes v' u'
variables (D : Type u') [category.{v'} D]

variables [has_zero_morphisms D]

instance : has_zero_morphisms (C ⥤ D) :=
{ has_zero := λ F G, ⟨{ app := λ X, 0, }⟩ }

@[simp] lemma zero_app (F G : C ⥤ D) (j : C) : (0 : F ⟶ G).app j = 0 := rfl

variables [has_zero_morphisms C]

lemma equivalence_preserves_zero_morphisms (F : C ≌ D) (X Y : C) :
  F.functor.map (0 : X ⟶ Y) = (0 : F.functor.obj X ⟶ F.functor.obj Y) :=
begin
  have t : F.functor.map (0 : X ⟶ Y) =
    F.functor.map (0 : X ⟶ Y) ≫ (0 : F.functor.obj Y ⟶ F.functor.obj Y),
  { apply faithful.map_injective (F.inverse),
    rw [functor.map_comp, equivalence.inv_fun_map],
    dsimp,
    rw [zero_comp, comp_zero, zero_comp], },
  exact t.trans (by simp)
end

@[simp] lemma is_equivalence_preserves_zero_morphisms (F : C ⥤ D) [is_equivalence F] (X Y : C) :
  F.map (0 : X ⟶ Y) = 0 :=
by rw [←functor.as_equivalence_functor F, equivalence_preserves_zero_morphisms]

end

variables (C)

/-- A category "has a zero object" if it has an object which is both initial and terminal. -/
class has_zero_object :=
(zero : C)
(unique_to : Π X : C, unique (zero ⟶ X))
(unique_from : Π X : C, unique (X ⟶ zero))

instance has_zero_object_punit : has_zero_object (discrete punit) :=
{ zero := punit.star,
  unique_to := by tidy,
  unique_from := by tidy, }

variables {C}

namespace has_zero_object

variables [has_zero_object C]

/--
Construct a `has_zero C` for a category with a zero object.
This can not be a global instance as it will trigger for every `has_zero C` typeclass search.
-/
protected def has_zero : has_zero C :=
{ zero := has_zero_object.zero }

localized "attribute [instance] category_theory.limits.has_zero_object.has_zero" in zero_object
localized "attribute [instance] category_theory.limits.has_zero_object.unique_to" in zero_object
localized "attribute [instance] category_theory.limits.has_zero_object.unique_from" in zero_object

@[ext]
lemma to_zero_ext {X : C} (f g : X ⟶ 0) : f = g :=
by rw [(has_zero_object.unique_from X).uniq f, (has_zero_object.unique_from X).uniq g]

@[ext]
lemma from_zero_ext {X : C} (f g : 0 ⟶ X) : f = g :=
by rw [(has_zero_object.unique_to X).uniq f, (has_zero_object.unique_to X).uniq g]

instance (X : C) : subsingleton (X ≅ 0) := by tidy

instance {X : C} (f : 0 ⟶ X) : mono f :=
{ right_cancellation := λ Z g h w, by ext, }

instance {X : C} (f : X ⟶ 0) : epi f :=
{ left_cancellation := λ Z g h w, by ext, }

/-- A category with a zero object has zero morphisms.

    It is rarely a good idea to use this. Many categories that have a zero object have zero
    morphisms for some other reason, for example from additivity. Library code that uses
    `zero_morphisms_of_zero_object` will then be incompatible with these categories because
    the `has_zero_morphisms` instances will not be definitionally equal. For this reason library
    code should generally ask for an instance of `has_zero_morphisms` separately, even if it already
    asks for an instance of `has_zero_objects`. -/
def zero_morphisms_of_zero_object : has_zero_morphisms C :=
{ has_zero := λ X Y,
  { zero := inhabited.default (X ⟶ 0) ≫ inhabited.default (0 ⟶ Y) },
  zero_comp' := λ X Y Z f, by { dunfold has_zero.zero, rw category.assoc, congr, },
  comp_zero' := λ X Y Z f, by { dunfold has_zero.zero, rw ←category.assoc, congr, }}

/-- A zero object is in particular initial. -/
def zero_is_initial : is_initial (0 : C) :=
is_initial.of_unique 0
/-- A zero object is in particular terminal. -/
def zero_is_terminal : is_terminal (0 : C) :=
is_terminal.of_unique 0

/-- A zero object is in particular initial. -/
@[priority 10]
instance has_initial : has_initial C :=
has_initial_of_unique 0
/-- A zero object is in particular terminal. -/
@[priority 10]
instance has_terminal : has_terminal C :=
has_terminal_of_unique 0

@[priority 100]
instance has_strict_initial : initial_mono_class C :=
initial_mono_class.of_is_initial zero_is_initial (λ X, category_theory.mono _)

open_locale zero_object

instance {B : Type*} [category B] [has_zero_morphisms C] : has_zero_object (B ⥤ C) :=
{ zero := { obj := λ X, 0, map := λ X Y f, 0, },
  unique_to := λ F, ⟨⟨{ app := λ X, 0, }⟩, by tidy⟩,
  unique_from := λ F, ⟨⟨{ app := λ X, 0, }⟩, by tidy⟩ }

@[simp] lemma functor.zero_obj {B : Type*} [category B] [has_zero_morphisms C] (X : B) :
  (0 : B ⥤ C).obj X = 0 := rfl
@[simp] lemma functor.zero_map {B : Type*} [category B] [has_zero_morphisms C]
  {X Y : B} (f : X ⟶ Y) : (0 : B ⥤ C).map f = 0 := rfl

end has_zero_object

section
variables [has_zero_object C] [has_zero_morphisms C]
open_locale zero_object

@[simp]
lemma id_zero : 𝟙 (0 : C) = (0 : 0 ⟶ 0) :=
by ext

/--  An arrow ending in the zero object is zero -/
-- This can't be a `simp` lemma because the left hand side would be a metavariable.
lemma zero_of_to_zero {X : C} (f : X ⟶ 0) : f = 0 :=
by ext

lemma zero_of_target_iso_zero {X Y : C} (f : X ⟶ Y) (i : Y ≅ 0) : f = 0 :=
begin
  have h : f = f ≫ i.hom ≫ 𝟙 0 ≫ i.inv := by simp only [iso.hom_inv_id, id_comp, comp_id],
  simpa using h,
end

/-- An arrow starting at the zero object is zero -/
lemma zero_of_from_zero {X : C} (f : 0 ⟶ X) : f = 0 :=
by ext

lemma zero_of_source_iso_zero {X Y : C} (f : X ⟶ Y) (i : X ≅ 0) : f = 0 :=
begin
  have h : f = i.hom ≫ 𝟙 0 ≫ i.inv ≫ f := by simp only [iso.hom_inv_id_assoc, id_comp, comp_id],
  simpa using h,
end

lemma zero_of_source_iso_zero' {X Y : C} (f : X ⟶ Y) (i : is_isomorphic X 0) : f = 0 :=
zero_of_source_iso_zero f (nonempty.some i)
lemma zero_of_target_iso_zero' {X Y : C} (f : X ⟶ Y) (i : is_isomorphic Y 0) : f = 0 :=
zero_of_target_iso_zero f (nonempty.some i)

lemma mono_of_source_iso_zero {X Y : C} (f : X ⟶ Y) (i : X ≅ 0) : mono f :=
⟨λ Z g h w, by rw [zero_of_target_iso_zero g i, zero_of_target_iso_zero h i]⟩

lemma epi_of_target_iso_zero {X Y : C} (f : X ⟶ Y) (i : Y ≅ 0) : epi f :=
⟨λ Z g h w, by rw [zero_of_source_iso_zero g i, zero_of_source_iso_zero h i]⟩

/--
An object `X` has `𝟙 X = 0` if and only if it is isomorphic to the zero object.

Because `X ≅ 0` contains data (even if a subsingleton), we express this `↔` as an `≃`.
-/
def id_zero_equiv_iso_zero (X : C) : (𝟙 X = 0) ≃ (X ≅ 0) :=
{ to_fun    := λ h, { hom := 0, inv := 0, },
  inv_fun   := λ i, zero_of_target_iso_zero (𝟙 X) i,
  left_inv  := by tidy,
  right_inv := by tidy, }

@[simp]
lemma id_zero_equiv_iso_zero_apply_hom (X : C) (h : 𝟙 X = 0) :
  ((id_zero_equiv_iso_zero X) h).hom = 0 := rfl

@[simp]
lemma id_zero_equiv_iso_zero_apply_inv (X : C) (h : 𝟙 X = 0) :
  ((id_zero_equiv_iso_zero X) h).inv = 0 := rfl

/-- If `0 : X ⟶ Y` is an monomorphism, then `X ≅ 0`. -/
@[simps]
def iso_zero_of_mono_zero {X Y : C} (h : mono (0 : X ⟶ Y)) : X ≅ 0 :=
{ hom := 0,
  inv := 0,
  hom_inv_id' := (cancel_mono (0 : X ⟶ Y)).mp (by simp) }

/-- If `0 : X ⟶ Y` is an epimorphism, then `Y ≅ 0`. -/
@[simps]
def iso_zero_of_epi_zero {X Y : C} (h : epi (0 : X ⟶ Y)) : Y ≅ 0 :=
{ hom := 0,
  inv := 0,
  hom_inv_id' := (cancel_epi (0 : X ⟶ Y)).mp (by simp) }

/-- If an object `X` is isomorphic to 0, there's no need to use choice to construct
an explicit isomorphism: the zero morphism suffices. -/
def iso_of_is_isomorphic_zero {X : C} (P : is_isomorphic X 0) : X ≅ 0 :=
{ hom := 0,
  inv := 0,
  hom_inv_id' :=
  begin
    casesI P,
    rw ←P.hom_inv_id,
    rw ←category.id_comp P.inv,
    simp,
  end,
  inv_hom_id' := by simp, }

end

section is_iso
variables [has_zero_morphisms C]

/--
A zero morphism `0 : X ⟶ Y` is an isomorphism if and only if
the identities on both `X` and `Y` are zero.
-/
@[simps]
def is_iso_zero_equiv (X Y : C) : is_iso (0 : X ⟶ Y) ≃ (𝟙 X = 0 ∧ 𝟙 Y = 0) :=
{ to_fun := by { introsI i, rw ←is_iso.hom_inv_id (0 : X ⟶ Y),
    rw ←is_iso.inv_hom_id (0 : X ⟶ Y), simp },
  inv_fun := λ h, ⟨⟨(0 : Y ⟶ X), by tidy⟩⟩,
  left_inv := by tidy,
  right_inv := by tidy, }

/--
A zero morphism `0 : X ⟶ X` is an isomorphism if and only if
the identity on `X` is zero.
-/
def is_iso_zero_self_equiv (X : C) : is_iso (0 : X ⟶ X) ≃ (𝟙 X = 0) :=
by simpa using is_iso_zero_equiv X X

variables [has_zero_object C]
open_locale zero_object

/--
A zero morphism `0 : X ⟶ Y` is an isomorphism if and only if
`X` and `Y` are isomorphic to the zero object.
-/
def is_iso_zero_equiv_iso_zero (X Y : C) : is_iso (0 : X ⟶ Y) ≃ (X ≅ 0) × (Y ≅ 0) :=
begin
  -- This is lame, because `prod` can't cope with `Prop`, so we can't use `equiv.prod_congr`.
  refine (is_iso_zero_equiv X Y).trans _,
  symmetry,
  fsplit,
  { rintros ⟨eX, eY⟩, fsplit,
    exact (id_zero_equiv_iso_zero X).symm eX,
    exact (id_zero_equiv_iso_zero Y).symm eY, },
  { rintros ⟨hX, hY⟩, fsplit,
    exact (id_zero_equiv_iso_zero X) hX,
    exact (id_zero_equiv_iso_zero Y) hY, },
  { tidy, },
  { tidy, },
end

lemma is_iso_of_source_target_iso_zero {X Y : C} (f : X ⟶ Y) (i : X ≅ 0) (j : Y ≅ 0) : is_iso f :=
begin
  rw zero_of_source_iso_zero f i,
  exact (is_iso_zero_equiv_iso_zero _ _).inv_fun ⟨i, j⟩,
end

/--
A zero morphism `0 : X ⟶ X` is an isomorphism if and only if
`X` is isomorphic to the zero object.
-/
def is_iso_zero_self_equiv_iso_zero (X : C) : is_iso (0 : X ⟶ X) ≃ (X ≅ 0) :=
(is_iso_zero_equiv_iso_zero X X).trans subsingleton_prod_self_equiv

end is_iso

/-- If there are zero morphisms, any initial object is a zero object. -/
def has_zero_object_of_has_initial_object
  [has_zero_morphisms C] [has_initial C] : has_zero_object C :=
{ zero := ⊥_ C,
  unique_to := λ X, ⟨⟨0⟩, by tidy⟩,
  unique_from := λ X, ⟨⟨0⟩, λ f,
  calc
    f = f ≫ 𝟙 _ : (category.comp_id _).symm
    ... = f ≫ 0 : by congr
    ... = 0     : has_zero_morphisms.comp_zero _ _
  ⟩ }

/-- If there are zero morphisms, any terminal object is a zero object. -/
def has_zero_object_of_has_terminal_object
  [has_zero_morphisms C] [has_terminal C] : has_zero_object C :=
{ zero := ⊤_ C,
  unique_from := λ X, ⟨⟨0⟩, by tidy⟩,
  unique_to := λ X, ⟨⟨0⟩, λ f,
  calc
    f = 𝟙 _ ≫ f : (category.id_comp _).symm
    ... = 0 ≫ f : by congr
    ... = 0     : zero_comp
  ⟩ }

section image
variable [has_zero_morphisms C]

lemma image_ι_comp_eq_zero {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} [has_image f]
  [epi (factor_thru_image f)] (h : f ≫ g = 0) : image.ι f ≫ g = 0 :=
zero_of_epi_comp (factor_thru_image f) $ by simp [h]

lemma comp_factor_thru_image_eq_zero {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} [has_image g]
  (h : f ≫ g = 0) : f ≫ factor_thru_image g = 0 :=
zero_of_comp_mono (image.ι g) $ by simp [h]

variables [has_zero_object C]
open_locale zero_object

/--
The zero morphism has a `mono_factorisation` through the zero object.
-/
@[simps]
def mono_factorisation_zero (X Y : C) : mono_factorisation (0 : X ⟶ Y) :=
{ I := 0, m := 0, e := 0, }

/--
The factorisation through the zero object is an image factorisation.
-/
def image_factorisation_zero (X Y : C) : image_factorisation (0 : X ⟶ Y) :=
{ F := mono_factorisation_zero X Y,
  is_image := { lift := λ F', 0 } }

instance has_image_zero {X Y : C} : has_image (0 : X ⟶ Y) :=
has_image.mk $ image_factorisation_zero _ _

/-- The image of a zero morphism is the zero object. -/
def image_zero {X Y : C} : image (0 : X ⟶ Y) ≅ 0 :=
is_image.iso_ext (image.is_image (0 : X ⟶ Y)) (image_factorisation_zero X Y).is_image

/-- The image of a morphism which is equal to zero is the zero object. -/
def image_zero' {X Y : C} {f : X ⟶ Y} (h : f = 0) [has_image f] : image f ≅ 0 :=
image.eq_to_iso h ≪≫ image_zero

@[simp]
lemma image.ι_zero {X Y : C} [has_image (0 : X ⟶ Y)] : image.ι (0 : X ⟶ Y) = 0 :=
begin
  rw ←image.lift_fac (mono_factorisation_zero X Y),
  simp,
end

/--
If we know `f = 0`,
it requires a little work to conclude `image.ι f = 0`,
because `f = g` only implies `image f ≅ image g`.
-/
@[simp]
lemma image.ι_zero' [has_equalizers C] {X Y : C} {f : X ⟶ Y} (h : f = 0) [has_image f] :
  image.ι f = 0 :=
by { rw image.eq_fac h, simp }

end image

/-- In the presence of zero morphisms, coprojections into a coproduct are (split) monomorphisms. -/
instance split_mono_sigma_ι
  {β : Type v} [decidable_eq β]
  [has_zero_morphisms C]
  (f : β → C) [has_colimit (discrete.functor f)] (b : β) : split_mono (sigma.ι f b) :=
{ retraction := sigma.desc (λ b', if h : b' = b then eq_to_hom (congr_arg f h) else 0), }

/-- In the presence of zero morphisms, projections into a product are (split) epimorphisms. -/
instance split_epi_pi_π
  {β : Type v} [decidable_eq β]
  [has_zero_morphisms C]
  (f : β → C) [has_limit (discrete.functor f)] (b : β) : split_epi (pi.π f b) :=
{ section_ := pi.lift (λ b', if h : b = b' then eq_to_hom (congr_arg f h) else 0), }

/-- In the presence of zero morphisms, coprojections into a coproduct are (split) monomorphisms. -/
instance split_mono_coprod_inl
  [has_zero_morphisms C] {X Y : C} [has_colimit (pair X Y)] :
  split_mono (coprod.inl : X ⟶ X ⨿ Y) :=
{ retraction := coprod.desc (𝟙 X) 0, }
/-- In the presence of zero morphisms, coprojections into a coproduct are (split) monomorphisms. -/
instance split_mono_coprod_inr
  [has_zero_morphisms C] {X Y : C} [has_colimit (pair X Y)] :
  split_mono (coprod.inr : Y ⟶ X ⨿ Y) :=
{ retraction := coprod.desc 0 (𝟙 Y), }

/-- In the presence of zero morphisms, projections into a product are (split) epimorphisms. -/
instance split_epi_prod_fst
  [has_zero_morphisms C] {X Y : C} [has_limit (pair X Y)] :
  split_epi (prod.fst : X ⨯ Y ⟶ X) :=
{ section_ := prod.lift (𝟙 X) 0, }
/-- In the presence of zero morphisms, projections into a product are (split) epimorphisms. -/
instance split_epi_prod_snd
  [has_zero_morphisms C] {X Y : C} [has_limit (pair X Y)] :
  split_epi (prod.snd : X ⨯ Y ⟶ Y) :=
{ section_ := prod.lift 0 (𝟙 Y), }

end category_theory.limits


/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import control.bitraversable.basic

/-!
# Bitraversable Lemmas

## Main definitions
  * tfst - traverse on first functor argument
  * tsnd - traverse on second functor argument

## Lemmas

Combination of
  * bitraverse
  * tfst
  * tsnd

with the applicatives `id` and `comp`

## References

 * Hackage: <https://hackage.haskell.org/package/base-4.12.0.0/docs/Data-Bitraversable.html>

## Tags

traversable bitraversable functor bifunctor applicative

-/

universes u

variables {t : Type u → Type u → Type u} [bitraversable t]
variables {β : Type u}

namespace bitraversable
open functor is_lawful_applicative
variables {F G : Type u → Type u}
          [applicative F] [applicative G]

/-- traverse on the first functor argument -/
@[reducible] def tfst {α α'} (f : α → F α') : t α β → F (t α' β) :=
bitraverse f pure

/-- traverse on the second functor argument -/
@[reducible] def tsnd {α α'} (f : α → F α') : t β α → F (t β α') :=
bitraverse pure f

variables [is_lawful_bitraversable t]
          [is_lawful_applicative F]
          [is_lawful_applicative G]

@[higher_order tfst_id]
lemma id_tfst : Π {α β} (x : t α β), tfst id.mk x = id.mk x :=
@id_bitraverse _ _ _

@[higher_order tsnd_id]
lemma id_tsnd : Π {α β} (x : t α β), tsnd id.mk x = id.mk x :=
@id_bitraverse _ _ _

@[higher_order tfst_comp_tfst]
lemma comp_tfst {α₀ α₁ α₂ β}
  (f : α₀ → F α₁) (f' : α₁ → G α₂) (x : t α₀ β) :
  comp.mk (tfst f' <$> tfst f x) = tfst (comp.mk ∘ map f' ∘ f) x :=
by rw ← comp_bitraverse; simp [tfst,map_comp_pure,has_pure.pure]

@[higher_order tfst_comp_tsnd]
lemma tfst_tsnd {α₀ α₁ β₀ β₁}
  (f : α₀ → F α₁) (f' : β₀ → G β₁) (x : t α₀ β₀) :
  comp.mk (tfst f <$> tsnd f' x) =
  bitraverse (comp.mk ∘ pure ∘ f) (comp.mk ∘ map pure ∘ f') x :=
by rw ← comp_bitraverse; simp [tfst,tsnd]

@[higher_order tsnd_comp_tfst]
lemma tsnd_tfst {α₀ α₁ β₀ β₁}
  (f : α₀ → F α₁) (f' : β₀ → G β₁) (x : t α₀ β₀) :
  comp.mk (tsnd f' <$> tfst f x) =
  bitraverse (comp.mk ∘ map pure ∘ f) (comp.mk ∘ pure ∘ f') x :=
by rw ← comp_bitraverse; simp [tfst,tsnd]

@[higher_order tsnd_comp_tsnd]
lemma comp_tsnd {α β₀ β₁ β₂}
  (g : β₀ → F β₁) (g' : β₁ → G β₂) (x : t α β₀) :
  comp.mk (tsnd g' <$> tsnd g x) = tsnd (comp.mk ∘ map g' ∘ g) x :=
by rw ← comp_bitraverse; simp [tsnd]; refl

open bifunctor

private

open function

@[higher_order]
lemma tfst_eq_fst_id {α α' β} (f : α → α') (x : t α β) :
  tfst (id.mk ∘ f) x = id.mk (fst f x) :=
by simp [tfst,fst,pure_eq_id_mk_comp_id,-comp.right_id,bitraverse_eq_bimap_id]

@[higher_order]
lemma tsnd_eq_snd_id {α β β'} (f : β → β') (x : t α β) :
  tsnd (id.mk ∘ f) x = id.mk (snd f x) :=
by simp [tsnd,snd,pure_eq_id_mk_comp_id,-comp.right_id,bitraverse_eq_bimap_id]

attribute [functor_norm] comp_bitraverse comp_tsnd comp_tfst
  tsnd_comp_tsnd tsnd_comp_tfst tfst_comp_tsnd tfst_comp_tfst
  bitraverse_comp bitraverse_id_id tfst_id tsnd_id

end bitraversable


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.real.cau_seq
import Mathlib.topology.uniform_space.basic
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Uniform structure induced by an absolute value

We build a uniform space structure on a commutative ring `R` equipped with an absolute value into
a linear ordered field `𝕜`. Of course in the case `R` is `ℚ`, `ℝ` or `ℂ` and
`𝕜 = ℝ`, we get the same thing as the metric space construction, and the general construction
follows exactly the same path.

## Implementation details

Note that we import `data.real.cau_seq` because this is where absolute values are defined, but
the current file does not depend on real numbers. TODO: extract absolute values from that
`data.real` folder.

## References

* [N. Bourbaki, *Topologie générale*][bourbaki1966]

## Tags

absolute value, uniform spaces
-/

namespace is_absolute_value

/-- The uniformity coming from an absolute value. -/
def uniform_space_core {𝕜 : Type u_1} [linear_ordered_field 𝕜] {R : Type u_2} [comm_ring R]
    (abv : R → 𝕜) [is_absolute_value abv] : uniform_space.core R :=
  uniform_space.core.mk
    (infi
      fun (ε : 𝕜) =>
        infi
          fun (H : ε > 0) =>
            filter.principal (set_of fun (p : R × R) => abv (prod.snd p - prod.fst p) < ε))
    sorry sorry sorry

/-- The uniform structure coming from an absolute value. -/
def uniform_space {𝕜 : Type u_1} [linear_ordered_field 𝕜] {R : Type u_2} [comm_ring R] (abv : R → 𝕜)
    [is_absolute_value abv] : uniform_space R :=
  uniform_space.of_core (uniform_space_core abv)

theorem mem_uniformity {𝕜 : Type u_1} [linear_ordered_field 𝕜] {R : Type u_2} [comm_ring R]
    (abv : R → 𝕜) [is_absolute_value abv] {s : set (R × R)} :
    s ∈ uniform_space.core.uniformity (uniform_space_core abv) ↔
        ∃ (ε : 𝕜), ∃ (H : ε > 0), ∀ {a b : R}, abv (b - a) < ε → (a, b) ∈ s :=
  sorry

end Mathlib