/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.lie.of_associative
import algebra.lie.non_unital_non_assoc_algebra
import algebra.lie.universal_enveloping
import algebra.free_non_unital_non_assoc_algebra

/-!
# Free Lie algebras

Given a commutative ring `R` and a type `X` we construct the free Lie algebra on `X` with
coefficients in `R` together with its universal property.

## Main definitions

  * `free_lie_algebra`
  * `free_lie_algebra.lift`
  * `free_lie_algebra.of`
  * `free_lie_algebra.universal_enveloping_equiv_free_algebra`

## Implementation details

### Quotient of free non-unital, non-associative algebra

We follow [N. Bourbaki, *Lie Groups and Lie Algebras, Chapters 1--3*](bourbaki1975) and construct
the free Lie algebra as a quotient of the free non-unital, non-associative algebra. Since we do not
currently have definitions of ideals, lattices of ideals, and quotients for
`non_unital_non_assoc_semiring`, we construct our quotient using the low-level `quot` function on
an inductively-defined relation.

### Alternative construction (needs PBW)

An alternative construction of the free Lie algebra on `X` is to start with the free unital
associative algebra on `X`, regard it as a Lie algebra via the ring commutator, and take its
smallest Lie subalgebra containing `X`. I.e.:
`lie_subalgebra.lie_span R (free_algebra R X) (set.range (free_algebra.ι R))`.

However with this definition there does not seem to be an easy proof that the required universal
property holds, and I don't know of a proof that avoids invoking the Poincaré–Birkhoff–Witt theorem.
A related MathOverflow question is [this one](https://mathoverflow.net/questions/396680/).

## Tags

lie algebra, free algebra, non-unital, non-associative, universal property, forgetful functor,
adjoint functor
-/

universes u v w

noncomputable theory

variables (R : Type u) (X : Type v) [comm_ring R]

/-- We save characters by using Bourbaki's name `lib` (as in «libre») for
`free_non_unital_non_assoc_algebra` in this file. -/
local notation `lib` := free_non_unital_non_assoc_algebra
local notation `lib.lift` := free_non_unital_non_assoc_algebra.lift
local notation `lib.of` := free_non_unital_non_assoc_algebra.of
local notation `lib.lift_of_apply` := free_non_unital_non_assoc_algebra.lift_of_apply
local notation `lib.lift_comp_of` := free_non_unital_non_assoc_algebra.lift_comp_of

namespace free_lie_algebra

/-- The quotient of `lib R X` by the equivalence relation generated by this relation will give us
the free Lie algebra. -/
inductive rel : lib R X → lib R X → Prop
| lie_self (a : lib R X) : rel (a * a) 0
| leibniz_lie (a b c : lib R X) : rel (a * (b * c)) (((a * b) * c) + (b * (a * c)))
| smul (t : R) (a b : lib R X) : rel a b → rel (t • a) (t • b)
| add_right (a b c : lib R X) : rel a b → rel (a + c) (b + c)
| mul_left (a b c : lib R X) : rel b c → rel (a * b) (a * c)
| mul_right (a b c : lib R X) : rel a b → rel (a * c) (b * c)

variables {R X}

lemma rel.add_left (a b c : lib R X) (h : rel R X b c) : rel R X (a + b) (a + c) :=
by { rw [add_comm _ b, add_comm _ c], exact rel.add_right _ _ _ h, }

lemma rel.neg (a b : lib R X) (h : rel R X a b) : rel R X (-a) (-b) :=
h.smul (-1) _ _

end free_lie_algebra

/-- The free Lie algebra on the type `X` with coefficients in the commutative ring `R`. -/
@[derive inhabited]
def free_lie_algebra := quot (free_lie_algebra.rel R X)

namespace free_lie_algebra

instance : add_comm_group (free_lie_algebra R X) :=
{ add            := quot.map₂ (+) rel.add_left rel.add_right,
  add_comm       := by { rintros ⟨a⟩ ⟨b⟩, change quot.mk _ _ = quot.mk _ _, rw add_comm, },
  add_assoc      := by { rintros ⟨a⟩ ⟨b⟩ ⟨c⟩, change quot.mk _ _ = quot.mk _ _, rw add_assoc, },
  zero           := quot.mk _ 0,
  zero_add       := by { rintros ⟨a⟩, change quot.mk _ _ = _, rw zero_add, },
  add_zero       := by { rintros ⟨a⟩, change quot.mk _ _ = _, rw add_zero, },
  neg            := quot.map has_neg.neg rel.neg,
  add_left_neg   := by { rintros ⟨a⟩, change quot.mk _ _ = quot.mk _ _ , rw add_left_neg, } }

instance : module R (free_lie_algebra R X) :=
{ smul      := λ t, quot.map ((•) t) (rel.smul t),
  one_smul  := by { rintros ⟨a⟩, change quot.mk _ _ = quot.mk _ _, rw one_smul, },
  mul_smul  := by { rintros t₁ t₂ ⟨a⟩, change quot.mk _ _ = quot.mk _ _, rw mul_smul, },
  add_smul  := by { rintros t₁ t₂ ⟨a⟩, change quot.mk _ _ = quot.mk _ _, rw add_smul, },
  smul_add  := by { rintros t ⟨a⟩ ⟨b⟩, change quot.mk _ _ = quot.mk _ _, rw smul_add, },
  zero_smul := by { rintros ⟨a⟩, change quot.mk _ _ = quot.mk _ _, rw zero_smul, },
  smul_zero := λ t, by { change quot.mk _ _ = quot.mk _ _, rw smul_zero, }, }

/-- Note that here we turn the `has_mul` coming from the `non_unital_non_assoc_semiring` structure
on `lib R X` into a `has_bracket` on `free_lie_algebra`. -/
instance : lie_ring (free_lie_algebra R X) :=
{ bracket     := quot.map₂ (*) rel.mul_left rel.mul_right,
  add_lie     := by { rintros ⟨a⟩ ⟨b⟩ ⟨c⟩, change quot.mk _ _ = quot.mk _ _, rw add_mul, },
  lie_add     := by { rintros ⟨a⟩ ⟨b⟩ ⟨c⟩, change quot.mk _ _ = quot.mk _ _, rw mul_add, },
  lie_self    := by { rintros ⟨a⟩, exact quot.sound (rel.lie_self a), },
  leibniz_lie := by { rintros ⟨a⟩ ⟨b⟩ ⟨c⟩, exact quot.sound (rel.leibniz_lie a b c), }, }

instance : lie_algebra R (free_lie_algebra R X) :=
{ lie_smul :=
  begin
    rintros t ⟨a⟩ ⟨c⟩,
    change quot.mk _ (a • (t • c)) = quot.mk _ (t • (a • c)),
    rw ← smul_comm,
  end, }

variables {X}

/-- The embedding of `X` into the free Lie algebra of `X` with coefficients in the commutative ring
`R`. -/
def of : X → free_lie_algebra R X := λ x, quot.mk _ (lib.of R x)

variables {L : Type w} [lie_ring L] [lie_algebra R L]

local attribute [instance] lie_ring.to_non_unital_non_assoc_semiring

/-- An auxiliary definition used to construct the equivalence `lift` below. -/
def lift_aux (f : X → L) := lib.lift R f

lemma lift_aux_map_smul (f : X → L) (t : R) (a : lib R X) :
  lift_aux R f (t • a) = t • lift_aux R f a :=
non_unital_alg_hom.map_smul _ t a

lemma lift_aux_map_add (f : X → L) (a b : lib R X) :
  lift_aux R f (a + b) = (lift_aux R f a) + (lift_aux R f b) :=
non_unital_alg_hom.map_add _ a b

lemma lift_aux_map_mul (f : X → L) (a b : lib R X) :
  lift_aux R f (a * b) = ⁅lift_aux R f a, lift_aux R f b⁆ :=
non_unital_alg_hom.map_mul _ a b

lemma lift_aux_spec (f : X → L) (a b : lib R X) (h : free_lie_algebra.rel R X a b) :
  lift_aux R f a = lift_aux R f b :=
begin
  induction h,
  case rel.lie_self : a'
  { simp only [lift_aux_map_mul, non_unital_alg_hom.map_zero, lie_self], },
  case rel.leibniz_lie : a' b' c'
  { simp only [lift_aux_map_mul, lift_aux_map_add, sub_add_cancel, lie_lie], },
  case rel.smul : t a' b' h₁ h₂
  { simp only [lift_aux_map_smul, h₂], },
  case rel.add_right : a' b' c' h₁ h₂
  { simp only [lift_aux_map_add, h₂], },
  case rel.mul_left : a' b' c' h₁ h₂
  { simp only [lift_aux_map_mul, h₂], },
  case rel.mul_right : a' b' c' h₁ h₂
  { simp only [lift_aux_map_mul, h₂], },
end

/-- The quotient map as a `non_unital_alg_hom`. -/
def mk : non_unital_alg_hom R (lib R X) (free_lie_algebra R X) :=
{ to_fun    := quot.mk (rel R X),
  map_smul' := λ t a, rfl,
  map_zero' := rfl,
  map_add'  := λ a b, rfl,
  map_mul'  := λ a b, rfl, }

/-- The functor `X ↦ free_lie_algebra R X` from the category of types to the category of Lie
algebras over `R` is adjoint to the forgetful functor in the other direction. -/
def lift : (X → L) ≃ (free_lie_algebra R X →ₗ⁅R⁆ L) :=
{ to_fun    := λ f,
    { to_fun    := λ c, quot.lift_on c (lift_aux R f) (lift_aux_spec R f),
      map_add'  := by { rintros ⟨a⟩ ⟨b⟩, rw ← lift_aux_map_add, refl, },
      map_smul' := by { rintros t ⟨a⟩, rw ← lift_aux_map_smul, refl, },
      map_lie'  := by { rintros ⟨a⟩ ⟨b⟩, rw ← lift_aux_map_mul, refl, }, },
  inv_fun   := λ F, F ∘ (of R),
  left_inv  := λ f, by { ext x, simp only [lift_aux, of, quot.lift_on_mk, lie_hom.coe_mk,
    function.comp_app, lib.lift_of_apply], },
  right_inv := λ F,
    begin
      ext ⟨a⟩,
      let F' := F.to_non_unital_alg_hom.comp (mk R),
      exact non_unital_alg_hom.congr_fun (lib.lift_comp_of R F') a,
    end, }

@[simp] lemma lift_symm_apply (F : free_lie_algebra R X →ₗ⁅R⁆ L) : (lift R).symm F = F ∘ (of R) :=
rfl

variables {R}

@[simp] lemma of_comp_lift (f : X → L) : (lift R f) ∘ (of R) = f :=
(lift R).left_inv f

@[simp] lemma lift_unique (f : X → L) (g : free_lie_algebra R X →ₗ⁅R⁆ L) :
  g ∘ (of R) = f ↔ g = lift R f :=
(lift R).symm_apply_eq

attribute [irreducible] of lift

@[simp] lemma lift_of_apply (f : X → L) (x) : lift R f (of R x) = f x :=
by rw [← function.comp_app (lift R f) (of R) x, of_comp_lift]

@[simp] lemma lift_comp_of (F : free_lie_algebra R X →ₗ⁅R⁆ L) : lift R (F ∘ (of R)) = F :=
by { rw ← lift_symm_apply, exact (lift R).apply_symm_apply F, }

@[ext] lemma hom_ext {F₁ F₂ : free_lie_algebra R X →ₗ⁅R⁆ L} (h : ∀ x, F₁ (of R x) = F₂ (of R x)) :
  F₁ = F₂ :=
have h' : (lift R).symm F₁ = (lift R).symm F₂, { ext, simp [h], },
(lift R).symm.injective h'

variables (R X)

/-- The universal enveloping algebra of the free Lie algebra is just the free unital associative
algebra. -/
@[simps] def universal_enveloping_equiv_free_algebra :
  universal_enveloping_algebra R (free_lie_algebra R X) ≃ₐ[R] free_algebra R X :=
alg_equiv.of_alg_hom
  (universal_enveloping_algebra.lift R $ free_lie_algebra.lift R $ free_algebra.ι R)
  (free_algebra.lift R $ (universal_enveloping_algebra.ι R) ∘ (free_lie_algebra.of R))
  (by { ext, simp, })
  (by { ext, simp, })

end free_lie_algebra


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

/-!
# Sets in sigma types

This file defines `set.sigma`, the indexed sum of sets.
-/

namespace set
variables {ι ι' : Type*} {α β : ι → Type*} {s s₁ s₂ : set ι} {t t₁ t₂ : Π i, set (α i)}
  {u : set (Σ i, α i)} {x : Σ i, α i} {i j : ι} {a : α i}

@[simp] theorem range_sigma_mk (i : ι) :
  range (sigma.mk i : α i → sigma α) = sigma.fst ⁻¹' {i} :=
begin
  apply subset.antisymm,
  { rintros _ ⟨b, rfl⟩, simp },
  { rintros ⟨x, y⟩ (rfl|_),
    exact mem_range_self y }
end

theorem preimage_image_sigma_mk_of_ne (h : i ≠ j) (s : set (α j)) :
  sigma.mk i ⁻¹' (sigma.mk j '' s) = ∅ :=
by { ext x, simp [h.symm] }

lemma image_sigma_mk_preimage_sigma_map_subset {β : ι' → Type*} (f : ι → ι')
  (g : Π i, α i → β (f i)) (i : ι) (s : set (β (f i))) :
  sigma.mk i '' (g i ⁻¹' s) ⊆ sigma.map f g ⁻¹' (sigma.mk (f i) '' s) :=
image_subset_iff.2 $ λ x hx, ⟨g i x, hx, rfl⟩

lemma image_sigma_mk_preimage_sigma_map {β : ι' → Type*} {f : ι → ι'} (hf : function.injective f)
  (g : Π i, α i → β (f i)) (i : ι) (s : set (β (f i))) :
  sigma.mk i '' (g i ⁻¹' s) = sigma.map f g ⁻¹' (sigma.mk (f i) '' s) :=
begin
  refine (image_sigma_mk_preimage_sigma_map_subset f g i s).antisymm _,
  rintro ⟨j, x⟩ ⟨y, hys, hxy⟩,
  simp only [hf.eq_iff, sigma.map] at hxy,
  rcases hxy with ⟨rfl, hxy⟩, rw [heq_iff_eq] at hxy, subst y,
  exact ⟨x, hys, rfl⟩
end

/-- Indexed sum of sets. `s.sigma t` is the set of dependent pairs `⟨i, a⟩` such that `i ∈ s` and
`a ∈ t i`.-/
protected def sigma (s : set ι) (t : Π i, set (α i)) : set (Σ i, α i) := {x | x.1 ∈ s ∧ x.2 ∈ t x.1}

@[simp] lemma mem_sigma_iff : x ∈ s.sigma t ↔ x.1 ∈ s ∧ x.2 ∈ t x.1 := iff.rfl
@[simp] lemma mk_sigma_iff : (⟨i, a⟩ : Σ i, α i) ∈ s.sigma t ↔ i ∈ s ∧ a ∈ t i := iff.rfl

lemma mk_mem_sigma (hi : i ∈ s) (ha : a ∈ t i) : (⟨i, a⟩ : Σ i, α i) ∈ s.sigma t := ⟨hi, ha⟩

lemma sigma_mono (hs : s₁ ⊆ s₂) (ht : ∀ i, t₁ i ⊆ t₂ i) : s₁.sigma t₁ ⊆ s₂.sigma t₂ :=
λ x hx, ⟨hs hx.1, ht _ hx.2⟩

lemma sigma_subset_iff : s.sigma t ⊆ u ↔ ∀ ⦃i⦄, i ∈ s → ∀ ⦃a⦄, a ∈ t i → (⟨i, a⟩ : Σ i, α i) ∈ u :=
⟨λ h i hi a ha, h $ mk_mem_sigma hi ha, λ h ⟨i, a⟩ ha, h ha.1 ha.2⟩

lemma forall_sigma_iff {p : (Σ i, α i) → Prop} :
  (∀ x ∈ s.sigma t, p x) ↔ ∀ ⦃i⦄, i ∈ s → ∀ ⦃a⦄, a ∈ t i → p ⟨i, a⟩ :=
sigma_subset_iff

lemma exists_sigma_iff {p : (Σ i, α i) → Prop} :
  (∃ x ∈ s.sigma t, p x) ↔ ∃ (i ∈ s) (a ∈ t i), p ⟨i, a⟩ :=
⟨λ ⟨⟨i, a⟩, ha, h⟩, ⟨i, ha.1, a, ha.2, h⟩, λ ⟨i, hi, a, ha, h⟩, ⟨⟨i, a⟩, ⟨hi, ha⟩, h⟩⟩

@[simp] lemma sigma_empty : s.sigma (λ _, (∅ : set (α i))) = ∅ := ext $ λ _, and_false _
@[simp] lemma empty_sigma : (∅ : set ι).sigma t = ∅ := ext $ λ _, false_and _
lemma univ_sigma_univ : (@univ ι).sigma (λ _, @univ (α i)) = univ := ext $ λ _, true_and _
@[simp] lemma sigma_univ : s.sigma (λ _, univ : Π i, set (α i)) = sigma.fst ⁻¹' s :=
ext $ λ _, and_true _

@[simp] lemma singleton_sigma : ({i} : set ι).sigma t = sigma.mk i '' t i :=
ext $ λ x, begin
  split,
  { obtain ⟨j, a⟩ := x,
    rintro ⟨(rfl : j = i), ha⟩,
    exact mem_image_of_mem _ ha },
  { rintro ⟨b, hb, rfl⟩,
    exact ⟨rfl, hb⟩ }
end

@[simp] lemma sigma_singleton {a : Π i, α i} :
  s.sigma (λ i, ({a i} : set (α i))) = (λ i, sigma.mk i $ a i) '' s :=
by { ext ⟨x, y⟩, simp [and.left_comm, eq_comm] }

lemma singleton_sigma_singleton {a : Π i, α i} :
  ({i} : set ι).sigma (λ i, ({a i} : set (α i))) = {⟨i, a i⟩} :=
by rw [sigma_singleton, image_singleton]

@[simp] lemma union_sigma : (s₁ ∪ s₂).sigma t = s₁.sigma t ∪ s₂.sigma t :=
ext $ λ _, or_and_distrib_right

@[simp] lemma sigma_union : s.sigma (λ i, t₁ i ∪ t₂ i) = s.sigma t₁ ∪ s.sigma t₂ :=
ext $ λ _, and_or_distrib_left

lemma sigma_inter_sigma : s₁.sigma t₁ ∩ s₂.sigma t₂ = (s₁ ∩ s₂).sigma (λ i, t₁ i ∩ t₂ i) :=
by { ext ⟨x, y⟩, simp [and_assoc, and.left_comm] }

lemma insert_sigma : (insert i s).sigma t = (sigma.mk i '' t i) ∪ s.sigma t :=
by rw [insert_eq, union_sigma, singleton_sigma]

lemma sigma_insert {a : Π i, α i} :
  s.sigma (λ i, insert (a i) (t i)) = ((λ i, ⟨i, a i⟩) '' s) ∪ s.sigma t :=
by simp_rw [insert_eq, sigma_union, sigma_singleton]

lemma sigma_preimage_eq {f : ι' → ι} {g : Π i, β i → α i} :
  (f ⁻¹' s).sigma (λ i, g (f i) ⁻¹' t (f i)) =
    (λ p : Σ i, β (f i), sigma.mk _ (g _ p.2)) ⁻¹' (s.sigma t) := rfl

lemma sigma_preimage_left {f : ι' → ι} :
  (f ⁻¹' s).sigma (λ i, t (f i)) = (λ p : Σ i, α (f i), sigma.mk _ p.2) ⁻¹' (s.sigma t) := rfl

lemma sigma_preimage_right {g : Π i, β i → α i} :
  s.sigma (λ i, g i ⁻¹' t i) = (λ p : Σ i, β i, sigma.mk p.1 (g _ p.2)) ⁻¹' (s.sigma t) := rfl

lemma preimage_sigma_map_sigma {α' : ι' → Type*} (f : ι → ι') (g : Π i, α i → α' (f i)) (s : set ι')
  (t : Π i, set (α' i)) :
  sigma.map f g ⁻¹' (s.sigma t) = (f ⁻¹' s).sigma (λ i, g i ⁻¹' t (f i)) := rfl

@[simp] lemma mk_preimage_sigma (hi : i ∈ s) : sigma.mk i ⁻¹' s.sigma t = t i :=
ext $ λ _, and_iff_right hi

@[simp] lemma mk_preimage_sigma_eq_empty (hi : i ∉ s) : sigma.mk i ⁻¹' s.sigma t = ∅ :=
ext $ λ _, iff_of_false (hi ∘ and.left) id

lemma mk_preimage_sigma_eq_if [decidable_pred (∈ s)] :
  sigma.mk i ⁻¹' s.sigma t = if i ∈ s then t i else ∅ :=
by split_ifs; simp [h]

lemma mk_preimage_sigma_fn_eq_if {β : Type*} [decidable_pred (∈ s)] (g : β → α i) :
  (λ b, sigma.mk i (g b)) ⁻¹' s.sigma t = if i ∈ s then g ⁻¹' t i else ∅ :=
ext $ λ _, by split_ifs; simp [h]

lemma sigma_univ_range_eq {f : Π i, α i → β i} :
  (univ : set ι).sigma (λ i, range (f i)) = range (λ x : Σ i, α i, ⟨x.1, f _ x.2⟩) :=
ext $ by simp [range]

protected lemma nonempty.sigma :
  s.nonempty → (∀ i, (t i).nonempty) → (s.sigma t : set _).nonempty :=
λ ⟨i, hi⟩ h, let ⟨a, ha⟩ := h i in ⟨⟨i, a⟩, hi, ha⟩

lemma nonempty.sigma_fst : (s.sigma t : set _).nonempty → s.nonempty := λ ⟨x, hx⟩, ⟨x.1, hx.1⟩
lemma nonempty.sigma_snd : (s.sigma t : set _).nonempty → ∃ i ∈ s, (t i).nonempty :=
λ ⟨x, hx⟩, ⟨x.1, hx.1, x.2, hx.2⟩

lemma sigma_nonempty_iff : (s.sigma t : set _).nonempty ↔ ∃ i ∈ s, (t i).nonempty :=
⟨nonempty.sigma_snd, λ ⟨i, hi, a, ha⟩, ⟨⟨i, a⟩, hi, ha⟩⟩

lemma sigma_eq_empty_iff : s.sigma t = ∅ ↔ ∀ i ∈ s, t i = ∅ :=
not_nonempty_iff_eq_empty.symm.trans $ sigma_nonempty_iff.not.trans $
  by simp only [not_nonempty_iff_eq_empty, not_exists]

lemma image_sigma_mk_subset_sigma_left {a : Π i, α i} (ha : ∀ i, a i ∈ t i) :
  (λ i, sigma.mk i (a i)) '' s ⊆ s.sigma t :=
image_subset_iff.2 $ λ i hi, ⟨hi, ha _⟩

lemma image_sigma_mk_subset_sigma_right (hi : i ∈ s) : sigma.mk i '' t i ⊆ s.sigma t :=
image_subset_iff.2 $ λ a, and.intro hi

lemma sigma_subset_preimage_fst (s : set ι) (t : Π i, set (α i)) : s.sigma t ⊆ sigma.fst ⁻¹' s :=
λ a, and.left

lemma fst_image_sigma_subset (s : set ι) (t : Π i, set (α i)) : sigma.fst '' s.sigma t ⊆ s :=
image_subset_iff.2 $ λ a, and.left

lemma fst_image_sigma (s : set ι) (ht : ∀ i, (t i).nonempty) : sigma.fst '' s.sigma t = s :=
(fst_image_sigma_subset _ _).antisymm $ λ i hi, let ⟨a, ha⟩ := ht i in ⟨⟨i, a⟩, ⟨hi, ha⟩, rfl⟩

lemma sigma_diff_sigma : s₁.sigma t₁ \ s₂.sigma t₂ = s₁.sigma (t₁ \ t₂) ∪ (s₁ \ s₂).sigma t₁ :=
ext $ λ x, by by_cases h₁ : x.1 ∈ s₁; by_cases h₂ : x.2 ∈ t₁ x.1; simp [*, ←imp_iff_or_not]

end set


/-
Copyright (c) 2021 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta

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

/-!
# Disjoint coproducts

Defines disjoint coproducts: coproducts where the intersection is initial and the coprojections
are monic.
Shows that a category with disjoint coproducts is `InitialMonoClass`.

## TODO

* Adapt this to the infinitary (small) version: This is one of the conditions in Giraud's theorem
  characterising sheaf topoi.
* Construct examples (and counterexamples?), eg Type, Vec.
* Define extensive categories, and show every extensive category has disjoint coproducts.
* Define coherent categories and use this to define positive coherent categories.
-/

universe v u u₂

namespace CategoryTheory

namespace Limits

open Category

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

/-- Given any pullback diagram of the form

Z  ⟶  X₁
↓      ↓
X₂ ⟶  X

where `X₁ ⟶ X ← X₂` is a coproduct diagram, then `Z` is initial, and both `X₁ ⟶ X` and `X₂ ⟶ X`
are mono.
-/
class CoproductDisjoint (X₁ X₂ : C) where
  isInitialOfIsPullbackOfIsCoproduct :
    ∀ {X Z} {pX₁ : X₁ ⟶ X} {pX₂ : X₂ ⟶ X} {f : Z ⟶ X₁} {g : Z ⟶ X₂}
      (_cX : IsColimit (BinaryCofan.mk pX₁ pX₂)) {comm : f ≫ pX₁ = g ≫ pX₂},
      IsLimit (PullbackCone.mk _ _ comm) → IsInitial Z
  mono_inl : ∀ (X) (X₁ : X₁ ⟶ X) (X₂ : X₂ ⟶ X) (_cX : IsColimit (BinaryCofan.mk X₁ X₂)), Mono X₁
  mono_inr : ∀ (X) (X₁ : X₁ ⟶ X) (X₂ : X₂ ⟶ X) (_cX : IsColimit (BinaryCofan.mk X₁ X₂)), Mono X₂
#align category_theory.limits.coproduct_disjoint CategoryTheory.Limits.CoproductDisjoint

/-- If the coproduct of `X₁` and `X₂` is disjoint, then given any pullback square

Z  ⟶  X₁
↓      ↓
X₂ ⟶  X

where `X₁ ⟶ X ← X₂` is a coproduct, then `Z` is initial.
-/
def isInitialOfIsPullbackOfIsCoproduct {Z X₁ X₂ X : C} [CoproductDisjoint X₁ X₂] {pX₁ : X₁ ⟶ X}
    {pX₂ : X₂ ⟶ X} (cX : IsColimit (BinaryCofan.mk pX₁ pX₂)) {f : Z ⟶ X₁} {g : Z ⟶ X₂}
    {comm : f ≫ pX₁ = g ≫ pX₂} (cZ : IsLimit (PullbackCone.mk _ _ comm)) : IsInitial Z :=
  CoproductDisjoint.isInitialOfIsPullbackOfIsCoproduct cX cZ
#align category_theory.limits.is_initial_of_is_pullback_of_is_coproduct CategoryTheory.Limits.isInitialOfIsPullbackOfIsCoproduct

/-- If the coproduct of `X₁` and `X₂` is disjoint, then given any pullback square

Z  ⟶  X₁
↓       ↓
X₂ ⟶  X₁ ⨿ X₂

`Z` is initial.
-/
noncomputable def isInitialOfIsPullbackOfCoproduct {Z X₁ X₂ : C} [HasBinaryCoproduct X₁ X₂]
    [CoproductDisjoint X₁ X₂] {f : Z ⟶ X₁} {g : Z ⟶ X₂}
    {comm : f ≫ (coprod.inl : X₁ ⟶ _ ⨿ X₂) = g ≫ coprod.inr}
    (cZ : IsLimit (PullbackCone.mk _ _ comm)) : IsInitial Z :=
  CoproductDisjoint.isInitialOfIsPullbackOfIsCoproduct (coprodIsCoprod _ _) cZ
#align category_theory.limits.is_initial_of_is_pullback_of_coproduct CategoryTheory.Limits.isInitialOfIsPullbackOfCoproduct

/-- If the coproduct of `X₁` and `X₂` is disjoint, then provided `X₁ ⟶ X ← X₂` is a coproduct the
pullback is an initial object:

        X₁
        ↓
X₂ ⟶  X
-/
noncomputable def isInitialOfPullbackOfIsCoproduct {X X₁ X₂ : C} [CoproductDisjoint X₁ X₂]
    {pX₁ : X₁ ⟶ X} {pX₂ : X₂ ⟶ X} [HasPullback pX₁ pX₂] (cX : IsColimit (BinaryCofan.mk pX₁ pX₂)) :
    IsInitial (pullback pX₁ pX₂) :=
  CoproductDisjoint.isInitialOfIsPullbackOfIsCoproduct cX (pullbackIsPullback _ _)
#align category_theory.limits.is_initial_of_pullback_of_is_coproduct CategoryTheory.Limits.isInitialOfPullbackOfIsCoproduct

/-- If the coproduct of `X₁` and `X₂` is disjoint, the pullback of `X₁ ⟶ X₁ ⨿ X₂` and `X₂ ⟶ X₁ ⨿ X₂`
is initial.
-/
noncomputable def isInitialOfPullbackOfCoproduct {X₁ X₂ : C} [HasBinaryCoproduct X₁ X₂]
    [CoproductDisjoint X₁ X₂] [HasPullback (coprod.inl : X₁ ⟶ _ ⨿ X₂) coprod.inr] :
    IsInitial (pullback (coprod.inl : X₁ ⟶ _ ⨿ X₂) coprod.inr) :=
  isInitialOfIsPullbackOfCoproduct (pullbackIsPullback _ _)
#align category_theory.limits.is_initial_of_pullback_of_coproduct CategoryTheory.Limits.isInitialOfPullbackOfCoproduct

instance {X₁ X₂ : C} [HasBinaryCoproduct X₁ X₂] [CoproductDisjoint X₁ X₂] :
    Mono (coprod.inl : X₁ ⟶ X₁ ⨿ X₂) :=
  CoproductDisjoint.mono_inl _ _ _ (coprodIsCoprod _ _)

instance {X₁ X₂ : C} [HasBinaryCoproduct X₁ X₂] [CoproductDisjoint X₁ X₂] :
    Mono (coprod.inr : X₂ ⟶ X₁ ⨿ X₂) :=
  CoproductDisjoint.mono_inr _ _ _ (coprodIsCoprod _ _)

/-- `C` has disjoint coproducts if every coproduct is disjoint. -/
class CoproductsDisjoint (C : Type u) [Category.{v} C] where
  CoproductDisjoint : ∀ X Y : C, CoproductDisjoint X Y
#align category_theory.limits.coproducts_disjoint CategoryTheory.Limits.CoproductsDisjoint

attribute [instance] CoproductsDisjoint.CoproductDisjoint

/-- If `C` has disjoint coproducts, any morphism out of initial is mono. Note it isn't true in
general that `C` has strict initial objects, for instance consider the category of types and
partial functions. -/
theorem initialMonoClass_of_disjoint_coproducts [CoproductsDisjoint C] : InitialMonoClass C where
  isInitial_mono_from X hI :=
    CoproductDisjoint.mono_inl X (IsInitial.to hI X) (CategoryTheory.CategoryStruct.id X)
      { desc := fun s : BinaryCofan _ _ => s.inr
        fac := fun _s j =>
          Discrete.casesOn j fun j => WalkingPair.casesOn j (hI.hom_ext _ _) (id_comp _)
        uniq := fun (_s : BinaryCofan _ _) _m w =>
          (id_comp _).symm.trans (w ⟨WalkingPair.right⟩) }
#align category_theory.limits.initial_mono_class_of_disjoint_coproducts CategoryTheory.Limits.initialMonoClass_of_disjoint_coproducts

end Limits

end CategoryTheory


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

import ring_theory.integrally_closed
import ring_theory.valuation.integers

/-!
# Integral elements over the ring of integers of a valution

The ring of integers is integrally closed inside the original ring.
-/

universes u v w

open_locale big_operators

namespace valuation

namespace integers

section comm_ring

variables {R : Type u} {Γ₀ : Type v} [comm_ring R] [linear_ordered_comm_group_with_zero Γ₀]
variables {v : valuation R Γ₀} {O : Type w} [comm_ring O] [algebra O R] (hv : integers v O)
include hv

open polynomial

lemma mem_of_integral {x : R} (hx : is_integral O x) : x ∈ v.integer :=
let ⟨p, hpm, hpx⟩ := hx in le_of_not_lt $ λ (hvx : 1 < v x), begin
  rw [hpm.as_sum, eval₂_add, eval₂_pow, eval₂_X, eval₂_finset_sum, add_eq_zero_iff_eq_neg] at hpx,
  replace hpx := congr_arg v hpx, refine ne_of_gt _ hpx,
  rw [v.map_neg, v.map_pow],
  refine v.map_sum_lt' (zero_lt_one.trans_le (one_le_pow_of_one_le' hvx.le _)) (λ i hi, _),
  rw [eval₂_mul, eval₂_pow, eval₂_C, eval₂_X, v.map_mul, v.map_pow, ← one_mul (v x ^ p.nat_degree)],
  cases (hv.2 $ p.coeff i).lt_or_eq with hvpi hvpi,
  { exact mul_lt_mul₀ hvpi (pow_lt_pow₀ hvx $ finset.mem_range.1 hi) },
  { erw hvpi, rw [one_mul, one_mul], exact pow_lt_pow₀ hvx (finset.mem_range.1 hi) }
end

protected lemma integral_closure : integral_closure O R = ⊥ :=
bot_unique $ λ r hr, let ⟨x, hx⟩ := hv.3 (hv.mem_of_integral hr) in algebra.mem_bot.2 ⟨x, hx⟩

end comm_ring

section fraction_field

variables {K : Type u} {Γ₀ : Type v} [field K] [linear_ordered_comm_group_with_zero Γ₀]
variables {v : valuation K Γ₀} {O : Type w} [comm_ring O] [is_domain O]
variables [algebra O K] [is_fraction_ring O K]
variables (hv : integers v O)

lemma integrally_closed : is_integrally_closed O :=
(is_integrally_closed.integral_closure_eq_bot_iff K).mp (valuation.integers.integral_closure hv)

end fraction_field

end integers

end valuation


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

import ring_theory.integrally_closed
import ring_theory.valuation.integers

/-!
# Integral elements over the ring of integers of a valution

The ring of integers is integrally closed inside the original ring.
-/

universes u v w

open_locale big_operators

namespace valuation

namespace integers

section comm_ring

variables {R : Type u} {Γ₀ : Type v} [comm_ring R] [linear_ordered_comm_group_with_zero Γ₀]
variables {v : valuation R Γ₀} {O : Type w} [comm_ring O] [algebra O R] (hv : integers v O)
include hv

open polynomial

lemma mem_of_integral {x : R} (hx : is_integral O x) : x ∈ v.integer :=
let ⟨p, hpm, hpx⟩ := hx in le_of_not_lt $ λ (hvx : 1 < v x), begin
  rw [hpm.as_sum, eval₂_add, eval₂_pow, eval₂_X, eval₂_finset_sum, add_eq_zero_iff_eq_neg] at hpx,
  replace hpx := congr_arg v hpx, refine ne_of_gt _ hpx,
  rw [v.map_neg, v.map_pow],
  refine v.map_sum_lt' (zero_lt_one₀.trans_le (one_le_pow_of_one_le' hvx.le _)) (λ i hi, _),
  rw [eval₂_mul, eval₂_pow, eval₂_C, eval₂_X, v.map_mul, v.map_pow, ← one_mul (v x ^ p.nat_degree)],
  cases (hv.2 $ p.coeff i).lt_or_eq with hvpi hvpi,
  { exact mul_lt_mul₀ hvpi (pow_lt_pow₀ hvx $ finset.mem_range.1 hi) },
  { erw hvpi, rw [one_mul, one_mul], exact pow_lt_pow₀ hvx (finset.mem_range.1 hi) }
end

protected lemma integral_closure : integral_closure O R = ⊥ :=
bot_unique $ λ r hr, let ⟨x, hx⟩ := hv.3 (hv.mem_of_integral hr) in algebra.mem_bot.2 ⟨x, hx⟩

end comm_ring

section fraction_field

variables {K : Type u} {Γ₀ : Type v} [field K] [linear_ordered_comm_group_with_zero Γ₀]
variables {v : valuation K Γ₀} {O : Type w} [comm_ring O] [is_domain O]
variables [algebra O K] [is_fraction_ring O K]
variables (hv : integers v O)

lemma integrally_closed : is_integrally_closed O :=
(is_integrally_closed.integral_closure_eq_bot_iff K).mp (valuation.integers.integral_closure hv)

end fraction_field

end integers

end valuation


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.adjunction.limits
import category_theory.adjunction.opposites
import category_theory.elements
import category_theory.limits.functor_category
import category_theory.limits.kan_extension
import category_theory.limits.preserves.limits
import category_theory.limits.shapes.terminal
import category_theory.limits.types

/-!
# Colimit of representables

This file constructs an adjunction `yoneda_adjunction` between `(Cᵒᵖ ⥤ Type u)` and `ℰ` given a
functor `A : C ⥤ ℰ`, where the right adjoint sends `(E : ℰ)` to `c ↦ (A.obj c ⟶ E)` (provided `ℰ`
has colimits).

This adjunction is used to show that every presheaf is a colimit of representables.

Further, the left adjoint `colimit_adj.extend_along_yoneda : (Cᵒᵖ ⥤ Type u) ⥤ ℰ` satisfies
`yoneda ⋙ L ≅ A`, that is, an extension of `A : C ⥤ ℰ` to `(Cᵒᵖ ⥤ Type u) ⥤ ℰ` through
`yoneda : C ⥤ Cᵒᵖ ⥤ Type u`. It is the left Kan extension of `A` along the yoneda embedding,
sometimes known as the Yoneda extension, as proved in `extend_along_yoneda_iso_Kan`.

`unique_extension_along_yoneda` shows `extend_along_yoneda` is unique amongst cocontinuous functors
with this property, establishing the presheaf category as the free cocompletion of a small category.

## Tags
colimit, representable, presheaf, free cocompletion

## References
* [S. MacLane, I. Moerdijk, *Sheaves in Geometry and Logic*][MM92]
* https://ncatlab.org/nlab/show/Yoneda+extension
-/

namespace category_theory

noncomputable theory

open category limits
universes u₁ u₂

variables {C : Type u₁} [small_category C]
variables {ℰ : Type u₂} [category.{u₁} ℰ]
variable (A : C ⥤ ℰ)

namespace colimit_adj

/--
The functor taking `(E : ℰ) (c : Cᵒᵖ)` to the homset `(A.obj C ⟶ E)`. It is shown in `L_adjunction`
that this functor has a left adjoint (provided `E` has colimits) given by taking colimits over
categories of elements.
In the case where `ℰ = Cᵒᵖ ⥤ Type u` and `A = yoneda`, this functor is isomorphic to the identity.

Defined as in [MM92], Chapter I, Section 5, Theorem 2.
-/
@[simps]
def restricted_yoneda : ℰ ⥤ (Cᵒᵖ ⥤ Type u₁) :=
yoneda ⋙ (whiskering_left _ _ (Type u₁)).obj (functor.op A)

/--
The functor `restricted_yoneda` is isomorphic to the identity functor when evaluated at the yoneda
embedding.
-/
def restricted_yoneda_yoneda : restricted_yoneda (yoneda : C ⥤ Cᵒᵖ ⥤ Type u₁) ≅ 𝟭 _ :=
nat_iso.of_components
(λ P, nat_iso.of_components (λ X, yoneda_sections_small X.unop _)
  (λ X Y f, funext $ λ x,
  begin
    dsimp,
    rw ← functor_to_types.naturality _ _ x f (𝟙 _),
    dsimp,
    simp,
  end))
(λ _ _ _, rfl)

/--
(Implementation). The equivalence of homsets which helps construct the left adjoint to
`colimit_adj.restricted_yoneda`.
It is shown in `restrict_yoneda_hom_equiv_natural` that this is a natural bijection.
-/
def restrict_yoneda_hom_equiv (P : Cᵒᵖ ⥤ Type u₁) (E : ℰ)
  {c : cocone ((category_of_elements.π P).left_op ⋙ A)} (t : is_colimit c) :
  (c.X ⟶ E) ≃ (P ⟶ (restricted_yoneda A).obj E) :=
((ulift_trivial _).symm ≪≫ t.hom_iso' E).to_equiv.trans
{ to_fun := λ k,
  { app := λ c p, k.1 (opposite.op ⟨_, p⟩),
    naturality' := λ c c' f, funext $ λ p,
      (k.2 (quiver.hom.op ⟨f, rfl⟩ :
              (opposite.op ⟨c', P.map f p⟩ : P.elementsᵒᵖ) ⟶ opposite.op ⟨c, p⟩)).symm },
  inv_fun := λ τ,
  { val := λ p, τ.app p.unop.1 p.unop.2,
    property := λ p p' f,
    begin
      simp_rw [← f.unop.2],
      apply (congr_fun (τ.naturality f.unop.1) p'.unop.2).symm,
    end },
  left_inv :=
  begin
    rintro ⟨k₁, k₂⟩,
    ext,
    dsimp,
    congr' 1,
    simp,
  end,
  right_inv :=
  begin
    rintro ⟨_, _⟩,
    refl,
  end }

/--
(Implementation). Show that the bijection in `restrict_yoneda_hom_equiv` is natural (on the right).
-/
lemma restrict_yoneda_hom_equiv_natural (P : Cᵒᵖ ⥤ Type u₁) (E₁ E₂ : ℰ) (g : E₁ ⟶ E₂)
  {c : cocone _} (t : is_colimit c) (k : c.X ⟶ E₁) :
restrict_yoneda_hom_equiv A P E₂ t (k ≫ g) =
  restrict_yoneda_hom_equiv A P E₁ t k ≫ (restricted_yoneda A).map g :=
begin
  ext _ X p,
  apply (assoc _ _ _).symm,
end

variables [has_colimits ℰ]

/--
The left adjoint to the functor `restricted_yoneda` (shown in `yoneda_adjunction`). It is also an
extension of `A` along the yoneda embedding (shown in `is_extension_along_yoneda`), in particular
it is the left Kan extension of `A` through the yoneda embedding.
-/
def extend_along_yoneda : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ :=
adjunction.left_adjoint_of_equiv
  (λ P E, restrict_yoneda_hom_equiv A P E (colimit.is_colimit _))
  (λ P E E' g, restrict_yoneda_hom_equiv_natural A P E E' g _)

@[simp]
lemma extend_along_yoneda_obj (P : Cᵒᵖ ⥤ Type u₁) : (extend_along_yoneda A).obj P =
colimit ((category_of_elements.π P).left_op ⋙ A) := rfl

lemma extend_along_yoneda_map {X Y : Cᵒᵖ ⥤ Type u₁} (f : X ⟶ Y) :
  (extend_along_yoneda A).map f = colimit.pre ((category_of_elements.π Y).left_op ⋙ A)
    (category_of_elements.map f).op :=
begin
  ext J,
  erw colimit.ι_pre ((category_of_elements.π Y).left_op ⋙ A) (category_of_elements.map f).op,
  dsimp only [extend_along_yoneda, restrict_yoneda_hom_equiv,
    is_colimit.hom_iso', is_colimit.hom_iso, ulift_trivial],
  simpa
end

/--
Show `extend_along_yoneda` is left adjoint to `restricted_yoneda`.

The construction of [MM92], Chapter I, Section 5, Theorem 2.
-/
def yoneda_adjunction : extend_along_yoneda A ⊣ restricted_yoneda A :=
adjunction.adjunction_of_equiv_left _ _

/--
The initial object in the category of elements for a representable functor. In `is_initial` it is
shown that this is initial.
-/
def elements.initial (A : C) : (yoneda.obj A).elements :=
⟨opposite.op A, 𝟙 _⟩

/--
Show that `elements.initial A` is initial in the category of elements for the `yoneda` functor.
-/
def is_initial (A : C) : is_initial (elements.initial A) :=
{ desc := λ s, ⟨s.X.2.op, comp_id _⟩,
  uniq' := λ s m w,
  begin
    simp_rw ← m.2,
    dsimp [elements.initial],
    simp,
  end }

/--
`extend_along_yoneda A` is an extension of `A` to the presheaf category along the yoneda embedding.
`unique_extension_along_yoneda` shows it is unique among functors preserving colimits with this
property (up to isomorphism).

The first part of [MM92], Chapter I, Section 5, Corollary 4.
See Property 1 of https://ncatlab.org/nlab/show/Yoneda+extension#properties.
-/
def is_extension_along_yoneda : (yoneda : C ⥤ Cᵒᵖ ⥤ Type u₁) ⋙ extend_along_yoneda A ≅ A :=
nat_iso.of_components
(λ X, (colimit.is_colimit _).cocone_point_unique_up_to_iso
      (colimit_of_diagram_terminal (terminal_op_of_initial (is_initial _)) _))
begin
  intros X Y f,
  change (colimit.desc _ ⟨_, _⟩ ≫ colimit.desc _ _) = colimit.desc _ _ ≫ _,
  apply colimit.hom_ext,
  intro j,
  rw [colimit.ι_desc_assoc, colimit.ι_desc_assoc],
  change (colimit.ι _ _ ≫ 𝟙 _) ≫ colimit.desc _ _ = _,
  rw [comp_id, colimit.ι_desc],
  dsimp,
  rw ← A.map_comp,
  congr' 1,
end

/-- See Property 2 of https://ncatlab.org/nlab/show/Yoneda+extension#properties. -/
instance : preserves_colimits (extend_along_yoneda A) :=
(yoneda_adjunction A).left_adjoint_preserves_colimits

/--
Show that the images of `X` after `extend_along_yoneda` and `Lan yoneda` are indeed isomorphic.
This follows from `category_theory.category_of_elements.costructured_arrow_yoneda_equivalence`.
-/
@[simps] def extend_along_yoneda_iso_Kan_app (X) :
  (extend_along_yoneda A).obj X ≅ ((Lan yoneda : (_ ⥤ ℰ) ⥤ _).obj A).obj X :=
let eq := category_of_elements.costructured_arrow_yoneda_equivalence X in
{ hom := colimit.pre (Lan.diagram (yoneda : C ⥤ _ ⥤ Type u₁) A X) eq.functor,
  inv := colimit.pre ((category_of_elements.π X).left_op ⋙ A) eq.inverse,
  hom_inv_id' :=
  begin
    erw colimit.pre_pre ((category_of_elements.π X).left_op ⋙ A) eq.inverse,
    transitivity colimit.pre ((category_of_elements.π X).left_op ⋙ A) (𝟭 _),
    congr,
    { exact congr_arg functor.op (category_of_elements.from_to_costructured_arrow_eq X) },
    { ext, simp only [colimit.ι_pre], erw category.comp_id, congr }
  end,
  inv_hom_id' :=
  begin
    erw colimit.pre_pre (Lan.diagram (yoneda : C ⥤ _ ⥤ Type u₁) A X) eq.functor,
    transitivity colimit.pre (Lan.diagram (yoneda : C ⥤ _ ⥤ Type u₁) A X) (𝟭 _),
    congr,
    { exact category_of_elements.to_from_costructured_arrow_eq X },
    { ext, simp only [colimit.ι_pre], erw category.comp_id, congr }
  end }

/--
Verify that `extend_along_yoneda` is indeed the left Kan extension along the yoneda embedding.
-/
@[simps]
def extend_along_yoneda_iso_Kan : extend_along_yoneda A ≅ (Lan yoneda : (_ ⥤ ℰ) ⥤ _).obj A :=
nat_iso.of_components (extend_along_yoneda_iso_Kan_app A)
begin
  intros X Y f, simp,
  rw extend_along_yoneda_map,
  erw colimit.pre_pre (Lan.diagram (yoneda : C ⥤ _ ⥤ Type u₁) A Y) (costructured_arrow.map f),
  erw colimit.pre_pre (Lan.diagram (yoneda : C ⥤ _ ⥤ Type u₁) A Y)
    (category_of_elements.costructured_arrow_yoneda_equivalence Y).functor,
  congr' 1,
  apply category_of_elements.costructured_arrow_yoneda_equivalence_naturality,
end

/-- extending `F ⋙ yoneda` along the yoneda embedding is isomorphic to `Lan F.op`. -/
@[simps] def extend_of_comp_yoneda_iso_Lan {D : Type u₁} [small_category D] (F : C ⥤ D) :
  extend_along_yoneda (F ⋙ yoneda) ≅ Lan F.op :=
adjunction.nat_iso_of_right_adjoint_nat_iso
  (yoneda_adjunction (F ⋙ yoneda))
  (Lan.adjunction (Type u₁) F.op)
  (iso_whisker_right curried_yoneda_lemma' ((whiskering_left Cᵒᵖ Dᵒᵖ (Type u₁)).obj F.op : _))

end colimit_adj

open colimit_adj

/-- `F ⋙ yoneda` is naturally isomorphic to `yoneda ⋙ Lan F.op`. -/
@[simps] def comp_yoneda_iso_yoneda_comp_Lan {D : Type u₁} [small_category D] (F : C ⥤ D) :
  F ⋙ yoneda ≅ yoneda ⋙ Lan F.op :=
(is_extension_along_yoneda (F ⋙ yoneda)).symm ≪≫
  iso_whisker_left yoneda (extend_of_comp_yoneda_iso_Lan F)

/--
Since `extend_along_yoneda A` is adjoint to `restricted_yoneda A`, if we use `A = yoneda`
then `restricted_yoneda A` is isomorphic to the identity, and so `extend_along_yoneda A` is as well.
-/
def extend_along_yoneda_yoneda : extend_along_yoneda (yoneda : C ⥤ _) ≅ 𝟭 _ :=
adjunction.nat_iso_of_right_adjoint_nat_iso
  (yoneda_adjunction _)
  adjunction.id
  restricted_yoneda_yoneda

/--
A functor to the presheaf category in which everything in the image is representable (witnessed
by the fact that it factors through the yoneda embedding).
`cocone_of_representable` gives a cocone for this functor which is a colimit and has point `P`.
-/
-- Maybe this should be reducible or an abbreviation?
def functor_to_representables (P : Cᵒᵖ ⥤ Type u₁) :
  (P.elements)ᵒᵖ ⥤ Cᵒᵖ ⥤ Type u₁ :=
(category_of_elements.π P).left_op ⋙ yoneda

/--
This is a cocone with point `P` for the functor `functor_to_representables P`. It is shown in
`colimit_of_representable P` that this cocone is a colimit: that is, we have exhibited an arbitrary
presheaf `P` as a colimit of representables.

The construction of [MM92], Chapter I, Section 5, Corollary 3.
-/
def cocone_of_representable (P : Cᵒᵖ ⥤ Type u₁) :
  cocone (functor_to_representables P) :=
cocone.extend (colimit.cocone _) (extend_along_yoneda_yoneda.hom.app P)

@[simp] lemma cocone_of_representable_X (P : Cᵒᵖ ⥤ Type u₁) :
  (cocone_of_representable P).X = P :=
rfl

/-- An explicit formula for the legs of the cocone `cocone_of_representable`. -/
-- Marking this as a simp lemma seems to make things more awkward.
lemma cocone_of_representable_ι_app (P : Cᵒᵖ ⥤ Type u₁) (j : (P.elements)ᵒᵖ):
  (cocone_of_representable P).ι.app j = (yoneda_sections_small _ _).inv j.unop.2 :=
colimit.ι_desc _ _

/-- The legs of the cocone `cocone_of_representable` are natural in the choice of presheaf. -/
lemma cocone_of_representable_naturality {P₁ P₂ : Cᵒᵖ ⥤ Type u₁} (α : P₁ ⟶ P₂)
  (j : (P₁.elements)ᵒᵖ) :
  (cocone_of_representable P₁).ι.app j ≫ α =
    (cocone_of_representable P₂).ι.app ((category_of_elements.map α).op.obj j) :=
begin
  ext T f,
  simpa [cocone_of_representable_ι_app] using functor_to_types.naturality _ _ α f.op _,
end

/--
The cocone with point `P` given by `the_cocone` is a colimit: that is, we have exhibited an
arbitrary presheaf `P` as a colimit of representables.

The result of [MM92], Chapter I, Section 5, Corollary 3.
-/
def colimit_of_representable (P : Cᵒᵖ ⥤ Type u₁) : is_colimit (cocone_of_representable P) :=
begin
  apply is_colimit.of_point_iso (colimit.is_colimit (functor_to_representables P)),
  change is_iso (colimit.desc _ (cocone.extend _ _)),
  rw [colimit.desc_extend, colimit.desc_cocone],
  apply_instance,
end

/--
Given two functors L₁ and L₂ which preserve colimits, if they agree when restricted to the
representable presheaves then they agree everywhere.
-/
def nat_iso_of_nat_iso_on_representables (L₁ L₂ : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ)
  [preserves_colimits L₁] [preserves_colimits L₂]
  (h : yoneda ⋙ L₁ ≅ yoneda ⋙ L₂) : L₁ ≅ L₂ :=
begin
  apply nat_iso.of_components _ _,
  { intro P,
    refine (is_colimit_of_preserves L₁ (colimit_of_representable P)).cocone_points_iso_of_nat_iso
           (is_colimit_of_preserves L₂ (colimit_of_representable P)) _,
    apply functor.associator _ _ _ ≪≫ _,
    exact iso_whisker_left (category_of_elements.π P).left_op h },
  { intros P₁ P₂ f,
    apply (is_colimit_of_preserves L₁ (colimit_of_representable P₁)).hom_ext,
    intro j,
    dsimp only [id.def, is_colimit.cocone_points_iso_of_nat_iso_hom, iso_whisker_left_hom],
    have :
      (L₁.map_cocone (cocone_of_representable P₁)).ι.app j ≫ L₁.map f =
      (L₁.map_cocone (cocone_of_representable P₂)).ι.app ((category_of_elements.map f).op.obj j),
    { dsimp,
      rw [← L₁.map_comp, cocone_of_representable_naturality],
      refl },
    rw [reassoc_of this, is_colimit.ι_map_assoc, is_colimit.ι_map],
    dsimp,
    rw [← L₂.map_comp, cocone_of_representable_naturality],
    refl }
end

variable [has_colimits ℰ]

/--
Show that `extend_along_yoneda` is the unique colimit-preserving functor which extends `A` to
the presheaf category.

The second part of [MM92], Chapter I, Section 5, Corollary 4.
See Property 3 of https://ncatlab.org/nlab/show/Yoneda+extension#properties.
-/
def unique_extension_along_yoneda (L : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ) (hL : yoneda ⋙ L ≅ A)
  [preserves_colimits L] :
  L ≅ extend_along_yoneda A :=
nat_iso_of_nat_iso_on_representables _ _ (hL ≪≫ (is_extension_along_yoneda _).symm)

/--
If `L` preserves colimits and `ℰ` has them, then it is a left adjoint. This is a special case of
`is_left_adjoint_of_preserves_colimits` used to prove that.
-/
def is_left_adjoint_of_preserves_colimits_aux (L : (Cᵒᵖ ⥤ Type u₁) ⥤ ℰ) [preserves_colimits L] :
  is_left_adjoint L :=
{ right := restricted_yoneda (yoneda ⋙ L),
  adj := (yoneda_adjunction _).of_nat_iso_left
            ((unique_extension_along_yoneda _ L (iso.refl _)).symm) }

/--
If `L` preserves colimits and `ℰ` has them, then it is a left adjoint. Note this is a (partial)
converse to `left_adjoint_preserves_colimits`.
-/
def is_left_adjoint_of_preserves_colimits (L : (C ⥤ Type u₁) ⥤ ℰ) [preserves_colimits L] :
  is_left_adjoint L :=
let e : (_ ⥤ Type u₁) ≌ (_ ⥤ Type u₁) := (op_op_equivalence C).congr_left,
    t := is_left_adjoint_of_preserves_colimits_aux (e.functor ⋙ L : _)
in by exactI adjunction.left_adjoint_of_nat_iso (e.inv_fun_id_assoc _)

end category_theory


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen
-/
import ring_theory.localization.fraction_ring
import ring_theory.localization.integer
import ring_theory.unique_factorization_domain

/-!
# Numerator and denominator in a localization

## Implementation notes

See `src/ring_theory/localization/basic.lean` for a design overview.

## Tags
localization, ring localization, commutative ring localization, characteristic predicate,
commutative ring, field of fractions
-/
variables {R : Type*} [comm_ring R] (M : submonoid R) {S : Type*} [comm_ring S]
variables [algebra R S] {P : Type*} [comm_ring P]

namespace is_fraction_ring

open is_localization

section num_denom

variables (A : Type*) [comm_ring A] [is_domain A] [unique_factorization_monoid A]
variables {K : Type*} [field K] [algebra A K] [is_fraction_ring A K]

lemma exists_reduced_fraction (x : K) :
  ∃ (a : A) (b : non_zero_divisors A),
  (∀ {d}, d ∣ a → d ∣ b → is_unit d) ∧ mk' K a b = x :=
begin
  obtain ⟨⟨b, b_nonzero⟩, a, hab⟩ := exists_integer_multiple (non_zero_divisors A) x,
  obtain ⟨a', b', c', no_factor, rfl, rfl⟩ :=
    unique_factorization_monoid.exists_reduced_factors' a b
      (mem_non_zero_divisors_iff_ne_zero.mp b_nonzero),
  obtain ⟨c'_nonzero, b'_nonzero⟩ := mul_mem_non_zero_divisors.mp b_nonzero,
  refine ⟨a', ⟨b', b'_nonzero⟩, @no_factor, _⟩,
  refine mul_left_cancel₀
    (is_fraction_ring.to_map_ne_zero_of_mem_non_zero_divisors b_nonzero) _,
  simp only [subtype.coe_mk, ring_hom.map_mul, algebra.smul_def] at *,
  erw [←hab, mul_assoc, mk'_spec' _ a' ⟨b', b'_nonzero⟩],
end

/-- `f.num x` is the numerator of `x : f.codomain` as a reduced fraction. -/
noncomputable def num (x : K) : A :=
classical.some (exists_reduced_fraction A x)

/-- `f.num x` is the denominator of `x : f.codomain` as a reduced fraction. -/
noncomputable def denom (x : K) : non_zero_divisors A :=
classical.some (classical.some_spec (exists_reduced_fraction A x))

lemma num_denom_reduced (x : K) :
  ∀ {d}, d ∣ num A x → d ∣ denom A x → is_unit d :=
(classical.some_spec (classical.some_spec (exists_reduced_fraction A x))).1

@[simp] lemma mk'_num_denom (x : K) : mk' K (num A x) (denom A x) = x :=
(classical.some_spec (classical.some_spec (exists_reduced_fraction A x))).2

variables {A}

lemma num_mul_denom_eq_num_iff_eq {x y : K} :
  x * algebra_map A K (denom A y) = algebra_map A K (num A y) ↔ x = y :=
⟨λ h, by simpa only [mk'_num_denom] using eq_mk'_iff_mul_eq.mpr h,
 λ h, eq_mk'_iff_mul_eq.mp (by rw [h, mk'_num_denom])⟩

lemma num_mul_denom_eq_num_iff_eq' {x y : K} :
  y * algebra_map A K (denom A x) = algebra_map A K (num A x) ↔ x = y :=
⟨λ h, by simpa only [eq_comm, mk'_num_denom] using eq_mk'_iff_mul_eq.mpr h,
 λ h, eq_mk'_iff_mul_eq.mp (by rw [h, mk'_num_denom])⟩

lemma num_mul_denom_eq_num_mul_denom_iff_eq {x y : K} :
  num A y * denom A x = num A x * denom A y ↔ x = y :=
⟨λ h, by simpa only [mk'_num_denom] using mk'_eq_of_eq h,
 λ h, by rw h⟩

lemma eq_zero_of_num_eq_zero {x : K} (h : num A x = 0) : x = 0 :=
num_mul_denom_eq_num_iff_eq'.mp (by rw [zero_mul, h, ring_hom.map_zero])

lemma is_integer_of_is_unit_denom {x : K} (h : is_unit (denom A x : A)) : is_integer A x :=
begin
  cases h with d hd,
  have d_ne_zero : algebra_map A K (denom A x) ≠ 0 :=
    is_fraction_ring.to_map_ne_zero_of_mem_non_zero_divisors (denom A x).2,
  use ↑d⁻¹ * num A x,
  refine trans _ (mk'_num_denom A x),
  rw [ring_hom.map_mul, ring_hom.map_units_inv, hd],
  apply mul_left_cancel₀ d_ne_zero,
  rw [←mul_assoc, mul_inv_cancel d_ne_zero, one_mul, mk'_spec']
end

lemma is_unit_denom_of_num_eq_zero {x : K} (h : num A x = 0) : is_unit (denom A x : A) :=
num_denom_reduced A x (h.symm ▸ dvd_zero _) dvd_rfl

end num_denom

variables (S)

end is_fraction_ring


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

import category_theory.closed.cartesian
import category_theory.limits.preserves.shapes.binary_products
import category_theory.adjunction.fully_faithful

/-!
# Cartesian closed functors

Define the exponential comparison morphisms for a functor which preserves binary products, and use
them to define a cartesian closed functor: one which (naturally) preserves exponentials.

Define the Frobenius morphism, and show it is an isomorphism iff the exponential comparison is an
isomorphism.

## TODO
Some of the results here are true more generally for closed objects and for closed monoidal
categories, and these could be generalised.

## References
https://ncatlab.org/nlab/show/cartesian+closed+functor
https://ncatlab.org/nlab/show/Frobenius+reciprocity

## Tags
Frobenius reciprocity, cartesian closed functor

-/

namespace category_theory

open category limits cartesian_closed

universes v u u'
variables {C : Type u} [category.{v} C]
variables {D : Type u'} [category.{v} D]

variables [has_finite_products C] [has_finite_products D]

variables (F : C ⥤ D) {L : D ⥤ C}

noncomputable theory

/--
The Frobenius morphism for an adjunction `L ⊣ F` at `A` is given by the morphism

    L(FA ⨯ B) ⟶ LFA ⨯ LB ⟶ A ⨯ LB

natural in `B`, where the first morphism is the product comparison and the latter uses the counit
of the adjunction.

We will show that if `C` and `D` are cartesian closed, then this morphism is an isomorphism for all
`A` iff `F` is a cartesian closed functor, i.e. it preserves exponentials.
-/
def frobenius_morphism (h : L ⊣ F) (A : C) :
  prod.functor.obj (F.obj A) ⋙ L ⟶ L ⋙ prod.functor.obj A :=
prod_comparison_nat_trans L (F.obj A) ≫ whisker_left _ (prod.functor.map (h.counit.app _))

/--
If `F` is full and faithful and has a left adjoint `L` which preserves binary products, then the
Frobenius morphism is an isomorphism.
-/
instance frobenius_morphism_iso_of_preserves_binary_products (h : L ⊣ F) (A : C)
  [preserves_limits_of_shape (discrete walking_pair) L] [full F] [faithful F] :
is_iso (frobenius_morphism F h A) :=
begin
  apply nat_iso.is_iso_of_is_iso_app _,
  intro B,
  dsimp [frobenius_morphism],
  apply_instance,
end

variables [cartesian_closed C] [cartesian_closed D]
variables [preserves_limits_of_shape (discrete walking_pair) F]

/--
The exponential comparison map.
`F` is a cartesian closed functor if this is an iso for all `A`.
-/
def exp_comparison (A : C) :
  exp A ⋙ F ⟶ F ⋙ exp (F.obj A) :=
transfer_nat_trans (exp.adjunction A) (exp.adjunction (F.obj A)) (prod_comparison_nat_iso F A).inv

lemma exp_comparison_ev (A B : C) :
  limits.prod.map (𝟙 (F.obj A)) ((exp_comparison F A).app B) ≫ (exp.ev (F.obj A)).app (F.obj B) =
    inv (prod_comparison F _ _) ≫ F.map ((exp.ev _).app _) :=
begin
  convert transfer_nat_trans_counit _ _ (prod_comparison_nat_iso F A).inv B,
  ext,
  simp,
end

lemma coev_exp_comparison (A B : C) :
  F.map ((exp.coev A).app B) ≫ (exp_comparison F A).app (A ⨯ B) =
      (exp.coev _).app (F.obj B) ≫ (exp (F.obj A)).map (inv (prod_comparison F A B)) :=
begin
  convert unit_transfer_nat_trans _ _ (prod_comparison_nat_iso F A).inv B,
  ext,
  dsimp,
  simp,
end

lemma uncurry_exp_comparison (A B : C) :
  cartesian_closed.uncurry ((exp_comparison F A).app B) =
    inv (prod_comparison F _ _) ≫ F.map ((exp.ev _).app _) :=
by rw [uncurry_eq, exp_comparison_ev]

/-- The exponential comparison map is natural in `A`. -/
lemma exp_comparison_whisker_left {A A' : C} (f : A' ⟶ A) :
  exp_comparison F A ≫ whisker_left _ (pre (F.map f)) =
  whisker_right (pre f) _ ≫ exp_comparison F A' :=
begin
  ext B,
  dsimp,
  apply uncurry_injective,
  rw [uncurry_natural_left, uncurry_natural_left, uncurry_exp_comparison, uncurry_pre,
    prod.map_swap_assoc, ←F.map_id, exp_comparison_ev, ←F.map_id,
    ←prod_comparison_inv_natural_assoc, ←prod_comparison_inv_natural_assoc, ←F.map_comp,
    ←F.map_comp, prod_map_pre_app_comp_ev],
end

/--
The functor `F` is cartesian closed (ie preserves exponentials) if each natural transformation
`exp_comparison F A` is an isomorphism
-/
class cartesian_closed_functor :=
(comparison_iso : ∀ A, is_iso (exp_comparison F A))

attribute [instance] cartesian_closed_functor.comparison_iso

lemma frobenius_morphism_mate (h : L ⊣ F) (A : C) :
  transfer_nat_trans_self
    (h.comp (exp.adjunction A))
    ((exp.adjunction (F.obj A)).comp h)
    (frobenius_morphism F h A) = exp_comparison F A :=
  begin
    rw ←equiv.eq_symm_apply,
    ext B : 2,
    dsimp [frobenius_morphism, transfer_nat_trans_self, transfer_nat_trans, adjunction.comp],
    simp only [id_comp, comp_id],
    rw [←L.map_comp_assoc, prod.map_id_comp, assoc, exp_comparison_ev, prod.map_id_comp, assoc,
      ← F.map_id, ← prod_comparison_inv_natural_assoc, ← F.map_comp, exp.ev_coev,
      F.map_id (A ⨯ L.obj B), comp_id],
    apply prod.hom_ext,
    { rw [assoc, assoc, ←h.counit_naturality, ←L.map_comp_assoc, assoc,
        inv_prod_comparison_map_fst],
      simp },
    { rw [assoc, assoc, ←h.counit_naturality, ←L.map_comp_assoc, assoc,
        inv_prod_comparison_map_snd],
      simp },
  end

/--
If the exponential comparison transformation (at `A`) is an isomorphism, then the Frobenius morphism
at `A` is an isomorphism.
-/
lemma frobenius_morphism_iso_of_exp_comparison_iso (h : L ⊣ F) (A : C)
  [i : is_iso (exp_comparison F A)] :
  is_iso (frobenius_morphism F h A) :=
begin
  rw ←frobenius_morphism_mate F h at i,
  exact @@transfer_nat_trans_self_of_iso _ _ _ _ _ i,
end

/--
If the Frobenius morphism at `A` is an isomorphism, then the exponential comparison transformation
(at `A`) is an isomorphism.
-/
lemma exp_comparison_iso_of_frobenius_morphism_iso (h : L ⊣ F) (A : C)
  [i : is_iso (frobenius_morphism F h A)] :
  is_iso (exp_comparison F A) :=
by { rw ← frobenius_morphism_mate F h, apply_instance }

/--
If `F` is full and faithful, and has a left adjoint which preserves binary products, then it is
cartesian closed.

TODO: Show the converse, that if `F` is cartesian closed and its left adjoint preserves binary
products, then it is full and faithful.
-/
def cartesian_closed_functor_of_left_adjoint_preserves_binary_products (h : L ⊣ F)
  [full F] [faithful F] [preserves_limits_of_shape (discrete walking_pair) L] :
  cartesian_closed_functor F :=
{ comparison_iso := λ A, exp_comparison_iso_of_frobenius_morphism_iso F h _ }

end category_theory


import field_theory.splitting_field

noncomputable theory
open_locale classical big_operators

universes u v w

variables {α : Type u} {β : Type v} {γ : Type w}

namespace polynomial

variables [field α] [field β] [field γ]
open polynomial

section splits

variables (i : α →+* β)

lemma degree_eq_one_of_irreducible_of_splits {p : polynomial β}
  (h_nz : p ≠ 0) (hp : irreducible p) (hp_splits: splits (ring_hom.id β) p):
  p.degree = 1 :=
begin
  rcases hp_splits,
  { contradiction },
  { apply hp_splits hp, simp }
end

end splits

end polynomial


lemma or_symm (P Q : Prop) : P ∨ Q → Q ∨ P :=
begin
intro h,
cases h,
right,
exact h,
left,
exact h,
end


/-
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, Mario Carneiro

! This file was ported from Lean 3 source module measure_theory.measurable_space_def
! leanprover-community/mathlib commit 8631e2d5ea77f6c13054d9151d82b83069680cb1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
-- import Mathbin.Data.Set.Countable
-- import Mathbin.Logic.Encodable.Lattice
-- import Mathbin.Order.Disjointed

import Mathlib.Data.Set.Basic
import Mathlib.Data.Set.Lattice

/-!
# Measurable spaces and measurable functions

This file defines measurable spaces and measurable functions.

A measurable space is a set equipped with a σ-algebra, a collection of
subsets closed under complementation and countable union. A function
between measurable spaces is measurable if the preimage of each
measurable subset is measurable.

σ-algebras on a fixed set `α` form a complete lattice. Here we order
σ-algebras by writing `m₁ ≤ m₂` if every set which is `m₁`-measurable is
also `m₂`-measurable (that is, `m₁` is a subset of `m₂`). In particular, any
collection of subsets of `α` generates a smallest σ-algebra which
contains all of them.

Do not add measurability lemmas (which could be tagged with
@[measurability]) to this file, since the measurability tactic is downstream
from here. Use `measure_theory.measurable_space` instead.

## References

* <https://en.wikipedia.org/wiki/Measurable_space>
* <https://en.wikipedia.org/wiki/Sigma-algebra>
* <https://en.wikipedia.org/wiki/Dynkin_system>

## Tags

measurable space, σ-algebra, measurable function
-/

-- open Set Encodable Function Equiv

open Classical

variable {α β γ δ δ' : Type _} {ι : Sort _} {s t u : Set α}

/-- A measurable space is a space equipped with a σ-algebra. -/
structure MeasurableSpace (α : Type _) where
  MeasurableSet' : Set α → Prop
  measurable_set_empty : MeasurableSet' ∅
  measurable_set_compl : ∀ s, MeasurableSet' s → MeasurableSet' (sᶜ)
  measurable_set_Union : ∀ f : ℕ → Set α, (∀ i, MeasurableSet' (f i)) → MeasurableSet' (⋃ i, f i)

#align measurable_space MeasurableSpace

attribute [class] MeasurableSpace

instance [h : MeasurableSpace α] : MeasurableSpace αᵒᵈ :=
  h

/--

section

/-- `measurable_set s` means that `s` is measurable (in the ambient measure space on `α`) -/
def MeasurableSet [MeasurableSpace α] : Set α → Prop :=
  ‹MeasurableSpace α›.MeasurableSet'
#align measurable_set MeasurableSet

-- mathport name: measurable_set_of
scoped[MeasureTheory] notation "measurable_set[" m "]" => @MeasurableSet hole! m

@[simp]
theorem MeasurableSet.empty [MeasurableSpace α] : MeasurableSet (∅ : Set α) :=
  ‹MeasurableSpace α›.measurable_set_empty
#align measurable_set.empty MeasurableSet.empty

variable {m : MeasurableSpace α}

include m

theorem MeasurableSet.compl : MeasurableSet s → MeasurableSet (sᶜ) :=
  ‹MeasurableSpace α›.measurable_set_compl s
#align measurable_set.compl MeasurableSet.compl

theorem MeasurableSet.of_compl (h : MeasurableSet (sᶜ)) : MeasurableSet s :=
  compl_compl s ▸ h.compl
#align measurable_set.of_compl MeasurableSet.of_compl

@[simp]
theorem MeasurableSet.compl_iff : MeasurableSet (sᶜ) ↔ MeasurableSet s :=
  ⟨MeasurableSet.of_compl, MeasurableSet.compl⟩
#align measurable_set.compl_iff MeasurableSet.compl_iff

@[simp]
theorem MeasurableSet.univ : MeasurableSet (univ : Set α) := by
  simpa using (@MeasurableSet.empty α _).compl
#align measurable_set.univ MeasurableSet.univ

@[nontriviality]
theorem Subsingleton.measurableSet [Subsingleton α] {s : Set α} : MeasurableSet s :=
  Subsingleton.set_cases MeasurableSet.empty MeasurableSet.univ s
#align subsingleton.measurable_set Subsingleton.measurableSet

theorem MeasurableSet.congr {s t : Set α} (hs : MeasurableSet s) (h : s = t) : MeasurableSet t := by
  rwa [← h]
#align measurable_set.congr MeasurableSet.congr

theorem MeasurableSet.bUnion_decode₂ [Encodable β] ⦃f : β → Set α⦄ (h : ∀ b, MeasurableSet (f b))
    (n : ℕ) : MeasurableSet (⋃ b ∈ decode₂ β n, f b) :=
  Encodable.unionᵢ_decode₂_cases MeasurableSet.empty h
#align measurable_set.bUnion_decode₂ MeasurableSet.bUnion_decode₂

theorem MeasurableSet.unionᵢ [Countable ι] ⦃f : ι → Set α⦄ (h : ∀ b, MeasurableSet (f b)) :
    MeasurableSet (⋃ b, f b) := by
  cases nonempty_encodable (PLift ι)
  rw [← Union_plift_down, ← Encodable.unionᵢ_decode₂]
  exact ‹MeasurableSpace α›.measurable_set_Union _ (MeasurableSet.bUnion_decode₂ fun _ => h _)
#align measurable_set.Union MeasurableSet.unionᵢ

theorem MeasurableSet.bUnion {f : β → Set α} {s : Set β} (hs : s.Countable)
    (h : ∀ b ∈ s, MeasurableSet (f b)) : MeasurableSet (⋃ b ∈ s, f b) :=
  by
  rw [bUnion_eq_Union]
  haveI := hs.to_encodable
  exact MeasurableSet.unionᵢ (by simpa using h)
#align measurable_set.bUnion MeasurableSet.bUnion

theorem Set.Finite.measurableSet_bUnion {f : β → Set α} {s : Set β} (hs : s.Finite)
    (h : ∀ b ∈ s, MeasurableSet (f b)) : MeasurableSet (⋃ b ∈ s, f b) :=
  MeasurableSet.bUnion hs.Countable h
#align set.finite.measurable_set_bUnion Set.Finite.measurableSet_bUnion

theorem Finset.measurableSet_bUnion {f : β → Set α} (s : Finset β)
    (h : ∀ b ∈ s, MeasurableSet (f b)) : MeasurableSet (⋃ b ∈ s, f b) :=
  s.finite_to_set.measurable_set_bUnion h
#align finset.measurable_set_bUnion Finset.measurableSet_bUnion

theorem MeasurableSet.unionₛ {s : Set (Set α)} (hs : s.Countable) (h : ∀ t ∈ s, MeasurableSet t) :
    MeasurableSet (⋃₀ s) := by
  rw [sUnion_eq_bUnion]
  exact MeasurableSet.bUnion hs h
#align measurable_set.sUnion MeasurableSet.unionₛ

theorem Set.Finite.measurableSet_unionₛ {s : Set (Set α)} (hs : s.Finite)
    (h : ∀ t ∈ s, MeasurableSet t) : MeasurableSet (⋃₀ s) :=
  MeasurableSet.unionₛ hs.Countable h
#align set.finite.measurable_set_sUnion Set.Finite.measurableSet_unionₛ

theorem MeasurableSet.interᵢ [Countable ι] {f : ι → Set α} (h : ∀ b, MeasurableSet (f b)) :
    MeasurableSet (⋂ b, f b) :=
  MeasurableSet.compl_iff.1 <| by
    rw [compl_Inter]
    exact MeasurableSet.unionᵢ fun b => (h b).compl
#align measurable_set.Inter MeasurableSet.interᵢ

theorem MeasurableSet.bInter {f : β → Set α} {s : Set β} (hs : s.Countable)
    (h : ∀ b ∈ s, MeasurableSet (f b)) : MeasurableSet (⋂ b ∈ s, f b) :=
  MeasurableSet.compl_iff.1 <| by
    rw [compl_Inter₂]
    exact MeasurableSet.bUnion hs fun b hb => (h b hb).compl
#align measurable_set.bInter MeasurableSet.bInter

theorem Set.Finite.measurableSet_bInter {f : β → Set α} {s : Set β} (hs : s.Finite)
    (h : ∀ b ∈ s, MeasurableSet (f b)) : MeasurableSet (⋂ b ∈ s, f b) :=
  MeasurableSet.bInter hs.Countable h
#align set.finite.measurable_set_bInter Set.Finite.measurableSet_bInter

theorem Finset.measurableSet_bInter {f : β → Set α} (s : Finset β)
    (h : ∀ b ∈ s, MeasurableSet (f b)) : MeasurableSet (⋂ b ∈ s, f b) :=
  s.finite_to_set.measurable_set_bInter h
#align finset.measurable_set_bInter Finset.measurableSet_bInter

theorem MeasurableSet.interₛ {s : Set (Set α)} (hs : s.Countable) (h : ∀ t ∈ s, MeasurableSet t) :
    MeasurableSet (⋂₀ s) := by
  rw [sInter_eq_bInter]
  exact MeasurableSet.bInter hs h
#align measurable_set.sInter MeasurableSet.interₛ

theorem Set.Finite.measurableSet_interₛ {s : Set (Set α)} (hs : s.Finite)
    (h : ∀ t ∈ s, MeasurableSet t) : MeasurableSet (⋂₀ s) :=
  MeasurableSet.interₛ hs.Countable h
#align set.finite.measurable_set_sInter Set.Finite.measurableSet_interₛ

@[simp]
theorem MeasurableSet.union {s₁ s₂ : Set α} (h₁ : MeasurableSet s₁) (h₂ : MeasurableSet s₂) :
    MeasurableSet (s₁ ∪ s₂) := by
  rw [union_eq_Union]
  exact MeasurableSet.unionᵢ (Bool.forall_bool.2 ⟨h₂, h₁⟩)
#align measurable_set.union MeasurableSet.union

@[simp]
theorem MeasurableSet.inter {s₁ s₂ : Set α} (h₁ : MeasurableSet s₁) (h₂ : MeasurableSet s₂) :
    MeasurableSet (s₁ ∩ s₂) := by
  rw [inter_eq_compl_compl_union_compl]
  exact (h₁.compl.union h₂.compl).compl
#align measurable_set.inter MeasurableSet.inter

@[simp]
theorem MeasurableSet.diff {s₁ s₂ : Set α} (h₁ : MeasurableSet s₁) (h₂ : MeasurableSet s₂) :
    MeasurableSet (s₁ \ s₂) :=
  h₁.inter h₂.compl
#align measurable_set.diff MeasurableSet.diff

@[simp]
theorem MeasurableSet.symmDiff {s₁ s₂ : Set α} (h₁ : MeasurableSet s₁) (h₂ : MeasurableSet s₂) :
    MeasurableSet (s₁ ∆ s₂) :=
  (h₁.diff h₂).union (h₂.diff h₁)
#align measurable_set.symm_diff MeasurableSet.symmDiff

@[simp]
theorem MeasurableSet.ite {t s₁ s₂ : Set α} (ht : MeasurableSet t) (h₁ : MeasurableSet s₁)
    (h₂ : MeasurableSet s₂) : MeasurableSet (t.ite s₁ s₂) :=
  (h₁.inter ht).union (h₂.diff ht)
#align measurable_set.ite MeasurableSet.ite

theorem MeasurableSet.ite' {s t : Set α} {p : Prop} (hs : p → MeasurableSet s)
    (ht : ¬p → MeasurableSet t) : MeasurableSet (ite p s t) :=
  by
  split_ifs
  exacts[hs h, ht h]
#align measurable_set.ite' MeasurableSet.ite'

@[simp]
theorem MeasurableSet.cond {s₁ s₂ : Set α} (h₁ : MeasurableSet s₁) (h₂ : MeasurableSet s₂)
    {i : Bool} : MeasurableSet (cond i s₁ s₂) :=
  by
  cases i
  exacts[h₂, h₁]
#align measurable_set.cond MeasurableSet.cond

@[simp]
theorem MeasurableSet.disjointed {f : ℕ → Set α} (h : ∀ i, MeasurableSet (f i)) (n) :
    MeasurableSet (disjointed f n) :=
  disjointedRec (fun t i ht => MeasurableSet.diff ht <| h _) (h n)
#align measurable_set.disjointed MeasurableSet.disjointed

@[simp]
theorem MeasurableSet.const (p : Prop) : MeasurableSet { a : α | p } := by
  by_cases p <;> simp [h, MeasurableSet.empty] <;> apply MeasurableSet.univ
#align measurable_set.const MeasurableSet.const

/-- Every set has a measurable superset. Declare this as local instance as needed. -/
theorem nonempty_measurable_superset (s : Set α) : Nonempty { t // s ⊆ t ∧ MeasurableSet t } :=
  ⟨⟨univ, subset_univ s, MeasurableSet.univ⟩⟩
#align nonempty_measurable_superset nonempty_measurable_superset

end

open MeasureTheory

@[ext]
theorem MeasurableSpace.ext :
    ∀ {m₁ m₂ : MeasurableSpace α},
      (∀ s : Set α, measurable_set[m₁] s ↔ measurable_set[m₂] s) → m₁ = m₂
  | ⟨s₁, _, _, _⟩, ⟨s₂, _, _, _⟩, h =>
    by
    have : s₁ = s₂ := funext fun x => propext <| h x
    subst this
#align measurable_space.ext MeasurableSpace.ext

@[ext]
theorem MeasurableSpace.ext_iff {m₁ m₂ : MeasurableSpace α} :
    m₁ = m₂ ↔ ∀ s : Set α, measurable_set[m₁] s ↔ measurable_set[m₂] s :=
  ⟨by
    rintro rfl
    intro s
    rfl, MeasurableSpace.ext⟩
#align measurable_space.ext_iff MeasurableSpace.ext_iff

/-- A typeclass mixin for `measurable_space`s such that each singleton is measurable. -/
class MeasurableSingletonClass (α : Type _) [MeasurableSpace α] : Prop where
  measurable_set_singleton : ∀ x, MeasurableSet ({x} : Set α)
#align measurable_singleton_class MeasurableSingletonClass

export MeasurableSingletonClass (measurable_set_singleton)

attribute [simp] measurable_set_singleton

section MeasurableSingletonClass

variable [MeasurableSpace α] [MeasurableSingletonClass α]

theorem measurableSet_eq {a : α} : MeasurableSet { x | x = a } :=
  measurableSet_singleton a
#align measurable_set_eq measurableSet_eq

theorem MeasurableSet.insert {s : Set α} (hs : MeasurableSet s) (a : α) :
    MeasurableSet (insert a s) :=
  (measurableSet_singleton a).union hs
#align measurable_set.insert MeasurableSet.insert

@[simp]
theorem measurableSet_insert {a : α} {s : Set α} : MeasurableSet (insert a s) ↔ MeasurableSet s :=
  ⟨fun h =>
    if ha : a ∈ s then by rwa [← insert_eq_of_mem ha]
    else insert_diff_self_of_not_mem ha ▸ h.diff (measurableSet_singleton _),
    fun h => h.insert a⟩
#align measurable_set_insert measurableSet_insert

theorem Set.Subsingleton.measurableSet {s : Set α} (hs : s.Subsingleton) : MeasurableSet s :=
  hs.inductionOn MeasurableSet.empty measurableSet_singleton
#align set.subsingleton.measurable_set Set.Subsingleton.measurableSet

theorem Set.Finite.measurableSet {s : Set α} (hs : s.Finite) : MeasurableSet s :=
  Finite.induction_on hs MeasurableSet.empty fun a s ha hsf hsm => hsm.insert _
#align set.finite.measurable_set Set.Finite.measurableSet

protected theorem Finset.measurableSet (s : Finset α) : MeasurableSet (↑s : Set α) :=
  s.finite_to_set.MeasurableSet
#align finset.measurable_set Finset.measurableSet

theorem Set.Countable.measurableSet {s : Set α} (hs : s.Countable) : MeasurableSet s :=
  by
  rw [← bUnion_of_singleton s]
  exact MeasurableSet.bUnion hs fun b hb => measurable_set_singleton b
#align set.countable.measurable_set Set.Countable.measurableSet

end MeasurableSingletonClass

namespace MeasurableSpace

section CompleteLattice

instance : LE (MeasurableSpace α) where le m₁ m₂ := ∀ s, measurable_set[m₁] s → measurable_set[m₂] s

theorem le_def {α} {a b : MeasurableSpace α} : a ≤ b ↔ a.MeasurableSet' ≤ b.MeasurableSet' :=
  Iff.rfl
#align measurable_space.le_def MeasurableSpace.le_def

instance : PartialOrder (MeasurableSpace α) :=
  { MeasurableSpace.hasLe,
    PartialOrder.lift (@MeasurableSet α) fun m₁ m₂ h => ext fun s => h ▸ Iff.rfl with
    lt := fun m₁ m₂ => m₁ ≤ m₂ ∧ ¬m₂ ≤ m₁ }

/-- The smallest σ-algebra containing a collection `s` of basic sets -/
inductive GenerateMeasurable (s : Set (Set α)) : Set α → Prop
  | basic : ∀ u ∈ s, generate_measurable u
  | Empty : generate_measurable ∅
  | compl : ∀ s, generate_measurable s → generate_measurable (sᶜ)
  | union : ∀ f : ℕ → Set α, (∀ n, generate_measurable (f n)) → generate_measurable (⋃ i, f i)
#align measurable_space.generate_measurable MeasurableSpace.GenerateMeasurable

/-- Construct the smallest measure space containing a collection of basic sets -/
def generateFrom (s : Set (Set α)) : MeasurableSpace α
    where
  MeasurableSet' := GenerateMeasurable s
  measurable_set_empty := GenerateMeasurable.empty
  measurable_set_compl := GenerateMeasurable.compl
  measurable_set_Union := GenerateMeasurable.union
#align measurable_space.generate_from MeasurableSpace.generateFrom

theorem measurableSet_generateFrom {s : Set (Set α)} {t : Set α} (ht : t ∈ s) :
    @MeasurableSet _ (generateFrom s) t :=
  GenerateMeasurable.basic t ht
#align measurable_space.measurable_set_generate_from MeasurableSpace.measurableSet_generateFrom

@[elab_as_elim]
theorem generateFrom_induction (p : Set α → Prop) (C : Set (Set α)) (hC : ∀ t ∈ C, p t)
    (h_empty : p ∅) (h_compl : ∀ t, p t → p (tᶜ))
    (h_Union : ∀ f : ℕ → Set α, (∀ n, p (f n)) → p (⋃ i, f i)) {s : Set α}
    (hs : measurable_set[generateFrom C] s) : p s :=
  by
  induction hs
  exacts[hC _ hs_H, h_empty, h_compl _ hs_ih, h_Union hs_f hs_ih]
#align measurable_space.generate_from_induction MeasurableSpace.generateFrom_induction

theorem generateFrom_le {s : Set (Set α)} {m : MeasurableSpace α}
    (h : ∀ t ∈ s, measurable_set[m] t) : generateFrom s ≤ m :=
  fun t (ht : GenerateMeasurable s t) =>
  ht.recOn h (measurable_set_empty m) (fun s _ hs => measurable_set_compl m s hs) fun f _ hf =>
    measurable_set_unionᵢ m f hf
#align measurable_space.generate_from_le MeasurableSpace.generateFrom_le

theorem generateFrom_le_iff {s : Set (Set α)} (m : MeasurableSpace α) :
    generateFrom s ≤ m ↔ s ⊆ { t | measurable_set[m] t } :=
  Iff.intro (fun h u hu => h _ <| measurableSet_generateFrom hu) fun h => generateFrom_le h
#align measurable_space.generate_from_le_iff MeasurableSpace.generateFrom_le_iff

@[simp]
theorem generateFrom_measurableSet [MeasurableSpace α] :
    generateFrom { s : Set α | MeasurableSet s } = ‹_› :=
  le_antisymm (generate_from_le fun _ => id) fun s => measurableSet_generateFrom
#align measurable_space.generate_from_measurable_set MeasurableSpace.generateFrom_measurableSet

/-- If `g` is a collection of subsets of `α` such that the `σ`-algebra generated from `g` contains
the same sets as `g`, then `g` was already a `σ`-algebra. -/
protected def mkOfClosure (g : Set (Set α)) (hg : { t | measurable_set[generateFrom g] t } = g) :
    MeasurableSpace α where
  MeasurableSet' s := s ∈ g
  measurable_set_empty := hg ▸ measurable_set_empty _
  measurable_set_compl := hg ▸ measurable_set_compl _
  measurable_set_Union := hg ▸ measurable_set_unionᵢ _
#align measurable_space.mk_of_closure MeasurableSpace.mkOfClosure

theorem mkOfClosure_sets {s : Set (Set α)} {hs : { t | measurable_set[generateFrom s] t } = s} :
    MeasurableSpace.mkOfClosure s hs = generateFrom s :=
  MeasurableSpace.ext fun t =>
    show t ∈ s ↔ _ by
      conv_lhs => rw [← hs]
      rfl
#align measurable_space.mk_of_closure_sets MeasurableSpace.mkOfClosure_sets

/-- We get a Galois insertion between `σ`-algebras on `α` and `set (set α)` by using `generate_from`
  on one side and the collection of measurable sets on the other side. -/
def giGenerateFrom : GaloisInsertion (@generateFrom α) fun m => { t | @MeasurableSet α m t }
    where
  gc s := generateFrom_le_iff
  le_l_u m s := measurableSet_generateFrom
  choice g hg := MeasurableSpace.mkOfClosure g <| le_antisymm hg <| (generateFrom_le_iff _).1 le_rfl
  choice_eq g hg := mkOfClosure_sets
#align measurable_space.gi_generate_from MeasurableSpace.giGenerateFrom

instance : CompleteLattice (MeasurableSpace α) :=
  giGenerateFrom.liftCompleteLattice

instance : Inhabited (MeasurableSpace α) :=
  ⟨⊤⟩

@[mono]
theorem generateFrom_mono {s t : Set (Set α)} (h : s ⊆ t) : generateFrom s ≤ generateFrom t :=
  giGenerateFrom.gc.monotone_l h
#align measurable_space.generate_from_mono MeasurableSpace.generateFrom_mono

theorem generateFrom_sup_generateFrom {s t : Set (Set α)} :
    generateFrom s ⊔ generateFrom t = generateFrom (s ∪ t) :=
  (@giGenerateFrom α).gc.l_sup.symm
#align measurable_space.generate_from_sup_generate_from MeasurableSpace.generateFrom_sup_generateFrom

@[simp]
theorem generateFrom_insert_univ (S : Set (Set α)) :
    generateFrom (insert Set.univ S) = generateFrom S :=
  by
  refine' le_antisymm _ (generate_from_mono (Set.subset_insert _ _))
  rw [generate_from_le_iff]
  intro t ht
  cases ht
  · rw [ht]
    exact MeasurableSet.univ
  · exact measurable_set_generate_from ht
#align measurable_space.generate_from_insert_univ MeasurableSpace.generateFrom_insert_univ

@[simp]
theorem generateFrom_insert_empty (S : Set (Set α)) : generateFrom (insert ∅ S) = generateFrom S :=
  by
  refine' le_antisymm _ (generate_from_mono (Set.subset_insert _ _))
  rw [generate_from_le_iff]
  intro t ht
  cases ht
  · rw [ht]
    exact @MeasurableSet.empty _ (generate_from S)
  · exact measurable_set_generate_from ht
#align measurable_space.generate_from_insert_empty MeasurableSpace.generateFrom_insert_empty

@[simp]
theorem generateFrom_singleton_empty : generateFrom {∅} = (⊥ : MeasurableSpace α) :=
  by
  rw [eq_bot_iff, generate_from_le_iff]
  simp
#align measurable_space.generate_from_singleton_empty MeasurableSpace.generateFrom_singleton_empty

@[simp]
theorem generateFrom_singleton_univ : generateFrom {Set.univ} = (⊥ : MeasurableSpace α) :=
  by
  rw [eq_bot_iff, generate_from_le_iff]
  simp
#align measurable_space.generate_from_singleton_univ MeasurableSpace.generateFrom_singleton_univ

theorem measurableSet_bot_iff {s : Set α} : @MeasurableSet α ⊥ s ↔ s = ∅ ∨ s = univ :=
  let b : MeasurableSpace α :=
    { MeasurableSet' := fun s => s = ∅ ∨ s = univ
      measurable_set_empty := Or.inl rfl
      measurable_set_compl := by simp (config := { contextual := true }) [or_imp]
      measurable_set_Union := fun f hf =>
        by_cases
          (fun h : ∃ i, f i = univ =>
            let ⟨i, hi⟩ := h
            Or.inr <| eq_univ_of_univ_subset <| hi ▸ le_supᵢ f i)
          fun h : ¬∃ i, f i = univ =>
          Or.inl <|
            eq_empty_of_subset_empty <|
              Union_subset fun i =>
                (hf i).elim (by simp (config := { contextual := true })) fun hi =>
                  False.elim <| h ⟨i, hi⟩ }
  have : b = ⊥ :=
    bot_unique fun s hs =>
      hs.elim (fun s => s.symm ▸ @measurable_set_empty _ ⊥) fun s =>
        s.symm ▸ @MeasurableSet.univ _ ⊥
  this ▸ Iff.rfl
#align measurable_space.measurable_set_bot_iff MeasurableSpace.measurableSet_bot_iff

@[simp]
theorem measurableSet_top {s : Set α} : @MeasurableSet _ ⊤ s :=
  trivial
#align measurable_space.measurable_set_top MeasurableSpace.measurableSet_top

@[simp]
theorem measurableSet_inf {m₁ m₂ : MeasurableSpace α} {s : Set α} :
    @MeasurableSet _ (m₁ ⊓ m₂) s ↔ @MeasurableSet _ m₁ s ∧ @MeasurableSet _ m₂ s :=
  Iff.rfl
#align measurable_space.measurable_set_inf MeasurableSpace.measurableSet_inf

@[simp]
theorem measurableSet_infₛ {ms : Set (MeasurableSpace α)} {s : Set α} :
    @MeasurableSet _ (infₛ ms) s ↔ ∀ m ∈ ms, @MeasurableSet _ m s :=
  show s ∈ ⋂₀ _ ↔ _ by simp
#align measurable_space.measurable_set_Inf MeasurableSpace.measurableSet_infₛ

@[simp]
theorem measurableSet_infᵢ {ι} {m : ι → MeasurableSpace α} {s : Set α} :
    @MeasurableSet _ (infᵢ m) s ↔ ∀ i, @MeasurableSet _ (m i) s := by
  rw [infᵢ, measurable_set_Inf, forall_range_iff]
#align measurable_space.measurable_set_infi MeasurableSpace.measurableSet_infᵢ

theorem measurableSet_sup {m₁ m₂ : MeasurableSpace α} {s : Set α} :
    measurable_set[m₁ ⊔ m₂] s ↔ GenerateMeasurable (measurable_set[m₁] ∪ measurable_set[m₂]) s :=
  Iff.refl _
#align measurable_space.measurable_set_sup MeasurableSpace.measurableSet_sup

theorem measurableSet_supₛ {ms : Set (MeasurableSpace α)} {s : Set α} :
    measurable_set[supₛ ms] s ↔
      GenerateMeasurable { s : Set α | ∃ m ∈ ms, measurable_set[m] s } s :=
  by
  change @MeasurableSet' _ (generate_from <| ⋃₀ _) _ ↔ _
  simp [generate_from, ← set_of_exists]
#align measurable_space.measurable_set_Sup MeasurableSpace.measurableSet_supₛ

theorem measurableSet_supᵢ {ι} {m : ι → MeasurableSpace α} {s : Set α} :
    @MeasurableSet _ (supᵢ m) s ↔ GenerateMeasurable { s : Set α | ∃ i, measurable_set[m i] s } s :=
  by simp only [supᵢ, measurable_set_Sup, exists_range_iff]
#align measurable_space.measurable_set_supr MeasurableSpace.measurableSet_supᵢ

theorem measurableSpace_supᵢ_eq (m : ι → MeasurableSpace α) :
    (⨆ n, m n) = generateFrom { s | ∃ n, measurable_set[m n] s } :=
  by
  ext s
  rw [measurable_set_supr]
  rfl
#align measurable_space.measurable_space_supr_eq MeasurableSpace.measurableSpace_supᵢ_eq

theorem generateFrom_unionᵢ_measurableSet (m : ι → MeasurableSpace α) :
    generateFrom (⋃ n, { t | measurable_set[m n] t }) = ⨆ n, m n :=
  (@giGenerateFrom α).l_supr_u m
#align measurable_space.generate_from_Union_measurable_set MeasurableSpace.generateFrom_unionᵢ_measurableSet

end CompleteLattice

end MeasurableSpace

section MeasurableFunctions

open MeasurableSpace

/-- A function `f` between measurable spaces is measurable if the preimage of every
  measurable set is measurable. -/
def Measurable [MeasurableSpace α] [MeasurableSpace β] (f : α → β) : Prop :=
  ∀ ⦃t : Set β⦄, MeasurableSet t → MeasurableSet (f ⁻¹' t)
#align measurable Measurable

-- mathport name: measurable_of
scoped[MeasureTheory] notation "measurable[" m "]" => @Measurable hole! hole! m hole!

theorem measurable_id {ma : MeasurableSpace α} : Measurable (@id α) := fun t => id
#align measurable_id measurable_id

theorem measurable_id' {ma : MeasurableSpace α} : Measurable fun a : α => a :=
  measurable_id
#align measurable_id' measurable_id'

theorem Measurable.comp {mα : MeasurableSpace α} {mβ : MeasurableSpace β} {mγ : MeasurableSpace γ}
    {g : β → γ} {f : α → β} (hg : Measurable g) (hf : Measurable f) : Measurable (g ∘ f) :=
  fun t ht => hf (hg ht)
#align measurable.comp Measurable.comp

@[simp]
theorem measurable_const {ma : MeasurableSpace α} {mb : MeasurableSpace β} {a : α} :
    Measurable fun b : β => a := fun s hs => MeasurableSet.const (a ∈ s)
#align measurable_const measurable_const

theorem Measurable.le {α} {m m0 : MeasurableSpace α} {mb : MeasurableSpace β} (hm : m ≤ m0)
    {f : α → β} (hf : measurable[m] f) : measurable[m0] f := fun s hs => hm _ (hf hs)
#align measurable.le Measurable.le

theorem MeasurableSpace.Top.measurable {α β : Type _} [MeasurableSpace β] (f : α → β) :
    @Measurable α β ⊤ _ f := fun s hs => MeasurableSpace.measurableSet_top
#align measurable_space.top.measurable MeasurableSpace.Top.measurable

end MeasurableFunctions

-/

def ignore_me := ""