/-
Copyright (c) 2019 Jean Lo. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jean Lo
-/
import topology.metric_space.hausdorff_distance

/-!
# Riesz's lemma

Riesz's lemma, stated for a normed space over a normed field: for any
closed proper subspace `F` of `E`, there is a nonzero `x` such that `∥x - F∥`
is at least `r * ∥x∥` for any `r < 1`. This is `riesz_lemma`.

In a nondiscrete normed field (with an element `c` of norm `> 1`) and any `R > ∥c∥`, one can
guarantee `∥x∥ ≤ R` and `∥x - y∥ ≥ 1` for any `y` in `F`. This is `riesz_lemma_of_norm_lt`.
-/

variables {𝕜 : Type*} [normed_field 𝕜]
variables {E : Type*} [normed_group E] [normed_space 𝕜 E]

/-- Riesz's lemma, which usually states that it is possible to find a
vector with norm 1 whose distance to a closed proper subspace is
arbitrarily close to 1. The statement here is in terms of multiples of
norms, since in general the existence of an element of norm exactly 1
is not guaranteed. For a variant giving an element with norm in `[1, R]`, see
`riesz_lemma_of_norm_lt`. -/
lemma riesz_lemma {F : subspace 𝕜 E} (hFc : is_closed (F : set E))
  (hF : ∃ x : E, x ∉ F) {r : ℝ} (hr : r < 1) :
  ∃ x₀ : E, x₀ ∉ F ∧ ∀ y ∈ F, r * ∥x₀∥ ≤ ∥x₀ - y∥ :=
begin
  classical,
  obtain ⟨x, hx⟩ : ∃ x : E, x ∉ F := hF,
  let d := metric.inf_dist x F,
  have hFn : (F : set E).nonempty, from ⟨_, F.zero_mem⟩,
  have hdp : 0 < d,
    from lt_of_le_of_ne metric.inf_dist_nonneg (λ heq, hx
    ((hFc.mem_iff_inf_dist_zero hFn).2 heq.symm)),
  let r' := max r 2⁻¹,
  have hr' : r' < 1, by { simp [r', hr], norm_num },
  have hlt : 0 < r' := lt_of_lt_of_le (by norm_num) (le_max_right r 2⁻¹),
  have hdlt : d < d / r', from (lt_div_iff hlt).mpr ((mul_lt_iff_lt_one_right hdp).2 hr'),
  obtain ⟨y₀, hy₀F, hxy₀⟩ : ∃ y ∈ F, dist x y < d / r' :=
    metric.exists_dist_lt_of_inf_dist_lt hdlt hFn,
  have x_ne_y₀ : x - y₀ ∉ F,
  { by_contradiction h,
    have : (x - y₀) + y₀ ∈ F, from F.add_mem h hy₀F,
    simp only [neg_add_cancel_right, sub_eq_add_neg] at this,
    exact hx this },
  refine ⟨x - y₀, x_ne_y₀, λy hy, le_of_lt _⟩,
  have hy₀y : y₀ + y ∈ F, from F.add_mem hy₀F hy,
  calc
    r * ∥x - y₀∥ ≤ r' * ∥x - y₀∥ : mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg _)
    ... < d : by { rw ←dist_eq_norm, exact (lt_div_iff' hlt).1 hxy₀ }
    ... ≤ dist x (y₀ + y) : metric.inf_dist_le_dist_of_mem hy₀y
    ... = ∥x - y₀ - y∥ : by { rw [sub_sub, dist_eq_norm] }
end

/--
A version of Riesz lemma: given a strict closed subspace `F`, one may find an element of norm `≤ R`
which is at distance  at least `1` of every element of `F`. Here, `R` is any given constant
strictly larger than the norm of an element of norm `> 1`. For a version without an `R`, see
`riesz_lemma`.

Since we are considering a general nondiscrete normed field, there may be a gap in possible norms
(for instance no element of norm in `(1,2)`). Hence, we can not allow `R` arbitrarily close to `1`,
and require `R > ∥c∥` for some `c : 𝕜` with norm `> 1`.
-/
lemma riesz_lemma_of_norm_lt
  {c : 𝕜} (hc : 1 < ∥c∥) {R : ℝ} (hR : ∥c∥ < R)
  {F : subspace 𝕜 E} (hFc : is_closed (F : set E)) (hF : ∃ x : E, x ∉ F) :
  ∃ x₀ : E, ∥x₀∥ ≤ R ∧ ∀ y ∈ F, 1 ≤ ∥x₀ - y∥ :=
begin
  have Rpos : 0 < R := (norm_nonneg _).trans_lt hR,
  have : ∥c∥ / R < 1, by { rw div_lt_iff Rpos, simpa using hR },
  rcases riesz_lemma hFc hF this with ⟨x, xF, hx⟩,
  have x0 : x ≠ 0 := λ H, by simpa [H] using xF,
  obtain ⟨d, d0, dxlt, ledx, -⟩ :
    ∃ (d : 𝕜), d ≠ 0 ∧ ∥d • x∥ < R ∧ R / ∥c∥ ≤ ∥d • x∥ ∧ ∥d∥⁻¹ ≤ R⁻¹ * ∥c∥ * ∥x∥ :=
      rescale_to_shell hc Rpos x0,
  refine ⟨d • x, dxlt.le, λ y hy, _⟩,
  set y' := d⁻¹ • y with hy',
  have y'F : y' ∈ F, by simp [hy', submodule.smul_mem _ _ hy],
  have yy' : y = d • y', by simp [hy', smul_smul, mul_inv_cancel d0],
  calc 1 = (∥c∥/R) * (R/∥c∥) : by field_simp [Rpos.ne', (zero_lt_one.trans hc).ne']
  ... ≤ (∥c∥/R) * (∥d • x∥) :
    mul_le_mul_of_nonneg_left ledx (div_nonneg (norm_nonneg _) Rpos.le)
  ... = ∥d∥ * (∥c∥/R * ∥x∥) : by { simp [norm_smul], ring }
  ... ≤ ∥d∥ * ∥x - y'∥ :
    mul_le_mul_of_nonneg_left (hx y' (by simp [hy', submodule.smul_mem _ _ hy])) (norm_nonneg _)
  ... = ∥d • x - y∥ : by simp [yy', ← smul_sub, norm_smul],
end


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_51
  (a b : ℝ)
  (h₀ : 0 < a ∧ 0 < b)
  (h₁ : a + b = 35)
  (h₂ : a = (2/5) * b) :
  b - a = 15 :=
begin
  linarith,
end


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

! This file was ported from Lean 3 source module data.set.intervals.disjoint
! leanprover-community/mathlib commit 207cfac9fcd06138865b5d04f7091e46d9320432
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Lattice

/-!
# Extra lemmas about intervals

This file contains lemmas about intervals that cannot be included into `Data.Set.Intervals.Basic`
because this would create an `import` cycle. Namely, lemmas in this file can use definitions
from `Data.Set.Lattice`, including `Disjoint`.
-/

universe u v w

variable {ι : Sort u} {α : Type v} {β : Type w}

open Set

open OrderDual (toDual)

namespace Set

section Preorder

variable [Preorder α] {a b c : α}

@[simp]
theorem Iic_disjoint_Ioi (h : a ≤ b) : Disjoint (Iic a) (Ioi b) :=
  disjoint_left.mpr fun _ ha hb => (h.trans_lt hb).not_le ha
#align set.Iic_disjoint_Ioi Set.Iic_disjoint_Ioi

@[simp]
theorem Iic_disjoint_Ioc (h : a ≤ b) : Disjoint (Iic a) (Ioc b c) :=
  (Iic_disjoint_Ioi h).mono le_rfl fun _ => And.left
#align set.Iic_disjoint_Ioc Set.Iic_disjoint_Ioc

@[simp]
theorem Ioc_disjoint_Ioc_same {a b c : α} : Disjoint (Ioc a b) (Ioc b c) :=
  (Iic_disjoint_Ioc (le_refl b)).mono (fun _ => And.right) le_rfl
#align set.Ioc_disjoint_Ioc_same Set.Ioc_disjoint_Ioc_same

@[simp]
theorem Ico_disjoint_Ico_same {a b c : α} : Disjoint (Ico a b) (Ico b c) :=
  disjoint_left.mpr fun _ hab hbc => hab.2.not_le hbc.1
#align set.Ico_disjoint_Ico_same Set.Ico_disjoint_Ico_same

@[simp]
theorem Ici_disjoint_Iic : Disjoint (Ici a) (Iic b) ↔ ¬a ≤ b := by
  rw [Set.disjoint_iff_inter_eq_empty, Ici_inter_Iic, Icc_eq_empty_iff]
#align set.Ici_disjoint_Iic Set.Ici_disjoint_Iic

@[simp]
theorem Iic_disjoint_Ici : Disjoint (Iic a) (Ici b) ↔ ¬b ≤ a :=
  disjoint_comm.trans Ici_disjoint_Iic
#align set.Iic_disjoint_Ici Set.Iic_disjoint_Ici

@[simp]
theorem unionᵢ_Iic : (⋃ a : α, Iic a) = univ :=
  unionᵢ_eq_univ_iff.2 fun x => ⟨x, right_mem_Iic⟩
#align set.Union_Iic Set.unionᵢ_Iic

@[simp]
theorem unionᵢ_Ici : (⋃ a : α, Ici a) = univ :=
  unionᵢ_eq_univ_iff.2 fun x => ⟨x, left_mem_Ici⟩
#align set.Union_Ici Set.unionᵢ_Ici

@[simp]
theorem unionᵢ_Icc_right (a : α) : (⋃ b, Icc a b) = Ici a := by
  simp only [← Ici_inter_Iic, ← inter_unionᵢ, unionᵢ_Iic, inter_univ]
#align set.Union_Icc_right Set.unionᵢ_Icc_right

@[simp]
theorem unionᵢ_Ioc_right (a : α) : (⋃ b, Ioc a b) = Ioi a := by
  simp only [← Ioi_inter_Iic, ← inter_unionᵢ, unionᵢ_Iic, inter_univ]
#align set.Union_Ioc_right Set.unionᵢ_Ioc_right

@[simp]
theorem unionᵢ_Icc_left (b : α) : (⋃ a, Icc a b) = Iic b := by
  simp only [← Ici_inter_Iic, ← unionᵢ_inter, unionᵢ_Ici, univ_inter]
#align set.Union_Icc_left Set.unionᵢ_Icc_left

@[simp]
theorem unionᵢ_Ico_left (b : α) : (⋃ a, Ico a b) = Iio b := by
  simp only [← Ici_inter_Iio, ← unionᵢ_inter, unionᵢ_Ici, univ_inter]
#align set.Union_Ico_left Set.unionᵢ_Ico_left

@[simp]
theorem unionᵢ_Iio [NoMaxOrder α] : (⋃ a : α, Iio a) = univ :=
  unionᵢ_eq_univ_iff.2 exists_gt
#align set.Union_Iio Set.unionᵢ_Iio

@[simp]
theorem unionᵢ_Ioi [NoMinOrder α] : (⋃ a : α, Ioi a) = univ :=
  unionᵢ_eq_univ_iff.2 exists_lt
#align set.Union_Ioi Set.unionᵢ_Ioi

@[simp]
theorem unionᵢ_Ico_right [NoMaxOrder α] (a : α) : (⋃ b, Ico a b) = Ici a := by
  simp only [← Ici_inter_Iio, ← inter_unionᵢ, unionᵢ_Iio, inter_univ]
#align set.Union_Ico_right Set.unionᵢ_Ico_right

@[simp]
theorem unionᵢ_Ioo_right [NoMaxOrder α] (a : α) : (⋃ b, Ioo a b) = Ioi a := by
  simp only [← Ioi_inter_Iio, ← inter_unionᵢ, unionᵢ_Iio, inter_univ]
#align set.Union_Ioo_right Set.unionᵢ_Ioo_right

@[simp]
theorem unionᵢ_Ioc_left [NoMinOrder α] (b : α) : (⋃ a, Ioc a b) = Iic b := by
  simp only [← Ioi_inter_Iic, ← unionᵢ_inter, unionᵢ_Ioi, univ_inter]
#align set.Union_Ioc_left Set.unionᵢ_Ioc_left

@[simp]
theorem unionᵢ_Ioo_left [NoMinOrder α] (b : α) : (⋃ a, Ioo a b) = Iio b := by
  simp only [← Ioi_inter_Iio, ← unionᵢ_inter, unionᵢ_Ioi, univ_inter]
#align set.Union_Ioo_left Set.unionᵢ_Ioo_left

end Preorder

section LinearOrder

variable [LinearOrder α] {a₁ a₂ b₁ b₂ : α}

@[simp]
theorem Ico_disjoint_Ico : Disjoint (Ico a₁ a₂) (Ico b₁ b₂) ↔ min a₂ b₂ ≤ max a₁ b₁ := by
  simp_rw [Set.disjoint_iff_inter_eq_empty, Ico_inter_Ico, Ico_eq_empty_iff, inf_eq_min, sup_eq_max,
    not_lt]
#align set.Ico_disjoint_Ico Set.Ico_disjoint_Ico

@[simp]
theorem Ioc_disjoint_Ioc : Disjoint (Ioc a₁ a₂) (Ioc b₁ b₂) ↔ min a₂ b₂ ≤ max a₁ b₁ := by
  have h : _ ↔ min (toDual a₁) (toDual b₁) ≤ max (toDual a₂) (toDual b₂) := Ico_disjoint_Ico
  simpa only [dual_Ico] using h
#align set.Ioc_disjoint_Ioc Set.Ioc_disjoint_Ioc

/-- If two half-open intervals are disjoint and the endpoint of one lies in the other,
  then it must be equal to the endpoint of the other. -/
theorem eq_of_Ico_disjoint {x₁ x₂ y₁ y₂ : α} (h : Disjoint (Ico x₁ x₂) (Ico y₁ y₂)) (hx : x₁ < x₂)
    (h2 : x₂ ∈ Ico y₁ y₂) : y₁ = x₂ := by
  rw [Ico_disjoint_Ico, min_eq_left (le_of_lt h2.2), le_max_iff] at h
  apply le_antisymm h2.1
  exact h.elim (fun h => absurd hx (not_lt_of_le h)) id
#align set.eq_of_Ico_disjoint Set.eq_of_Ico_disjoint

@[simp]
theorem unionᵢ_Ico_eq_Iio_self_iff {f : ι → α} {a : α} :
    (⋃ i, Ico (f i) a) = Iio a ↔ ∀ x < a, ∃ i, f i ≤ x := by
  simp [← Ici_inter_Iio, ← unionᵢ_inter, subset_def]
#align set.Union_Ico_eq_Iio_self_iff Set.unionᵢ_Ico_eq_Iio_self_iff

@[simp]
theorem unionᵢ_Ioc_eq_Ioi_self_iff {f : ι → α} {a : α} :
    (⋃ i, Ioc a (f i)) = Ioi a ↔ ∀ x, a < x → ∃ i, x ≤ f i := by
  simp [← Ioi_inter_Iic, ← inter_unionᵢ, subset_def]
#align set.Union_Ioc_eq_Ioi_self_iff Set.unionᵢ_Ioc_eq_Ioi_self_iff

@[simp]
theorem bunionᵢ_Ico_eq_Iio_self_iff {p : ι → Prop} {f : ∀ i, p i → α} {a : α} :
    (⋃ (i) (hi : p i), Ico (f i hi) a) = Iio a ↔ ∀ x < a, ∃ i hi, f i hi ≤ x := by
  simp [← Ici_inter_Iio, ← unionᵢ_inter, subset_def]
#align set.bUnion_Ico_eq_Iio_self_iff Set.bunionᵢ_Ico_eq_Iio_self_iff

@[simp]
theorem bunionᵢ_Ioc_eq_Ioi_self_iff {p : ι → Prop} {f : ∀ i, p i → α} {a : α} :
    (⋃ (i) (hi : p i), Ioc a (f i hi)) = Ioi a ↔ ∀ x, a < x → ∃ i hi, x ≤ f i hi := by
  simp [← Ioi_inter_Iic, ← inter_unionᵢ, subset_def]
#align set.bUnion_Ioc_eq_Ioi_self_iff Set.bunionᵢ_Ioc_eq_Ioi_self_iff

end LinearOrder

end Set

section UnionIxx

variable [LinearOrder α] {s : Set α} {a : α} {f : ι → α}

theorem IsGLB.bunionᵢ_Ioi_eq (h : IsGLB s a) : (⋃ x ∈ s, Ioi x) = Ioi a := by
  refine' (unionᵢ₂_subset fun x hx => _).antisymm fun x hx => _
  · exact Ioi_subset_Ioi (h.1 hx)
  · rcases h.exists_between hx with ⟨y, hys, _, hyx⟩
    exact mem_bunionᵢ hys hyx
#align is_glb.bUnion_Ioi_eq IsGLB.bunionᵢ_Ioi_eq

theorem IsGLB.unionᵢ_Ioi_eq (h : IsGLB (range f) a) : (⋃ x, Ioi (f x)) = Ioi a :=
  bunionᵢ_range.symm.trans h.bunionᵢ_Ioi_eq
#align is_glb.Union_Ioi_eq IsGLB.unionᵢ_Ioi_eq

theorem IsLUB.bunionᵢ_Iio_eq (h : IsLUB s a) : (⋃ x ∈ s, Iio x) = Iio a :=
  h.dual.bunionᵢ_Ioi_eq
#align is_lub.bUnion_Iio_eq IsLUB.bunionᵢ_Iio_eq

theorem IsLUB.unionᵢ_Iio_eq (h : IsLUB (range f) a) : (⋃ x, Iio (f x)) = Iio a :=
  h.dual.unionᵢ_Ioi_eq
#align is_lub.Union_Iio_eq IsLUB.unionᵢ_Iio_eq

theorem IsGLB.bunionᵢ_Ici_eq_Ioi (a_glb : IsGLB s a) (a_not_mem : a ∉ s) :
    (⋃ x ∈ s, Ici x) = Ioi a := by
  refine' (unionᵢ₂_subset fun x hx => _).antisymm fun x hx => _
  · exact Ici_subset_Ioi.mpr (lt_of_le_of_ne (a_glb.1 hx) fun h => (h ▸ a_not_mem) hx)
  · rcases a_glb.exists_between hx with ⟨y, hys, _, hyx⟩
    apply mem_unionᵢ₂.mpr
    refine' ⟨y, hys, hyx.le⟩
#align is_glb.bUnion_Ici_eq_Ioi IsGLB.bunionᵢ_Ici_eq_Ioi

theorem IsGLB.bunionᵢ_Ici_eq_Ici (a_glb : IsGLB s a) (a_mem : a ∈ s) :
    (⋃ x ∈ s, Ici x) = Ici a := by
  refine' (unionᵢ₂_subset fun x hx => _).antisymm fun x hx => _
  · exact Ici_subset_Ici.mpr (mem_lowerBounds.mp a_glb.1 x hx)
  · apply mem_unionᵢ₂.mpr
    refine' ⟨a, a_mem, hx⟩
#align is_glb.bUnion_Ici_eq_Ici IsGLB.bunionᵢ_Ici_eq_Ici

theorem IsLUB.bunionᵢ_Iic_eq_Iio (a_lub : IsLUB s a) (a_not_mem : a ∉ s) :
    (⋃ x ∈ s, Iic x) = Iio a :=
  a_lub.dual.bunionᵢ_Ici_eq_Ioi a_not_mem
#align is_lub.bUnion_Iic_eq_Iio IsLUB.bunionᵢ_Iic_eq_Iio

theorem IsLUB.bunionᵢ_Iic_eq_Iic (a_lub : IsLUB s a) (a_mem : a ∈ s) : (⋃ x ∈ s, Iic x) = Iic a :=
  a_lub.dual.bunionᵢ_Ici_eq_Ici a_mem
#align is_lub.bUnion_Iic_eq_Iic IsLUB.bunionᵢ_Iic_eq_Iic

theorem unionᵢ_Ici_eq_Ioi_infᵢ {R : Type _} [CompleteLinearOrder R] {f : ι → R}
    (no_least_elem : (⨅ i, f i) ∉ range f) : (⋃ i : ι, Ici (f i)) = Ioi (⨅ i, f i) := by
  simp only [← IsGLB.bunionᵢ_Ici_eq_Ioi (@isGLB_infᵢ _ _ _ f) no_least_elem, mem_range,
    unionᵢ_exists, unionᵢ_unionᵢ_eq']
#align Union_Ici_eq_Ioi_infi unionᵢ_Ici_eq_Ioi_infᵢ

theorem unionᵢ_Iic_eq_Iio_supᵢ {R : Type _} [CompleteLinearOrder R] {f : ι → R}
    (no_greatest_elem : (⨆ i, f i) ∉ range f) : (⋃ i : ι, Iic (f i)) = Iio (⨆ i, f i) :=
  @unionᵢ_Ici_eq_Ioi_infᵢ ι (OrderDual R) _ f no_greatest_elem
#align Union_Iic_eq_Iio_supr unionᵢ_Iic_eq_Iio_supᵢ

theorem unionᵢ_Ici_eq_Ici_infᵢ {R : Type _} [CompleteLinearOrder R] {f : ι → R}
    (has_least_elem : (⨅ i, f i) ∈ range f) : (⋃ i : ι, Ici (f i)) = Ici (⨅ i, f i) := by
  simp only [← IsGLB.bunionᵢ_Ici_eq_Ici (@isGLB_infᵢ _ _ _ f) has_least_elem, mem_range,
    unionᵢ_exists, unionᵢ_unionᵢ_eq']
#align Union_Ici_eq_Ici_infi unionᵢ_Ici_eq_Ici_infᵢ

theorem unionᵢ_Iic_eq_Iic_supᵢ {R : Type _} [CompleteLinearOrder R] {f : ι → R}
    (has_greatest_elem : (⨆ i, f i) ∈ range f) : (⋃ i : ι, Iic (f i)) = Iic (⨆ i, f i) :=
  @unionᵢ_Ici_eq_Ici_infᵢ ι (OrderDual R) _ f has_greatest_elem
#align Union_Iic_eq_Iic_supr unionᵢ_Iic_eq_Iic_supᵢ

end UnionIxx


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.sigma.basic
import order.rel_classes

/-!
# Lexicographic order on a sigma type

This defines the lexicographical order of two arbitrary relations on a sigma type and proves some
lemmas about `psigma.lex`, which is defined in core Lean.

Given a relation in the index type and a relation on each summand, the lexicographical order on the
sigma type relates `a` and `b` if their summands are related or they are in the same summand and
related by the summand's relation.

## See also

Related files are:
* `data.finset.colex`: Colexicographic order on finite sets.
* `data.list.lex`: Lexicographic order on lists.
* `data.sigma.order`: Lexicographic order on `Σ i, α i` per say.
* `data.psigma.order`: Lexicographic order on `Σ' i, α i`.
* `data.prod.lex`: Lexicographic order on `α × β`. Can be thought of as the special case of
  `sigma.lex` where all summands are the same
-/

namespace sigma
variables {ι : Type*} {α : ι → Type*} {r r₁ r₂ : ι → ι → Prop} {s s₁ s₂ : Π i, α i → α i → Prop}
  {a b : Σ i, α i}

/-- The lexicographical order on a sigma type. It takes in a relation on the index type and a
relation for each summand. `a` is related to `b` iff their summands are related or they are in the
same summand and are related through the summand's relation. -/
inductive lex (r : ι → ι → Prop) (s : Π i, α i → α i → Prop) : Π a b : Σ i, α i, Prop
| left {i j : ι} (a : α i) (b : α j) : r i j → lex ⟨i, a⟩ ⟨j, b⟩
| right {i : ι} (a b : α i)          : s i a b → lex ⟨i, a⟩ ⟨i, b⟩

lemma lex_iff : lex r s a b ↔ r a.1 b.1 ∨ ∃ h : a.1 = b.1, s _ (h.rec a.2) b.2 :=
begin
  split,
  { rintro (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩),
    { exact or.inl hij },
    { exact or.inr ⟨rfl, hab⟩ } },
  { obtain ⟨i, a⟩ := a,
    obtain ⟨j, b⟩ := b,
    dsimp only,
    rintro (h | ⟨rfl, h⟩),
    { exact lex.left _ _ h },
    { exact lex.right _ _ h } }
end

instance lex.decidable (r : ι → ι → Prop) (s : Π i, α i → α i → Prop) [decidable_eq ι]
  [decidable_rel r] [Π i, decidable_rel (s i)] :
  decidable_rel (lex r s) :=
λ a b, decidable_of_decidable_of_iff infer_instance lex_iff.symm

lemma lex.mono (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ i a b, s₁ i a b → s₂ i a b) {a b : Σ i, α i}
  (h : lex r₁ s₁ a b) :
  lex r₂ s₂ a b :=
begin
  obtain (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩) := h,
  { exact lex.left _ _ (hr _ _ hij) },
  { exact lex.right _ _ (hs _ _ _ hab) }
end

lemma lex.mono_left (hr : ∀ a b, r₁ a b → r₂ a b) {a b : Σ i, α i} (h : lex r₁ s a b) :
  lex r₂ s a b :=
h.mono hr $ λ _ _ _, id

lemma lex.mono_right (hs : ∀ i a b, s₁ i a b → s₂ i a b) {a b : Σ i, α i} (h : lex r s₁ a b) :
  lex r s₂ a b :=
h.mono (λ _ _, id) hs

instance [Π i, is_refl (α i) (s i)] : is_refl _ (lex r s) := ⟨λ ⟨i, a⟩, lex.right _ _ $ refl _⟩

instance [is_irrefl ι r] [Π i, is_irrefl (α i) (s i)] : is_irrefl _ (lex r s) :=
⟨begin
  rintro _ (⟨i, j, a, b, hi⟩ | ⟨i, a, b, ha⟩),
  { exact irrefl _ hi },
  { exact irrefl _ ha }
end⟩

instance [is_trans ι r] [Π i, is_trans (α i) (s i)] : is_trans _ (lex r s) :=
⟨begin
  rintro _ _ _ (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩) (⟨_, k, _, c, hk⟩ | ⟨_, _, c, hc⟩),
  { exact lex.left _ _ (trans hij hk) },
  { exact lex.left _ _ hij },
  { exact lex.left _ _ hk },
  { exact lex.right _ _ (trans hab hc) }
end⟩

instance [is_symm ι r] [Π i, is_symm (α i) (s i)] : is_symm _ (lex r s) :=
⟨begin
  rintro _ _ (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩),
  { exact lex.left _ _ (symm hij) },
  { exact lex.right _ _ (symm hab) }
end⟩

local attribute [instance] is_asymm.is_irrefl

instance [is_asymm ι r] [Π i, is_antisymm (α i) (s i)] : is_antisymm _ (lex r s) :=
⟨begin
  rintro _ _ (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩) (⟨_, _, _, _, hji⟩ | ⟨_, _, _, hba⟩),
  { exact (asymm hij hji).elim },
  { exact (irrefl _ hij).elim },
  { exact (irrefl _ hji).elim },
  { exact ext rfl (heq_of_eq $ antisymm hab hba) }
end⟩

instance [is_trichotomous ι r] [Π i, is_total (α i) (s i)] : is_total _ (lex r s) :=
⟨begin
  rintro ⟨i, a⟩ ⟨j, b⟩,
  obtain hij | rfl | hji := trichotomous_of r i j,
  { exact or.inl (lex.left _ _ hij) },
  { obtain hab | hba := total_of (s i) a b,
    { exact or.inl (lex.right _ _ hab) },
    { exact or.inr (lex.right _ _ hba) } },
  { exact or.inr (lex.left _ _ hji) }
end⟩

instance [is_trichotomous ι r] [Π i, is_trichotomous (α i) (s i)] : is_trichotomous _ (lex r s) :=
⟨begin
  rintro ⟨i, a⟩ ⟨j, b⟩,
  obtain hij | rfl | hji := trichotomous_of r i j,
  { exact or.inl (lex.left _ _ hij) },
  { obtain hab | rfl | hba := trichotomous_of (s i) a b,
    { exact or.inl (lex.right _ _ hab) },
    { exact or.inr (or.inl rfl) },
    { exact or.inr (or.inr $ lex.right _ _ hba) } },
  { exact or.inr (or.inr $ lex.left _ _ hji) }
end⟩

end sigma

/-! ### `psigma` -/

namespace psigma
variables {ι : Sort*} {α : ι → Sort*} {r r₁ r₂ : ι → ι → Prop} {s s₁ s₂ : Π i, α i → α i → Prop}

lemma lex_iff {a b : Σ' i, α i} : lex r s a b ↔ r a.1 b.1 ∨ ∃ h : a.1 = b.1, s _ (h.rec a.2) b.2 :=
begin
  split,
  { rintro (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩),
    { exact or.inl hij },
    { exact or.inr ⟨rfl, hab⟩ } },
  { obtain ⟨i, a⟩ := a,
    obtain ⟨j, b⟩ := b,
    dsimp only,
    rintro (h | ⟨rfl, h⟩),
    { exact lex.left _ _ h },
    { exact lex.right _ h } }
end

instance lex.decidable (r : ι → ι → Prop) (s : Π i, α i → α i → Prop) [decidable_eq ι]
  [decidable_rel r] [Π i, decidable_rel (s i)] :
  decidable_rel (lex r s) :=
λ a b, decidable_of_decidable_of_iff infer_instance lex_iff.symm

lemma lex.mono {r₁ r₂ : ι → ι → Prop} {s₁ s₂ : Π i, α i → α i → Prop}
  (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ i a b, s₁ i a b → s₂ i a b) {a b : Σ' i, α i}
  (h : lex r₁ s₁ a b) :
  lex r₂ s₂ a b :=
begin
  obtain (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩) := h,
  { exact lex.left _ _ (hr _ _ hij) },
  { exact lex.right _ (hs _ _ _ hab) }
end

lemma lex.mono_left {r₁ r₂ : ι → ι → Prop} {s : Π i, α i → α i → Prop}
  (hr : ∀ a b, r₁ a b → r₂ a b) {a b : Σ' i, α i} (h : lex r₁ s a b) :
  lex r₂ s a b :=
h.mono hr $ λ _ _ _, id

lemma lex.mono_right {r : ι → ι → Prop} {s₁ s₂ : Π i, α i → α i → Prop}
  (hs : ∀ i a b, s₁ i a b → s₂ i a b) {a b : Σ' i, α i} (h : lex r s₁ a b) :
  lex r s₂ a b :=
h.mono (λ _ _, id) hs

end psigma


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

Theory of complete Boolean algebras.
-/
import order.complete_lattice

set_option old_structure_cmd true

universes u v w
variables {α : Type u} {β : Type v} {ι : Sort w}

/-- A complete distributive lattice is a bit stronger than the name might
  suggest; perhaps completely distributive lattice is more descriptive,
  as this class includes a requirement that the lattice join
  distribute over *arbitrary* infima, and similarly for the dual. -/
class complete_distrib_lattice α extends complete_lattice α :=
(infi_sup_le_sup_Inf : ∀a s, (⨅ b ∈ s, a ⊔ b) ≤ a ⊔ Inf s)
(inf_Sup_le_supr_inf : ∀a s, a ⊓ Sup s ≤ (⨆ b ∈ s, a ⊓ b))

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

instance : complete_distrib_lattice (order_dual α) :=
{ infi_sup_le_sup_Inf := complete_distrib_lattice.inf_Sup_le_supr_inf,
  inf_Sup_le_supr_inf := complete_distrib_lattice.infi_sup_le_sup_Inf,
  .. order_dual.complete_lattice α }

theorem sup_Inf_eq : a ⊔ Inf s = (⨅ b ∈ s, a ⊔ b) :=
sup_Inf_le_infi_sup.antisymm (complete_distrib_lattice.infi_sup_le_sup_Inf _ _)

theorem Inf_sup_eq : Inf s ⊔ b = (⨅ a ∈ s, a ⊔ b) :=
by simpa only [sup_comm] using @sup_Inf_eq α _ b s

theorem inf_Sup_eq : a ⊓ Sup s = (⨆ b ∈ s, a ⊓ b) :=
(complete_distrib_lattice.inf_Sup_le_supr_inf _ _).antisymm supr_inf_le_inf_Sup

theorem Sup_inf_eq : Sup s ⊓ b = (⨆ a ∈ s, a ⊓ b) :=
by simpa only [inf_comm] using @inf_Sup_eq α _ b s

theorem supr_inf_eq (f : ι → α) (a : α) : (⨆ i, f i) ⊓ a = ⨆ i, f i ⊓ a :=
by rw [supr, Sup_inf_eq, supr_range]

theorem inf_supr_eq (a : α) (f : ι → α) : a ⊓ (⨆ i, f i) = ⨆ i, a ⊓ f i :=
by simpa only [inf_comm] using supr_inf_eq f a

theorem infi_sup_eq (f : ι → α) (a : α) : (⨅ i, f i) ⊔ a = ⨅ i, f i ⊔ a :=
@supr_inf_eq (order_dual α) _ _ _ _

theorem sup_infi_eq (a : α) (f : ι → α) : a ⊔ (⨅ i, f i) = ⨅ i, a ⊔ f i :=
@inf_supr_eq (order_dual α) _ _ _ _

theorem Inf_sup_Inf : Inf s ⊔ Inf t = (⨅p ∈ set.prod s t, (p : α × α).1 ⊔ p.2) :=
begin
  apply le_antisymm,
  { finish },
  { have : ∀ a ∈ s, (⨅p ∈ set.prod s t, (p : α × α).1 ⊔ p.2) ≤ a ⊔ Inf t,
    { assume a ha,
      have : (⨅p ∈ set.prod s t, ((p : α × α).1 : α) ⊔ p.2) ≤
             (⨅p ∈ prod.mk a '' t, (p : α × α).1 ⊔ p.2),
      { apply infi_le_infi_of_subset,
        rintros ⟨x, y⟩,
        simp only [and_imp, set.mem_image, prod.mk.inj_iff, set.prod_mk_mem_set_prod_eq,
                   exists_imp_distrib],
        assume x' x't ax x'y,
        rw [← x'y, ← ax],
        simp [ha, x't] },
      rw [infi_image] at this,
      simp only at this,
      rwa ← sup_Inf_eq at this },
    calc (⨅p ∈ set.prod s t, (p : α × α).1 ⊔ p.2) ≤ (⨅a∈s, a ⊔ Inf t) : by simp; exact this
       ... = Inf s ⊔ Inf t : Inf_sup_eq.symm }
end

theorem Sup_inf_Sup : Sup s ⊓ Sup t = (⨆p ∈ set.prod s t, (p : α × α).1 ⊓ p.2) :=
@Inf_sup_Inf (order_dual α) _ _ _

lemma supr_disjoint_iff {f : ι → α} : disjoint (⨆ i, f i) a ↔ ∀ i, disjoint (f i) a :=
by simp only [disjoint_iff, supr_inf_eq, supr_eq_bot]

lemma disjoint_supr_iff {f : ι → α} : disjoint a (⨆ i, f i) ↔ ∀ i, disjoint a (f i) :=
by simpa only [disjoint.comm] using @supr_disjoint_iff _ _ _ a f

end complete_distrib_lattice

@[priority 100] -- see Note [lower instance priority]
instance complete_distrib_lattice.bounded_distrib_lattice [d : complete_distrib_lattice α] :
  bounded_distrib_lattice α :=
{ le_sup_inf := λ x y z, by rw [← Inf_pair, ← Inf_pair, sup_Inf_eq, ← Inf_image, set.image_pair],
  ..d }

/-- A complete boolean algebra is a completely distributive boolean algebra. -/
class complete_boolean_algebra α extends boolean_algebra α, complete_distrib_lattice α

section complete_boolean_algebra
variables [complete_boolean_algebra α] {a b : α} {s : set α} {f : ι → α}

theorem compl_infi : (infi f)ᶜ = (⨆i, (f i)ᶜ) :=
le_antisymm
  (compl_le_of_compl_le $ le_infi $ assume i, compl_le_of_compl_le $ le_supr (compl ∘ f) i)
  (supr_le $ assume i, compl_le_compl $ infi_le _ _)

theorem compl_supr : (supr f)ᶜ = (⨅i, (f i)ᶜ) :=
compl_injective (by simp [compl_infi])

theorem compl_Inf : (Inf s)ᶜ = (⨆i∈s, iᶜ) :=
by simp only [Inf_eq_infi, compl_infi]

theorem compl_Sup : (Sup s)ᶜ = (⨅i∈s, iᶜ) :=
by simp only [Sup_eq_supr, compl_supr]

end complete_boolean_algebra


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Johannes Hölzl, Mario Carneiro, Patrick Massot
-/
import data.prod.pprod
import data.set.countable
import order.filter.basic

/-!
# Filter bases

A filter basis `B : filter_basis α` on a type `α` is a nonempty collection of sets of `α`
such that the intersection of two elements of this collection contains some element of
the collection. Compared to filters, filter bases do not require that any set containing
an element of `B` belongs to `B`.
A filter basis `B` can be used to construct `B.filter : filter α` such that a set belongs
to `B.filter` if and only if it contains an element of `B`.

Given an indexing type `ι`, a predicate `p : ι → Prop`, and a map `s : ι → set α`,
the proposition `h : filter.is_basis p s` makes sure the range of `s` bounded by `p`
(ie. `s '' set_of p`) defines a filter basis `h.filter_basis`.

If one already has a filter `l` on `α`, `filter.has_basis l p s` (where `p : ι → Prop`
and `s : ι → set α` as above) means that a set belongs to `l` if and
only if it contains some `s i` with `p i`. It implies `h : filter.is_basis p s`, and
`l = h.filter_basis.filter`. The point of this definition is that checking statements
involving elements of `l` often reduces to checking them on the basis elements.

We define a function `has_basis.index (h : filter.has_basis l p s) (t) (ht : t ∈ l)` that returns
some index `i` such that `p i` and `s i ⊆ t`. This function can be useful to avoid manual
destruction of `h.mem_iff.mpr ht` using `cases` or `let`.

This file also introduces more restricted classes of bases, involving monotonicity or
countability. In particular, for `l : filter α`, `l.is_countably_generated` means
there is a countable set of sets which generates `s`. This is reformulated in term of bases,
and consequences are derived.

## Main statements

* `has_basis.mem_iff`, `has_basis.mem_of_superset`, `has_basis.mem_of_mem` : restate `t ∈ f`
  in terms of a basis;
* `basis_sets` : all sets of a filter form a basis;
* `has_basis.inf`, `has_basis.inf_principal`, `has_basis.prod`, `has_basis.prod_self`,
  `has_basis.map`, `has_basis.comap` : combinators to construct filters of `l ⊓ l'`,
  `l ⊓ 𝓟 t`, `l ×ᶠ l'`, `l ×ᶠ l`, `l.map f`, `l.comap f` respectively;
* `has_basis.le_iff`, `has_basis.ge_iff`, has_basis.le_basis_iff` : restate `l ≤ l'` in terms
  of bases.
* `has_basis.tendsto_right_iff`, `has_basis.tendsto_left_iff`, `has_basis.tendsto_iff` : restate
  `tendsto f l l'` in terms of bases.
* `is_countably_generated_iff_exists_antitone_basis` : proves a filter is
  countably generated if and only if it admits a basis parametrized by a
  decreasing sequence of sets indexed by `ℕ`.
* `tendsto_iff_seq_tendsto ` : an abstract version of "sequentially continuous implies continuous".

## Implementation notes

As with `Union`/`bUnion`/`sUnion`, there are three different approaches to filter bases:

* `has_basis l s`, `s : set (set α)`;
* `has_basis l s`, `s : ι → set α`;
* `has_basis l p s`, `p : ι → Prop`, `s : ι → set α`.

We use the latter one because, e.g., `𝓝 x` in an `emetric_space` or in a `metric_space` has a basis
of this form. The other two can be emulated using `s = id` or `p = λ _, true`.

With this approach sometimes one needs to `simp` the statement provided by the `has_basis`
machinery, e.g., `simp only [exists_prop, true_and]` or `simp only [forall_const]` can help
with the case `p = λ _, true`.
-/

open set filter
open_locale filter classical

section sort

variables {α β γ : Type*} {ι ι' : Sort*}

/-- A filter basis `B` on a type `α` is a nonempty collection of sets of `α`
such that the intersection of two elements of this collection contains some element
of the collection. -/
structure filter_basis (α : Type*) :=
(sets                   : set (set α))
(nonempty               : sets.nonempty)
(inter_sets {x y}       : x ∈ sets → y ∈ sets → ∃ z ∈ sets, z ⊆ x ∩ y)

instance filter_basis.nonempty_sets (B : filter_basis α) : nonempty B.sets := B.nonempty.to_subtype

/-- If `B` is a filter basis on `α`, and `U` a subset of `α` then we can write `U ∈ B` as
on paper. -/
@[reducible]
instance {α : Type*}: has_mem (set α) (filter_basis α) := ⟨λ U B, U ∈ B.sets⟩

-- For illustration purposes, the filter basis defining (at_top : filter ℕ)
instance : inhabited (filter_basis ℕ) :=
⟨{ sets := range Ici,
  nonempty := ⟨Ici 0, mem_range_self 0⟩,
  inter_sets := begin
    rintros _ _ ⟨n, rfl⟩ ⟨m, rfl⟩,
    refine ⟨Ici (max n m), mem_range_self _, _⟩,
    rintros p p_in,
    split ; rw mem_Ici at *,
    exact le_of_max_le_left p_in,
    exact le_of_max_le_right p_in,
  end }⟩

/-- View a filter as a filter basis. -/
def filter.as_basis (f : filter α) : filter_basis α :=
⟨f.sets, ⟨univ, univ_mem⟩, λ x y hx hy, ⟨x ∩ y, inter_mem hx hy, subset_rfl⟩⟩

/-- `is_basis p s` means the image of `s` bounded by `p` is a filter basis. -/
protected structure filter.is_basis (p : ι → Prop) (s : ι → set α) : Prop :=
(nonempty : ∃ i, p i)
(inter : ∀ {i j}, p i → p j → ∃ k, p k ∧ s k ⊆ s i ∩ s j)

namespace filter
namespace is_basis

/-- Constructs a filter basis from an indexed family of sets satisfying `is_basis`. -/
protected def filter_basis {p : ι → Prop} {s : ι → set α} (h : is_basis p s) : filter_basis α :=
{ sets := {t | ∃ i, p i ∧ s i = t},
  nonempty := let ⟨i, hi⟩ := h.nonempty in ⟨s i, ⟨i, hi, rfl⟩⟩,
  inter_sets := by { rintros _ _ ⟨i, hi, rfl⟩ ⟨j, hj, rfl⟩,
                     rcases h.inter hi hj with ⟨k, hk, hk'⟩,
                     exact ⟨_, ⟨k, hk, rfl⟩, hk'⟩ } }

variables {p : ι → Prop} {s : ι → set α} (h : is_basis p s)

lemma mem_filter_basis_iff {U : set α} : U ∈ h.filter_basis ↔ ∃ i, p i ∧ s i = U :=
iff.rfl
end is_basis
end filter

namespace filter_basis

/-- The filter associated to a filter basis. -/
protected def filter (B : filter_basis α) : filter α :=
{ sets := {s | ∃ t ∈ B, t ⊆ s},
  univ_sets := let ⟨s, s_in⟩ := B.nonempty in ⟨s, s_in, s.subset_univ⟩,
  sets_of_superset := λ x y ⟨s, s_in, h⟩ hxy, ⟨s, s_in, set.subset.trans h hxy⟩,
  inter_sets := λ x y ⟨s, s_in, hs⟩ ⟨t, t_in, ht⟩,
                let ⟨u, u_in, u_sub⟩ := B.inter_sets s_in t_in in
                ⟨u, u_in, set.subset.trans u_sub $ set.inter_subset_inter hs ht⟩ }

lemma mem_filter_iff (B : filter_basis α) {U : set α} : U ∈ B.filter ↔ ∃ s ∈ B, s ⊆ U :=
iff.rfl

lemma mem_filter_of_mem (B : filter_basis α) {U : set α} : U ∈ B → U ∈ B.filter:=
λ U_in, ⟨U, U_in, subset.refl _⟩

lemma eq_infi_principal (B : filter_basis α) : B.filter = ⨅ s : B.sets, 𝓟 s :=
begin
  have : directed (≥) (λ (s : B.sets), 𝓟 (s : set α)),
  { rintros ⟨U, U_in⟩ ⟨V, V_in⟩,
    rcases B.inter_sets U_in V_in with ⟨W, W_in, W_sub⟩,
    use [W, W_in],
    simp only [ge_iff_le, le_principal_iff, mem_principal, subtype.coe_mk],
    exact subset_inter_iff.mp W_sub },
  ext U,
  simp [mem_filter_iff, mem_infi_of_directed this]
end

protected lemma generate (B : filter_basis α) : generate B.sets = B.filter :=
begin
  apply le_antisymm,
  { intros U U_in,
    rcases B.mem_filter_iff.mp U_in with ⟨V, V_in, h⟩,
    exact generate_sets.superset (generate_sets.basic V_in) h },
  { rw sets_iff_generate,
    apply mem_filter_of_mem }
end
end filter_basis

namespace filter
namespace is_basis
variables {p : ι → Prop} {s : ι → set α}

/-- Constructs a filter from an indexed family of sets satisfying `is_basis`. -/
protected def filter (h : is_basis p s) : filter α := h.filter_basis.filter

protected lemma mem_filter_iff (h : is_basis p s) {U : set α} :
  U ∈ h.filter ↔ ∃ i, p i ∧ s i ⊆ U :=
begin
  erw [h.filter_basis.mem_filter_iff],
  simp only [mem_filter_basis_iff h, exists_prop],
  split,
  { rintros ⟨_, ⟨i, pi, rfl⟩, h⟩,
    tauto },
  { tauto }
end

lemma filter_eq_generate (h : is_basis p s) : h.filter = generate {U | ∃ i, p i ∧ s i = U} :=
by erw h.filter_basis.generate ; refl
end is_basis

/-- We say that a filter `l` has a basis `s : ι → set α` bounded by `p : ι → Prop`,
if `t ∈ l` if and only if `t` includes `s i` for some `i` such that `p i`. -/
protected structure has_basis (l : filter α) (p : ι → Prop) (s : ι → set α) : Prop :=
(mem_iff' : ∀ (t : set α), t ∈ l ↔ ∃ i (hi : p i), s i ⊆ t)

section same_type

variables {l l' : filter α} {p : ι → Prop} {s : ι → set α} {t : set α} {i : ι}
  {p' : ι' → Prop} {s' : ι' → set α} {i' : ι'}

lemma has_basis_generate (s : set (set α)) :
  (generate s).has_basis (λ t, set.finite t ∧ t ⊆ s) (λ t, ⋂₀ t) :=
⟨begin
  intro U,
  rw mem_generate_iff,
  apply exists_congr,
  tauto
end⟩

/-- The smallest filter basis containing a given collection of sets. -/
def filter_basis.of_sets (s : set (set α)) : filter_basis α :=
{ sets := sInter '' { t | set.finite t ∧ t ⊆ s},
  nonempty := ⟨univ, ∅, ⟨⟨finite_empty, empty_subset s⟩, sInter_empty⟩⟩,
  inter_sets := begin
    rintros _ _ ⟨a, ⟨fina, suba⟩, rfl⟩ ⟨b, ⟨finb, subb⟩, rfl⟩,
    exact ⟨⋂₀ (a ∪ b), mem_image_of_mem _ ⟨fina.union finb, union_subset suba subb⟩,
           by rw sInter_union⟩,
  end }

/-- Definition of `has_basis` unfolded with implicit set argument. -/
lemma has_basis.mem_iff (hl : l.has_basis p s) : t ∈ l ↔ ∃ i (hi : p i), s i ⊆ t :=
hl.mem_iff' t

lemma has_basis.eq_of_same_basis (hl : l.has_basis p s) (hl' : l'.has_basis p s) : l = l' :=
begin
  ext t,
  rw [hl.mem_iff, hl'.mem_iff]
end

lemma has_basis_iff : l.has_basis p s ↔ ∀ t, t ∈ l ↔ ∃ i (hi : p i), s i ⊆ t :=
⟨λ ⟨h⟩, h, λ h, ⟨h⟩⟩

lemma has_basis.ex_mem (h : l.has_basis p s) : ∃ i, p i :=
let ⟨i, pi, h⟩ := h.mem_iff.mp univ_mem in ⟨i, pi⟩

protected lemma has_basis.nonempty (h : l.has_basis p s) : nonempty ι :=
nonempty_of_exists h.ex_mem

protected lemma is_basis.has_basis (h : is_basis p s) : has_basis h.filter p s :=
⟨λ t, by simp only [h.mem_filter_iff, exists_prop]⟩

lemma has_basis.mem_of_superset (hl : l.has_basis p s) (hi : p i) (ht : s i ⊆ t) : t ∈ l :=
(hl.mem_iff).2 ⟨i, hi, ht⟩

lemma has_basis.mem_of_mem (hl : l.has_basis p s) (hi : p i) : s i ∈ l :=
hl.mem_of_superset hi $ subset.refl _

/-- Index of a basis set such that `s i ⊆ t` as an element of `subtype p`. -/
noncomputable def has_basis.index (h : l.has_basis p s) (t : set α) (ht : t ∈ l) :
  {i : ι // p i} :=
⟨(h.mem_iff.1 ht).some, (h.mem_iff.1 ht).some_spec.fst⟩

lemma has_basis.property_index (h : l.has_basis p s) (ht : t ∈ l) : p (h.index t ht) :=
(h.index t ht).2

lemma has_basis.set_index_mem (h : l.has_basis p s) (ht : t ∈ l) : s (h.index t ht) ∈ l :=
h.mem_of_mem $ h.property_index _

lemma has_basis.set_index_subset (h : l.has_basis p s) (ht : t ∈ l) : s (h.index t ht) ⊆ t :=
(h.mem_iff.1 ht).some_spec.snd

lemma has_basis.is_basis (h : l.has_basis p s) : is_basis p s :=
{ nonempty := let ⟨i, hi, H⟩ := h.mem_iff.mp univ_mem in ⟨i, hi⟩,
  inter := λ i j hi hj, by simpa [h.mem_iff]
    using l.inter_sets (h.mem_of_mem hi) (h.mem_of_mem hj) }

lemma has_basis.filter_eq (h : l.has_basis p s) : h.is_basis.filter = l :=
by { ext U, simp [h.mem_iff, is_basis.mem_filter_iff] }

lemma has_basis.eq_generate (h : l.has_basis p s) : l = generate { U | ∃ i, p i ∧ s i = U } :=
by rw [← h.is_basis.filter_eq_generate, h.filter_eq]

lemma generate_eq_generate_inter (s : set (set α)) :
  generate s = generate (sInter '' { t | set.finite t ∧ t ⊆ s}) :=
by erw [(filter_basis.of_sets s).generate, ← (has_basis_generate s).filter_eq] ; refl

lemma of_sets_filter_eq_generate (s : set (set α)) : (filter_basis.of_sets s).filter = generate s :=
by rw [← (filter_basis.of_sets s).generate, generate_eq_generate_inter s] ; refl

protected lemma _root_.filter_basis.has_basis {α : Type*} (B : filter_basis α) :
  has_basis (B.filter) (λ s : set α, s ∈ B) id :=
⟨λ t, B.mem_filter_iff⟩

lemma has_basis.to_has_basis' (hl : l.has_basis p s) (h : ∀ i, p i → ∃ i', p' i' ∧ s' i' ⊆ s i)
  (h' : ∀ i', p' i' → s' i' ∈ l) : l.has_basis p' s' :=
begin
  refine ⟨λ t, ⟨λ ht, _, λ ⟨i', hi', ht⟩, mem_of_superset (h' i' hi') ht⟩⟩,
  rcases hl.mem_iff.1 ht with ⟨i, hi, ht⟩,
  rcases h i hi with ⟨i', hi', hs's⟩,
  exact ⟨i', hi', subset.trans hs's ht⟩
end

lemma has_basis.to_has_basis (hl : l.has_basis p s) (h : ∀ i, p i → ∃ i', p' i' ∧ s' i' ⊆ s i)
  (h' : ∀ i', p' i' → ∃ i, p i ∧ s i ⊆ s' i') : l.has_basis p' s' :=
hl.to_has_basis' h $ λ i' hi', let ⟨i, hi, hss'⟩ := h' i' hi' in hl.mem_iff.2 ⟨i, hi, hss'⟩

lemma has_basis.to_subset (hl : l.has_basis p s) {t : ι → set α} (h : ∀ i, p i → t i ⊆ s i)
  (ht : ∀ i, p i → t i ∈ l) : l.has_basis p t :=
hl.to_has_basis' (λ i hi, ⟨i, hi, h i hi⟩) ht

lemma has_basis.eventually_iff (hl : l.has_basis p s) {q : α → Prop} :
  (∀ᶠ x in l, q x) ↔ ∃ i, p i ∧ ∀ ⦃x⦄, x ∈ s i → q x :=
by simpa using hl.mem_iff

lemma has_basis.frequently_iff (hl : l.has_basis p s) {q : α → Prop} :
  (∃ᶠ x in l, q x) ↔ ∀ i, p i → ∃ x ∈ s i, q x :=
by simp [filter.frequently, hl.eventually_iff]

lemma has_basis.exists_iff (hl : l.has_basis p s) {P : set α → Prop}
  (mono : ∀ ⦃s t⦄, s ⊆ t → P t → P s) :
  (∃ s ∈ l, P s) ↔ ∃ (i) (hi : p i), P (s i) :=
⟨λ ⟨s, hs, hP⟩, let ⟨i, hi, his⟩ := hl.mem_iff.1 hs in ⟨i, hi, mono his hP⟩,
  λ ⟨i, hi, hP⟩, ⟨s i, hl.mem_of_mem hi, hP⟩⟩

lemma has_basis.forall_iff (hl : l.has_basis p s) {P : set α → Prop}
  (mono : ∀ ⦃s t⦄, s ⊆ t → P s → P t) :
  (∀ s ∈ l, P s) ↔ ∀ i, p i → P (s i) :=
⟨λ H i hi, H (s i) $ hl.mem_of_mem hi,
  λ H s hs, let ⟨i, hi, his⟩ := hl.mem_iff.1 hs in mono his (H i hi)⟩

lemma has_basis.ne_bot_iff (hl : l.has_basis p s) :
  ne_bot l ↔ (∀ {i}, p i → (s i).nonempty) :=
forall_mem_nonempty_iff_ne_bot.symm.trans $ hl.forall_iff $ λ _ _, nonempty.mono

lemma has_basis.eq_bot_iff (hl : l.has_basis p s) :
  l = ⊥ ↔ ∃ i, p i ∧ s i = ∅ :=
not_iff_not.1 $ ne_bot_iff.symm.trans $ hl.ne_bot_iff.trans $
by simp only [not_exists, not_and, ← ne_empty_iff_nonempty]

lemma basis_sets (l : filter α) : l.has_basis (λ s : set α, s ∈ l) id :=
⟨λ t, exists_mem_subset_iff.symm⟩

lemma as_basis_filter (f : filter α) : f.as_basis.filter = f :=
by ext t; exact exists_mem_subset_iff

lemma has_basis_self {l : filter α} {P : set α → Prop} :
  has_basis l (λ s, s ∈ l ∧ P s) id ↔ ∀ t ∈ l, ∃ r ∈ l, P r ∧ r ⊆ t :=
begin
  simp only [has_basis_iff, exists_prop, id, and_assoc],
  exact forall_congr (λ s, ⟨λ h, h.1, λ h, ⟨h, λ ⟨t, hl, hP, hts⟩, mem_of_superset hl hts⟩⟩)
end

lemma has_basis.comp_of_surjective (h : l.has_basis p s) {g : ι' → ι} (hg : function.surjective g) :
  l.has_basis (p ∘ g) (s ∘ g) :=
⟨λ t, h.mem_iff.trans hg.exists⟩

lemma has_basis.comp_equiv (h : l.has_basis p s) (e : ι' ≃ ι) : l.has_basis (p ∘ e) (s ∘ e) :=
h.comp_of_surjective e.surjective

/-- If `{s i | p i}` is a basis of a filter `l` and each `s i` includes `s j` such that
`p j ∧ q j`, then `{s j | p j ∧ q j}` is a basis of `l`. -/
lemma has_basis.restrict (h : l.has_basis p s) {q : ι → Prop}
  (hq : ∀ i, p i → ∃ j, p j ∧ q j ∧ s j ⊆ s i) :
  l.has_basis (λ i, p i ∧ q i) s :=
begin
  refine ⟨λ t, ⟨λ ht, _, λ ⟨i, hpi, hti⟩, h.mem_iff.2 ⟨i, hpi.1, hti⟩⟩⟩,
  rcases h.mem_iff.1 ht with ⟨i, hpi, hti⟩,
  rcases hq i hpi with ⟨j, hpj, hqj, hji⟩,
  exact ⟨j, ⟨hpj, hqj⟩, subset.trans hji hti⟩
end

/-- If `{s i | p i}` is a basis of a filter `l` and `V ∈ l`, then `{s i | p i ∧ s i ⊆ V}`
is a basis of `l`. -/
lemma has_basis.restrict_subset (h : l.has_basis p s) {V : set α} (hV : V ∈ l) :
  l.has_basis (λ i, p i ∧ s i ⊆ V) s :=
h.restrict $ λ i hi, (h.mem_iff.1 (inter_mem hV (h.mem_of_mem hi))).imp $
  λ j hj, ⟨hj.fst, subset_inter_iff.1 hj.snd⟩

lemma has_basis.has_basis_self_subset {p : set α → Prop} (h : l.has_basis (λ s, s ∈ l ∧ p s) id)
  {V : set α} (hV : V ∈ l) : l.has_basis (λ s, s ∈ l ∧ p s ∧ s ⊆ V) id :=
by simpa only [and_assoc] using h.restrict_subset hV

theorem has_basis.ge_iff (hl' : l'.has_basis p' s')  : l ≤ l' ↔ ∀ i', p' i' → s' i' ∈ l :=
⟨λ h i' hi', h $ hl'.mem_of_mem hi',
  λ h s hs, let ⟨i', hi', hs⟩ := hl'.mem_iff.1 hs in mem_of_superset (h _ hi') hs⟩

theorem has_basis.le_iff (hl : l.has_basis p s) : l ≤ l' ↔ ∀ t ∈ l', ∃ i (hi : p i), s i ⊆ t :=
by simp only [le_def, hl.mem_iff]

theorem has_basis.le_basis_iff (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
  l ≤ l' ↔ ∀ i', p' i' → ∃ i (hi : p i), s i ⊆ s' i' :=
by simp only [hl'.ge_iff, hl.mem_iff]

lemma has_basis.ext (hl : l.has_basis p s) (hl' : l'.has_basis p' s')
  (h : ∀ i, p i → ∃ i', p' i' ∧ s' i' ⊆ s i)
  (h' : ∀ i', p' i' → ∃ i, p i ∧ s i ⊆ s' i') : l = l' :=
begin
  apply le_antisymm,
  { rw hl.le_basis_iff hl',
    simpa using h' },
  { rw hl'.le_basis_iff hl,
    simpa using h },
end

lemma has_basis.inf' (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
  (l ⊓ l').has_basis (λ i : pprod ι ι', p i.1 ∧ p' i.2) (λ i, s i.1 ∩ s' i.2) :=
⟨begin
  intro t,
  split,
  { simp only [mem_inf_iff, exists_prop, hl.mem_iff, hl'.mem_iff],
    rintros ⟨t, ⟨i, hi, ht⟩, t', ⟨i', hi', ht'⟩, rfl⟩,
    use [⟨i, i'⟩, ⟨hi, hi'⟩, inter_subset_inter ht ht'] },
  { rintros ⟨⟨i, i'⟩, ⟨hi, hi'⟩, H⟩,
    exact mem_inf_of_inter (hl.mem_of_mem hi) (hl'.mem_of_mem hi') H }
end⟩

lemma has_basis.inf {ι ι' : Type*} {p : ι → Prop} {s : ι → set α} {p' : ι' → Prop}
  {s' : ι' → set α} (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
  (l ⊓ l').has_basis (λ i : ι × ι', p i.1 ∧ p' i.2) (λ i, s i.1 ∩ s' i.2) :=
(hl.inf' hl').to_has_basis (λ i hi, ⟨⟨i.1, i.2⟩, hi, subset.rfl⟩)
  (λ i hi, ⟨⟨i.1, i.2⟩, hi, subset.rfl⟩)

lemma has_basis_infi {ι : Type*} {ι' : ι → Type*} {l : ι → filter α}
  {p : Π i, ι' i → Prop} {s : Π i, ι' i → set α} (hl : ∀ i, (l i).has_basis (p i) (s i)) :
  (⨅ i, l i).has_basis (λ If : set ι × Π i, ι' i, If.1.finite ∧ ∀ i ∈ If.1, p i (If.2 i))
    (λ If : set ι × Π i, ι' i, ⋂ i ∈ If.1, s i (If.2 i)) :=
⟨begin
  intro t,
  split,
  { simp only [mem_infi', (hl _).mem_iff],
    rintros ⟨I, hI, V, hV, -, hVt, -⟩,
    choose u hu using hV,
    refine ⟨⟨I, u⟩, ⟨hI, λ i _, (hu i).1⟩, _⟩,
    rw hVt,
    exact Inter_mono (λ i, Inter_mono $ λ hi, (hu i).2) },
  { rintros ⟨⟨I, f⟩, ⟨hI₁, hI₂⟩, hsub⟩,
    refine mem_of_superset _ hsub,
    exact (bInter_mem hI₁).mpr (λ i hi, mem_infi_of_mem i $ (hl i).mem_of_mem $ hI₂ _ hi) }
end⟩

lemma has_basis_infi_of_directed' {ι : Type*} {ι' : ι → Sort*}
  [nonempty ι]
  {l : ι → filter α} (s : Π i, (ι' i) → set α) (p : Π i, (ι' i) → Prop)
  (hl : ∀ i, (l i).has_basis (p i) (s i)) (h : directed (≥) l) :
  (⨅ i, l i).has_basis (λ (ii' : Σ i, ι' i), p ii'.1 ii'.2) (λ ii', s ii'.1 ii'.2) :=
begin
  refine ⟨λ t, _⟩,
  rw [mem_infi_of_directed h, sigma.exists],
  exact exists_congr (λ i, (hl i).mem_iff)
end

lemma has_basis_infi_of_directed {ι : Type*} {ι' : Sort*}
  [nonempty ι]
  {l : ι → filter α} (s : ι → ι' → set α) (p : ι → ι' → Prop)
  (hl : ∀ i, (l i).has_basis (p i) (s i)) (h : directed (≥) l) :
  (⨅ i, l i).has_basis (λ (ii' : ι × ι'), p ii'.1 ii'.2) (λ ii', s ii'.1 ii'.2) :=
begin
  refine ⟨λ t, _⟩,
  rw [mem_infi_of_directed h, prod.exists],
  exact exists_congr (λ i, (hl i).mem_iff)
end

lemma has_basis_binfi_of_directed' {ι : Type*} {ι' : ι → Sort*}
  {dom : set ι} (hdom : dom.nonempty)
  {l : ι → filter α} (s : Π i, (ι' i) → set α) (p : Π i, (ι' i) → Prop)
  (hl : ∀ i ∈ dom, (l i).has_basis (p i) (s i)) (h : directed_on (l ⁻¹'o ge) dom) :
  (⨅ i ∈ dom, l i).has_basis (λ (ii' : Σ i, ι' i), ii'.1 ∈ dom ∧ p ii'.1 ii'.2)
    (λ ii', s ii'.1 ii'.2) :=
begin
  refine ⟨λ t, _⟩,
  rw [mem_binfi_of_directed h hdom, sigma.exists],
  refine exists_congr (λ i, ⟨_, _⟩),
  { rintros ⟨hi, hti⟩,
    rcases (hl i hi).mem_iff.mp hti with ⟨b, hb, hbt⟩,
    exact ⟨b, ⟨hi, hb⟩, hbt⟩ },
  { rintros ⟨b, ⟨hi, hb⟩, hibt⟩,
    exact ⟨hi, (hl i hi).mem_iff.mpr ⟨b, hb, hibt⟩⟩ }
end

lemma has_basis_binfi_of_directed {ι : Type*} {ι' : Sort*}
  {dom : set ι} (hdom : dom.nonempty)
  {l : ι → filter α} (s : ι → ι' → set α) (p : ι → ι' → Prop)
  (hl : ∀ i ∈ dom, (l i).has_basis (p i) (s i)) (h : directed_on (l ⁻¹'o ge) dom) :
  (⨅ i ∈ dom, l i).has_basis (λ (ii' : ι × ι'), ii'.1 ∈ dom ∧ p ii'.1 ii'.2)
    (λ ii', s ii'.1 ii'.2) :=
begin
  refine ⟨λ t, _⟩,
  rw [mem_binfi_of_directed h hdom, prod.exists],
  refine exists_congr (λ i, ⟨_, _⟩),
  { rintros ⟨hi, hti⟩,
    rcases (hl i hi).mem_iff.mp hti with ⟨b, hb, hbt⟩,
    exact ⟨b, ⟨hi, hb⟩, hbt⟩ },
  { rintros ⟨b, ⟨hi, hb⟩, hibt⟩,
    exact ⟨hi, (hl i hi).mem_iff.mpr ⟨b, hb, hibt⟩⟩ }
end

lemma has_basis_principal (t : set α) : (𝓟 t).has_basis (λ i : unit, true) (λ i, t) :=
⟨λ U, by simp⟩

lemma has_basis_pure (x : α) : (pure x : filter α).has_basis (λ i : unit, true) (λ i, {x}) :=
by simp only [← principal_singleton, has_basis_principal]

lemma has_basis.sup' (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
  (l ⊔ l').has_basis (λ i : pprod ι ι', p i.1 ∧ p' i.2) (λ i, s i.1 ∪ s' i.2) :=
⟨begin
  intros t,
  simp only [mem_sup, hl.mem_iff, hl'.mem_iff, pprod.exists, union_subset_iff, exists_prop,
    and_assoc, exists_and_distrib_left],
  simp only [← and_assoc, exists_and_distrib_right, and_comm]
end⟩

lemma has_basis.sup {ι ι' : Type*} {p : ι → Prop} {s : ι → set α} {p' : ι' → Prop}
  {s' : ι' → set α} (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
  (l ⊔ l').has_basis (λ i : ι × ι', p i.1 ∧ p' i.2) (λ i, s i.1 ∪ s' i.2) :=
(hl.sup' hl').to_has_basis (λ i hi, ⟨⟨i.1, i.2⟩, hi, subset.rfl⟩)
  (λ i hi, ⟨⟨i.1, i.2⟩, hi, subset.rfl⟩)

lemma has_basis_supr {ι : Sort*} {ι' : ι → Type*} {l : ι → filter α}
  {p : Π i, ι' i → Prop} {s : Π i, ι' i → set α} (hl : ∀ i, (l i).has_basis (p i) (s i)) :
  (⨆ i, l i).has_basis (λ f : Π i, ι' i, ∀ i, p i (f i)) (λ f : Π i, ι' i, ⋃ i, s i (f i)) :=
has_basis_iff.mpr $ λ t, by simp only [has_basis_iff, (hl _).mem_iff, classical.skolem,
  forall_and_distrib, Union_subset_iff, mem_supr]

lemma has_basis.sup_principal (hl : l.has_basis p s) (t : set α) :
  (l ⊔ 𝓟 t).has_basis p (λ i, s i ∪ t) :=
⟨λ u, by simp only [(hl.sup' (has_basis_principal t)).mem_iff, pprod.exists, exists_prop, and_true,
  unique.exists_iff]⟩

lemma has_basis.sup_pure (hl : l.has_basis p s) (x : α) :
  (l ⊔ pure x).has_basis p (λ i, s i ∪ {x}) :=
by simp only [← principal_singleton, hl.sup_principal]

lemma has_basis.inf_principal (hl : l.has_basis p s) (s' : set α) :
  (l ⊓ 𝓟 s').has_basis p (λ i, s i ∩ s') :=
⟨λ t, by simp only [mem_inf_principal, hl.mem_iff, subset_def, mem_set_of_eq,
  mem_inter_iff, and_imp]⟩

lemma has_basis.inf_basis_ne_bot_iff (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
  ne_bot (l ⊓ l') ↔ ∀ ⦃i⦄ (hi : p i) ⦃i'⦄ (hi' : p' i'), (s i ∩ s' i').nonempty :=
(hl.inf' hl').ne_bot_iff.trans $ by simp [@forall_swap _ ι']

lemma has_basis.inf_ne_bot_iff (hl : l.has_basis p s) :
  ne_bot (l ⊓ l') ↔ ∀ ⦃i⦄ (hi : p i) ⦃s'⦄ (hs' : s' ∈ l'), (s i ∩ s').nonempty :=
hl.inf_basis_ne_bot_iff l'.basis_sets

lemma has_basis.inf_principal_ne_bot_iff (hl : l.has_basis p s) {t : set α} :
  ne_bot (l ⊓ 𝓟 t) ↔ ∀ ⦃i⦄ (hi : p i), (s i ∩ t).nonempty :=
(hl.inf_principal t).ne_bot_iff

lemma has_basis.disjoint_basis_iff (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
  disjoint l l' ↔ ∃ i (hi : p i) i' (hi' : p' i'), disjoint (s i) (s' i') :=
not_iff_not.mp $ by simp only [disjoint_iff, ← ne.def, ← ne_bot_iff, hl.inf_basis_ne_bot_iff hl',
  not_exists, bot_eq_empty, ne_empty_iff_nonempty, inf_eq_inter]

lemma inf_ne_bot_iff :
  ne_bot (l ⊓ l') ↔ ∀ ⦃s : set α⦄ (hs : s ∈ l) ⦃s'⦄ (hs' : s' ∈ l'), (s ∩ s').nonempty :=
l.basis_sets.inf_ne_bot_iff

lemma inf_principal_ne_bot_iff {s : set α} :
  ne_bot (l ⊓ 𝓟 s) ↔ ∀ U ∈ l, (U ∩ s).nonempty :=
l.basis_sets.inf_principal_ne_bot_iff

lemma mem_iff_inf_principal_compl {f : filter α} {s : set α} :
  s ∈ f ↔ f ⊓ 𝓟 sᶜ = ⊥ :=
begin
  refine not_iff_not.1 ((inf_principal_ne_bot_iff.trans _).symm.trans ne_bot_iff),
  exact ⟨λ h hs, by simpa [empty_not_nonempty] using h s hs,
    λ hs t ht, inter_compl_nonempty_iff.2 $ λ hts, hs $ mem_of_superset ht hts⟩,
end

lemma not_mem_iff_inf_principal_compl {f : filter α} {s : set α} :
  s ∉ f ↔ ne_bot (f ⊓ 𝓟 sᶜ) :=
(not_congr mem_iff_inf_principal_compl).trans ne_bot_iff.symm

@[simp] lemma disjoint_principal_right {f : filter α} {s : set α} :
  disjoint f (𝓟 s) ↔ sᶜ ∈ f :=
by rw [mem_iff_inf_principal_compl, compl_compl, disjoint_iff]

@[simp] lemma disjoint_principal_left {f : filter α} {s : set α} :
  disjoint (𝓟 s) f ↔ sᶜ ∈ f :=
by rw [disjoint.comm, disjoint_principal_right]

@[simp] lemma disjoint_principal_principal {s t : set α} :
  disjoint (𝓟 s) (𝓟 t) ↔ disjoint s t :=
by simp [disjoint_iff_subset_compl_left]

alias disjoint_principal_principal ↔ _ disjoint.filter_principal

@[simp] lemma disjoint_pure_pure {x y : α} :
  disjoint (pure x : filter α) (pure y) ↔ x ≠ y :=
by simp only [← principal_singleton, disjoint_principal_principal, disjoint_singleton]

lemma le_iff_forall_inf_principal_compl {f g : filter α} :
  f ≤ g ↔ ∀ V ∈ g, f ⊓ 𝓟 Vᶜ = ⊥ :=
forall₂_congr $ λ _ _, mem_iff_inf_principal_compl

lemma inf_ne_bot_iff_frequently_left {f g : filter α} :
  ne_bot (f ⊓ g) ↔ ∀ {p : α → Prop}, (∀ᶠ x in f, p x) → ∃ᶠ x in g, p x :=
by simpa only [inf_ne_bot_iff, frequently_iff, exists_prop, and_comm]

lemma inf_ne_bot_iff_frequently_right {f g : filter α} :
  ne_bot (f ⊓ g) ↔ ∀ {p : α → Prop}, (∀ᶠ x in g, p x) → ∃ᶠ x in f, p x :=
by { rw inf_comm, exact inf_ne_bot_iff_frequently_left }

lemma has_basis.eq_binfi (h : l.has_basis p s) :
  l = ⨅ i (_ : p i), 𝓟 (s i) :=
eq_binfi_of_mem_iff_exists_mem $ λ t, by simp only [h.mem_iff, mem_principal]

lemma has_basis.eq_infi (h : l.has_basis (λ _, true) s) :
  l = ⨅ i, 𝓟 (s i) :=
by simpa only [infi_true] using h.eq_binfi

lemma has_basis_infi_principal {s : ι → set α} (h : directed (≥) s) [nonempty ι] :
  (⨅ i, 𝓟 (s i)).has_basis (λ _, true) s :=
⟨begin
  refine λ t, (mem_infi_of_directed (h.mono_comp _ _) t).trans $
    by simp only [exists_prop, true_and, mem_principal],
  exact λ _ _, principal_mono.2
end⟩

/-- If `s : ι → set α` is an indexed family of sets, then finite intersections of `s i` form a basis
of `⨅ i, 𝓟 (s i)`.  -/
lemma has_basis_infi_principal_finite {ι : Type*} (s : ι → set α) :
  (⨅ i, 𝓟 (s i)).has_basis (λ t : set ι, t.finite) (λ t, ⋂ i ∈ t, s i) :=
begin
  refine ⟨λ U, (mem_infi_finite _).trans _⟩,
  simp only [infi_principal_finset, mem_Union, mem_principal, exists_prop,
    exists_finite_iff_finset, finset.set_bInter_coe]
end

lemma has_basis_binfi_principal {s : β → set α} {S : set β} (h : directed_on (s ⁻¹'o (≥)) S)
  (ne : S.nonempty) :
  (⨅ i ∈ S, 𝓟 (s i)).has_basis (λ i, i ∈ S) s :=
⟨begin
  refine λ t, (mem_binfi_of_directed _ ne).trans $ by simp only [mem_principal],
  rw [directed_on_iff_directed, ← directed_comp, (∘)] at h ⊢,
  apply h.mono_comp _ _,
  exact λ _ _, principal_mono.2
end⟩

lemma has_basis_binfi_principal' {ι : Type*} {p : ι → Prop} {s : ι → set α}
  (h : ∀ i, p i → ∀ j, p j → ∃ k (h : p k), s k ⊆ s i ∧ s k ⊆ s j) (ne : ∃ i, p i) :
  (⨅ i (h : p i), 𝓟 (s i)).has_basis p s :=
filter.has_basis_binfi_principal h ne

lemma has_basis.map (f : α → β) (hl : l.has_basis p s) :
  (l.map f).has_basis p (λ i, f '' (s i)) :=
⟨λ t, by simp only [mem_map, image_subset_iff, hl.mem_iff, preimage]⟩

lemma has_basis.comap (f : β → α) (hl : l.has_basis p s) :
  (l.comap f).has_basis p (λ i, f ⁻¹' (s i)) :=
⟨begin
  intro t,
  simp only [mem_comap, exists_prop, hl.mem_iff],
  split,
  { rintros ⟨t', ⟨i, hi, ht'⟩, H⟩,
    exact ⟨i, hi, subset.trans (preimage_mono ht') H⟩ },
  { rintros ⟨i, hi, H⟩,
    exact ⟨s i, ⟨i, hi, subset.refl _⟩, H⟩ }
end⟩

lemma comap_has_basis (f : α → β) (l : filter β) :
  has_basis (comap f l) (λ s : set β, s ∈ l) (λ s, f ⁻¹' s) :=
⟨λ t, mem_comap⟩

lemma has_basis.prod_self (hl : l.has_basis p s) :
  (l ×ᶠ l).has_basis p (λ i, s i ×ˢ s i) :=
⟨begin
  intro t,
  apply mem_prod_iff.trans,
  split,
  { rintros ⟨t₁, ht₁, t₂, ht₂, H⟩,
    rcases hl.mem_iff.1 (inter_mem ht₁ ht₂) with ⟨i, hi, ht⟩,
    exact ⟨i, hi, λ p ⟨hp₁, hp₂⟩, H ⟨(ht hp₁).1, (ht hp₂).2⟩⟩ },
  { rintros ⟨i, hi, H⟩,
    exact ⟨s i, hl.mem_of_mem hi, s i, hl.mem_of_mem hi, H⟩ }
end⟩

lemma mem_prod_self_iff {s} : s ∈ l ×ᶠ l ↔ ∃ t ∈ l, t ×ˢ t ⊆ s :=
l.basis_sets.prod_self.mem_iff

lemma has_basis.sInter_sets (h : has_basis l p s) :
  ⋂₀ l.sets = ⋂ i (hi : p i), s i :=
begin
  ext x,
  simp only [mem_Inter, mem_sInter, filter.mem_sets, h.forall_mem_mem],
end

variables {ι'' : Type*} [preorder ι''] (l) (s'' : ι'' → set α)

/-- `is_antitone_basis s` means the image of `s` is a filter basis such that `s` is decreasing. -/
@[protect_proj] structure is_antitone_basis extends is_basis (λ _, true) s'' : Prop :=
(antitone : antitone s'')

/-- We say that a filter `l` has an antitone basis `s : ι → set α`, if `t ∈ l` if and only if `t`
includes `s i` for some `i`, and `s` is decreasing. -/
@[protect_proj] structure has_antitone_basis (l : filter α) (s : ι'' → set α)
  extends has_basis l (λ _, true) s : Prop :=
(antitone : antitone s)

end same_type

section two_types

variables {la : filter α} {pa : ι → Prop} {sa : ι → set α}
  {lb : filter β} {pb : ι' → Prop} {sb : ι' → set β} {f : α → β}

lemma has_basis.tendsto_left_iff (hla : la.has_basis pa sa) :
  tendsto f la lb ↔ ∀ t ∈ lb, ∃ i (hi : pa i), maps_to f (sa i) t :=
by { simp only [tendsto, (hla.map f).le_iff, image_subset_iff], refl }

lemma has_basis.tendsto_right_iff (hlb : lb.has_basis pb sb) :
  tendsto f la lb ↔ ∀ i (hi : pb i), ∀ᶠ x in la, f x ∈ sb i :=
by simpa only [tendsto, hlb.ge_iff, mem_map, filter.eventually]

lemma has_basis.tendsto_iff (hla : la.has_basis pa sa) (hlb : lb.has_basis pb sb) :
  tendsto f la lb ↔ ∀ ib (hib : pb ib), ∃ ia (hia : pa ia), ∀ x ∈ sa ia, f x ∈ sb ib :=
by simp [hlb.tendsto_right_iff, hla.eventually_iff]

lemma tendsto.basis_left (H : tendsto f la lb) (hla : la.has_basis pa sa) :
  ∀ t ∈ lb, ∃ i (hi : pa i), maps_to f (sa i) t :=
hla.tendsto_left_iff.1 H

lemma tendsto.basis_right (H : tendsto f la lb) (hlb : lb.has_basis pb sb) :
  ∀ i (hi : pb i), ∀ᶠ x in la, f x ∈ sb i :=
hlb.tendsto_right_iff.1 H

lemma tendsto.basis_both (H : tendsto f la lb) (hla : la.has_basis pa sa)
  (hlb : lb.has_basis pb sb) :
  ∀ ib (hib : pb ib), ∃ ia (hia : pa ia), ∀ x ∈ sa ia, f x ∈ sb ib :=
(hla.tendsto_iff hlb).1 H

lemma has_basis.prod'' (hla : la.has_basis pa sa) (hlb : lb.has_basis pb sb) :
  (la ×ᶠ lb).has_basis (λ i : pprod ι ι', pa i.1 ∧ pb i.2) (λ i, sa i.1 ×ˢ sb i.2) :=
(hla.comap prod.fst).inf' (hlb.comap prod.snd)

lemma has_basis.prod {ι ι' : Type*} {pa : ι → Prop} {sa : ι → set α} {pb : ι' → Prop}
  {sb : ι' → set β} (hla : la.has_basis pa sa) (hlb : lb.has_basis pb sb) :
  (la ×ᶠ lb).has_basis (λ i : ι × ι', pa i.1 ∧ pb i.2) (λ i, sa i.1 ×ˢ sb i.2) :=
(hla.comap prod.fst).inf (hlb.comap prod.snd)

lemma has_basis.prod' {la : filter α} {lb : filter β} {ι : Type*} {p : ι → Prop}
  {sa : ι → set α} {sb : ι → set β}
  (hla : la.has_basis p sa) (hlb : lb.has_basis p sb)
  (h_dir : ∀ {i j}, p i → p j → ∃ k, p k ∧ sa k ⊆ sa i ∧ sb k ⊆ sb j) :
  (la ×ᶠ lb).has_basis p (λ i, sa i ×ˢ sb i) :=
begin
  simp only [has_basis_iff, (hla.prod hlb).mem_iff],
  refine λ t, ⟨_, _⟩,
  { rintros ⟨⟨i, j⟩, ⟨hi, hj⟩, hsub : sa i ×ˢ sb j ⊆ t⟩,
    rcases h_dir hi hj with ⟨k, hk, ki, kj⟩,
    exact ⟨k, hk, (set.prod_mono ki kj).trans hsub⟩ },
  { rintro ⟨i, hi, h⟩,
    exact ⟨⟨i, i⟩, ⟨hi, hi⟩, h⟩ },
end

lemma has_antitone_basis.prod {f : filter α} {g : filter β}
  {s : ℕ → set α} {t : ℕ → set β} (hf : has_antitone_basis f s) (hg : has_antitone_basis g t) :
  has_antitone_basis (f ×ᶠ g) (λ n, s n ×ˢ t n) :=
begin
  have h : has_basis (f ×ᶠ g) _ _ := has_basis.prod' hf.to_has_basis hg.to_has_basis _,
  swap,
  { intros i j,
    simp only [true_and, forall_true_left],
    exact ⟨max i j, hf.antitone (le_max_left _ _), hg.antitone (le_max_right _ _)⟩, },
  refine ⟨h, λ n m hn_le_m, set.prod_mono _ _⟩,
  exacts [hf.antitone hn_le_m, hg.antitone hn_le_m]
end

lemma has_basis.coprod {ι ι' : Type*} {pa : ι → Prop} {sa : ι → set α} {pb : ι' → Prop}
  {sb : ι' → set β} (hla : la.has_basis pa sa) (hlb : lb.has_basis pb sb) :
  (la.coprod lb).has_basis (λ i : ι × ι', pa i.1 ∧ pb i.2)
    (λ i, prod.fst ⁻¹' sa i.1 ∪ prod.snd ⁻¹' sb i.2) :=
(hla.comap prod.fst).sup (hlb.comap prod.snd)

end two_types

end filter

end sort

namespace filter

variables {α β γ ι : Type*} {ι' : Sort*}

/-- `is_countably_generated f` means `f = generate s` for some countable `s`. -/
class is_countably_generated (f : filter α) : Prop :=
(out [] : ∃ s : set (set α), s.countable ∧ f = generate s)

/-- `is_countable_basis p s` means the image of `s` bounded by `p` is a countable filter basis. -/
structure is_countable_basis (p : ι → Prop) (s : ι → set α) extends is_basis p s : Prop :=
(countable : (set_of p).countable)

/-- We say that a filter `l` has a countable basis `s : ι → set α` bounded by `p : ι → Prop`,
if `t ∈ l` if and only if `t` includes `s i` for some `i` such that `p i`, and the set
defined by `p` is countable. -/
structure has_countable_basis (l : filter α) (p : ι → Prop) (s : ι → set α)
  extends has_basis l p s : Prop :=
(countable : (set_of p).countable)

/-- A countable filter basis `B` on a type `α` is a nonempty countable collection of sets of `α`
such that the intersection of two elements of this collection contains some element
of the collection. -/
structure countable_filter_basis (α : Type*) extends filter_basis α :=
(countable : sets.countable)

-- For illustration purposes, the countable filter basis defining (at_top : filter ℕ)
instance nat.inhabited_countable_filter_basis : inhabited (countable_filter_basis ℕ) :=
⟨{ countable := countable_range (λ n, Ici n),
   ..(default : filter_basis ℕ) }⟩

lemma has_countable_basis.is_countably_generated {f : filter α} {p : ι → Prop} {s : ι → set α}
  (h : f.has_countable_basis p s) :
  f.is_countably_generated :=
⟨⟨{t | ∃ i, p i ∧ s i = t}, h.countable.image s, h.to_has_basis.eq_generate⟩⟩

lemma antitone_seq_of_seq (s : ℕ → set α) :
  ∃ t : ℕ → set α, antitone t ∧ (⨅ i, 𝓟 $ s i) = ⨅ i, 𝓟 (t i) :=
begin
  use λ n, ⋂ m ≤ n, s m, split,
  { exact λ i j hij, bInter_mono (Iic_subset_Iic.2 hij) (λ n hn, subset.refl _) },
  apply le_antisymm; rw le_infi_iff; intro i,
  { rw le_principal_iff, refine (bInter_mem (finite_le_nat _)).2 (λ j hji, _),
    rw ← le_principal_iff, apply infi_le_of_le j _, exact le_rfl },
  { apply infi_le_of_le i _, rw principal_mono, intro a, simp, intro h, apply h, refl },
end

lemma countable_binfi_eq_infi_seq [complete_lattice α] {B : set ι} (Bcbl : B.countable)
  (Bne : B.nonempty) (f : ι → α) :
  ∃ (x : ℕ → ι), (⨅ t ∈ B, f t) = ⨅ i, f (x i) :=
begin
  rw countable_iff_exists_surjective_to_subtype Bne at Bcbl,
  rcases Bcbl with ⟨g, gsurj⟩,
  rw infi_subtype',
  use (λ n, g n), apply le_antisymm; rw le_infi_iff,
  { intro i, apply infi_le_of_le (g i) _, apply le_rfl },
  { intros a, rcases gsurj a with ⟨i, rfl⟩, apply infi_le }
end

lemma countable_binfi_eq_infi_seq' [complete_lattice α] {B : set ι} (Bcbl : B.countable) (f : ι → α)
  {i₀ : ι} (h : f i₀ = ⊤) :
  ∃ (x : ℕ → ι), (⨅ t ∈ B, f t) = ⨅ i, f (x i) :=
begin
  cases B.eq_empty_or_nonempty with hB Bnonempty,
  { rw [hB, infi_emptyset],
    use λ n, i₀,
    simp [h] },
  { exact countable_binfi_eq_infi_seq Bcbl Bnonempty f }
end

lemma countable_binfi_principal_eq_seq_infi {B : set (set α)} (Bcbl : B.countable) :
  ∃ (x : ℕ → set α), (⨅ t ∈ B, 𝓟 t) = ⨅ i, 𝓟 (x i) :=
countable_binfi_eq_infi_seq' Bcbl 𝓟 principal_univ

section is_countably_generated

protected lemma has_antitone_basis.mem [preorder ι] {l : filter α} {s : ι → set α}
  (hs : l.has_antitone_basis s) (i : ι) : s i ∈ l :=
hs.to_has_basis.mem_of_mem trivial

/-- If `f` is countably generated and `f.has_basis p s`, then `f` admits a decreasing basis
enumerated by natural numbers such that all sets have the form `s i`. More precisely, there is a
sequence `i n` such that `p (i n)` for all `n` and `s (i n)` is a decreasing sequence of sets which
forms a basis of `f`-/
lemma has_basis.exists_antitone_subbasis {f : filter α} [h : f.is_countably_generated]
  {p : ι' → Prop} {s : ι' → set α} (hs : f.has_basis p s) :
  ∃ x : ℕ → ι', (∀ i, p (x i)) ∧ f.has_antitone_basis (λ i, s (x i)) :=
begin
  obtain ⟨x', hx'⟩ : ∃ x : ℕ → set α, f = ⨅ i, 𝓟 (x i),
  { unfreezingI { rcases h with ⟨s, hsc, rfl⟩ },
    rw generate_eq_binfi,
    exact countable_binfi_principal_eq_seq_infi hsc },
  have : ∀ i, x' i ∈ f := λ i, hx'.symm ▸ (infi_le (λ i, 𝓟 (x' i)) i) (mem_principal_self _),
  let x : ℕ → {i : ι' // p i} := λ n, nat.rec_on n (hs.index _ $ this 0)
    (λ n xn, (hs.index _ $ inter_mem (this $ n + 1) (hs.mem_of_mem xn.2))),
  have x_mono : antitone (λ i, s (x i)),
  { refine antitone_nat_of_succ_le (λ i, _),
    exact (hs.set_index_subset _).trans (inter_subset_right _ _) },
  have x_subset : ∀ i, s (x i) ⊆ x' i,
  { rintro (_|i),
    exacts [hs.set_index_subset _, subset.trans (hs.set_index_subset _) (inter_subset_left _ _)] },
  refine ⟨λ i, x i, λ i, (x i).2, _⟩,
  have : (⨅ i, 𝓟 (s (x i))).has_antitone_basis (λ i, s (x i)) :=
    ⟨has_basis_infi_principal (directed_of_sup x_mono), x_mono⟩,
  convert this,
  exact le_antisymm (le_infi $ λ i, le_principal_iff.2 $ by cases i; apply hs.set_index_mem)
    (hx'.symm ▸ le_infi (λ i, le_principal_iff.2 $
      this.to_has_basis.mem_iff.2 ⟨i, trivial, x_subset i⟩))
end

/-- A countably generated filter admits a basis formed by an antitone sequence of sets. -/
lemma exists_antitone_basis (f : filter α) [f.is_countably_generated] :
  ∃ x : ℕ → set α, f.has_antitone_basis x :=
let ⟨x, hxf, hx⟩ := f.basis_sets.exists_antitone_subbasis in ⟨x, hx⟩

lemma exists_antitone_seq (f : filter α) [f.is_countably_generated] :
  ∃ x : ℕ → set α, antitone x ∧ ∀ {s}, (s ∈ f ↔ ∃ i, x i ⊆ s) :=
let ⟨x, hx⟩ := f.exists_antitone_basis in
⟨x, hx.antitone, λ s, by simp [hx.to_has_basis.mem_iff]⟩

instance inf.is_countably_generated (f g : filter α) [is_countably_generated f]
  [is_countably_generated g] :
  is_countably_generated (f ⊓ g) :=
begin
  rcases f.exists_antitone_basis with ⟨s, hs⟩,
  rcases g.exists_antitone_basis with ⟨t, ht⟩,
  exact has_countable_basis.is_countably_generated
    ⟨hs.to_has_basis.inf ht.to_has_basis, set.countable_encodable _⟩
end

instance comap.is_countably_generated (l : filter β) [l.is_countably_generated] (f : α → β) :
  (comap f l).is_countably_generated :=
let ⟨x, hxl⟩ := l.exists_antitone_basis in
has_countable_basis.is_countably_generated ⟨hxl.to_has_basis.comap _, countable_encodable _⟩

instance sup.is_countably_generated (f g : filter α) [is_countably_generated f]
  [is_countably_generated g] :
  is_countably_generated (f ⊔ g) :=
begin
  rcases f.exists_antitone_basis with ⟨s, hs⟩,
  rcases g.exists_antitone_basis with ⟨t, ht⟩,
  exact has_countable_basis.is_countably_generated
    ⟨hs.to_has_basis.sup ht.to_has_basis, set.countable_encodable _⟩
end

end is_countably_generated

@[instance] lemma is_countably_generated_seq [encodable β] (x : β → set α) :
  is_countably_generated (⨅ i, 𝓟 $ x i) :=
begin
  use [range x, countable_range x],
  rw [generate_eq_binfi, infi_range]
end

lemma is_countably_generated_of_seq {f : filter α} (h : ∃ x : ℕ → set α, f = ⨅ i, 𝓟 $ x i) :
  f.is_countably_generated  :=
let ⟨x, h⟩ := h in by rw h ; apply is_countably_generated_seq

lemma is_countably_generated_binfi_principal {B : set $ set α} (h : B.countable) :
  is_countably_generated (⨅ (s ∈ B), 𝓟 s) :=
is_countably_generated_of_seq (countable_binfi_principal_eq_seq_infi h)

lemma is_countably_generated_iff_exists_antitone_basis {f : filter α} :
  is_countably_generated f ↔ ∃ x : ℕ → set α, f.has_antitone_basis x :=
begin
  split,
  { introI h, exact f.exists_antitone_basis },
  { rintros ⟨x, h⟩,
    rw h.to_has_basis.eq_infi,
    exact is_countably_generated_seq x },
end

@[instance] lemma is_countably_generated_principal (s : set α) : is_countably_generated (𝓟 s) :=
is_countably_generated_of_seq ⟨λ _, s, infi_const.symm⟩

@[instance] lemma is_countably_generated_pure (a : α) : is_countably_generated (pure a) :=
by { rw ← principal_singleton, exact is_countably_generated_principal _, }

@[instance] lemma is_countably_generated_bot : is_countably_generated (⊥ : filter α) :=
@principal_empty α ▸ is_countably_generated_principal _

@[instance] lemma is_countably_generated_top : is_countably_generated (⊤ : filter α) :=
@principal_univ α ▸ is_countably_generated_principal _

instance is_countably_generated.prod {f : filter α} {g : filter β}
  [hf : f.is_countably_generated] [hg : g.is_countably_generated] :
  is_countably_generated (f ×ᶠ g) :=
begin
  simp_rw is_countably_generated_iff_exists_antitone_basis at hf hg ⊢,
  rcases hf with ⟨s, hs⟩,
  rcases hg with ⟨t, ht⟩,
  refine ⟨_, hs.prod ht⟩,
end

end filter


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import category_theory.limits.shapes.normal_mono.basic
import category_theory.limits.shapes.finite_products

/-!
# Normal mono categories with finite products and kernels have all equalizers.

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

This, and the dual result, are used in the development of abelian categories.
-/

noncomputable theory

open category_theory
open category_theory.limits

variables {C : Type*} [category C] [has_zero_morphisms C]

namespace category_theory.normal_mono_category

variables [has_finite_products C] [has_kernels C] [normal_mono_category C]

/-- The pullback of two monomorphisms exists. -/
@[irreducible]
lemma pullback_of_mono {X Y Z : C} (a : X ⟶ Z) (b : Y ⟶ Z) [mono a] [mono b] :
  has_limit (cospan a b) :=
let ⟨P, f, haf, i⟩ := normal_mono_of_mono a in
let ⟨Q, g, hbg, i'⟩ := normal_mono_of_mono b in
let ⟨a', ha'⟩ := kernel_fork.is_limit.lift' i (kernel.ι (prod.lift f g)) $
    calc kernel.ι (prod.lift f g) ≫ f
        = kernel.ι (prod.lift f g) ≫ prod.lift f g ≫ limits.prod.fst : by rw prod.lift_fst
    ... = (0 : kernel (prod.lift f g) ⟶ P ⨯ Q) ≫ limits.prod.fst : by rw kernel.condition_assoc
    ... = 0 : zero_comp in
let ⟨b', hb'⟩ := kernel_fork.is_limit.lift' i' (kernel.ι (prod.lift f g)) $
    calc kernel.ι (prod.lift f g) ≫ g
        = kernel.ι (prod.lift f g) ≫ (prod.lift f g) ≫ limits.prod.snd : by rw prod.lift_snd
    ... = (0 : kernel (prod.lift f g) ⟶ P ⨯ Q) ≫ limits.prod.snd : by rw kernel.condition_assoc
    ... = 0 : zero_comp in
has_limit.mk { cone := pullback_cone.mk a' b' $ by { simp at ha' hb', rw [ha', hb'] },
  is_limit := pullback_cone.is_limit.mk _
    (λ s, kernel.lift (prod.lift f g) (pullback_cone.snd s ≫ b) $ prod.hom_ext
      (calc ((pullback_cone.snd s ≫ b) ≫ prod.lift f g) ≫ limits.prod.fst
            = pullback_cone.snd s ≫ b ≫ f : by simp only [prod.lift_fst, category.assoc]
        ... = pullback_cone.fst s ≫ a ≫ f : by rw pullback_cone.condition_assoc
        ... = pullback_cone.fst s ≫ 0 : by rw haf
        ... = 0 ≫ limits.prod.fst :
          by rw [comp_zero, zero_comp])
      (calc ((pullback_cone.snd s ≫ b) ≫ prod.lift f g) ≫ limits.prod.snd
            = pullback_cone.snd s ≫ b ≫ g : by simp only [prod.lift_snd, category.assoc]
        ... = pullback_cone.snd s ≫ 0 : by rw hbg
        ... = 0 ≫ limits.prod.snd :
          by rw [comp_zero, zero_comp]))
    (λ s, (cancel_mono a).1 $
      by { rw kernel_fork.ι_of_ι at ha', simp [ha', pullback_cone.condition s] })
    (λ s, (cancel_mono b).1 $
      by { rw kernel_fork.ι_of_ι at hb', simp [hb'] })
    (λ s m h₁ h₂, (cancel_mono (kernel.ι (prod.lift f g))).1 $ calc m ≫ kernel.ι (prod.lift f g)
          = m ≫ a' ≫ a : by { congr, exact ha'.symm }
      ... = pullback_cone.fst s ≫ a : by rw [←category.assoc, h₁]
      ... = pullback_cone.snd s ≫ b : pullback_cone.condition s
      ... = kernel.lift (prod.lift f g) (pullback_cone.snd s ≫ b) _ ≫ kernel.ι (prod.lift f g) :
        by rw kernel.lift_ι) }

section

local attribute [instance] pullback_of_mono

/-- The pullback of `(𝟙 X, f)` and `(𝟙 X, g)` -/
private abbreviation P {X Y : C} (f g : X ⟶ Y)
  [mono (prod.lift (𝟙 X) f)] [mono (prod.lift (𝟙 X) g)] : C :=
pullback (prod.lift (𝟙 X) f) (prod.lift (𝟙 X) g)

/-- The equalizer of `f` and `g` exists. -/
@[irreducible]
lemma has_limit_parallel_pair {X Y : C} (f g : X ⟶ Y) : has_limit (parallel_pair f g) :=
have huv : (pullback.fst : P f g ⟶ X) = pullback.snd, from
  calc (pullback.fst : P f g ⟶ X) = pullback.fst ≫ 𝟙 _ : eq.symm $ category.comp_id _
    ... = pullback.fst ≫ prod.lift (𝟙 X) f ≫ limits.prod.fst : by rw prod.lift_fst
    ... = pullback.snd ≫ prod.lift (𝟙 X) g ≫ limits.prod.fst : by rw pullback.condition_assoc
    ... = pullback.snd : by rw [prod.lift_fst, category.comp_id],
have hvu : (pullback.fst : P f g ⟶ X) ≫ f = pullback.snd ≫ g, from
  calc (pullback.fst : P f g ⟶ X) ≫ f
        = pullback.fst ≫ prod.lift (𝟙 X) f ≫ limits.prod.snd : by rw prod.lift_snd
    ... = pullback.snd ≫ prod.lift (𝟙 X) g ≫ limits.prod.snd : by rw pullback.condition_assoc
    ... = pullback.snd ≫ g : by rw prod.lift_snd,
have huu : (pullback.fst : P f g ⟶ X) ≫ f = pullback.fst ≫ g, by rw [hvu, ←huv],
has_limit.mk { cone := fork.of_ι pullback.fst huu,
  is_limit := fork.is_limit.mk _
  (λ s, pullback.lift (fork.ι s) (fork.ι s) $ prod.hom_ext
    (by simp only [prod.lift_fst, category.assoc])
    (by simp only [prod.comp_lift, fork.condition]))
  (λ s, by simp only [fork.ι_of_ι, pullback.lift_fst])
  (λ s m h, pullback.hom_ext
    (by simpa only [pullback.lift_fst] using h)
    (by simpa only [huv.symm, pullback.lift_fst] using h)) }

end

section
local attribute [instance] has_limit_parallel_pair

/-- A `normal_mono_category` category with finite products and kernels has all equalizers. -/
@[priority 100] instance has_equalizers : has_equalizers C :=
has_equalizers_of_has_limit_parallel_pair _

end

/-- If a zero morphism is a cokernel of `f`, then `f` is an epimorphism. -/
lemma epi_of_zero_cokernel {X Y : C} (f : X ⟶ Y) (Z : C)
  (l : is_colimit (cokernel_cofork.of_π (0 : Y ⟶ Z) (show f ≫ 0 = 0, by simp))) : epi f :=
⟨λ P u v huv,
 begin
  obtain ⟨W, w, hw, hl⟩ := normal_mono_of_mono (equalizer.ι u v),
  obtain ⟨m, hm⟩ := equalizer.lift' f huv,
  have hwf : f ≫ w = 0,
  { rw [←hm, category.assoc, hw, comp_zero] },
  obtain ⟨n, hn⟩ := cokernel_cofork.is_colimit.desc' l _ hwf,
  rw [cofork.π_of_π, zero_comp] at hn,
  haveI : is_iso (equalizer.ι u v),
  { apply is_iso_limit_cone_parallel_pair_of_eq hn.symm hl },
  apply (cancel_epi (equalizer.ι u v)).1,
  exact equalizer.condition _ _
 end⟩

section
variables [has_zero_object C]
open_locale zero_object

/-- If `f ≫ g = 0` implies `g = 0` for all `g`, then `g` is a monomorphism. -/
lemma epi_of_zero_cancel {X Y : C} (f : X ⟶ Y)
  (hf : ∀ (Z : C) (g : Y ⟶ Z) (hgf : f ≫ g = 0), g = 0) : epi f :=
epi_of_zero_cokernel f 0 $ zero_cokernel_of_zero_cancel f hf

end

end category_theory.normal_mono_category

namespace category_theory.normal_epi_category

variables [has_finite_coproducts C] [has_cokernels C] [normal_epi_category C]

/-- The pushout of two epimorphisms exists. -/
@[irreducible]
lemma pushout_of_epi {X Y Z : C} (a : X ⟶ Y) (b : X ⟶ Z) [epi a] [epi b] :
  has_colimit (span a b) :=
let ⟨P, f, hfa, i⟩ := normal_epi_of_epi a in
let ⟨Q, g, hgb, i'⟩ := normal_epi_of_epi b in
let ⟨a', ha'⟩ := cokernel_cofork.is_colimit.desc' i (cokernel.π (coprod.desc f g)) $
  calc f ≫ cokernel.π (coprod.desc f g)
      = coprod.inl ≫ coprod.desc f g ≫ cokernel.π (coprod.desc f g) : by rw coprod.inl_desc_assoc
  ... = coprod.inl ≫ (0 : P ⨿ Q ⟶ cokernel (coprod.desc f g)) : by rw cokernel.condition
  ... = 0 : has_zero_morphisms.comp_zero _ _ in
let ⟨b', hb'⟩ := cokernel_cofork.is_colimit.desc' i' (cokernel.π (coprod.desc f g)) $
  calc g ≫ cokernel.π (coprod.desc f g)
      = coprod.inr ≫ coprod.desc f g ≫ cokernel.π (coprod.desc f g) : by rw coprod.inr_desc_assoc
  ... = coprod.inr ≫ (0 : P ⨿ Q ⟶ cokernel (coprod.desc f g)) :  by rw cokernel.condition
  ... = 0 : has_zero_morphisms.comp_zero _ _ in
has_colimit.mk
{ cocone := pushout_cocone.mk a' b' $ by { simp only [cofork.π_of_π] at ha' hb', rw [ha', hb'] },
  is_colimit := pushout_cocone.is_colimit.mk _
  (λ s, cokernel.desc (coprod.desc f g) (b ≫ pushout_cocone.inr s) $ coprod.hom_ext
    (calc coprod.inl ≫ coprod.desc f g ≫ b ≫ pushout_cocone.inr s
          = f ≫ b ≫ pushout_cocone.inr s : by rw coprod.inl_desc_assoc
      ... = f ≫ a ≫ pushout_cocone.inl s : by rw pushout_cocone.condition
      ... = 0 ≫ pushout_cocone.inl s : by rw reassoc_of hfa
      ... = coprod.inl ≫ 0 : by rw [comp_zero, zero_comp])
    (calc coprod.inr ≫ coprod.desc f g ≫ b ≫ pushout_cocone.inr s
          = g ≫ b ≫ pushout_cocone.inr s : by rw coprod.inr_desc_assoc
      ... = 0 ≫ pushout_cocone.inr s : by rw reassoc_of hgb
      ... = coprod.inr ≫ 0 : by rw [comp_zero, zero_comp]))
  (λ s, (cancel_epi a).1 $
    by { rw cokernel_cofork.π_of_π at ha', simp [reassoc_of ha', pushout_cocone.condition s] })
  (λ s, (cancel_epi b).1 $ by { rw cokernel_cofork.π_of_π at hb', simp [reassoc_of hb'] })
  (λ s m h₁ h₂, (cancel_epi (cokernel.π (coprod.desc f g))).1 $
  calc cokernel.π (coprod.desc f g) ≫ m
        = (a ≫ a') ≫ m : by { congr, exact ha'.symm }
    ... = a ≫ pushout_cocone.inl s : by rw [category.assoc, h₁]
    ... = b ≫ pushout_cocone.inr s : pushout_cocone.condition s
    ... = cokernel.π (coprod.desc f g) ≫
            cokernel.desc (coprod.desc f g) (b ≫ pushout_cocone.inr s) _ :
      by rw cokernel.π_desc) }

section
local attribute [instance] pushout_of_epi

/-- The pushout of `(𝟙 Y, f)` and `(𝟙 Y, g)`. -/
private abbreviation Q {X Y : C} (f g : X ⟶ Y)
  [epi (coprod.desc (𝟙 Y) f)] [epi (coprod.desc (𝟙 Y) g)] : C :=
pushout (coprod.desc (𝟙 Y) f) (coprod.desc (𝟙 Y) g)

/-- The coequalizer of `f` and `g` exists. -/
@[irreducible]
lemma has_colimit_parallel_pair {X Y : C} (f g : X ⟶ Y) : has_colimit (parallel_pair f g) :=
have huv : (pushout.inl : Y ⟶ Q f g) = pushout.inr, from
  calc (pushout.inl : Y ⟶ Q f g) = 𝟙 _ ≫ pushout.inl : eq.symm $ category.id_comp _
    ... = (coprod.inl ≫ coprod.desc (𝟙 Y) f) ≫ pushout.inl : by rw coprod.inl_desc
    ... = (coprod.inl ≫ coprod.desc (𝟙 Y) g) ≫ pushout.inr :
      by simp only [category.assoc, pushout.condition]
    ... = pushout.inr : by rw [coprod.inl_desc, category.id_comp],
have hvu : f ≫ (pushout.inl : Y ⟶ Q f g) = g ≫ pushout.inr, from
  calc f ≫ (pushout.inl : Y ⟶ Q f g)
        = (coprod.inr ≫ coprod.desc (𝟙 Y) f) ≫ pushout.inl : by rw coprod.inr_desc
    ... = (coprod.inr ≫ coprod.desc (𝟙 Y) g) ≫ pushout.inr :
      by simp only [category.assoc, pushout.condition]
    ... = g ≫ pushout.inr : by rw coprod.inr_desc,
have huu : f ≫ (pushout.inl : Y ⟶ Q f g) = g ≫ pushout.inl, by rw [hvu, huv],
has_colimit.mk { cocone := cofork.of_π pushout.inl huu,
  is_colimit := cofork.is_colimit.mk _
  (λ s, pushout.desc (cofork.π s) (cofork.π s) $ coprod.hom_ext
    (by simp only [coprod.inl_desc_assoc])
    (by simp only [coprod.desc_comp, cofork.condition]))
  (λ s, by simp only [pushout.inl_desc, cofork.π_of_π])
  (λ s m h, pushout.hom_ext
    (by simpa only [pushout.inl_desc] using h)
    (by simpa only [huv.symm, pushout.inl_desc] using h)) }

end

section
local attribute [instance] has_colimit_parallel_pair

/-- A `normal_epi_category` category with finite coproducts and cokernels has all coequalizers. -/
@[priority 100] instance has_coequalizers : has_coequalizers C :=
has_coequalizers_of_has_colimit_parallel_pair _

end

/-- If a zero morphism is a kernel of `f`, then `f` is a monomorphism. -/
lemma mono_of_zero_kernel {X Y : C} (f : X ⟶ Y) (Z : C)
  (l : is_limit (kernel_fork.of_ι (0 : Z ⟶ X) (show 0 ≫ f = 0, by simp))) : mono f :=
⟨λ P u v huv,
 begin
  obtain ⟨W, w, hw, hl⟩ := normal_epi_of_epi (coequalizer.π u v),
  obtain ⟨m, hm⟩ := coequalizer.desc' f huv,
  have hwf : w ≫ f = 0,
  { rw [←hm, reassoc_of hw, zero_comp] },
  obtain ⟨n, hn⟩ := kernel_fork.is_limit.lift' l _ hwf,
  rw [fork.ι_of_ι, has_zero_morphisms.comp_zero] at hn,
  haveI : is_iso (coequalizer.π u v),
  { apply is_iso_colimit_cocone_parallel_pair_of_eq hn.symm hl },
  apply (cancel_mono (coequalizer.π u v)).1,
  exact coequalizer.condition _ _
 end⟩

section
variables [has_zero_object C]
open_locale zero_object

/-- If `g ≫ f = 0` implies `g = 0` for all `g`, then `f` is a monomorphism. -/
lemma mono_of_cancel_zero {X Y : C} (f : X ⟶ Y)
  (hf : ∀ (Z : C) (g : Z ⟶ X) (hgf : g ≫ f = 0), g = 0) : mono f :=
mono_of_zero_kernel f 0 $ zero_kernel_of_cancel_zero f hf

end

end category_theory.normal_epi_category


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison, Johannes Hölzl, Reid Barton

! This file was ported from Lean 3 source module category_theory.category.basic
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Combinatorics.Quiver.Basic

/-!
# Categories

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

Defines a category, as a type class parametrised by the type of objects.

## Notations

Introduces notations
* `X ⟶ Y` for the morphism spaces (type as `\hom`),
* `𝟙 X` for the identity morphism on `X` (type as `\b1`),
* `f ≫ g` for composition in the 'arrows' convention (type as `\gg`).

Users may like to add `f ⊚ g` for composition in the standard convention, using
```lean
local notation f ` ⊚ `:80 g:80 := category.comp g f    -- type as \oo
```
-/

library_note "category_theory universes"/--
The typeclass `category C` describes morphisms associated to objects of type `C : Type u`.

The universe levels of the objects and morphisms are independent, and will often need to be
specified explicitly, as `category.{v} C`.

Typically any concrete example will either be a `small_category`, where `v = u`,
which can be introduced as
```
universes u
variables {C : Type u} [small_category C]
```
or a `large_category`, where `u = v+1`, which can be introduced as
```
universes u
variables {C : Type (u+1)} [large_category C]
```

In order for the library to handle these cases uniformly,
we generally work with the unconstrained `category.{v u}`,
for which objects live in `Type u` and morphisms live in `Type v`.

Because the universe parameter `u` for the objects can be inferred from `C`
when we write `category C`, while the universe parameter `v` for the morphisms
can not be automatically inferred, through the category theory library
we introduce universe parameters with morphism levels listed first,
as in
```
universes v u
```
or
```
universes v₁ v₂ u₁ u₂
```
when multiple independent universes are needed.

This has the effect that we can simply write `category.{v} C`
(that is, only specifying a single parameter) while `u` will be inferred.

Often, however, it's not even necessary to include the `.{v}`.
(Although it was in earlier versions of Lean.)
If it is omitted a "free" universe will be used.
-/

universe v u

namespace CategoryTheory

#print CategoryTheory.CategoryStruct /-
/-- A preliminary structure on the way to defining a category,
containing the data, but none of the axioms. -/
class CategoryStruct (obj : Type u) extends Quiver.{v + 1} obj : Type max u (v + 1) where
  id : ∀ X : obj, hom X X
  comp : ∀ {X Y Z : obj}, (X ⟶ Y) → (Y ⟶ Z) → (X ⟶ Z)
#align category_theory.category_struct CategoryTheory.CategoryStruct
-/

-- mathport name: «expr𝟙»
notation "𝟙" => CategoryStruct.id

-- mathport name: «expr ≫ »
infixr:80
  " ≫ " =>-- type as \b1
  CategoryStruct.comp

#print CategoryTheory.Category /-
-- type as \gg
/-- The typeclass `category C` describes morphisms associated to objects of type `C`.
The universe levels of the objects and morphisms are unconstrained, and will often need to be
specified explicitly, as `category.{v} C`. (See also `large_category` and `small_category`.)

See <https://stacks.math.columbia.edu/tag/0014>.
-/
class Category (obj : Type u) extends CategoryStruct.{v} obj : Type max u (v + 1) where
  id_comp' : ∀ {X Y : obj} (f : hom X Y), 𝟙 X ≫ f = f := by obviously
  comp_id' : ∀ {X Y : obj} (f : hom X Y), f ≫ 𝟙 Y = f := by obviously
  assoc' :
    ∀ {W X Y Z : obj} (f : hom W X) (g : hom X Y) (h : hom Y Z), (f ≫ g) ≫ h = f ≫ g ≫ h := by
    obviously
#align category_theory.category CategoryTheory.Category
-/

-- `restate_axiom` is a command that creates a lemma from a structure field,
-- discarding any auto_param wrappers from the type.
-- (It removes a backtick from the name, if it finds one, and otherwise adds "_lemma".)
restate_axiom category.id_comp'

restate_axiom category.comp_id'

restate_axiom category.assoc'

attribute [simp] category.id_comp category.comp_id category.assoc

attribute [trans] category_struct.comp

#print CategoryTheory.LargeCategory /-
/-- A `large_category` has objects in one universe level higher than the universe level of
the morphisms. It is useful for examples such as the category of types, or the category
of groups, etc.
-/
abbrev LargeCategory (C : Type (u + 1)) : Type (u + 1) :=
  Category.{u} C
#align category_theory.large_category CategoryTheory.LargeCategory
-/

#print CategoryTheory.SmallCategory /-
/-- A `small_category` has objects and morphisms in the same universe level.
-/
abbrev SmallCategory (C : Type u) : Type (u + 1) :=
  Category.{u} C
#align category_theory.small_category CategoryTheory.SmallCategory
-/

section

variable {C : Type u} [Category.{v} C] {X Y Z : C}

initialize_simps_projections category (to_category_struct_to_quiver_hom → Hom,
  to_category_struct_comp → comp, to_category_struct_id → id, -toCategoryStruct)

#print CategoryTheory.eq_whisker /-
/-- postcompose an equation between morphisms by another morphism -/
theorem eq_whisker {f g : X ⟶ Y} (w : f = g) (h : Y ⟶ Z) : f ≫ h = g ≫ h := by rw [w]
#align category_theory.eq_whisker CategoryTheory.eq_whisker
-/

#print CategoryTheory.whisker_eq /-
/-- precompose an equation between morphisms by another morphism -/
theorem whisker_eq (f : X ⟶ Y) {g h : Y ⟶ Z} (w : g = h) : f ≫ g = f ≫ h := by rw [w]
#align category_theory.whisker_eq CategoryTheory.whisker_eq
-/

-- mathport name: «expr =≫ »
infixr:80 " =≫ " => eq_whisker

-- mathport name: «expr ≫= »
infixr:80 " ≫= " => whisker_eq

#print CategoryTheory.eq_of_comp_left_eq /-
theorem eq_of_comp_left_eq {f g : X ⟶ Y} (w : ∀ {Z : C} (h : Y ⟶ Z), f ≫ h = g ≫ h) : f = g :=
  by
  convert w (𝟙 Y)
  tidy
#align category_theory.eq_of_comp_left_eq CategoryTheory.eq_of_comp_left_eq
-/

#print CategoryTheory.eq_of_comp_right_eq /-
theorem eq_of_comp_right_eq {f g : Y ⟶ Z} (w : ∀ {X : C} (h : X ⟶ Y), h ≫ f = h ≫ g) : f = g :=
  by
  convert w (𝟙 Y)
  tidy
#align category_theory.eq_of_comp_right_eq CategoryTheory.eq_of_comp_right_eq
-/

#print CategoryTheory.eq_of_comp_left_eq' /-
theorem eq_of_comp_left_eq' (f g : X ⟶ Y)
    (w : (fun {Z : C} (h : Y ⟶ Z) => f ≫ h) = fun {Z : C} (h : Y ⟶ Z) => g ≫ h) : f = g :=
  eq_of_comp_left_eq fun Z h => by convert congr_fun (congr_fun w Z) h
#align category_theory.eq_of_comp_left_eq' CategoryTheory.eq_of_comp_left_eq'
-/

#print CategoryTheory.eq_of_comp_right_eq' /-
theorem eq_of_comp_right_eq' (f g : Y ⟶ Z)
    (w : (fun {X : C} (h : X ⟶ Y) => h ≫ f) = fun {X : C} (h : X ⟶ Y) => h ≫ g) : f = g :=
  eq_of_comp_right_eq fun X h => by convert congr_fun (congr_fun w X) h
#align category_theory.eq_of_comp_right_eq' CategoryTheory.eq_of_comp_right_eq'
-/

#print CategoryTheory.id_of_comp_left_id /-
theorem id_of_comp_left_id (f : X ⟶ X) (w : ∀ {Y : C} (g : X ⟶ Y), f ≫ g = g) : f = 𝟙 X :=
  by
  convert w (𝟙 X)
  tidy
#align category_theory.id_of_comp_left_id CategoryTheory.id_of_comp_left_id
-/

#print CategoryTheory.id_of_comp_right_id /-
theorem id_of_comp_right_id (f : X ⟶ X) (w : ∀ {Y : C} (g : Y ⟶ X), g ≫ f = g) : f = 𝟙 X :=
  by
  convert w (𝟙 X)
  tidy
#align category_theory.id_of_comp_right_id CategoryTheory.id_of_comp_right_id
-/

#print CategoryTheory.comp_ite /-
theorem comp_ite {P : Prop} [Decidable P] {X Y Z : C} (f : X ⟶ Y) (g g' : Y ⟶ Z) :
    (f ≫ if P then g else g') = if P then f ≫ g else f ≫ g' := by split_ifs <;> rfl
#align category_theory.comp_ite CategoryTheory.comp_ite
-/

#print CategoryTheory.ite_comp /-
theorem ite_comp {P : Prop} [Decidable P] {X Y Z : C} (f f' : X ⟶ Y) (g : Y ⟶ Z) :
    (if P then f else f') ≫ g = if P then f ≫ g else f' ≫ g := by split_ifs <;> rfl
#align category_theory.ite_comp CategoryTheory.ite_comp
-/

#print CategoryTheory.comp_dite /-
theorem comp_dite {P : Prop} [Decidable P] {X Y Z : C} (f : X ⟶ Y) (g : P → (Y ⟶ Z))
    (g' : ¬P → (Y ⟶ Z)) : (f ≫ if h : P then g h else g' h) = if h : P then f ≫ g h else f ≫ g' h :=
  by split_ifs <;> rfl
#align category_theory.comp_dite CategoryTheory.comp_dite
-/

#print CategoryTheory.dite_comp /-
theorem dite_comp {P : Prop} [Decidable P] {X Y Z : C} (f : P → (X ⟶ Y)) (f' : ¬P → (X ⟶ Y))
    (g : Y ⟶ Z) : (if h : P then f h else f' h) ≫ g = if h : P then f h ≫ g else f' h ≫ g := by
  split_ifs <;> rfl
#align category_theory.dite_comp CategoryTheory.dite_comp
-/

#print CategoryTheory.Epi /-
/-- A morphism `f` is an epimorphism if it can be "cancelled" when precomposed:
`f ≫ g = f ≫ h` implies `g = h`.

See <https://stacks.math.columbia.edu/tag/003B>.
-/
class Epi (f : X ⟶ Y) : Prop where
  left_cancellation : ∀ {Z : C} (g h : Y ⟶ Z) (w : f ≫ g = f ≫ h), g = h
#align category_theory.epi CategoryTheory.Epi
-/

#print CategoryTheory.Mono /-
/-- A morphism `f` is a monomorphism if it can be "cancelled" when postcomposed:
`g ≫ f = h ≫ f` implies `g = h`.

See <https://stacks.math.columbia.edu/tag/003B>.
-/
class Mono (f : X ⟶ Y) : Prop where
  right_cancellation : ∀ {Z : C} (g h : Z ⟶ X) (w : g ≫ f = h ≫ f), g = h
#align category_theory.mono CategoryTheory.Mono
-/

instance (X : C) : Epi (𝟙 X) :=
  ⟨fun Z g h w => by simpa using w⟩

instance (X : C) : Mono (𝟙 X) :=
  ⟨fun Z g h w => by simpa using w⟩

#print CategoryTheory.cancel_epi /-
theorem cancel_epi (f : X ⟶ Y) [Epi f] {g h : Y ⟶ Z} : f ≫ g = f ≫ h ↔ g = h :=
  ⟨fun p => Epi.left_cancellation g h p, congr_arg _⟩
#align category_theory.cancel_epi CategoryTheory.cancel_epi
-/

#print CategoryTheory.cancel_mono /-
theorem cancel_mono (f : X ⟶ Y) [Mono f] {g h : Z ⟶ X} : g ≫ f = h ≫ f ↔ g = h :=
  ⟨fun p => Mono.right_cancellation g h p, congr_arg _⟩
#align category_theory.cancel_mono CategoryTheory.cancel_mono
-/

#print CategoryTheory.cancel_epi_id /-
theorem cancel_epi_id (f : X ⟶ Y) [Epi f] {h : Y ⟶ Y} : f ≫ h = f ↔ h = 𝟙 Y :=
  by
  convert cancel_epi f
  simp
#align category_theory.cancel_epi_id CategoryTheory.cancel_epi_id
-/

#print CategoryTheory.cancel_mono_id /-
theorem cancel_mono_id (f : X ⟶ Y) [Mono f] {g : X ⟶ X} : g ≫ f = f ↔ g = 𝟙 X :=
  by
  convert cancel_mono f
  simp
#align category_theory.cancel_mono_id CategoryTheory.cancel_mono_id
-/

#print CategoryTheory.epi_comp /-
theorem epi_comp {X Y Z : C} (f : X ⟶ Y) [Epi f] (g : Y ⟶ Z) [Epi g] : Epi (f ≫ g) :=
  by
  constructor; intro Z a b w
  apply (cancel_epi g).1
  apply (cancel_epi f).1
  simpa using w
#align category_theory.epi_comp CategoryTheory.epi_comp
-/

#print CategoryTheory.mono_comp /-
theorem mono_comp {X Y Z : C} (f : X ⟶ Y) [Mono f] (g : Y ⟶ Z) [Mono g] : Mono (f ≫ g) :=
  by
  constructor; intro Z a b w
  apply (cancel_mono f).1
  apply (cancel_mono g).1
  simpa using w
#align category_theory.mono_comp CategoryTheory.mono_comp
-/

#print CategoryTheory.mono_of_mono /-
theorem mono_of_mono {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [Mono (f ≫ g)] : Mono f :=
  by
  constructor; intro Z a b w
  replace w := congr_arg (fun k => k ≫ g) w
  dsimp at w
  rw [category.assoc, category.assoc] at w
  exact (cancel_mono _).1 w
#align category_theory.mono_of_mono CategoryTheory.mono_of_mono
-/

#print CategoryTheory.mono_of_mono_fac /-
theorem mono_of_mono_fac {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} {h : X ⟶ Z} [Mono h] (w : f ≫ g = h) :
    Mono f := by
  subst h
  exact mono_of_mono f g
#align category_theory.mono_of_mono_fac CategoryTheory.mono_of_mono_fac
-/

#print CategoryTheory.epi_of_epi /-
theorem epi_of_epi {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [Epi (f ≫ g)] : Epi g :=
  by
  constructor; intro Z a b w
  replace w := congr_arg (fun k => f ≫ k) w
  dsimp at w
  rw [← category.assoc, ← category.assoc] at w
  exact (cancel_epi _).1 w
#align category_theory.epi_of_epi CategoryTheory.epi_of_epi
-/

#print CategoryTheory.epi_of_epi_fac /-
theorem epi_of_epi_fac {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} {h : X ⟶ Z} [Epi h] (w : f ≫ g = h) :
    Epi g := by subst h <;> exact epi_of_epi f g
#align category_theory.epi_of_epi_fac CategoryTheory.epi_of_epi_fac
-/

end

section

variable (C : Type u)

variable [Category.{v} C]

universe u'

#print CategoryTheory.uliftCategory /-
instance uliftCategory : Category.{v} (ULift.{u'} C)
    where
  Hom X Y := X.down ⟶ Y.down
  id X := 𝟙 X.down
  comp _ _ _ f g := f ≫ g
#align category_theory.ulift_category CategoryTheory.uliftCategory
-/

-- We verify that this previous instance can lift small categories to large categories.
example (D : Type u) [SmallCategory D] : LargeCategory (ULift.{u + 1} D) := by infer_instance

end

end CategoryTheory

library_note "dsimp, simp"/--
Many proofs in the category theory library use the `dsimp, simp` pattern,
which typically isn't necessary elsewhere.

One would usually hope that the same effect could be achieved simply with `simp`.

The essential issue is that composition of morphisms involves dependent types.
When you have a chain of morphisms being composed, say `f : X ⟶ Y` and `g : Y ⟶ Z`,
then `simp` can operate succesfully on the morphisms
(e.g. if `f` is the identity it can strip that off).

However if we have an equality of objects, say `Y = Y'`,
then `simp` can't operate because it would break the typing of the composition operations.
We rarely have interesting equalities of objects
(because that would be "evil" --- anything interesting should be expressed as an isomorphism
and tracked explicitly),
except of course that we have plenty of definitional equalities of objects.

`dsimp` can apply these safely, even inside a composition.

After `dsimp` has cleared up the object level, `simp` can resume work on the morphism level ---
but without the `dsimp` step, because `simp` looks at expressions syntactically,
the relevant lemmas might not fire.

There's no bound on how many times you potentially could have to switch back and forth,
if the `simp` introduced new objects we again need to `dsimp`.
In practice this does occur, but only rarely, because `simp` tends to shorten chains of compositions
(i.e. not introduce new objects at all).
-/


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury G. Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.list.sort
import Mathlib.data.fin
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Isomorphism between `fin (length l)` and `{x // x ∈ l}`

Given a list `l,

* if `l` has no duplicates, then `list.nodup.nth_le_equiv` is the bijection between `fin (length l)`
  and `{x // x ∈ l}` sending `⟨i, hi⟩` to `⟨nth_le l i hi, _⟩` with the inverse sending `⟨x, hx⟩` to
  `⟨index_of x l, _⟩`;

* if `l` is sorted w.r.t. `(<)`, then `list.sorted.nth_le_iso` is the same bijection reinterpreted
  as an `order_iso`.

-/

namespace list

namespace nodup

/-- If `l` has no duplicates, then `list.nth_le` defines a bijection between `fin (length l)` and
the set of elements of `l`. -/
def nth_le_equiv {α : Type u_1} [DecidableEq α] (l : List α) (H : nodup l) : fin (length l) ≃ Subtype fun (x : α) => x ∈ l :=
  equiv.mk (fun (i : fin (length l)) => { val := nth_le l ↑i sorry, property := sorry })
    (fun (x : Subtype fun (x : α) => x ∈ l) => { val := index_of (↑x) l, property := sorry }) sorry sorry

@[simp] theorem coe_nth_le_equiv_apply {α : Type u_1} [DecidableEq α] {l : List α} (H : nodup l) (i : fin (length l)) : ↑(coe_fn (nth_le_equiv l H) i) = nth_le l (↑i) (subtype.property i) :=
  rfl

@[simp] theorem coe_nth_le_equiv_symm_apply {α : Type u_1} [DecidableEq α] {l : List α} (H : nodup l) (x : Subtype fun (x : α) => x ∈ l) : ↑(coe_fn (equiv.symm (nth_le_equiv l H)) x) = index_of (↑x) l :=
  rfl

end nodup

namespace sorted

theorem nth_le_mono {α : Type u_1} [preorder α] {l : List α} (h : sorted LessEq l) : monotone fun (i : fin (length l)) => nth_le l (↑i) (subtype.property i) :=
  fun (i j : fin (length l)) => nth_le_of_sorted_of_le h

theorem nth_le_strict_mono {α : Type u_1} [preorder α] {l : List α} (h : sorted Less l) : strict_mono fun (i : fin (length l)) => nth_le l (↑i) (subtype.property i) :=
  fun (i j : fin (length l)) => iff.mp pairwise_iff_nth_le h (↑i) (↑j) (subtype.property j)

/-- If `l` is a list sorted w.r.t. `(<)`, then `list.nth_le` defines an order isomorphism between
`fin (length l)` and the set of elements of `l`. -/
def nth_le_iso {α : Type u_1} [preorder α] [DecidableEq α] (l : List α) (H : sorted Less l) : fin (length l) ≃o Subtype fun (x : α) => x ∈ l :=
  rel_iso.mk (nodup.nth_le_equiv l sorry) sorry

@[simp] theorem coe_nth_le_iso_apply {α : Type u_1} [preorder α] {l : List α} [DecidableEq α] (H : sorted Less l) {i : fin (length l)} : ↑(coe_fn (nth_le_iso l H) i) = nth_le l (↑i) (subtype.property i) :=
  rfl

@[simp] theorem coe_nth_le_iso_symm_apply {α : Type u_1} [preorder α] {l : List α} [DecidableEq α] (H : sorted Less l) {x : Subtype fun (x : α) => x ∈ l} : ↑(coe_fn (order_iso.symm (nth_le_iso l H)) x) = index_of (↑x) l :=
  rfl


/-
Copyright (c) 2018 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.products.basic
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
The hom functor, sending `(X, Y)` to the type `X ⟶ Y`.
-/

namespace category_theory.functor

/-- `functor.hom` is the hom-pairing, sending (X,Y) to X → Y, contravariant in X and covariant in Y. -/
def hom (C : Type u) [category C] : Cᵒᵖ × C ⥤ Type v :=
  mk (fun (p : Cᵒᵖ × C) => opposite.unop (prod.fst p) ⟶ prod.snd p)
    fun (X Y : Cᵒᵖ × C) (f : X ⟶ Y) (h : opposite.unop (prod.fst X) ⟶ prod.snd X) =>
      has_hom.hom.unop (prod.fst f) ≫ h ≫ prod.snd f

@[simp] theorem hom_obj (C : Type u) [category C] (X : Cᵒᵖ × C) : obj (hom C) X = (opposite.unop (prod.fst X) ⟶ prod.snd X) :=
  rfl

@[simp] theorem hom_pairing_map (C : Type u) [category C] {X : Cᵒᵖ × C} {Y : Cᵒᵖ × C} (f : X ⟶ Y) : map (hom C) f = fun (h : obj (hom C) X) => has_hom.hom.unop (prod.fst f) ≫ h ≫ prod.snd f :=
  rfl


import data.real.basic

variables x y : ℝ

theorem Q5a : ∀x, ∃y, x+y=2 := sorry

theorem Q5b : ¬ (∃ y, ∀ x, x+y=2) := sorry