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

! This file was ported from Lean 3 source module probability.martingale.convergence
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Probability.Martingale.Upcrossing
import Mathbin.MeasureTheory.Function.UniformIntegrable
import Mathbin.MeasureTheory.Constructions.Polish

/-!

# Martingale convergence theorems

The martingale convergence theorems are a collection of theorems characterizing the convergence
of a martingale provided it satisfies some boundedness conditions. This file contains the
almost everywhere martingale convergence theorem which provides an almost everywhere limit to
an L¹ bounded submartingale. It also contains the L¹ martingale convergence theorem which provides
an L¹ limit to a uniformly integrable submartingale. Finally, it also contains the Lévy upwards
theorems.

## Main results

* `measure_theory.submartingale.ae_tendsto_limit_process`: the almost everywhere martingale
  convergence theorem: an L¹-bounded submartingale adapted to the filtration `ℱ` converges almost
  everywhere to its limit process.
* `measure_theory.submartingale.mem_ℒp_limit_process`: the limit process of an Lᵖ-bounded
  submartingale is Lᵖ.
* `measure_theory.submartingale.tendsto_snorm_one_limit_process`: part a of the L¹ martingale
  convergence theorem: a uniformly integrable submartingale adapted to the filtration `ℱ` converges
  almost everywhere and in L¹ to an integrable function which is measurable with respect to
  the σ-algebra `⨆ n, ℱ n`.
* `measure_theory.martingale.ae_eq_condexp_limit_process`: part b the L¹ martingale convergence
  theorem: if `f` is a uniformly integrable martingale adapted to the filtration `ℱ`, then
  `f n` equals `𝔼[g | ℱ n]` almost everywhere where `g` is the limiting process of `f`.
* `measure_theory.integrable.tendsto_ae_condexp`: part c the L¹ martingale convergence theorem:
  given a `⨆ n, ℱ n`-measurable function `g` where `ℱ` is a filtration, `𝔼[g | ℱ n]` converges
  almost everywhere to `g`.
* `measure_theory.integrable.tendsto_snorm_condexp`: part c the L¹ martingale convergence theorem:
  given a `⨆ n, ℱ n`-measurable function `g` where `ℱ` is a filtration, `𝔼[g | ℱ n]` converges in
  L¹ to `g`.

-/

open TopologicalSpace Filter MeasureTheory.Filtration

open NNReal ENNReal MeasureTheory ProbabilityTheory BigOperators Topology

namespace MeasureTheory

variable {Ω ι : Type _} {m0 : MeasurableSpace Ω} {μ : Measure Ω} {ℱ : Filtration ℕ m0}

variable {a b : ℝ} {f : ℕ → Ω → ℝ} {ω : Ω} {R : ℝ≥0}

section AeConvergence

/-!

### Almost everywhere martingale convergence theorem

We will now prove the almost everywhere martingale convergence theorem.

The a.e. martingale convergence theorem states: if `f` is an L¹-bounded `ℱ`-submartingale, then
it converges almost everywhere to an integrable function which is measurable with respect to
the σ-algebra `ℱ∞ := ⨆ n, ℱ n`.

Mathematically, we proceed by first noting that a real sequence $(x_n)$ converges if
(a) $\limsup_{n \to \infty} |x_n| < \infty$, (b) for all $a < b \in \mathbb{Q}$ we have the
number of upcrossings of $(x_n)$ from below $a$ to above $b$ is finite.
Thus, for all $\omega$ satisfying $\limsup_{n \to \infty} |f_n(\omega)| < \infty$ and the number of
upcrossings of $(f_n(\omega))$ from below $a$ to above $b$ is finite for all $a < b \in \mathbb{Q}$,
we have $(f_n(\omega))$ is convergent.

Hence, assuming $(f_n)$ is L¹-bounded, using Fatou's lemma, we have
$$
  \mathbb{E} \limsup_{n \to \infty} |f_n| \le \limsup_{n \to \infty} \mathbb{E}|f_n| < \infty
$$
implying $\limsup_{n \to \infty} |f_n| < \infty$ a.e. Furthermore, by the upcrossing estimate,
the number of upcrossings is finite almost everywhere implying $f$ converges pointwise almost
everywhere.

Thus, denoting $g$ the a.e. limit of $(f_n)$, $g$ is $\mathcal{F}_\infty$-measurable as for all
$n$, $f_n$ is $\mathcal{F}_n$-measurable and $\mathcal{F}_n \le \mathcal{F}_\infty$. Finally, $g$
is integrable as $|g| \le \liminf_{n \to \infty} |f_n|$ so
$$
  \mathbb{E}|g| \le \mathbb{E} \limsup_{n \to \infty} |f_n| \le
    \limsup_{n \to \infty} \mathbb{E}|f_n| < \infty
$$
as required.

Implementation wise, we have `tendsto_of_no_upcrossings` which showed that
a bounded sequence converges if it does not visit below $a$ and above $b$ infinitely often
for all $a, b ∈ s$ for some dense set $s$. So, we may skip the first step provided we can prove
that the realizations are bounded almost everywhere. Indeed, suppose $(|f_n(\omega)|)$ is not
bounded, then either $f_n(\omega) \to \pm \infty$ or one of $\limsup f_n(\omega)$ or
$\liminf f_n(\omega)$ equals $\pm \infty$ while the other is finite. But the first case
contradicts $\liminf |f_n(\omega)| < \infty$ while the second case contradicts finite upcrossings.

Furthermore, we introduced `filtration.limit_process` which chooses the limiting random variable
of a stochastic process if it exists, otherwise it returns 0. Hence, instead of showing an
existence statement, we phrased the a.e. martingale convergence theorem by showed that a
submartingale converges to its `limit_process` almost everywhere.

-/

/-- If a stochastic process has bounded upcrossing from below `a` to above `b`,
then it does not frequently visit both below `a` and above `b`. -/
theorem not_frequently_of_upcrossings_lt_top (hab : a < b) (hω : upcrossings a b f ω ≠ ∞) :
    ¬((∃ᶠ n in atTop, f n ω < a) ∧ ∃ᶠ n in atTop, b < f n ω) :=
  by
  rw [← lt_top_iff_ne_top, upcrossings_lt_top_iff] at hω
  replace hω : ∃ k, ∀ N, upcrossings_before a b f N ω < k
  · obtain ⟨k, hk⟩ := hω
    exact ⟨k + 1, fun N => lt_of_le_of_lt (hk N) k.lt_succ_self⟩
  rintro ⟨h₁, h₂⟩
  rw [frequently_at_top] at h₁ h₂
  refine' Classical.not_not.2 hω _
  push_neg
  intro k
  induction' k with k ih
  · simp only [zero_le', exists_const]
  · obtain ⟨N, hN⟩ := ih
    obtain ⟨N₁, hN₁, hN₁'⟩ := h₁ N
    obtain ⟨N₂, hN₂, hN₂'⟩ := h₂ N₁
    exact
      ⟨N₂ + 1,
        Nat.succ_le_of_lt <|
          lt_of_le_of_lt hN (upcrossings_before_lt_of_exists_upcrossing hab hN₁ hN₁' hN₂ hN₂')⟩
#align measure_theory.not_frequently_of_upcrossings_lt_top MeasureTheory.not_frequently_of_upcrossings_lt_top

/-- A stochastic process that frequently visits below `a` and above `b` have infinite
upcrossings. -/
theorem upcrossings_eq_top_of_frequently_lt (hab : a < b) (h₁ : ∃ᶠ n in atTop, f n ω < a)
    (h₂ : ∃ᶠ n in atTop, b < f n ω) : upcrossings a b f ω = ∞ :=
  by_contradiction fun h => not_frequently_of_upcrossings_lt_top hab h ⟨h₁, h₂⟩
#align measure_theory.upcrossings_eq_top_of_frequently_lt MeasureTheory.upcrossings_eq_top_of_frequently_lt

/-- A realization of a stochastic process with bounded upcrossings and bounded liminfs is
convergent.

We use the spelling `< ∞` instead of the standard `≠ ∞` in the assumptions since it is not as easy
to change `<` to `≠` under binders. -/
theorem tendsto_of_uncrossing_lt_top (hf₁ : liminf (fun n => (‖f n ω‖₊ : ℝ≥0∞)) atTop < ∞)
    (hf₂ : ∀ a b : ℚ, a < b → upcrossings a b f ω < ∞) :
    ∃ c, Tendsto (fun n => f n ω) atTop (𝓝 c) :=
  by
  by_cases h : is_bounded_under (· ≤ ·) at_top fun n => |f n ω|
  · rw [is_bounded_under_le_abs] at h
    refine' tendsto_of_no_upcrossings Rat.denseRange_cast _ h.1 h.2
    · intro a ha b hb hab
      obtain ⟨⟨a, rfl⟩, ⟨b, rfl⟩⟩ := ha, hb
      exact not_frequently_of_upcrossings_lt_top hab (hf₂ a b (Rat.cast_lt.1 hab)).Ne
  · obtain ⟨a, b, hab, h₁, h₂⟩ := ENNReal.exists_upcrossings_of_not_bounded_under hf₁.ne h
    exact
      False.elim ((hf₂ a b hab).Ne (upcrossings_eq_top_of_frequently_lt (Rat.cast_lt.2 hab) h₁ h₂))
#align measure_theory.tendsto_of_uncrossing_lt_top MeasureTheory.tendsto_of_uncrossing_lt_top

/-- An L¹-bounded submartingale has bounded upcrossings almost everywhere. -/
theorem Submartingale.upcrossings_ae_lt_top' [IsFiniteMeasure μ] (hf : Submartingale f ℱ μ)
    (hbdd : ∀ n, snorm (f n) 1 μ ≤ R) (hab : a < b) : ∀ᵐ ω ∂μ, upcrossings a b f ω < ∞ :=
  by
  refine' ae_lt_top (hf.adapted.measurable_upcrossings hab) _
  have := hf.mul_lintegral_upcrossings_le_lintegral_pos_part a b
  rw [mul_comm, ← ENNReal.le_div_iff_mul_le] at this
  · refine' (lt_of_le_of_lt this (ENNReal.div_lt_top _ _)).Ne
    · have hR' : ∀ n, (∫⁻ ω, ‖f n ω - a‖₊ ∂μ) ≤ R + ‖a‖₊ * μ Set.univ :=
        by
        simp_rw [snorm_one_eq_lintegral_nnnorm] at hbdd
        intro n
        refine' (lintegral_mono _ : (∫⁻ ω, ‖f n ω - a‖₊ ∂μ) ≤ ∫⁻ ω, ‖f n ω‖₊ + ‖a‖₊ ∂μ).trans _
        · intro ω
          simp_rw [sub_eq_add_neg, ← nnnorm_neg a, ← ENNReal.coe_add, ENNReal.coe_le_coe]
          exact nnnorm_add_le _ _
        · simp_rw [lintegral_add_right _ measurable_const, lintegral_const]
          exact add_le_add (hbdd _) le_rfl
      refine'
        ne_of_lt
          (supᵢ_lt_iff.2
            ⟨R + ‖a‖₊ * μ Set.univ,
              ENNReal.add_lt_top.2
                ⟨ENNReal.coe_lt_top, ENNReal.mul_lt_top ennreal.coe_lt_top.ne (measure_ne_top _ _)⟩,
              fun n => le_trans _ (hR' n)⟩)
      refine' lintegral_mono fun ω => _
      rw [ENNReal.ofReal_le_iff_le_toReal, ENNReal.coe_toReal, coe_nnnorm]
      by_cases hnonneg : 0 ≤ f n ω - a
      ·
        rw [LatticeOrderedCommGroup.pos_of_nonneg _ hnonneg, Real.norm_eq_abs,
          abs_of_nonneg hnonneg]
      · rw [LatticeOrderedCommGroup.pos_of_nonpos _ (not_le.1 hnonneg).le]
        exact norm_nonneg _
      · simp only [Ne.def, ENNReal.coe_ne_top, not_false_iff]
    · simp only [hab, Ne.def, ENNReal.ofReal_eq_zero, sub_nonpos, not_le]
  · simp only [hab, Ne.def, ENNReal.ofReal_eq_zero, sub_nonpos, not_le, true_or_iff]
  · simp only [Ne.def, ENNReal.ofReal_ne_top, not_false_iff, true_or_iff]
#align measure_theory.submartingale.upcrossings_ae_lt_top' MeasureTheory.Submartingale.upcrossings_ae_lt_top'

theorem Submartingale.upcrossings_ae_lt_top [IsFiniteMeasure μ] (hf : Submartingale f ℱ μ)
    (hbdd : ∀ n, snorm (f n) 1 μ ≤ R) : ∀ᵐ ω ∂μ, ∀ a b : ℚ, a < b → upcrossings a b f ω < ∞ :=
  by
  simp only [ae_all_iff, eventually_imp_distrib_left]
  rintro a b hab
  exact hf.upcrossings_ae_lt_top' hbdd (Rat.cast_lt.2 hab)
#align measure_theory.submartingale.upcrossings_ae_lt_top MeasureTheory.Submartingale.upcrossings_ae_lt_top

/-- An L¹-bounded submartingale converges almost everywhere. -/
theorem Submartingale.exists_ae_tendsto_of_bdd [IsFiniteMeasure μ] (hf : Submartingale f ℱ μ)
    (hbdd : ∀ n, snorm (f n) 1 μ ≤ R) : ∀ᵐ ω ∂μ, ∃ c, Tendsto (fun n => f n ω) atTop (𝓝 c) :=
  by
  filter_upwards [hf.upcrossings_ae_lt_top hbdd,
    ae_bdd_liminf_at_top_of_snorm_bdd one_ne_zero
      (fun n => (hf.strongly_measurable n).Measurable.mono (ℱ.le n) le_rfl) hbdd]with ω h₁ h₂
  exact tendsto_of_uncrossing_lt_top h₂ h₁
#align measure_theory.submartingale.exists_ae_tendsto_of_bdd MeasureTheory.Submartingale.exists_ae_tendsto_of_bdd

theorem Submartingale.exists_ae_trim_tendsto_of_bdd [IsFiniteMeasure μ] (hf : Submartingale f ℱ μ)
    (hbdd : ∀ n, snorm (f n) 1 μ ≤ R) :
    ∀ᵐ ω ∂μ.trim (supₛ_le fun m ⟨n, hn⟩ => hn ▸ ℱ.le _ : (⨆ n, ℱ n) ≤ m0),
      ∃ c, Tendsto (fun n => f n ω) atTop (𝓝 c) :=
  by
  rw [ae_iff, trim_measurable_set_eq]
  · exact hf.exists_ae_tendsto_of_bdd hbdd
  ·
    exact
      MeasurableSet.compl
        (@measurable_set_exists_tendsto _ _ _ _ _ _ (⨆ n, ℱ n) _ _ _ _ _ fun n =>
          (hf.strongly_measurable n).Measurable.mono (le_supₛ ⟨n, rfl⟩) le_rfl)
#align measure_theory.submartingale.exists_ae_trim_tendsto_of_bdd MeasureTheory.Submartingale.exists_ae_trim_tendsto_of_bdd

/-- **Almost everywhere martingale convergence theorem**: An L¹-bounded submartingale converges
almost everywhere to a `⨆ n, ℱ n`-measurable function. -/
theorem Submartingale.ae_tendsto_limitProcess [IsFiniteMeasure μ] (hf : Submartingale f ℱ μ)
    (hbdd : ∀ n, snorm (f n) 1 μ ≤ R) :
    ∀ᵐ ω ∂μ, Tendsto (fun n => f n ω) atTop (𝓝 (ℱ.limitProcess f μ ω)) := by
  classical
    suffices
      ∃ g, strongly_measurable[⨆ n, ℱ n] g ∧ ∀ᵐ ω ∂μ, tendsto (fun n => f n ω) at_top (𝓝 (g ω))
      by
      rw [limit_process, dif_pos this]
      exact (Classical.choose_spec this).2
    set g' : Ω → ℝ := fun ω => if h : ∃ c, tendsto (fun n => f n ω) at_top (𝓝 c) then h.some else 0
    have hle : (⨆ n, ℱ n) ≤ m0 := supₛ_le fun m ⟨n, hn⟩ => hn ▸ ℱ.le _
    have hg' : ∀ᵐ ω ∂μ.trim hle, tendsto (fun n => f n ω) at_top (𝓝 (g' ω)) :=
      by
      filter_upwards [hf.exists_ae_trim_tendsto_of_bdd hbdd]with ω hω
      simp_rw [g', dif_pos hω]
      exact hω.some_spec
    have hg'm : @ae_strongly_measurable _ _ _ (⨆ n, ℱ n) g' (μ.trim hle) :=
      (@aeMeasurableOfTendstoMetrizableAe' _ _ (⨆ n, ℱ n) _ _ _ _ _ _ _
          (fun n =>
            ((hf.strongly_measurable n).Measurable.mono (le_supₛ ⟨n, rfl⟩ : ℱ n ≤ ⨆ n, ℱ n)
                le_rfl).AeMeasurable)
          hg').AeStronglyMeasurable
    obtain ⟨g, hgm, hae⟩ := hg'm
    have hg : ∀ᵐ ω ∂μ.trim hle, tendsto (fun n => f n ω) at_top (𝓝 (g ω)) :=
      by
      filter_upwards [hae, hg']with ω hω hg'ω
      exact hω ▸ hg'ω
    exact ⟨g, hgm, measure_eq_zero_of_trim_eq_zero hle hg⟩
#align measure_theory.submartingale.ae_tendsto_limit_process MeasureTheory.Submartingale.ae_tendsto_limitProcess

/-- The limiting process of an Lᵖ-bounded submartingale is Lᵖ. -/
theorem Submartingale.memℒpLimitProcess {p : ℝ≥0∞} (hf : Submartingale f ℱ μ)
    (hbdd : ∀ n, snorm (f n) p μ ≤ R) : Memℒp (ℱ.limitProcess f μ) p μ :=
  memℒpLimitProcessOfSnormBdd
    (fun n => ((hf.StronglyMeasurable n).mono (ℱ.le n)).AeStronglyMeasurable) hbdd
#align measure_theory.submartingale.mem_ℒp_limit_process MeasureTheory.Submartingale.memℒpLimitProcess

end AeConvergence

section L1Convergence

variable [IsFiniteMeasure μ] {g : Ω → ℝ}

/-!

### L¹ martingale convergence theorem

We will now prove the L¹ martingale convergence theorems.

The L¹ martingale convergence theorem states that:
(a) if `f` is a uniformly integrable (in the probability sense) submartingale adapted to the
  filtration `ℱ`, it converges in L¹ to an integrable function `g` which is measurable with
  respect to `ℱ∞ := ⨆ n, ℱ n` and
(b) if `f` is actually a martingale, `f n = 𝔼[g | ℱ n]` almost everywhere.
(c) Finally, if `h` is integrable and measurable with respect to `ℱ∞`, `(𝔼[h | ℱ n])ₙ` is a
  uniformly integrable martingale which converges to `h` almost everywhere and in L¹.

The proof is quite simple. (a) follows directly from the a.e. martingale convergence theorem
and the Vitali convergence theorem as our definition of uniform integrability (in the probability
sense) directly implies L¹-uniform boundedness. We note that our definition of uniform
integrability is slightly non-standard but is equivalent to the usual literary definition. This
equivalence is provided by `measure_theory.uniform_integrable_iff`.

(b) follows since given $n$, we have for all $m \ge n$,
$$
  \|f_n - \mathbb{E}[g \mid \mathcal{F}_n]\|_1 =
    \|\mathbb{E}[f_m - g \mid \mathcal{F}_n]\|_1 \le \|\|f_m - g\|_1.
$$
Thus, taking $m \to \infty$ provides the almost everywhere equality.

Finally, to prove (c), we define $f_n := \mathbb{E}[h \mid \mathcal{F}_n]$. It is clear that
$(f_n)_n$ is a martingale by the tower property for conditional expectations. Furthermore,
$(f_n)_n$ is uniformly integrable in the probability sense. Indeed, as a single function is
uniformly integrable in the measure theory sense, for all $\epsilon > 0$, there exists some
$\delta > 0$ such that for all measurable set $A$ with $\mu(A) < δ$, we have
$\mathbb{E}|h|\mathbf{1}_A < \epsilon$. So, since for sufficently large $\lambda$, by the Markov
inequality, we have for all $n$,
$$
  \mu(|f_n| \ge \lambda) \le \lambda^{-1}\mathbb{E}|f_n| \le \lambda^{-1}\mathbb|g| < \delta,
$$
we have for sufficently large $\lambda$, for all $n$,
$$
  \mathbb{E}|f_n|\mathbf{1}_{|f_n| \ge \lambda} \le
    \mathbb|g|\mathbf{1}_{|f_n| \ge \lambda} < \epsilon,
$$
implying $(f_n)_n$ is uniformly integrable. Now, to prove $f_n \to h$ almost everywhere and in
L¹, it suffices to show that $h = g$ almost everywhere where $g$ is the almost everywhere and L¹
limit of $(f_n)_n$ from part (b) of the theorem. By noting that, for all $s \in \mathcal{F}_n$,
we have
$$
  \mathbb{E}g\mathbf{1}_s = \mathbb{E}[\mathbb{E}[g \mid \mathcal{F}_n]\mathbf{1}_s] =
    \mathbb{E}[\mathbb{E}[h \mid \mathcal{F}_n]\mathbf{1}_s] = \mathbb{E}h\mathbf{1}_s
$$
where $\mathbb{E}[g \mid \mathcal{F}_n = \mathbb{E}[h \mid \mathcal{F}_n]$ almost everywhere
by part (b); the equality also holds for all $s \in \mathcal{F}_\infty$ by Dynkin's theorem.
Thus, as both $h$ and $g$ are $\mathcal{F}_\infty$-measurable, $h = g$ almost everywhere as
required.

Similar to the a.e. martingale convergence theorem, rather than showing the existence of the
limiting process, we phrased the L¹-martingale convergence theorem by proving that a submartingale
does converge in L¹ to its `limit_process`. However, in contrast to the a.e. martingale convergence
theorem, we do not need to introduce a L¹ version of `filtration.limit_process` as the L¹ limit
and the a.e. limit of a submartingale coincide.

-/

/-- Part a of the **L¹ martingale convergence theorem**: a uniformly integrable submartingale
adapted to the filtration `ℱ` converges a.e. and in L¹ to an integrable function which is
measurable with respect to the σ-algebra `⨆ n, ℱ n`. -/
theorem Submartingale.tendsto_snorm_one_limitProcess (hf : Submartingale f ℱ μ)
    (hunif : UniformIntegrable f 1 μ) :
    Tendsto (fun n => snorm (f n - ℱ.limitProcess f μ) 1 μ) atTop (𝓝 0) :=
  by
  obtain ⟨R, hR⟩ := hunif.2.2
  have hmeas : ∀ n, ae_strongly_measurable (f n) μ := fun n =>
    ((hf.strongly_measurable n).mono (ℱ.le _)).AeStronglyMeasurable
  exact
    tendsto_Lp_of_tendsto_in_measure _ le_rfl ENNReal.one_ne_top hmeas
      (mem_ℒp_limit_process_of_snorm_bdd hmeas hR) hunif.2.1
      (tendsto_in_measure_of_tendsto_ae hmeas <| hf.ae_tendsto_limit_process hR)
#align measure_theory.submartingale.tendsto_snorm_one_limit_process MeasureTheory.Submartingale.tendsto_snorm_one_limitProcess

theorem Submartingale.ae_tendsto_limitProcess_of_uniformIntegrable (hf : Submartingale f ℱ μ)
    (hunif : UniformIntegrable f 1 μ) :
    ∀ᵐ ω ∂μ, Tendsto (fun n => f n ω) atTop (𝓝 (ℱ.limitProcess f μ ω)) :=
  let ⟨R, hR⟩ := hunif.2.2
  hf.ae_tendsto_limitProcess hR
#align measure_theory.submartingale.ae_tendsto_limit_process_of_uniform_integrable MeasureTheory.Submartingale.ae_tendsto_limitProcess_of_uniformIntegrable

/-- If a martingale `f` adapted to `ℱ` converges in L¹ to `g`, then for all `n`, `f n` is almost
everywhere equal to `𝔼[g | ℱ n]`. -/
theorem Martingale.eq_condexp_of_tendsto_snorm {μ : Measure Ω} (hf : Martingale f ℱ μ)
    (hg : Integrable g μ) (hgtends : Tendsto (fun n => snorm (f n - g) 1 μ) atTop (𝓝 0)) (n : ℕ) :
    f n =ᵐ[μ] μ[g|ℱ n] :=
  by
  rw [← sub_ae_eq_zero, ←
    snorm_eq_zero_iff
      (((hf.strongly_measurable n).mono (ℱ.le _)).sub
          (strongly_measurable_condexp.mono (ℱ.le _))).AeStronglyMeasurable
      one_ne_zero]
  have ht : tendsto (fun m => snorm (μ[f m - g|ℱ n]) 1 μ) at_top (𝓝 0) :=
    haveI hint : ∀ m, integrable (f m - g) μ := fun m => (hf.integrable m).sub hg
    tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds hgtends (fun m => zero_le _)
      fun m => snorm_one_condexp_le_snorm _
  have hev : ∀ m ≥ n, snorm (μ[f m - g|ℱ n]) 1 μ = snorm (f n - μ[g|ℱ n]) 1 μ :=
    by
    refine' fun m hm => snorm_congr_ae ((condexp_sub (hf.integrable m) hg).trans _)
    filter_upwards [hf.2 n m hm]with x hx
    simp only [hx, Pi.sub_apply]
  exact tendsto_nhds_unique (tendsto_atTop_of_eventually_const hev) ht
#align measure_theory.martingale.eq_condexp_of_tendsto_snorm MeasureTheory.Martingale.eq_condexp_of_tendsto_snorm

/-- Part b of the **L¹ martingale convergence theorem**: if `f` is a uniformly integrable martingale
adapted to the filtration `ℱ`, then for all `n`, `f n` is almost everywhere equal to the conditional
expectation of its limiting process wrt. `ℱ n`. -/
theorem Martingale.ae_eq_condexp_limitProcess (hf : Martingale f ℱ μ)
    (hbdd : UniformIntegrable f 1 μ) (n : ℕ) : f n =ᵐ[μ] μ[ℱ.limitProcess f μ|ℱ n] :=
  let ⟨R, hR⟩ := hbdd.2.2
  hf.eq_condexp_of_tendsto_snorm ((memℒpLimitProcessOfSnormBdd hbdd.1 hR).Integrable le_rfl)
    (hf.Submartingale.tendsto_snorm_one_limitProcess hbdd) n
#align measure_theory.martingale.ae_eq_condexp_limit_process MeasureTheory.Martingale.ae_eq_condexp_limitProcess

/-- Part c of the **L¹ martingale convergnce theorem**: Given a integrable function `g` which
is measurable with respect to `⨆ n, ℱ n` where `ℱ` is a filtration, the martingale defined by
`𝔼[g | ℱ n]` converges almost everywhere to `g`.

This martingale also converges to `g` in L¹ and this result is provided by
`measure_theory.integrable.tendsto_snorm_condexp` -/
theorem Integrable.tendsto_ae_condexp (hg : Integrable g μ)
    (hgmeas : strongly_measurable[⨆ n, ℱ n] g) :
    ∀ᵐ x ∂μ, Tendsto (fun n => (μ[g|ℱ n]) x) atTop (𝓝 (g x)) :=
  by
  have hle : (⨆ n, ℱ n) ≤ m0 := supₛ_le fun m ⟨n, hn⟩ => hn ▸ ℱ.le _
  have hunif : uniform_integrable (fun n => μ[g|ℱ n]) 1 μ :=
    hg.uniform_integrable_condexp_filtration
  obtain ⟨R, hR⟩ := hunif.2.2
  have hlimint : integrable (ℱ.limit_process (fun n => μ[g|ℱ n]) μ) μ :=
    (mem_ℒp_limit_process_of_snorm_bdd hunif.1 hR).Integrable le_rfl
  suffices g =ᵐ[μ] ℱ.limit_process (fun n x => (μ[g|ℱ n]) x) μ
    by
    filter_upwards [this,
      (martingale_condexp g ℱ μ).Submartingale.ae_tendsto_limitProcess hR]with x heq ht
    rwa [HEq]
  have :
    ∀ n s,
      measurable_set[ℱ n] s →
        (∫ x in s, g x ∂μ) = ∫ x in s, ℱ.limit_process (fun n x => (μ[g|ℱ n]) x) μ x ∂μ :=
    by
    intro n s hs
    rw [← set_integral_condexp (ℱ.le n) hg hs, ← set_integral_condexp (ℱ.le n) hlimint hs]
    refine' set_integral_congr_ae (ℱ.le _ _ hs) _
    filter_upwards [(martingale_condexp g ℱ μ).ae_eq_condexp_limitProcess hunif n]with x hx _
    rwa [hx]
  refine'
    ae_eq_of_forall_set_integral_eq_of_sigma_finite' hle (fun s _ _ => hg.integrable_on)
      (fun s _ _ => hlimint.integrable_on) (fun s hs => _) hgmeas.ae_strongly_measurable'
      strongly_measurable_limit_process.ae_strongly_measurable'
  refine'
    @MeasurableSpace.induction_on_inter _ _ _ (⨆ n, ℱ n) (MeasurableSpace.measurableSpace_supᵢ_eq ℱ)
      _ _ _ _ _ _ hs
  · rintro s ⟨n, hs⟩ t ⟨m, ht⟩ -
    by_cases hnm : n ≤ m
    · exact ⟨m, (ℱ.mono hnm _ hs).inter ht⟩
    · exact ⟨n, hs.inter (ℱ.mono (not_le.1 hnm).le _ ht)⟩
  ·
    simp only [measure_empty, WithTop.zero_lt_top, measure.restrict_empty, integral_zero_measure,
      forall_true_left]
  · rintro t ⟨n, ht⟩ -
    exact this n _ ht
  · rintro t htmeas ht -
    have hgeq := @integral_add_compl _ _ (⨆ n, ℱ n) _ _ _ _ _ _ htmeas (hg.trim hle hgmeas)
    have hheq :=
      @integral_add_compl _ _ (⨆ n, ℱ n) _ _ _ _ _ _ htmeas
        (hlimint.trim hle strongly_measurable_limit_process)
    rw [add_comm, ← eq_sub_iff_add_eq] at hgeq hheq
    rw [set_integral_trim hle hgmeas htmeas.compl,
      set_integral_trim hle strongly_measurable_limit_process htmeas.compl, hgeq, hheq, ←
      set_integral_trim hle hgmeas htmeas, ←
      set_integral_trim hle strongly_measurable_limit_process htmeas, ← integral_trim hle hgmeas, ←
      integral_trim hle strongly_measurable_limit_process, ← integral_univ,
      this 0 _ MeasurableSet.univ, integral_univ, ht (measure_lt_top _ _)]
  · rintro f hf hfmeas heq -
    rw [integral_Union (fun n => hle _ (hfmeas n)) hf hg.integrable_on,
      integral_Union (fun n => hle _ (hfmeas n)) hf hlimint.integrable_on]
    exact tsum_congr fun n => HEq _ (measure_lt_top _ _)
#align measure_theory.integrable.tendsto_ae_condexp MeasureTheory.Integrable.tendsto_ae_condexp

/-- Part c of the **L¹ martingale convergnce theorem**: Given a integrable function `g` which
is measurable with respect to `⨆ n, ℱ n` where `ℱ` is a filtration, the martingale defined by
`𝔼[g | ℱ n]` converges in L¹ to `g`.

This martingale also converges to `g` almost everywhere and this result is provided by
`measure_theory.integrable.tendsto_ae_condexp` -/
theorem Integrable.tendsto_snorm_condexp (hg : Integrable g μ)
    (hgmeas : strongly_measurable[⨆ n, ℱ n] g) :
    Tendsto (fun n => snorm (μ[g|ℱ n] - g) 1 μ) atTop (𝓝 0) :=
  tendsto_Lp_of_tendstoInMeasure _ le_rfl ENNReal.one_ne_top
    (fun n => (stronglyMeasurable_condexp.mono (ℱ.le n)).AeStronglyMeasurable)
    (memℒp_one_iff_integrable.2 hg) hg.uniformIntegrableCondexpFiltration.2.1
    (tendstoInMeasureOfTendstoAe
      (fun n => (stronglyMeasurable_condexp.mono (ℱ.le n)).AeStronglyMeasurable)
      (hg.tendsto_ae_condexp hgmeas))
#align measure_theory.integrable.tendsto_snorm_condexp MeasureTheory.Integrable.tendsto_snorm_condexp

/-- **Lévy's upward theorem**, almost everywhere version: given a function `g` and a filtration
`ℱ`, the sequence defined by `𝔼[g | ℱ n]` converges almost everywhere to `𝔼[g | ⨆ n, ℱ n]`. -/
theorem tendsto_ae_condexp (g : Ω → ℝ) :
    ∀ᵐ x ∂μ, Tendsto (fun n => (μ[g|ℱ n]) x) atTop (𝓝 ((μ[g|⨆ n, ℱ n]) x)) :=
  by
  have ht : ∀ᵐ x ∂μ, tendsto (fun n => (μ[μ[g|⨆ n, ℱ n]|ℱ n]) x) at_top (𝓝 ((μ[g|⨆ n, ℱ n]) x)) :=
    integrable_condexp.tendsto_ae_condexp strongly_measurable_condexp
  have heq : ∀ n, ∀ᵐ x ∂μ, (μ[μ[g|⨆ n, ℱ n]|ℱ n]) x = (μ[g|ℱ n]) x := fun n =>
    condexp_condexp_of_le (le_supᵢ _ n) (supᵢ_le fun n => ℱ.le n)
  rw [← ae_all_iff] at heq
  filter_upwards [HEq, ht]with x hxeq hxt
  exact hxt.congr hxeq
#align measure_theory.tendsto_ae_condexp MeasureTheory.tendsto_ae_condexp

/-- **Lévy's upward theorem**, L¹ version: given a function `g` and a filtration `ℱ`, the
sequence defined by `𝔼[g | ℱ n]` converges in L¹ to `𝔼[g | ⨆ n, ℱ n]`. -/
theorem tendsto_snorm_condexp (g : Ω → ℝ) :
    Tendsto (fun n => snorm (μ[g|ℱ n] - μ[g|⨆ n, ℱ n]) 1 μ) atTop (𝓝 0) :=
  by
  have ht : tendsto (fun n => snorm (μ[μ[g|⨆ n, ℱ n]|ℱ n] - μ[g|⨆ n, ℱ n]) 1 μ) at_top (𝓝 0) :=
    integrable_condexp.tendsto_snorm_condexp strongly_measurable_condexp
  have heq : ∀ n, ∀ᵐ x ∂μ, (μ[μ[g|⨆ n, ℱ n]|ℱ n]) x = (μ[g|ℱ n]) x := fun n =>
    condexp_condexp_of_le (le_supᵢ _ n) (supᵢ_le fun n => ℱ.le n)
  refine' ht.congr fun n => snorm_congr_ae _
  filter_upwards [HEq n]with x hxeq
  simp only [hxeq, Pi.sub_apply]
#align measure_theory.tendsto_snorm_condexp MeasureTheory.tendsto_snorm_condexp

end L1Convergence

end MeasureTheory


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import analysis.specific_limits
import order.filter.countable_Inter
import topology.G_delta

/-!
# Baire theorem

In a complete metric space, a countable intersection of dense open subsets is dense.

The good concept underlying the theorem is that of a Gδ set, i.e., a countable intersection
of open sets. Then Baire theorem can also be formulated as the fact that a countable
intersection of dense Gδ sets is a dense Gδ set. We prove Baire theorem, giving several different
formulations that can be handy. We also prove the important consequence that, if the space is
covered by a countable union of closed sets, then the union of their interiors is dense.

The names of the theorems do not contain the string "Baire", but are instead built from the form of
the statement. "Baire" is however in the docstring of all the theorems, to facilitate grep searches.

We also define the filter `residual α` generated by dense `Gδ` sets and prove that this filter
has the countable intersection property.
-/

noncomputable theory
open_locale classical topological_space filter ennreal

open filter encodable set

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

section Baire_theorem
open emetric ennreal
variables [pseudo_emetric_space α] [complete_space α]

/-- Baire theorem: a countable intersection of dense open sets is dense. Formulated here when
the source space is ℕ (and subsumed below by `dense_Inter_of_open` working with any
encodable source space). -/
theorem dense_Inter_of_open_nat {f : ℕ → set α} (ho : ∀n, is_open (f n))
  (hd : ∀n, dense (f n)) : dense (⋂n, f n) :=
begin
  let B : ℕ → ℝ≥0∞ := λn, 1/2^n,
  have Bpos : ∀n, 0 < B n,
  { intro n,
    simp only [B, one_div, one_mul, ennreal.inv_pos],
    exact pow_ne_top two_ne_top },
  /- Translate the density assumption into two functions `center` and `radius` associating
  to any n, x, δ, δpos a center and a positive radius such that
  `closed_ball center radius` is included both in `f n` and in `closed_ball x δ`.
  We can also require `radius ≤ (1/2)^(n+1)`, to ensure we get a Cauchy sequence later. -/
  have : ∀n x δ, δ ≠ 0 → ∃y r, 0 < r ∧ r ≤ B (n+1) ∧ closed_ball y r ⊆ (closed_ball x δ) ∩ f n,
  { assume n x δ δpos,
    have : x ∈ closure (f n) := hd n x,
    rcases emetric.mem_closure_iff.1 this (δ/2) (ennreal.half_pos δpos) with ⟨y, ys, xy⟩,
    rw edist_comm at xy,
    obtain ⟨r, rpos, hr⟩ : ∃ r > 0, closed_ball y r ⊆ f n :=
      nhds_basis_closed_eball.mem_iff.1 (is_open_iff_mem_nhds.1 (ho n) y ys),
    refine ⟨y, min (min (δ/2) r) (B (n+1)), _, _, λz hz, ⟨_, _⟩⟩,
    show 0 < min (min (δ / 2) r) (B (n+1)),
      from lt_min (lt_min (ennreal.half_pos δpos) rpos) (Bpos (n+1)),
    show min (min (δ / 2) r) (B (n+1)) ≤ B (n+1), from min_le_right _ _,
    show z ∈ closed_ball x δ, from calc
      edist z x ≤ edist z y + edist y x : edist_triangle _ _ _
      ... ≤ (min (min (δ / 2) r) (B (n+1))) + (δ/2) : add_le_add hz (le_of_lt xy)
      ... ≤ δ/2 + δ/2 : add_le_add (le_trans (min_le_left _ _) (min_le_left _ _)) le_rfl
      ... = δ : ennreal.add_halves δ,
    show z ∈ f n, from hr (calc
      edist z y ≤ min (min (δ / 2) r) (B (n+1)) : hz
      ... ≤ r : le_trans (min_le_left _ _) (min_le_right _ _)) },
  choose! center radius Hpos HB Hball using this,
  refine λ x, (mem_closure_iff_nhds_basis nhds_basis_closed_eball).2 (λ ε εpos, _),
  /- `ε` is positive. We have to find a point in the ball of radius `ε` around `x` belonging to all
  `f n`. For this, we construct inductively a sequence `F n = (c n, r n)` such that the closed ball
  `closed_ball (c n) (r n)` is included in the previous ball and in `f n`, and such that
  `r n` is small enough to ensure that `c n` is a Cauchy sequence. Then `c n` converges to a
  limit which belongs to all the `f n`. -/
  let F : ℕ → (α × ℝ≥0∞) := λn, nat.rec_on n (prod.mk x (min ε (B 0)))
                              (λn p, prod.mk (center n p.1 p.2) (radius n p.1 p.2)),
  let c : ℕ → α := λn, (F n).1,
  let r : ℕ → ℝ≥0∞ := λn, (F n).2,
  have rpos : ∀ n, 0 < r n,
  { assume n,
    induction n with n hn,
    exact lt_min εpos (Bpos 0),
    exact Hpos n (c n) (r n) hn.ne' },
  have r0 : ∀ n, r n ≠ 0 := λ n, (rpos n).ne',
  have rB : ∀n, r n ≤ B n,
  { assume n,
    induction n with n hn,
    exact min_le_right _ _,
    exact HB n (c n) (r n) (r0 n) },
  have incl : ∀n, closed_ball (c (n+1)) (r (n+1)) ⊆ (closed_ball (c n) (r n)) ∩ (f n) :=
    λ n, Hball n (c n) (r n) (r0 n),
  have cdist : ∀n, edist (c n) (c (n+1)) ≤ B n,
  { assume n,
    rw edist_comm,
    have A : c (n+1) ∈ closed_ball (c (n+1)) (r (n+1)) := mem_closed_ball_self,
    have I := calc
      closed_ball (c (n+1)) (r (n+1)) ⊆ closed_ball (c n) (r n) :
        subset.trans (incl n) (inter_subset_left _ _)
      ... ⊆ closed_ball (c n) (B n) : closed_ball_subset_closed_ball (rB n),
    exact I A },
  have : cauchy_seq c :=
    cauchy_seq_of_edist_le_geometric_two _ one_ne_top cdist,
  -- as the sequence `c n` is Cauchy in a complete space, it converges to a limit `y`.
  rcases cauchy_seq_tendsto_of_complete this with ⟨y, ylim⟩,
  -- this point `y` will be the desired point. We will check that it belongs to all
  -- `f n` and to `ball x ε`.
  use y,
  simp only [exists_prop, set.mem_Inter],
  have I : ∀n, ∀m ≥ n, closed_ball (c m) (r m) ⊆ closed_ball (c n) (r n),
  { assume n,
    refine nat.le_induction _ (λm hnm h, _),
    { exact subset.refl _ },
    { exact subset.trans (incl m) (subset.trans (inter_subset_left _ _) h) }},
  have yball : ∀n, y ∈ closed_ball (c n) (r n),
  { assume n,
    refine is_closed_ball.mem_of_tendsto ylim _,
    refine (filter.eventually_ge_at_top n).mono (λ m hm, _),
    exact I n m hm mem_closed_ball_self },
  split,
  show ∀n, y ∈ f n,
  { assume n,
    have : closed_ball (c (n+1)) (r (n+1)) ⊆ f n := subset.trans (incl n) (inter_subset_right _ _),
    exact this (yball (n+1)) },
  show edist y x ≤ ε, from le_trans (yball 0) (min_le_left _ _),
end

/-- Baire theorem: a countable intersection of dense open sets is dense. Formulated here with ⋂₀. -/
theorem dense_sInter_of_open {S : set (set α)} (ho : ∀s∈S, is_open s) (hS : countable S)
  (hd : ∀s∈S, dense s) : dense (⋂₀S) :=
begin
  cases S.eq_empty_or_nonempty with h h,
  { simp [h] },
  { rcases hS.exists_surjective h with ⟨f, hf⟩,
    have F : ∀n, f n ∈ S := λn, by rw hf; exact mem_range_self _,
    rw [hf, sInter_range],
    exact dense_Inter_of_open_nat (λn, ho _ (F n)) (λn, hd _ (F n)) }
end

/-- Baire theorem: a countable intersection of dense open sets is dense. Formulated here with
an index set which is a countable set in any type. -/
theorem dense_bInter_of_open {S : set β} {f : β → set α} (ho : ∀s∈S, is_open (f s))
  (hS : countable S) (hd : ∀s∈S, dense (f s)) : dense (⋂s∈S, f s) :=
begin
  rw ← sInter_image,
  apply dense_sInter_of_open,
  { rwa ball_image_iff },
  { exact hS.image _ },
  { rwa ball_image_iff }
end

/-- Baire theorem: a countable intersection of dense open sets is dense. Formulated here with
an index set which is an encodable type. -/
theorem dense_Inter_of_open [encodable β] {f : β → set α} (ho : ∀s, is_open (f s))
  (hd : ∀s, dense (f s)) : dense (⋂s, f s) :=
begin
  rw ← sInter_range,
  apply dense_sInter_of_open,
  { rwa forall_range_iff },
  { exact countable_range _ },
  { rwa forall_range_iff }
end

/-- Baire theorem: a countable intersection of dense Gδ sets is dense. Formulated here with ⋂₀. -/
theorem dense_sInter_of_Gδ {S : set (set α)} (ho : ∀s∈S, is_Gδ s) (hS : countable S)
  (hd : ∀s∈S, dense s) : dense (⋂₀S) :=
begin
  -- the result follows from the result for a countable intersection of dense open sets,
  -- by rewriting each set as a countable intersection of open sets, which are of course dense.
  choose T hTo hTc hsT using ho,
  have : ⋂₀ S = ⋂₀ (⋃ s ∈ S, T s ‹_›), -- := (sInter_bUnion (λs hs, (hT s hs).2.2)).symm,
    by simp only [sInter_Union, (hsT _ _).symm, ← sInter_eq_bInter],
  rw this,
  refine dense_sInter_of_open _ (hS.bUnion hTc) _;
    simp only [mem_Union]; rintro t ⟨s, hs, tTs⟩,
  show is_open t, from hTo s hs t tTs,
  show dense t,
  { intro x,
    have := hd s hs x,
    rw hsT s hs at this,
    exact closure_mono (sInter_subset_of_mem tTs) this }
end

/-- Baire theorem: a countable intersection of dense Gδ sets is dense. Formulated here with
an index set which is an encodable type. -/
theorem dense_Inter_of_Gδ [encodable β] {f : β → set α} (ho : ∀s, is_Gδ (f s))
  (hd : ∀s, dense (f s)) : dense (⋂s, f s) :=
begin
  rw ← sInter_range,
  exact dense_sInter_of_Gδ (forall_range_iff.2 ‹_›) (countable_range _) (forall_range_iff.2 ‹_›)
end

/-- Baire theorem: a countable intersection of dense Gδ sets is dense. Formulated here with
an index set which is a countable set in any type. -/
theorem dense_bInter_of_Gδ {S : set β} {f : Π x ∈ S, set α} (ho : ∀s∈S, is_Gδ (f s ‹_›))
  (hS : countable S) (hd : ∀s∈S, dense (f s ‹_›)) : dense (⋂s∈S, f s ‹_›) :=
begin
  rw bInter_eq_Inter,
  haveI := hS.to_encodable,
  exact dense_Inter_of_Gδ (λ s, ho s s.2) (λ s, hd s s.2)
end

/-- Baire theorem: the intersection of two dense Gδ sets is dense. -/
theorem dense.inter_of_Gδ {s t : set α} (hs : is_Gδ s) (ht : is_Gδ t) (hsc : dense s)
  (htc : dense t) :
  dense (s ∩ t) :=
begin
  rw [inter_eq_Inter],
  apply dense_Inter_of_Gδ; simp [bool.forall_bool, *]
end

/-- A property holds on a residual (comeagre) set if and only if it holds on some dense `Gδ` set. -/
lemma eventually_residual {p : α → Prop} :
  (∀ᶠ x in residual α, p x) ↔ ∃ (t : set α), is_Gδ t ∧ dense t ∧ ∀ x ∈ t, p x :=
calc (∀ᶠ x in residual α, p x) ↔
  ∀ᶠ x in ⨅ (t : set α) (ht : is_Gδ t ∧ dense t), 𝓟 t, p x :
    by simp only [residual, infi_and]
... ↔ ∃ (t : set α) (ht : is_Gδ t ∧ dense t), ∀ᶠ x in 𝓟 t, p x : mem_binfi_of_directed
    (λ t₁ h₁ t₂ h₂, ⟨t₁ ∩ t₂, ⟨h₁.1.inter h₂.1, dense.inter_of_Gδ h₁.1 h₂.1 h₁.2 h₂.2⟩, by simp⟩)
    ⟨univ, is_Gδ_univ, dense_univ⟩
... ↔ _ : by simp [and_assoc]

/-- A set is residual (comeagre) if and only if it includes a dense `Gδ` set. -/
lemma mem_residual {s : set α} : s ∈ residual α ↔ ∃ t ⊆ s, is_Gδ t ∧ dense t :=
(@eventually_residual α _ _ (λ x, x ∈ s)).trans $ exists_congr $
λ t, by rw [exists_prop, and_comm (t ⊆ s), subset_def, and_assoc]

lemma dense_of_mem_residual {s : set α} (hs : s ∈ residual α) : dense s :=
let ⟨t, hts, _, hd⟩ := mem_residual.1 hs in hd.mono hts

instance : countable_Inter_filter (residual α) :=
⟨begin
  intros S hSc hS,
  simp only [mem_residual] at *,
  choose T hTs hT using hS,
  refine ⟨⋂ s ∈ S, T s ‹_›, _, _, _⟩,
  { rw [sInter_eq_bInter],
    exact Inter₂_mono hTs },
  { exact is_Gδ_bInter hSc (λ s hs, (hT s hs).1) },
  { exact dense_bInter_of_Gδ (λ s hs, (hT s hs).1) hSc (λ s hs, (hT s hs).2) }
end⟩

/-- Baire theorem: if countably many closed sets cover the whole space, then their interiors
are dense. Formulated here with an index set which is a countable set in any type. -/
theorem dense_bUnion_interior_of_closed {S : set β} {f : β → set α} (hc : ∀s∈S, is_closed (f s))
  (hS : countable S) (hU : (⋃s∈S, f s) = univ) : dense (⋃s∈S, interior (f s)) :=
begin
  let g := λs, (frontier (f s))ᶜ,
  have : dense (⋂s∈S, g s),
  { refine dense_bInter_of_open (λs hs, _) hS (λs hs, _),
    show is_open (g s), from is_open_compl_iff.2 is_closed_frontier,
    show dense (g s),
    { intro x,
      simp [interior_frontier (hc s hs)] }},
  refine this.mono _,
  show (⋂s∈S, g s) ⊆ (⋃s∈S, interior (f s)),
  assume x hx,
  have : x ∈ ⋃s∈S, f s, { have := mem_univ x, rwa ← hU at this },
  rcases mem_Union₂.1 this with ⟨s, hs, xs⟩,
  have : x ∈ g s := mem_Inter₂.1 hx s hs,
  have : x ∈ interior (f s),
  { have : x ∈ f s \ (frontier (f s)) := mem_inter xs this,
    simpa [frontier, xs, (hc s hs).closure_eq] using this },
  exact mem_Union₂.2 ⟨s, ⟨hs, this⟩⟩
end

/-- Baire theorem: if countably many closed sets cover the whole space, then their interiors
are dense. Formulated here with `⋃₀`. -/
theorem dense_sUnion_interior_of_closed {S : set (set α)} (hc : ∀s∈S, is_closed s)
  (hS : countable S) (hU : (⋃₀ S) = univ) : dense (⋃s∈S, interior s) :=
by rw sUnion_eq_bUnion at hU; exact dense_bUnion_interior_of_closed hc hS hU

/-- Baire theorem: if countably many closed sets cover the whole space, then their interiors
are dense. Formulated here with an index set which is an encodable type. -/
theorem dense_Union_interior_of_closed [encodable β] {f : β → set α} (hc : ∀s, is_closed (f s))
  (hU : (⋃s, f s) = univ) : dense (⋃s, interior (f s)) :=
begin
  rw ← bUnion_univ,
  apply dense_bUnion_interior_of_closed,
  { simp [hc] },
  { apply countable_encodable },
  { rwa ← bUnion_univ at hU }
end

/-- One of the most useful consequences of Baire theorem: if a countable union of closed sets
covers the space, then one of the sets has nonempty interior. -/
theorem nonempty_interior_of_Union_of_closed [nonempty α] [encodable β] {f : β → set α}
  (hc : ∀s, is_closed (f s)) (hU : (⋃s, f s) = univ) :
  ∃s, (interior $ f s).nonempty :=
begin
  by_contradiction h,
  simp only [not_exists, not_nonempty_iff_eq_empty] at h,
  have := calc ∅ = closure (⋃s, interior (f s)) : by simp [h]
             ... = univ : (dense_Union_interior_of_closed hc hU).closure_eq,
  exact univ_nonempty.ne_empty this.symm
end

end Baire_theorem


/-
Copyright (c) 2021 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson, Yaël Dillies
-/

import computability.NFA

/-!
# Epsilon Nondeterministic Finite Automata

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

This file contains the definition of an epsilon Nondeterministic Finite Automaton (`ε_NFA`), a state
machine which determines whether a string (implemented as a list over an arbitrary alphabet) is in a
regular set by evaluating the string over every possible path, also having access to ε-transitons,
which can be followed without reading a character.
Since this definition allows for automata with infinite states, a `fintype` instance must be
supplied for true `ε_NFA`'s.
-/

open set
open_locale computability

universes u v

/-- An `ε_NFA` is a set of states (`σ`), a transition function from state to state labelled by the
  alphabet (`step`), a starting state (`start`) and a set of acceptance states (`accept`).
  Note the transition function sends a state to a `set` of states and can make ε-transitions by
  inputing `none`.
  Since this definition allows for Automata with infinite states, a `fintype` instance must be
  supplied for true `ε_NFA`'s.-/
structure ε_NFA (α : Type u) (σ : Type v) :=
(step : σ → option α → set σ)
(start : set σ)
(accept : set σ)

variables {α : Type u} {σ σ' : Type v} (M : ε_NFA α σ) {S : set σ} {x : list α} {s : σ} {a : α}

namespace ε_NFA

/-- The `ε_closure` of a set is the set of states which can be reached by taking a finite string of
ε-transitions from an element of the set. -/
inductive ε_closure (S : set σ) : set σ
| base : ∀ s ∈ S, ε_closure s
| step : ∀ s (t ∈ M.step s none), ε_closure s → ε_closure t

@[simp] lemma subset_ε_closure (S : set σ) : S ⊆ M.ε_closure S := ε_closure.base

@[simp] lemma ε_closure_empty : M.ε_closure ∅ = ∅ :=
eq_empty_of_forall_not_mem $ λ s hs, by induction hs with t ht _ _ _ _ ih; assumption

@[simp] lemma ε_closure_univ : M.ε_closure univ = univ :=
eq_univ_of_univ_subset $ subset_ε_closure _ _

/-- `M.step_set S a` is the union of the ε-closure of `M.step s a` for all `s ∈ S`. -/
def step_set (S : set σ) (a : α) : set σ := ⋃ s ∈ S, M.ε_closure $ M.step s a

variables {M}

@[simp] lemma mem_step_set_iff : s ∈ M.step_set S a ↔ ∃ t ∈ S, s ∈ M.ε_closure (M.step t a) :=
mem_Union₂

@[simp] lemma step_set_empty (a : α) : M.step_set ∅ a = ∅ :=
by simp_rw [step_set, Union_false, Union_empty]

variables (M)

/-- `M.eval_from S x` computes all possible paths through `M` with input `x` starting at an element
of `S`. -/
def eval_from (start : set σ) : list α → set σ :=
list.foldl M.step_set (M.ε_closure start)

@[simp] lemma eval_from_nil (S : set σ) : M.eval_from S [] = M.ε_closure S := rfl
@[simp] lemma eval_from_singleton (S : set σ) (a : α) :
  M.eval_from S [a] = M.step_set (M.ε_closure S) a := rfl
@[simp] lemma eval_from_append_singleton (S : set σ) (x : list α) (a : α) :
  M.eval_from S (x ++ [a]) = M.step_set (M.eval_from S x) a :=
by simp only [eval_from, list.foldl_append, list.foldl_cons, list.foldl_nil]

@[simp] lemma eval_from_empty (x : list α) : M.eval_from ∅ x = ∅ :=
begin
  induction x using list.reverse_rec_on with x a ih,
  { rw [eval_from_nil, ε_closure_empty] },
  { rw [eval_from_append_singleton, ih, step_set_empty] }
end

/-- `M.eval x` computes all possible paths through `M` with input `x` starting at an element of
`M.start`. -/
def eval := M.eval_from M.start

@[simp] lemma eval_nil : M.eval [] = M.ε_closure M.start := rfl
@[simp] lemma eval_singleton (a : α) : M.eval [a] = M.step_set (M.ε_closure M.start) a := rfl
@[simp] lemma eval_append_singleton (x : list α) (a : α) :
  M.eval (x ++ [a]) = M.step_set (M.eval x) a :=
eval_from_append_singleton _ _ _ _

/-- `M.accepts` is the language of `x` such that there is an accept state in `M.eval x`. -/
def accepts : language α := {x | ∃ S ∈ M.accept, S ∈ M.eval x}

/-! ### Conversions between `ε_NFA` and `NFA` -/

/-- `M.to_NFA` is an `NFA` constructed from an `ε_NFA` `M`. -/
def to_NFA : NFA α σ :=
{ step := λ S a, M.ε_closure (M.step S a),
  start := M.ε_closure M.start,
  accept := M.accept }

@[simp] lemma to_NFA_eval_from_match (start : set σ) :
  M.to_NFA.eval_from (M.ε_closure start) = M.eval_from start := rfl

@[simp] lemma to_NFA_correct :
  M.to_NFA.accepts = M.accepts :=
begin
  ext x,
  rw [accepts, NFA.accepts, eval, NFA.eval, ←to_NFA_eval_from_match],
  refl
end

lemma pumping_lemma [fintype σ] {x : list α} (hx : x ∈ M.accepts)
  (hlen : fintype.card (set σ) ≤ list.length x) :
  ∃ a b c, x = a ++ b ++ c ∧ a.length + b.length ≤ fintype.card (set σ) ∧ b ≠ [] ∧
    {a} * {b}∗ * {c} ≤ M.accepts :=
begin
  rw ←to_NFA_correct at hx ⊢,
  exact M.to_NFA.pumping_lemma hx hlen
end

end ε_NFA

namespace NFA

/-- `M.to_ε_NFA` is an `ε_NFA` constructed from an `NFA` `M` by using the same start and accept
  states and transition functions. -/
def to_ε_NFA (M : NFA α σ) : ε_NFA α σ :=
{ step := λ s a, a.cases_on' ∅ (λ a, M.step s a),
  start := M.start,
  accept := M.accept }

@[simp] lemma to_ε_NFA_ε_closure (M : NFA α σ) (S : set σ) : M.to_ε_NFA.ε_closure S = S :=
begin
  ext a,
  refine ⟨_, ε_NFA.ε_closure.base _⟩,
  rintro (⟨_, h⟩ | ⟨_, _, h, _⟩),
  { exact h },
  { cases h }
end

@[simp] lemma to_ε_NFA_eval_from_match (M : NFA α σ) (start : set σ) :
  M.to_ε_NFA.eval_from start = M.eval_from start :=
begin
  rw [eval_from, ε_NFA.eval_from, to_ε_NFA_ε_closure],
  congr,
  ext S s,
  simp only [step_set, ε_NFA.step_set, exists_prop, set.mem_Union],
  apply exists_congr,
  simp only [and.congr_right_iff],
  intros t ht,
  rw M.to_ε_NFA_ε_closure,
  refl
end

@[simp] lemma to_ε_NFA_correct (M : NFA α σ) :
  M.to_ε_NFA.accepts = M.accepts :=
begin
  rw [accepts, ε_NFA.accepts, eval, ε_NFA.eval, to_ε_NFA_eval_from_match],
  refl
end

end NFA

/-! ### Regex-like operations -/

namespace ε_NFA

instance : has_zero (ε_NFA α σ) := ⟨⟨λ _ _, ∅, ∅, ∅⟩⟩
instance : has_one (ε_NFA α σ) := ⟨⟨λ _ _, ∅, univ, univ⟩⟩

instance : inhabited (ε_NFA α σ) := ⟨0⟩

variables (P : ε_NFA α σ) (Q : ε_NFA α σ')

@[simp] lemma step_zero (s a) : (0 : ε_NFA α σ).step s a = ∅ := rfl
@[simp] lemma step_one (s a) : (1 : ε_NFA α σ).step s a = ∅ := rfl

@[simp] lemma start_zero : (0 : ε_NFA α σ).start = ∅ := rfl
@[simp] lemma start_one : (1 : ε_NFA α σ).start = univ := rfl

@[simp]

end ε_NFA


/-
Copyright (c) 2021 Yourong Zang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yourong Zang, Yury Kudryashov

! This file was ported from Lean 3 source module topology.alexandroff
! leanprover-community/mathlib commit dc6c365e751e34d100e80fe6e314c3c3e0fd2988
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Fintype.Option
import Mathlib.Topology.Separation
import Mathlib.Topology.Sets.Opens

/-!
# The Alexandroff Compactification

We construct the Alexandroff compactification (the one-point compactification) of an arbitrary
topological space `X` and prove some properties inherited from `X`.

## Main definitions

* `Alexandroff`: the Alexandroff compactification, we use coercion for the canonical embedding
  `X → Alexandroff X`; when `X` is already compact, the compactification adds an isolated point
  to the space.
* `Alexandroff.infty`: the extra point

## Main results

* The topological structure of `Alexandroff X`
* The connectedness of `Alexandroff X` for a noncompact, preconnected `X`
* `Alexandroff X` is `T₀` for a T₀ space `X`
* `Alexandroff X` is `T₁` for a T₁ space `X`
* `Alexandroff X` is normal if `X` is a locally compact Hausdorff space

## Tags

one-point compactification, compactness
-/

open Set Filter Topology

/-!
### Definition and basic properties

In this section we define `Alexandroff X` to be the disjoint union of `X` and `∞`, implemented as
`Option X`. Then we restate some lemmas about `Option X` for `Alexandroff X`.
-/

variable {X : Type _}

/-- The Alexandroff extension of an arbitrary topological space `X` -/
def Alexandroff (X : Type _) :=
  Option X
#align alexandroff Alexandroff

/-- The repr uses the notation from the `Alexandroff` locale. -/
instance [Repr X] : Repr (Alexandroff X) :=
  ⟨fun o _ =>
    match o with
    | none => "∞"
    | some a => "↑" ++ repr a⟩

namespace Alexandroff

/-- The point at infinity -/
@[match_pattern] def infty : Alexandroff X := none
#align alexandroff.infty Alexandroff.infty

@[inherit_doc]
scoped notation "∞" => Alexandroff.infty

/-- Coercion from `X` to `Alexandroff X`. -/
@[coe, match_pattern] def some : X → Alexandroff X := Option.some

instance : CoeTC X (Alexandroff X) := ⟨some⟩

instance : Inhabited (Alexandroff X) := ⟨∞⟩

instance [Fintype X] : Fintype (Alexandroff X) :=
  inferInstanceAs (Fintype (Option X))

instance infinite [Infinite X] : Infinite (Alexandroff X) :=
  inferInstanceAs (Infinite (Option X))
#align alexandroff.infinite Alexandroff.infinite

theorem coe_injective : Function.Injective ((↑) : X → Alexandroff X) :=
  Option.some_injective X
#align alexandroff.coe_injective Alexandroff.coe_injective

@[norm_cast]
theorem coe_eq_coe {x y : X} : (x : Alexandroff X) = y ↔ x = y :=
  coe_injective.eq_iff
#align alexandroff.coe_eq_coe Alexandroff.coe_eq_coe

@[simp]
theorem coe_ne_infty (x : X) : (x : Alexandroff X) ≠ ∞ :=
  fun.
#align alexandroff.coe_ne_infty Alexandroff.coe_ne_infty

@[simp]
theorem infty_ne_coe (x : X) : ∞ ≠ (x : Alexandroff X) :=
  fun.
#align alexandroff.infty_ne_coe Alexandroff.infty_ne_coe

/-- Recursor for `Alexandroff` using the preferred forms `∞` and `↑x`. -/
@[elab_as_elim]
protected def rec {C : Alexandroff X → Sort _} (h₁ : C ∞) (h₂ : ∀ x : X, C x) :
    ∀ z : Alexandroff X, C z
  | ∞ => h₁
  | (x : X) => h₂ x
#align alexandroff.rec Alexandroff.rec

theorem isCompl_range_coe_infty : IsCompl (range ((↑) : X → Alexandroff X)) {∞} :=
  isCompl_range_some_none X
#align alexandroff.is_compl_range_coe_infty Alexandroff.isCompl_range_coe_infty

-- porting note: moved @[simp] to a new lemma
theorem range_coe_union_infty : range ((↑) : X → Alexandroff X) ∪ {∞} = univ :=
  range_some_union_none X
#align alexandroff.range_coe_union_infty Alexandroff.range_coe_union_infty

@[simp]
theorem insert_infty_range_coe : insert ∞ (range (@some X)) = univ :=
  insert_none_range_some _

@[simp]
theorem range_coe_inter_infty : range ((↑) : X → Alexandroff X) ∩ {∞} = ∅ :=
  range_some_inter_none X
#align alexandroff.range_coe_inter_infty Alexandroff.range_coe_inter_infty

@[simp]
theorem compl_range_coe : range ((↑) : X → Alexandroff X)ᶜ = {∞} :=
  compl_range_some X
#align alexandroff.compl_range_coe Alexandroff.compl_range_coe

theorem compl_infty : ({∞}ᶜ : Set (Alexandroff X)) = range ((↑) : X → Alexandroff X) :=
  (@isCompl_range_coe_infty X).symm.compl_eq
#align alexandroff.compl_infty Alexandroff.compl_infty

theorem compl_image_coe (s : Set X) : ((↑) '' s : Set (Alexandroff X))ᶜ = (↑) '' sᶜ ∪ {∞} := by
  rw [coe_injective.compl_image_eq, compl_range_coe]
#align alexandroff.compl_image_coe Alexandroff.compl_image_coe

theorem ne_infty_iff_exists {x : Alexandroff X} : x ≠ ∞ ↔ ∃ y : X, (y : Alexandroff X) = x := by
  induction x using Alexandroff.rec <;> simp
#align alexandroff.ne_infty_iff_exists Alexandroff.ne_infty_iff_exists

instance canLift : CanLift (Alexandroff X) X (↑) fun x => x ≠ ∞ :=
  WithTop.canLift
#align alexandroff.can_lift Alexandroff.canLift

theorem not_mem_range_coe_iff {x : Alexandroff X} : x ∉ range some ↔ x = ∞ := by
  rw [← mem_compl_iff, compl_range_coe, mem_singleton_iff]
#align alexandroff.not_mem_range_coe_iff Alexandroff.not_mem_range_coe_iff

theorem infty_not_mem_range_coe : ∞ ∉ range ((↑) : X → Alexandroff X) :=
  not_mem_range_coe_iff.2 rfl
#align alexandroff.infty_not_mem_range_coe Alexandroff.infty_not_mem_range_coe

theorem infty_not_mem_image_coe {s : Set X} : ∞ ∉ ((↑) : X → Alexandroff X) '' s :=
  not_mem_subset (image_subset_range _ _) infty_not_mem_range_coe
#align alexandroff.infty_not_mem_image_coe Alexandroff.infty_not_mem_image_coe

@[simp]
theorem coe_preimage_infty : ((↑) : X → Alexandroff X) ⁻¹' {∞} = ∅ := by
  ext
  simp
#align alexandroff.coe_preimage_infty Alexandroff.coe_preimage_infty

/-!
### Topological space structure on `Alexandroff X`

We define a topological space structure on `Alexandroff X` so that `s` is open if and only if

* `(↑) ⁻¹' s` is open in `X`;
* if `∞ ∈ s`, then `((↑) ⁻¹' s)ᶜ` is compact.

Then we reformulate this definition in a few different ways, and prove that
`(↑) : X → Alexandroff X` is an open embedding. If `X` is not a compact space, then we also prove
that `(↑)` has dense range, so it is a dense embedding.
-/

variable [TopologicalSpace X]

instance : TopologicalSpace (Alexandroff X) where
  IsOpen s := (∞ ∈ s → IsCompact ((((↑) : X → Alexandroff X) ⁻¹' s)ᶜ)) ∧
    IsOpen (((↑) : X → Alexandroff X) ⁻¹' s)
  isOpen_univ := by simp
  isOpen_inter s t := by
    rintro ⟨hms, hs⟩ ⟨hmt, ht⟩
    refine' ⟨_, hs.inter ht⟩
    rintro ⟨hms', hmt'⟩
    simpa [compl_inter] using (hms hms').union (hmt hmt')
  isOpen_unionₛ S ho := by
    suffices IsOpen ((↑) ⁻¹' ⋃₀ S : Set X) by
      refine' ⟨_, this⟩
      rintro ⟨s, hsS : s ∈ S, hs : ∞ ∈ s⟩
      refine' isCompact_of_isClosed_subset ((ho s hsS).1 hs) this.isClosed_compl _
      exact compl_subset_compl.mpr (preimage_mono <| subset_unionₛ_of_mem hsS)
    rw [preimage_unionₛ]
    exact isOpen_bunionᵢ fun s hs => (ho s hs).2

variable {s : Set (Alexandroff X)} {t : Set X}

theorem isOpen_def :
    IsOpen s ↔ (∞ ∈ s → IsCompact (((↑) ⁻¹' s : Set X)ᶜ)) ∧ IsOpen ((↑) ⁻¹' s : Set X) :=
  Iff.rfl
#align alexandroff.is_open_def Alexandroff.isOpen_def

theorem isOpen_iff_of_mem' (h : ∞ ∈ s) :
    IsOpen s ↔ IsCompact (((↑) ⁻¹' s : Set X)ᶜ) ∧ IsOpen ((↑) ⁻¹' s : Set X) := by
  simp [isOpen_def, h]
#align alexandroff.is_open_iff_of_mem' Alexandroff.isOpen_iff_of_mem'

theorem isOpen_iff_of_mem (h : ∞ ∈ s) :
    IsOpen s ↔ IsClosed (((↑) ⁻¹' s : Set X)ᶜ) ∧ IsCompact (((↑) ⁻¹' s : Set X)ᶜ) := by
  simp only [isOpen_iff_of_mem' h, isClosed_compl_iff, and_comm]
#align alexandroff.is_open_iff_of_mem Alexandroff.isOpen_iff_of_mem

theorem isOpen_iff_of_not_mem (h : ∞ ∉ s) : IsOpen s ↔ IsOpen ((↑) ⁻¹' s : Set X) := by
  simp [isOpen_def, h]
#align alexandroff.is_open_iff_of_not_mem Alexandroff.isOpen_iff_of_not_mem

theorem isClosed_iff_of_mem (h : ∞ ∈ s) : IsClosed s ↔ IsClosed ((↑) ⁻¹' s : Set X) := by
  have : ∞ ∉ sᶜ := fun H => H h
  rw [← isOpen_compl_iff, isOpen_iff_of_not_mem this, ← isOpen_compl_iff, preimage_compl]
#align alexandroff.is_closed_iff_of_mem Alexandroff.isClosed_iff_of_mem

theorem isClosed_iff_of_not_mem (h : ∞ ∉ s) :
    IsClosed s ↔ IsClosed ((↑) ⁻¹' s : Set X) ∧ IsCompact ((↑) ⁻¹' s : Set X) := by
  rw [← isOpen_compl_iff, isOpen_iff_of_mem (mem_compl h), ← preimage_compl, compl_compl]
#align alexandroff.is_closed_iff_of_not_mem Alexandroff.isClosed_iff_of_not_mem

@[simp]
theorem isOpen_image_coe {s : Set X} : IsOpen ((↑) '' s : Set (Alexandroff X)) ↔ IsOpen s := by
  rw [isOpen_iff_of_not_mem infty_not_mem_image_coe, preimage_image_eq _ coe_injective]
#align alexandroff.is_open_image_coe Alexandroff.isOpen_image_coe

theorem isOpen_compl_image_coe {s : Set X} :
    IsOpen (((↑) '' s : Set (Alexandroff X))ᶜ) ↔ IsClosed s ∧ IsCompact s := by
  rw [isOpen_iff_of_mem, ← preimage_compl, compl_compl, preimage_image_eq _ coe_injective]
  exact infty_not_mem_image_coe
#align alexandroff.is_open_compl_image_coe Alexandroff.isOpen_compl_image_coe

@[simp]
theorem isClosed_image_coe {s : Set X} :
    IsClosed ((↑) '' s : Set (Alexandroff X)) ↔ IsClosed s ∧ IsCompact s := by
  rw [← isOpen_compl_iff, isOpen_compl_image_coe]
#align alexandroff.is_closed_image_coe Alexandroff.isClosed_image_coe

/-- An open set in `Alexandroff X` constructed from a closed compact set in `X` -/
def opensOfCompl (s : Set X) (h₁ : IsClosed s) (h₂ : IsCompact s) :
    TopologicalSpace.Opens (Alexandroff X) :=
  ⟨((↑) '' s)ᶜ, isOpen_compl_image_coe.2 ⟨h₁, h₂⟩⟩
#align alexandroff.opens_of_compl Alexandroff.opensOfCompl

theorem infty_mem_opensOfCompl {s : Set X} (h₁ : IsClosed s) (h₂ : IsCompact s) :
    ∞ ∈ opensOfCompl s h₁ h₂ :=
  mem_compl infty_not_mem_image_coe
#align alexandroff.infty_mem_opens_of_compl Alexandroff.infty_mem_opensOfCompl

@[continuity]
theorem continuous_coe : Continuous ((↑) : X → Alexandroff X) :=
  continuous_def.mpr fun _s hs => hs.right
#align alexandroff.continuous_coe Alexandroff.continuous_coe

theorem isOpenMap_coe : IsOpenMap ((↑) : X → Alexandroff X) := fun _ => isOpen_image_coe.2
#align alexandroff.is_open_map_coe Alexandroff.isOpenMap_coe

theorem openEmbedding_coe : OpenEmbedding ((↑) : X → Alexandroff X) :=
  openEmbedding_of_continuous_injective_open continuous_coe coe_injective isOpenMap_coe
#align alexandroff.open_embedding_coe Alexandroff.openEmbedding_coe

theorem isOpen_range_coe : IsOpen (range ((↑) : X → Alexandroff X)) :=
  openEmbedding_coe.open_range
#align alexandroff.is_open_range_coe Alexandroff.isOpen_range_coe

theorem isClosed_infty : IsClosed ({∞} : Set (Alexandroff X)) := by
  rw [← compl_range_coe, isClosed_compl_iff]
  exact isOpen_range_coe
#align alexandroff.is_closed_infty Alexandroff.isClosed_infty

theorem nhds_coe_eq (x : X) : 𝓝 ↑x = map ((↑) : X → Alexandroff X) (𝓝 x) :=
  (openEmbedding_coe.map_nhds_eq x).symm
#align alexandroff.nhds_coe_eq Alexandroff.nhds_coe_eq

theorem nhdsWithin_coe_image (s : Set X) (x : X) :
    𝓝[(↑) '' s] (x : Alexandroff X) = map (↑) (𝓝[s] x) :=
  (openEmbedding_coe.toEmbedding.map_nhdsWithin_eq _ _).symm
#align alexandroff.nhds_within_coe_image Alexandroff.nhdsWithin_coe_image

theorem nhdsWithin_coe (s : Set (Alexandroff X)) (x : X) : 𝓝[s] ↑x = map (↑) (𝓝[(↑) ⁻¹' s] x) :=
  (openEmbedding_coe.map_nhdsWithin_preimage_eq _ _).symm
#align alexandroff.nhds_within_coe Alexandroff.nhdsWithin_coe

theorem comap_coe_nhds (x : X) : comap ((↑) : X → Alexandroff X) (𝓝 x) = 𝓝 x :=
  (openEmbedding_coe.toInducing.nhds_eq_comap x).symm
#align alexandroff.comap_coe_nhds Alexandroff.comap_coe_nhds

/-- If `x` is not an isolated point of `X`, then `x : Alexandroff X` is not an isolated point
of `Alexandroff X`. -/
instance nhdsWithin_compl_coe_neBot (x : X) [h : NeBot (𝓝[≠] x)] :
    NeBot (𝓝[≠] (x : Alexandroff X)) := by
  simpa [nhdsWithin_coe, preimage, coe_eq_coe] using h.map some
#align alexandroff.nhds_within_compl_coe_ne_bot Alexandroff.nhdsWithin_compl_coe_neBot

theorem nhdsWithin_compl_infty_eq : 𝓝[≠] (∞ : Alexandroff X) = map (↑) (coclosedCompact X) := by
  refine' (nhdsWithin_basis_open ∞ _).ext (hasBasis_coclosedCompact.map _) _ _
  · rintro s ⟨hs, hso⟩
    refine' ⟨_, (isOpen_iff_of_mem hs).mp hso, _⟩
    simp [Subset.rfl]
  · rintro s ⟨h₁, h₂⟩
    refine' ⟨_, ⟨mem_compl infty_not_mem_image_coe, isOpen_compl_image_coe.2 ⟨h₁, h₂⟩⟩, _⟩
    simp [compl_image_coe, ← diff_eq, subset_preimage_image]
#align alexandroff.nhds_within_compl_infty_eq Alexandroff.nhdsWithin_compl_infty_eq

/-- If `X` is a non-compact space, then `∞` is not an isolated point of `Alexandroff X`. -/
instance nhdsWithin_compl_infty_neBot [NoncompactSpace X] : NeBot (𝓝[≠] (∞ : Alexandroff X)) := by
  rw [nhdsWithin_compl_infty_eq]
  infer_instance
#align alexandroff.nhds_within_compl_infty_ne_bot Alexandroff.nhdsWithin_compl_infty_neBot

instance (priority := 900) nhdsWithin_compl_neBot [∀ x : X, NeBot (𝓝[≠] x)] [NoncompactSpace X]
    (x : Alexandroff X) : NeBot (𝓝[≠] x) :=
  Alexandroff.rec Alexandroff.nhdsWithin_compl_infty_neBot
    (fun y => Alexandroff.nhdsWithin_compl_coe_neBot y) x
#align alexandroff.nhds_within_compl_ne_bot Alexandroff.nhdsWithin_compl_neBot

theorem nhds_infty_eq : 𝓝 (∞ : Alexandroff X) = map (↑) (coclosedCompact X) ⊔ pure ∞ := by
  rw [← nhdsWithin_compl_infty_eq, nhdsWithin_compl_singleton_sup_pure]
#align alexandroff.nhds_infty_eq Alexandroff.nhds_infty_eq

theorem hasBasis_nhds_infty :
    (𝓝 (∞ : Alexandroff X)).HasBasis (fun s : Set X => IsClosed s ∧ IsCompact s) fun s =>
      (↑) '' sᶜ ∪ {∞} := by
  rw [nhds_infty_eq]
  exact (hasBasis_coclosedCompact.map _).sup_pure _
#align alexandroff.has_basis_nhds_infty Alexandroff.hasBasis_nhds_infty

@[simp]
theorem comap_coe_nhds_infty : comap ((↑) : X → Alexandroff X) (𝓝 ∞) = coclosedCompact X := by
  simp [nhds_infty_eq, comap_sup, comap_map coe_injective]
#align alexandroff.comap_coe_nhds_infty Alexandroff.comap_coe_nhds_infty

theorem le_nhds_infty {f : Filter (Alexandroff X)} :
    f ≤ 𝓝 ∞ ↔ ∀ s : Set X, IsClosed s → IsCompact s → (↑) '' sᶜ ∪ {∞} ∈ f := by
  simp only [hasBasis_nhds_infty.ge_iff, and_imp]
#align alexandroff.le_nhds_infty Alexandroff.le_nhds_infty

theorem ultrafilter_le_nhds_infty {f : Ultrafilter (Alexandroff X)} :
    (f : Filter (Alexandroff X)) ≤ 𝓝 ∞ ↔ ∀ s : Set X, IsClosed s → IsCompact s → (↑) '' s ∉ f := by
  simp only [le_nhds_infty, ← compl_image_coe, Ultrafilter.mem_coe,
    Ultrafilter.compl_mem_iff_not_mem]
#align alexandroff.ultrafilter_le_nhds_infty Alexandroff.ultrafilter_le_nhds_infty

theorem tendsto_nhds_infty' {α : Type _} {f : Alexandroff X → α} {l : Filter α} :
    Tendsto f (𝓝 ∞) l ↔ Tendsto f (pure ∞) l ∧ Tendsto (f ∘ (↑)) (coclosedCompact X) l := by
  simp [nhds_infty_eq, and_comm]
#align alexandroff.tendsto_nhds_infty' Alexandroff.tendsto_nhds_infty'

theorem tendsto_nhds_infty {α : Type _} {f : Alexandroff X → α} {l : Filter α} :
    Tendsto f (𝓝 ∞) l ↔
      ∀ s ∈ l, f ∞ ∈ s ∧ ∃ t : Set X, IsClosed t ∧ IsCompact t ∧ MapsTo (f ∘ (↑)) (tᶜ) s :=
  tendsto_nhds_infty'.trans <| by
    simp only [tendsto_pure_left, hasBasis_coclosedCompact.tendsto_left_iff, forall_and,
      and_assoc, exists_prop]
#align alexandroff.tendsto_nhds_infty Alexandroff.tendsto_nhds_infty

theorem continuousAt_infty' {Y : Type _} [TopologicalSpace Y] {f : Alexandroff X → Y} :
    ContinuousAt f ∞ ↔ Tendsto (f ∘ (↑)) (coclosedCompact X) (𝓝 (f ∞)) :=
  tendsto_nhds_infty'.trans <| and_iff_right (tendsto_pure_nhds _ _)
#align alexandroff.continuous_at_infty' Alexandroff.continuousAt_infty'

theorem continuousAt_infty {Y : Type _} [TopologicalSpace Y] {f : Alexandroff X → Y} :
    ContinuousAt f ∞ ↔
      ∀ s ∈ 𝓝 (f ∞), ∃ t : Set X, IsClosed t ∧ IsCompact t ∧ MapsTo (f ∘ (↑)) (tᶜ) s :=
  continuousAt_infty'.trans <| by simp only [hasBasis_coclosedCompact.tendsto_left_iff, and_assoc]
#align alexandroff.continuous_at_infty Alexandroff.continuousAt_infty

theorem continuousAt_coe {Y : Type _} [TopologicalSpace Y] {f : Alexandroff X → Y} {x : X} :
    ContinuousAt f x ↔ ContinuousAt (f ∘ (↑)) x := by
  rw [ContinuousAt, nhds_coe_eq, tendsto_map'_iff, ContinuousAt]; rfl
#align alexandroff.continuous_at_coe Alexandroff.continuousAt_coe

/-- If `X` is not a compact space, then the natural embedding `X → Alexandroff X` has dense range.
-/
theorem denseRange_coe [NoncompactSpace X] : DenseRange ((↑) : X → Alexandroff X) := by
  rw [DenseRange, ← compl_infty]
  exact dense_compl_singleton _
#align alexandroff.dense_range_coe Alexandroff.denseRange_coe

theorem denseEmbedding_coe [NoncompactSpace X] : DenseEmbedding ((↑) : X → Alexandroff X) :=
  { openEmbedding_coe with dense := denseRange_coe }
#align alexandroff.dense_embedding_coe Alexandroff.denseEmbedding_coe

@[simp]
theorem specializes_coe {x y : X} : (x : Alexandroff X) ⤳ y ↔ x ⤳ y :=
  openEmbedding_coe.toInducing.specializes_iff
#align alexandroff.specializes_coe Alexandroff.specializes_coe

@[simp]
theorem inseparable_coe {x y : X} : Inseparable (x : Alexandroff X) y ↔ Inseparable x y :=
  openEmbedding_coe.toInducing.inseparable_iff
#align alexandroff.inseparable_coe Alexandroff.inseparable_coe

theorem not_specializes_infty_coe {x : X} : ¬Specializes ∞ (x : Alexandroff X) :=
  isClosed_infty.not_specializes rfl (coe_ne_infty x)
#align alexandroff.not_specializes_infty_coe Alexandroff.not_specializes_infty_coe

theorem not_inseparable_infty_coe {x : X} : ¬Inseparable ∞ (x : Alexandroff X) := fun h =>
  not_specializes_infty_coe h.specializes
#align alexandroff.not_inseparable_infty_coe Alexandroff.not_inseparable_infty_coe

theorem not_inseparable_coe_infty {x : X} : ¬Inseparable (x : Alexandroff X) ∞ := fun h =>
  not_specializes_infty_coe h.specializes'
#align alexandroff.not_inseparable_coe_infty Alexandroff.not_inseparable_coe_infty

theorem inseparable_iff {x y : Alexandroff X} :
    Inseparable x y ↔ x = ∞ ∧ y = ∞ ∨ ∃ x' : X, x = x' ∧ ∃ y' : X, y = y' ∧ Inseparable x' y' := by
  induction x using Alexandroff.rec <;> induction y using Alexandroff.rec <;>
    simp [not_inseparable_infty_coe, not_inseparable_coe_infty, coe_eq_coe, Inseparable.refl]
#align alexandroff.inseparable_iff Alexandroff.inseparable_iff

/-!
### Compactness and separation properties

In this section we prove that `Alexandroff X` is a compact space; it is a T₀ (resp., T₁) space if
the original space satisfies the same separation axiom. If the original space is a locally compact
Hausdorff space, then `Alexandroff X` is a normal (hence, T₃ and Hausdorff) space.

Finally, if the original space `X` is *not* compact and is a preconnected space, then
`Alexandroff X` is a connected space.
-/

/-- For any topological space `X`, its one point compactification is a compact space. -/
instance : CompactSpace (Alexandroff X) where
  isCompact_univ := by
    have : Tendsto ((↑) : X → Alexandroff X) (cocompact X) (𝓝 ∞) := by
      rw [nhds_infty_eq]
      exact (tendsto_map.mono_left cocompact_le_coclosedCompact).mono_right le_sup_left
    rw [← insert_none_range_some X]
    exact this.isCompact_insert_range_of_cocompact continuous_coe

/-- The one point compactification of a `T0Space` space is a `T0Space`. -/
instance [T0Space X] : T0Space (Alexandroff X) := by
  refine' ⟨fun x y hxy => _⟩
  rcases inseparable_iff.1 hxy with (⟨rfl, rfl⟩ | ⟨x, rfl, y, rfl, h⟩)
  exacts [rfl, congr_arg some h.eq]

/-- The one point compactification of a `T1Space` space is a `T1Space`. -/
instance [T1Space X] : T1Space (Alexandroff X) where
  t1 z := by
    induction z using Alexandroff.rec
    · exact isClosed_infty
    · rw [← image_singleton, isClosed_image_coe]
      exact ⟨isClosed_singleton, isCompact_singleton⟩

/-- The one point compactification of a locally compact Hausdorff space is a normal (hence,
Hausdorff and regular) topological space. -/
instance [LocallyCompactSpace X] [T2Space X] : NormalSpace (Alexandroff X) := by
  have key : ∀ z : X, Disjoint (𝓝 (some z)) (𝓝 ∞) := fun z => by
    rw [nhds_infty_eq, disjoint_sup_right, nhds_coe_eq, coclosedCompact_eq_cocompact,
      disjoint_map coe_injective, ← principal_singleton, disjoint_principal_right, compl_infty]
    exact ⟨disjoint_nhds_cocompact z, range_mem_map⟩
  suffices : T2Space (Alexandroff X); exact normalOfCompactT2
  refine t2Space_iff_disjoint_nhds.2 fun x y hxy => ?_
  induction x using Alexandroff.rec <;> induction y using Alexandroff.rec
  · exact (hxy rfl).elim
  · exact (key _).symm
  · exact key _
  · rwa [nhds_coe_eq, nhds_coe_eq, disjoint_map coe_injective, disjoint_nhds_nhds,
      ← coe_injective.ne_iff]

/-- If `X` is not a compact space, then `Alexandroff X` is a connected space. -/
instance [PreconnectedSpace X] [NoncompactSpace X] : ConnectedSpace (Alexandroff X) where
  toPreconnectedSpace := denseEmbedding_coe.toDenseInducing.preconnectedSpace
  toNonempty := inferInstance

/-- If `X` is an infinite type with discrete topology (e.g., `ℕ`), then the identity map from
`CofiniteTopology (Alexandroff X)` to `Alexandroff X` is not continuous. -/
theorem not_continuous_cofiniteTopology_of_symm [Infinite X] [DiscreteTopology X] :
    ¬Continuous (@CofiniteTopology.of (Alexandroff X)).symm := by
  inhabit X
  simp only [continuous_iff_continuousAt, ContinuousAt, not_forall]
  use CofiniteTopology.of ↑(default : X)
  simpa [nhds_coe_eq, nhds_discrete, CofiniteTopology.nhds_eq] using
    (finite_singleton ((default : X) : Alexandroff X)).infinite_compl
#align alexandroff.not_continuous_cofinite_topology_of_symm Alexandroff.not_continuous_cofiniteTopology_of_symm

end Alexandroff

/-- A concrete counterexample shows that  `Continuous.homeoOfEquivCompactToT2`
cannot be generalized from `T2Space` to `T1Space`.

Let `α = Alexandroff ℕ` be the one-point compactification of `ℕ`, and let `β` be the same space
`Alexandroff ℕ` with the cofinite topology.  Then `α` is compact, `β` is T1, and the identity map
`id : α → β` is a continuous equivalence that is not a homeomorphism.
-/
theorem Continuous.homeoOfEquivCompactToT2.t1_counterexample :
    ∃ (α β : Type) (_ : TopologicalSpace α) (_ : TopologicalSpace β),
      CompactSpace α ∧ T1Space β ∧ ∃ f : α ≃ β, Continuous f ∧ ¬Continuous f.symm :=
  ⟨Alexandroff ℕ, CofiniteTopology (Alexandroff ℕ), inferInstance, inferInstance, inferInstance,
    inferInstance, CofiniteTopology.of, CofiniteTopology.continuous_of,
    Alexandroff.not_continuous_cofiniteTopology_of_symm⟩
#align continuous.homeo_of_equiv_compact_to_t2.t1_counterexample Continuous.homeoOfEquivCompactToT2.t1_counterexample


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import algebra.hom.equiv
import logic.function.conjugate
import order.conditionally_complete_lattice
import order.ord_continuous

/-!
# Semiconjugate by `Sup`

In this file we prove two facts about semiconjugate (families of) functions.

First, if an order isomorphism `fa : α → α` is semiconjugate to an order embedding `fb : β → β` by
`g : α → β`, then `fb` is semiconjugate to `fa` by `y ↦ Sup {x | g x ≤ y}`, see
`semiconj.symm_adjoint`.

Second, consider two actions `f₁ f₂ : G → α → α` of a group on a complete lattice by order
isomorphisms. Then the map `x ↦ ⨆ g : G, (f₁ g)⁻¹ (f₂ g x)` semiconjugates each `f₁ g'` to `f₂ g'`,
see `function.Sup_div_semiconj`.  In the case of a conditionally complete lattice, a similar
statement holds true under an additional assumption that each set `{(f₁ g)⁻¹ (f₂ g x) | g : G}` is
bounded above, see `function.cSup_div_semiconj`.

The lemmas come from [Étienne Ghys, Groupes d'homeomorphismes du cercle et cohomologie
bornee][ghys87:groupes], Proposition 2.1 and 5.4 respectively. In the paper they are formulated for
homeomorphisms of the circle, so in order to apply results from this file one has to lift these
homeomorphisms to the real line first.
-/

variables {α β γ : Type*}

open set

/-- We say that `g : β → α` is an order right adjoint function for `f : α → β` if it sends each `y`
to a least upper bound for `{x | f x ≤ y}`. If `α` is a partial order, and `f : α → β` has
a right adjoint, then this right adjoint is unique. -/
def is_order_right_adjoint [preorder α] [preorder β] (f : α → β) (g : β → α) :=
∀ y, is_lub {x | f x ≤ y} (g y)

lemma is_order_right_adjoint_Sup [complete_lattice α] [preorder β] (f : α → β) :
  is_order_right_adjoint f (λ y, Sup {x | f x ≤ y}) :=
λ y, is_lub_Sup _

lemma is_order_right_adjoint_cSup [conditionally_complete_lattice α] [preorder β] (f : α → β)
  (hne : ∀ y, ∃ x, f x ≤ y) (hbdd : ∀ y, bdd_above {x | f x ≤ y}) :
  is_order_right_adjoint f (λ y, Sup {x | f x ≤ y}) :=
λ y, is_lub_cSup (hne y) (hbdd y)

namespace is_order_right_adjoint

protected

lemma right_mono [preorder α] [preorder β] {f : α → β} {g : β → α}
  (h : is_order_right_adjoint f g) :
  monotone g :=
λ y₁ y₂ hy, (h y₁).mono (h y₂) $ λ x hx, le_trans hx hy

lemma order_iso_comp [preorder α] [preorder β] [preorder γ] {f : α → β} {g : β → α}
  (h : is_order_right_adjoint f g) (e : β ≃o γ) :
  is_order_right_adjoint (e ∘ f) (g ∘ e.symm) :=
λ y, by simpa [e.le_symm_apply] using h (e.symm y)

lemma comp_order_iso [preorder α] [preorder β] [preorder γ] {f : α → β} {g : β → α}
  (h : is_order_right_adjoint f g) (e : γ ≃o α) :
  is_order_right_adjoint (f ∘ e) (e.symm ∘ g) :=
begin
  intro y,
  change is_lub (e ⁻¹' {x | f x ≤ y}) (e.symm (g y)),
  rw [e.is_lub_preimage, e.apply_symm_apply],
  exact h y
end

end is_order_right_adjoint

namespace function

/-- If an order automorphism `fa` is semiconjugate to an order embedding `fb` by a function `g`
and `g'` is an order right adjoint of `g` (i.e. `g' y = Sup {x | f x ≤ y}`), then `fb` is
semiconjugate to `fa` by `g'`.

This is a version of Proposition 2.1 from [Étienne Ghys, Groupes d'homeomorphismes du cercle et
cohomologie bornee][ghys87:groupes]. -/
lemma semiconj.symm_adjoint [partial_order α] [preorder β]
  {fa : α ≃o α}
  {fb : β ↪o β} {g : α → β}
  (h : function.semiconj g fa fb) {g' : β → α} (hg' : is_order_right_adjoint g g') :
  function.semiconj g' fb fa :=
begin
  refine λ y, (hg' _).unique _,
  rw [← fa.surjective.image_preimage {x | g x ≤ fb y}, preimage_set_of_eq],
  simp only [h.eq, fb.le_iff_le, fa.left_ord_continuous (hg' _)]
end

variable {G : Type*}

lemma semiconj_of_is_lub [partial_order α] [group G]
  (f₁ f₂ : G →* (α ≃o α)) {h : α → α}
  (H : ∀ x, is_lub (range (λ g', (f₁ g')⁻¹ (f₂ g' x))) (h x)) (g : G) :
  function.semiconj h (f₂ g) (f₁ g) :=
begin
  refine λ y, (H _).unique _,
  have := (f₁ g).left_ord_continuous (H y),
  rw [← range_comp, ← (equiv.mul_right g).surjective.range_comp _] at this,
  simpa [(∘)] using this
end

/-- Consider two actions `f₁ f₂ : G → α → α` of a group on a complete lattice by order
isomorphisms. Then the map `x ↦ ⨆ g : G, (f₁ g)⁻¹ (f₂ g x)` semiconjugates each `f₁ g'` to `f₂ g'`.

This is a version of Proposition 5.4 from [Étienne Ghys, Groupes d'homeomorphismes du cercle et
cohomologie bornee][ghys87:groupes]. -/
lemma Sup_div_semiconj [complete_lattice α] [group G]
  (f₁ f₂ : G →* (α ≃o α)) (g : G) :
  function.semiconj (λ x, ⨆ g' : G, (f₁ g')⁻¹ (f₂ g' x)) (f₂ g) (f₁ g) :=
semiconj_of_is_lub f₁ f₂ (λ x, is_lub_supr) _

/-- Consider two actions `f₁ f₂ : G → α → α` of a group on a conditionally complete lattice by order
isomorphisms. Suppose that each set $s(x)=\{f_1(g)^{-1} (f_2(g)(x)) | g \in G\}$ is bounded above.
Then the map `x ↦ Sup s(x)` semiconjugates each `f₁ g'` to `f₂ g'`.

This is a version of Proposition 5.4 from [Étienne Ghys, Groupes d'homeomorphismes du cercle et
cohomologie bornee][ghys87:groupes]. -/
lemma cSup_div_semiconj [conditionally_complete_lattice α] [group G]
  (f₁ f₂ : G →* (α ≃o α))
  (hbdd : ∀ x, bdd_above (range $ λ g, (f₁ g)⁻¹ (f₂ g x))) (g : G) :
  function.semiconj (λ x, ⨆ g' : G, (f₁ g')⁻¹ (f₂ g' x)) (f₂ g) (f₁ g) :=
semiconj_of_is_lub f₁ f₂ (λ x, is_lub_cSup (range_nonempty _) (hbdd x)) _

end function


import set_tactic.freealg

open interactive
open lean.parser
open tactic
open tactic.interactive («let» «have» simp refl)
open freealg

------------------------- Conversion Tactic: [(finset α) or (set α) or boolean_lattice] to [boolean_ring]

lemma finset.inter_is_inf (α : Type u) [decidable_eq α] (X Y : finset α) : X ∩ Y = X ⊓ Y := rfl
lemma finset.union_is_sup (α : Type u) [decidable_eq α] (X Y : finset α) : X ∪ Y = X ⊔ Y := rfl
lemma finset.empt_is_bot (α : Type u) [decidable_eq α] : (finset.has_emptyc.emptyc : finset α) = ⊥ := rfl
lemma finset.subset_is_le (α : Type u) [decidable_eq α] (X Y : finset α) : (X ⊆ Y) = (X ≤ Y) := rfl
--lemma finset.univ_is_top (α : Type u) [decidable_eq α] : (finset.order_top : finset α) = ⊤ :=

lemma set.union_is_sup (α : Type u) (X Y : set α) : X ∪ Y = X ⊔ Y := rfl
lemma set.inter_is_inf (α : Type u) (X Y : set α) : X ∩ Y = X ⊓ Y := rfl
lemma set.empt_is_bot (α : Type u) : (set.has_emptyc.emptyc : set α) = ⊥ := rfl
lemma set.univ_is_top (α : Type u) : (set.univ : set α) = ⊤ := rfl
lemma set.subset_is_le (α : Type u) (X Y : set α) : (X ⊆ Y) = (X ≤ Y) := rfl

meta def to_ring_eqn : tactic unit := do
`[try {simp only
    [finset.inter_is_inf, finset.union_is_sup, finset.empt_is_bot, finset.subset_is_le,
     set.union_is_sup, set.inter_is_inf, set.empt_is_bot, set.univ_is_top, set.subset_is_le,
     top_to_ring, bot_to_ring, symm_diff_to_ring, inf_to_ring, sup_to_ring,
      diff_to_ring, compl_to_ring, le_to_ring] at *}]

------------------------------ Normalization Tactics (in a free boolean algebra) -------------------------
meta def ids_list : lean.parser (list name) := types.list_of ident
meta def meta_build_vector : list pexpr -> pexpr
| [] := ``(vector.nil)
| (v :: vs) := ``(vector.cons %%v %%(meta_build_vector vs))
meta def list_with_idx {T : Type} : (list T) → nat -> list (nat × T)
| [] n := []
| (v :: vs) n := (n, v) :: list_with_idx vs (n + 1)

meta def tactic.interactive.introduce_varmap_rewrite (vname : parse ident) (vars : parse ids_list) : tactic unit :=
  do
    names <- vars.mmap (fun name, get_local name),
    («let» vname ``(vector _ %%(vars.length)) $ meta_build_vector (names.map to_pexpr)),
    mmap
      (λ (pair : (nat × expr)),
        let name := prod.snd pair in
        let idx := prod.fst pair in
        do
          vname_expr <- get_local vname,
          hname <- get_unused_name `Hv,
          («have» hname ``(%%name = _) ``(on_var %%vname_expr %%idx (by norm_num))),
          hname_expr <- get_local hname,
          tactic.try (rewrite_target hname_expr),
          return ())
      (list_with_idx names 0),
    return ()

meta def find_matching_type (e : expr) : list expr → tactic expr
| []         := tactic.failed
| (H :: Hs)  := do t ← tactic.infer_type H,
                   (tactic.unify e t >> return H) <|> find_matching_type Hs
set_option pp.all false
meta def get_sets_in_expr : expr → tactic (list name)
| e :=
  match e with
  -- This mostly handles basic expressions
  | expr.local_const unique pretty _ _ :=
    do
      expr <- get_local pretty,
      ((do
        `(finset _) <- tactic.infer_type expr,
        return [pretty])
      <|>
       (do
        `(set _) <- tactic.infer_type expr,
        return [pretty])
      <|>
       (do
        `(%%typ) <- tactic.infer_type expr,
        boolalg_expr_to_find <- to_expr ``(boolean_algebra %%typ),
        _ <- find_assumption boolalg_expr_to_find,
        return [pretty])
      <|>
        return [])
  | expr.app e1 e2 :=
    do l1 <- get_sets_in_expr e1,
       l2 <- get_sets_in_expr e2,
       return (l1 ++ l2)
  | _ := do return []
  end

def keep_unique {T: Type} [decidable_eq T]: list T -> list T
| [] := []
| (x :: xs) := let tl := keep_unique xs in
                if list.mem x tl then tl else x :: tl
#reduce keep_unique [1, 2, 3, 1, 1]

/- A bound variable with a de-Bruijn index. -/
-- | var _ := tactic.failed ()
/- A type universe: `Sort u` -/
-- | sort l := do return ()
/- A global constant. These include definitions, constants and inductive type stuff present
in the environment as well as hard-coded definitions. -/
-- | const name l := do return ()
/- [WARNING] Do not trust the types for `mvar` and `local_const`,
they are sometimes dummy values. Use `tactic.infer_type` instead. -/
/- An `mvar` is a 'hole' yet to be filled in by the elaborator or tactic state. -/
-- | mvar unique pretty type := do return ()
/- A local constant. For example, if our tactic state was `h : P ⊢ Q`, `h` would be a local constant. -/
-- | local_const unique pretty binder type := do return ()
/- Function application. -/
-- | app e1 e2 := do return ()
/- Lambda abstraction. eg ```(λ a : α, x)`` -/
-- | lam name binder type body := do return ()
/- Pi type constructor. eg ```(Π a : α, x)`` and ```(α → β)`` -/
-- | pi name binder type body := do return ()
/- An explicit let binding. -/
--| elet name type assignment body := do return ()
/- A macro, see the docstring for `macro_def`.
  The list of expressions are local constants and metavariables that the macro depends on.
  -/
-- | expr.macro macro_def body := do return ()

meta def dummy : tactic unit :=
  do tactic.trace "Hello World"

meta def tactic.interactive.simplify_sets (extra_sets : (parse (optional ids_list))) : tactic unit :=
  do
    -- TODO: actually check the goal is of the form of some boolalg equation
    --       also -- do something about hypotheses...
    texpr <- target,
    list_of_sets <- get_sets_in_expr texpr,
    vname <- get_unused_name `V,
    tactic.interactive.introduce_varmap_rewrite vname
      (keep_unique $ list_of_sets ++ match extra_sets with | some l := l | none := [] end ),
    vname_expr <- get_local vname,
    to_ring_eqn,
    -- Some goals are already discharged by this point, so everything else
    -- goes in a try block.

    tactic.try (simp none tt ([``(freealg.on_one %%vname_expr),
                   ``(freealg.on_add %%vname_expr),
                   ``(freealg.on_mul %%vname_expr),
                   ``(freealg.on_zero %%vname_expr),
                   ``(freealg.on_var %%vname_expr)].map simp_arg_type.expr)
                    list.nil loc.wildcard),
    tactic.try (refl)