/-
Copyright (c) 2022 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying
-/
import measure_theory.function.convergence_in_measure
import measure_theory.function.l1_space

/-!
# Uniform integrability

This file contains the definitions for uniform integrability (both in the measure theory sense
as well as the probability theory sense). This file also contains the Vitali convergence theorem
which estabishes a relation between uniform integrability, convergence in measure and
Lp convergence.

Uniform integrability plays a vital role in the theory of martingales most notably is used to
fomulate the martingale convergence theorem.

## Main definitions

* `measure_theory.unif_integrable`: uniform integrability in the measure theory sense.
  In particular, a sequence of functions `f` is uniformly integrable if for all `ε > 0`, there
  exists some `δ > 0` such that for all sets `s` of smaller measure than `δ`, the Lp-norm of
  `f i` restricted `s` is smaller than `ε` for all `i`.
* `measure_theory.uniform_integrable`: uniform integrability in the probability theory sense.
  In particular, a sequence of measurable functions `f` is uniformly integrable in the
  probability theory sense if it is uniformly integrable in the measure theory sense and
  has uniformly bounded Lp-norm.

# Main results

* `measure_theory.unif_integrable_fintype`: a finite sequence of Lp functions is uniformly
  integrable.
* `measure_theory.tendsto_Lp_of_tendsto_ae`: a sequence of Lp functions which is uniformly
  integrable converges in Lp if they converge almost everywhere.
* `measure_theory.tendsto_in_measure_iff_tendsto_Lp`: Vitali convergence theorem:
  a sequence of Lp functions converges in Lp if and only if it is uniformly integrable
  and converges in measure.

## Tags
uniform integrable, uniformly absolutely continuous integral, Vitali convergence theorem
-/

noncomputable theory
open_locale classical measure_theory nnreal ennreal topology big_operators

namespace measure_theory

open set filter topological_space

variables {α β ι : Type*} {m : measurable_space α} {μ : measure α} [normed_add_comm_group β]

/-- Uniform integrability in the measure theory sense.

A sequence of functions `f` is said to be uniformly integrable if for all `ε > 0`, there exists
some `δ > 0` such that for all sets `s` with measure less than `δ`, the Lp-norm of `f i`
restricted on `s` is less than `ε`.

Uniform integrablility is also known as uniformly absolutely continuous integrals. -/
def unif_integrable {m : measurable_space α} (f : ι → α → β) (p : ℝ≥0∞) (μ : measure α) : Prop :=
∀ ⦃ε : ℝ⦄ (hε : 0 < ε), ∃ (δ : ℝ) (hδ : 0 < δ), ∀ i s, measurable_set s → μ s ≤ ennreal.of_real δ →
snorm (s.indicator (f i)) p μ ≤ ennreal.of_real ε

/-- In probability theory, a family of measurable functions is uniformly integrable if it is
uniformly integrable in the measure theory sense and is uniformly bounded. -/
def uniform_integrable {m : measurable_space α}
  (f : ι → α → β) (p : ℝ≥0∞) (μ : measure α) : Prop :=
(∀ i, ae_strongly_measurable (f i) μ) ∧ unif_integrable f p μ ∧ ∃ C : ℝ≥0, ∀ i, snorm (f i) p μ ≤ C

namespace uniform_integrable

protected lemma ae_strongly_measurable {f : ι → α → β} {p : ℝ≥0∞}
  (hf : uniform_integrable f p μ) (i : ι) : ae_strongly_measurable (f i) μ :=
hf.1 i

protected lemma unif_integrable {f : ι → α → β} {p : ℝ≥0∞}
  (hf : uniform_integrable f p μ) : unif_integrable f p μ :=
hf.2.1

protected lemma mem_ℒp {f : ι → α → β} {p : ℝ≥0∞}
  (hf : uniform_integrable f p μ) (i : ι) :
  mem_ℒp (f i) p μ :=
⟨hf.1 i, let ⟨_, _, hC⟩ := hf.2 in lt_of_le_of_lt (hC i) ennreal.coe_lt_top⟩

end uniform_integrable

section unif_integrable

/-! ### `unif_integrable`

This section deals with uniform integrability in the measure theory sense. -/

namespace unif_integrable

variables {f g : ι → α → β} {p : ℝ≥0∞}

protected lemma add
  (hf : unif_integrable f p μ) (hg : unif_integrable g p μ) (hp : 1 ≤ p)
  (hf_meas : ∀ i, ae_strongly_measurable (f i) μ) (hg_meas : ∀ i, ae_strongly_measurable (g i) μ) :
  unif_integrable (f + g) p μ :=
begin
  intros ε hε,
  have hε2 : 0 < ε / 2 := half_pos hε,
  obtain ⟨δ₁, hδ₁_pos, hfδ₁⟩ := hf hε2,
  obtain ⟨δ₂, hδ₂_pos, hgδ₂⟩ := hg hε2,
  refine ⟨min δ₁ δ₂, lt_min hδ₁_pos hδ₂_pos, λ i s hs hμs, _⟩,
  simp_rw [pi.add_apply, indicator_add'],
  refine (snorm_add_le ((hf_meas i).indicator hs) ((hg_meas i).indicator hs) hp).trans _,
  have hε_halves : ennreal.of_real ε = ennreal.of_real (ε / 2) + ennreal.of_real (ε / 2),
    by rw [← ennreal.of_real_add hε2.le hε2.le, add_halves],
  rw hε_halves,
  exact add_le_add (hfδ₁ i s hs (hμs.trans (ennreal.of_real_le_of_real (min_le_left _ _))))
    (hgδ₂ i s hs (hμs.trans (ennreal.of_real_le_of_real (min_le_right _ _)))),
end

protected lemma neg (hf : unif_integrable f p μ) : unif_integrable (-f) p μ :=
by { simp_rw [unif_integrable, pi.neg_apply, indicator_neg', snorm_neg], exact hf, }

protected lemma sub
  (hf : unif_integrable f p μ) (hg : unif_integrable g p μ) (hp : 1 ≤ p)
  (hf_meas : ∀ i, ae_strongly_measurable (f i) μ) (hg_meas : ∀ i, ae_strongly_measurable (g i) μ) :
  unif_integrable (f - g) p μ :=
by { rw sub_eq_add_neg, exact hf.add hg.neg hp hf_meas (λ i, (hg_meas i).neg), }

protected lemma ae_eq (hf : unif_integrable f p μ) (hfg : ∀ n, f n =ᵐ[μ] g n) :
  unif_integrable g p μ :=
begin
  intros ε hε,
  obtain ⟨δ, hδ_pos, hfδ⟩ := hf hε,
  refine ⟨δ, hδ_pos, λ n s hs hμs, (le_of_eq $ snorm_congr_ae _).trans (hfδ n s hs hμs)⟩,
  filter_upwards [hfg n] with x hx,
  simp_rw [indicator_apply, hx],
end

end unif_integrable

lemma unif_integrable_zero_meas [measurable_space α] {p : ℝ≥0∞} {f : ι → α → β} :
  unif_integrable f p (0 : measure α) :=
λ ε hε, ⟨1, one_pos, λ i s hs hμs, by simp⟩

lemma unif_integrable_congr_ae {p : ℝ≥0∞} {f g : ι → α → β} (hfg : ∀ n, f n =ᵐ[μ] g n) :
  unif_integrable f p μ ↔ unif_integrable g p μ :=
⟨λ hf, hf.ae_eq hfg, λ hg, hg.ae_eq (λ n, (hfg n).symm)⟩

lemma tendsto_indicator_ge (f : α → β) (x : α):
  tendsto (λ M : ℕ, {x | (M : ℝ) ≤ ‖f x‖₊}.indicator f x) at_top (𝓝 0) :=
begin
  refine @tendsto_at_top_of_eventually_const _ _ _ _ _ _ _ (nat.ceil (‖f x‖₊ : ℝ) + 1) (λ n hn, _),
  rw indicator_of_not_mem,
  simp only [not_le, mem_set_of_eq],
  refine lt_of_le_of_lt (nat.le_ceil _) _,
  refine lt_of_lt_of_le (lt_add_one _) _,
  norm_cast,
  rwa [ge_iff_le, coe_nnnorm] at hn,
end

variables (μ) {p : ℝ≥0∞}

section

variables {f : α → β}

/-- This lemma is weaker than `measure_theory.mem_ℒp.integral_indicator_norm_ge_nonneg_le`
as the latter provides `0 ≤ M` and does not require the measurability of `f`. -/
lemma mem_ℒp.integral_indicator_norm_ge_le
  (hf : mem_ℒp f 1 μ) (hmeas : strongly_measurable f) {ε : ℝ} (hε : 0 < ε) :
  ∃ M : ℝ, ∫⁻ x, ‖{x | M ≤ ‖f x‖₊}.indicator f x‖₊ ∂μ ≤ ennreal.of_real ε :=
begin
  have htendsto : ∀ᵐ x ∂μ, tendsto (λ M : ℕ, {x | (M : ℝ) ≤ ‖f x‖₊}.indicator f x) at_top (𝓝 0) :=
    univ_mem' (id $ λ x, tendsto_indicator_ge f x),
  have hmeas : ∀ M : ℕ, ae_strongly_measurable ({x | (M : ℝ) ≤ ‖f x‖₊}.indicator f) μ,
  { assume M,
    apply hf.1.indicator,
    apply strongly_measurable.measurable_set_le strongly_measurable_const
      hmeas.nnnorm.measurable.coe_nnreal_real.strongly_measurable },
  have hbound : has_finite_integral (λ x, ‖f x‖) μ,
  { rw mem_ℒp_one_iff_integrable at hf,
    exact hf.norm.2 },
  have := tendsto_lintegral_norm_of_dominated_convergence hmeas hbound _ htendsto,
  { rw ennreal.tendsto_at_top_zero at this,
    obtain ⟨M, hM⟩ := this (ennreal.of_real ε) (ennreal.of_real_pos.2 hε),
    simp only [true_and, ge_iff_le, zero_tsub, zero_le,
              sub_zero, zero_add, coe_nnnorm, mem_Icc] at hM,
    refine ⟨M, _⟩,
    convert hM M le_rfl,
    ext1 x,
    simp only [coe_nnnorm, ennreal.of_real_eq_coe_nnreal (norm_nonneg _)],
    refl },
  { refine λ n, univ_mem' (id $ λ x, _),
    by_cases hx : (n : ℝ) ≤ ‖f x‖,
    { dsimp,
      rwa indicator_of_mem },
    { dsimp,
      rw [indicator_of_not_mem, norm_zero],
      { exact norm_nonneg _ },
      { assumption } } }
end

/-- This lemma is superceded by `measure_theory.mem_ℒp.integral_indicator_norm_ge_nonneg_le`
which does not require measurability. -/
lemma mem_ℒp.integral_indicator_norm_ge_nonneg_le_of_meas
  (hf : mem_ℒp f 1 μ) (hmeas : strongly_measurable f) {ε : ℝ} (hε : 0 < ε) :
  ∃ M : ℝ, 0 ≤ M ∧ ∫⁻ x, ‖{x | M ≤ ‖f x‖₊}.indicator f x‖₊ ∂μ ≤ ennreal.of_real ε :=
let ⟨M, hM⟩ := hf.integral_indicator_norm_ge_le μ hmeas hε in ⟨max M 0, le_max_right _ _, by simpa⟩

lemma mem_ℒp.integral_indicator_norm_ge_nonneg_le
  (hf : mem_ℒp f 1 μ) {ε : ℝ} (hε : 0 < ε) :
  ∃ M : ℝ, 0 ≤ M ∧ ∫⁻ x, ‖{x | M ≤ ‖f x‖₊}.indicator f x‖₊ ∂μ ≤ ennreal.of_real ε :=
begin
  have hf_mk : mem_ℒp (hf.1.mk f) 1 μ := (mem_ℒp_congr_ae hf.1.ae_eq_mk).mp hf,
  obtain ⟨M, hM_pos, hfM⟩ := hf_mk.integral_indicator_norm_ge_nonneg_le_of_meas μ
    hf.1.strongly_measurable_mk hε,
  refine ⟨M, hM_pos, (le_of_eq _).trans hfM⟩,
  refine lintegral_congr_ae _,
  filter_upwards [hf.1.ae_eq_mk] with x hx,
  simp only [indicator_apply, coe_nnnorm, mem_set_of_eq, ennreal.coe_eq_coe, hx.symm],
end

lemma mem_ℒp.snorm_ess_sup_indicator_norm_ge_eq_zero
  (hf : mem_ℒp f ∞ μ) (hmeas : strongly_measurable f) :
  ∃ M : ℝ, snorm_ess_sup ({x | M ≤ ‖f x‖₊}.indicator f) μ = 0 :=
begin
  have hbdd : snorm_ess_sup f μ < ∞ := hf.snorm_lt_top,
  refine ⟨(snorm f ∞ μ + 1).to_real, _⟩,
  rw snorm_ess_sup_indicator_eq_snorm_ess_sup_restrict,
  have : μ.restrict {x : α | (snorm f ⊤ μ + 1).to_real ≤ ‖f x‖₊} = 0,
  { simp only [coe_nnnorm, snorm_exponent_top, measure.restrict_eq_zero],
    have : {x : α | (snorm_ess_sup f μ + 1).to_real ≤ ‖f x‖} ⊆
      {x : α | snorm_ess_sup f μ < ‖f x‖₊},
    { intros x hx,
      rw [mem_set_of_eq, ← ennreal.to_real_lt_to_real hbdd.ne ennreal.coe_lt_top.ne,
          ennreal.coe_to_real, coe_nnnorm],
      refine lt_of_lt_of_le _ hx,
      rw ennreal.to_real_lt_to_real hbdd.ne,
      { exact ennreal.lt_add_right hbdd.ne one_ne_zero },
      { exact (ennreal.add_lt_top.2 ⟨hbdd, ennreal.one_lt_top⟩).ne } },
    rw ← nonpos_iff_eq_zero,
    refine (measure_mono this).trans _,
    have hle := coe_nnnorm_ae_le_snorm_ess_sup f μ,
    simp_rw [ae_iff, not_le] at hle,
    exact nonpos_iff_eq_zero.2 hle },
  rw [this, snorm_ess_sup_measure_zero],
  exact measurable_set_le measurable_const hmeas.nnnorm.measurable.subtype_coe,
end

/- This lemma is slightly weaker than `measure_theory.mem_ℒp.snorm_indicator_norm_ge_pos_le` as the
latter provides `0 < M`. -/
lemma mem_ℒp.snorm_indicator_norm_ge_le
  (hf : mem_ℒp f p μ) (hmeas : strongly_measurable f) {ε : ℝ} (hε : 0 < ε) :
  ∃ M : ℝ, snorm ({x | M ≤ ‖f x‖₊}.indicator f) p μ ≤ ennreal.of_real ε :=
begin
  by_cases hp_ne_zero : p = 0,
  { refine ⟨1, hp_ne_zero.symm ▸ _⟩,
    simp [snorm_exponent_zero] },
  by_cases hp_ne_top : p = ∞,
  { subst hp_ne_top,
    obtain ⟨M, hM⟩ := hf.snorm_ess_sup_indicator_norm_ge_eq_zero μ hmeas,
    refine ⟨M, _⟩,
    simp only [snorm_exponent_top, hM, zero_le] },
  obtain ⟨M, hM', hM⟩ := @mem_ℒp.integral_indicator_norm_ge_nonneg_le _ _ _ μ _
    (λ x, ‖f x‖^p.to_real) (hf.norm_rpow hp_ne_zero hp_ne_top) _
    (real.rpow_pos_of_pos hε p.to_real),
  refine ⟨M ^(1 / p.to_real), _⟩,
  rw [snorm_eq_lintegral_rpow_nnnorm hp_ne_zero hp_ne_top,
      ← ennreal.rpow_one (ennreal.of_real ε)],
  conv_rhs { rw ← mul_one_div_cancel (ennreal.to_real_pos hp_ne_zero hp_ne_top).ne.symm },
  rw [ennreal.rpow_mul,
      ennreal.rpow_le_rpow_iff (one_div_pos.2 $ ennreal.to_real_pos hp_ne_zero hp_ne_top),
      ennreal.of_real_rpow_of_pos hε],
  convert hM,
  ext1 x,
  rw [ennreal.coe_rpow_of_nonneg _ ennreal.to_real_nonneg,
      nnnorm_indicator_eq_indicator_nnnorm, nnnorm_indicator_eq_indicator_nnnorm],
  have hiff : M ^ (1 / p.to_real) ≤ ‖f x‖₊ ↔ M ≤ ‖‖f x‖ ^ p.to_real‖₊,
  { rw [coe_nnnorm, coe_nnnorm, real.norm_rpow_of_nonneg (norm_nonneg _), norm_norm,
        ← real.rpow_le_rpow_iff hM' (real.rpow_nonneg_of_nonneg (norm_nonneg _) _)
        (one_div_pos.2 $ ennreal.to_real_pos hp_ne_zero hp_ne_top),
        ← real.rpow_mul (norm_nonneg _),
        mul_one_div_cancel (ennreal.to_real_pos hp_ne_zero hp_ne_top).ne.symm, real.rpow_one] },
  by_cases hx : x ∈ {x : α | M ^ (1 / p.to_real) ≤ ‖f x‖₊},
  { rw [set.indicator_of_mem hx,set.indicator_of_mem, real.nnnorm_of_nonneg], refl,
    change _ ≤ _,
    rwa ← hiff },
  { rw [set.indicator_of_not_mem hx, set.indicator_of_not_mem],
    { simp [(ennreal.to_real_pos hp_ne_zero hp_ne_top).ne.symm] },
    { change ¬ _ ≤ _,
      rwa ← hiff } }
end

/-- This lemma implies that a single function is uniformly integrable (in the probability sense). -/
lemma mem_ℒp.snorm_indicator_norm_ge_pos_le
  (hf : mem_ℒp f p μ) (hmeas : strongly_measurable f) {ε : ℝ} (hε : 0 < ε) :
  ∃ M : ℝ, 0 < M ∧ snorm ({x | M ≤ ‖f x‖₊}.indicator f) p μ ≤ ennreal.of_real ε :=
begin
  obtain ⟨M, hM⟩ := hf.snorm_indicator_norm_ge_le μ hmeas hε,
  refine ⟨max M 1, lt_of_lt_of_le zero_lt_one (le_max_right _ _),
    le_trans (snorm_mono (λ x, _)) hM⟩,
  rw [norm_indicator_eq_indicator_norm, norm_indicator_eq_indicator_norm],
  refine indicator_le_indicator_of_subset (λ x hx, _) (λ x, norm_nonneg _) x,
  change max _ _ ≤ _ at hx, -- removing the `change` breaks the proof!
  exact (max_le_iff.1 hx).1,
end

end

lemma snorm_indicator_le_of_bound {f : α → β} (hp_top : p ≠ ∞)
  {ε : ℝ} (hε : 0 < ε) {M : ℝ} (hf : ∀ x, ‖f x‖ < M) :
  ∃ (δ : ℝ) (hδ : 0 < δ), ∀ s, measurable_set s → μ s ≤ ennreal.of_real δ →
  snorm (s.indicator f) p μ ≤ ennreal.of_real ε :=
begin
  by_cases hM : M ≤ 0,
  { refine ⟨1, zero_lt_one, λ s hs hμ, _⟩,
    rw (_ : f = 0),
    { simp [hε.le] },
    { ext x,
      rw [pi.zero_apply, ← norm_le_zero_iff],
      exact (lt_of_lt_of_le (hf x) hM).le } },
  rw not_le at hM,
  refine ⟨(ε / M) ^ p.to_real, real.rpow_pos_of_pos (div_pos hε hM) _, λ s hs hμ, _⟩,
  by_cases hp : p = 0,
  { simp [hp] },
  rw snorm_indicator_eq_snorm_restrict hs,
  have haebdd : ∀ᵐ x ∂μ.restrict s, ‖f x‖ ≤ M,
  { filter_upwards,
    exact (λ x, (hf x).le) },
  refine le_trans (snorm_le_of_ae_bound haebdd) _,
  rw [measure.restrict_apply measurable_set.univ, univ_inter,
    ← ennreal.le_div_iff_mul_le (or.inl _) (or.inl ennreal.of_real_ne_top)],
  { rw [← one_div, ennreal.rpow_one_div_le_iff (ennreal.to_real_pos hp hp_top)],
    refine le_trans hμ _,
    rw [← ennreal.of_real_rpow_of_pos (div_pos hε hM),
      ennreal.rpow_le_rpow_iff (ennreal.to_real_pos hp hp_top), ennreal.of_real_div_of_pos hM],
    exact le_rfl },
  { simpa only [ennreal.of_real_eq_zero, not_le, ne.def] },
end

section

variables {f : α → β}

/-- Auxiliary lemma for `measure_theory.mem_ℒp.snorm_indicator_le`. -/
lemma mem_ℒp.snorm_indicator_le' (hp_one : 1 ≤ p) (hp_top : p ≠ ∞)
  (hf : mem_ℒp f p μ) (hmeas : strongly_measurable f) {ε : ℝ} (hε : 0 < ε) :
  ∃ (δ : ℝ) (hδ : 0 < δ), ∀ s, measurable_set s → μ s ≤ ennreal.of_real δ →
  snorm (s.indicator f) p μ ≤ 2 * ennreal.of_real ε :=
begin
  obtain ⟨M, hMpos, hM⟩ := hf.snorm_indicator_norm_ge_pos_le μ hmeas hε,
  obtain ⟨δ, hδpos, hδ⟩ := @snorm_indicator_le_of_bound _ _ _ μ _ _
    ({x | ‖f x‖ < M}.indicator f) hp_top _ hε M _,
  { refine ⟨δ, hδpos, λ s hs hμs, _⟩,
    rw (_ : f = {x : α | M ≤ ‖f x‖₊}.indicator f + {x : α | ‖f x‖ < M}.indicator f),
    { rw snorm_indicator_eq_snorm_restrict hs,
      refine le_trans (snorm_add_le _ _ hp_one) _,
      { exact strongly_measurable.ae_strongly_measurable (hmeas.indicator
        (measurable_set_le measurable_const hmeas.nnnorm.measurable.subtype_coe)) },
      { exact strongly_measurable.ae_strongly_measurable (hmeas.indicator
        (measurable_set_lt hmeas.nnnorm.measurable.subtype_coe measurable_const)) },
      { rw two_mul,
        refine add_le_add (le_trans (snorm_mono_measure _ measure.restrict_le_self) hM) _,
        rw ← snorm_indicator_eq_snorm_restrict hs,
        exact hδ s hs hμs } },
    { ext x,
      by_cases hx : M ≤ ‖f x‖,
      { rw [pi.add_apply, indicator_of_mem, indicator_of_not_mem, add_zero];
        simpa },
      { rw [pi.add_apply, indicator_of_not_mem, indicator_of_mem, zero_add];
        simpa using hx } } },
  { intros x,
    rw [norm_indicator_eq_indicator_norm, indicator_apply],
    split_ifs,
    exacts [h, hMpos] }
end

/-- This lemma is superceded by `measure_theory.mem_ℒp.snorm_indicator_le` which does not require
measurability on `f`. -/
lemma mem_ℒp.snorm_indicator_le_of_meas (hp_one : 1 ≤ p) (hp_top : p ≠ ∞)
  (hf : mem_ℒp f p μ) (hmeas : strongly_measurable f) {ε : ℝ} (hε : 0 < ε) :
  ∃ (δ : ℝ) (hδ : 0 < δ), ∀ s, measurable_set s → μ s ≤ ennreal.of_real δ →
  snorm (s.indicator f) p μ ≤ ennreal.of_real ε :=
begin
  obtain ⟨δ, hδpos, hδ⟩ := hf.snorm_indicator_le' μ hp_one hp_top hmeas (half_pos hε),
  refine ⟨δ, hδpos, λ s hs hμs, le_trans (hδ s hs hμs) _⟩,
  rw [ennreal.of_real_div_of_pos zero_lt_two, (by norm_num : ennreal.of_real 2 = 2),
    ennreal.mul_div_cancel'];
  norm_num,
end

lemma mem_ℒp.snorm_indicator_le (hp_one : 1 ≤ p) (hp_top : p ≠ ∞)
  (hf : mem_ℒp f p μ) {ε : ℝ} (hε : 0 < ε) :
  ∃ (δ : ℝ) (hδ : 0 < δ), ∀ s, measurable_set s → μ s ≤ ennreal.of_real δ →
  snorm (s.indicator f) p μ ≤ ennreal.of_real ε :=
begin
  have hℒp := hf,
  obtain ⟨⟨f', hf', heq⟩, hnorm⟩ := hf,
  obtain ⟨δ, hδpos, hδ⟩ := (hℒp.ae_eq heq).snorm_indicator_le_of_meas μ hp_one hp_top hf' hε,
  refine ⟨δ, hδpos, λ s hs hμs, _⟩,
  convert hδ s hs hμs using 1,
  rw [snorm_indicator_eq_snorm_restrict hs, snorm_indicator_eq_snorm_restrict hs],
  refine snorm_congr_ae heq.restrict,
end

/-- A constant function is uniformly integrable. -/
lemma unif_integrable_const {g : α → β} (hp : 1 ≤ p) (hp_ne_top : p ≠ ∞) (hg : mem_ℒp g p μ) :
  unif_integrable (λ n : ι, g) p μ :=
begin
  intros ε hε,
  obtain ⟨δ, hδ_pos, hgδ⟩ := hg.snorm_indicator_le μ hp hp_ne_top hε,
  exact ⟨δ, hδ_pos, λ i, hgδ⟩,
end

/-- A single function is uniformly integrable. -/
lemma unif_integrable_subsingleton [subsingleton ι]
  (hp_one : 1 ≤ p) (hp_top : p ≠ ∞) {f : ι → α → β} (hf : ∀ i, mem_ℒp (f i) p μ) :
  unif_integrable f p μ :=
begin
  intros ε hε,
  by_cases hι : nonempty ι,
  { cases hι with i,
    obtain ⟨δ, hδpos, hδ⟩ := (hf i).snorm_indicator_le μ hp_one hp_top hε,
    refine ⟨δ, hδpos, λ j s hs hμs, _⟩,
    convert hδ s hs hμs },
  { exact ⟨1, zero_lt_one, λ i, false.elim $ hι $ nonempty.intro i⟩ }
end

/-- This lemma is less general than `measure_theory.unif_integrable_fintype` which applies to
all sequences indexed by a finite type. -/
lemma unif_integrable_fin (hp_one : 1 ≤ p) (hp_top : p ≠ ∞)
  {n : ℕ} {f : fin n → α → β} (hf : ∀ i, mem_ℒp (f i) p μ) :
  unif_integrable f p μ :=
begin
  revert f,
  induction n with n h,
  { exact (λ f hf, unif_integrable_subsingleton μ hp_one hp_top hf) },
  intros f hfLp ε hε,
  set g : fin n → α → β := λ k, f k with hg,
  have hgLp : ∀ i, mem_ℒp (g i) p μ := λ i, hfLp i,
  obtain ⟨δ₁, hδ₁pos, hδ₁⟩ := h hgLp hε,
  obtain ⟨δ₂, hδ₂pos, hδ₂⟩ := (hfLp n).snorm_indicator_le μ hp_one hp_top hε,
  refine ⟨min δ₁ δ₂, lt_min hδ₁pos hδ₂pos, λ i s hs hμs, _⟩,
  by_cases hi : i.val < n,
  { rw (_ : f i = g ⟨i.val, hi⟩),
    { exact hδ₁ _ s hs (le_trans hμs $ ennreal.of_real_le_of_real $ min_le_left _ _) },
    { rw hg, simp } },
  { rw (_ : i = n),
    { exact hδ₂ _ hs (le_trans hμs $ ennreal.of_real_le_of_real $ min_le_right _ _) },
    { have hi' := fin.is_lt i,
      rw nat.lt_succ_iff at hi',
      rw not_lt at hi,
      simp [← le_antisymm hi' hi] } }
end

/-- A finite sequence of Lp functions is uniformly integrable. -/
lemma unif_integrable_finite [finite ι] (hp_one : 1 ≤ p) (hp_top : p ≠ ∞)
  {f : ι → α → β} (hf : ∀ i, mem_ℒp (f i) p μ) :
  unif_integrable f p μ :=
begin
  obtain ⟨n, hn⟩ := finite.exists_equiv_fin ι,
  intros ε hε,
  set g : fin n → α → β := f ∘ hn.some.symm with hgeq,
  have hg : ∀ i, mem_ℒp (g i) p μ := λ _, hf _,
  obtain ⟨δ, hδpos, hδ⟩ := unif_integrable_fin μ hp_one hp_top hg hε,
  refine ⟨δ, hδpos, λ i s hs hμs, _⟩,
  specialize hδ (hn.some i) s hs hμs,
  simp_rw [hgeq, function.comp_app, equiv.symm_apply_apply] at hδ,
  assumption,
end

end

lemma snorm_sub_le_of_dist_bdd
  {p : ℝ≥0∞} (hp' : p ≠ ∞) {s : set α} (hs : measurable_set[m] s)
  {f g : α → β} {c : ℝ} (hc : 0 ≤ c) (hf : ∀ x ∈ s, dist (f x) (g x) ≤ c) :
  snorm (s.indicator (f - g)) p μ ≤ ennreal.of_real c * μ s ^ (1 / p.to_real) :=
begin
  by_cases hp : p = 0,
  { simp [hp], },
  have : ∀ x, ‖s.indicator (f - g) x‖ ≤ ‖s.indicator (λ x, c) x‖,
  { intro x,
    by_cases hx : x ∈ s,
    { rw [indicator_of_mem hx, indicator_of_mem hx, pi.sub_apply, ← dist_eq_norm,
          real.norm_eq_abs, abs_of_nonneg hc],
      exact hf x hx },
    { simp [indicator_of_not_mem hx] } },
  refine le_trans (snorm_mono this) _,
  rw snorm_indicator_const hs hp hp',
  refine mul_le_mul_right' (le_of_eq _) _,
  rw [← of_real_norm_eq_coe_nnnorm, real.norm_eq_abs, abs_of_nonneg hc],
end

/-- A sequence of uniformly integrable functions which converges μ-a.e. converges in Lp. -/
lemma tendsto_Lp_of_tendsto_ae_of_meas [is_finite_measure μ]
  (hp : 1 ≤ p) (hp' : p ≠ ∞) {f : ℕ → α → β} {g : α → β}
  (hf : ∀ n, strongly_measurable (f n)) (hg : strongly_measurable g)
  (hg' : mem_ℒp g p μ) (hui : unif_integrable f p μ)
  (hfg : ∀ᵐ x ∂μ, tendsto (λ n, f n x) at_top (𝓝 (g x))) :
  tendsto (λ n, snorm (f n - g) p μ) at_top (𝓝 0) :=
begin
  rw ennreal.tendsto_at_top_zero,
  intros ε hε,
  by_cases ε < ∞, swap,
  { rw [not_lt, top_le_iff] at h,
    exact ⟨0, λ n hn, by simp [h]⟩ },
  by_cases hμ : μ = 0,
  { exact ⟨0, λ n hn, by simp [hμ]⟩ },
  have hε' : 0 < ε.to_real / 3 :=
    div_pos (ennreal.to_real_pos (gt_iff_lt.1 hε).ne.symm h.ne) (by norm_num),
  have hdivp : 0 ≤ 1 / p.to_real,
  { refine one_div_nonneg.2 _,
    rw [← ennreal.zero_to_real, ennreal.to_real_le_to_real ennreal.zero_ne_top hp'],
    exact le_trans (zero_le _) hp },
  have hpow : 0 < (measure_univ_nnreal μ) ^ (1 / p.to_real) :=
    real.rpow_pos_of_pos (measure_univ_nnreal_pos hμ) _,
  obtain ⟨δ₁, hδ₁, hsnorm₁⟩ := hui hε',
  obtain ⟨δ₂, hδ₂, hsnorm₂⟩ := hg'.snorm_indicator_le μ hp hp' hε',
  obtain ⟨t, htm, ht₁, ht₂⟩ := tendsto_uniformly_on_of_ae_tendsto' hf
    hg hfg (lt_min hδ₁ hδ₂),
  rw metric.tendsto_uniformly_on_iff at ht₂,
  specialize ht₂ (ε.to_real / (3 * measure_univ_nnreal μ ^ (1 / p.to_real)))
    (div_pos (ennreal.to_real_pos (gt_iff_lt.1 hε).ne.symm h.ne) (mul_pos (by norm_num) hpow)),
  obtain ⟨N, hN⟩ := eventually_at_top.1 ht₂, clear ht₂,
  refine ⟨N, λ n hn, _⟩,
  rw [← t.indicator_self_add_compl (f n - g)],
  refine le_trans (snorm_add_le ((((hf n).sub hg).indicator htm).ae_strongly_measurable)
    (((hf n).sub hg).indicator htm.compl).ae_strongly_measurable hp) _,
  rw [sub_eq_add_neg, indicator_add' t, indicator_neg'],
  refine le_trans (add_le_add_right (snorm_add_le ((hf n).indicator htm).ae_strongly_measurable
    (hg.indicator htm).neg.ae_strongly_measurable hp) _) _,
  have hnf : snorm (t.indicator (f n)) p μ ≤ ennreal.of_real (ε.to_real / 3),
  { refine hsnorm₁ n t htm (le_trans ht₁ _),
    rw ennreal.of_real_le_of_real_iff hδ₁.le,
    exact min_le_left _ _ },
  have hng : snorm (t.indicator g) p μ ≤ ennreal.of_real (ε.to_real / 3),
  { refine hsnorm₂ t htm (le_trans ht₁ _),
    rw ennreal.of_real_le_of_real_iff hδ₂.le,
    exact min_le_right _ _ },
  have hlt : snorm (tᶜ.indicator (f n - g)) p μ ≤ ennreal.of_real (ε.to_real / 3),
  { specialize hN n hn,
    have := snorm_sub_le_of_dist_bdd μ
      hp' htm.compl _ (λ x hx, (dist_comm (g x) (f n x) ▸ (hN x hx).le :
      dist (f n x) (g x) ≤ ε.to_real / (3 * measure_univ_nnreal μ ^ (1 / p.to_real)))),
    refine le_trans this _,
    rw [div_mul_eq_div_mul_one_div, ← ennreal.of_real_to_real (measure_lt_top μ tᶜ).ne,
        ennreal.of_real_rpow_of_nonneg ennreal.to_real_nonneg hdivp, ← ennreal.of_real_mul,
        mul_assoc],
    { refine ennreal.of_real_le_of_real (mul_le_of_le_one_right hε'.le _),
      rw [mul_comm, mul_one_div, div_le_one],
      { refine real.rpow_le_rpow ennreal.to_real_nonneg
          (ennreal.to_real_le_of_le_of_real (measure_univ_nnreal_pos hμ).le _) hdivp,
        rw [ennreal.of_real_coe_nnreal, coe_measure_univ_nnreal],
        exact measure_mono (subset_univ _) },
      { exact real.rpow_pos_of_pos (measure_univ_nnreal_pos hμ) _ } },
    { refine mul_nonneg (hε').le (one_div_nonneg.2 hpow.le) },
    { rw div_mul_eq_div_mul_one_div,
      exact mul_nonneg hε'.le (one_div_nonneg.2 hpow.le) } },
  have : ennreal.of_real (ε.to_real / 3) = ε / 3,
  { rw [ennreal.of_real_div_of_pos (show (0 : ℝ) < 3, by norm_num), ennreal.of_real_to_real h.ne],
    simp },
  rw this at hnf hng hlt,
  rw [snorm_neg, ← ennreal.add_thirds ε, ← sub_eq_add_neg],
  exact add_le_add_three hnf hng hlt
end

/-- A sequence of uniformly integrable functions which converges μ-a.e. converges in Lp. -/
lemma tendsto_Lp_of_tendsto_ae [is_finite_measure μ]
  (hp : 1 ≤ p) (hp' : p ≠ ∞) {f : ℕ → α → β} {g : α → β}
  (hf : ∀ n, ae_strongly_measurable (f n) μ) (hg : mem_ℒp g p μ) (hui : unif_integrable f p μ)
  (hfg : ∀ᵐ x ∂μ, tendsto (λ n, f n x) at_top (𝓝 (g x))) :
  tendsto (λ n, snorm (f n - g) p μ) at_top (𝓝 0) :=
begin
  suffices : tendsto (λ (n : ℕ), snorm ((hf n).mk (f n) - (hg.1.mk g)) p μ) at_top (𝓝 0),
  { convert this,
    exact funext (λ n, snorm_congr_ae ((hf n).ae_eq_mk.sub hg.1.ae_eq_mk)), },
  refine tendsto_Lp_of_tendsto_ae_of_meas μ hp hp' (λ n, (hf n).strongly_measurable_mk)
    hg.1.strongly_measurable_mk (hg.ae_eq hg.1.ae_eq_mk) (hui.ae_eq (λ n, (hf n).ae_eq_mk)) _,
  have h_ae_forall_eq : ∀ᵐ x ∂μ, ∀ n, f n x = (hf n).mk (f n) x,
  { rw ae_all_iff,
    exact λ n, (hf n).ae_eq_mk, },
  filter_upwards [hfg, h_ae_forall_eq, hg.1.ae_eq_mk] with x hx_tendsto hxf_eq hxg_eq,
  rw ← hxg_eq,
  convert hx_tendsto,
  ext1 n,
  exact (hxf_eq n).symm,
end

variables {f : ℕ → α → β} {g : α → β}

lemma unif_integrable_of_tendsto_Lp_zero (hp : 1 ≤ p) (hp' : p ≠ ∞)
  (hf : ∀ n, mem_ℒp (f n) p μ) (hf_tendsto : tendsto (λ n, snorm (f n) p μ) at_top (𝓝 0)) :
  unif_integrable f p μ :=
begin
  intros ε hε,
  rw ennreal.tendsto_at_top_zero at hf_tendsto,
  obtain ⟨N, hN⟩ := hf_tendsto (ennreal.of_real ε) (by simpa),
  set F : fin N → α → β := λ n, f n,
  have hF : ∀ n, mem_ℒp (F n) p μ := λ n, hf n,
  obtain ⟨δ₁, hδpos₁, hδ₁⟩ := unif_integrable_fin μ hp hp' hF hε,
  refine ⟨δ₁, hδpos₁, λ n s hs hμs, _⟩,
  by_cases hn : n < N,
  { exact hδ₁ ⟨n, hn⟩ s hs hμs },
  { exact (snorm_indicator_le _).trans (hN n (not_lt.1 hn)) },
end

/-- Convergence in Lp implies uniform integrability. -/
lemma unif_integrable_of_tendsto_Lp
  (hp : 1 ≤ p) (hp' : p ≠ ∞) (hf : ∀ n, mem_ℒp (f n) p μ) (hg : mem_ℒp g p μ)
  (hfg : tendsto (λ n, snorm (f n - g) p μ) at_top (𝓝 0)) :
  unif_integrable f p μ :=
begin
  have : f = (λ n, g) + λ n, f n - g, by { ext1 n, simp, },
  rw this,
  refine unif_integrable.add _ _ hp
    (λ _, hg.ae_strongly_measurable) (λ n, (hf n).1.sub hg.ae_strongly_measurable),
  { exact unif_integrable_const μ hp hp' hg, },
  { exact unif_integrable_of_tendsto_Lp_zero μ hp hp' (λ n, (hf n).sub hg) hfg, },
end

/-- Forward direction of Vitali's convergence theorem: if `f` is a sequence of uniformly integrable
functions that converge in measure to some function `g` in a finite measure space, then `f`
converge in Lp to `g`. -/
lemma tendsto_Lp_of_tendsto_in_measure [is_finite_measure μ]
  (hp : 1 ≤ p) (hp' : p ≠ ∞) (hf : ∀ n, ae_strongly_measurable (f n) μ)
  (hg : mem_ℒp g p μ) (hui : unif_integrable f p μ)
  (hfg : tendsto_in_measure μ f at_top g) :
  tendsto (λ n, snorm (f n - g) p μ) at_top (𝓝 0) :=
begin
  refine tendsto_of_subseq_tendsto (λ ns hns, _),
  obtain ⟨ms, hms, hms'⟩ := tendsto_in_measure.exists_seq_tendsto_ae (λ ε hε, (hfg ε hε).comp hns),
  exact ⟨ms, tendsto_Lp_of_tendsto_ae μ hp hp' (λ _, hf _) hg
    (λ ε hε, let ⟨δ, hδ, hδ'⟩ := hui hε in ⟨δ, hδ, λ i s hs hμs, hδ' _ s hs hμs⟩) hms'⟩,
end

/-- **Vitali's convergence theorem**: A sequence of functions `f` converges to `g` in Lp if and
only if it is uniformly integrable and converges to `g` in measure. -/
lemma tendsto_in_measure_iff_tendsto_Lp [is_finite_measure μ]
  (hp : 1 ≤ p) (hp' : p ≠ ∞) (hf : ∀ n, mem_ℒp (f n) p μ) (hg : mem_ℒp g p μ) :
  tendsto_in_measure μ f at_top g ∧ unif_integrable f p μ ↔
  tendsto (λ n, snorm (f n - g) p μ) at_top (𝓝 0) :=
⟨λ h, tendsto_Lp_of_tendsto_in_measure μ hp hp' (λ n, (hf n).1) hg h.2 h.1,
  λ h, ⟨tendsto_in_measure_of_tendsto_snorm
    (lt_of_lt_of_le zero_lt_one hp).ne.symm
    (λ n, (hf n).ae_strongly_measurable)
    hg.ae_strongly_measurable h, unif_integrable_of_tendsto_Lp μ hp hp' hf hg h⟩⟩

/-- This lemma is superceded by `unif_integrable_of` which do not require `C` to be positive. -/
lemma unif_integrable_of' (hp : 1 ≤ p) (hp' : p ≠ ∞) {f : ι → α → β}
  (hf : ∀ i, strongly_measurable (f i))
  (h : ∀ ε : ℝ, 0 < ε → ∃ C : ℝ≥0, 0 < C ∧
    ∀ i, snorm ({x | C ≤ ‖f i x‖₊}.indicator (f i)) p μ ≤ ennreal.of_real ε) :
  unif_integrable f p μ :=
begin
  have hpzero := (lt_of_lt_of_le zero_lt_one hp).ne.symm,
  by_cases hμ : μ set.univ = 0,
  { rw measure.measure_univ_eq_zero at hμ,
    exact hμ.symm ▸ unif_integrable_zero_meas },
  intros ε hε,
  obtain ⟨C, hCpos, hC⟩ := h (ε / 2) (half_pos hε),
  refine ⟨(ε / (2 * C)) ^ ennreal.to_real p, real.rpow_pos_of_pos
    (div_pos hε (mul_pos two_pos (nnreal.coe_pos.2 hCpos))) _, λ i s hs hμs, _⟩,
  by_cases hμs' : μ s = 0,
  { rw (snorm_eq_zero_iff ((hf i).indicator hs).ae_strongly_measurable hpzero).2
      (indicator_meas_zero hμs'),
    norm_num },
  calc snorm (indicator s (f i)) p μ ≤ snorm (indicator (s ∩ {x | C ≤ ‖f i x‖₊}) (f i)) p μ +
    snorm (indicator (s ∩ {x | ‖f i x‖₊ < C}) (f i)) p μ :
    begin
      refine le_trans (eq.le _) (snorm_add_le (strongly_measurable.ae_strongly_measurable
        ((hf i).indicator (hs.inter (strongly_measurable_const.measurable_set_le (hf i).nnnorm))))
        (strongly_measurable.ae_strongly_measurable ((hf i).indicator (hs.inter
        ((hf i).nnnorm.measurable_set_lt strongly_measurable_const)))) hp),
      congr,
      change _ = λ x, (s ∩ {x : α | C ≤ ‖f i x‖₊}).indicator (f i) x +
        (s ∩ {x : α | ‖f i x‖₊ < C}).indicator (f i) x,
      rw ← set.indicator_union_of_disjoint,
      { congr,
        rw [← inter_union_distrib_left, (by { ext, simp [le_or_lt] } :
          {x : α | C ≤ ‖f i x‖₊} ∪ {x : α | ‖f i x‖₊ < C} = set.univ), inter_univ] },
      { refine (disjoint.inf_right' _ _).inf_left' _,
        rw disjoint_iff_inf_le,
        rintro x ⟨hx₁ : _ ≤ _, hx₂ : _ < _⟩,
        exact false.elim (hx₂.ne (eq_of_le_of_not_lt hx₁ (not_lt.2 hx₂.le)).symm) }
    end
    ... ≤ snorm (indicator ({x | C ≤ ‖f i x‖₊}) (f i)) p μ + C * μ s ^ (1 / ennreal.to_real p) :
    begin
      refine add_le_add (snorm_mono $ λ x, norm_indicator_le_of_subset
        (inter_subset_right _ _) _ _) _,
      rw ← indicator_indicator,
      rw snorm_indicator_eq_snorm_restrict,
      have : ∀ᵐ x ∂(μ.restrict s), ‖({x : α | ‖f i x‖₊ < C}).indicator (f i) x‖ ≤ C,
      { refine ae_of_all _ _,
        simp_rw norm_indicator_eq_indicator_norm,
        exact indicator_le' (λ x (hx : _ < _), hx.le) (λ _ _, nnreal.coe_nonneg _) },
      refine le_trans (snorm_le_of_ae_bound this) _,
      rw [mul_comm, measure.restrict_apply' hs, univ_inter,
        ennreal.of_real_coe_nnreal, one_div],
      exacts [le_rfl, hs],
    end
    ... ≤ ennreal.of_real (ε / 2) + C * ennreal.of_real (ε / (2 * C)) :
    begin
      refine add_le_add (hC i) (mul_le_mul_left' _ _),
      rwa [ennreal.rpow_one_div_le_iff (ennreal.to_real_pos hpzero hp'),
        ennreal.of_real_rpow_of_pos (div_pos hε (mul_pos two_pos (nnreal.coe_pos.2 hCpos)))]
    end
    ... ≤ ennreal.of_real (ε / 2) + ennreal.of_real (ε / 2) :
    begin
      refine add_le_add_left _ _,
      rw [← ennreal.of_real_coe_nnreal, ← ennreal.of_real_mul (nnreal.coe_nonneg _),
        ← div_div, mul_div_cancel' _ (nnreal.coe_pos.2 hCpos).ne.symm],
      exact le_rfl,
    end
    ... ≤ ennreal.of_real ε :
    begin
      rw [← ennreal.of_real_add (half_pos hε).le (half_pos hε).le, add_halves],
      exact le_rfl,
    end
end

lemma unif_integrable_of (hp : 1 ≤ p) (hp' : p ≠ ∞) {f : ι → α → β}
  (hf : ∀ i, ae_strongly_measurable (f i) μ)
  (h : ∀ ε : ℝ, 0 < ε → ∃ C : ℝ≥0,
    ∀ i, snorm ({x | C ≤ ‖f i x‖₊}.indicator (f i)) p μ ≤ ennreal.of_real ε) :
  unif_integrable f p μ :=
begin
  set g : ι → α → β := λ i, (hf i).some,
  refine (unif_integrable_of' μ hp hp' (λ i, (Exists.some_spec $hf i).1) (λ ε hε, _)).ae_eq
    (λ i, (Exists.some_spec $ hf i).2.symm),
  obtain ⟨C, hC⟩ := h ε hε,
  have hCg : ∀ i, snorm ({x | C ≤ ‖g i x‖₊}.indicator (g i)) p μ ≤ ennreal.of_real ε,
  { intro i,
    refine le_trans (le_of_eq $ snorm_congr_ae _) (hC i),
    filter_upwards [(Exists.some_spec $ hf i).2] with x hx,
    by_cases hfx : x ∈ {x | C ≤ ‖f i x‖₊},
    { rw [indicator_of_mem hfx, indicator_of_mem, hx],
      rwa [mem_set_of, hx] at hfx },
    { rw [indicator_of_not_mem hfx, indicator_of_not_mem],
      rwa [mem_set_of, hx] at hfx } },
  refine ⟨max C 1, lt_max_of_lt_right one_pos, λ i, le_trans (snorm_mono (λ x, _)) (hCg i)⟩,
  rw [norm_indicator_eq_indicator_norm, norm_indicator_eq_indicator_norm],
  exact indicator_le_indicator_of_subset
    (λ x hx, le_trans (le_max_left _ _) hx) (λ _, norm_nonneg _) _,
end

end unif_integrable

section uniform_integrable

/-! `uniform_integrable`

In probability theory, uniform integrability normally refers to the condition that a sequence
of function `(fₙ)` satisfies for all `ε > 0`, there exists some `C ≥ 0` such that
`∫ x in {|fₙ| ≥ C}, fₙ x ∂μ ≤ ε` for all `n`.

In this section, we will develope some API for `uniform_integrable` and prove that
`uniform_integrable` is equivalent to this definition of uniform integrability.
-/

variables {p : ℝ≥0∞} {f : ι → α → β}

lemma uniform_integrable_zero_meas [measurable_space α] :
  uniform_integrable f p (0 : measure α) :=
⟨λ n, ae_strongly_measurable_zero_measure _,
  unif_integrable_zero_meas, 0, λ i, snorm_measure_zero.le⟩

lemma uniform_integrable.ae_eq {g : ι → α → β}
  (hf : uniform_integrable f p μ) (hfg : ∀ n, f n =ᵐ[μ] g n) :
  uniform_integrable g p μ :=
begin
  obtain ⟨hfm, hunif, C, hC⟩ := hf,
  refine ⟨λ i, (hfm i).congr (hfg i), (unif_integrable_congr_ae hfg).1 hunif, C, λ i, _⟩,
  rw ← snorm_congr_ae (hfg i),
  exact hC i
end

lemma uniform_integrable_congr_ae {g : ι → α → β}
  (hfg : ∀ n, f n =ᵐ[μ] g n) :
  uniform_integrable f p μ ↔ uniform_integrable g p μ :=
⟨λ h, h.ae_eq hfg, λ h, h.ae_eq (λ i, (hfg i).symm)⟩

/-- A finite sequence of Lp functions is uniformly integrable in the probability sense. -/
lemma uniform_integrable_finite [finite ι] (hp_one : 1 ≤ p) (hp_top : p ≠ ∞)
  (hf : ∀ i, mem_ℒp (f i) p μ) :
  uniform_integrable f p μ :=
begin
  casesI nonempty_fintype ι,
  refine ⟨λ n, (hf n).1, unif_integrable_finite μ hp_one hp_top hf, _⟩,
  by_cases hι : nonempty ι,
  { choose ae_meas hf using hf,
    set C := (finset.univ.image (λ i : ι, snorm (f i) p μ)).max'
      ⟨snorm (f hι.some) p μ, finset.mem_image.2 ⟨hι.some, finset.mem_univ _, rfl⟩⟩,
    refine ⟨C.to_nnreal, λ i, _⟩,
    rw ennreal.coe_to_nnreal,
    { exact finset.le_max' _ _ (finset.mem_image.2 ⟨i, finset.mem_univ _, rfl⟩) },
    { refine ne_of_lt ((finset.max'_lt_iff _ _).2 (λ y hy, _)),
      rw finset.mem_image at hy,
      obtain ⟨i, -, rfl⟩ := hy,
      exact hf i } },
  { exact ⟨0, λ i, false.elim $ hι $ nonempty.intro i⟩ }
end

/-- A single function is uniformly integrable in the probability sense. -/
lemma uniform_integrable_subsingleton [subsingleton ι] (hp_one : 1 ≤ p) (hp_top : p ≠ ∞)
  (hf : ∀ i, mem_ℒp (f i) p μ) :
  uniform_integrable f p μ :=
uniform_integrable_finite hp_one hp_top hf

/-- A constant sequence of functions is uniformly integrable in the probability sense. -/
lemma uniform_integrable_const {g : α → β} (hp : 1 ≤ p) (hp_ne_top : p ≠ ∞)
  (hg : mem_ℒp g p μ) :
  uniform_integrable (λ n : ι, g) p μ :=
⟨λ i, hg.1, unif_integrable_const μ hp hp_ne_top hg,
  ⟨(snorm g p μ).to_nnreal, λ i, le_of_eq (ennreal.coe_to_nnreal hg.2.ne).symm⟩⟩

/-- This lemma is superceded by `uniform_integrable_of` which only requires
`ae_strongly_measurable`. -/
lemma uniform_integrable_of' [is_finite_measure μ] (hp : 1 ≤ p) (hp' : p ≠ ∞)
  (hf : ∀ i, strongly_measurable (f i))
  (h : ∀ ε : ℝ, 0 < ε → ∃ C : ℝ≥0,
    ∀ i, snorm ({x | C ≤ ‖f i x‖₊}.indicator (f i)) p μ ≤ ennreal.of_real ε) :
  uniform_integrable f p μ :=
begin
  refine ⟨λ i, (hf i).ae_strongly_measurable,
    unif_integrable_of μ hp hp' (λ i, (hf i).ae_strongly_measurable) h, _⟩,
  obtain ⟨C, hC⟩ := h 1 one_pos,
  refine ⟨(C * (μ univ ^ (p.to_real⁻¹)) + 1 : ℝ≥0∞).to_nnreal, λ i, _⟩,
  calc snorm (f i) p μ ≤ snorm ({x : α | ‖f i x‖₊ < C}.indicator (f i)) p μ +
    snorm ({x : α | C ≤ ‖f i x‖₊}.indicator (f i)) p μ :
  begin
    refine le_trans (snorm_mono (λ x, _)) (snorm_add_le
      (strongly_measurable.ae_strongly_measurable ((hf i).indicator
      ((hf i).nnnorm.measurable_set_lt strongly_measurable_const)))
      (strongly_measurable.ae_strongly_measurable ((hf i).indicator
      (strongly_measurable_const.measurable_set_le (hf i).nnnorm))) hp),
    { rw [pi.add_apply, indicator_apply],
      split_ifs with hx,
      { rw [indicator_of_not_mem, add_zero],
        simpa using hx },
      { rw [indicator_of_mem, zero_add],
        simpa using hx } }
  end
  ... ≤ C * μ univ ^ (p.to_real⁻¹) + 1 :
  begin
    have : ∀ᵐ x ∂μ, ‖{x : α | ‖f i x‖₊ < C}.indicator (f i) x‖₊ ≤ C,
    { refine eventually_of_forall _,
      simp_rw nnnorm_indicator_eq_indicator_nnnorm,
      exact indicator_le (λ x (hx : _ < _), hx.le) },
    refine add_le_add (le_trans (snorm_le_of_ae_bound this) _) (ennreal.of_real_one ▸ (hC i)),
    rw [ennreal.of_real_coe_nnreal, mul_comm],
    exact le_rfl,
  end
  ... = (C * (μ univ ^ (p.to_real⁻¹)) + 1 : ℝ≥0∞).to_nnreal :
  begin
    rw ennreal.coe_to_nnreal,
    exact ennreal.add_ne_top.2 ⟨ennreal.mul_ne_top ennreal.coe_ne_top
      (ennreal.rpow_ne_top_of_nonneg (inv_nonneg.2 ennreal.to_real_nonneg)
      (measure_lt_top _ _).ne), ennreal.one_ne_top⟩,
  end
end

/-- A sequene of functions `(fₙ)` is uniformly integrable in the probability sense if for all
`ε > 0`, there exists some `C` such that `∫ x in {|fₙ| ≥ C}, fₙ x ∂μ ≤ ε` for all `n`. -/
lemma uniform_integrable_of [is_finite_measure μ] (hp : 1 ≤ p) (hp' : p ≠ ∞)
  (hf : ∀ i, ae_strongly_measurable (f i) μ)
  (h : ∀ ε : ℝ, 0 < ε → ∃ C : ℝ≥0,
    ∀ i, snorm ({x | C ≤ ‖f i x‖₊}.indicator (f i)) p μ ≤ ennreal.of_real ε) :
  uniform_integrable f p μ :=
begin
  set g : ι → α → β := λ i, (hf i).some,
  have hgmeas : ∀ i, strongly_measurable (g i) := λ i, (Exists.some_spec $ hf i).1,
  have hgeq : ∀ i, g i =ᵐ[μ] f i := λ i, (Exists.some_spec $ hf i).2.symm,
  refine (uniform_integrable_of' hp hp' hgmeas $ λ ε hε, _).ae_eq hgeq,
  obtain ⟨C, hC⟩ := h ε hε,
  refine ⟨C, λ i, le_trans (le_of_eq $ snorm_congr_ae _) (hC i)⟩,
  filter_upwards [(Exists.some_spec $ hf i).2] with x hx,
  by_cases hfx : x ∈ {x | C ≤ ‖f i x‖₊},
  { rw [indicator_of_mem hfx, indicator_of_mem, hx],
    rwa [mem_set_of, hx] at hfx },
  { rw [indicator_of_not_mem hfx, indicator_of_not_mem],
    rwa [mem_set_of, hx] at hfx }
end

/-- This lemma is superceded by `uniform_integrable.spec` which does not require measurability. -/
lemma uniform_integrable.spec' (hp : p ≠ 0) (hp' : p ≠ ∞)
  (hf : ∀ i, strongly_measurable (f i))
  (hfu : uniform_integrable f p μ) {ε : ℝ} (hε : 0 < ε) :
  ∃ C : ℝ≥0, ∀ i, snorm ({x | C ≤ ‖f i x‖₊}.indicator (f i)) p μ ≤ ennreal.of_real ε :=
begin
  obtain ⟨-, hfu, M, hM⟩ := hfu,
  obtain ⟨δ, hδpos, hδ⟩ := hfu hε,
  obtain ⟨C, hC⟩ : ∃ C : ℝ≥0, ∀ i, μ {x | C ≤ ‖f i x‖₊} ≤ ennreal.of_real δ,
  { by_contra hcon, push_neg at hcon,
    choose ℐ hℐ using hcon,
    lift δ to ℝ≥0 using hδpos.le,
    have : ∀ C : ℝ≥0, C • (δ : ℝ≥0∞) ^ (1 / p.to_real) ≤ snorm (f (ℐ C)) p μ,
    { intros C,
      calc C • (δ : ℝ≥0∞) ^ (1 / p.to_real) ≤ C • μ {x | C ≤ ‖f (ℐ C) x‖₊} ^ (1 / p.to_real):
      begin
        rw [ennreal.smul_def, ennreal.smul_def, smul_eq_mul, smul_eq_mul],
        simp_rw ennreal.of_real_coe_nnreal at hℐ,
        refine mul_le_mul' le_rfl (ennreal.rpow_le_rpow (hℐ C).le
          (one_div_nonneg.2 ennreal.to_real_nonneg)),
      end
      ... ≤ snorm ({x | C ≤ ‖f (ℐ C) x‖₊}.indicator (f (ℐ C))) p μ :
      begin
        refine snorm_indicator_ge_of_bdd_below hp hp' _
          (measurable_set_le measurable_const (hf _).nnnorm.measurable)
          (eventually_of_forall $ λ x hx, _),
        rwa [nnnorm_indicator_eq_indicator_nnnorm, indicator_of_mem hx],
      end
      ... ≤ snorm (f (ℐ C)) p μ : snorm_indicator_le _ },
    specialize this ((2 * (max M 1) * (δ⁻¹ ^ (1 / p.to_real)))),
    rw [ennreal.coe_rpow_of_nonneg _ (one_div_nonneg.2 ennreal.to_real_nonneg),
      ← ennreal.coe_smul, smul_eq_mul, mul_assoc, nnreal.inv_rpow,
      inv_mul_cancel (nnreal.rpow_pos (nnreal.coe_pos.1 hδpos)).ne.symm, mul_one,
      ennreal.coe_mul, ← nnreal.inv_rpow] at this,
    refine (lt_of_le_of_lt (le_trans (hM $ ℐ $ 2 * (max M 1) * (δ⁻¹ ^ (1 / p.to_real)))
      (le_max_left M 1)) (lt_of_lt_of_le _ this)).ne rfl,
    rw [← ennreal.coe_one, ← with_top.coe_max, ← ennreal.coe_mul, ennreal.coe_lt_coe],
    exact lt_two_mul_self (lt_max_of_lt_right one_pos) },
  exact ⟨C, λ i, hδ i _ (measurable_set_le measurable_const (hf i).nnnorm.measurable) (hC i)⟩,
end

lemma uniform_integrable.spec (hp : p ≠ 0) (hp' : p ≠ ∞)
  (hfu : uniform_integrable f p μ) {ε : ℝ} (hε : 0 < ε) :
  ∃ C : ℝ≥0, ∀ i, snorm ({x | C ≤ ‖f i x‖₊}.indicator (f i)) p μ ≤ ennreal.of_real ε :=
begin
  set g : ι → α → β := λ i, (hfu.1 i).some,
  have hgmeas : ∀ i, strongly_measurable (g i) := λ i, (Exists.some_spec $ hfu.1 i).1,
  have hgunif : uniform_integrable g p μ := hfu.ae_eq (λ i, (Exists.some_spec $ hfu.1 i).2),
  obtain ⟨C, hC⟩ := hgunif.spec' hp hp' hgmeas hε,
  refine ⟨C, λ i, le_trans (le_of_eq $ snorm_congr_ae _) (hC i)⟩,
  filter_upwards [(Exists.some_spec $ hfu.1 i).2] with x hx,
  by_cases hfx : x ∈ {x | C ≤ ‖f i x‖₊},
  { rw [indicator_of_mem hfx, indicator_of_mem, hx],
    rwa [mem_set_of, hx] at hfx },
  { rw [indicator_of_not_mem hfx, indicator_of_not_mem],
    rwa [mem_set_of, hx] at hfx }
end

/-- The definition of uniform integrable in mathlib is equivalent to the definition commonly
found in literature. -/
lemma uniform_integrable_iff [is_finite_measure μ] (hp : 1 ≤ p) (hp' : p ≠ ∞) :
  uniform_integrable f p μ ↔ (∀ i, ae_strongly_measurable (f i) μ) ∧
  ∀ ε : ℝ, 0 < ε → ∃ C : ℝ≥0,
    ∀ i, snorm ({x | C ≤ ‖f i x‖₊}.indicator (f i)) p μ ≤ ennreal.of_real ε  :=
⟨λ h, ⟨h.1, λ ε, h.spec (lt_of_lt_of_le zero_lt_one hp).ne.symm hp'⟩,
 λ h, uniform_integrable_of hp hp' h.1 h.2⟩

/-- The averaging of a uniformly integrable sequence is also uniformly integrable. -/

end uniform_integrable

end measure_theory


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

import field_theory.splitting_field
import field_theory.perfect_closure
import field_theory.separable

/-!
# Algebraically Closed Field

In this file we define the typeclass for algebraically closed fields and algebraic closures,
and prove some of their properties.

## Main Definitions

- `is_alg_closed k` is the typeclass saying `k` is an algebraically closed field, i.e. every
polynomial in `k` splits.

- `is_alg_closure R K` is the typeclass saying `K` is an algebraic closure of `R`, where `R` is a
  commutative ring. This means that the map from `R` to `K` is injective, and `K` is
  algebraically closed and algebraic over `R`

- `is_alg_closed.lift` is a map from an algebraic extension `L` of `R`, into any algebraically
  closed extension of `R`.

- `is_alg_closure.equiv` is a proof that any two algebraic closures of the
  same field are isomorphic.

## Tags

algebraic closure, algebraically closed

-/
universes u v w

open_locale classical big_operators polynomial
open polynomial

variables (k : Type u) [field k]

/-- Typeclass for algebraically closed fields.

To show `polynomial.splits p f` for an arbitrary ring homomorphism `f`,
see `is_alg_closed.splits_codomain` and `is_alg_closed.splits_domain`.
-/
class is_alg_closed : Prop :=
(splits : ∀ p : k[X], p.splits $ ring_hom.id k)

/-- Every polynomial splits in the field extension `f : K →+* k` if `k` is algebraically closed.

See also `is_alg_closed.splits_domain` for the case where `K` is algebraically closed.
-/
theorem is_alg_closed.splits_codomain {k K : Type*} [field k] [is_alg_closed k] [field K]
  {f : K →+* k} (p : K[X]) : p.splits f :=
by { convert is_alg_closed.splits (p.map f), simp [splits_map_iff] }

/-- Every polynomial splits in the field extension `f : K →+* k` if `K` is algebraically closed.

See also `is_alg_closed.splits_codomain` for the case where `k` is algebraically closed.
-/
theorem is_alg_closed.splits_domain {k K : Type*} [field k] [is_alg_closed k] [field K]
  {f : k →+* K} (p : k[X]) : p.splits f :=
polynomial.splits_of_splits_id _ $ is_alg_closed.splits _

namespace is_alg_closed

variables {k}

theorem exists_root [is_alg_closed k] (p : k[X]) (hp : p.degree ≠ 0) : ∃ x, is_root p x :=
exists_root_of_splits _ (is_alg_closed.splits p) hp

lemma exists_pow_nat_eq [is_alg_closed k] (x : k) {n : ℕ} (hn : 0 < n) : ∃ z, z ^ n = x :=
begin
  rcases exists_root (X ^ n - C x) _ with ⟨z, hz⟩, swap,
  { rw degree_X_pow_sub_C hn x,
    exact ne_of_gt (with_bot.coe_lt_coe.2 hn) },
  use z,
  simp only [eval_C, eval_X, eval_pow, eval_sub, is_root.def] at hz,
  exact sub_eq_zero.1 hz
end

lemma exists_eq_mul_self [is_alg_closed k] (x : k) : ∃ z, x = z * z :=
begin
  rcases exists_pow_nat_eq x zero_lt_two with ⟨z, rfl⟩,
  exact ⟨z, sq z⟩
end

theorem exists_eval₂_eq_zero_of_injective {R : Type*} [ring R] [is_alg_closed k] (f : R →+* k)
  (hf : function.injective f) (p : R[X]) (hp : p.degree ≠ 0) : ∃ x, p.eval₂ f x = 0 :=
let ⟨x, hx⟩ := exists_root (p.map f) (by rwa [degree_map_eq_of_injective hf]) in
⟨x, by rwa [eval₂_eq_eval_map, ← is_root]⟩

theorem exists_eval₂_eq_zero {R : Type*} [field R] [is_alg_closed k] (f : R →+* k)
  (p : R[X]) (hp : p.degree ≠ 0) : ∃ x, p.eval₂ f x = 0 :=
exists_eval₂_eq_zero_of_injective f f.injective p hp

variables (k)

theorem exists_aeval_eq_zero_of_injective {R : Type*} [comm_ring R] [is_alg_closed k] [algebra R k]
  (hinj : function.injective (algebra_map R k)) (p : R[X]) (hp : p.degree ≠ 0) :
  ∃ x : k, aeval x p = 0 :=
exists_eval₂_eq_zero_of_injective (algebra_map R k) hinj p hp

theorem exists_aeval_eq_zero {R : Type*} [field R] [is_alg_closed k] [algebra R k]
  (p : R[X]) (hp : p.degree ≠ 0) : ∃ x : k, aeval x p = 0 :=
exists_eval₂_eq_zero (algebra_map R k) p hp

theorem of_exists_root (H : ∀ p : k[X], p.monic → irreducible p → ∃ x, p.eval x = 0) :
  is_alg_closed k :=
⟨λ p, or.inr $ λ q hq hqp,
 have irreducible (q * C (leading_coeff q)⁻¹),
   by { rw ← coe_norm_unit_of_ne_zero hq.ne_zero,
        exact (associated_normalize _).irreducible hq },
 let ⟨x, hx⟩ := H (q * C (leading_coeff q)⁻¹) (monic_mul_leading_coeff_inv hq.ne_zero) this in
 degree_mul_leading_coeff_inv q hq.ne_zero ▸ degree_eq_one_of_irreducible_of_root this hx⟩

lemma degree_eq_one_of_irreducible [is_alg_closed k] {p : k[X]}
  (hp : irreducible p) :
  p.degree = 1 :=
degree_eq_one_of_irreducible_of_splits hp (is_alg_closed.splits_codomain _)

lemma algebra_map_surjective_of_is_integral {k K : Type*} [field k] [ring K] [is_domain K]
  [hk : is_alg_closed k] [algebra k K] (hf : algebra.is_integral k K) :
  function.surjective (algebra_map k K) :=
begin
  refine λ x, ⟨-((minpoly k x).coeff 0), _⟩,
  have hq : (minpoly k x).leading_coeff = 1 := minpoly.monic (hf x),
  have h : (minpoly k x).degree = 1 := degree_eq_one_of_irreducible k
    (minpoly.irreducible (hf x)),
  have : (aeval x (minpoly k x)) = 0 := minpoly.aeval k x,
  rw [eq_X_add_C_of_degree_eq_one h, hq, C_1, one_mul,
    aeval_add, aeval_X, aeval_C, add_eq_zero_iff_eq_neg] at this,
  exact (ring_hom.map_neg (algebra_map k K) ((minpoly k x).coeff 0)).symm ▸ this.symm,
end

lemma algebra_map_surjective_of_is_integral'
  {k K : Type*} [field k] [comm_ring K] [is_domain K]
  [hk : is_alg_closed k] (f : k →+* K) (hf : f.is_integral) : function.surjective f :=
@algebra_map_surjective_of_is_integral k K _ _ _ _ f.to_algebra hf

lemma algebra_map_surjective_of_is_algebraic {k K : Type*} [field k] [ring K] [is_domain K]
  [hk : is_alg_closed k] [algebra k K] (hf : algebra.is_algebraic k K) :
  function.surjective (algebra_map k K) :=
algebra_map_surjective_of_is_integral (algebra.is_algebraic_iff_is_integral.mp hf)

end is_alg_closed

/-- Typeclass for an extension being an algebraic closure. -/
class is_alg_closure (R : Type u) (K : Type v) [comm_ring R]
  [field K] [algebra R K] [no_zero_smul_divisors R K] : Prop :=
(alg_closed : is_alg_closed K)
(algebraic : algebra.is_algebraic R K)

theorem is_alg_closure_iff (K : Type v) [field K] [algebra k K] :
  is_alg_closure k K ↔ is_alg_closed K ∧ algebra.is_algebraic k K :=
⟨λ h, ⟨h.1, h.2⟩, λ h, ⟨h.1, h.2⟩⟩

namespace lift

/- In this section, the homomorphism from any algebraic extension into an algebraically
  closed extension is proven to exist. The assumption that M is algebraically closed could probably
  easily be switched to an assumption that M contains all the roots of polynomials in K -/
variables {K : Type u} {L : Type v} {M : Type w} [field K] [field L] [algebra K L]
  [field M] [algebra K M] [is_alg_closed M] (hL : algebra.is_algebraic K L)

variables (K L M)
include hL
open subalgebra alg_hom function

/-- This structure is used to prove the existence of a homomorphism from any algebraic extension
into an algebraic closure -/
structure subfield_with_hom :=
(carrier : subalgebra K L)
(emb : carrier →ₐ[K] M)

variables {K L M hL}

namespace subfield_with_hom
variables {E₁ E₂ E₃ : subfield_with_hom K L M hL}

instance : has_le (subfield_with_hom K L M hL) :=
{ le := λ E₁ E₂, ∃ h : E₁.carrier ≤ E₂.carrier, ∀ x, E₂.emb (inclusion h x) = E₁.emb x }

noncomputable instance : inhabited (subfield_with_hom K L M hL) :=
⟨{ carrier := ⊥,
   emb := (algebra.of_id K M).comp (algebra.bot_equiv K L).to_alg_hom }⟩

lemma le_def : E₁ ≤ E₂ ↔ ∃ h : E₁.carrier ≤ E₂.carrier, ∀ x, E₂.emb (inclusion h x) = E₁.emb x :=
iff.rfl

lemma compat (h : E₁ ≤ E₂) : ∀ x, E₂.emb (inclusion h.fst x) = E₁.emb x :=
by { rw le_def at h, cases h, assumption }

instance : preorder (subfield_with_hom K L M hL) :=
{ le := (≤),
  le_refl := λ E, ⟨le_rfl, by simp⟩,
  le_trans := λ E₁ E₂ E₃ h₁₂ h₂₃,
    ⟨le_trans h₁₂.fst h₂₃.fst,
    λ _, by erw [← inclusion_inclusion h₁₂.fst h₂₃.fst, compat, compat]⟩ }

open lattice

lemma maximal_subfield_with_hom_chain_bounded (c : set (subfield_with_hom K L M hL))
  (hc : is_chain (≤) c) :
  ∃ ub : subfield_with_hom K L M hL, ∀ N, N ∈ c → N ≤ ub :=
if hcn : c.nonempty then
let ub : subfield_with_hom K L M hL :=
by haveI : nonempty c := set.nonempty.to_subtype hcn; exact
{ carrier := ⨆ i : c, (i : subfield_with_hom K L M hL).carrier,
  emb := subalgebra.supr_lift
    (λ i : c, (i : subfield_with_hom K L M hL).carrier)
    (λ i j, let ⟨k, hik, hjk⟩ := directed_on_iff_directed.1 hc.directed_on i j in
      ⟨k, hik.fst, hjk.fst⟩)
    (λ i, (i : subfield_with_hom K L M hL).emb)
    begin
      assume i j h,
      ext x,
      cases hc.total i.prop j.prop with hij hji,
      { simp [← hij.snd x] },
      { erw [alg_hom.comp_apply, ← hji.snd (inclusion h x),
          inclusion_inclusion, inclusion_self, alg_hom.id_apply x] }
    end _ rfl } in
⟨ub, λ N hN, ⟨(le_supr (λ i : c, (i : subfield_with_hom K L M hL).carrier) ⟨N, hN⟩ : _),
  begin
    intro x,
    simp [ub],
    refl
  end⟩⟩
else by { rw [set.not_nonempty_iff_eq_empty] at hcn, simp [hcn], }

variables (hL M)

lemma exists_maximal_subfield_with_hom : ∃ E : subfield_with_hom K L M hL,
  ∀ N, E ≤ N → N ≤ E :=
exists_maximal_of_chains_bounded
  maximal_subfield_with_hom_chain_bounded (λ _ _ _, le_trans)

/-- The maximal `subfield_with_hom`. We later prove that this is equal to `⊤`. -/
noncomputable def maximal_subfield_with_hom : subfield_with_hom K L M hL :=
classical.some (exists_maximal_subfield_with_hom M hL)

lemma maximal_subfield_with_hom_is_maximal :
  ∀ (N : subfield_with_hom K L M hL),
    (maximal_subfield_with_hom M hL) ≤ N → N ≤ (maximal_subfield_with_hom M hL) :=
classical.some_spec (exists_maximal_subfield_with_hom M hL)

lemma maximal_subfield_with_hom_eq_top :
  (maximal_subfield_with_hom M hL).carrier = ⊤ :=
begin
  rw [eq_top_iff],
  intros x _,
  let p := minpoly K x,
  let N : subalgebra K L := (maximal_subfield_with_hom M hL).carrier,
  letI : field N := (subalgebra.is_field_of_algebraic N hL).to_field,
  letI : algebra N M := (maximal_subfield_with_hom M hL).emb.to_ring_hom.to_algebra,
  cases is_alg_closed.exists_aeval_eq_zero M (minpoly N x)
    (ne_of_gt (minpoly.degree_pos
      (is_algebraic_iff_is_integral.1
        (algebra.is_algebraic_of_larger_base _ _ hL x)))) with y hy,
  let O : subalgebra N L := algebra.adjoin N {(x : L)},
  let larger_emb := ((adjoin_root.lift_hom (minpoly N x) y hy).comp
     (alg_equiv.adjoin_singleton_equiv_adjoin_root_minpoly N x).to_alg_hom),
  have hNO : N ≤ O.restrict_scalars K,
  { intros z hz,
    show algebra_map N L ⟨z, hz⟩ ∈ O,
    exact O.algebra_map_mem _ },
  let O' : subfield_with_hom K L M hL :=
  { carrier := O.restrict_scalars K,
    emb := larger_emb.restrict_scalars K },
  have hO' : maximal_subfield_with_hom M hL ≤ O',
  { refine ⟨hNO, _⟩,
    intros z,
    show O'.emb (algebra_map N O z) = algebra_map N M z,
    simp only [O', restrict_scalars_apply, alg_hom.commutes] },
  refine (maximal_subfield_with_hom_is_maximal M hL O' hO').fst _,
  exact algebra.subset_adjoin (set.mem_singleton x),
end

end subfield_with_hom
end lift

namespace is_alg_closed

variables {K : Type u} [field K] {L : Type v} {M : Type w} [field L] [algebra K L]
  [field M] [algebra K M] [is_alg_closed M] (hL : algebra.is_algebraic K L)

variables (K L M)
include hL

/-- Less general version of `lift`. -/
@[irreducible] private noncomputable def lift_aux : L →ₐ[K] M :=
(lift.subfield_with_hom.maximal_subfield_with_hom M hL).emb.comp $
  eq.rec_on (lift.subfield_with_hom.maximal_subfield_with_hom_eq_top M hL).symm algebra.to_top

omit hL

variables {R : Type u} [comm_ring R]
variables {S : Type v} [comm_ring S] [is_domain S] [algebra R S]
  [algebra R M] [no_zero_smul_divisors R S]
  [no_zero_smul_divisors R M]
  (hS : algebra.is_algebraic R S)
variables {M}

include hS

/-- A (random) homomorphism from an algebraic extension of R into an algebraically
  closed extension of R. -/

@[irreducible] noncomputable def lift : S →ₐ[R] M :=
begin
  letI : is_domain R := (no_zero_smul_divisors.algebra_map_injective R S).is_domain _,
  have hfRfS : algebra.is_algebraic (fraction_ring R) (fraction_ring S),
    from λ x, (is_fraction_ring.is_algebraic_iff R (fraction_ring R) (fraction_ring S)).1
      ((is_fraction_ring.is_algebraic_iff' R S (fraction_ring S)).1 hS x),
  let f : fraction_ring S →ₐ[fraction_ring R] M :=
    lift_aux (fraction_ring R) (fraction_ring S) M hfRfS,
  exact (f.restrict_scalars R).comp ((algebra.of_id S (fraction_ring S)).restrict_scalars R),
end

omit hS
@[priority 100]
noncomputable instance perfect_ring (p : ℕ) [fact p.prime] [char_p k p]
  [is_alg_closed k] : perfect_ring k p :=
perfect_ring.of_surjective k p $ λ x, is_alg_closed.exists_pow_nat_eq _ $ fact.out _

/-- Algebraically closed fields are infinite since `Xⁿ⁺¹ - 1` is separable when `#K = n` -/
@[priority 500]
instance {K : Type*} [field K] [is_alg_closed K] : infinite K :=
begin
  apply infinite.mk,
  introsI hfin,
  set n := fintype.card K with hn,
  set f := (X : K[X]) ^ (n + 1) - 1 with hf,
  have hfsep : separable f := separable_X_pow_sub_C 1 (by simp) one_ne_zero,
  apply nat.not_succ_le_self (fintype.card K),
  have hroot : n.succ = fintype.card (f.root_set K),
  { erw [card_root_set_eq_nat_degree hfsep (is_alg_closed.splits_domain _),
         nat_degree_X_pow_sub_C] },
  rw hroot,
  exact fintype.card_le_of_injective coe subtype.coe_injective,
end

end is_alg_closed

namespace is_alg_closure

variables (K : Type*) (J : Type*) (R : Type u) (S : Type*) [field K] [field J] [comm_ring R]
  (L : Type v) (M : Type w) [field L] [field M] [algebra R M] [no_zero_smul_divisors R M]
  [is_alg_closure R M] [algebra K M] [is_alg_closure K M]
  [comm_ring S] [algebra S L] [no_zero_smul_divisors S L] [is_alg_closure S L]

local attribute [instance] is_alg_closure.alg_closed

section
variables [algebra R L] [no_zero_smul_divisors R L] [is_alg_closure R L]

/-- A (random) isomorphism between two algebraic closures of `R`. -/
noncomputable def equiv : L ≃ₐ[R] M :=
let f : L →ₐ[R] M := is_alg_closed.lift is_alg_closure.algebraic in
alg_equiv.of_bijective f
  ⟨ring_hom.injective f.to_ring_hom,
    begin
      letI : algebra L M := ring_hom.to_algebra f,
      letI : is_scalar_tower R L M :=
        is_scalar_tower.of_algebra_map_eq (by simp [ring_hom.algebra_map_to_algebra]),
      show function.surjective (algebra_map L M),
      exact is_alg_closed.algebra_map_surjective_of_is_algebraic
        (algebra.is_algebraic_of_larger_base_of_injective
          (no_zero_smul_divisors.algebra_map_injective R _) is_alg_closure.algebraic),
    end⟩

end

section equiv_of_algebraic

variables [algebra R S] [algebra R L] [is_scalar_tower R S L]
variables [algebra K J] [algebra J L] [is_alg_closure J L] [algebra K L]
  [is_scalar_tower K J L]

/-- A (random) isomorphism between an algebraic closure of `R` and an algebraic closure of
  an algebraic extension of `R` -/
noncomputable def equiv_of_algebraic' [nontrivial S] [no_zero_smul_divisors R S]
  (hRL : algebra.is_algebraic R L) : L ≃ₐ[R] M :=
begin
  letI : no_zero_smul_divisors R L :=
    no_zero_smul_divisors.of_algebra_map_injective begin
      rw [is_scalar_tower.algebra_map_eq R S L],
      exact function.injective.comp
        (no_zero_smul_divisors.algebra_map_injective _ _)
        (no_zero_smul_divisors.algebra_map_injective _ _)
    end,
  letI : is_alg_closure R L :=
  { alg_closed := by apply_instance,
    algebraic := hRL },
  exact is_alg_closure.equiv _ _ _
end

/-- A (random) isomorphism between an algebraic closure of `K` and an algebraic closure
  of an algebraic extension of `K` -/
noncomputable def equiv_of_algebraic (hKJ : algebra.is_algebraic K J) : L ≃ₐ[K] M :=
equiv_of_algebraic' K J _ _ (algebra.is_algebraic_trans hKJ is_alg_closure.algebraic)

end equiv_of_algebraic

section equiv_of_equiv

variables {R S}

/-- Used in the definition of `equiv_of_equiv` -/
noncomputable def equiv_of_equiv_aux (hSR : S ≃+* R) :
  { e : L ≃+* M // e.to_ring_hom.comp (algebra_map S L) =
    (algebra_map R M).comp hSR.to_ring_hom }:=
begin
  letI : algebra R S := ring_hom.to_algebra hSR.symm.to_ring_hom,
  letI : algebra S R := ring_hom.to_algebra hSR.to_ring_hom,
  letI : is_domain R := (no_zero_smul_divisors.algebra_map_injective R M).is_domain _,
  letI : is_domain S := (no_zero_smul_divisors.algebra_map_injective S L).is_domain _,
  have : algebra.is_algebraic R S,
    from λ x, begin
      rw [← ring_equiv.symm_apply_apply hSR x],
      exact is_algebraic_algebra_map _
    end,
  letI : algebra R L := ring_hom.to_algebra ((algebra_map S L).comp (algebra_map R S)),
  haveI : is_scalar_tower R S L := is_scalar_tower.of_algebra_map_eq (λ _, rfl),
  haveI : is_scalar_tower S R L := is_scalar_tower.of_algebra_map_eq
    (by simp [ring_hom.algebra_map_to_algebra]),
  haveI : no_zero_smul_divisors R S :=
    no_zero_smul_divisors.of_algebra_map_injective hSR.symm.injective,
  refine ⟨equiv_of_algebraic' R S L M (algebra.is_algebraic_of_larger_base_of_injective
      (show function.injective (algebra_map S R), from hSR.injective)
      is_alg_closure.algebraic) , _⟩,
  ext,
  simp only [ring_equiv.to_ring_hom_eq_coe, function.comp_app, ring_hom.coe_comp,
    alg_equiv.coe_ring_equiv, ring_equiv.coe_to_ring_hom],
  conv_lhs { rw [← hSR.symm_apply_apply x] },
  show equiv_of_algebraic' R S L M _ (algebra_map R L (hSR x)) = _,
  rw [alg_equiv.commutes]
end

/-- Algebraic closure of isomorphic fields are isomorphic -/
noncomputable def equiv_of_equiv (hSR : S ≃+* R) : L ≃+* M :=
equiv_of_equiv_aux L M hSR

@[simp] lemma equiv_of_equiv_comp_algebra_map (hSR : S ≃+* R) :
  (↑(equiv_of_equiv L M hSR) : L →+* M).comp (algebra_map S L) =
  (algebra_map R M).comp hSR :=
(equiv_of_equiv_aux L M hSR).2

@[simp] lemma equiv_of_equiv_algebra_map (hSR : S ≃+* R) (s : S):
  equiv_of_equiv L M hSR (algebra_map S L s) =
  algebra_map R M (hSR s) :=
ring_hom.ext_iff.1 (equiv_of_equiv_comp_algebra_map L M hSR) s

@[simp] lemma equiv_of_equiv_symm_algebra_map (hSR : S ≃+* R) (r : R):
  (equiv_of_equiv L M hSR).symm (algebra_map R M r) =
  algebra_map S L (hSR.symm r) :=
(equiv_of_equiv L M hSR).injective (by simp)

@[simp] lemma equiv_of_equiv_symm_comp_algebra_map (hSR : S ≃+* R) :
  ((equiv_of_equiv L M hSR).symm : M →+* L).comp (algebra_map R M) =
  (algebra_map S L).comp hSR.symm :=
ring_hom.ext_iff.2 (equiv_of_equiv_symm_algebra_map L M hSR)

end equiv_of_equiv

end is_alg_closure


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

! This file was ported from Lean 3 source module logic.equiv.nat
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Pairing

/-!
# Equivalences involving `ℕ`

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

This file defines some additional constructive equivalences using `encodable` and the pairing
function on `ℕ`.
-/

open Nat Function

namespace Equiv

variable {α : Type _}

#print Equiv.boolProdNatEquivNat /-
/-- An equivalence between `bool × ℕ` and `ℕ`, by mapping `(tt, x)` to `2 * x + 1` and `(ff, x)` to
`2 * x`.
-/
@[simps]
def boolProdNatEquivNat : Bool × ℕ ≃ ℕ
    where
  toFun := uncurry bit
  invFun := boddDiv2
  left_inv := fun ⟨b, n⟩ => by simp only [bodd_bit, div2_bit, uncurry_apply_pair, bodd_div2_eq]
  right_inv n := by simp only [bit_decomp, bodd_div2_eq, uncurry_apply_pair]
#align equiv.bool_prod_nat_equiv_nat Equiv.boolProdNatEquivNat
-/

#print Equiv.natSumNatEquivNat /-
/-- An equivalence between `ℕ ⊕ ℕ` and `ℕ`, by mapping `(sum.inl x)` to `2 * x` and `(sum.inr x)` to
`2 * x + 1`.
-/
@[simps symm_apply]
def natSumNatEquivNat : Sum ℕ ℕ ≃ ℕ :=
  (boolProdEquivSum ℕ).symm.trans boolProdNatEquivNat
#align equiv.nat_sum_nat_equiv_nat Equiv.natSumNatEquivNat
-/

#print Equiv.natSumNatEquivNat_apply /-
@[simp]
theorem natSumNatEquivNat_apply : ⇑natSumNatEquivNat = Sum.elim bit0 bit1 := by ext (x | x) <;> rfl
#align equiv.nat_sum_nat_equiv_nat_apply Equiv.natSumNatEquivNat_apply
-/

#print Equiv.intEquivNat /-
/-- An equivalence between `ℤ` and `ℕ`, through `ℤ ≃ ℕ ⊕ ℕ` and `ℕ ⊕ ℕ ≃ ℕ`.
-/
def intEquivNat : ℤ ≃ ℕ :=
  intEquivNatSumNat.trans natSumNatEquivNat
#align equiv.int_equiv_nat Equiv.intEquivNat
-/

#print Equiv.prodEquivOfEquivNat /-
/-- An equivalence between `α × α` and `α`, given that there is an equivalence between `α` and `ℕ`.
-/
def prodEquivOfEquivNat (e : α ≃ ℕ) : α × α ≃ α :=
  calc
    α × α ≃ ℕ × ℕ := prodCongr e e
    _ ≃ ℕ := pairEquiv
    _ ≃ α := e.symm

#align equiv.prod_equiv_of_equiv_nat Equiv.prodEquivOfEquivNat
-/

end Equiv


import data.real.irrational Zalpha linear_algebra.basic
import data.real.basic data.nat.prime
import tactic.norm_num tactic.ring

noncomputable theory

open nat.prime

local attribute [instance] nat.decidable_prime_1
theorem prime_five : nat.prime 5 := dec_trivial

def αℝ := (real.sqrt 5 + 1) / 2

lemma αℝ_ne_zero : αℝ ≠ 0 :=
  begin
  unfold αℝ,
  apply ne.symm, simp,
  rw [eq_div_iff_mul_eq (0 : ℝ) _ two_ne_zero],
  apply ne.symm, simp,
  rw [← eq_sub_iff_add_eq],
  simp, rw [eq_neg_iff_eq_neg],
  intro h,
  suffices : (-1 < (0 : ℝ)),
    from ne_of_lt (lt_of_lt_of_le this (real.sqrt_nonneg 5)) (eq.symm h),
  apply lt_of_add_lt_add_right _, exact 1,
  simp, exact zero_lt_one,
  end

def to_real : ℤα → ℝ := λ z, z.1 + z.2 * αℝ

def irrat_ext_add {x : ℝ} (q : ℚ) : irrational x → irrational (x + q) :=
  begin
  intro h, intro nq, apply exists.elim nq, intro q', simp, intro hadd,
  have : x = q' - q, from eq_sub_of_add_eq hadd,
  rw this at h,
  have h2 : irrational q,
    revert h, simp,
  apply h2,
  existsi q,
  refl,
  end

def irrat_ext_mul {x : ℝ} (q : ℚ) : q ≠ 0 → irrational x → irrational (x / q) :=
  begin
  intro qne0, intro h, intro nq, apply exists.elim nq, intro q', simp, intro hmul,
  have qne0' : (↑ q : ℝ) ≠ 0, { simp, exact qne0, },
  have : x = q' * q, from eq.symm ((eq_div_iff_mul_eq _ _ qne0').1 (eq.symm hmul)),
  rw this at h,
  apply h,
  existsi (q' * q),
  simp,
  end

def irrat_ext_neg {x : ℝ} : irrational x → irrational (-x) :=
  begin
  intro h,
  have neg1ne0 := neg_ne_zero.2 (@one_ne_zero ℚ _),
  have := irrat_ext_mul (-1) neg1ne0 h,
  simp at this, rw [div_neg x (one_ne_zero), div_one] at this,
  exact this,
  end

def irrat_ext_inv {x : ℝ} : x ≠ 0 → irrational x → irrational (x⁻¹) :=
  begin
  intro xne0, intro h, intro nq, apply exists.elim nq, intro q, simp, intro hinv,
  rw [← division_ring.inv_inv xne0] at h,
  apply h, apply exists.intro (q⁻¹), rw hinv,
  exact eq.symm (rat.cast_inv q),
  end

section
open real rat
theorem sqrt_five_irrational : irrational (sqrt 5)
| ⟨⟨n, d, h, c⟩, e⟩ := begin
  simp [num_denom', mk_eq_div] at e,
  have := @mul_self_sqrt 5 (le_of_lt (add_pos four_pos zero_lt_one)),
  have d0 : (0:ℝ) < d := nat.cast_pos.2 h,
  rw [e, div_mul_div, div_eq_iff_mul_eq (ne_of_gt $ mul_pos d0 d0),
      ← int.cast_mul, ← int.nat_abs_mul_self] at this,
  revert c this, generalize : n.nat_abs = a, intros,
  have E : 5 * (d * d) = a * a := (@nat.cast_inj ℝ _ _ _ _ _).1 (by simpa),
  have ae : 5 ∣ a,
  { refine (or_self _).1 (prime_five.dvd_mul.1 _),
    rw ← E, apply dvd_mul_right },
  have de : 5 ∣ d,
  { have := mul_dvd_mul ae ae,
    refine (or_self _).1 (prime_five.dvd_mul.1 _),
    rwa [← E, nat.mul_dvd_mul_iff_left (nat.succ_pos 4)] at this },
  refine nat.not_coprime_of_dvd_of_dvd _ ae de c, from dec_trivial,
end
end

def one_half : ℚ := (1 : ℚ) / (2 : ℚ)

theorem αℝ_irrational : irrational αℝ :=
  begin
  have irrat := irrat_ext_add (one_half) (irrat_ext_mul 2 two_ne_zero sqrt_five_irrational),
  have alphar : real.sqrt 5 / ↑(2 : ℚ) + ↑(one_half) = αℝ,
    unfold one_half, unfold αℝ,
    rw [eq_div_iff_mul_eq _ _ two_ne_zero],
    rw [right_distrib],
    have : (one_half : ℝ) * 2 = (1 : ℝ),
      show (one_half : ℝ) * 2 = (1 : ℝ),
      symmetry, transitivity, symmetry, exact rat.cast_one,
      have : (2 : ℝ) = (2 : ℚ),
        show (1 + 1 : ℝ) = (1 + 1 : ℚ),
        rw [rat.cast_add, rat.cast_one],
      rw this,
      rw [← rat.cast_mul, rat.cast_inj], refl,
    unfold_coes, unfold_coes at this, unfold one_half at this,
    rw this,
    have : (rat.cast 2 : ℝ) = 2,
      show (rat.cast (1 + 1) : ℝ) = 1 + 1,
      show (↑ (1 + 1 : ℚ) : ℝ) = 1 + 1,
      rw [rat.cast_add, rat.cast_one],
    rw this, simp, exact div_mul_cancel (real.sqrt 5) two_ne_zero,
  rw alphar at irrat, exact irrat,
  end

lemma αℝ.linear_independent : ∀ z : ℤα, to_real z = 0 → z = 0 :=
  begin
  intro z, intro h, unfold to_real at h,
  rw [← eq_sub_iff_add_eq] at h, simp at h, rw [eq_neg_iff_eq_neg] at h,
  suffices : z.i = 0,
  {
    rw this at h,
    simp at h,
    cases h,
      exact Zalpha.ext this h,
    exfalso,
    revert h,
    exact αℝ_ne_zero,
  },
  by_contradiction zine0,
  have zine0' : (↑ z.i : ℝ) ≠ 0, { simp, exact zine0, },
  rw [iff.intro eq.symm eq.symm] at h,
  rw [neg_eq_neg_one_mul, ← eq_div_iff_mul_eq _ _ zine0'] at h,
  rw [mul_div_assoc, mul_div_comm] at h,
  rw [mul_comm, iff.intro eq.symm eq.symm, ← eq_div_iff_mul_eq _ (-1) αℝ_ne_zero] at h,
  have : ∀ (i : ℤ), (i : ℝ) = ↑ (↑ (i : ℤ) : ℚ),
  { intro i, symmetry,
    apply int.eq_cast (rat.cast ∘ int.cast),
    simp,
    show rat.cast (int.cast (1 : ℤ)) = (1 : ℝ),
    show rat.cast (↑ (1 : ℤ)) = (1 : ℝ),
    show ↑ (↑ (1 : ℤ) : ℚ) = (1 : ℝ),
    simp,
    intros, simp,
    show rat.cast (int.cast (x + y)) = rat.cast (int.cast x) + rat.cast (int.cast y),
    show rat.cast (↑ (x + y)) = rat.cast (↑ x) + rat.cast (↑ y),
    show (↑ (↑ (x + y) : ℚ) : ℝ) = ↑ (↑ x : ℚ) + ↑ (↑ y : ℚ), simp,
  },
  rw [this z.i, this z.r] at h,
  rw [← @rat.cast_div ℝ _ _ z.r z.i] at h,
  rw [division_def (-1) αℝ, mul_comm, mul_neg_one] at h,
  apply irrat_ext_neg (irrat_ext_inv αℝ_ne_zero αℝ_irrational),
  apply exists.intro, exact eq.symm h,
  end

@[simp] lemma to_real_α : to_real Zalpha.α = αℝ := by unfold to_real; simp
@[simp] lemma to_real_0 : to_real (0 : ℤα) = (0 : ℝ) := by unfold to_real; simp
@[simp] lemma to_real_1 : to_real 1 = 1 := by unfold to_real; simp

lemma αℝ.sqrd : αℝ*αℝ = αℝ + 1 :=
have h : (0 : ℝ) ≤ 5 := by norm_num,
begin
  unfold αℝ,
  rw [div_mul_div, mul_add, mul_one, add_mul, one_mul, ← pow_two, real.sqr_sqrt h],
  ring,
end

instance : is_ring_hom to_real :=
{ map_add :=
    begin
    intros, unfold to_real, simp [right_distrib],
    end
, map_mul :=
    begin
    intros, unfold to_real, simp [left_distrib, right_distrib],
    have : (↑(x.r) * αℝ * ((y.r) * αℝ)) = x.r * y.r * (αℝ * αℝ), ac_refl,
    rw [this, αℝ.sqrd],
    simp [left_distrib], ac_refl,
    end
, map_one :=
    begin
    unfold to_real, simp,
    end
}

lemma to_real.injective : function.injective to_real :=
  begin
  intros z₁ z₂ h,
  rw [← sub_eq_zero] at h,
  rw [← sub_eq_zero],
  rw [← is_ring_hom.map_sub to_real] at h,
  exact αℝ.linear_independent _ h,
  end

lemma to_real.inj : ∀ a b, to_real a = to_real b ↔ a = b :=
  begin
  intros, constructor, exact @to_real.injective a b, intro h, rw h
  end

/-instance : integral_domain Zalpha :=
{ eq_zero_or_eq_zero_of_mul_eq_zero :=
  begin
  intros a b h,
  rw [← to_real.inj, to_real.is_ring_hom.map_mul] at h,
  simp at h,
  have := eq_zero_or_eq_zero_of_mul_eq_zero h,
  cases this,
  rw [← to_real_0, to_real.inj _ 0] at this,
  left, exact this,
  rw [← to_real_0, to_real.inj _ 0] at this,
  right, exact this,
  end,
  zero_ne_one := dec_trivial,
  ..Zalpha.comm_ring
}-/