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

! This file was ported from Lean 3 source module number_theory.liouville.liouville_with
! 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.Analysis.SpecialFunctions.Pow
import Mathbin.NumberTheory.Liouville.Basic
import Mathbin.Topology.Instances.Irrational

/-!
# Liouville numbers with a given exponent

We say that a real number `x` is a Liouville number with exponent `p : ℝ` if there exists a real
number `C` such that for infinitely many denominators `n` there exists a numerator `m` such that
`x ≠ m / n` and `|x - m / n| < C / n ^ p`. A number is a Liouville number in the sense of
`liouville` if it is `liouville_with` any real exponent, see `forall_liouville_with_iff`.

* If `p ≤ 1`, then this condition is trivial.

* If `1 < p ≤ 2`, then this condition is equivalent to `irrational x`. The forward implication
  does not require `p ≤ 2` and is formalized as `liouville_with.irrational`; the other implication
  follows from approximations by continued fractions and is not formalized yet.

* If `p > 2`, then this is a non-trivial condition on irrational numbers. In particular,
  [Thue–Siegel–Roth theorem](https://en.wikipedia.org/wiki/Roth's_theorem) states that such numbers
  must be transcendental.

In this file we define the predicate `liouville_with` and prove some basic facts about this
predicate.

## Tags

Liouville number, irrational, irrationality exponent
-/

open Filter Metric Real Set

open Filter Topology

/-- We say that a real number `x` is a Liouville number with exponent `p : ℝ` if there exists a real
number `C` such that for infinitely many denominators `n` there exists a numerator `m` such that
`x ≠ m / n` and `|x - m / n| < C / n ^ p`.

A number is a Liouville number in the sense of `liouville` if it is `liouville_with` any real
exponent. -/
def LiouvilleWith (p x : ℝ) : Prop :=
  ∃ C, ∃ᶠ n : ℕ in atTop, ∃ m : ℤ, x ≠ m / n ∧ |x - m / n| < C / n ^ p
#align liouville_with LiouvilleWith

/-- For `p = 1` (hence, for any `p ≤ 1`), the condition `liouville_with p x` is trivial. -/
theorem liouvilleWith_one (x : ℝ) : LiouvilleWith 1 x :=
  by
  use 2
  refine' ((eventually_gt_at_top 0).mono fun n hn => _).Frequently
  have hn' : (0 : ℝ) < n := by simpa
  have : x < ↑(⌊x * ↑n⌋ + 1) / ↑n :=
    by
    rw [lt_div_iff hn', Int.cast_add, Int.cast_one]
    exact Int.lt_floor_add_one _
  refine' ⟨⌊x * n⌋ + 1, this.ne, _⟩
  rw [abs_sub_comm, abs_of_pos (sub_pos.2 this), rpow_one, sub_lt_iff_lt_add',
    add_div_eq_mul_add_div _ _ hn'.ne', div_lt_div_right hn']
  simpa [bit0, ← add_assoc] using (Int.floor_le (x * n)).trans_lt (lt_add_one _)
#align liouville_with_one liouvilleWith_one

namespace LiouvilleWith

variable {p q x y : ℝ} {r : ℚ} {m : ℤ} {n : ℕ}

/-- The constant `C` provided by the definition of `liouville_with` can be made positive.
We also add `1 ≤ n` to the list of assumptions about the denominator. While it is equivalent to
the original statement, the case `n = 0` breaks many arguments. -/
theorem exists_pos (h : LiouvilleWith p x) :
    ∃ (C : ℝ)(h₀ : 0 < C),
      ∃ᶠ n : ℕ in atTop, 1 ≤ n ∧ ∃ m : ℤ, x ≠ m / n ∧ |x - m / n| < C / n ^ p :=
  by
  rcases h with ⟨C, hC⟩
  refine' ⟨max C 1, zero_lt_one.trans_le <| le_max_right _ _, _⟩
  refine' ((eventually_ge_at_top 1).and_frequently hC).mono _
  rintro n ⟨hle, m, hne, hlt⟩
  refine' ⟨hle, m, hne, hlt.trans_le _⟩
  exact div_le_div_of_le (rpow_nonneg_of_nonneg n.cast_nonneg _) (le_max_left _ _)
#align liouville_with.exists_pos LiouvilleWith.exists_pos

/-- If a number is Liouville with exponent `p`, then it is Liouville with any smaller exponent. -/
theorem mono (h : LiouvilleWith p x) (hle : q ≤ p) : LiouvilleWith q x :=
  by
  rcases h.exists_pos with ⟨C, hC₀, hC⟩
  refine' ⟨C, hC.mono _⟩; rintro n ⟨hn, m, hne, hlt⟩
  refine' ⟨m, hne, hlt.trans_le <| div_le_div_of_le_left hC₀.le _ _⟩
  exacts[rpow_pos_of_pos (Nat.cast_pos.2 hn) _,
    rpow_le_rpow_of_exponent_le (Nat.one_le_cast.2 hn) hle]
#align liouville_with.mono LiouvilleWith.mono

/-- If `x` satisfies Liouville condition with exponent `p` and `q < p`, then `x`
satisfies Liouville condition with exponent `q` and constant `1`. -/
theorem frequently_lt_rpow_neg (h : LiouvilleWith p x) (hlt : q < p) :
    ∃ᶠ n : ℕ in atTop, ∃ m : ℤ, x ≠ m / n ∧ |x - m / n| < n ^ (-q) :=
  by
  rcases h.exists_pos with ⟨C, hC₀, hC⟩
  have : ∀ᶠ n : ℕ in at_top, C < n ^ (p - q) := by
    simpa only [(· ∘ ·), neg_sub, one_div] using
      ((tendsto_rpow_atTop (sub_pos.2 hlt)).comp tendsto_nat_cast_atTop_atTop).Eventually
        (eventually_gt_at_top C)
  refine' (this.and_frequently hC).mono _
  rintro n ⟨hnC, hn, m, hne, hlt⟩
  replace hn : (0 : ℝ) < n := Nat.cast_pos.2 hn
  refine' ⟨m, hne, hlt.trans <| (div_lt_iff <| rpow_pos_of_pos hn _).2 _⟩
  rwa [mul_comm, ← rpow_add hn, ← sub_eq_add_neg]
#align liouville_with.frequently_lt_rpow_neg LiouvilleWith.frequently_lt_rpow_neg

/-- The product of a Liouville number and a nonzero rational number is again a Liouville number.  -/
theorem mul_rat (h : LiouvilleWith p x) (hr : r ≠ 0) : LiouvilleWith p (x * r) :=
  by
  rcases h.exists_pos with ⟨C, hC₀, hC⟩
  refine' ⟨r.denom ^ p * (|r| * C), (tendsto_id.nsmul_at_top r.pos).Frequently (hC.mono _)⟩
  rintro n ⟨hn, m, hne, hlt⟩
  have A : (↑(r.num * m) : ℝ) / ↑(r.denom • id n) = m / n * r := by
    simp [← div_mul_div_comm, ← r.cast_def, mul_comm]
  refine' ⟨r.num * m, _, _⟩
  · rw [A]
    simp [hne, hr]
  · rw [A, ← sub_mul, abs_mul]
    simp only [smul_eq_mul, id.def, Nat.cast_mul]
    refine' (mul_lt_mul_of_pos_right hlt <| abs_pos.2 <| Rat.cast_ne_zero.2 hr).trans_le _
    rw [mul_rpow, mul_div_mul_left, mul_comm, mul_div_assoc]
    exacts[(rpow_pos_of_pos (Nat.cast_pos.2 r.pos) _).ne', Nat.cast_nonneg _, Nat.cast_nonneg _]
#align liouville_with.mul_rat LiouvilleWith.mul_rat

/-- The product `x * r`, `r : ℚ`, `r ≠ 0`, is a Liouville number with exponent `p` if and only if
`x` satisfies the same condition. -/
theorem mul_rat_iff (hr : r ≠ 0) : LiouvilleWith p (x * r) ↔ LiouvilleWith p x :=
  ⟨fun h => by
    simpa only [mul_assoc, ← Rat.cast_mul, mul_inv_cancel hr, Rat.cast_one, mul_one] using
      h.mul_rat (inv_ne_zero hr),
    fun h => h.mul_rat hr⟩
#align liouville_with.mul_rat_iff LiouvilleWith.mul_rat_iff

/-- The product `r * x`, `r : ℚ`, `r ≠ 0`, is a Liouville number with exponent `p` if and only if
`x` satisfies the same condition. -/
theorem rat_mul_iff (hr : r ≠ 0) : LiouvilleWith p (r * x) ↔ LiouvilleWith p x := by
  rw [mul_comm, mul_rat_iff hr]
#align liouville_with.rat_mul_iff LiouvilleWith.rat_mul_iff

theorem rat_mul (h : LiouvilleWith p x) (hr : r ≠ 0) : LiouvilleWith p (r * x) :=
  (rat_mul_iff hr).2 h
#align liouville_with.rat_mul LiouvilleWith.rat_mul

theorem mul_int_iff (hm : m ≠ 0) : LiouvilleWith p (x * m) ↔ LiouvilleWith p x := by
  rw [← Rat.cast_coe_int, mul_rat_iff (Int.cast_ne_zero.2 hm)]
#align liouville_with.mul_int_iff LiouvilleWith.mul_int_iff

theorem mul_int (h : LiouvilleWith p x) (hm : m ≠ 0) : LiouvilleWith p (x * m) :=
  (mul_int_iff hm).2 h
#align liouville_with.mul_int LiouvilleWith.mul_int

theorem int_mul_iff (hm : m ≠ 0) : LiouvilleWith p (m * x) ↔ LiouvilleWith p x := by
  rw [mul_comm, mul_int_iff hm]
#align liouville_with.int_mul_iff LiouvilleWith.int_mul_iff

theorem int_mul (h : LiouvilleWith p x) (hm : m ≠ 0) : LiouvilleWith p (m * x) :=
  (int_mul_iff hm).2 h
#align liouville_with.int_mul LiouvilleWith.int_mul

theorem mul_nat_iff (hn : n ≠ 0) : LiouvilleWith p (x * n) ↔ LiouvilleWith p x := by
  rw [← Rat.cast_coe_nat, mul_rat_iff (Nat.cast_ne_zero.2 hn)]
#align liouville_with.mul_nat_iff LiouvilleWith.mul_nat_iff

theorem mul_nat (h : LiouvilleWith p x) (hn : n ≠ 0) : LiouvilleWith p (x * n) :=
  (mul_nat_iff hn).2 h
#align liouville_with.mul_nat LiouvilleWith.mul_nat

theorem nat_mul_iff (hn : n ≠ 0) : LiouvilleWith p (n * x) ↔ LiouvilleWith p x := by
  rw [mul_comm, mul_nat_iff hn]
#align liouville_with.nat_mul_iff LiouvilleWith.nat_mul_iff

theorem nat_mul (h : LiouvilleWith p x) (hn : n ≠ 0) : LiouvilleWith p (n * x) :=
  by
  rw [mul_comm]
  exact h.mul_nat hn
#align liouville_with.nat_mul LiouvilleWith.nat_mul

theorem add_rat (h : LiouvilleWith p x) (r : ℚ) : LiouvilleWith p (x + r) :=
  by
  rcases h.exists_pos with ⟨C, hC₀, hC⟩
  refine' ⟨r.denom ^ p * C, (tendsto_id.nsmul_at_top r.pos).Frequently (hC.mono _)⟩
  rintro n ⟨hn, m, hne, hlt⟩
  have hr : (0 : ℝ) < r.denom := Nat.cast_pos.2 r.pos
  have hn' : (n : ℝ) ≠ 0 := Nat.cast_ne_zero.2 (zero_lt_one.trans_le hn).ne'
  have : (↑(r.denom * m + r.num * n : ℤ) / ↑(r.denom • id n) : ℝ) = m / n + r := by
    simp [add_div, hr.ne', mul_div_mul_left, mul_div_mul_right, hn', ← Rat.cast_def]
  refine' ⟨r.denom * m + r.num * n, _⟩
  rw [this, add_sub_add_right_eq_sub]
  refine' ⟨by simpa, hlt.trans_le (le_of_eq _)⟩
  have : (r.denom ^ p : ℝ) ≠ 0 := (rpow_pos_of_pos hr _).ne'
  simp [mul_rpow, Nat.cast_nonneg, mul_div_mul_left, this]
#align liouville_with.add_rat LiouvilleWith.add_rat

@[simp]
theorem add_rat_iff : LiouvilleWith p (x + r) ↔ LiouvilleWith p x :=
  ⟨fun h => by simpa using h.add_rat (-r), fun h => h.add_rat r⟩
#align liouville_with.add_rat_iff LiouvilleWith.add_rat_iff

@[simp]
theorem rat_add_iff : LiouvilleWith p (r + x) ↔ LiouvilleWith p x := by rw [add_comm, add_rat_iff]
#align liouville_with.rat_add_iff LiouvilleWith.rat_add_iff

theorem rat_add (h : LiouvilleWith p x) (r : ℚ) : LiouvilleWith p (r + x) :=
  add_comm x r ▸ h.add_rat r
#align liouville_with.rat_add LiouvilleWith.rat_add

@[simp]
theorem add_int_iff : LiouvilleWith p (x + m) ↔ LiouvilleWith p x := by
  rw [← Rat.cast_coe_int m, add_rat_iff]
#align liouville_with.add_int_iff LiouvilleWith.add_int_iff

@[simp]
theorem int_add_iff : LiouvilleWith p (m + x) ↔ LiouvilleWith p x := by rw [add_comm, add_int_iff]
#align liouville_with.int_add_iff LiouvilleWith.int_add_iff

@[simp]
theorem add_nat_iff : LiouvilleWith p (x + n) ↔ LiouvilleWith p x := by
  rw [← Rat.cast_coe_nat n, add_rat_iff]
#align liouville_with.add_nat_iff LiouvilleWith.add_nat_iff

@[simp]
theorem nat_add_iff : LiouvilleWith p (n + x) ↔ LiouvilleWith p x := by rw [add_comm, add_nat_iff]
#align liouville_with.nat_add_iff LiouvilleWith.nat_add_iff

theorem add_int (h : LiouvilleWith p x) (m : ℤ) : LiouvilleWith p (x + m) :=
  add_int_iff.2 h
#align liouville_with.add_int LiouvilleWith.add_int

theorem int_add (h : LiouvilleWith p x) (m : ℤ) : LiouvilleWith p (m + x) :=
  int_add_iff.2 h
#align liouville_with.int_add LiouvilleWith.int_add

theorem add_nat (h : LiouvilleWith p x) (n : ℕ) : LiouvilleWith p (x + n) :=
  h.add_int n
#align liouville_with.add_nat LiouvilleWith.add_nat

theorem nat_add (h : LiouvilleWith p x) (n : ℕ) : LiouvilleWith p (n + x) :=
  h.int_add n
#align liouville_with.nat_add LiouvilleWith.nat_add

protected theorem neg (h : LiouvilleWith p x) : LiouvilleWith p (-x) :=
  by
  rcases h with ⟨C, hC⟩
  refine' ⟨C, hC.mono _⟩
  rintro n ⟨m, hne, hlt⟩
  use -m; simp [neg_div, abs_sub_comm _ x, *]
#align liouville_with.neg LiouvilleWith.neg

@[simp]
theorem neg_iff : LiouvilleWith p (-x) ↔ LiouvilleWith p x :=
  ⟨fun h => neg_neg x ▸ h.neg, LiouvilleWith.neg⟩
#align liouville_with.neg_iff LiouvilleWith.neg_iff

@[simp]
theorem sub_rat_iff : LiouvilleWith p (x - r) ↔ LiouvilleWith p x := by
  rw [sub_eq_add_neg, ← Rat.cast_neg, add_rat_iff]
#align liouville_with.sub_rat_iff LiouvilleWith.sub_rat_iff

theorem sub_rat (h : LiouvilleWith p x) (r : ℚ) : LiouvilleWith p (x - r) :=
  sub_rat_iff.2 h
#align liouville_with.sub_rat LiouvilleWith.sub_rat

@[simp]
theorem sub_int_iff : LiouvilleWith p (x - m) ↔ LiouvilleWith p x := by
  rw [← Rat.cast_coe_int, sub_rat_iff]
#align liouville_with.sub_int_iff LiouvilleWith.sub_int_iff

theorem sub_int (h : LiouvilleWith p x) (m : ℤ) : LiouvilleWith p (x - m) :=
  sub_int_iff.2 h
#align liouville_with.sub_int LiouvilleWith.sub_int

@[simp]
theorem sub_nat_iff : LiouvilleWith p (x - n) ↔ LiouvilleWith p x := by
  rw [← Rat.cast_coe_nat, sub_rat_iff]
#align liouville_with.sub_nat_iff LiouvilleWith.sub_nat_iff

theorem sub_nat (h : LiouvilleWith p x) (n : ℕ) : LiouvilleWith p (x - n) :=
  sub_nat_iff.2 h
#align liouville_with.sub_nat LiouvilleWith.sub_nat

@[simp]
theorem rat_sub_iff : LiouvilleWith p (r - x) ↔ LiouvilleWith p x := by simp [sub_eq_add_neg]
#align liouville_with.rat_sub_iff LiouvilleWith.rat_sub_iff

theorem rat_sub (h : LiouvilleWith p x) (r : ℚ) : LiouvilleWith p (r - x) :=
  rat_sub_iff.2 h
#align liouville_with.rat_sub LiouvilleWith.rat_sub

@[simp]
theorem int_sub_iff : LiouvilleWith p (m - x) ↔ LiouvilleWith p x := by simp [sub_eq_add_neg]
#align liouville_with.int_sub_iff LiouvilleWith.int_sub_iff

theorem int_sub (h : LiouvilleWith p x) (m : ℤ) : LiouvilleWith p (m - x) :=
  int_sub_iff.2 h
#align liouville_with.int_sub LiouvilleWith.int_sub

@[simp]
theorem nat_sub_iff : LiouvilleWith p (n - x) ↔ LiouvilleWith p x := by simp [sub_eq_add_neg]
#align liouville_with.nat_sub_iff LiouvilleWith.nat_sub_iff

theorem nat_sub (h : LiouvilleWith p x) (n : ℕ) : LiouvilleWith p (n - x) :=
  nat_sub_iff.2 h
#align liouville_with.nat_sub LiouvilleWith.nat_sub

theorem ne_cast_int (h : LiouvilleWith p x) (hp : 1 < p) (m : ℤ) : x ≠ m :=
  by
  rintro rfl
  rename' m => M
  rcases((eventually_gt_at_top 0).and_frequently (h.frequently_lt_rpow_neg hp)).exists with
    ⟨n : ℕ, hn : 0 < n, m : ℤ, hne : (M : ℝ) ≠ m / n, hlt : |(M - m / n : ℝ)| < n ^ (-1 : ℝ)⟩
  refine' hlt.not_le _
  have hn' : (0 : ℝ) < n := by simpa
  rw [rpow_neg_one, ← one_div, sub_div' _ _ _ hn'.ne', abs_div, Nat.abs_cast, div_le_div_right hn']
  norm_cast
  rw [← zero_add (1 : ℤ), Int.add_one_le_iff, abs_pos, sub_ne_zero]
  rw [Ne.def, eq_div_iff hn'.ne'] at hne
  exact_mod_cast hne
#align liouville_with.ne_cast_int LiouvilleWith.ne_cast_int

/-- A number satisfying the Liouville condition with exponent `p > 1` is an irrational number. -/
protected theorem irrational (h : LiouvilleWith p x) (hp : 1 < p) : Irrational x :=
  by
  rintro ⟨r, rfl⟩
  rcases eq_or_ne r 0 with (rfl | h0)
  · refine' h.ne_cast_int hp 0 _
    rw [Rat.cast_zero, Int.cast_zero]
  · refine' (h.mul_rat (inv_ne_zero h0)).ne_cast_int hp 1 _
    simp [Rat.cast_ne_zero.2 h0]
#align liouville_with.irrational LiouvilleWith.irrational

end LiouvilleWith

namespace Liouville

variable {x : ℝ}

/-- If `x` is a Liouville number, then for any `n`, for infinitely many denominators `b` there
exists a numerator `a` such that `x ≠ a / b` and `|x - a / b| < 1 / b ^ n`. -/
theorem frequently_exists_num (hx : Liouville x) (n : ℕ) :
    ∃ᶠ b : ℕ in atTop, ∃ a : ℤ, x ≠ a / b ∧ |x - a / b| < 1 / b ^ n :=
  by
  refine' Classical.not_not.1 fun H => _
  simp only [Liouville, not_forall, not_exists, not_frequently, not_and, not_lt,
    eventually_at_top] at H
  rcases H with ⟨N, hN⟩
  have : ∀ b > (1 : ℕ), ∀ᶠ m : ℕ in at_top, ∀ a : ℤ, (1 / b ^ m : ℝ) ≤ |x - a / b| :=
    by
    intro b hb
    replace hb : (1 : ℝ) < b := Nat.one_lt_cast.2 hb
    have H : tendsto (fun m => 1 / b ^ m : ℕ → ℝ) at_top (𝓝 0) :=
      by
      simp only [one_div]
      exact tendsto_inv_at_top_zero.comp (tendsto_pow_atTop_atTop_of_one_lt hb)
    refine' (H.eventually (hx.irrational.eventually_forall_le_dist_cast_div b)).mono _
    exact fun m hm a => hm a
  have : ∀ᶠ m : ℕ in at_top, ∀ b < N, 1 < b → ∀ a : ℤ, (1 / b ^ m : ℝ) ≤ |x - a / b| :=
    (finite_lt_nat N).eventually_all.2 fun b hb => eventually_imp_distrib_left.2 (this b)
  rcases(this.and (eventually_ge_at_top n)).exists with ⟨m, hm, hnm⟩
  rcases hx m with ⟨a, b, hb, hne, hlt⟩
  lift b to ℕ using zero_le_one.trans hb.le
  norm_cast  at hb
  push_cast at hne hlt
  cases le_or_lt N b
  · refine' (hN b h a hne).not_lt (hlt.trans_le _)
    replace hb : (1 : ℝ) < b := Nat.one_lt_cast.2 hb
    have hb0 : (0 : ℝ) < b := zero_lt_one.trans hb
    exact one_div_le_one_div_of_le (pow_pos hb0 _) (pow_le_pow hb.le hnm)
  · exact (hm b h hb _).not_lt hlt
#align liouville.frequently_exists_num Liouville.frequently_exists_num

/-- A Liouville number is a Liouville number with any real exponent. -/
protected theorem liouvilleWith (hx : Liouville x) (p : ℝ) : LiouvilleWith p x :=
  by
  suffices : LiouvilleWith ⌈p⌉₊ x; exact this.mono (Nat.le_ceil p)
  refine' ⟨1, ((eventually_gt_at_top 1).and_frequently (hx.frequently_exists_num ⌈p⌉₊)).mono _⟩
  rintro b ⟨hb, a, hne, hlt⟩
  refine' ⟨a, hne, _⟩
  rwa [rpow_nat_cast]
#align liouville.liouville_with Liouville.liouvilleWith

end Liouville

/-- A number satisfies the Liouville condition with any exponent if and only if it is a Liouville
number. -/
theorem forall_liouvilleWith_iff {x : ℝ} : (∀ p, LiouvilleWith p x) ↔ Liouville x :=
  by
  refine' ⟨fun H n => _, Liouville.liouvilleWith⟩
  rcases((eventually_gt_at_top 1).and_frequently
        ((H (n + 1)).frequently_lt_rpow_neg (lt_add_one n))).exists with
    ⟨b, hb, a, hne, hlt⟩
  exact ⟨a, b, by exact_mod_cast hb, hne, by simpa [rpow_neg] using hlt⟩
#align forall_liouville_with_iff forall_liouvilleWith_iff


import basic_defs_world.definition -- hide

/- Axiom : The total set (called `univ`) is open.
univ_mem : is_open set.univ
-/

/- Axiom : The intersection of two open sets is open.
inter : ∀ (U V : set X) (hA : is_open U) (hB : is_open V), is_open (U ∩ V)
-/

/- Axiom : The union of an arbitrary set of open sets is open.
union : ∀ (Y : set (set X)) (h : ∀ U ∈ Y, is_open U), is_open (⋃₀ Y)
-/

/- Axiom : The union over the empty set is empty.
sUnion_empty : ⋃₀ ∅ = ∅
-/

/-
# Level 1 : The empty set is open.
-/
noncomputable theory -- hide
open set -- hide

/-
In many textbooks, one of the axioms of a topological space is that the empty set is open. This actually follows from the other axioms!
-/

namespace topological_space -- hide

/- Hint : Click here for a hint, in case you get stuck.
In Lean, sets are notation for logical statements. That is, the set
`a ∈ { x : X | P x }` means *the same as* `P a`. As a somewhat degenerate
example, `a ∈ ∅` means `false`.
-/

/- Lemma
Prove that the empty set is open.
-/
lemma is_open_empty {X : Type} [topological_space X] : is_open (∅ : set X) :=
begin
  rw ←sUnion_empty,
  apply union,
  tauto,

end

end topological_space -- hide


import tactic data.nat.basic data.int.basic
noncomputable theory
open_locale classical

theorem sqrt2_irrational_nat :
  ¬ ∃ (m n : ℕ),
  2 * m^2 = n^2 ∧
  m ≠ 0
:=
begin
  sorry,
end

-- Assume the above theorem

lemma num_2 : (2 : ℚ).num = 2 :=
begin
  sorry,
end

lemma denom_2 : (2 : ℚ).denom = 1 :=
begin
  sorry,
end

/-
q.denom = denominator of q (valued in ℕ)
q.num = numerator of q (valued in ℤ)

for integer m,
m.nat_abs = absolute value of m (valued in ℕ)

int.nat_abs_mul_self' : ∀ (a : ℤ), ↑(a.nat_abs) * ↑(a.nat_abs) = a * a
int.coe_nat_inj : ∀ {m n : ℕ}, ↑m = ↑n → m = n

rat.mul_self_denom : ∀ (q : ℚ), (q * q).denom = q.denom * q.denom
rat.mul_self_num : ∀ (q : ℚ), (q * q).num = q.num * q.num
rat.denom_ne_zero : ∀ (q : ℚ), q.denom ≠ 0

lemmas about nat-to-int coercion, which norm_cast knows:
nat.cast_one : ↑(1 : ℕ) = (1 : ℤ)
nat.cast_two : ↑(2 : ℕ) = (2 : ℤ)
nat.cast_mul (m n : ℕ) : ↑(m * n) = ↑m * ↑n

lemma which ring_nf knows:
pow_two (x) : x^2 = x * x

-/

theorem sqrt2_irrational :
¬ (∃ q : ℚ, 2 = q * q)
:=
begin
  rintro ⟨q, h⟩,
  have clear_denom := rat.eq_iff_mul_eq_mul.mp h,
  sorry,
end


-- Boilerplate:
import algebra.group.defs
import algebra.module.basic
import algebra.ring.basic
namespace examples

/-
Following the pattern of monoids, the base class introduces notation, and is subclassed to add the axioms of the structure:
-/
-- Adapted from `algebra/group/defs.lean:47`
class has_scalar (α β : Type*) :=
(smul : α → β → β)
infix • := has_scalar.smul

-- Adapted from `group_theory/group_action/defs.lean:85`
class mul_action (M A : Type*) [monoid M] extends has_scalar M A :=
(one_smul : ∀ (x : A), (1 : M) • x = x)
(mul_smul : ∀ (r s : M) (x : A), (r * s) • x = r • (s • x))

-- Adapted from `group_theory/group_action/defs.lean:446`
class distrib_mul_action (M A : Type*) [monoid M] [add_monoid A]
  extends mul_action M A :=
(smul_add : ∀ (r : M) (x y : A), r • (x + y) = r • x + r • y)
(smul_zero : ∀ (r : M), r • (0 : A) = 0)

-- Adapted from `algebra/module/basic.lean:50`
class module (R M : Type*) [semiring R] [add_comm_monoid M]
  extends distrib_mul_action R M :=
(add_smul : ∀ (r s : R) (x : M), (r + s) • x = r • x + s • x)
(zero_smul : ∀ (x : M), (0 : R) • x = 0)

namespace extend
/-
Namely, declaring that `module R M extends add_comm_monoid M`
-/
class module (R M : Type*) [semiring R] extends add_comm_monoid M, distrib_mul_action R M :=
(add_smul : ∀ (r s : R) (x : M), (r + s) • x = r • x + s • x)
(zero_smul : ∀ (x : M), (0 : R) • x = 0)
/-
would generate the following instance:
-/
#print module.to_add_comm_monoid
end extend

namespace out
/-
[W]e can make `R` a functional dependency of `M` by instead defining:
-/
class module (R : out_param Type*) (M : Type*) [semiring R]
  extends add_comm_monoid M, distrib_mul_action R M :=
(add_smul : ∀ (r s : R) (x : M), (r + s) • x = r • x + s • x)
(zero_smul : ∀ (x : M), (0 : R) • x = 0)
end out

/-
For `module` this functional dependency is not acceptable
since each `add_comm_monoid M` has a natural `module ℕ M` structure given by the instance `add_comm_monoid.nat_module` -/
#check add_comm_monoid.nat_module

/-
A final way to resolve dangerous instances is to remove the \lstinline{instance} keyword so that it does not participate in synthesis.
\mathlib takes this approach when stating the theorem that any module over a ring has additive inverses:
-/
-- Adapted from `algebra/module/basic.lean:170`
def module.add_comm_monoid_to_add_comm_group (R M : Type*)
  [ring R] [add_comm_monoid M] [module R M] :
  add_comm_group M :=
{ neg          := λ a, (-1 : R) • a,
  add_left_neg := λ a, show (-1 : R) • a + a = 0, by
  { nth_rewrite 1 ← mul_action.one_smul a,
    rw [← module.add_smul, add_left_neg, module.zero_smul] },
  ..(infer_instance : add_comm_monoid M), }

end examples


/-
Copyright (c) 2021 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne, Kexing Ying
-/
import probability.notation
import probability.hitting_time

/-!
# Martingales

A family of functions `f : ι → α → E` is a martingale with respect to a filtration `ℱ` if every
`f i` is integrable, `f` is adapted with respect to `ℱ` and for all `i ≤ j`,
`μ[f j | ℱ i] =ᵐ[μ] f i`. On the other hand, `f : ι → α → E` is said to be a supermartingale
with respect to the filtration `ℱ` if `f i` is integrable, `f` is adapted with resepct to `ℱ`
and for all `i ≤ j`, `μ[f j | ℱ i] ≤ᵐ[μ] f i`. Finally, `f : ι → α → E` is said to be a
submartingale with respect to the filtration `ℱ` if `f i` is integrable, `f` is adapted with
resepct to `ℱ` and for all `i ≤ j`, `f i ≤ᵐ[μ] μ[f j | ℱ i]`.

The definitions of filtration and adapted can be found in `probability.stopping`.

### Definitions

* `measure_theory.martingale f ℱ μ`: `f` is a martingale with respect to filtration `ℱ` and
  measure `μ`.
* `measure_theory.supermartingale f ℱ μ`: `f` is a supermartingale with respect to
  filtration `ℱ` and measure `μ`.
* `measure_theory.submartingale f ℱ μ`: `f` is a submartingale with respect to filtration `ℱ` and
  measure `μ`.

### Results

* `measure_theory.martingale_condexp f ℱ μ`: the sequence `λ i, μ[f | ℱ i, ℱ.le i])` is a
  martingale with respect to `ℱ` and `μ`.

-/

open topological_space filter
open_locale nnreal ennreal measure_theory probability_theory big_operators

namespace measure_theory

variables {α E ι : Type*} [preorder ι]
  {m0 : measurable_space α} {μ : measure α}
  [normed_group E] [normed_space ℝ E] [complete_space E]
  {f g : ι → α → E} {ℱ : filtration ι m0}

/-- A family of functions `f : ι → α → E` is a martingale with respect to a filtration `ℱ` if `f`
is adapted with respect to `ℱ` and for all `i ≤ j`, `μ[f j | ℱ i] =ᵐ[μ] f i`. -/
def martingale (f : ι → α → E) (ℱ : filtration ι m0) (μ : measure α) : Prop :=
adapted ℱ f ∧ ∀ i j, i ≤ j → μ[f j | ℱ i] =ᵐ[μ] f i

/-- A family of integrable functions `f : ι → α → E` is a supermartingale with respect to a
filtration `ℱ` if `f` is adapted with respect to `ℱ` and for all `i ≤ j`,
`μ[f j | ℱ.le i] ≤ᵐ[μ] f i`. -/
def supermartingale [has_le E] (f : ι → α → E) (ℱ : filtration ι m0) (μ : measure α) : Prop :=
adapted ℱ f ∧ (∀ i j, i ≤ j → μ[f j | ℱ i] ≤ᵐ[μ] f i) ∧ ∀ i, integrable (f i) μ

/-- A family of integrable functions `f : ι → α → E` is a submartingale with respect to a
filtration `ℱ` if `f` is adapted with respect to `ℱ` and for all `i ≤ j`,
`f i ≤ᵐ[μ] μ[f j | ℱ.le i]`. -/
def submartingale [has_le E] (f : ι → α → E) (ℱ : filtration ι m0) (μ : measure α) : Prop :=
adapted ℱ f ∧ (∀ i j, i ≤ j → f i ≤ᵐ[μ] μ[f j | ℱ i]) ∧ ∀ i, integrable (f i) μ

variables (E)
lemma martingale_zero (ℱ : filtration ι m0) (μ : measure α) :
  martingale (0 : ι → α → E) ℱ μ :=
⟨adapted_zero E ℱ, λ i j hij, by { rw [pi.zero_apply, condexp_zero], simp, }⟩
variables {E}

namespace martingale

@[protected]
lemma adapted (hf : martingale f ℱ μ) : adapted ℱ f := hf.1

@[protected]
lemma strongly_measurable (hf : martingale f ℱ μ) (i : ι) : strongly_measurable[ℱ i] (f i) :=
hf.adapted i

lemma condexp_ae_eq (hf : martingale f ℱ μ) {i j : ι} (hij : i ≤ j) :
  μ[f j | ℱ i] =ᵐ[μ] f i :=
hf.2 i j hij

@[protected]
lemma integrable (hf : martingale f ℱ μ) (i : ι) : integrable (f i) μ :=
integrable_condexp.congr (hf.condexp_ae_eq (le_refl i))

lemma set_integral_eq [sigma_finite_filtration μ ℱ] (hf : martingale f ℱ μ) {i j : ι} (hij : i ≤ j)
  {s : set α} (hs : measurable_set[ℱ i] s) :
  ∫ x in s, f i x ∂μ = ∫ x in s, f j x ∂μ :=
begin
  rw ← @set_integral_condexp _ _ _ _ _ (ℱ i) m0 _ _ _ (ℱ.le i) _ (hf.integrable j) hs,
  refine set_integral_congr_ae (ℱ.le i s hs) _,
  filter_upwards [hf.2 i j hij] with _ heq _ using heq.symm,
end

lemma add (hf : martingale f ℱ μ) (hg : martingale g ℱ μ) : martingale (f + g) ℱ μ :=
begin
  refine ⟨hf.adapted.add hg.adapted, λ i j hij, _⟩,
  exact (condexp_add (hf.integrable j) (hg.integrable j)).trans
    ((hf.2 i j hij).add (hg.2 i j hij)),
end

lemma neg (hf : martingale f ℱ μ) : martingale (-f) ℱ μ :=
⟨hf.adapted.neg, λ i j hij, (condexp_neg (f j)).trans ((hf.2 i j hij).neg)⟩

lemma sub (hf : martingale f ℱ μ) (hg : martingale g ℱ μ) : martingale (f - g) ℱ μ :=
by { rw sub_eq_add_neg, exact hf.add hg.neg, }

lemma smul (c : ℝ) (hf : martingale f ℱ μ) : martingale (c • f) ℱ μ :=
begin
  refine ⟨hf.adapted.smul c, λ i j hij, _⟩,
  refine (condexp_smul c (f j)).trans ((hf.2 i j hij).mono (λ x hx, _)),
  rw [pi.smul_apply, hx, pi.smul_apply, pi.smul_apply],
end

lemma supermartingale [preorder E] (hf : martingale f ℱ μ) : supermartingale f ℱ μ :=
⟨hf.1, λ i j hij, (hf.2 i j hij).le, λ i, hf.integrable i⟩

lemma submartingale [preorder E] (hf : martingale f ℱ μ) : submartingale f ℱ μ :=
⟨hf.1, λ i j hij, (hf.2 i j hij).symm.le, λ i, hf.integrable i⟩

end martingale

lemma martingale_iff [partial_order E] : martingale f ℱ μ ↔
  supermartingale f ℱ μ ∧ submartingale f ℱ μ :=
⟨λ hf, ⟨hf.supermartingale, hf.submartingale⟩,
 λ ⟨hf₁, hf₂⟩, ⟨hf₁.1, λ i j hij, (hf₁.2.1 i j hij).antisymm (hf₂.2.1 i j hij)⟩⟩

lemma martingale_condexp (f : α → E) (ℱ : filtration ι m0) (μ : measure α)
  [sigma_finite_filtration μ ℱ] :
  martingale (λ i, μ[f | ℱ i]) ℱ μ :=
⟨λ i, strongly_measurable_condexp, λ i j hij, condexp_condexp_of_le (ℱ.mono hij) (ℱ.le j)⟩

namespace supermartingale

@[protected]
lemma adapted [has_le E] (hf : supermartingale f ℱ μ) : adapted ℱ f := hf.1

@[protected]
lemma strongly_measurable [has_le E] (hf : supermartingale f ℱ μ) (i : ι) :
  strongly_measurable[ℱ i] (f i) :=
hf.adapted i

@[protected]
lemma integrable [has_le E] (hf : supermartingale f ℱ μ) (i : ι) : integrable (f i) μ := hf.2.2 i

lemma condexp_ae_le [has_le E] (hf : supermartingale f ℱ μ) {i j : ι} (hij : i ≤ j) :
  μ[f j | ℱ i] ≤ᵐ[μ] f i :=
hf.2.1 i j hij

lemma set_integral_le [sigma_finite_filtration μ ℱ] {f : ι → α → ℝ} (hf : supermartingale f ℱ μ)
  {i j : ι} (hij : i ≤ j) {s : set α} (hs : measurable_set[ℱ i] s) :
  ∫ x in s, f j x ∂μ ≤ ∫ x in s, f i x ∂μ :=
begin
  rw ← set_integral_condexp (ℱ.le i) (hf.integrable j) hs,
  refine set_integral_mono_ae integrable_condexp.integrable_on (hf.integrable i).integrable_on _,
  filter_upwards [hf.2.1 i j hij] with _ heq using heq,
end

lemma add [preorder E] [covariant_class E E (+) (≤)]
  (hf : supermartingale f ℱ μ) (hg : supermartingale g ℱ μ) : supermartingale (f + g) ℱ μ :=
begin
  refine ⟨hf.1.add hg.1, λ i j hij, _, λ i, (hf.2.2 i).add (hg.2.2 i)⟩,
  refine (condexp_add (hf.integrable j) (hg.integrable j)).le.trans _,
  filter_upwards [hf.2.1 i j hij, hg.2.1 i j hij],
  intros,
  refine add_le_add _ _; assumption,
end

lemma add_martingale [preorder E] [covariant_class E E (+) (≤)]
  (hf : supermartingale f ℱ μ) (hg : martingale g ℱ μ) : supermartingale (f + g) ℱ μ :=
hf.add hg.supermartingale

lemma neg [preorder E] [covariant_class E E (+) (≤)]
  (hf : supermartingale f ℱ μ) : submartingale (-f) ℱ μ :=
begin
  refine ⟨hf.1.neg, λ i j hij, _, λ i, (hf.2.2 i).neg⟩,
  refine eventually_le.trans _ (condexp_neg (f j)).symm.le,
  filter_upwards [hf.2.1 i j hij] with _ _,
  simpa,
end

end supermartingale

namespace submartingale

@[protected]
lemma adapted [has_le E] (hf : submartingale f ℱ μ) : adapted ℱ f := hf.1

@[protected]
lemma strongly_measurable [has_le E] (hf : submartingale f ℱ μ) (i : ι) :
  strongly_measurable[ℱ i] (f i) :=
hf.adapted i

@[protected]
lemma integrable [has_le E] (hf : submartingale f ℱ μ) (i : ι) : integrable (f i) μ := hf.2.2 i

lemma ae_le_condexp [has_le E] (hf : submartingale f ℱ μ) {i j : ι} (hij : i ≤ j) :
  f i ≤ᵐ[μ] μ[f j | ℱ i] :=
hf.2.1 i j hij

lemma add [preorder E] [covariant_class E E (+) (≤)]
  (hf : submartingale f ℱ μ) (hg : submartingale g ℱ μ) : submartingale (f + g) ℱ μ :=
begin
  refine ⟨hf.1.add hg.1, λ i j hij, _, λ i, (hf.2.2 i).add (hg.2.2 i)⟩,
  refine eventually_le.trans _ (condexp_add (hf.integrable j) (hg.integrable j)).symm.le,
  filter_upwards [hf.2.1 i j hij, hg.2.1 i j hij],
  intros,
  refine add_le_add _ _; assumption,
end

lemma add_martingale [preorder E] [covariant_class E E (+) (≤)]
  (hf : submartingale f ℱ μ) (hg : martingale g ℱ μ) : submartingale (f + g) ℱ μ :=
hf.add hg.submartingale

lemma neg [preorder E] [covariant_class E E (+) (≤)]
  (hf : submartingale f ℱ μ) : supermartingale (-f) ℱ μ :=
begin
  refine ⟨hf.1.neg, λ i j hij, (condexp_neg (f j)).le.trans _, λ i, (hf.2.2 i).neg⟩,
  filter_upwards [hf.2.1 i j hij] with _ _,
  simpa,
end

/-- The converse of this lemma is `measure_theory.submartingale_of_set_integral_le`. -/
lemma set_integral_le [sigma_finite_filtration μ ℱ] {f : ι → α → ℝ} (hf : submartingale f ℱ μ)
  {i j : ι} (hij : i ≤ j) {s : set α} (hs : measurable_set[ℱ i] s) :
  ∫ x in s, f i x ∂μ ≤ ∫ x in s, f j x ∂μ :=
begin
  rw [← neg_le_neg_iff, ← integral_neg, ← integral_neg],
  exact supermartingale.set_integral_le hf.neg hij hs,
end

lemma sub_supermartingale [preorder E] [covariant_class E E (+) (≤)]
  (hf : submartingale f ℱ μ) (hg : supermartingale g ℱ μ) : submartingale (f - g) ℱ μ :=
by { rw sub_eq_add_neg, exact hf.add hg.neg }

lemma sub_martingale [preorder E] [covariant_class E E (+) (≤)]
  (hf : submartingale f ℱ μ) (hg : martingale g ℱ μ) : submartingale (f - g) ℱ μ :=
hf.sub_supermartingale hg.supermartingale

protected lemma sup {f g : ι → α → ℝ} (hf : submartingale f ℱ μ) (hg : submartingale g ℱ μ) :
  submartingale (f ⊔ g) ℱ μ :=
begin
  refine ⟨λ i, @strongly_measurable.sup _ _ _ _ (ℱ i) _ _ _ (hf.adapted i) (hg.adapted i),
    λ i j hij, _, λ i, integrable.sup (hf.integrable _) (hg.integrable _)⟩,
  refine eventually_le.sup_le _ _,
  { exact eventually_le.trans (hf.2.1 i j hij)
      (condexp_mono (hf.integrable _) (integrable.sup (hf.integrable j) (hg.integrable j))
      (eventually_of_forall (λ x, le_max_left _ _))) },
  { exact eventually_le.trans (hg.2.1 i j hij)
      (condexp_mono (hg.integrable _) (integrable.sup (hf.integrable j) (hg.integrable j))
      (eventually_of_forall (λ x, le_max_right _ _))) }
end

protected lemma pos {f : ι → α → ℝ} (hf : submartingale f ℱ μ) :
  submartingale (f⁺) ℱ μ :=
hf.sup (martingale_zero _ _ _).submartingale

end submartingale

section submartingale

lemma submartingale_of_set_integral_le [is_finite_measure μ]
  {f : ι → α → ℝ} (hadp : adapted ℱ f) (hint : ∀ i, integrable (f i) μ)
  (hf : ∀ i j : ι, i ≤ j → ∀ s : set α, measurable_set[ℱ i] s →
    ∫ x in s, f i x ∂μ ≤ ∫ x in s, f j x ∂μ) :
  submartingale f ℱ μ :=
begin
  refine ⟨hadp, λ i j hij, _, hint⟩,
  suffices : f i ≤ᵐ[μ.trim (ℱ.le i)] μ[f j| ℱ i],
  { exact ae_le_of_ae_le_trim this },
  suffices : 0 ≤ᵐ[μ.trim (ℱ.le i)] μ[f j| ℱ i] - f i,
  { filter_upwards [this] with x hx,
    rwa ← sub_nonneg },
  refine ae_nonneg_of_forall_set_integral_nonneg_of_finite_measure
    ((integrable_condexp.sub (hint i)).trim _ (strongly_measurable_condexp.sub $ hadp i))
    (λ s hs, _),
  specialize hf i j hij s hs,
  rwa [← set_integral_trim _ (strongly_measurable_condexp.sub $ hadp i) hs,
    integral_sub' integrable_condexp.integrable_on (hint i).integrable_on, sub_nonneg,
    set_integral_condexp (ℱ.le i) (hint j) hs],
end

lemma submartingale_of_condexp_sub_nonneg [is_finite_measure μ]
  {f : ι → α → ℝ} (hadp : adapted ℱ f) (hint : ∀ i, integrable (f i) μ)
  (hf : ∀ i j, i ≤ j → 0 ≤ᵐ[μ] μ[f j - f i | ℱ i]) :
  submartingale f ℱ μ :=
begin
  refine ⟨hadp, λ i j hij, _, hint⟩,
  rw [← condexp_of_strongly_measurable (ℱ.le _) (hadp _) (hint _), ← eventually_sub_nonneg],
  exact eventually_le.trans (hf i j hij) (condexp_sub (hint _) (hint _)).le,
  apply_instance
end

lemma submartingale.condexp_sub_nonneg [is_finite_measure μ]
  {f : ι → α → ℝ} (hf : submartingale f ℱ μ) {i j : ι} (hij : i ≤ j) :
  0 ≤ᵐ[μ] μ[f j - f i | ℱ i] :=
begin
  refine eventually_le.trans _ (condexp_sub (hf.integrable _) (hf.integrable _)).symm.le,
  rw [eventually_sub_nonneg,
    condexp_of_strongly_measurable (ℱ.le _) (hf.adapted _) (hf.integrable _)],
  exact hf.2.1 i j hij,
  apply_instance
end

lemma submartingale_iff_condexp_sub_nonneg [is_finite_measure μ] {f : ι → α → ℝ} :
  submartingale f ℱ μ ↔ adapted ℱ f ∧ (∀ i, integrable (f i) μ) ∧ ∀ i j, i ≤ j →
  0 ≤ᵐ[μ] μ[f j - f i | ℱ i] :=
⟨λ h, ⟨h.adapted, h.integrable, λ i j, h.condexp_sub_nonneg⟩,
 λ ⟨hadp, hint, h⟩, submartingale_of_condexp_sub_nonneg hadp hint h⟩

end submartingale

namespace supermartingale

lemma sub_submartingale [preorder E] [covariant_class E E (+) (≤)]
  (hf : supermartingale f ℱ μ) (hg : submartingale g ℱ μ) : supermartingale (f - g) ℱ μ :=
by { rw sub_eq_add_neg, exact hf.add hg.neg }

lemma sub_martingale [preorder E] [covariant_class E E (+) (≤)]
  (hf : supermartingale f ℱ μ) (hg : martingale g ℱ μ) : supermartingale (f - g) ℱ μ :=
hf.sub_submartingale hg.submartingale

section

variables {F : Type*} [normed_lattice_add_comm_group F]
  [normed_space ℝ F] [complete_space F] [ordered_smul ℝ F]

lemma smul_nonneg {f : ι → α → F}
  {c : ℝ} (hc : 0 ≤ c) (hf : supermartingale f ℱ μ) :
  supermartingale (c • f) ℱ μ :=
begin
  refine ⟨hf.1.smul c, λ i j hij, _, λ i, (hf.2.2 i).smul c⟩,
  refine (condexp_smul c (f j)).le.trans _,
  filter_upwards [hf.2.1 i j hij] with _ hle,
  simp,
  exact smul_le_smul_of_nonneg hle hc,
end

lemma smul_nonpos {f : ι → α → F}
  {c : ℝ} (hc : c ≤ 0) (hf : supermartingale f ℱ μ) :
  submartingale (c • f) ℱ μ :=
begin
  rw [← neg_neg c, (by { ext i x, simp } : - -c • f = -(-c • f))],
  exact (hf.smul_nonneg $ neg_nonneg.2 hc).neg,
end

end

end supermartingale

namespace submartingale

section

variables {F : Type*} [normed_lattice_add_comm_group F]
  [normed_space ℝ F] [complete_space F] [ordered_smul ℝ F]

lemma smul_nonneg {f : ι → α → F}
  {c : ℝ} (hc : 0 ≤ c) (hf : submartingale f ℱ μ) :
  submartingale (c • f) ℱ μ :=
begin
  rw [← neg_neg c, (by { ext i x, simp } : - -c • f = -(c • -f))],
  exact supermartingale.neg (hf.neg.smul_nonneg hc),
end

lemma smul_nonpos {f : ι → α → F}
  {c : ℝ} (hc : c ≤ 0) (hf : submartingale f ℱ μ) :
  supermartingale (c • f) ℱ μ :=
begin
  rw [← neg_neg c, (by { ext i x, simp } : - -c • f = -(-c • f))],
  exact (hf.smul_nonneg $ neg_nonneg.2 hc).neg,
end

end

end submartingale

section nat

variables {𝒢 : filtration ℕ m0}

lemma submartingale_of_set_integral_le_succ [is_finite_measure μ]
  {f : ℕ → α → ℝ} (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ)
  (hf : ∀ i, ∀ s : set α, measurable_set[𝒢 i] s → ∫ x in s, f i x ∂μ ≤ ∫ x in s, f (i + 1) x ∂μ) :
  submartingale f 𝒢 μ :=
begin
  refine submartingale_of_set_integral_le hadp hint (λ i j hij s hs, _),
  induction hij with k hk₁ hk₂,
  { exact le_rfl },
  { exact le_trans hk₂ (hf k s (𝒢.mono hk₁ _ hs)) }
end

lemma submartingale_nat [is_finite_measure μ]
  {f : ℕ → α → ℝ} (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ)
  (hf : ∀ i, f i ≤ᵐ[μ] μ[f (i + 1) | 𝒢 i]) :
  submartingale f 𝒢 μ :=
begin
  refine submartingale_of_set_integral_le_succ hadp hint (λ i s hs, _),
  have : ∫ x in s, f (i + 1) x ∂μ = ∫ x in s, μ[f (i + 1)|𝒢 i] x ∂μ :=
    (set_integral_condexp (𝒢.le i) (hint _) hs).symm,
  rw this,
  exact set_integral_mono_ae (hint i).integrable_on integrable_condexp.integrable_on (hf i),
end

lemma submartingale_of_condexp_sub_nonneg_nat [is_finite_measure μ]
  {f : ℕ → α → ℝ} (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ)
  (hf : ∀ i, 0 ≤ᵐ[μ] μ[f (i + 1) - f i | 𝒢 i]) :
  submartingale f 𝒢 μ :=
begin
  refine submartingale_nat hadp hint (λ i, _),
  rw [← condexp_of_strongly_measurable (𝒢.le _) (hadp _) (hint _), ← eventually_sub_nonneg],
  exact eventually_le.trans (hf i) (condexp_sub (hint _) (hint _)).le,
  apply_instance
end

namespace submartingale

lemma integrable_stopped_value [has_le E] {f : ℕ → α → E} (hf : submartingale f 𝒢 μ) {τ : α → ℕ}
  (hτ : is_stopping_time 𝒢 τ) {N : ℕ} (hbdd : ∀ x, τ x ≤ N) :
  integrable (stopped_value f τ) μ :=
integrable_stopped_value hτ hf.integrable hbdd

-- We may generalize the below lemma to functions taking value in a `normed_lattice_add_comm_group`.
-- Similarly, generalize `(super/)submartingale.set_integral_le`.

/-- Given a submartingale `f` and bounded stopping times `τ` and `π` such that `τ ≤ π`, the
expectation of `stopped_value f τ` is less than or equal to the expectation of `stopped_value f π`.
This is the forward direction of the optional stopping theorem. -/
lemma expected_stopped_value_mono [sigma_finite_filtration μ 𝒢]
  {f : ℕ → α → ℝ} (hf : submartingale f 𝒢 μ) {τ π : α → ℕ}
  (hτ : is_stopping_time 𝒢 τ) (hπ : is_stopping_time 𝒢 π) (hle : τ ≤ π)
  {N : ℕ} (hbdd : ∀ x, π x ≤ N) :
  μ[stopped_value f τ] ≤ μ[stopped_value f π] :=
begin
  rw [← sub_nonneg, ← integral_sub', stopped_value_sub_eq_sum' hle hbdd],
  { simp only [finset.sum_apply],
    have : ∀ i, measurable_set[𝒢 i] {x : α | τ x ≤ i ∧ i < π x},
    { intro i,
      refine (hτ i).inter _,
      convert (hπ i).compl,
      ext x,
      simpa },
    rw integral_finset_sum,
    { refine finset.sum_nonneg (λ i hi, _),
      rw [integral_indicator (𝒢.le _ _ (this _)), integral_sub', sub_nonneg],
      { exact hf.set_integral_le (nat.le_succ i) (this _) },
      { exact (hf.integrable _).integrable_on },
      { exact (hf.integrable _).integrable_on } },
    intros i hi,
    exact integrable.indicator (integrable.sub (hf.integrable _) (hf.integrable _))
      (𝒢.le _ _ (this _)) },
  { exact hf.integrable_stopped_value hπ hbdd },
  { exact hf.integrable_stopped_value hτ (λ x, le_trans (hle x) (hbdd x)) }
end

end submartingale

/-- The converse direction of the optional stopping theorem, i.e. an adapted integrable process `f`
is a submartingale if for all bounded stopping times `τ` and `π` such that `τ ≤ π`, the
stopped value of `f` at `τ` has expectation smaller than its stopped value at `π`. -/
lemma submartingale_of_expected_stopped_value_mono [is_finite_measure μ]
  {f : ℕ → α → ℝ} (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ)
  (hf : ∀ τ π : α → ℕ, is_stopping_time 𝒢 τ → is_stopping_time 𝒢 π → τ ≤ π → (∃ N, ∀ x, π x ≤ N) →
    μ[stopped_value f τ] ≤ μ[stopped_value f π]) :
  submartingale f 𝒢 μ :=
begin
  refine submartingale_of_set_integral_le hadp hint (λ i j hij s hs, _),
  classical,
  specialize hf (s.piecewise (λ _, i) (λ _, j)) _
    (is_stopping_time_piecewise_const hij hs)
    (is_stopping_time_const 𝒢 j) (λ x, (ite_le_sup _ _ _).trans (max_eq_right hij).le)
    ⟨j, λ x, le_rfl⟩,
  rwa [stopped_value_const, stopped_value_piecewise_const,
    integral_piecewise (𝒢.le _ _ hs) (hint _).integrable_on (hint _).integrable_on,
    ← integral_add_compl (𝒢.le _ _ hs) (hint j), add_le_add_iff_right] at hf,
end

/-- **The optional stopping theorem** (fair game theorem): an adapted integrable process `f`
is a submartingale if and only if for all bounded stopping times `τ` and `π` such that `τ ≤ π`, the
stopped value of `f` at `τ` has expectation smaller than its stopped value at `π`. -/
lemma submartingale_iff_expected_stopped_value_mono [is_finite_measure μ]
  {f : ℕ → α → ℝ} (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ) :
  submartingale f 𝒢 μ ↔
  ∀ τ π : α → ℕ, is_stopping_time 𝒢 τ → is_stopping_time 𝒢 π → τ ≤ π → (∃ N, ∀ x, π x ≤ N) →
    μ[stopped_value f τ] ≤ μ[stopped_value f π] :=
⟨λ hf _ _ hτ hπ hle ⟨N, hN⟩, hf.expected_stopped_value_mono hτ hπ hle hN,
 submartingale_of_expected_stopped_value_mono hadp hint⟩

section maximal

open finset

lemma smul_le_stopped_value_hitting [is_finite_measure μ]
  {f : ℕ → α → ℝ} (hsub : submartingale f 𝒢 μ) {ε : ℝ≥0} (n : ℕ) :
  ε • μ {x | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k x)} ≤
  ennreal.of_real (∫ x in {x | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k x)},
    stopped_value f (hitting f {y : ℝ | ↑ε ≤ y} 0 n) x ∂μ) :=
begin
  have hn : set.Icc 0 n = {k | k ≤ n},
  { ext x, simp },
  have : ∀ x, ((ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k x)) →
    (ε : ℝ) ≤ stopped_value f (hitting f {y : ℝ | ↑ε ≤ y} 0 n) x,
  { intros x hx,
    simp_rw [le_sup'_iff, mem_range, nat.lt_succ_iff] at hx,
    refine stopped_value_hitting_mem _,
    simp only [set.mem_set_of_eq, exists_prop, hn],
    exact let ⟨j, hj₁, hj₂⟩ := hx in ⟨j, hj₁, hj₂⟩ },
  have h := set_integral_ge_of_const_le (measurable_set_le measurable_const
    (finset.measurable_range_sup'' (λ n _, (hsub.strongly_measurable n).measurable.le (𝒢.le n))))
    (measure_ne_top _ _) this
    (integrable.integrable_on (integrable_stopped_value (hitting_is_stopping_time
     hsub.adapted measurable_set_Ici) hsub.integrable hitting_le)),
  rw [ennreal.le_of_real_iff_to_real_le, ennreal.to_real_smul],
  { exact h },
  { exact ennreal.mul_ne_top (by simp) (measure_ne_top _ _) },
  { exact le_trans (mul_nonneg ε.coe_nonneg ennreal.to_real_nonneg) h }
end

/-- **Doob's maximal inequality**: Given a non-negative submartingale `f`, for all `ε : ℝ≥0`,
we have `ε • μ {ε ≤ f* n} ≤ ∫ x in {ε ≤ f* n}, f n` where `f* n x = max_{k ≤ n}, f k x`.

In some literature, the Doob's maximal inequality refers to what we call Doob's Lp inequality
(which is a corollary of this lemma and will be proved in an upcomming PR). -/
lemma maximal_ineq [is_finite_measure μ]
  {f : ℕ → α → ℝ} (hsub : submartingale f 𝒢 μ) (hnonneg : 0 ≤ f) {ε : ℝ≥0} (n : ℕ) :
  ε • μ {x | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k x)} ≤
  ennreal.of_real (∫ x in {x | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k x)},
    f n x ∂μ) :=
begin
  suffices : ε • μ {x | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k x)} +
    ennreal.of_real (∫ x in {x | ((range (n + 1)).sup' nonempty_range_succ (λ k, f k x)) < ε},
      f n x ∂μ) ≤ ennreal.of_real (μ[f n]),
  { have hadd : ennreal.of_real (∫ (x : α), f n x ∂μ) =
      ennreal.of_real (∫ (x : α) in
        {x : α | ↑ε ≤ ((range (n + 1)).sup' nonempty_range_succ (λ k, f k x))}, f n x ∂μ) +
      ennreal.of_real (∫ (x : α) in
        {x : α | ((range (n + 1)).sup' nonempty_range_succ (λ k, f k x)) < ↑ε}, f n x ∂μ),
    { rw [← ennreal.of_real_add, ← integral_union],
      { conv_lhs { rw ← integral_univ },
        convert rfl,
        ext x,
        change (ε : ℝ) ≤ _ ∨ _ < (ε : ℝ) ↔ _,
        simp only [le_or_lt, true_iff] },
      { rintro x ⟨hx₁ : _ ≤ _, hx₂ : _ < _⟩,
        exact (not_le.2 hx₂) hx₁ },
      { exact (measurable_set_lt (finset.measurable_range_sup''
          (λ n _, (hsub.strongly_measurable n).measurable.le (𝒢.le n))) measurable_const) },
      exacts [(hsub.integrable _).integrable_on, (hsub.integrable _).integrable_on,
        integral_nonneg (hnonneg _), integral_nonneg (hnonneg _)] },
    rwa [hadd, ennreal.add_le_add_iff_right ennreal.of_real_ne_top] at this },
  calc ε • μ {x | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k x)}
    + ennreal.of_real (∫ x in {x | ((range (n + 1)).sup' nonempty_range_succ (λ k, f k x)) < ε},
        f n x ∂μ)
    ≤ ennreal.of_real (∫ x in {x | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k x)},
        stopped_value f (hitting f {y : ℝ | ↑ε ≤ y} 0 n) x ∂μ)
    + ennreal.of_real (∫ x in {x | ((range (n + 1)).sup' nonempty_range_succ (λ k, f k x)) < ε},
        stopped_value f (hitting f {y : ℝ | ↑ε ≤ y} 0 n) x ∂μ) :
    begin
      refine add_le_add (smul_le_stopped_value_hitting hsub _)
        (ennreal.of_real_le_of_real (set_integral_mono_on (hsub.integrable n).integrable_on
        (integrable.integrable_on (integrable_stopped_value
          (hitting_is_stopping_time hsub.adapted measurable_set_Ici) hsub.integrable hitting_le))
        (measurable_set_lt (finset.measurable_range_sup''
          (λ n _, (hsub.strongly_measurable n).measurable.le (𝒢.le n))) measurable_const) _)),
      intros x hx,
      rw set.mem_set_of_eq at hx,
      have : hitting f {y : ℝ | ↑ε ≤ y} 0 n x = n,
      { simp only [hitting, set.mem_set_of_eq, exists_prop, pi.coe_nat, nat.cast_id,
          ite_eq_right_iff, forall_exists_index, and_imp],
        intros m hm hεm,
        exact false.elim ((not_le.2 hx)
          ((le_sup'_iff _).2 ⟨m, mem_range.2 (nat.lt_succ_of_le hm.2), hεm⟩)) },
      simp_rw [stopped_value, this],
    end
    ... = ennreal.of_real (∫ x, stopped_value f (hitting f {y : ℝ | ↑ε ≤ y} 0 n) x ∂μ) :
    begin
      rw [← ennreal.of_real_add, ← integral_union],
      { conv_rhs { rw ← integral_univ },
        convert rfl,
        ext x,
        change _ ↔ (ε : ℝ) ≤ _ ∨ _ < (ε : ℝ),
        simp only [le_or_lt, iff_true] },
      { rintro x ⟨hx₁ : _ ≤ _, hx₂ : _ < _⟩,
        exact (not_le.2 hx₂) hx₁ },
      { exact (measurable_set_lt (finset.measurable_range_sup''
          (λ n _, (hsub.strongly_measurable n).measurable.le (𝒢.le n))) measurable_const) },
      { exact (integrable.integrable_on (integrable_stopped_value
          (hitting_is_stopping_time hsub.adapted measurable_set_Ici) hsub.integrable hitting_le)) },
      { exact (integrable.integrable_on (integrable_stopped_value
          (hitting_is_stopping_time hsub.adapted measurable_set_Ici) hsub.integrable hitting_le)) },
      exacts [integral_nonneg (λ x, hnonneg _ _), integral_nonneg (λ x, hnonneg _ _)],
    end
    ... ≤ ennreal.of_real (μ[f n]) :
    begin
      refine ennreal.of_real_le_of_real _,
      rw ← stopped_value_const f n,
      exact hsub.expected_stopped_value_mono
        (hitting_is_stopping_time hsub.adapted measurable_set_Ici)
        (is_stopping_time_const _ _) (λ x, hitting_le x) (λ x, le_rfl : ∀ x, n ≤ n),
    end
end

end maximal

end nat

end measure_theory


import ..lectures.love08_operational_semantics_demo

/-! # LoVe Exercise 8: Operational Semantics -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Guarded Command Language

In 1976, E. W. Dijkstra introduced the guarded command language (GCL), a
minimalistic imperative language with built-in nondeterminism. A grammar for one
of its variants is given below:

    S  ::=  x := e       -- assignment
         |  assert b     -- assertion
         |  S ; S        -- sequential composition
         |  S | ⋯ | S    -- nondeterministic choice
         |  loop S       -- nondeterministic iteration

Assignment and sequential composition are as in the WHILE language. The other
statements have the following semantics:

* `assert b` aborts if `b` evaluates to false; otherwise, the command is a
  no-op.

* `S | ⋯ | S` chooses any of the branches and executes it, ignoring the other
  branches.

* `loop S` executes `S` any number of times.

In Lean, GCL is captured by the following inductive type: -/

namespace gcl

inductive stmt (σ : Type) : Type
| assign : string → (σ → ℕ) → stmt
| assert : (σ → Prop) → stmt
| seq    : stmt → stmt → stmt
| choice : list stmt → stmt
| loop   : stmt → stmt

infixr (name := seq_exercise) ` ;; ` : 90 := stmt.seq

/-! The parameter `σ` abstracts over the state type. It is necessary as a work
around for a Lean bug. Below we will take `σ := state`.

1.1. Complete the following big-step semantics, based on the informal
specification of GCL above. -/

inductive big_step : (stmt state × state) → state → Prop
| assign {x a s} :
  big_step (stmt.assign x a, s) (s{x ↦ a s})
| assert {b : state → Prop} {s} (hcond : b s) :
  big_step (stmt.assert b, s) s
| seq {S T s t u} (h₁ : big_step (S, s) t) (h₂ : big_step (T, t) u) :
  big_step (S ;; T, s) u
| choice {Ss s t} (i) (hless : i < list.length Ss)
    (hbody : big_step (list.nth_le Ss i hless, s) t) :
  big_step (stmt.choice Ss, s) t
| loop_base {S s} :
  big_step (stmt.loop S, s) s
| loop_step {S s u} (t) (hbody : big_step (S, s) t)
    (hrest : big_step (stmt.loop S, t) u) :
  big_step (stmt.loop S, s) u

infix (name := big_step_exercise) ` ⟹ ` : 110 := big_step

/-! 1.2. Prove the following inversion rules, as we did in the lecture for the
WHILE language. -/

@[simp] lemma big_step_assign_iff {x a s t} :
  (stmt.assign x a, s) ⟹ t ↔ t = s{x ↦ a s} :=
begin
  apply iff.intro,
  { intro hasn,
    cases' hasn,
    refl },
  { intro heq,
    rw heq,
    exact big_step.assign }
end

@[simp] lemma big_step_assert {b s t} :
  (stmt.assert b, s) ⟹ t ↔ t = s ∧ b s :=
begin
  apply iff.intro,
  { intro hast,
    cases' hast,
    simp * at * },
  { intros hand,
    cases' hand,
    rw left,
    apply big_step.assert right }
end

@[simp] lemma big_step_seq_iff {S₁ S₂ s t} :
  (stmt.seq S₁ S₂, s) ⟹ t ↔ (∃u, (S₁, s) ⟹ u ∧ (S₂, u) ⟹ t) :=
begin
  apply iff.intro,
  { intro hseq,
    cases' hseq,
    apply exists.intro,
    apply and.intro; assumption },
  { intro hseq,
    cases' hseq,
    cases' h,
    apply big_step.seq; assumption }
end

lemma big_step_loop {S s u} :
  (stmt.loop S, s) ⟹ u ↔
  (s = u ∨ (∃t, (S, s) ⟹ t ∧ (stmt.loop S, t) ⟹ u)) :=
begin
  apply iff.intro,
  { intro hloop,
    cases' hloop,
    { apply or.intro_left,
      refl },
    { apply or.intro_right,
      apply exists.intro t,
      cc } },
  { intro hor,
    cases' hor,
    { rw h,
      apply big_step.loop_base },
    { cases' h,
      cases' h,
      apply big_step.loop_step; assumption } }
end

@[simp] lemma big_step_choice {Ss s t} :
  (stmt.choice Ss, s) ⟹ t ↔
  (∃(i : ℕ) (hless : i < list.length Ss),
     (list.nth_le Ss i hless, s) ⟹ t) :=
begin
  apply iff.intro,
  { intro hchoice,
    cases' hchoice,
    apply exists.intro i,
    apply exists.intro hless,
    assumption },
  { intro hex,
    cases' hex with i hex,
    cases' hex with hless hstep,
    apply big_step.choice; assumption }
end

end gcl

/-! 1.3. Complete the translation below of a deterministic program to a GCL
program, by filling in the `sorry` placeholders below. -/

def gcl_of : stmt → gcl.stmt state
| stmt.skip         := gcl.stmt.assert (λ_, true)
| (stmt.assign x a) :=
  gcl.stmt.assign x a
| (S ;; T)          :=
  gcl_of S ;;
  gcl_of T
| (stmt.ite b S T)  :=
  gcl.stmt.choice [
    gcl.stmt.assert b ;; gcl_of S,
    gcl.stmt.assert (λs, ¬ b s) ;; gcl_of T
  ]
| (stmt.while b S)  :=
  gcl.stmt.loop
    (gcl.stmt.assert b ;;
     gcl_of S) ;;
  gcl.stmt.assert (λs, ¬ b s)

/-! 1.4. In the definition of `gcl_of` above, `skip` is translated to
`assert (λ_, true)`. Looking at the big-step semantics of both constructs, we
can convince ourselves that it makes sense. Can you think of other correct ways
to define the `skip` case? -/

/-! Here are two other possibilities:

* `loop (assert (λ_, false))`
* `assign "x" (λs, s "x")`

There are infinitely many variants, e.g., `seq` of the above two solutions. -/

/-! ## Question 2: Program Equivalence

For this question, we introduce the notion of program equivalence: `S₁ ≈ S₂`. -/

def big_step_equiv (S₁ S₂ : stmt) : Prop :=
∀s t, (S₁, s) ⟹ t ↔ (S₂, s) ⟹ t

infix (name := equiv_exercise) ` ≈ ` := big_step_equiv

/-! Program equivalence is a equivalence relation, i.e., it is reflexive,
symmetric, and transitive. -/

@[refl] lemma big_step_equiv.refl {S : stmt} :
  S ≈ S :=
fix s t,
show (S, s) ⟹ t ↔ (S, s) ⟹ t, from
  by refl

@[symm] lemma big_step_equiv.symm {S₁ S₂ : stmt}:
  S₁ ≈ S₂ → S₂ ≈ S₁ :=
assume h : S₁ ≈ S₂,
fix s t,
show (S₂, s) ⟹ t ↔ (S₁, s) ⟹ t, from
  iff.symm (h s t)

@[trans] lemma big_step_equiv.trans {S₁ S₂ S₃ : stmt} (h₁₂ : S₁ ≈ S₂)
    (h₂₃ : S₂ ≈ S₃) :
  S₁ ≈ S₃ :=
fix s t,
show (S₁, s) ⟹ t ↔ (S₃, s) ⟹ t, from
  iff.trans (h₁₂ s t) (h₂₃ s t)

/-! 2.1. Prove the following program equivalences. -/

lemma big_step_equiv.skip_assign_id {x} :
  stmt.assign x (λs, s x) ≈ stmt.skip :=
begin
  intros s t,
  apply iff.intro,
  { intro hasn,
    cases' hasn,
    simp * at * },
  { intro hskip,
    cases' hskip,
    simp * at * }
end

lemma big_step_equiv.seq_skip_left {S : stmt} :
  stmt.skip ;; S ≈ S :=
begin
  intros s t,
  apply iff.intro,
  { intro h,
    cases' h,
    cases' h_1,
    assumption },
  { intro h,
    exact big_step.seq big_step.skip h }
end

lemma big_step_equiv.seq_skip_right {S : stmt} :
  S ;; stmt.skip ≈ S :=
begin
  intros s t,
  apply iff.intro,
  { intro h,
    cases' h,
    cases' h_1,
    assumption },
  { intro h,
    exact big_step.seq h big_step.skip }
end

lemma big_step_equiv.ite_seq_while {b} {S : stmt} :
  stmt.ite b (S ;; stmt.while b S) stmt.skip ≈ stmt.while b S :=
begin
  intros s t,
  apply iff.intro,
  { intro hite,
    cases' hite,
    { cases' hite,
      apply big_step.while_true; assumption },
    { cases' hite,
      apply big_step.while_false,
      assumption } },
  { intro while,
    cases' while,
    { apply big_step.ite_true hcond,
      apply big_step.seq; assumption },
    { apply big_step.ite_false hcond,
      exact big_step.skip } }
end

/-! 2.2 (**optional**). Program equivalence can be used to replace subprograms
by other subprograms with the same semantics. Prove the following so-called
congruence rules: -/

lemma big_step_equiv.seq_congr {S₁ S₂ T₁ T₂ : stmt} (hS : S₁ ≈ S₂)
    (hT : T₁ ≈ T₂) :
  S₁ ;; T₁ ≈ S₂ ;; T₂ :=
begin
  intros s t,
  apply iff.intro,
  { intro hseq,
    cases' hseq with _ _ _ _ _ _ _ u _ hS₁ hT₁,
    apply big_step.seq,
    { apply iff.elim_left (hS _ _) hS₁ },
    { apply iff.elim_left (hT _ _) hT₁ } },
  { intros hseq,
    cases' hseq with _ _ _ _ _ _ _ u _ hS₂ hT₂,
    apply big_step.seq,
    { exact iff.elim_right (hS _ _) hS₂ },
    { exact iff.elim_right (hT _ _) hT₂ } }
end

lemma big_step_equiv.ite_congr {b} {S₁ S₂ T₁ T₂ : stmt} (hS : S₁ ≈ S₂)
    (hT : T₁ ≈ T₂) :
  stmt.ite b S₁ T₁ ≈ stmt.ite b S₂ T₂ :=
begin
  intros s t,
  apply iff.intro,
  { intro hite,
    cases' hite,
    case ite_true : _ _ _ _ _ hcond hbody {
      apply big_step.ite_true hcond,
      exact iff.elim_left (hS _ _) hbody },
    case ite_false : _ _ _ _ _ hcond hbody {
      apply big_step.ite_false hcond,
      exact iff.elim_left (hT _ _) hbody } },
  { intro hite,
    cases' hite,
    case ite_true : _ _ _ _ _ hcond hbody {
      apply big_step.ite_true hcond,
      exact iff.elim_right (hS _ _) hbody },
    case ite_false : _ _ _ _ _ hcond hbody {
      apply big_step.ite_false hcond,
      exact iff.elim_right (hT _ _) hbody } }
end

lemma denote_equiv.while_congr {b} {S₁ S₂ : stmt} (hS : S₁ ≈ S₂) :
  stmt.while b S₁ ≈ stmt.while b S₂ :=
begin
  intros s t,
  apply iff.intro,
  { intro hwhile,
    induction' hwhile,
    case while_true : b S t u v hcond hbody hrest ih_body ih_rest {
      apply big_step.while_true hcond,
      exact iff.elim_left (hS _ _) hbody,
      exact ih_rest hS },
    case while_false {
      exact big_step.while_false hcond } },
  { intro hwhile,
    induction' hwhile,
    case while_true : b S t u v hcond hbody hrest ih_body ih_rest {
      apply big_step.while_true hcond,
      exact iff.elim_right (hS _ _) hbody,
      exact ih_rest hS },
    case while_false {
      exact big_step.while_false hcond } }
end

end LoVe


import Logic.Vorspiel.Vorspiel
import Mathlib.Data.Finset.Basic

structure Language where
  func : Nat → Type u
  rel  : Nat → Type u

namespace Language

protected def empty : Language.{u} where
  func := fun _ => PEmpty
  rel  := fun _ => PEmpty

instance : Inhabited Language := ⟨Language.empty⟩

inductive GraphFunc : ℕ → Type
  | start : GraphFunc 0
  | terminal : GraphFunc 0

inductive GraphRel : ℕ → Type
  | equal : GraphRel 2
  | le : GraphRel 2

def graph : Language where
  func := GraphFunc
  rel := GraphRel

inductive BinaryRel : ℕ → Type
  | isone : BinaryRel 1
  | equal : BinaryRel 2
  | le : BinaryRel 2

def binary : Language where
  func := fun _ => Empty
  rel := BinaryRel

inductive EqRel : ℕ → Type
  | equal : EqRel 2

@[reducible]
def equal : Language where
  func := fun _ => Empty
  rel := EqRel

instance (k) : ToString (equal.func k) := ⟨fun _ => ""⟩

instance (k) : ToString (equal.rel k) := ⟨fun _ => "\\mathrm{Eq}"⟩

instance (k) : DecidableEq (equal.func k) := fun a b => by rcases a

instance (k) : DecidableEq (equal.rel k) := fun a b => by rcases a; rcases b; exact isTrue (by simp)

instance (k) : Encodable (equal.func k) := Encodable.IsEmpty.toEncodable

instance (k) : Encodable (equal.rel k) where
  encode := fun _ => 0
  decode := fun _ =>
    match k with
    | 2 => some EqRel.equal
    | _ => none
  encodek := fun x => by rcases x; simp

inductive ORingFunc : ℕ → Type
  | zero : ORingFunc 0
  | one : ORingFunc 0
  | add : ORingFunc 2
  | mul : ORingFunc 2

inductive ORingRel : ℕ → Type
  | eq : ORingRel 2
  | lt : ORingRel 2

@[reducible]
def oring : Language where
  func := ORingFunc
  rel := ORingRel

instance (k) : ToString (oring.func k) :=
⟨ fun s =>
  match s with
  | ORingFunc.zero => "0"
  | ORingFunc.one  => "1"
  | ORingFunc.add  => "(+)"
  | ORingFunc.mul  => "(\\cdot)"⟩

instance (k) : ToString (oring.rel k) :=
⟨ fun s =>
  match s with
  | ORingRel.eq => "\\mathrm{Eq}"
  | ORingRel.lt    => "\\mathrm{Lt}"⟩

instance (k) : DecidableEq (oring.func k) := fun a b =>
  by rcases a <;> rcases b <;> simp <;> try {exact instDecidableTrue} <;> try {exact instDecidableFalse}

instance (k) : DecidableEq (oring.rel k) := fun a b =>
  by rcases a <;> rcases b <;> simp <;> try {exact instDecidableTrue} <;> try {exact instDecidableFalse}

instance (k) : Encodable (oring.func k) where
  encode := fun x =>
    match x with
    | ORingFunc.zero => 0
    | ORingFunc.one  => 1
    | ORingFunc.add  => 0
    | ORingFunc.mul  => 1
  decode := fun e =>
    match k, e with
    | 0, 0 => some ORingFunc.zero
    | 0, 1 => some ORingFunc.one
    | 2, 0 => some ORingFunc.add
    | 2, 1 => some ORingFunc.mul
    | _, _ => none
  encodek := fun x => by rcases x <;> simp

instance (k) : Encodable (oring.rel k) where
  encode := fun x =>
    match x with
    | ORingRel.eq => 0
    | ORingRel.lt    => 1
  decode := fun e =>
    match k, e with
    | 2, 0 => some ORingRel.eq
    | 2, 1 => some ORingRel.lt
    | _, _ => none
  encodek := fun x => by rcases x <;> simp

def relational (α : ℕ → Type u) : Language where
  func := fun _ => PEmpty
  rel := α

section relational
variable {α : ℕ → Type u} [e : ∀ n, Encodable (α n)] [d : ∀ n, DecidableEq (α n)] [s : ∀ n, ToString (α n)]

instance (k) : Encodable ((relational α).func k) := Encodable.IsEmpty.toEncodable (α := PEmpty)

instance (k) : Encodable ((relational α).rel k) := e k

instance (k) : DecidableEq ((relational α).func k) := fun a => by cases a

instance (k) : DecidableEq ((relational α).rel k) := d k

instance : ToString ((relational α).rel k) :=
  ⟨fun a => "R^{" ++ toString k ++ "}_{" ++ toString (α := α k) a ++ "}"⟩

def toRelational (a : α k) : (relational α).rel k := a

instance : ToString ((relational α).func k) := ⟨fun a => by cases a⟩

end relational

class HasEq (L : Language.{u}) where
  eq : L.rel 2

class HasLt (L : Language.{u}) where
  lt : L.rel 2

class HasZero (L : Language.{u}) where
  zero : L.func 0

class HasOne (L : Language.{u}) where
  one : L.func 0

class HasAdd (L : Language.{u}) where
  add : L.func 2

class HasMul (L : Language.{u}) where
  mul : L.func 2

attribute [match_pattern] HasEq.eq HasAdd.add HasMul.mul

class HasORing (L : Language) extends L.HasEq, L.HasLt, L.HasZero, L.HasOne, L.HasAdd, L.HasMul

instance : HasORing oring where
  eq := ORingRel.eq
  lt := ORingRel.lt
  zero := ORingFunc.zero
  one := ORingFunc.one
  add := ORingFunc.add
  mul := ORingFunc.mul

structure Hom (L₁ L₂ : Language) where
  onFunc : {k : ℕ} → L₁.func k → L₂.func k
  onRel : {k : ℕ} → L₁.rel k → L₂.rel k

infix:25 " →ᵥ " => Hom

namespace Hom
variable (L L₁ L₂ L₃ : Language) (Φ : Hom L₁ L₂)

protected def id : L →ᵥ L where
  onFunc := id
  onRel := id

variable {L L₁ L₂ L₃}

def comp (Ψ : L₂ →ᵥ L₃) (Φ : L₁ →ᵥ L₂) : L₁ →ᵥ L₃ where
  onFunc := Ψ.onFunc ∘ Φ.onFunc
  onRel  := Ψ.onRel ∘ Φ.onRel

end Hom

def subLanguage (L : Language) (pfunc : ∀ k, Language.func L k → Prop) (prel : ∀ k, L.rel k → Prop) :
    Language where
  func := fun k => Subtype (pfunc k)
  rel  := fun k => Subtype (prel k)

section subLanguage

variable (L) {pf : ∀ k, Language.func L k → Prop} {pr : ∀ k, L.rel k → Prop}

def ofSubLanguage : subLanguage L pf pr →ᵥ L where
  onFunc := Subtype.val
  onRel  := Subtype.val

@[simp] lemma ofSubLanguage_onFunc {k : ℕ} :
    (ofSubLanguage L).onFunc p = p.val := rfl

@[simp] lemma ofSubLanguage_onRel {k : ℕ} :
    (ofSubLanguage L).onRel p = p.val := rfl

end subLanguage

end Language


/-
Copyright (c) 2022 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 topology.metric_space.pi_nat
import topology.metric_space.isometry
import topology.metric_space.gluing
import analysis.normed.field.basic

/-!
# Polish spaces

A topological space is Polish if its topology is second-countable and there exists a compatible
complete metric. This is the class of spaces that is well-behaved with respect to measure theory.
In this file, we establish the basic properties of Polish spaces.

## Main definitions and results

* `polish_space α` is a mixin typeclass on a topological space, requiring that the topology is
  second-countable and compatible with a complete metric. To endow the space with such a metric,
  use in a proof `letI := upgrade_polish_space α`.
  We register an instance from complete second-countable metric spaces to Polish spaces, not the
  other way around.
* We register that countable products and sums of Polish spaces are Polish.
* `is_closed.polish_space`: a closed subset of a Polish space is Polish.
* `is_open.polish_space`: an open subset of a Polish space is Polish.
* `exists_nat_nat_continuous_surjective`: any nonempty Polish space is the continuous image
  of the fundamental Polish space `ℕ → ℕ`.

A fundamental property of Polish spaces is that one can put finer topologies, still Polish,
with additional properties:

* `exists_polish_space_forall_le`: on a topological space, consider countably many topologies
  `t n`, all Polish and finer than the original topology. Then there exists another Polish
  topology which is finer than all the `t n`.
* `is_clopenable s` is a property of a subset `s` of a topological space, requiring that there
  exists a finer topology, which is Polish, for which `s` becomes open and closed. We show that
  this property is satisfied for open sets, closed sets, for complements, and for countable unions.
  Once Borel-measurable sets are defined in later files, it will follow that any Borel-measurable
  set is clopenable. Once the Lusin-Souslin theorem is proved using analytic sets, we will even
  show that a set is clopenable if and only if it is Borel-measurable, see
  `is_clopenable_iff_measurable_set`.
-/

noncomputable theory
open_locale classical topology filter
open topological_space set metric filter function

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

/-! ### Basic properties of Polish spaces -/

/-- A Polish space is a topological space with second countable topology, that can be endowed
with a metric for which it is complete.
We register an instance from complete second countable metric space to polish space, and not the
other way around as this is the most common use case.

To endow a Polish space with a complete metric space structure, do `letI := upgrade_polish_space α`.
-/
class polish_space (α : Type*) [h : topological_space α] : Prop :=
(second_countable [] : second_countable_topology α)
(complete : ∃ m : metric_space α, m.to_uniform_space.to_topological_space = h ∧
  @complete_space α m.to_uniform_space)

/-- A convenience class, for a Polish space endowed with a complete metric. No instance of this
class should be registered: It should be used as `letI := upgrade_polish_space α` to endow a Polish
space with a complete metric. -/
class upgraded_polish_space (α : Type*) extends metric_space α, second_countable_topology α,
  complete_space α

@[priority 100]
instance polish_space_of_complete_second_countable
  [m : metric_space α] [h : second_countable_topology α] [h' : complete_space α] :
  polish_space α :=
{ second_countable := h,
  complete := ⟨m, rfl, h'⟩ }

/-- Construct on a Polish space a metric (compatible with the topology) which is complete. -/
def polish_space_metric (α : Type*) [ht : topological_space α] [h : polish_space α] :
  metric_space α :=
h.complete.some.replace_topology h.complete.some_spec.1.symm

lemma complete_polish_space_metric (α : Type*) [ht : topological_space α] [h : polish_space α] :
  @complete_space α (polish_space_metric α).to_uniform_space :=
begin
  convert h.complete.some_spec.2,
  exact metric_space.replace_topology_eq _ _
end

/-- This definition endows a Polish space with a complete metric. Use it as:
`letI := upgrade_polish_space α`. -/
def upgrade_polish_space (α : Type*) [ht : topological_space α] [h : polish_space α] :
  upgraded_polish_space α :=
begin
  letI := polish_space_metric α,
  exact { .. complete_polish_space_metric α, .. polish_space.second_countable α }
end

namespace polish_space

@[priority 100]
instance t2_space (α : Type*) [topological_space α] [polish_space α] : t2_space α :=
by { letI := upgrade_polish_space α, apply_instance }

/-- A countable product of Polish spaces is Polish. -/
instance pi_countable {ι : Type*} [countable ι] {E : ι → Type*}
  [∀ i, topological_space (E i)] [∀ i, polish_space (E i)] :
  polish_space (Π i, E i) :=
begin
  casesI nonempty_encodable ι,
  letI := λ i, upgrade_polish_space (E i),
  letI : metric_space (Π i, E i) := pi_countable.metric_space,
  apply_instance,
end

/-- Without this instance, `polish_space (ℕ → ℕ)` is not found by typeclass inference. -/
instance nat_fun [topological_space α] [polish_space α] :
  polish_space (ℕ → α) :=
by apply_instance

/-- A countable disjoint union of Polish spaces is Polish. -/
instance sigma {ι : Type*} [countable ι]
  {E : ι → Type*} [∀ n, topological_space (E n)] [∀ n, polish_space (E n)] :
  polish_space (Σ n, E n) :=
begin
  letI := λ n, upgrade_polish_space (E n),
  letI : metric_space (Σ n, E n) := sigma.metric_space,
  haveI : complete_space (Σ n, E n) := sigma.complete_space,
  apply_instance
end

/-- The disjoint union of two Polish spaces is Polish. -/
instance sum [topological_space α] [polish_space α] [topological_space β] [polish_space β] :
  polish_space (α ⊕ β) :=
begin
  letI := upgrade_polish_space α,
  letI := upgrade_polish_space β,
  letI : metric_space (α ⊕ β) := metric_space_sum,
  apply_instance
end

/-- Any nonempty Polish space is the continuous image of the fundamental space `ℕ → ℕ`. -/
lemma exists_nat_nat_continuous_surjective
  (α : Type*) [topological_space α] [polish_space α] [nonempty α] :
  ∃ (f : (ℕ → ℕ) → α), continuous f ∧ surjective f :=
begin
  letI := upgrade_polish_space α,
  exact exists_nat_nat_continuous_surjective_of_complete_space α
end

/-- Given a closed embedding into a Polish space, the source space is also Polish. -/
lemma _root_.closed_embedding.polish_space [topological_space α] [topological_space β]
  [polish_space β] {f : α → β} (hf : closed_embedding f) :
  polish_space α :=
begin
  letI := upgrade_polish_space β,
  letI : metric_space α := hf.to_embedding.comap_metric_space f,
  haveI : second_countable_topology α := hf.to_embedding.second_countable_topology,
  haveI : complete_space α,
  { rw complete_space_iff_is_complete_range hf.to_embedding.to_isometry.uniform_inducing,
    apply is_closed.is_complete,
    exact hf.closed_range },
  apply_instance
end

/-- Pulling back a Polish topology under an equiv gives again a Polish topology. -/
lemma _root_.equiv.polish_space_induced [t : topological_space β] [polish_space β]
  (f : α ≃ β) :
  @polish_space α (t.induced f) :=
begin
  letI : topological_space α := t.induced f,
  exact (f.to_homeomorph_of_inducing ⟨rfl⟩).closed_embedding.polish_space,
end

/-- A closed subset of a Polish space is also Polish. -/
lemma _root_.is_closed.polish_space {α : Type*} [topological_space α] [polish_space α] {s : set α}
  (hs : is_closed s) :
  polish_space s :=
(is_closed.closed_embedding_subtype_coe hs).polish_space

/-- A sequence of type synonyms of a given type `α`, useful in the proof of
`exists_polish_space_forall_le` to endow each copy with a different topology. -/
@[nolint unused_arguments has_nonempty_instance]
def aux_copy (α : Type*) {ι : Type*} (i : ι) : Type* := α

/-- Given a Polish space, and countably many finer Polish topologies, there exists another Polish
topology which is finer than all of them. -/
lemma exists_polish_space_forall_le {ι : Type*} [countable ι]
  [t : topological_space α] [p : polish_space α]
  (m : ι → topological_space α) (hm : ∀ n, m n ≤ t) (h'm : ∀ n, @polish_space α (m n)) :
  ∃ (t' : topological_space α), (∀ n, t' ≤ m n) ∧ (t' ≤ t) ∧ @polish_space α t' :=
begin
  rcases is_empty_or_nonempty ι with hι|hι,
  { exact ⟨t, λ i, (is_empty.elim hι i : _), le_rfl, p⟩ },
  unfreezingI { inhabit ι },
  /- Consider the product of infinitely many copies of `α`, each endowed with the topology `m n`.
  This is a Polish space, as a product of Polish spaces. Pulling back this topology under the
  diagonal embedding of `α`, one gets a Polish topology which is finer than all the `m n`. -/
  letI : ∀ (n : ι), topological_space (aux_copy α n) := λ n, m n,
  haveI : ∀ (n : ι), polish_space (aux_copy α n) := λ n, h'm n,
  letI T : topological_space (Π (n : ι), aux_copy α n) := by apply_instance,
  let f : α → Π (n : ι), aux_copy α n := λ x n, x,
  -- show that the induced topology is finer than all the `m n`.
  have T_le_m : ∀ n, T.induced f ≤ m n,
  { assume n s hs,
    refine ⟨set.pi ({n} : set ι) (λ i, s), _, _⟩,
    { apply is_open_set_pi (finite_singleton _),
      assume a ha,
      rw mem_singleton_iff.1 ha,
      exact hs },
    { ext x,
      simp only [singleton_pi, mem_preimage] } },
  refine ⟨T.induced f, λ n, T_le_m n, (T_le_m default).trans (hm default), _⟩,
  -- show that the new topology is Polish, as the pullback of a Polish topology under a closed
  -- embedding.
  have A : range f = ⋂ n, {x | x n = x default},
  { ext x,
    split,
    { rintros ⟨y, rfl⟩,
      exact mem_Inter.2 (λ n, by simp only [mem_set_of_eq]) },
    { assume hx,
      refine ⟨x default, _⟩,
      ext1 n,
      symmetry,
      exact (mem_Inter.1 hx n : _) } },
  have f_closed : is_closed (range f),
  { rw A,
    apply is_closed_Inter (λ n, _),
    have C : ∀ (i : ι), continuous (λ (x : Π n, aux_copy α n), (id (x i) : α)),
    { assume i,
      apply continuous.comp _ (continuous_apply i),
      apply continuous_def.2 (λ s hs, _),
      exact hm i s hs },
    apply is_closed_eq (C n) (C default) },
  have K : @_root_.embedding _ _ (T.induced f) T f,
  { apply function.injective.embedding_induced,
    assume x y hxy,
    have : f x default = f y default, by rw hxy,
    exact this },
  have L : @closed_embedding _ _ (T.induced f) T f,
  { split,
    { exact K },
    { exact f_closed } },
  exact @closed_embedding.polish_space _ _ (T.induced f) T (by apply_instance) _ L
end

/-!
### An open subset of a Polish space is Polish

To prove this fact, one needs to construct another metric, giving rise to the same topology,
for which the open subset is complete. This is not obvious, as for instance `(0,1) ⊆ ℝ` is not
complete for the usual metric of `ℝ`: one should build a new metric that blows up close to the
boundary.
-/

section complete_copy

variables [metric_space α] {s : set α}

/-- A type synonym for a subset `s` of a metric space, on which we will construct another metric
for which it will be complete. -/
@[nolint has_nonempty_instance]
def complete_copy {α : Type*} (s : set α) : Type* := s

/-- A distance on a subset `s` of a metric space, designed to make it complete if `s` is open.
It is given by `dist' x y = dist x y + |1 / dist x sᶜ - 1 / dist y sᶜ|`, where the second term
blows up close to the boundary to ensure that Cauchy sequences for `dist'` remain well
inside `s`. -/
def has_dist_complete_copy (s : set α) : has_dist (complete_copy s) :=
⟨λ x y, dist x.1 y.1 + abs (1 / inf_dist x.1 sᶜ - 1 / inf_dist y.1 sᶜ)⟩

local attribute [instance] has_dist_complete_copy

lemma dist_complete_copy_eq (x y : complete_copy s) :
  dist x y = dist x.1 y.1 + abs (1/inf_dist x.1 sᶜ - 1 / inf_dist y.1 sᶜ) := rfl

lemma dist_le_dist_complete_copy (x y : complete_copy s) :
  dist x.1 y.1 ≤ dist x y :=
(le_add_iff_nonneg_right _).2 (abs_nonneg _)

/-- A metric space structure on a subset `s` of a metric space, designed to make it complete
if `s` is open. It is given by `dist' x y = dist x y + |1 / dist x sᶜ - 1 / dist y sᶜ|`, where the
second term blows up close to the boundary to ensure that Cauchy sequences for `dist'` remain well
inside `s`. -/
def complete_copy_metric_space (s : set α) : metric_space (complete_copy s) :=
{ dist_self := λ x, by simp [dist_complete_copy_eq],
  dist_comm := λ x y, by simp [dist_complete_copy_eq, dist_comm, abs_sub_comm],
  dist_triangle := λ x y z, calc
    dist x z = dist x.1 z.1 + abs (1 / inf_dist x.1 sᶜ - 1 / inf_dist z.1 sᶜ) : rfl
    ... ≤ (dist x.1 y.1 + dist y.1 z.1) +
      (abs (1 / inf_dist x.1 sᶜ - 1 / inf_dist y.1 sᶜ)
      + abs (1 / inf_dist y.1 sᶜ - 1 / inf_dist z.1 sᶜ)) :
    begin
      rw [← real.dist_eq, ← real.dist_eq, ← real.dist_eq],
      exact add_le_add (dist_triangle _ _ _) (dist_triangle _ _ _)
    end
    ... = dist x y + dist y z : by { rw [dist_complete_copy_eq, dist_complete_copy_eq], abel },
  eq_of_dist_eq_zero :=
  begin
    assume x y hxy,
    apply subtype.coe_injective,
    refine dist_le_zero.1 _,
    rw ← hxy,
    exact dist_le_dist_complete_copy x y
  end }

local attribute [instance] complete_copy_metric_space

/-- The identity between the type synonym `complete_copy s` (with its modified metric) and the
original subtype `s` is a homeomorphism. -/
def complete_copy_id_homeo (hs : is_open s) (h's : sᶜ.nonempty) : complete_copy s ≃ₜ s :=
{ to_fun := id,
  inv_fun := id,
  left_inv := λ x, rfl,
  right_inv := λ x, rfl,
  continuous_to_fun :=
  begin
    have : lipschitz_with 1 (λ (x : complete_copy s), (id x : s)),
    { apply lipschitz_with.mk_one,
      exact dist_le_dist_complete_copy },
    exact this.continuous,
  end,
  continuous_inv_fun :=
  begin
    apply continuous_iff_continuous_at.2 (λ x, _),
    suffices H : tendsto (λ (b : s), dist b.1 x.1
      + |1 / inf_dist b.1 sᶜ - 1 / inf_dist x.1 sᶜ|) (𝓝 x)
      (𝓝 (dist x.1 x.1 + abs (1 / inf_dist x.1 sᶜ - 1 / inf_dist x.1 sᶜ))),
    { rw [continuous_at, tendsto_iff_dist_tendsto_zero],
      simpa only [sub_self, abs_zero, add_zero, dist_self] using H },
    have I : 0 < inf_dist x.val sᶜ,
    { rw ← hs.is_closed_compl.not_mem_iff_inf_dist_pos h's,
      simp },
    apply tendsto.add,
    { apply continuous.tendsto, exact continuous_subtype_coe.dist continuous_const },
    { refine (tendsto.sub_const _ _).abs,
      refine tendsto.div tendsto_const_nhds _ I.ne',
      exact ((continuous_inf_dist_pt _).comp continuous_subtype_coe).tendsto _ }
  end }

lemma complete_space_complete_copy [complete_space α] (hs : is_open s) (h's : sᶜ.nonempty) :
  complete_space (complete_copy s) :=
begin
  refine metric.complete_of_convergent_controlled_sequences (λ n, (1/2)^n) (by simp) _,
  assume u hu,
  have A : cauchy_seq (λ n, (u n).1),
  { apply cauchy_seq_of_le_tendsto_0 (λ (n : ℕ), (1/2)^n) (λ n m N hNn hNm, _) _,
    { exact (dist_le_dist_complete_copy (u n) (u m)).trans (hu N n m hNn hNm).le },
    { exact tendsto_pow_at_top_nhds_0_of_lt_1 (by norm_num) (by norm_num) } },
  obtain ⟨x, xlim⟩ : ∃ x, tendsto (λ n, (u n).1) at_top (𝓝 x),
  { haveI : nonempty α := ⟨(u 0).1⟩,
    exact ⟨_, A.tendsto_lim⟩ },
  suffices xs : x ∈ s,
  { refine ⟨⟨x, xs⟩, _⟩,
    have L : tendsto (λ n, (id ⟨(u n).1, (u n).2⟩ : s)) at_top (𝓝 (⟨x, xs⟩)),
    { apply embedding_subtype_coe.tendsto_nhds_iff.2, exact xlim },
    convert ((complete_copy_id_homeo hs h's).symm.continuous.tendsto _).comp L,
    ext1 n,
    simp [complete_copy_id_homeo] },
  obtain ⟨C, hC⟩ : ∃ C, ∀ n, 1 / inf_dist (u n).1 sᶜ < C,
  { refine ⟨(1/2)^0 + dist (1 / inf_dist (u 0).1 sᶜ) 0, λ n, _⟩,
    calc 1 / inf_dist (u n).val sᶜ ≤ dist (1 / inf_dist (u n).val sᶜ) 0 :
      by { rw real.dist_0_eq_abs, exact le_abs_self _ }
    ... ≤ dist (1 / inf_dist (u n).1 sᶜ) (1 / inf_dist (u 0).1 sᶜ)
          + dist (1 / inf_dist (u 0).1 sᶜ) 0 : dist_triangle _ _ _
    ... ≤ (dist (u n).1 (u 0).1 + dist (1 / inf_dist (u n).1 sᶜ) (1 / inf_dist (u 0).1 sᶜ))
          + dist (1 / inf_dist (u 0).1 sᶜ) 0 :
      add_le_add (le_add_of_nonneg_left dist_nonneg) le_rfl
    ... = dist (u n) (u 0) +  dist (1 / inf_dist (u 0).1 sᶜ) 0 : rfl
    ... < (1/2)^0 + dist (1 / inf_dist (u 0).1 sᶜ) 0 :
      add_lt_add_right (hu 0 n 0 (zero_le _) le_rfl) _ },
  have Cpos : 0 < C,
  { apply lt_of_le_of_lt _ (hC 0),
    simp [inf_dist_nonneg] },
  have I : ∀ n, 1/C ≤ inf_dist (u n).1 sᶜ,
  { assume n,
    have : 0 < inf_dist (u n).val sᶜ,
    { apply (hs.is_closed_compl.not_mem_iff_inf_dist_pos h's).1, simp },
    rw div_le_iff' Cpos,
    exact (div_le_iff this).1 (hC n).le },
  have I' : 1/C ≤ inf_dist x sᶜ,
  { have : tendsto (λ n, inf_dist (u n).1 sᶜ) at_top (𝓝 (inf_dist x sᶜ)) :=
      ((continuous_inf_dist_pt sᶜ).tendsto x).comp xlim,
    exact ge_of_tendsto' this I },
  suffices : x ∉ sᶜ, by simpa,
  apply (hs.is_closed_compl.not_mem_iff_inf_dist_pos h's).2 (lt_of_lt_of_le _ I'),
  simp [Cpos],
end

/-- An open subset of a Polish space is also Polish. -/
lemma _root_.is_open.polish_space {α : Type*} [topological_space α] [polish_space α] {s : set α}
  (hs : is_open s) :
  polish_space s :=
begin
  rcases eq_empty_or_nonempty sᶜ with h's|h's,
  { simp at h's,
    apply is_closed.polish_space,
    rw h's,
    exact is_closed_univ },
  { letI := upgrade_polish_space α,
    haveI : complete_space (complete_copy s) := complete_space_complete_copy hs h's,
    haveI : second_countable_topology (complete_copy s) :=
      (complete_copy_id_homeo hs h's).embedding.second_countable_topology,
    exact (complete_copy_id_homeo hs h's).symm.closed_embedding.polish_space }
end

end complete_copy

/-! ### Clopenable sets in Polish spaces -/

/-- A set in a topological space is clopenable if there exists a finer Polish topology for which
this set is open and closed. It turns out that this notion is equivalent to being Borel-measurable,
but this is nontrivial (see `is_clopenable_iff_measurable_set`). -/
def is_clopenable [t : topological_space α] (s : set α) : Prop :=
∃ (t' : topological_space α), t' ≤ t ∧ @polish_space α t' ∧ is_closed[t'] s ∧ is_open[t'] s

/-- Given a closed set `s` in a Polish space, one can construct a finer Polish topology for
which `s` is both open and closed. -/
lemma _root_.is_closed.is_clopenable [topological_space α] [polish_space α] {s : set α}
  (hs : is_closed s) : is_clopenable s :=
begin
  /- Both sets `s` and `sᶜ` admit a Polish topology. So does their disjoint union `s ⊕ sᶜ`.
  Pulling back this topology by the canonical bijection with `α` gives the desired Polish
  topology in which `s` is both open and closed. -/
  haveI : polish_space s := hs.polish_space,
  let t : set α := sᶜ,
  haveI : polish_space t := hs.is_open_compl.polish_space,
  let f : α ≃ (s ⊕ t) := (equiv.set.sum_compl s).symm,
  letI T : topological_space (s ⊕ t) := by apply_instance,
  let t' : topological_space α := T.induced f,
  let g := @equiv.to_homeomorph_of_inducing  _ _ t' T f { induced := rfl },
  have A : g ⁻¹' (range (sum.inl : s → s ⊕ t)) = s,
  { ext x,
    by_cases h : x ∈ s,
    { simp only [equiv.set.sum_compl_symm_apply_of_mem, h, mem_preimage, equiv.to_fun_as_coe,
        mem_range_self, equiv.to_homeomorph_of_inducing_apply]},
    { simp only [equiv.set.sum_compl_symm_apply_of_not_mem, h, not_false_iff, mem_preimage,
        equiv.to_homeomorph_of_inducing_apply, equiv.to_fun_as_coe, mem_range, exists_false]} },
  refine ⟨t', _, f.polish_space_induced, _, _⟩,
  { assume u hu,
    change ∃ (s' : set (↥s ⊕ ↥t)), T.is_open s' ∧ f ⁻¹' s' = u,
    refine ⟨f.symm ⁻¹' u, _, by simp only [equiv.symm_symm, equiv.symm_preimage_preimage]⟩,
    refine is_open_sum_iff.2 ⟨_, _⟩,
    { have : is_open ((coe : s → α) ⁻¹' u) := is_open.preimage continuous_subtype_coe hu,
      have : sum.inl ⁻¹' (⇑(f.symm) ⁻¹' u) = (coe : s → α) ⁻¹' u,
        by { ext x, simp only [equiv.symm_symm, mem_preimage, equiv.set.sum_compl_apply_inl] },
      rwa this },
    { have : is_open ((coe : t → α) ⁻¹' u) := is_open.preimage continuous_subtype_coe hu,
      have : sum.inr ⁻¹' (⇑(f.symm) ⁻¹' u) = (coe : t → α) ⁻¹' u,
        by { ext x, simp only [equiv.symm_symm, mem_preimage, equiv.set.sum_compl_apply_inr] },
      rwa this } },
  { have : is_closed[t'] (g ⁻¹' (range (sum.inl : s → s ⊕ t))),
    { apply is_closed.preimage,
      { exact @homeomorph.continuous _ _ t' _ g },
      { exact is_closed_range_inl } },
    convert this,
    exact A.symm },
  { have : is_open[t'] (g ⁻¹' (range (sum.inl : s → s ⊕ t))),
    { apply is_open.preimage,
      { exact @homeomorph.continuous _ _ t' _ g },
      { exact is_open_range_inl } },
    convert this,
    exact A.symm },
end

lemma is_clopenable.compl [topological_space α] {s : set α} (hs : is_clopenable s) :
  is_clopenable sᶜ :=
begin
  rcases hs with ⟨t, t_le, t_polish, h, h'⟩,
  exact ⟨t, t_le, t_polish, @is_open.is_closed_compl α t s h', @is_closed.is_open_compl α t s h⟩,
end

lemma _root_.is_open.is_clopenable [topological_space α] [polish_space α] {s : set α}
  (hs : is_open s) : is_clopenable s :=
by simpa using hs.is_closed_compl.is_clopenable.compl

lemma is_clopenable.Union [t : topological_space α] [polish_space α] {s : ℕ → set α}
  (hs : ∀ n, is_clopenable (s n)) :
  is_clopenable (⋃ n, s n) :=
begin
  choose m mt m_polish m_closed m_open using hs,
  obtain ⟨t', t'm, -, t'_polish⟩ :
    ∃ (t' : topological_space α), (∀ (n : ℕ), t' ≤ m n) ∧ (t' ≤ t) ∧ @polish_space α t' :=
      exists_polish_space_forall_le m mt m_polish,
  have A : is_open[t'] (⋃ n, s n),
  { apply is_open_Union,
    assume n,
    apply t'm n,
    exact m_open n },
  obtain ⟨t'', t''_le, t''_polish, h1, h2⟩ :
    ∃ (t'' : topological_space α), t'' ≤ t' ∧ @polish_space α t''
      ∧ is_closed[t''] (⋃ n, s n) ∧ is_open[t''] (⋃ n, s n) :=
        @is_open.is_clopenable α t' t'_polish _ A,
  exact ⟨t'', t''_le.trans ((t'm 0).trans (mt 0)), t''_polish, h1, h2⟩,
end

end polish_space