/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.logic

universes u

namespace Mathlib

namespace nat

notation:1024 "ℕ" => Mathlib.nat

inductive less_than_or_equal (a : ℕ) : ℕ → Prop
where
| refl : less_than_or_equal a a
| step : ∀ {b : ℕ}, less_than_or_equal a b → less_than_or_equal a (Nat.succ b)

protected instance has_le : HasLessEq ℕ :=
  { LessEq := less_than_or_equal }

protected def le (n : ℕ) (m : ℕ) :=
  less_than_or_equal n m

protected def lt (n : ℕ) (m : ℕ) :=
  less_than_or_equal (Nat.succ n) m

protected instance has_lt : HasLess ℕ :=
  { Less := nat.lt }

def pred : ℕ → ℕ :=
  Nat.pred

protected def sub : ℕ → ℕ → ℕ :=
  Nat.sub

protected def mul : ℕ → ℕ → ℕ :=
  Nat.mul

protected instance has_sub : Sub ℕ :=
  { sub := Nat.sub }

protected instance has_mul : Mul ℕ :=
  { mul := Nat.mul }

-- defeq to the instance provided by comm_semiring

protected instance has_dvd : has_dvd ℕ :=
  has_dvd.mk fun (a b : ℕ) => ∃ (c : ℕ), b = a * c

protected instance decidable_eq : DecidableEq ℕ :=
  sorry

def repeat {α : Type u} (f : ℕ → α → α) : ℕ → α → α :=
  sorry

protected instance inhabited : Inhabited ℕ :=
  { default := 0 }

@[simp] theorem nat_zero_eq_zero : 0 = 0 :=
  rfl

/- properties of inequality -/

protected def le_refl (a : ℕ) : a ≤ a :=
  less_than_or_equal.refl

theorem le_succ (n : ℕ) : n ≤ Nat.succ n :=
  less_than_or_equal.step (nat.le_refl n)

theorem succ_le_succ {n : ℕ} {m : ℕ} : n ≤ m → Nat.succ n ≤ Nat.succ m :=
  fun (h : n ≤ m) =>
    less_than_or_equal._oldrec (nat.le_refl (Nat.succ n))
      (fun (a : ℕ) (b : less_than_or_equal n a) => less_than_or_equal.step) h

theorem zero_le (n : ℕ) : 0 ≤ n := sorry

theorem zero_lt_succ (n : ℕ) : 0 < Nat.succ n :=
  succ_le_succ (zero_le n)

def succ_pos (n : ℕ) : 0 < Nat.succ n :=
  zero_lt_succ

theorem not_succ_le_zero (n : ℕ) : Nat.succ n ≤ 0 → False := sorry

theorem not_lt_zero (a : ℕ) : ¬a < 0 :=
  not_succ_le_zero a

theorem pred_le_pred {n : ℕ} {m : ℕ} : n ≤ m → Nat.pred n ≤ Nat.pred m := sorry

theorem le_of_succ_le_succ {n : ℕ} {m : ℕ} : Nat.succ n ≤ Nat.succ m → n ≤ m :=
  pred_le_pred

protected instance decidable_le (a : ℕ) (b : ℕ) : Decidable (a ≤ b) :=
  sorry

protected instance decidable_lt (a : ℕ) (b : ℕ) : Decidable (a < b) :=
  nat.decidable_le (Nat.succ a) b

protected theorem eq_or_lt_of_le {a : ℕ} {b : ℕ} (h : a ≤ b) : a = b ∨ a < b :=
  less_than_or_equal.cases_on h (Or.inl rfl) fun (n : ℕ) (h : less_than_or_equal a n) => Or.inr (succ_le_succ h)

theorem lt_succ_of_le {a : ℕ} {b : ℕ} : a ≤ b → a < Nat.succ b :=
  succ_le_succ

@[simp] theorem succ_sub_succ_eq_sub (a : ℕ) (b : ℕ) : Nat.succ a - Nat.succ b = a - b :=
  nat.rec_on b ((fun (this : Nat.succ a - 1 = a - 0) => this) (Eq.refl (Nat.succ a - 1)))
    fun (b : ℕ) => congr_arg Nat.pred

theorem not_succ_le_self (n : ℕ) : ¬Nat.succ n ≤ n :=
  Nat.rec (not_succ_le_zero 0)
    (fun (a : ℕ) (b : ¬Nat.succ a ≤ a) (c : Nat.succ (Nat.succ a) ≤ Nat.succ a) => b (le_of_succ_le_succ c)) n

protected theorem lt_irrefl (n : ℕ) : ¬n < n :=
  not_succ_le_self n

protected theorem le_trans {n : ℕ} {m : ℕ} {k : ℕ} (h1 : n ≤ m) : m ≤ k → n ≤ k :=
  less_than_or_equal._oldrec h1 fun (p : ℕ) (h2 : less_than_or_equal m p) => less_than_or_equal.step

theorem pred_le (n : ℕ) : Nat.pred n ≤ n :=
  nat.cases_on n (idRhs (less_than_or_equal (Nat.pred 0) (Nat.pred 0)) less_than_or_equal.refl)
    fun (n : ℕ) =>
      idRhs (less_than_or_equal (Nat.pred (Nat.succ n)) (Nat.succ n)) (less_than_or_equal.step less_than_or_equal.refl)

theorem pred_lt {n : ℕ} : n ≠ 0 → Nat.pred n < n := sorry

theorem sub_le (a : ℕ) (b : ℕ) : a - b ≤ a :=
  nat.rec_on b (nat.le_refl (a - 0)) fun (b₁ : ℕ) => nat.le_trans (pred_le (a - b₁))

theorem sub_lt {a : ℕ} {b : ℕ} : 0 < a → 0 < b → a - b < a := sorry

protected theorem lt_of_lt_of_le {n : ℕ} {m : ℕ} {k : ℕ} : n < m → m ≤ k → n < k :=
  nat.le_trans

/- Basic nat.add lemmas -/

protected theorem zero_add (n : ℕ) : 0 + n = n := sorry

theorem succ_add (n : ℕ) (m : ℕ) : Nat.succ n + m = Nat.succ (n + m) := sorry

theorem add_succ (n : ℕ) (m : ℕ) : n + Nat.succ m = Nat.succ (n + m) :=
  rfl

protected theorem add_zero (n : ℕ) : n + 0 = n :=
  rfl

theorem add_one (n : ℕ) : n + 1 = Nat.succ n :=
  rfl

theorem succ_eq_add_one (n : ℕ) : Nat.succ n = n + 1 :=
  rfl

/- Basic lemmas for comparing numerals -/

protected theorem bit0_succ_eq (n : ℕ) : bit0 (Nat.succ n) = Nat.succ (Nat.succ (bit0 n)) :=
  (fun (this : Nat.succ (Nat.succ n + n) = Nat.succ (Nat.succ (n + n))) => this) (congr_arg Nat.succ (succ_add n n))

protected theorem zero_lt_bit0 {n : ℕ} : n ≠ 0 → 0 < bit0 n := sorry

protected theorem zero_lt_bit1 (n : ℕ) : 0 < bit1 n :=
  zero_lt_succ (bit0 n)

protected theorem bit0_ne_zero {n : ℕ} : n ≠ 0 → bit0 n ≠ 0 := sorry

protected theorem bit1_ne_zero (n : ℕ) : bit1 n ≠ 0 :=
  (fun (this : Nat.succ (n + n) ≠ 0) => this) fun (h : Nat.succ (n + n) = 0) => nat.no_confusion h


import limits tactic.linarith

open M1P1

-- The sequence 1/n tends to zero as n -> infinity.
theorem easy : is_limit (λ n, 1 / n) 0 :=
begin
  -- say ε is a positive real
  intros ε Hε,
  -- we need to find N such that n ≥ N → |1 / n| < ε.
  -- It's a standard fact there exists some integer M ≥ 0
  -- such that 1 / (M + 1) < ε...
  cases (exists_nat_one_div_lt Hε) with M HM,
  -- ...so let's set N = M + 1.
  let N := M + 1,
  use N,
  -- Now say n ≥ N.
  intros n Hn, change N ≤ n at Hn,
  -- We need to show |1/n| < ε (because 1/n = 1/n - 0)
  rw sub_zero, show abs ((1 : ℝ) / n) < ε,
  -- Because n ≥ N = M + 1 ≥ 1 > 0, we have n > 0
  have HM' : 0 < N := lt_of_lt_of_le zero_lt_one (by simp),
  have HM'' : (0 : ℝ) < N :=
    by rwa [←nat.cast_zero,nat.cast_lt],
    -- note to self -- Lean rewriting M + 1 as 1 + M
  have HNn : (N : ℝ) ≤ n := by rwa nat.cast_le,
  have Hn'' : 0 < (n : ℝ) := by linarith,
  -- so 1 / n > 0,
  have H2 : (1 : ℝ) / n > 0,
    exact one_div_pos_of_pos Hn'',
  -- and hence |1 / n| = 1 / n.
  rw abs_of_pos H2,
  -- We want to prove 1 / n < ε, but we know 1 / N < ε,
  -- so it suffices to prove 1 / n ≤ 1 / N
  suffices : (1 : ℝ) / n ≤ 1 / N,
    exact lt_of_le_of_lt this HM,
  -- This follows easily from the fact that N ≤ n
  refine div_le_div_of_le_left zero_le_one HM'' HNn,
end


/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yury Kudryashov, Sébastien Gouëzel
-/
import measure_theory.constructions.borel_space

/-!
# Stieltjes measures on the real line

Consider a function `f : ℝ → ℝ` which is monotone and right-continuous. Then one can define a
corrresponding measure, giving mass `f b - f a` to the interval `(a, b]`.

## Main definitions

* `stieltjes_function` is a structure containing a function from `ℝ → ℝ`, together with the
assertions that it is monotone and right-continuous. To `f : stieltjes_function`, one associates
a Borel measure `f.measure`.
* `f.left_lim x` is the limit of `f` to the left of `x`.
* `f.measure_Ioc` asserts that `f.measure (Ioc a b) = of_real (f b - f a)`
* `f.measure_Ioo` asserts that `f.measure (Ioo a b) = of_real (f.left_lim b - f a)`.
* `f.measure_Icc` and `f.measure_Ico` are analogous.
-/

noncomputable theory
open classical set filter
open ennreal (of_real)
open_locale big_operators ennreal nnreal topological_space

/-! ### Basic properties of Stieltjes functions -/

/-- Bundled monotone right-continuous real functions, used to construct Stieltjes measures. -/
structure stieltjes_function :=
(to_fun : ℝ → ℝ)
(mono' : monotone to_fun)
(right_continuous' : ∀ x, continuous_within_at to_fun (Ici x) x)

namespace stieltjes_function

instance : has_coe_to_fun stieltjes_function (λ _, ℝ → ℝ) := ⟨to_fun⟩

initialize_simps_projections stieltjes_function (to_fun → apply)

variable (f : stieltjes_function)

lemma mono : monotone f := f.mono'

lemma right_continuous (x : ℝ) : continuous_within_at f (Ici x) x := f.right_continuous' x

/-- The limit of a Stieltjes function to the left of `x` (it exists by monotonicity). The fact that
it is indeed a left limit is asserted in `tendsto_left_lim` -/
@[irreducible] def left_lim (x : ℝ) := Sup (f '' (Iio x))

lemma tendsto_left_lim (x : ℝ) : tendsto f (𝓝[Iio x] x) (𝓝 (f.left_lim x)) :=
by { rw left_lim, exact f.mono.tendsto_nhds_within_Iio x }

lemma left_lim_le {x y : ℝ} (h : x ≤ y) : f.left_lim x ≤ f y :=
begin
  apply le_of_tendsto (f.tendsto_left_lim x),
  filter_upwards [self_mem_nhds_within],
  assume z hz,
  exact (f.mono (le_of_lt hz)).trans (f.mono h)
end

lemma le_left_lim {x y : ℝ} (h : x < y) : f x ≤ f.left_lim y :=
begin
  apply ge_of_tendsto (f.tendsto_left_lim y),
  apply mem_nhds_within_Iio_iff_exists_Ioo_subset.2 ⟨x, h, _⟩,
  assume z hz,
  exact f.mono hz.1.le,
end

lemma left_lim_le_left_lim {x y : ℝ} (h : x ≤ y) : f.left_lim x ≤ f.left_lim y :=
begin
  rcases eq_or_lt_of_le h with rfl|hxy,
  { exact le_rfl },
  { exact (f.left_lim_le le_rfl).trans (f.le_left_lim hxy) }
end

/-- The identity of `ℝ` as a Stieltjes function, used to construct Lebesgue measure. -/
@[simps] protected def id : stieltjes_function :=
{ to_fun := id,
  mono' := λ x y, id,
  right_continuous' := λ x, continuous_within_at_id }

@[simp] lemma id_left_lim (x : ℝ) : stieltjes_function.id.left_lim x = x :=
tendsto_nhds_unique (stieltjes_function.id.tendsto_left_lim x) $
  (continuous_at_id).tendsto.mono_left nhds_within_le_nhds

instance : inhabited stieltjes_function := ⟨stieltjes_function.id⟩

/-! ### The outer measure associated to a Stieltjes function -/

/-- Length of an interval. This is the largest monotone function which correctly measures all
intervals. -/
def length (s : set ℝ) : ℝ≥0∞ := ⨅a b (h : s ⊆ Ioc a b), of_real (f b - f a)

@[simp] lemma length_empty : f.length ∅ = 0 :=
nonpos_iff_eq_zero.1 $ infi_le_of_le 0 $ infi_le_of_le 0 $ by simp

@[simp] lemma length_Ioc (a b : ℝ) :
  f.length (Ioc a b) = of_real (f b - f a) :=
begin
  refine le_antisymm (infi_le_of_le a $ binfi_le b (subset.refl _))
    (le_infi $ λ a', le_infi $ λ b', le_infi $ λ h, ennreal.coe_le_coe.2 _),
  cases le_or_lt b a with ab ab,
  { rw real.to_nnreal_of_nonpos (sub_nonpos.2 (f.mono ab)), apply zero_le, },
  cases (Ioc_subset_Ioc_iff ab).1 h with h₁ h₂,
  exact real.to_nnreal_le_to_nnreal (sub_le_sub (f.mono h₁) (f.mono h₂))
end

lemma length_mono {s₁ s₂ : set ℝ} (h : s₁ ⊆ s₂) :
  f.length s₁ ≤ f.length s₂ :=
infi_le_infi $ λ a, infi_le_infi $ λ b, infi_le_infi2 $ λ h', ⟨subset.trans h h', le_refl _⟩

open measure_theory

/-- The Stieltjes outer measure associated to a Stieltjes function. -/
protected def outer : outer_measure ℝ :=
outer_measure.of_function f.length f.length_empty

lemma outer_le_length (s : set ℝ) : f.outer s ≤ f.length s :=
outer_measure.of_function_le _

/-- If a compact interval `[a, b]` is covered by a union of open interval `(c i, d i)`, then
`f b - f a ≤ ∑ f (d i) - f (c i)`. This is an auxiliary technical statement to prove the same
statement for half-open intervals, the point of the current statement being that one can use
compactness to reduce it to a finite sum, and argue by induction on the size of the covering set. -/
lemma length_subadditive_Icc_Ioo {a b : ℝ} {c d : ℕ → ℝ}
  (ss : Icc a b ⊆ ⋃ i, Ioo (c i) (d i)) :
  of_real (f b - f a) ≤ ∑' i, of_real (f (d i) - f (c i)) :=
begin
  suffices : ∀ (s:finset ℕ) b
    (cv : Icc a b ⊆ ⋃ i ∈ (↑s:set ℕ), Ioo (c i) (d i)),
    (of_real (f b - f a) : ℝ≥0∞) ≤ ∑ i in s, of_real (f (d i) - f (c i)),
  { rcases is_compact_Icc.elim_finite_subcover_image (λ (i : ℕ) (_ : i ∈ univ),
      @is_open_Ioo _ _ _ _ (c i) (d i)) (by simpa using ss) with ⟨s, su, hf, hs⟩,
    have e : (⋃ i ∈ (↑hf.to_finset:set ℕ), Ioo (c i) (d i)) = (⋃ i ∈ s, Ioo (c i) (d i)),
      by simp only [ext_iff, exists_prop, finset.set_bUnion_coe, mem_Union, forall_const, iff_self,
                    finite.mem_to_finset],
    rw ennreal.tsum_eq_supr_sum,
    refine le_trans _ (le_supr _ hf.to_finset),
    exact this hf.to_finset _ (by simpa only [e]) },
  clear ss b,
  refine λ s, finset.strong_induction_on s (λ s IH b cv, _),
  cases le_total b a with ab ab,
  { rw ennreal.of_real_eq_zero.2 (sub_nonpos.2 (f.mono ab)), exact zero_le _, },
  have := cv ⟨ab, le_refl _⟩, simp at this,
  rcases this with ⟨i, is, cb, bd⟩,
  rw [← finset.insert_erase is] at cv ⊢,
  rw [finset.coe_insert, bUnion_insert] at cv,
  rw [finset.sum_insert (finset.not_mem_erase _ _)],
  refine le_trans _ (add_le_add_left (IH _ (finset.erase_ssubset is) (c i) _) _),
  { refine le_trans (ennreal.of_real_le_of_real _) ennreal.of_real_add_le,
    rw sub_add_sub_cancel,
    exact sub_le_sub_right (f.mono bd.le) _ },
  { rintro x ⟨h₁, h₂⟩,
    refine (cv ⟨h₁, le_trans h₂ (le_of_lt cb)⟩).resolve_left
      (mt and.left (not_lt_of_le h₂)) }
end

@[simp] lemma outer_Ioc (a b : ℝ) :
  f.outer (Ioc a b) = of_real (f b - f a) :=
begin
  /- It suffices to show that, if `(a, b]` is covered by sets `s i`, then `f b - f a` is bounded
  by `∑ f.length (s i) + ε`. The difficulty is that `f.length` is expressed in terms of half-open
  intervals, while we would like to have a compact interval covered by open intervals to use
  compactness and finite sums, as provided by `length_subadditive_Icc_Ioo`. The trick is to use the
  right-continuity of `f`. If `a'` is close enough to `a` on its right, then `[a', b]` is still
  covered by the sets `s i` and moreover `f b - f a'` is very close to `f b - f a` (up to `ε/2`).
  Also, by definition one can cover `s i` by a half-closed interval `(p i, q i]` with `f`-length
  very close to  that of `s i` (within a suitably small `ε' i`, say). If one moves `q i` very
  slightly to the right, then the `f`-length will change very little by right continuity, and we
  will get an open interval `(p i, q' i)` covering `s i` with `f (q' i) - f (p i)` within `ε' i`
  of the `f`-length of `s i`. -/
  refine le_antisymm (by { rw ← f.length_Ioc, apply outer_le_length })
    (le_binfi $ λ s hs, ennreal.le_of_forall_pos_le_add $ λ ε εpos h, _),
  let δ := ε / 2,
  have δpos : 0 < (δ : ℝ≥0∞), by simpa using εpos.ne',
  rcases ennreal.exists_pos_sum_of_encodable δpos.ne' ℕ with ⟨ε', ε'0, hε⟩,
  obtain ⟨a', ha', aa'⟩ : ∃ a', f a' - f a < δ ∧ a < a',
  { have A : continuous_within_at (λ r, f r - f a) (Ioi a) a,
    { refine continuous_within_at.sub _ continuous_within_at_const,
      exact (f.right_continuous a).mono Ioi_subset_Ici_self },
    have B : f a - f a < δ, by rwa [sub_self, nnreal.coe_pos, ← ennreal.coe_pos],
    exact (((tendsto_order.1 A).2 _ B).and self_mem_nhds_within).exists },
  have : ∀ i, ∃ p:ℝ×ℝ, s i ⊆ Ioo p.1 p.2 ∧
                        (of_real (f p.2 - f p.1) : ℝ≥0∞) < f.length (s i) + ε' i,
  { intro i,
    have := (ennreal.lt_add_right ((ennreal.le_tsum i).trans_lt h).ne
        (ennreal.coe_ne_zero.2 (ε'0 i).ne')),
    conv at this { to_lhs, rw length },
    simp only [infi_lt_iff, exists_prop] at this,
    rcases this with ⟨p, q', spq, hq'⟩,
    have : continuous_within_at (λ r, of_real (f r - f p)) (Ioi q') q',
    { apply ennreal.continuous_of_real.continuous_at.comp_continuous_within_at,
      refine continuous_within_at.sub _ continuous_within_at_const,
      exact (f.right_continuous q').mono Ioi_subset_Ici_self },
    rcases (((tendsto_order.1 this).2 _ hq').and self_mem_nhds_within).exists with ⟨q, hq, q'q⟩,
    exact ⟨⟨p, q⟩, spq.trans (Ioc_subset_Ioo_right q'q), hq⟩ },
  choose g hg using this,
  have I_subset : Icc a' b ⊆ ⋃ i, Ioo (g i).1 (g i).2 := calc
    Icc a' b ⊆ Ioc a b : λ x hx, ⟨aa'.trans_le hx.1, hx.2⟩
    ... ⊆ ⋃ i, s i : hs
    ... ⊆ ⋃ i, Ioo (g i).1 (g i).2 : Union_subset_Union (λ i, (hg i).1),
  calc of_real (f b - f a)
      = of_real ((f b - f a') + (f a' - f a)) : by rw sub_add_sub_cancel
  ... ≤ of_real (f b - f a') + of_real (f a' - f a) : ennreal.of_real_add_le
  ... ≤ (∑' i, of_real (f (g i).2 - f (g i).1)) + of_real δ :
    add_le_add (f.length_subadditive_Icc_Ioo I_subset) (ennreal.of_real_le_of_real ha'.le)
  ... ≤ (∑' i, (f.length (s i) + ε' i)) + δ :
    add_le_add (ennreal.tsum_le_tsum (λ i, (hg i).2.le))
      (by simp only [ennreal.of_real_coe_nnreal, le_rfl])
  ... = (∑' i, f.length (s i)) + (∑' i, ε' i) + δ : by rw [ennreal.tsum_add]
  ... ≤ (∑' i, f.length (s i)) + δ + δ : add_le_add (add_le_add le_rfl hε.le) le_rfl
  ... = ∑' (i : ℕ), f.length (s i) + ε : by simp [add_assoc, ennreal.add_halves]
end

lemma measurable_set_Ioi {c : ℝ} :
  f.outer.caratheodory.measurable_set' (Ioi c) :=
begin
  apply outer_measure.of_function_caratheodory (λ t, _),
  refine le_infi (λ a, le_infi (λ b, le_infi (λ h, _))),
  refine le_trans (add_le_add
    (f.length_mono $ inter_subset_inter_left _ h)
    (f.length_mono $ diff_subset_diff_left h)) _,
  cases le_total a c with hac hac; cases le_total b c with hbc hbc,
  { simp only [Ioc_inter_Ioi, f.length_Ioc, hac, sup_eq_max, hbc, le_refl, Ioc_eq_empty,
      max_eq_right, min_eq_left, Ioc_diff_Ioi, f.length_empty, zero_add, not_lt] },
  { simp only [hac, hbc, Ioc_inter_Ioi, Ioc_diff_Ioi, f.length_Ioc, min_eq_right,
      sup_eq_max, ←ennreal.of_real_add, f.mono hac, f.mono hbc, sub_nonneg, sub_add_sub_cancel,
      le_refl, max_eq_right] },
  { simp only [hbc, le_refl, Ioc_eq_empty, Ioc_inter_Ioi, min_eq_left, Ioc_diff_Ioi,
      f.length_empty, zero_add, or_true, le_sup_iff, f.length_Ioc, not_lt] },
  { simp only [hac, hbc, Ioc_inter_Ioi, Ioc_diff_Ioi, f.length_Ioc, min_eq_right,
      sup_eq_max, le_refl, Ioc_eq_empty, add_zero, max_eq_left, f.length_empty, not_lt] }
end

theorem outer_trim : f.outer.trim = f.outer :=
begin
  refine le_antisymm (λ s, _) (outer_measure.le_trim _),
  rw outer_measure.trim_eq_infi,
  refine le_infi (λ t, le_infi $ λ ht,
    ennreal.le_of_forall_pos_le_add $ λ ε ε0 h, _),
  rcases ennreal.exists_pos_sum_of_encodable
    (ennreal.coe_pos.2 ε0).ne' ℕ with ⟨ε', ε'0, hε⟩,
  refine le_trans _ (add_le_add_left (le_of_lt hε) _),
  rw ← ennreal.tsum_add,
  choose g hg using show
    ∀ i, ∃ s, t i ⊆ s ∧ measurable_set s ∧
      f.outer s ≤ f.length (t i) + of_real (ε' i),
  { intro i,
    have := (ennreal.lt_add_right ((ennreal.le_tsum i).trans_lt h).ne
        (ennreal.coe_pos.2 (ε'0 i)).ne'),
    conv at this {to_lhs, rw length},
    simp only [infi_lt_iff] at this,
    rcases this with ⟨a, b, h₁, h₂⟩,
    rw ← f.outer_Ioc at h₂,
    exact ⟨_, h₁, measurable_set_Ioc, le_of_lt $ by simpa using h₂⟩ },
  simp at hg,
  apply infi_le_of_le (Union g) _,
  apply infi_le_of_le (subset.trans ht $ Union_subset_Union (λ i, (hg i).1)) _,
  apply infi_le_of_le (measurable_set.Union (λ i, (hg i).2.1)) _,
  exact le_trans (f.outer.Union _) (ennreal.tsum_le_tsum $ λ i, (hg i).2.2)
end

lemma borel_le_measurable : borel ℝ ≤ f.outer.caratheodory :=
begin
  rw borel_eq_generate_from_Ioi,
  refine measurable_space.generate_from_le _,
  simp [f.measurable_set_Ioi] { contextual := tt }
end

/-! ### The measure associated to a Stieltjes function -/

/-- The measure associated to a Stieltjes function, giving mass `f b - f a` to the
interval `(a, b]`. -/
@[irreducible] protected def measure : measure ℝ :=
{ to_outer_measure := f.outer,
  m_Union := λ s hs, f.outer.Union_eq_of_caratheodory $
    λ i, f.borel_le_measurable _ (hs i),
  trimmed := f.outer_trim }

@[simp] lemma measure_Ioc (a b : ℝ) : f.measure (Ioc a b) = of_real (f b - f a) :=
by { rw stieltjes_function.measure, exact f.outer_Ioc a b }

@[simp] lemma measure_singleton (a : ℝ) : f.measure {a} = of_real (f a - f.left_lim a) :=
begin
  obtain ⟨u, u_mono, u_lt_a, u_lim⟩ : ∃ (u : ℕ → ℝ), strict_mono u ∧ (∀ (n : ℕ), u n < a)
    ∧ tendsto u at_top (𝓝 a) := exists_seq_strict_mono_tendsto a,
  have A : {a} = ⋂ n, Ioc (u n) a,
  { refine subset.antisymm (λ x hx, by simp [mem_singleton_iff.1 hx, u_lt_a]) (λ x hx, _),
    simp at hx,
    have : a ≤ x := le_of_tendsto' u_lim (λ n, (hx n).1.le),
    simp [le_antisymm this (hx 0).2] },
  have L1 : tendsto (λ n, f.measure (Ioc (u n) a)) at_top (𝓝 (f.measure {a})),
  { rw A,
    refine tendsto_measure_Inter (λ n, measurable_set_Ioc) (λ m n hmn, _) _,
    { exact Ioc_subset_Ioc (u_mono.monotone hmn) le_rfl },
    { exact ⟨0, by simpa only [measure_Ioc] using ennreal.of_real_ne_top⟩ } },
  have L2 : tendsto (λ n, f.measure (Ioc (u n) a)) at_top (𝓝 (of_real (f a - f.left_lim a))),
  { simp only [measure_Ioc],
    have : tendsto (λ n, f (u n)) at_top (𝓝 (f.left_lim a)),
    { apply (f.tendsto_left_lim a).comp,
      exact tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ u_lim
        (eventually_of_forall (λ n, u_lt_a n)) },
    exact ennreal.continuous_of_real.continuous_at.tendsto.comp (tendsto_const_nhds.sub this) },
  exact tendsto_nhds_unique L1 L2
end

@[simp] lemma measure_Icc (a b : ℝ) : f.measure (Icc a b) = of_real (f b - f.left_lim a) :=
begin
  rcases le_or_lt a b with hab|hab,
  { have A : disjoint {a} (Ioc a b), by simp,
    simp [← Icc_union_Ioc_eq_Icc le_rfl hab, -singleton_union, ← ennreal.of_real_add, f.left_lim_le,
      measure_union A (measurable_set_singleton a) measurable_set_Ioc, f.mono hab] },
  { simp only [hab, measure_empty, Icc_eq_empty, not_le],
    symmetry,
    simp [ennreal.of_real_eq_zero, f.le_left_lim hab] }
end

@[simp] lemma measure_Ioo {a b : ℝ} : f.measure (Ioo a b) = of_real (f.left_lim b - f a) :=
begin
  rcases le_or_lt b a with hab|hab,
  { simp only [hab, measure_empty, Ioo_eq_empty, not_lt],
    symmetry,
    simp [ennreal.of_real_eq_zero, f.left_lim_le hab] },
  { have A : disjoint (Ioo a b) {b}, by simp,
    have D : f b - f a = (f b - f.left_lim b) + (f.left_lim b - f a), by abel,
    have := f.measure_Ioc a b,
    simp only [←Ioo_union_Icc_eq_Ioc hab le_rfl, measure_singleton,
      measure_union A measurable_set_Ioo (measurable_set_singleton b), Icc_self] at this,
    rw [D, ennreal.of_real_add, add_comm] at this,
    { simpa only [ennreal.add_right_inj ennreal.of_real_ne_top] },
    { simp only [f.left_lim_le, sub_nonneg] },
    { simp only [f.le_left_lim hab, sub_nonneg] } },
end

@[simp]

end stieltjes_function


/-
This defines an operation fin_nth which gets the nth item on a list when the
index is guaranteed to reference a valid element.
-/
import galois.nat.simplify_le
import init.data.fin.ops

universe variable u

namespace list

/--
Return the element in the list at the given index.

This is a total version of nth.
-/
def fin_nth {α : Type u} : Π (l : list α), fin l.length →  α
| [] ⟨x, pr⟩ :=
begin
  simp [nat.lt_is_succ_le, nat.add_succ, nat.not_succ_le_zero] at pr,
  contradiction
end
| (h::r) ⟨0, pr⟩ := h
| (h::r) ⟨nat.succ i, p⟩ :=
  let q : i < length r :=
        begin
          simp [nat.succ_lt_succ_iff, nat.succ_add] at p,
          exact p,
        end in
  fin_nth r ⟨i,q⟩

structure found_member {α : Type u} (x : α) (xs : list α) : Type :=
  (idx : fin xs.length)
  (lookup_eq : fin_nth _ idx = x)

lemma no_member_nil {α : Type u} (H : fin (@nil α).length) : false :=
begin
  cases H,
  simp [length] at is_lt,
  simp [nat.lt_is_succ_le, nat.add_succ, nat.not_succ_le_zero] at is_lt,
  contradiction
end

namespace fin
-- This is now in the standard library
-- https://github.com/leanprover/lean/blob/master/library/init/data/fin/ops.lean#L13-L14
protected def succ {n : ℕ } : fin n → fin (nat.succ n)
| ⟨a, h⟩ := ⟨nat.succ a, nat.succ_lt_succ h⟩
end fin

end list


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import number_theory.zsqrtd.gaussian_int
/-!
# Sums of two squares

Proof of Fermat's theorem on the sum of two squares. Every prime congruent to 1 mod 4 is the sum
of two squares
-/

open gaussian_int principal_ideal_ring

namespace nat
namespace prime

/-- **Fermat's theorem on the sum of two squares**. Every prime congruent to 1 mod 4 is the sum
of two squares. -/
lemma sq_add_sq (p : ℕ) [hp : _root_.fact p.prime] (hp1 : p % 4 = 1) :
  ∃ a b : ℕ, a ^ 2 + b ^ 2 = p :=
begin
  apply sq_add_sq_of_nat_prime_of_not_irreducible p,
  rw [principal_ideal_ring.irreducible_iff_prime, prime_iff_mod_four_eq_three_of_nat_prime p, hp1],
  norm_num
end

end prime
end nat


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

-- import tactic -- imports all the Lean tactics
import Std.Tactic.Basic -- imports triv and exfalso

/-!

# Logic in Lean, example sheet 2 : `True` and `False`

We learn about the `True` and `False` propositions.

## Tactics you will need

To solve the levels on this sheet you will need to know all previous
tactics, plus the following two new ones. Check out their explanations
in the course book. Or just try them out and hover over them to see
if you can understand what's going on.

* `triv`
* `exfalso`

-/

-- Throughout this sheet, `P`, `Q` and `R` will denote propositions.

variable (P Q R : Prop)

example : True := by
  triv

example : True → True := by
  sorry

example : False → True := by
  intro h
  exfalso
  exact h

example : False → False := by
  sorry

example : (True → False) → False := by
  sorry

example : False → P := by
  sorry

example : True → False → True → False → True → False := by
  sorry

example : P → ((P → False) → False) := by
  sorry

example : (P → False) → P → Q := by
  sorry

example : (True → False) → P := by
  sorry


-- Notes 11/26/2019

-- false is not provable, except from a contradiction
-- if we reach a proof of false, our proposition must be false

-- false also implies anything
example : false → 0 = 1 := false.elim

example : ∀ (P : Prop), false → P := λ (p), λ (f), false.elim f

#check @false.elim

-- If we can show that P → false, then P must not be true
-- No proof could exist for P

axiom P : Prop

example : P → ¬P → false :=
begin
    assume hp,
    assume hnp,
    contradiction
end

example : P → ¬P → false :=
    λ (hp),
        λ (hnp),
            (hnp hp)

example : P → ¬ P → 0 = 1 :=
    λ (hp),
        λ (hnp),
            false.elim (hnp hp)

example : P → (P → ¬ P) → false :=
begin
    assume hp,
    assume pnp,
    apply pnp hp,
    exact hp,
end

axiom Q : Prop
axiom q : Q

example : P ∨ Q :=
begin
    apply or.intro_right, -- or.intro_right lets you construct a proof of P ∨ Q from Q
    exact q,
end

axiom excluded_middle : ∀ (P : Prop), P ∨ ¬P

example : P ∨ ¬P :=
begin
    exact (excluded_middle P),
end

-- or elimination : P ∨ Q → (P → R) → (Q → R) → R
-- if we have P or Q, and P implies R, and Q implies R, then R must be true!!

-- case analysis

axioms
    (R : Prop)
    (p : P)
    (pr : P → R)
    (qr : Q → R)

example : (P ∨ Q) → R :=
begin
    assume pq,
    apply or.elim pq pr qr,
end

example : (P ∨ Q) → R :=
    λ pq,
        match pq with
        | or.inl hp := pr hp
        | or.inr hq := qr hq
        end

example : (P ∨ Q) → R :=
begin
    assume pq,
    cases pq with hp hq,
    apply pr hp,
    apply qr hq,
end


import control.random

open io

/-! # Uniform generation -/

def random_num (n : ℕ) : io ℕ :=
io.rand 1 n

-- Given some seed, we generate a random number in `{1, ..., n}`.
#eval random_num 37 >>= print

def random_num_list' (n : ℕ) (m : ℕ) : list (io ℕ) :=
list.map (λ _, random_num n) (list.range m)

def print_list_io {α : Type*} [has_to_string α] : list (io α) → io (list α)
| [] := return []
| (x :: xs) := do
  x' ← x,
  xs' ← print_list_io xs,
  return (x' :: xs')

-- Generate a list of random numbers uniformly in `{1, ..., n}` of size `m`.
def random_num_list (n : ℕ) (m : ℕ) : io (list ℕ) :=
print_list_io $ random_num_list' n m

#eval random_num_list 37 100 >>= print

/-! # Generation given some distribution -/

def normalize_distrib' : list ℕ → list ℕ
| [] := []
| (x :: xs) := (list.sum (x :: xs)) :: normalize_distrib' xs

def normalize_distrib : list ℕ → list ℕ :=
list.reverse ∘ normalize_distrib' ∘ list.reverse

@[derive [decidable_pred]]
def list.placed (l : list ℕ) (n : ℕ) (i : ℕ) : Prop :=
if hi : i < l.length then n ≤ l.nth_le i hi else false

lemma lt_length_of_placed {l : list ℕ} {n : ℕ} {i : ℕ} (h : l.placed n i) :
  i < l.length :=
begin
  rw [list.placed] at h,
  split_ifs at h with hi hi,
  exacts [hi, false.elim h],
end

lemma exists_placed_iff {l : list ℕ} {n : ℕ} :
  (∃ i, l.placed n i) ↔ (∃ i, i < l.length ∧ l.placed n i) :=
⟨λ ⟨i, h⟩, ⟨i, lt_length_of_placed h, h⟩, λ ⟨i, _, h⟩, ⟨i, h⟩⟩

instance {l : list ℕ} {n : ℕ} : decidable (∃ i, l.placed n i) :=
decidable_of_iff' _ exists_placed_iff

def list.place (l : list ℕ) (n : ℕ) : ℕ :=
if hi : ∃ i, l.placed n i then @nat.find (l.placed n) infer_instance hi else l.length

def list.distribute (distrib : list ℕ) :
  list ℕ → list ℕ
| [] := []
| (x :: xs) := distrib.place x :: list.distribute xs

def random_num_list_distrib (m : ℕ) (distrib : list ℕ) : io (list ℕ) := do
  rnd ← random_num_list (list.sum distrib + 1) m,
  return ((normalize_distrib distrib).distribute rnd)

#eval random_num_list_distrib 100 [1, 1, 1, 1, 1, 1] >>= print

/-! # Historgram -/

def list.counts_occurence (l : list ℕ) : list ℕ :=
(list.range (l.foldr max 1 + 1)).map (λ n, l.count n)

def counts_occurence_io : io (list ℕ) → io (list ℕ) :=
functor.map list.counts_occurence

#eval counts_occurence_io (random_num_list_distrib 100 [1, 0, 0, 9, 8, 1]) >>= print


-- Teorema_de_Cantor.lean
-- Teorema de Cantor.
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 6-mayo-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar el teorema de Cantor:
--    ∀ f : α → set α, ¬ surjective f
-- ----------------------------------------------------------------------

import data.set.basic
open function

variables {α : Type}

-- 1ª demostración
-- ===============

example : ∀ f : α → set α, ¬ surjective f :=
begin
  intros f hf,
  let S := {i | i ∉ f i},
  unfold surjective at hf,
  cases hf S with j hj,
  by_cases j ∈ S,
  { dsimp at h,
    apply h,
    rw hj,
    exact h, },
  { apply h,
    rw ← hj at h,
    exact h, },
end

-- 2ª demostración
-- ===============

example : ∀ f : α → set α, ¬ surjective f :=
begin
  intros f hf,
  let S := {i | i ∉ f i},
  cases hf S with j hj,
  by_cases j ∈ S,
  { apply  h,
    rwa hj, },
  { apply h,
    rwa ← hj at h, },
end

-- 3ª demostración
-- ===============

example : ∀ f : α → set α, ¬ surjective f :=
begin
  intros f hf,
  let S := {i | i ∉ f i},
  cases hf S with j hj,
  have h : (j ∈ S) = (j ∉ S), from
    calc  (j ∈ S)
        = (j ∉ f j) : set.mem_set_of_eq
    ... = (j ∉ S)   : congr_arg not (congr_arg (has_mem.mem j) hj),
  exact false_of_a_eq_not_a h,
end

-- 4ª demostración
-- ===============

example : ∀ f : α → set α, ¬ surjective f :=
begin
  intros f hf,
  let S := {i | i ∉ f i},
  cases hf S with j hj,
  have h : (j ∈ S) = (j ∉ S),
  { dsimp,
    exact congr_arg not (congr_arg (has_mem.mem j) hj), },
  { exact false_of_a_eq_not_a (congr_arg not (congr_arg not h)), },
end

-- 5ª demostración
-- ===============

example : ∀ f : α → set α, ¬ surjective f :=
cantor_surjective


/-
Copyright (c) 2021 Martin Zinkevich. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Martin Zinkevich, Rémy Degenne
-/
import logic.encodable.lattice
import measure_theory.measurable_space_def

/-!
# Induction principles for measurable sets, related to π-systems and λ-systems.

## Main statements

* The main theorem of this file is Dynkin's π-λ theorem, which appears
  here as an induction principle `induction_on_inter`. Suppose `s` is a
  collection of subsets of `α` such that the intersection of two members
  of `s` belongs to `s` whenever it is nonempty. Let `m` be the σ-algebra
  generated by `s`. In order to check that a predicate `C` holds on every
  member of `m`, it suffices to check that `C` holds on the members of `s` and
  that `C` is preserved by complementation and *disjoint* countable
  unions.

* The proof of this theorem relies on the notion of `is_pi_system`, i.e., a collection of sets
  which is closed under binary non-empty intersections. Note that this is a small variation around
  the usual notion in the literature, which often requires that a π-system is non-empty, and closed
  also under disjoint intersections. This variation turns out to be convenient for the
  formalization.

* The proof of Dynkin's π-λ theorem also requires the notion of `dynkin_system`, i.e., a collection
  of sets which contains the empty set, is closed under complementation and under countable union
  of pairwise disjoint sets. The disjointness condition is the only difference with `σ`-algebras.

* `generate_pi_system g` gives the minimal π-system containing `g`.
  This can be considered a Galois insertion into both measurable spaces and sets.

* `generate_from_generate_pi_system_eq` proves that if you start from a collection of sets `g`,
  take the generated π-system, and then the generated σ-algebra, you get the same result as
  the σ-algebra generated from `g`. This is useful because there are connections between
  independent sets that are π-systems and the generated independent spaces.

* `mem_generate_pi_system_Union_elim` and `mem_generate_pi_system_Union_elim'` show that any
  element of the π-system generated from the union of a set of π-systems can be
  represented as the intersection of a finite number of elements from these sets.

* `pi_Union_Inter` defines a new π-system from a family of π-systems `π : ι → set (set α)` and a
  set of finsets `S : set (finset α)`. `pi_Union_Inter π S` is the set of sets that can be written
  as `⋂ x ∈ t, f x` for some `t ∈ S` and sets `f x ∈ π x`. If `S` is union-closed, then it is a
  π-system. The π-systems used to prove Kolmogorov's 0-1 law will be defined using this mechanism
  (TODO).

## Implementation details

* `is_pi_system` is a predicate, not a type. Thus, we don't explicitly define the galois
  insertion, nor do we define a complete lattice. In theory, we could define a complete
  lattice and galois insertion on the subtype corresponding to `is_pi_system`.
-/

open measurable_space set
open_locale classical measure_theory

/-- A π-system is a collection of subsets of `α` that is closed under binary intersection of
  non-disjoint sets. Usually it is also required that the collection is nonempty, but we don't do
  that here. -/
def is_pi_system {α} (C : set (set α)) : Prop :=
∀ s t ∈ C, (s ∩ t : set α).nonempty → s ∩ t ∈ C

namespace measurable_space

lemma is_pi_system_measurable_set {α:Type*} [measurable_space α] :
  is_pi_system {s : set α | measurable_set s} :=
λ s hs t ht _, hs.inter ht

end measurable_space

lemma is_pi_system.singleton {α} (S : set α) : is_pi_system ({S} : set (set α)) :=
begin
  intros s h_s t h_t h_ne,
  rw [set.mem_singleton_iff.1 h_s, set.mem_singleton_iff.1 h_t, set.inter_self,
      set.mem_singleton_iff],
end

lemma is_pi_system.insert_empty {α} {S : set (set α)} (h_pi : is_pi_system S) :
  is_pi_system (insert ∅ S) :=
begin
  intros s hs t ht hst,
  cases hs,
  { simp [hs], },
  { cases ht,
    { simp [ht], },
    { exact set.mem_insert_of_mem _ (h_pi s hs t ht hst), }, },
end

lemma is_pi_system.insert_univ {α} {S : set (set α)} (h_pi : is_pi_system S) :
  is_pi_system (insert set.univ S) :=
begin
  intros s hs t ht hst,
  cases hs,
  { cases ht; simp [hs, ht], },
  { cases ht,
    { simp [hs, ht], },
    { exact set.mem_insert_of_mem _ (h_pi s hs t ht hst), }, },
end

section order

variables {α : Type*} {ι ι' : Sort*} [linear_order α]

lemma is_pi_system_image_Iio (s : set α) : is_pi_system (Iio '' s) :=
begin
  rintro _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩ -,
  exact ⟨a ⊓ b, inf_ind a b ha hb, Iio_inter_Iio.symm⟩
end

lemma is_pi_system_Iio : is_pi_system (range Iio : set (set α)) :=
@image_univ α _ Iio ▸ is_pi_system_image_Iio univ

lemma is_pi_system_image_Ioi (s : set α) : is_pi_system (Ioi '' s) :=
@is_pi_system_image_Iio αᵒᵈ _ s

lemma is_pi_system_Ioi : is_pi_system (range Ioi : set (set α)) :=
@image_univ α _ Ioi ▸ is_pi_system_image_Ioi univ

lemma is_pi_system_Ixx_mem {Ixx : α → α → set α} {p : α → α → Prop}
  (Hne : ∀ {a b}, (Ixx a b).nonempty → p a b)
  (Hi : ∀ {a₁ b₁ a₂ b₂}, Ixx a₁ b₁ ∩ Ixx a₂ b₂ = Ixx (max a₁ a₂) (min b₁ b₂)) (s t : set α) :
  is_pi_system {S | ∃ (l ∈ s) (u ∈ t) (hlu : p l u), Ixx l u = S} :=
begin
  rintro _ ⟨l₁, hls₁, u₁, hut₁, hlu₁, rfl⟩ _ ⟨l₂, hls₂, u₂, hut₂, hlu₂, rfl⟩,
  simp only [Hi, ← sup_eq_max, ← inf_eq_min],
  exact λ H, ⟨l₁ ⊔ l₂, sup_ind l₁ l₂ hls₁ hls₂, u₁ ⊓ u₂, inf_ind u₁ u₂ hut₁ hut₂, Hne H, rfl⟩
end

lemma is_pi_system_Ixx {Ixx : α → α → set α} {p : α → α → Prop}
  (Hne : ∀ {a b}, (Ixx a b).nonempty → p a b)
  (Hi : ∀ {a₁ b₁ a₂ b₂}, Ixx a₁ b₁ ∩ Ixx a₂ b₂ = Ixx (max a₁ a₂) (min b₁ b₂))
  (f : ι → α) (g : ι' → α) :
  @is_pi_system α ({S | ∃ i j (h : p (f i) (g j)), Ixx (f i) (g j) = S}) :=
by simpa only [exists_range_iff] using is_pi_system_Ixx_mem @Hne @Hi (range f) (range g)

lemma is_pi_system_Ioo_mem (s t : set α) :
  is_pi_system {S | ∃ (l ∈ s) (u ∈ t) (h : l < u), Ioo l u = S} :=
is_pi_system_Ixx_mem (λ a b ⟨x, hax, hxb⟩, hax.trans hxb) (λ _ _ _ _, Ioo_inter_Ioo) s t

lemma is_pi_system_Ioo (f : ι → α) (g : ι' → α) :
  @is_pi_system α {S | ∃ l u (h : f l < g u), Ioo (f l) (g u) = S} :=
is_pi_system_Ixx (λ a b ⟨x, hax, hxb⟩, hax.trans hxb) (λ _ _ _ _, Ioo_inter_Ioo) f g

lemma is_pi_system_Ioc_mem (s t : set α) :
  is_pi_system {S | ∃ (l ∈ s) (u ∈ t) (h : l < u), Ioc l u = S} :=
is_pi_system_Ixx_mem (λ a b ⟨x, hax, hxb⟩, hax.trans_le hxb) (λ _ _ _ _, Ioc_inter_Ioc) s t

lemma is_pi_system_Ioc (f : ι → α) (g : ι' → α) :
  @is_pi_system α {S | ∃ i j (h : f i < g j), Ioc (f i) (g j) = S} :=
is_pi_system_Ixx (λ a b ⟨x, hax, hxb⟩, hax.trans_le hxb) (λ _ _ _ _, Ioc_inter_Ioc) f g

lemma is_pi_system_Ico_mem (s t : set α) :
  is_pi_system {S | ∃ (l ∈ s) (u ∈ t) (h : l < u), Ico l u = S} :=
is_pi_system_Ixx_mem (λ a b ⟨x, hax, hxb⟩, hax.trans_lt hxb) (λ _ _ _ _, Ico_inter_Ico) s t

lemma is_pi_system_Ico (f : ι → α) (g : ι' → α) :
  @is_pi_system α {S | ∃ i j (h : f i < g j), Ico (f i) (g j) = S} :=
is_pi_system_Ixx (λ a b ⟨x, hax, hxb⟩, hax.trans_lt hxb) (λ _ _ _ _, Ico_inter_Ico) f g

lemma is_pi_system_Icc_mem (s t : set α) :
  is_pi_system {S | ∃ (l ∈ s) (u ∈ t) (h : l ≤ u), Icc l u = S} :=
is_pi_system_Ixx_mem (λ a b, nonempty_Icc.1) (λ _ _ _ _, Icc_inter_Icc) s t

lemma is_pi_system_Icc (f : ι → α) (g : ι' → α) :
  @is_pi_system α {S | ∃ i j (h : f i ≤ g j), Icc (f i) (g j) = S} :=
is_pi_system_Ixx (λ a b, nonempty_Icc.1) (λ _ _ _ _, Icc_inter_Icc) f g

end order

/-- Given a collection `S` of subsets of `α`, then `generate_pi_system S` is the smallest
π-system containing `S`. -/
inductive generate_pi_system {α} (S : set (set α)) : set (set α)
| base {s : set α} (h_s : s ∈ S) : generate_pi_system s
| inter {s t : set α} (h_s : generate_pi_system s) (h_t : generate_pi_system t)
  (h_nonempty : (s ∩ t).nonempty) : generate_pi_system (s ∩ t)

lemma is_pi_system_generate_pi_system {α} (S : set (set α)) :
  is_pi_system (generate_pi_system S) :=
λ s h_s t h_t h_nonempty, generate_pi_system.inter h_s h_t h_nonempty

lemma subset_generate_pi_system_self {α} (S : set (set α)) : S ⊆ generate_pi_system S :=
λ s, generate_pi_system.base

lemma generate_pi_system_subset_self {α} {S : set (set α)} (h_S : is_pi_system S) :
  generate_pi_system S ⊆ S :=
begin
  intros x h,
  induction h with s h_s s u h_gen_s h_gen_u h_nonempty h_s h_u,
  { exact h_s, },
  { exact h_S _ h_s _ h_u h_nonempty, },
end

lemma generate_pi_system_eq {α} {S : set (set α)} (h_pi : is_pi_system S) :
  generate_pi_system S = S :=
set.subset.antisymm (generate_pi_system_subset_self h_pi) (subset_generate_pi_system_self S)

lemma generate_pi_system_mono {α} {S T : set (set α)} (hST : S ⊆ T) :
  generate_pi_system S ⊆ generate_pi_system T :=
begin
  intros t ht,
  induction ht with s h_s s u h_gen_s h_gen_u h_nonempty h_s h_u,
  { exact generate_pi_system.base (set.mem_of_subset_of_mem hST h_s),},
  { exact is_pi_system_generate_pi_system T _ h_s _ h_u h_nonempty, },
end

lemma generate_pi_system_measurable_set {α} [M : measurable_space α] {S : set (set α)}
  (h_meas_S : ∀ s ∈ S, measurable_set s) (t : set α)
  (h_in_pi : t ∈ generate_pi_system S) : measurable_set t :=
begin
  induction h_in_pi with s h_s s u h_gen_s h_gen_u h_nonempty h_s h_u,
  { apply h_meas_S _ h_s, },
  { apply measurable_set.inter h_s h_u, },
end

lemma generate_from_measurable_set_of_generate_pi_system {α} {g : set (set α)} (t : set α)
  (ht : t ∈ generate_pi_system g) :
  measurable_set[generate_from g] t :=
@generate_pi_system_measurable_set α (generate_from g) g
  (λ s h_s_in_g, measurable_set_generate_from h_s_in_g) t ht

lemma generate_from_generate_pi_system_eq {α} {g : set (set α)} :
  generate_from (generate_pi_system g) = generate_from g :=
begin
  apply le_antisymm; apply generate_from_le,
  { exact λ t h_t, generate_from_measurable_set_of_generate_pi_system t h_t, },
  { exact λ t h_t, measurable_set_generate_from (generate_pi_system.base h_t), },
end

/- Every element of the π-system generated by the union of a family of π-systems
is a finite intersection of elements from the π-systems.
For an indexed union version, see `mem_generate_pi_system_Union_elim'`. -/
lemma mem_generate_pi_system_Union_elim {α β} {g : β → set (set α)}
  (h_pi : ∀ b, is_pi_system (g b)) (t : set α) (h_t : t ∈ generate_pi_system (⋃ b, g b)) :
  ∃ (T : finset β) (f : β → set α), (t = ⋂ b ∈ T, f b) ∧ (∀ b ∈ T, f b ∈ g b) :=
begin
  induction h_t with s h_s s t' h_gen_s h_gen_t' h_nonempty h_s h_t',
  { rcases h_s with ⟨t', ⟨⟨b, rfl⟩, h_s_in_t'⟩⟩,
    refine ⟨{b}, (λ _, s), _⟩,
    simpa using h_s_in_t', },
  { rcases h_t' with ⟨T_t', ⟨f_t', ⟨rfl, h_t'⟩⟩⟩,
    rcases h_s with ⟨T_s, ⟨f_s, ⟨rfl, h_s⟩ ⟩ ⟩,
    use [(T_s ∪ T_t'), (λ (b:β),
      if (b ∈ T_s) then (if (b ∈ T_t') then (f_s b ∩ (f_t' b)) else (f_s b))
      else (if (b ∈ T_t') then (f_t' b) else (∅ : set α)))],
    split,
    { ext a,
      simp_rw [set.mem_inter_iff, set.mem_Inter, finset.mem_union, or_imp_distrib],
      rw ← forall_and_distrib,
      split; intros h1 b; by_cases hbs : b ∈ T_s; by_cases hbt : b ∈ T_t'; specialize h1 b;
        simp only [hbs, hbt, if_true, if_false, true_implies_iff, and_self, false_implies_iff,
          and_true, true_and] at h1 ⊢,
      all_goals { exact h1, }, },
    intros b h_b,
    split_ifs with hbs hbt hbt,
    { refine h_pi b (f_s b) (h_s b hbs) (f_t' b) (h_t' b hbt) (set.nonempty.mono _ h_nonempty),
      exact set.inter_subset_inter (set.bInter_subset_of_mem hbs) (set.bInter_subset_of_mem hbt), },
    { exact h_s b hbs, },
    { exact h_t' b hbt, },
    { rw finset.mem_union at h_b,
      apply false.elim (h_b.elim hbs hbt), }, },
end

/- Every element of the π-system generated by an indexed union of a family of π-systems
is a finite intersection of elements from the π-systems.
For a total union version, see `mem_generate_pi_system_Union_elim`. -/
lemma mem_generate_pi_system_Union_elim' {α β} {g : β → set (set α)} {s : set β}
  (h_pi : ∀ b ∈ s, is_pi_system (g b)) (t : set α) (h_t : t ∈ generate_pi_system (⋃ b ∈ s, g b)) :
  ∃ (T : finset β) (f : β → set α), (↑T ⊆ s) ∧ (t = ⋂ b ∈ T, f b) ∧ (∀ b ∈ T, f b ∈ g b) :=
begin
  have : t ∈ generate_pi_system (⋃ (b : subtype s), (g ∘ subtype.val) b),
  { suffices h1 : (⋃ (b : subtype s), (g ∘ subtype.val) b) = (⋃ b ∈ s, g b), by rwa h1,
    ext x,
    simp only [exists_prop, set.mem_Union, function.comp_app, subtype.exists, subtype.coe_mk],
    refl },
  rcases @mem_generate_pi_system_Union_elim α (subtype s) (g ∘ subtype.val)
    (λ b, h_pi b.val b.property) t this with ⟨T, ⟨f, ⟨rfl, h_t'⟩⟩⟩,
  refine ⟨T.image subtype.val, function.extend subtype.val f (λ b : β, (∅ : set α)), by simp, _, _⟩,
  { ext a, split;
    { simp only [set.mem_Inter, subtype.forall, finset.set_bInter_finset_image],
      intros h1 b h_b h_b_in_T,
      have h2 := h1 b h_b h_b_in_T,
      revert h2,
      rw function.extend_apply subtype.val_injective,
      apply id } },
  { intros b h_b,
    simp_rw [finset.mem_image, exists_prop, subtype.exists,
             exists_and_distrib_right, exists_eq_right] at h_b,
    cases h_b,
    have h_b_alt : b = (subtype.mk b h_b_w).val := rfl,
    rw [h_b_alt, function.extend_apply subtype.val_injective],
    apply h_t',
    apply h_b_h },
end

section Union_Inter

/-! ### π-system generated by finite intersections of sets of a π-system family -/

/-- From a set of finsets `S : set (finset ι)` and a family of sets of sets `π : ι → set (set α)`,
define the set of sets that can be written as `⋂ x ∈ t, f x` for some `t ∈ S` and sets `f x ∈ π x`.

If `S` is union-closed and `π` is a family of π-systems, then it is a π-system.
The π-systems used to prove Kolmogorov's 0-1 law are of that form. -/
def pi_Union_Inter {α ι} (π : ι → set (set α)) (S : set (finset ι)) : set (set α) :=
{s : set α | ∃ (t : finset ι) (htS : t ∈ S) (f : ι → set α) (hf : ∀ x, x ∈ t → f x ∈ π x),
  s = ⋂ x ∈ t, f x}

/-- If `S` is union-closed and `π` is a family of π-systems, then `pi_Union_Inter π S` is a
π-system. -/
lemma is_pi_system_pi_Union_Inter {α ι} (π : ι → set (set α))
  (hpi : ∀ x, is_pi_system (π x)) (S : set (finset ι)) (h_sup : sup_closed S) :
  is_pi_system (pi_Union_Inter π S) :=
begin
  rintros t1 ⟨p1, hp1S, f1, hf1m, ht1_eq⟩ t2 ⟨p2, hp2S, f2, hf2m, ht2_eq⟩ h_nonempty,
  simp_rw [pi_Union_Inter, set.mem_set_of_eq],
  let g := λ n, (ite (n ∈ p1) (f1 n) set.univ) ∩ (ite (n ∈ p2) (f2 n) set.univ),
  use [p1 ∪ p2, h_sup p1 p2 hp1S hp2S, g],
  have h_inter_eq : t1 ∩ t2 = ⋂ i ∈ p1 ∪ p2, g i,
  { rw [ht1_eq, ht2_eq],
    simp_rw [← set.inf_eq_inter, g],
    ext1 x,
    simp only [inf_eq_inter, mem_inter_eq, mem_Inter, finset.mem_union],
    refine ⟨λ h i hi_mem_union, _, λ h, ⟨λ i hi1, _, λ i hi2, _⟩⟩,
    { split_ifs,
      exacts [⟨h.1 i h_1, h.2 i h_2⟩, ⟨h.1 i h_1, set.mem_univ _⟩,
        ⟨set.mem_univ _, h.2 i h_2⟩, ⟨set.mem_univ _, set.mem_univ _⟩], },
    { specialize h i (or.inl hi1),
      rw if_pos hi1 at h,
      exact h.1, },
    { specialize h i (or.inr hi2),
      rw if_pos hi2 at h,
      exact h.2, }, },
  refine ⟨λ n hn, _, h_inter_eq⟩,
  simp_rw g,
  split_ifs with hn1 hn2,
  { refine hpi n (f1 n) (hf1m n hn1) (f2 n) (hf2m n hn2) (set.ne_empty_iff_nonempty.mp (λ h, _)),
    rw h_inter_eq at h_nonempty,
    suffices h_empty : (⋂ i ∈ p1 ∪ p2, g i) = ∅,
      from (set.not_nonempty_iff_eq_empty.mpr h_empty) h_nonempty,
    refine le_antisymm (set.Inter_subset_of_subset n _) (set.empty_subset _),
    refine set.Inter_subset_of_subset hn _,
    simp_rw [g, if_pos hn1, if_pos hn2],
    exact h.subset, },
  { simp [hf1m n hn1], },
  { simp [hf2m n h], },
  { exact absurd hn (by simp [hn1, h]), },
end

lemma pi_Union_Inter_mono_left {α ι} {π π' : ι → set (set α)} (h_le : ∀ i, π i ⊆ π' i)
  (S : set (finset ι)) :
  pi_Union_Inter π S ⊆ pi_Union_Inter π' S :=
begin
  rintros s ⟨t, ht_mem, ft, hft_mem_pi, rfl⟩,
  exact ⟨t, ht_mem, ft, λ x hxt, h_le x (hft_mem_pi x hxt), rfl⟩,
end

lemma generate_from_pi_Union_Inter_le {α ι} {m : measurable_space α}
  (π : ι → set (set α)) (h : ∀ n, generate_from (π n) ≤ m) (S : set (finset ι)) :
  generate_from (pi_Union_Inter π S) ≤ m :=
begin
  refine generate_from_le _,
  rintros t ⟨ht_p, ht_p_mem, ft, hft_mem_pi, rfl⟩,
  refine finset.measurable_set_bInter _ (λ x hx_mem, (h x) _ _),
  exact measurable_set_generate_from (hft_mem_pi x hx_mem),
end

lemma subset_pi_Union_Inter {α ι} {π : ι → set (set α)} {S : set (finset ι)}
  (h_univ : ∀ i, set.univ ∈ π i) {i : ι} {s : finset ι} (hsS : s ∈ S) (his : i ∈ s) :
  π i ⊆ pi_Union_Inter π S :=
begin
  refine λ t ht_pii, ⟨s, hsS, (λ j, ite (j = i) t set.univ), ⟨λ m h_pm, _, _⟩⟩,
  { split_ifs,
    { rwa h, },
    { exact h_univ m, }, },
  { ext1 x,
    simp_rw set.mem_Inter,
    split; intro hx,
    { intros j h_p_j,
      split_ifs,
      { exact hx, },
      { exact set.mem_univ _, }, },
    { simpa using hx i his, }, },
end

lemma mem_pi_Union_Inter_of_measurable_set {α ι} (m : ι → measurable_space α)
  {S : set (finset ι)} {i : ι} {t : finset ι} (htS : t ∈ S) (hit : i ∈ t) (s : set α)
  (hs : measurable_set[m i] s) :
  s ∈ pi_Union_Inter (λ n, {s | measurable_set[m n] s}) S :=
subset_pi_Union_Inter (λ i, measurable_set.univ) htS hit hs

lemma le_generate_from_pi_Union_Inter {α ι} {π : ι → set (set α)}
  (S : set (finset ι)) (h_univ : ∀ n, set.univ ∈ π n) {x : ι}
  {t : finset ι} (htS : t ∈ S) (hxt : x ∈ t) :
  generate_from (π x) ≤ generate_from (pi_Union_Inter π S) :=
generate_from_mono (subset_pi_Union_Inter h_univ htS hxt)

lemma measurable_set_supr_of_mem_pi_Union_Inter {α ι} (m : ι → measurable_space α)
  (S : set (finset ι)) (t : set α) (ht : t ∈ pi_Union_Inter (λ n, {s | measurable_set[m n] s}) S) :
  measurable_set[⨆ i (hi : ∃ s ∈ S, i ∈ s), m i] t :=
begin
  rcases ht with ⟨pt, hpt, ft, ht_m, rfl⟩,
  refine pt.measurable_set_bInter (λ i hi, _),
  suffices h_le : m i ≤ (⨆ i (hi : ∃ s ∈ S, i ∈ s), m i), from h_le (ft i) (ht_m i hi),
  have hi' : ∃ s ∈ S, i ∈ s, from ⟨pt, hpt, hi⟩,
  exact le_supr₂ i hi',
end

lemma generate_from_pi_Union_Inter_measurable_space {α ι} (m : ι → measurable_space α)
  (S : set (finset ι)) :
  generate_from (pi_Union_Inter (λ n, {s | measurable_set[m n] s}) S)
    = ⨆ i (hi : ∃ p ∈ S, i ∈ p), m i :=
begin
  refine le_antisymm _ _,
  { rw ← @generate_from_measurable_set α (⨆ i (hi : ∃ p ∈ S, i ∈ p), m i),
    exact generate_from_mono (measurable_set_supr_of_mem_pi_Union_Inter m S), },
  { refine supr₂_le (λ i hi, _),
    rcases hi with ⟨p, hpS, hpi⟩,
    rw ← @generate_from_measurable_set α (m i),
    exact generate_from_mono (mem_pi_Union_Inter_of_measurable_set m hpS hpi), },
end

end Union_Inter

namespace measurable_space
variable {α : Type*}

/-! ## Dynkin systems and Π-λ theorem -/

/-- A Dynkin system is a collection of subsets of a type `α` that contains the empty set,
  is closed under complementation and under countable union of pairwise disjoint sets.
  The disjointness condition is the only difference with `σ`-algebras.

  The main purpose of Dynkin systems is to provide a powerful induction rule for σ-algebras
  generated by a collection of sets which is stable under intersection.

  A Dynkin system is also known as a "λ-system" or a "d-system".
-/
structure dynkin_system (α : Type*) :=
(has : set α → Prop)
(has_empty : has ∅)
(has_compl : ∀ {a}, has a → has aᶜ)
(has_Union_nat : ∀ {f : ℕ → set α}, pairwise (disjoint on f) → (∀ i, has (f i)) → has (⋃ i, f i))

namespace dynkin_system

@[ext] lemma ext : ∀ {d₁ d₂ : dynkin_system α}, (∀ s : set α, d₁.has s ↔ d₂.has s) → d₁ = d₂
| ⟨s₁, _, _, _⟩ ⟨s₂, _, _, _⟩ h := have s₁ = s₂, from funext $ assume x, propext $ h x,
  by subst this

variable (d : dynkin_system α)

lemma has_compl_iff {a} : d.has aᶜ ↔ d.has a :=
⟨λ h, by simpa using d.has_compl h, λ h, d.has_compl h⟩

lemma has_univ : d.has univ :=
by simpa using d.has_compl d.has_empty

theorem has_Union {β} [encodable β] {f : β → set α}
  (hd : pairwise (disjoint on f)) (h : ∀ i, d.has (f i)) : d.has (⋃ i, f i) :=
by { rw ← encodable.Union_decode₂, exact
  d.has_Union_nat (encodable.Union_decode₂_disjoint_on hd)
    (λ n, encodable.Union_decode₂_cases d.has_empty h) }

theorem has_union {s₁ s₂ : set α}
  (h₁ : d.has s₁) (h₂ : d.has s₂) (h : s₁ ∩ s₂ ⊆ ∅) : d.has (s₁ ∪ s₂) :=
by { rw union_eq_Union, exact
  d.has_Union (pairwise_disjoint_on_bool.2 h) (bool.forall_bool.2 ⟨h₂, h₁⟩) }

lemma has_diff {s₁ s₂ : set α} (h₁ : d.has s₁) (h₂ : d.has s₂) (h : s₂ ⊆ s₁) : d.has (s₁ \ s₂) :=
begin
  apply d.has_compl_iff.1,
  simp [diff_eq, compl_inter],
  exact d.has_union (d.has_compl h₁) h₂ (λ x ⟨h₁, h₂⟩, h₁ (h h₂)),
end

instance : has_le (dynkin_system α) :=
{ le          := λ m₁ m₂, m₁.has ≤ m₂.has }

lemma le_def {α} {a b : dynkin_system α} : a ≤ b ↔ a.has ≤ b.has := iff.rfl

instance : partial_order (dynkin_system α) :=
{ le_refl     := assume a b, le_rfl,
  le_trans    := assume a b c hab hbc, le_def.mpr (le_trans hab hbc),
  le_antisymm := assume a b h₁ h₂, ext $ assume s, ⟨h₁ s, h₂ s⟩,
  ..dynkin_system.has_le }

/-- Every measurable space (σ-algebra) forms a Dynkin system -/
def of_measurable_space (m : measurable_space α) : dynkin_system α :=
{ has       := m.measurable_set',
  has_empty := m.measurable_set_empty,
  has_compl := m.measurable_set_compl,
  has_Union_nat := assume f _ hf, m.measurable_set_Union f hf }

lemma of_measurable_space_le_of_measurable_space_iff {m₁ m₂ : measurable_space α} :
  of_measurable_space m₁ ≤ of_measurable_space m₂ ↔ m₁ ≤ m₂ :=
iff.rfl

/-- The least Dynkin system containing a collection of basic sets.
  This inductive type gives the underlying collection of sets. -/
inductive generate_has (s : set (set α)) : set α → Prop
| basic : ∀ t ∈ s, generate_has t
| empty : generate_has ∅
| compl : ∀ {a}, generate_has a → generate_has aᶜ
| Union : ∀ {f : ℕ → set α}, pairwise (disjoint on f) →
    (∀ i, generate_has (f i)) → generate_has (⋃ i, f i)

lemma generate_has_compl {C : set (set α)} {s : set α} : generate_has C sᶜ ↔ generate_has C s :=
by { refine ⟨_, generate_has.compl⟩, intro h, convert generate_has.compl h, simp }

/-- The least Dynkin system containing a collection of basic sets. -/
def generate (s : set (set α)) : dynkin_system α :=
{ has := generate_has s,
  has_empty := generate_has.empty,
  has_compl := assume a, generate_has.compl,
  has_Union_nat := assume f, generate_has.Union }

lemma generate_has_def {C : set (set α)} : (generate C).has = generate_has C := rfl

instance : inhabited (dynkin_system α) := ⟨generate univ⟩

/-- If a Dynkin system is closed under binary intersection, then it forms a `σ`-algebra. -/
def to_measurable_space (h_inter : ∀ s₁ s₂, d.has s₁ → d.has s₂ → d.has (s₁ ∩ s₂)) :=
{ measurable_space .
  measurable_set'      := d.has,
  measurable_set_empty := d.has_empty,
  measurable_set_compl := assume s h, d.has_compl h,
  measurable_set_Union := λ f hf,
    begin
      rw ←Union_disjointed,
      exact d.has_Union (disjoint_disjointed _)
        (λ n, disjointed_rec (λ t i h, h_inter _ _ h $ d.has_compl $ hf i) (hf n)),
    end }

lemma of_measurable_space_to_measurable_space
  (h_inter : ∀ s₁ s₂, d.has s₁ → d.has s₂ → d.has (s₁ ∩ s₂)) :
  of_measurable_space (d.to_measurable_space h_inter) = d :=
ext $ assume s, iff.rfl

/-- If `s` is in a Dynkin system `d`, we can form the new Dynkin system `{s ∩ t | t ∈ d}`. -/
def restrict_on {s : set α} (h : d.has s) : dynkin_system α :=
{ has       := λ t, d.has (t ∩ s),
  has_empty := by simp [d.has_empty],
  has_compl := assume t hts,
    have tᶜ ∩ s = ((t ∩ s)ᶜ) \ sᶜ,
      from set.ext $ assume x, by { by_cases x ∈ s; simp [h] },
    by { rw [this], exact d.has_diff (d.has_compl hts) (d.has_compl h)
      (compl_subset_compl.mpr $ inter_subset_right _ _) },
  has_Union_nat := assume f hd hf,
    begin
      rw [inter_comm, inter_Union],
      apply d.has_Union_nat,
      { exact λ i j h x ⟨⟨_, h₁⟩, _, h₂⟩, hd i j h ⟨h₁, h₂⟩ },
      { simpa [inter_comm] using hf },
    end }

lemma generate_le {s : set (set α)} (h : ∀ t ∈ s, d.has t) : generate s ≤ d :=
λ t ht, ht.rec_on h d.has_empty
  (assume a _ h, d.has_compl h)
  (assume f hd _ hf, d.has_Union hd hf)

lemma generate_has_subset_generate_measurable {C : set (set α)} {s : set α}
  (hs : (generate C).has s) : measurable_set[generate_from C] s :=
generate_le (of_measurable_space (generate_from C)) (λ t, measurable_set_generate_from) s hs

lemma generate_inter {s : set (set α)}
  (hs : is_pi_system s) {t₁ t₂ : set α}
  (ht₁ : (generate s).has t₁) (ht₂ : (generate s).has t₂) : (generate s).has (t₁ ∩ t₂) :=
have generate s ≤ (generate s).restrict_on ht₂,
  from generate_le _ $ assume s₁ hs₁,
  have (generate s).has s₁, from generate_has.basic s₁ hs₁,
  have generate s ≤ (generate s).restrict_on this,
    from generate_le _ $ assume s₂ hs₂,
      show (generate s).has (s₂ ∩ s₁), from
        (s₂ ∩ s₁).eq_empty_or_nonempty.elim
        (λ h,  h.symm ▸ generate_has.empty)
        (λ h, generate_has.basic _ $ hs _ hs₂ _ hs₁ h),
  have (generate s).has (t₂ ∩ s₁), from this _ ht₂,
  show (generate s).has (s₁ ∩ t₂), by rwa [inter_comm],
this _ ht₁

/--
  **Dynkin's π-λ theorem**:
  Given a collection of sets closed under binary intersections, then the Dynkin system it
  generates is equal to the σ-algebra it generates.
  This result is known as the π-λ theorem.
  A collection of sets closed under binary intersection is called a π-system (often requiring
  additionnally that is is non-empty, but we drop this condition in the formalization).
-/
lemma generate_from_eq {s : set (set α)} (hs : is_pi_system s) :
  generate_from s = (generate s).to_measurable_space (λ t₁ t₂, generate_inter hs) :=
le_antisymm
  (generate_from_le $ assume t ht, generate_has.basic t ht)
  (of_measurable_space_le_of_measurable_space_iff.mp $
    by { rw [of_measurable_space_to_measurable_space],
    exact (generate_le _ $ assume t ht, measurable_set_generate_from ht) })

end dynkin_system

theorem induction_on_inter {C : set α → Prop} {s : set (set α)} [m : measurable_space α]
  (h_eq : m = generate_from s) (h_inter : is_pi_system s)
  (h_empty : C ∅) (h_basic : ∀ t ∈ s, C t) (h_compl : ∀ t, measurable_set t → C t → C tᶜ)
  (h_union : ∀ f : ℕ → set α, pairwise (disjoint on f) →
    (∀ i, measurable_set (f i)) → (∀ i, C (f i)) → C (⋃ i, f i)) :
  ∀ ⦃t⦄, measurable_set t → C t :=
have eq : measurable_set = dynkin_system.generate_has s,
  by { rw [h_eq, dynkin_system.generate_from_eq h_inter], refl },
assume t ht,
have dynkin_system.generate_has s t, by rwa [eq] at ht,
this.rec_on h_basic h_empty
  (assume t ht, h_compl t $ by { rw [eq], exact ht })
  (assume f hf ht, h_union f hf $ assume i, by { rw [eq], exact ht _ })

end measurable_space


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import order.complete_lattice
import order.synonym

/-!
# Galois connections, insertions and coinsertions

Galois connections are order theoretic adjoints, i.e. a pair of functions `u` and `l`,
such that `∀ a b, l a ≤ b ↔ a ≤ u b`.

## Main definitions

* `galois_connection`: A Galois connection is a pair of functions `l` and `u` satisfying
  `l a ≤ b ↔ a ≤ u b`. They are special cases of adjoint functors in category theory,
  but do not depend on the category theory library in mathlib.
* `galois_insertion`: A Galois insertion is a Galois connection where `l ∘ u = id`
* `galois_coinsertion`: A Galois coinsertion is a Galois connection where `u ∘ l = id`

## Implementation details

Galois insertions can be used to lift order structures from one type to another.
For example if `α` is a complete lattice, and `l : α → β`, and `u : β → α` form a Galois insertion,
then `β` is also a complete lattice. `l` is the lower adjoint and `u` is the upper adjoint.

An example of a Galois insertion is in group theory. If `G` is a group, then there is a Galois
insertion between the set of subsets of `G`, `set G`, and the set of subgroups of `G`,
`subgroup G`. The lower adjoint is `subgroup.closure`, taking the `subgroup` generated by a `set`,
and the upper adjoint is the coercion from `subgroup G` to `set G`, taking the underlying set
of a subgroup.

Naively lifting a lattice structure along this Galois insertion would mean that the definition
of `inf` on subgroups would be `subgroup.closure (↑S ∩ ↑T)`. This is an undesirable definition
because the intersection of subgroups is already a subgroup, so there is no need to take the
closure. For this reason a `choice` function is added as a field to the `galois_insertion`
structure. It has type `Π S : set G, ↑(closure S) ≤ S → subgroup G`. When `↑(closure S) ≤ S`, then
`S` is already a subgroup, so this function can be defined using `subgroup.mk` and not `closure`.
This means the infimum of subgroups will be defined to be the intersection of sets, paired
with a proof that intersection of subgroups is a subgroup, rather than the closure of the
intersection.
-/

open function order_dual set

universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x} {κ : ι → Sort*} {a a₁ a₂ : α}
  {b b₁ b₂ : β}

/-- A Galois connection is a pair of functions `l` and `u` satisfying
  `l a ≤ b ↔ a ≤ u b`. They are special cases of adjoint functors in category theory,
    but do not depend on the category theory library in mathlib. -/
def galois_connection [preorder α] [preorder β] (l : α → β) (u : β → α) := ∀ a b, l a ≤ b ↔ a ≤ u b

/-- Makes a Galois connection from an order-preserving bijection. -/
theorem order_iso.to_galois_connection [preorder α] [preorder β] (oi : α ≃o β) :
  galois_connection oi oi.symm :=
λ b g, oi.rel_symm_apply.symm

namespace galois_connection

section
variables [preorder α] [preorder β] {l : α → β} {u : β → α} (gc : galois_connection l u)

lemma monotone_intro (hu : monotone u) (hl : monotone l)
  (hul : ∀ a, a ≤ u (l a)) (hlu : ∀ a, l (u a) ≤ a) : galois_connection l u :=
λ a b, ⟨λ h, (hul _).trans (hu h), λ h, (hl h).trans (hlu _)⟩

include gc

protected lemma dual {l : α → β} {u : β → α} (gc : galois_connection l u) :
  galois_connection (order_dual.to_dual ∘ u ∘ order_dual.of_dual)
    (order_dual.to_dual ∘ l ∘ order_dual.of_dual) :=
λ a b, (gc b a).symm

lemma le_iff_le {a : α} {b : β} : l a ≤ b ↔ a ≤ u b :=
gc _ _

lemma l_le {a : α} {b : β} : a ≤ u b → l a ≤ b :=
(gc _ _).mpr

lemma le_u {a : α} {b : β} : l a ≤ b → a ≤ u b :=
(gc _ _).mp

lemma le_u_l (a) : a ≤ u (l a) :=
gc.le_u $ le_rfl

lemma l_u_le (a) : l (u a) ≤ a :=
gc.l_le $ le_rfl

lemma monotone_u : monotone u :=
λ a b H, gc.le_u ((gc.l_u_le a).trans H)

lemma monotone_l : monotone l :=
gc.dual.monotone_u.dual

lemma upper_bounds_l_image (s : set α) : upper_bounds (l '' s) = u ⁻¹' upper_bounds s :=
set.ext $ λ b, by simp [upper_bounds, gc _ _]

lemma lower_bounds_u_image (s : set β) : lower_bounds (u '' s) = l ⁻¹' lower_bounds s :=
gc.dual.upper_bounds_l_image s

lemma bdd_above_l_image {s : set α} : bdd_above (l '' s) ↔ bdd_above s :=
⟨λ ⟨x, hx⟩, ⟨u x, by rwa [gc.upper_bounds_l_image] at hx⟩, gc.monotone_l.map_bdd_above⟩

lemma bdd_below_u_image {s : set β} : bdd_below (u '' s) ↔ bdd_below s :=
gc.dual.bdd_above_l_image

lemma is_lub_l_image {s : set α} {a : α} (h : is_lub s a) : is_lub (l '' s) (l a) :=
⟨gc.monotone_l.mem_upper_bounds_image h.left,
  λ b hb, gc.l_le $ h.right $ by rwa [gc.upper_bounds_l_image] at hb⟩

lemma is_glb_u_image {s : set β} {b : β} (h : is_glb s b) : is_glb (u '' s) (u b) :=
gc.dual.is_lub_l_image h

lemma is_least_l {a : α} : is_least {b | a ≤ u b} (l a) :=
⟨gc.le_u_l _, λ b hb, gc.l_le hb⟩

lemma is_greatest_u {b : β} : is_greatest {a | l a ≤ b} (u b) :=
gc.dual.is_least_l

lemma is_glb_l {a : α} : is_glb {b | a ≤ u b} (l a) := gc.is_least_l.is_glb

lemma is_lub_u {b : β} : is_lub { a | l a ≤ b } (u b) := gc.is_greatest_u.is_lub

/-- If `(l, u)` is a Galois connection, then the relation `x ≤ u (l y)` is a transitive relation.
If `l` is a closure operator (`submodule.span`, `subgroup.closure`, ...) and `u` is the coercion to
`set`, this reads as "if `U` is in the closure of `V` and `V` is in the closure of `W` then `U` is
in the closure of `W`". -/
lemma le_u_l_trans {x y z : α} (hxy : x ≤ u (l y)) (hyz : y ≤ u (l z)) :
  x ≤ u (l z) :=
hxy.trans (gc.monotone_u $ gc.l_le hyz)

lemma l_u_le_trans {x y z : β} (hxy : l (u x) ≤ y) (hyz : l (u y) ≤ z) :
  l (u x) ≤ z :=
(gc.monotone_l $ gc.le_u hxy).trans hyz

end

section partial_order
variables [partial_order α] [preorder β] {l : α → β} {u : β → α} (gc : galois_connection l u)
include gc

lemma u_l_u_eq_u (b : β) : u (l (u b)) = u b :=
(gc.monotone_u (gc.l_u_le _)).antisymm (gc.le_u_l _)

lemma u_l_u_eq_u' : u ∘ l ∘ u = u := funext gc.u_l_u_eq_u

lemma u_unique {l' : α → β} {u' : β → α} (gc' : galois_connection l' u')
  (hl : ∀ a, l a = l' a) {b : β} : u b = u' b :=
le_antisymm (gc'.le_u $ hl (u b) ▸ gc.l_u_le _)
  (gc.le_u $ (hl (u' b)).symm ▸ gc'.l_u_le _)

/-- If there exists a `b` such that `a = u a`, then `b = l a` is one such element. -/
lemma exists_eq_u (a : α) : (∃ b : β, a = u b) ↔ a = u (l a) :=
⟨λ ⟨S, hS⟩, hS.symm ▸ (gc.u_l_u_eq_u _).symm, λ HI, ⟨_, HI⟩ ⟩

lemma u_eq {z : α} {y : β} :
  u y = z ↔ ∀ x, x ≤ z ↔ l x ≤ y :=
begin
  split,
  { rintros rfl x,
    exact (gc x y).symm },
  { intros H,
    exact ((H $ u y).mpr (gc.l_u_le y)).antisymm ((gc _ _).mp $ (H z).mp le_rfl) }
end

end partial_order

section partial_order
variables [preorder α] [partial_order β] {l : α → β} {u : β → α} (gc : galois_connection l u)
include gc

lemma l_u_l_eq_l (a : α) : l (u (l a)) = l a :=
(gc.l_u_le _).antisymm (gc.monotone_l (gc.le_u_l _))

lemma l_u_l_eq_l' : l ∘ u ∘ l = l := funext gc.l_u_l_eq_l

lemma l_unique {l' : α → β} {u' : β → α} (gc' : galois_connection l' u')
  (hu : ∀ b, u b = u' b) {a : α} : l a = l' a :=
le_antisymm (gc.l_le $ (hu (l' a)).symm ▸ gc'.le_u_l _)
  (gc'.l_le $ hu (l a) ▸ gc.le_u_l _)

/-- If there exists an `a` such that `b = l a`, then `a = u b` is one such element. -/
lemma exists_eq_l (b : β) : (∃ a : α, b = l a) ↔ b = l (u b) :=
⟨λ ⟨S, hS⟩, hS.symm ▸ (gc.l_u_l_eq_l _).symm, λ HI, ⟨_, HI⟩ ⟩

lemma l_eq  {x : α} {z : β} :
  l x = z ↔ ∀ y, z ≤ y ↔ x ≤ u y :=
begin
  split,
  { rintros rfl y,
    exact gc x y },
  { intros H,
    exact ((gc _ _).mpr $ (H z).mp le_rfl).antisymm ((H $ l x).mpr (gc.le_u_l x)) }
end

end partial_order

section order_top
variables [partial_order α] [preorder β] [order_top α] [order_top β] {l : α → β} {u : β → α}
  (gc : galois_connection l u)
include gc

lemma u_top : u ⊤ = ⊤ := top_unique $ gc.le_u le_top

end order_top

section order_bot
variables [preorder α] [partial_order β] [order_bot α] [order_bot β] {l : α → β} {u : β → α}
  (gc : galois_connection l u)
include gc

lemma l_bot : l ⊥ = ⊥ := gc.dual.u_top

end order_bot

section semilattice_sup
variables [semilattice_sup α] [semilattice_sup β] {l : α → β} {u : β → α}
  (gc : galois_connection l u)
include gc

lemma l_sup : l (a₁ ⊔ a₂) = l a₁ ⊔ l a₂ :=
(gc.is_lub_l_image is_lub_pair).unique $ by simp only [image_pair, is_lub_pair]

end semilattice_sup

section semilattice_inf
variables [semilattice_inf α] [semilattice_inf β] {l : α → β} {u : β → α}
  (gc : galois_connection l u)
include gc

lemma u_inf : u (b₁ ⊓ b₂) = u b₁ ⊓ u b₂ := gc.dual.l_sup

end semilattice_inf

section complete_lattice
variables [complete_lattice α] [complete_lattice β] {l : α → β} {u : β → α}
  (gc : galois_connection l u)
include gc

lemma l_supr {f : ι → α} : l (supr f) = ⨆ i, l (f i) :=
eq.symm $ is_lub.supr_eq $ show is_lub (range (l ∘ f)) (l (supr f)),
  by rw [range_comp, ← Sup_range]; exact gc.is_lub_l_image (is_lub_Sup _)

lemma l_supr₂ {f : Π i, κ i → α} : l (⨆ i j, f i j) = ⨆ i j, l (f i j) := by simp_rw gc.l_supr

lemma u_infi {f : ι → β} : u (infi f) = ⨅ i, u (f i) := gc.dual.l_supr
lemma u_infi₂ {f : Π i, κ i → β} : u (⨅ i j, f i j) = ⨅ i j, u (f i j) := gc.dual.l_supr₂

lemma l_Sup {s : set α} : l (Sup s) = ⨆ a ∈ s, l a := by simp only [Sup_eq_supr, gc.l_supr]
lemma u_Inf {s : set β} : u (Inf s) = ⨅ a ∈ s, u a := gc.dual.l_Sup

end complete_lattice

section linear_order
variables [linear_order α] [linear_order β] {l : α → β} {u : β → α}
  (gc : galois_connection l u)

lemma lt_iff_lt {a : α} {b : β} : b < l a ↔ u b < a := lt_iff_lt_of_le_iff_le (gc a b)

end linear_order

/- Constructing Galois connections -/
section constructions

protected lemma id [pα : preorder α] : @galois_connection α α pα pα id id :=
λ a b, iff.intro (λ x, x) (λ x, x)

protected lemma compose [preorder α] [preorder β] [preorder γ]
  {l1 : α → β} {u1 : β → α} {l2 : β → γ} {u2 : γ → β}
  (gc1 : galois_connection l1 u1) (gc2 : galois_connection l2 u2) :
  galois_connection (l2 ∘ l1) (u1 ∘ u2) :=
by intros a b; rw [gc2, gc1]

protected lemma dfun {ι : Type u} {α : ι → Type v} {β : ι → Type w}
  [∀ i, preorder (α i)] [∀ i, preorder (β i)]
  (l : Πi, α i → β i) (u : Πi, β i → α i) (gc : ∀ i, galois_connection (l i) (u i)) :
  galois_connection (λ (a : Π i, α i) i, l i (a i)) (λ b i, u i (b i)) :=
λ a b, forall_congr $ λ i, gc i (a i) (b i)

end constructions

lemma l_comm_of_u_comm
  {X : Type*} [preorder X] {Y : Type*} [preorder Y]
  {Z : Type*} [preorder Z] {W : Type*} [partial_order W]
  {lYX : X → Y} {uXY : Y → X} (hXY : galois_connection lYX uXY)
  {lWZ : Z → W} {uZW : W → Z} (hZW : galois_connection lWZ uZW)
  {lWY : Y → W} {uYW : W → Y} (hWY : galois_connection lWY uYW)
  {lZX : X → Z} {uXZ : Z → X} (hXZ : galois_connection lZX uXZ)
  (h : ∀ w, uXZ (uZW w) = uXY (uYW w)) {x : X} : lWZ (lZX x) = lWY (lYX x) :=
(hXZ.compose hZW).l_unique (hXY.compose hWY) h

lemma u_comm_of_l_comm
  {X : Type*} [partial_order X] {Y : Type*} [preorder Y]
  {Z : Type*} [preorder Z] {W : Type*} [preorder W]
  {lYX : X → Y} {uXY : Y → X} (hXY : galois_connection lYX uXY)
  {lWZ : Z → W} {uZW : W → Z} (hZW : galois_connection lWZ uZW)
  {lWY : Y → W} {uYW : W → Y} (hWY : galois_connection lWY uYW)
  {lZX : X → Z} {uXZ : Z → X} (hXZ : galois_connection lZX uXZ)
  (h : ∀ x, lWZ (lZX x) = lWY (lYX x)) {w : W} : uXZ (uZW w) = uXY (uYW w) :=
(hXZ.compose hZW).u_unique (hXY.compose hWY) h

lemma l_comm_iff_u_comm
  {X : Type*} [partial_order X] {Y : Type*} [preorder Y]
  {Z : Type*} [preorder Z] {W : Type*} [partial_order W]
  {lYX : X → Y} {uXY : Y → X} (hXY : galois_connection lYX uXY)
  {lWZ : Z → W} {uZW : W → Z} (hZW : galois_connection lWZ uZW)
  {lWY : Y → W} {uYW : W → Y} (hWY : galois_connection lWY uYW)
  {lZX : X → Z} {uXZ : Z → X} (hXZ : galois_connection lZX uXZ) :
  (∀ w : W, uXZ (uZW w) = uXY (uYW w)) ↔ ∀ x : X, lWZ (lZX x) = lWY (lYX x) :=
⟨hXY.l_comm_of_u_comm hZW hWY hXZ, hXY.u_comm_of_l_comm hZW hWY hXZ⟩

end galois_connection

section
variables [complete_lattice α] [complete_lattice β] [complete_lattice γ] {f : α → β → γ} {s : set α}
  {t : set β} {l u : α → β → γ} {l₁ u₁ : β → γ → α} {l₂ u₂ : α → γ → β}

lemma Sup_image2_eq_Sup_Sup (h₁ : ∀ b, galois_connection (swap l b) (u₁ b))
  (h₂ : ∀ a, galois_connection (l a) (u₂ a)) :
  Sup (image2 l s t) = l (Sup s) (Sup t) :=
by simp_rw [Sup_image2, ←(h₂ _).l_Sup, ←(h₁ _).l_Sup]

lemma Sup_image2_eq_Sup_Inf (h₁ : ∀ b, galois_connection (swap l b) (u₁ b))
  (h₂ : ∀ a, galois_connection (l a ∘ of_dual) (to_dual ∘ u₂ a)) :
  Sup (image2 l s t) = l (Sup s) (Inf t) :=
@Sup_image2_eq_Sup_Sup _ βᵒᵈ _ _ _ _ _ _ _ _ _ h₁ h₂

lemma Sup_image2_eq_Inf_Sup (h₁ : ∀ b, galois_connection (swap l b ∘ of_dual) (to_dual ∘ u₁ b))
  (h₂ : ∀ a, galois_connection (l a) (u₂ a)) :
  Sup (image2 l s t) = l (Inf s) (Sup t) :=
@Sup_image2_eq_Sup_Sup αᵒᵈ _ _ _ _ _ _ _ _ _ _ h₁ h₂

lemma Sup_image2_eq_Inf_Inf (h₁ : ∀ b, galois_connection (swap l b ∘ of_dual) (to_dual ∘ u₁ b))
  (h₂ : ∀ a, galois_connection (l a ∘ of_dual) (to_dual ∘ u₂ a)) :
  Sup (image2 l s t) = l (Inf s) (Inf t) :=
@Sup_image2_eq_Sup_Sup αᵒᵈ βᵒᵈ _ _ _ _ _ _ _ _ _ h₁ h₂

lemma Inf_image2_eq_Inf_Inf (h₁ : ∀ b, galois_connection (l₁ b) (swap u b))
  (h₂ : ∀ a, galois_connection (l₂ a) (u a)) :
  Inf (image2 u s t) = u (Inf s) (Inf t) :=
by simp_rw [Inf_image2, ←(h₂ _).u_Inf, ←(h₁ _).u_Inf]

lemma Inf_image2_eq_Inf_Sup (h₁ : ∀ b, galois_connection (l₁ b) (swap u b))
  (h₂ : ∀ a, galois_connection (to_dual ∘ l₂ a) (u a ∘ of_dual)) :
  Inf (image2 u s t) = u (Inf s) (Sup t) :=
@Inf_image2_eq_Inf_Inf _ βᵒᵈ _ _ _ _ _ _ _ _ _ h₁ h₂

lemma Inf_image2_eq_Sup_Inf (h₁ : ∀ b, galois_connection (to_dual ∘ l₁ b) (swap u b ∘ of_dual))
  (h₂ : ∀ a, galois_connection (l₂ a) (u a)) :
  Inf (image2 u s t) = u (Sup s) (Inf t) :=
@Inf_image2_eq_Inf_Inf αᵒᵈ _ _ _ _ _ _ _ _ _ _ h₁ h₂

lemma Inf_image2_eq_Sup_Sup (h₁ : ∀ b, galois_connection (to_dual ∘ l₁ b) (swap u b ∘ of_dual))
  (h₂ : ∀ a, galois_connection (to_dual ∘ l₂ a) (u a ∘ of_dual)) :
  Inf (image2 u s t) = u (Sup s) (Sup t) :=
@Inf_image2_eq_Inf_Inf αᵒᵈ βᵒᵈ _ _ _ _ _ _ _ _ _ h₁ h₂

end

namespace order_iso

variables [preorder α] [preorder β]

@[simp] lemma bdd_above_image (e : α ≃o β) {s : set α} : bdd_above (e '' s) ↔ bdd_above s :=
e.to_galois_connection.bdd_above_l_image

@[simp] lemma bdd_below_image (e : α ≃o β) {s : set α} : bdd_below (e '' s) ↔ bdd_below s :=
e.dual.bdd_above_image

@[simp] lemma bdd_above_preimage (e : α ≃o β) {s : set β} : bdd_above (e ⁻¹' s) ↔ bdd_above s :=
by rw [← e.bdd_above_image, e.image_preimage]

@[simp] lemma bdd_below_preimage (e : α ≃o β) {s : set β} : bdd_below (e ⁻¹' s) ↔ bdd_below s :=
by rw [← e.bdd_below_image, e.image_preimage]

end order_iso

namespace nat

lemma galois_connection_mul_div {k : ℕ} (h : 0 < k) : galois_connection (λ n, n * k) (λ n, n / k) :=
λ x y, (le_div_iff_mul_le h).symm

end nat

/-- A Galois insertion is a Galois connection where `l ∘ u = id`. It also contains a constructive
choice function, to give better definitional equalities when lifting order structures. Dual
to `galois_coinsertion` -/
@[nolint has_inhabited_instance]
structure galois_insertion {α β : Type*} [preorder α] [preorder β] (l : α → β) (u : β → α) :=
(choice : Πx : α, u (l x) ≤ x → β)
(gc : galois_connection l u)
(le_l_u : ∀ x, x ≤ l (u x))
(choice_eq : ∀ a h, choice a h = l a)

/-- A constructor for a Galois insertion with the trivial `choice` function. -/
def galois_insertion.monotone_intro {α β : Type*} [preorder α] [preorder β] {l : α → β} {u : β → α}
  (hu : monotone u) (hl : monotone l) (hul : ∀ a, a ≤ u (l a)) (hlu : ∀ b, l (u b) = b) :
  galois_insertion l u :=
{ choice := λ x _, l x,
  gc := galois_connection.monotone_intro hu hl hul (λ b, le_of_eq (hlu b)),
  le_l_u := λ b, le_of_eq $ (hlu b).symm,
  choice_eq := λ _ _, rfl }

/-- Makes a Galois insertion from an order-preserving bijection. -/
protected def order_iso.to_galois_insertion [preorder α] [preorder β] (oi : α ≃o β) :
  galois_insertion oi oi.symm :=
{ choice := λ b h, oi b,
  gc := oi.to_galois_connection,
  le_l_u := λ g, le_of_eq (oi.right_inv g).symm,
  choice_eq := λ b h, rfl }

/-- Make a `galois_insertion l u` from a `galois_connection l u` such that `∀ b, b ≤ l (u b)` -/
def galois_connection.to_galois_insertion {α β : Type*} [preorder α] [preorder β]
  {l : α → β} {u : β → α} (gc : galois_connection l u) (h : ∀ b, b ≤ l (u b)) :
  galois_insertion l u :=
{ choice := λ x _, l x,
  gc := gc,
  le_l_u := h,
  choice_eq := λ _ _, rfl }

/-- Lift the bottom along a Galois connection -/
def galois_connection.lift_order_bot {α β : Type*} [preorder α] [order_bot α] [partial_order β]
  {l : α → β} {u : β → α} (gc : galois_connection l u) :
  order_bot β :=
{ bot    := l ⊥,
  bot_le := λ b, gc.l_le $ bot_le }

namespace galois_insertion

variables {l : α → β} {u : β → α}

lemma l_u_eq [preorder α] [partial_order β] (gi : galois_insertion l u) (b : β) :
  l (u b) = b :=
(gi.gc.l_u_le _).antisymm (gi.le_l_u _)

lemma left_inverse_l_u [preorder α] [partial_order β] (gi : galois_insertion l u) :
  left_inverse l u :=
gi.l_u_eq

lemma l_surjective [preorder α] [partial_order β] (gi : galois_insertion l u) :
  surjective l :=
gi.left_inverse_l_u.surjective

lemma u_injective [preorder α] [partial_order β] (gi : galois_insertion l u) :
  injective u :=
gi.left_inverse_l_u.injective

lemma l_sup_u [semilattice_sup α] [semilattice_sup β] (gi : galois_insertion l u) (a b : β) :
  l (u a ⊔ u b) = a ⊔ b :=
calc l (u a ⊔ u b) = l (u a) ⊔ l (u b) : gi.gc.l_sup
               ... = a ⊔ b : by simp only [gi.l_u_eq]

lemma l_supr_u [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  {ι : Sort x} (f : ι → β) :
  l (⨆ i, u (f i)) = ⨆ i, (f i) :=
calc l (⨆ (i : ι), u (f i)) = ⨆ (i : ι), l (u (f i)) : gi.gc.l_supr
                        ... = ⨆ (i : ι), f i : congr_arg _ $ funext $ λ i, gi.l_u_eq (f i)

lemma l_bsupr_u [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  {ι : Sort x} {p : ι → Prop} (f : Π i (hi : p i), β) :
  l (⨆ i hi, u (f i hi)) = ⨆ i hi, f i hi :=
by simp only [supr_subtype', gi.l_supr_u]

lemma l_Sup_u_image [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  (s : set β) : l (Sup (u '' s)) = Sup s :=
by rw [Sup_image, gi.l_bsupr_u, Sup_eq_supr]

lemma l_inf_u [semilattice_inf α] [semilattice_inf β] (gi : galois_insertion l u) (a b : β) :
  l (u a ⊓ u b) = a ⊓ b :=
calc l (u a ⊓ u b) = l (u (a ⊓ b)) : congr_arg l gi.gc.u_inf.symm
               ... = a ⊓ b : by simp only [gi.l_u_eq]

lemma l_infi_u [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  {ι : Sort x} (f : ι → β) :
  l (⨅ i, u (f i)) = ⨅ i, f i :=
calc l (⨅ (i : ι), u (f i)) = l (u (⨅ (i : ι), (f i))) : congr_arg l gi.gc.u_infi.symm
                        ... = ⨅ (i : ι), f i : gi.l_u_eq _

lemma l_binfi_u [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  {ι : Sort x} {p : ι → Prop} (f : Π i (hi : p i), β) :
  l (⨅ i hi, u (f i hi)) = ⨅ i hi, f i hi :=
by simp only [infi_subtype', gi.l_infi_u]

lemma l_Inf_u_image [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  (s : set β) : l (Inf (u '' s)) = Inf s :=
by rw [Inf_image, gi.l_binfi_u, Inf_eq_infi]

lemma l_infi_of_ul_eq_self [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  {ι : Sort x} (f : ι → α) (hf : ∀ i, u (l (f i)) = f i) :
  l (⨅ i, f i) = ⨅ i, l (f i) :=
calc l (⨅ i, (f i)) =  l ⨅ (i : ι), (u (l (f i))) : by simp [hf]
                ... = ⨅ i, l (f i) : gi.l_infi_u _

lemma l_binfi_of_ul_eq_self [complete_lattice α] [complete_lattice β] (gi : galois_insertion l u)
  {ι : Sort x} {p : ι → Prop} (f : Π i (hi : p i), α) (hf : ∀ i hi, u (l (f i hi)) = f i hi) :
  l (⨅ i hi, f i hi) = ⨅ i hi, l (f i hi) :=
by { rw [infi_subtype', infi_subtype'], exact gi.l_infi_of_ul_eq_self _ (λ _, hf _ _) }

lemma u_le_u_iff [preorder α] [preorder β] (gi : galois_insertion l u) {a b} :
  u a ≤ u b ↔ a ≤ b :=
⟨λ h, (gi.le_l_u _).trans (gi.gc.l_le h),
    λ h, gi.gc.monotone_u h⟩

lemma strict_mono_u [preorder α] [preorder β] (gi : galois_insertion l u) : strict_mono u :=
strict_mono_of_le_iff_le $ λ _ _, gi.u_le_u_iff.symm

lemma is_lub_of_u_image [preorder α] [preorder β] (gi : galois_insertion l u) {s : set β} {a : α}
  (hs : is_lub (u '' s) a) : is_lub s (l a) :=
⟨λ x hx, (gi.le_l_u x).trans $ gi.gc.monotone_l $ hs.1 $ mem_image_of_mem _ hx,
  λ x hx, gi.gc.l_le $ hs.2 $ gi.gc.monotone_u.mem_upper_bounds_image hx⟩

lemma is_glb_of_u_image [preorder α] [preorder β] (gi : galois_insertion l u) {s : set β} {a : α}
  (hs : is_glb (u '' s) a) : is_glb s (l a) :=
⟨λ x hx, gi.gc.l_le $ hs.1 $ mem_image_of_mem _ hx,
  λ x hx, (gi.le_l_u x).trans $ gi.gc.monotone_l $ hs.2 $
    gi.gc.monotone_u.mem_lower_bounds_image hx⟩

section lift

variables [partial_order β]

/-- Lift the suprema along a Galois insertion -/
@[reducible] -- See note [reducible non instances]
def lift_semilattice_sup [semilattice_sup α] (gi : galois_insertion l u) : semilattice_sup β :=
{ sup := λ a b, l (u a ⊔ u b),
  le_sup_left  := λ a b, (gi.le_l_u a).trans $ gi.gc.monotone_l $ le_sup_left,
  le_sup_right := λ a b, (gi.le_l_u b).trans $ gi.gc.monotone_l $ le_sup_right,
  sup_le       := λ a b c hac hbc,
    gi.gc.l_le $ sup_le (gi.gc.monotone_u hac) (gi.gc.monotone_u hbc),
  .. ‹partial_order β› }

/-- Lift the infima along a Galois insertion -/
@[reducible] -- See note [reducible non instances]
def lift_semilattice_inf [semilattice_inf α] (gi : galois_insertion l u) : semilattice_inf β :=
{ inf := λ a b, gi.choice (u a ⊓ u b) $
    (le_inf (gi.gc.monotone_u $ gi.gc.l_le $ inf_le_left)
      (gi.gc.monotone_u $ gi.gc.l_le $ inf_le_right)),
  inf_le_left  := by simp only [gi.choice_eq]; exact λ a b, gi.gc.l_le inf_le_left,
  inf_le_right := by simp only [gi.choice_eq]; exact λ a b, gi.gc.l_le inf_le_right,
  le_inf       := by simp only [gi.choice_eq]; exact λ a b c hac hbc,
    (gi.le_l_u a).trans $ gi.gc.monotone_l $ le_inf (gi.gc.monotone_u hac) (gi.gc.monotone_u hbc),
  .. ‹partial_order β› }

/-- Lift the suprema and infima along a Galois insertion -/
@[reducible] -- See note [reducible non instances]
def lift_lattice [lattice α] (gi : galois_insertion l u) : lattice β :=
{ .. gi.lift_semilattice_sup, .. gi.lift_semilattice_inf }

/-- Lift the top along a Galois insertion -/
@[reducible] -- See note [reducible non instances]
def lift_order_top [preorder α] [order_top α] (gi : galois_insertion l u) : order_top β :=
{ top    := gi.choice ⊤ $ le_top,
  le_top := by simp only [gi.choice_eq]; exact λ b, (gi.le_l_u b).trans (gi.gc.monotone_l le_top) }

/-- Lift the top, bottom, suprema, and infima along a Galois insertion -/
@[reducible] -- See note [reducible non instances]
def lift_bounded_order [preorder α] [bounded_order α]
  (gi : galois_insertion l u) : bounded_order β :=
{ .. gi.lift_order_top, .. gi.gc.lift_order_bot }

/-- Lift all suprema and infima along a Galois insertion -/
@[reducible] -- See note [reducible non instances]
def lift_complete_lattice [complete_lattice α] (gi : galois_insertion l u) : complete_lattice β :=
{ Sup := λ s, l (Sup (u '' s)),
  Sup_le := λ s, (gi.is_lub_of_u_image (is_lub_Sup _)).2,
  le_Sup := λ s, (gi.is_lub_of_u_image (is_lub_Sup _)).1,
  Inf := λ s, gi.choice (Inf (u '' s)) $ (is_glb_Inf _).2 $ gi.gc.monotone_u.mem_lower_bounds_image
    (gi.is_glb_of_u_image $ is_glb_Inf _).1,
  Inf_le := λ s, by { rw gi.choice_eq, exact (gi.is_glb_of_u_image (is_glb_Inf _)).1 },
  le_Inf := λ s, by { rw gi.choice_eq, exact (gi.is_glb_of_u_image (is_glb_Inf _)).2 },
  .. gi.lift_bounded_order,
  .. gi.lift_lattice }

end lift

end galois_insertion

/-- A Galois coinsertion is a Galois connection where `u ∘ l = id`. It also contains a constructive
choice function, to give better definitional equalities when lifting order structures. Dual to
`galois_insertion` -/
@[nolint has_inhabited_instance]
structure galois_coinsertion [preorder α] [preorder β] (l : α → β) (u : β → α) :=
(choice : Πx : β, x ≤ l (u x) → α)
(gc : galois_connection l u)
(u_l_le : ∀ x, u (l x) ≤ x)
(choice_eq : ∀ a h, choice a h = u a)

/-- Make a `galois_insertion` between `αᵒᵈ` and `βᵒᵈ` from a `galois_coinsertion` between `α` and
`β`. -/
def galois_coinsertion.dual [preorder α] [preorder β] {l : α → β} {u : β → α} :
  galois_coinsertion l u → galois_insertion (to_dual ∘ u ∘ of_dual) (to_dual ∘ l ∘ of_dual) :=
λ x, ⟨x.1, x.2.dual, x.3, x.4⟩

/-- Make a `galois_coinsertion` between `αᵒᵈ` and `βᵒᵈ` from a `galois_insertion` between `α` and
`β`. -/
def galois_insertion.dual [preorder α] [preorder β] {l : α → β} {u : β → α} :
  galois_insertion l u → galois_coinsertion (to_dual ∘ u ∘ of_dual) (to_dual ∘ l ∘ of_dual) :=
λ x, ⟨x.1, x.2.dual, x.3, x.4⟩

/-- Make a `galois_insertion` between `α` and `β` from a `galois_coinsertion` between `αᵒᵈ` and
`βᵒᵈ`. -/
def galois_coinsertion.of_dual [preorder α] [preorder β] {l : αᵒᵈ → βᵒᵈ} {u : βᵒᵈ → αᵒᵈ} :
  galois_coinsertion l u → galois_insertion (of_dual ∘ u ∘ to_dual) (of_dual ∘ l ∘ to_dual) :=
λ x, ⟨x.1, x.2.dual, x.3, x.4⟩

/-- Make a `galois_coinsertion` between `α` and `β` from a `galois_insertion` between `αᵒᵈ` and
`βᵒᵈ`. -/
def galois_insertion.of_dual [preorder α] [preorder β] {l : αᵒᵈ → βᵒᵈ} {u : βᵒᵈ → αᵒᵈ} :
  galois_insertion l u → galois_coinsertion (of_dual ∘ u ∘ to_dual) (of_dual ∘ l ∘ to_dual) :=
λ x, ⟨x.1, x.2.dual, x.3, x.4⟩

/-- Makes a Galois coinsertion from an order-preserving bijection. -/
protected def order_iso.to_galois_coinsertion [preorder α] [preorder β] (oi : α ≃o β) :
  galois_coinsertion oi oi.symm :=
{ choice := λ b h, oi.symm b,
  gc := oi.to_galois_connection,
  u_l_le := λ g, le_of_eq (oi.left_inv g),
  choice_eq := λ b h, rfl }

/-- A constructor for a Galois coinsertion with the trivial `choice` function. -/
def galois_coinsertion.monotone_intro [preorder α] [preorder β] {l : α → β} {u : β → α}
  (hu : monotone u) (hl : monotone l) (hlu : ∀ b, l (u b) ≤ b)
  (hul : ∀ a, u (l a) = a) :
  galois_coinsertion l u :=
(galois_insertion.monotone_intro hl.dual hu.dual hlu hul).of_dual

/-- Make a `galois_coinsertion l u` from a `galois_connection l u` such that `∀ b, b ≤ l (u b)` -/
def galois_connection.to_galois_coinsertion {α β : Type*} [preorder α] [preorder β]
  {l : α → β} {u : β → α} (gc : galois_connection l u) (h : ∀ a, u (l a) ≤ a) :
  galois_coinsertion l u :=
{ choice := λ x _, u x,
  gc := gc,
  u_l_le := h,
  choice_eq := λ _ _, rfl }

/-- Lift the top along a Galois connection -/
def galois_connection.lift_order_top {α β : Type*} [partial_order α] [preorder β] [order_top β]
  {l : α → β} {u : β → α} (gc : galois_connection l u) :
  order_top α :=
{ top    := u ⊤,
  le_top := λ b, gc.le_u $ le_top }

namespace galois_coinsertion

variables {l : α → β} {u : β → α}

lemma u_l_eq [partial_order α] [preorder β] (gi : galois_coinsertion l u) (a : α) :
  u (l a) = a :=
gi.dual.l_u_eq a

lemma u_l_left_inverse [partial_order α] [preorder β] (gi : galois_coinsertion l u) :
  left_inverse u l :=
gi.u_l_eq

lemma u_surjective [partial_order α] [preorder β] (gi : galois_coinsertion l u) :
  surjective u :=
gi.dual.l_surjective

lemma l_injective [partial_order α] [preorder β] (gi : galois_coinsertion l u) :
  injective l :=
gi.dual.u_injective

lemma u_inf_l [semilattice_inf α] [semilattice_inf β] (gi : galois_coinsertion l u) (a b : α) :
  u (l a ⊓ l b) = a ⊓ b :=
gi.dual.l_sup_u a b

lemma u_infi_l [complete_lattice α] [complete_lattice β] (gi : galois_coinsertion l u)
  {ι : Sort x} (f : ι → α) :
  u (⨅ i, l (f i)) = ⨅ i, (f i) :=
gi.dual.l_supr_u _

lemma u_Inf_l_image [complete_lattice α] [complete_lattice β] (gi : galois_coinsertion l u)
  (s : set α) : u (Inf (l '' s)) = Inf s :=
gi.dual.l_Sup_u_image _

lemma u_sup_l [semilattice_sup α] [semilattice_sup β] (gi : galois_coinsertion l u) (a b : α) :
  u (l a ⊔ l b) = a ⊔ b :=
gi.dual.l_inf_u _ _

lemma u_supr_l [complete_lattice α] [complete_lattice β] (gi : galois_coinsertion l u)
  {ι : Sort x} (f : ι → α) :
  u (⨆ i, l (f i)) = ⨆ i, (f i) :=
gi.dual.l_infi_u _

lemma u_bsupr_l [complete_lattice α] [complete_lattice β] (gi : galois_coinsertion l u)
  {ι : Sort x} {p : ι → Prop} (f : Π i (hi : p i), α) :
  u (⨆ i hi, l (f i hi)) = ⨆ i hi, f i hi :=
gi.dual.l_binfi_u _

lemma u_Sup_l_image [complete_lattice α] [complete_lattice β] (gi : galois_coinsertion l u)
  (s : set α) : u (Sup (l '' s)) = Sup s :=
gi.dual.l_Inf_u_image _

lemma u_supr_of_lu_eq_self [complete_lattice α] [complete_lattice β] (gi : galois_coinsertion l u)
  {ι : Sort x} (f : ι → β) (hf : ∀ i, l (u (f i)) = f i) :
  u (⨆ i, (f i)) = ⨆ i, u (f i) :=
gi.dual.l_infi_of_ul_eq_self _ hf

lemma u_bsupr_of_lu_eq_self [complete_lattice α] [complete_lattice β] (gi : galois_coinsertion l u)
  {ι : Sort x} {p : ι → Prop} (f : Π i (hi : p i), β) (hf : ∀ i hi, l (u (f i hi)) = f i hi) :
  u (⨆ i hi, f i hi) = ⨆ i hi, u (f i hi) :=
gi.dual.l_binfi_of_ul_eq_self _ hf

lemma l_le_l_iff [preorder α] [preorder β] (gi : galois_coinsertion l u) {a b} :
  l a ≤ l b ↔ a ≤ b :=
gi.dual.u_le_u_iff

lemma strict_mono_l [preorder α] [preorder β] (gi : galois_coinsertion l u) : strict_mono l :=
λ a b h, gi.dual.strict_mono_u h

lemma is_glb_of_l_image [preorder α] [preorder β] (gi : galois_coinsertion l u) {s : set α} {a : β}
  (hs : is_glb (l '' s) a) : is_glb s (u a) :=
gi.dual.is_lub_of_u_image hs

lemma is_lub_of_l_image [preorder α] [preorder β] (gi : galois_coinsertion l u) {s : set α} {a : β}
  (hs : is_lub (l '' s) a) : is_lub s (u a) :=
gi.dual.is_glb_of_u_image hs

section lift

variables [partial_order α]

/-- Lift the infima along a Galois coinsertion -/
@[reducible] -- See note [reducible non instances]
def lift_semilattice_inf [semilattice_inf β] (gi : galois_coinsertion l u) : semilattice_inf α :=
{ inf := λ a b, u (l a ⊓ l b),
  .. ‹partial_order α›, .. @order_dual.semilattice_inf _ gi.dual.lift_semilattice_sup }

/-- Lift the suprema along a Galois coinsertion -/
@[reducible] -- See note [reducible non instances]
def lift_semilattice_sup [semilattice_sup β] (gi : galois_coinsertion l u) : semilattice_sup α :=
{ sup := λ a b, gi.choice (l a ⊔ l b) $
    (sup_le (gi.gc.monotone_l $ gi.gc.le_u $ le_sup_left)
      (gi.gc.monotone_l $ gi.gc.le_u $ le_sup_right)),
  .. ‹partial_order α›, .. @order_dual.semilattice_sup _ gi.dual.lift_semilattice_inf }

/-- Lift the suprema and infima along a Galois coinsertion -/
@[reducible] -- See note [reducible non instances]
def lift_lattice [lattice β] (gi : galois_coinsertion l u) : lattice α :=
{ .. gi.lift_semilattice_sup, .. gi.lift_semilattice_inf }

/-- Lift the bot along a Galois coinsertion -/
@[reducible] -- See note [reducible non instances]
def lift_order_bot [preorder β] [order_bot β] (gi : galois_coinsertion l u) : order_bot α :=
{ bot    := gi.choice ⊥ $ bot_le,
  .. @order_dual.order_bot _ _ gi.dual.lift_order_top }

/-- Lift the top, bottom, suprema, and infima along a Galois coinsertion -/
@[reducible] -- See note [reducible non instances]
def lift_bounded_order [preorder β] [bounded_order β]
  (gi : galois_coinsertion l u) : bounded_order α :=
{ .. gi.lift_order_bot, .. gi.gc.lift_order_top }

/-- Lift all suprema and infima along a Galois coinsertion -/
@[reducible] -- See note [reducible non instances]
def lift_complete_lattice [complete_lattice β] (gi : galois_coinsertion l u) : complete_lattice α :=
{ Inf := λ s, u (Inf (l '' s)),
  Sup := λ s, gi.choice (Sup (l '' s)) _,
  .. @order_dual.complete_lattice _ gi.dual.lift_complete_lattice }

end lift

end galois_coinsertion

/-- If `α` is a partial order with bottom element (e.g., `ℕ`, `ℝ≥0`), then
`λ o : with_bot α, o.get_or_else ⊥` and coercion form a Galois insertion. -/
def with_bot.gi_get_or_else_bot [preorder α] [order_bot α] :
  galois_insertion (λ o : with_bot α, o.get_or_else ⊥) coe :=
{ gc := λ a b, with_bot.get_or_else_bot_le_iff,
  le_l_u := λ a, le_rfl,
  choice := λ o ho, _,
  choice_eq := λ _ _, rfl }


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import topology.metric_space.basic
import order.filter.archimedean
/-!
# Topology on the integers

The structure of a metric space on `ℤ` is introduced in this file, induced from `ℝ`.
-/
noncomputable theory
open metric set filter

namespace int

instance : has_dist ℤ := ⟨λ x y, dist (x : ℝ) y⟩

theorem dist_eq (x y : ℤ) : dist x y = |x - y| := rfl

@[norm_cast, simp] theorem dist_cast_real (x y : ℤ) : dist (x : ℝ) y = dist x y := rfl

lemma pairwise_one_le_dist : pairwise (λ m n : ℤ, 1 ≤ dist m n) :=
begin
  intros m n hne,
  rw dist_eq, norm_cast, rwa [← zero_add (1 : ℤ), int.add_one_le_iff, abs_pos, sub_ne_zero]
end

lemma uniform_embedding_coe_real : uniform_embedding (coe : ℤ → ℝ) :=
uniform_embedding_bot_of_pairwise_le_dist zero_lt_one pairwise_one_le_dist

lemma closed_embedding_coe_real : closed_embedding (coe : ℤ → ℝ) :=
closed_embedding_of_pairwise_le_dist zero_lt_one pairwise_one_le_dist

instance : metric_space ℤ := int.uniform_embedding_coe_real.comap_metric_space _

theorem preimage_ball (x : ℤ) (r : ℝ) : coe ⁻¹' (ball (x : ℝ) r) = ball x r := rfl

theorem preimage_closed_ball (x : ℤ) (r : ℝ) :
  coe ⁻¹' (closed_ball (x : ℝ) r) = closed_ball x r := rfl

theorem ball_eq_Ioo (x : ℤ) (r : ℝ) : ball x r = Ioo ⌊↑x - r⌋ ⌈↑x + r⌉ :=
by rw [← preimage_ball, real.ball_eq_Ioo, preimage_Ioo]

theorem closed_ball_eq_Icc (x : ℤ) (r : ℝ) : closed_ball x r = Icc ⌈↑x - r⌉ ⌊↑x + r⌋ :=
by rw [← preimage_closed_ball, real.closed_ball_eq_Icc, preimage_Icc]

instance : proper_space ℤ :=
⟨ begin
    intros x r,
    rw closed_ball_eq_Icc,
    exact (set.finite_Icc _ _).is_compact,
  end ⟩

@[simp] lemma cocompact_eq : cocompact ℤ = at_bot ⊔ at_top :=
by simp only [← comap_dist_right_at_top_eq_cocompact (0 : ℤ), dist_eq, sub_zero, cast_zero,
  ← cast_abs, ← @comap_comap _ _ _ _ abs, int.comap_coe_at_top, comap_abs_at_top]

@[simp] lemma cofinite_eq : (cofinite : filter ℤ) = at_bot ⊔ at_top :=
by rw [← cocompact_eq_cofinite, cocompact_eq]

end int