/-
Copyright (c) 2021 Manuel Candales. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Manuel Candales
-/
import data.real.basic
import data.set.basic
import data.set.finite

/-!
# IMO 2008 Q2
(a) Prove that
          ```
          x^2 / (x-1)^2 + y^2 / (y-1)^2 + z^2 / (z-1)^2 ≥ 1
          ```
for all real numbers `x`,`y`, `z`, each different from 1, and satisfying `xyz = 1`.

(b) Prove that equality holds above for infinitely many triples of rational numbers `x`, `y`, `z`,
each different from 1, and satisfying `xyz = 1`.

# Solution
(a) Since `xyz = 1`, we can apply the substitution `x = a/b`, `y = b/c`, `z = c/a`.
Then we define `m = c-b`, `n = b-a` and rewrite the inequality as `LHS - 1 ≥ 0`
using `c`, `m` and `n`. We factor `LHS - 1` as a square, which finishes the proof.

(b) We present a set `W` of rational triples. We prove that `W` is a subset of the
set of rational solutions to the equation, and that `W` is infinite.
-/

lemma subst_abc {x y z : ℝ} (h : x*y*z = 1) :
  ∃ a b c : ℝ, a ≠ 0 ∧ b ≠ 0 ∧ c ≠ 0 ∧ x = a/b ∧ y = b/c ∧ z = c /a :=
begin
  use [x, 1, 1/y],
  have h₁ : x ≠ 0 := left_ne_zero_of_mul (left_ne_zero_of_mul_eq_one h),
  have h₂ : (1 : ℝ) ≠ (0 : ℝ) := one_ne_zero,
  have hy_ne_zero : y ≠ 0 := right_ne_zero_of_mul (left_ne_zero_of_mul_eq_one h),
  have h₃ : 1/y ≠ 0 := one_div_ne_zero hy_ne_zero,
  have h₄ : x = x / 1 := (div_one x).symm,
  have h₅ : y = 1 / (1 / y) := (one_div_one_div y).symm,
  have h₆ : z = 1 / y / x, { field_simp, linarith [h] },
  exact ⟨h₁, h₂, h₃, h₄, h₅, h₆⟩,
end

theorem imo2008_q2a (x y z : ℝ) (h : x*y*z = 1) (hx : x ≠ 1) (hy : y ≠ 1) (hz : z ≠ 1) :
  x^2 / (x-1)^2 + y^2 / (y-1)^2 + z^2 / (z-1)^2 ≥ 1 :=
begin
  obtain ⟨a, b, c, ha, hb, hc, hx₂, hy₂, hz₂⟩ := subst_abc h,

  set m := c-b with hm_abc,
  set n := b-a with hn_abc,
  have ha_cmn : a = c - m - n,      { linarith },
  have hb_cmn : b = c - m,          { linarith },
  have hab_mn : (a-b)^2 = n^2,      { rw [ha_cmn, hb_cmn], ring },
  have hbc_mn : (b-c)^2 = m^2,      { rw hb_cmn, ring },
  have hca_mn : (c-a)^2 = (m+n)^2,  { rw ha_cmn, ring },

  have hm_ne_zero : m ≠ 0,
  { rw hm_abc, rw hy₂ at hy, intro p, apply hy, field_simp, linarith },

  have hn_ne_zero : n ≠ 0,
  { rw hn_abc, rw hx₂ at hx, intro p, apply hx, field_simp, linarith },

  have hmn_ne_zero : m + n ≠ 0,
  { rw hm_abc, rw hn_abc, rw hz₂ at hz, intro p, apply hz, field_simp, linarith },

  have key : x^2 / (x-1)^2 + y^2 / (y-1)^2 + z^2 / (z-1)^2 - 1 ≥ 0,
  { calc  x^2 / (x-1)^2 + y^2 / (y-1)^2 + z^2 / (z-1)^2 - 1
        = (a/b)^2 / (a/b-1)^2 + (b/c)^2 / (b/c-1)^2 + (c/a)^2 / (c/a-1)^2 - 1 :
          by rw [hx₂, hy₂, hz₂]
    ... = a^2/(a-b)^2 + b^2/(b-c)^2 + c^2/(c-a)^2 - 1 :
          by field_simp [div_sub_one hb, div_sub_one hc, div_sub_one ha]
    ... = (c-m-n)^2/n^2 + (c-m)^2/m^2 + c^2/(m+n)^2 - 1 :
          by rw [hab_mn, hbc_mn, hca_mn, ha_cmn, hb_cmn]
    ... = ( (c*(m^2+n^2+m*n) - m*(m+n)^2) / (m*n*(m+n)) )^2 :
          by { ring_nf, field_simp, ring }
    ... ≥ 0 :
          sq_nonneg _ },

  linarith [key],
end

def rational_solutions := { s : ℚ×ℚ×ℚ | ∃ (x y z : ℚ), s = (x, y, z) ∧
  x ≠ 1 ∧ y ≠ 1 ∧ z ≠ 1 ∧ x*y*z = 1 ∧ x^2/(x-1)^2 + y^2/(y-1)^2 + z^2/(z-1)^2 = 1 }

theorem imo2008_q2b : set.infinite rational_solutions :=
begin
  let W := { s : ℚ×ℚ×ℚ | ∃ (x y z : ℚ), s = (x, y, z) ∧
    ∃ t : ℚ, t > 0 ∧ x = -(t+1)/t^2 ∧ y = t/(t+1)^2 ∧ z = -t*(t+1)},

  have hW_sub_S : W ⊆ rational_solutions,
  { intros s hs_in_W,
    rw rational_solutions,
    simp only [set.mem_set_of_eq] at hs_in_W ⊢,
    rcases hs_in_W with ⟨x, y, z, h₁, t, ht_gt_zero, hx_t, hy_t, hz_t⟩,
    use [x, y, z],

    have ht_ne_zero  : t ≠ 0,           exact ne_of_gt ht_gt_zero,
    have ht1_ne_zero : t+1 ≠ 0,         linarith[ht_gt_zero],
    have key_gt_zero : t^2 + t + 1 > 0, linarith[pow_pos ht_gt_zero 2, ht_gt_zero],
    have key_ne_zero : t^2 + t + 1 ≠ 0, exact ne_of_gt key_gt_zero,

    have h₂ : x ≠ 1,      { rw hx_t, field_simp, linarith[key_gt_zero] },
    have h₃ : y ≠ 1,      { rw hy_t, field_simp, linarith[key_gt_zero] },
    have h₄ : z ≠ 1,      { rw hz_t, linarith[key_gt_zero] },
    have h₅ : x*y*z = 1,  { rw [hx_t, hy_t, hz_t], field_simp, ring },

    have h₆ : x^2/(x-1)^2 + y^2/(y-1)^2 + z^2/(z-1)^2 = 1,
    { have hx1 : (x - 1)^2 = (t^2 + t + 1)^2/t^4,     { field_simp, rw hx_t, field_simp, ring },
      have hy1 : (y - 1)^2 = (t^2 + t + 1)^2/(t+1)^4, { field_simp, rw hy_t, field_simp, ring },
      have hz1 : (z - 1)^2 = (t^2 + t + 1)^2,         { rw hz_t, ring },
      calc  x^2/(x-1)^2 + y^2/(y-1)^2 + z^2/(z-1)^2
          = (x^2*t^4 + y^2*(t+1)^4 + z^2)/(t^2 + t + 1)^2 :
            by { rw [hx1, hy1, hz1], field_simp }
      ... = 1 :
            by { rw [hx_t, hy_t, hz_t], field_simp, ring } },

    exact ⟨h₁, h₂, h₃, h₄, h₅, h₆⟩ },

  have hW_inf : set.infinite W,
  { let g : ℚ×ℚ×ℚ → ℚ := (λs, -s.2.2),
    let K := g '' W,

    have hK_not_bdd : ¬bdd_above K,
    { rw not_bdd_above_iff,
      intro q,
      let t : ℚ := max (q+1) 1,
      use t*(t+1),

      have h₁ : t * (t + 1) ∈ K,
      { let x : ℚ := -(t + 1)/t^2,
        let y : ℚ := t/(t+1)^2,
        set z : ℚ := -t*(t+1) with hz_def,

        simp only [set.mem_image, prod.exists],
        use [x, y, z], split,
        simp only [set.mem_set_of_eq],
        { use [x, y, z], split,
          refl,
          { use t, split,
            { simp only [gt_iff_lt, lt_max_iff], right, exact zero_lt_one },
            exact ⟨rfl, rfl, rfl⟩ } },
        { have hg : g(x, y, z) = -z := rfl,
          rw [hg, hz_def], ring } },

      have h₂ : q < t * (t + 1),
      { calc q < q + 1    : by linarith
           ... ≤ t        : le_max_left (q + 1) 1
           ... ≤ t+t^2    : by linarith [sq_nonneg t]
           ... = t*(t+1)  : by ring },

      exact ⟨h₁, h₂⟩ },

    have hK_inf : set.infinite K,
    { intro h, apply hK_not_bdd, exact set.finite.bdd_above h },

    exact set.infinite_of_infinite_image g hK_inf },

  exact set.infinite_mono hW_sub_S hW_inf,
end


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.basic
import Mathlib.order.preorder_hom
import Mathlib.order.galois_connection
import Mathlib.tactic.monotonicity.default
import Mathlib.PostPort

universes u l

namespace Mathlib

/-!
# Closure operators on a partial order

We define (bundled) closure operators on a partial order as an monotone (increasing), extensive
(inflationary) and idempotent function.
We define closed elements for the operator as elements which are fixed by it.

Note that there is close connection to Galois connections and Galois insertions: every closure
operator induces a Galois insertion (from the set of closed elements to the underlying type), and
every Galois connection induces a closure operator (namely the composition). In particular,
a Galois insertion can be seen as a general case of a closure operator, where the inclusion is given
by coercion, see `closure_operator.gi`.

## References

* https://en.wikipedia.org/wiki/Closure_operator#Closure_operators_on_partially_ordered_sets

-/

/--
A closure operator on the partial order `α` is a monotone function which is extensive (every `x`
is less than its closure) and idempotent.
-/
structure closure_operator (α : Type u) [partial_order α] extends α →ₘ α where
  le_closure' : ∀ (x : α), x ≤ preorder_hom.to_fun _to_preorder_hom x
  idempotent' :
    ∀ (x : α),
      preorder_hom.to_fun _to_preorder_hom (preorder_hom.to_fun _to_preorder_hom x) =
        preorder_hom.to_fun _to_preorder_hom x

protected instance closure_operator.has_coe_to_fun (α : Type u) [partial_order α] :
    has_coe_to_fun (closure_operator α) :=
  has_coe_to_fun.mk (fun (c : closure_operator α) => α → α)
    fun (c : closure_operator α) => preorder_hom.to_fun (closure_operator.to_preorder_hom c)

namespace closure_operator

/-- The identity function as a closure operator. -/
@[simp] theorem id_to_preorder_hom_to_fun (α : Type u) [partial_order α] (x : α) :
    coe_fn (to_preorder_hom (id α)) x = x :=
  Eq.refl (coe_fn (to_preorder_hom (id α)) x)

protected instance inhabited (α : Type u) [partial_order α] : Inhabited (closure_operator α) :=
  { default := id α }

theorem ext {α : Type u} [partial_order α] (c₁ : closure_operator α) (c₂ : closure_operator α) :
    ⇑c₁ = ⇑c₂ → c₁ = c₂ :=
  sorry

/-- Constructor for a closure operator using the weaker idempotency axiom: `f (f x) ≤ f x`. -/
def mk' {α : Type u} [partial_order α] (f : α → α) (hf₁ : monotone f) (hf₂ : ∀ (x : α), x ≤ f x)
    (hf₃ : ∀ (x : α), f (f x) ≤ f x) : closure_operator α :=
  mk (preorder_hom.mk f hf₁) hf₂ sorry

/--
theorem monotone {α : Type u} [partial_order α] (c : closure_operator α) : monotone ⇑c :=
  preorder_hom.monotone' (to_preorder_hom c)

Every element is less than its closure. This property is sometimes referred to as extensivity or
inflationary.
-/
theorem le_closure {α : Type u} [partial_order α] (c : closure_operator α) (x : α) :
    x ≤ coe_fn c x :=
  le_closure' c x

@[simp] theorem idempotent {α : Type u} [partial_order α] (c : closure_operator α) (x : α) :
    coe_fn c (coe_fn c x) = coe_fn c x :=
  idempotent' c x

theorem le_closure_iff {α : Type u} [partial_order α] (c : closure_operator α) (x : α) (y : α) :
    x ≤ coe_fn c y ↔ coe_fn c x ≤ coe_fn c y :=
  { mp := fun (h : x ≤ coe_fn c y) => idempotent c y ▸ monotone c h,
    mpr := fun (h : coe_fn c x ≤ coe_fn c y) => le_trans (le_closure c x) h }

theorem closure_top {α : Type u} [order_top α] (c : closure_operator α) : coe_fn c ⊤ = ⊤ :=
  le_antisymm le_top (le_closure c ⊤)

theorem closure_inter_le {α : Type u} [semilattice_inf α] (c : closure_operator α) (x : α) (y : α) :
    coe_fn c (x ⊓ y) ≤ coe_fn c x ⊓ coe_fn c y :=
  le_inf (monotone c inf_le_left) (monotone c inf_le_right)

theorem closure_union_closure_le {α : Type u} [semilattice_sup α] (c : closure_operator α) (x : α)
    (y : α) : coe_fn c x ⊔ coe_fn c y ≤ coe_fn c (x ⊔ y) :=
  sup_le (monotone c le_sup_left) (monotone c le_sup_right)

/-- An element `x` is closed for the closure operator `c` if it is a fixed point for it. -/
def closed {α : Type u} [partial_order α] (c : closure_operator α) : set α :=
  fun (x : α) => coe_fn c x = x

theorem mem_closed_iff {α : Type u} [partial_order α] (c : closure_operator α) (x : α) :
    x ∈ closed c ↔ coe_fn c x = x :=
  iff.rfl

theorem mem_closed_iff_closure_le {α : Type u} [partial_order α] (c : closure_operator α) (x : α) :
    x ∈ closed c ↔ coe_fn c x ≤ x :=
  { mp := le_of_eq, mpr := fun (h : coe_fn c x ≤ x) => le_antisymm h (le_closure c x) }

theorem closure_eq_self_of_mem_closed {α : Type u} [partial_order α] (c : closure_operator α)
    {x : α} (h : x ∈ closed c) : coe_fn c x = x :=
  h

@[simp] theorem closure_is_closed {α : Type u} [partial_order α] (c : closure_operator α) (x : α) :
    coe_fn c x ∈ closed c :=
  idempotent c x

/-- The set of closed elements for `c` is exactly its range. -/
theorem closed_eq_range_close {α : Type u} [partial_order α] (c : closure_operator α) :
    closed c = set.range ⇑c :=
  sorry

/-- Send an `x` to an element of the set of closed elements (by taking the closure). -/
def to_closed {α : Type u} [partial_order α] (c : closure_operator α) (x : α) : ↥(closed c) :=
  { val := coe_fn c x, property := closure_is_closed c x }

theorem top_mem_closed {α : Type u} [order_top α] (c : closure_operator α) : ⊤ ∈ closed c :=
  closure_top c

theorem closure_le_closed_iff_le {α : Type u} [partial_order α] (c : closure_operator α) {x : α}
    {y : α} (hy : closed c y) : x ≤ y ↔ coe_fn c x ≤ y :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (x ≤ y ↔ coe_fn c x ≤ y))
        (Eq.symm (closure_eq_self_of_mem_closed c hy))))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (x ≤ coe_fn c y ↔ coe_fn c x ≤ coe_fn c y))
          (propext (le_closure_iff c x y))))
      (iff.refl (coe_fn c x ≤ coe_fn c y)))

/-- The set of closed elements has a Galois insertion to the underlying type. -/
def gi {α : Type u} [partial_order α] (c : closure_operator α) :
    galois_insertion (to_closed c) coe :=
  galois_insertion.mk (fun (x : α) (hx : ↑(to_closed c x) ≤ x) => { val := x, property := sorry })
    sorry sorry sorry

end closure_operator

/--
Every Galois connection induces a closure operator given by the composition. This is the partial
order version of the statement that every adjunction induces a monad.
-/
@[simp] theorem galois_connection.closure_operator_to_preorder_hom_to_fun {α : Type u}
    [partial_order α] {β : Type u} [preorder β] {l : α → β} {u : β → α} (gc : galois_connection l u)
    (x : α) :
    coe_fn (closure_operator.to_preorder_hom (galois_connection.closure_operator gc)) x = u (l x) :=
  Eq.refl (coe_fn (closure_operator.to_preorder_hom (galois_connection.closure_operator gc)) x)

/--
The Galois insertion associated to a closure operator can be used to reconstruct the closure
operator.

Note that the inverse in the opposite direction does not hold in general.
-/
@[simp] theorem closure_operator_gi_self {α : Type u} [partial_order α] (c : closure_operator α) :
    galois_connection.closure_operator (galois_insertion.gc (closure_operator.gi c)) = c :=
  sorry

end Mathlib


import analysis.topology.continuity
import analysis.topology.topological_space
import analysis.topology.infinite_sum
import analysis.topology.topological_structures
import analysis.topology.uniform_space

import Topology.Material.Sutherland_Chapter_8

import data.equiv.basic

local attribute [instance] classical.prop_decidable

universes u v w

open set filter lattice classical

-- Below is the definition of the subspace_topology
-- I think we should actually use the subspace topology already in lean
-- It is the one induced by the inclusion map, subspace.val
-- It is called subtype.topological_space
def subspace_topology {α : Type u} [X : topological_space α] (A : set α) : topological_space A := {
  is_open := λ I, ∃ U : set α, X.is_open U ∧ subtype.val '' I = U ∩ A,
  is_open_univ := begin existsi univ, split, exact X.is_open_univ, rw univ_inter, unfold set.image, simp, end,
  is_open_inter := begin
    intros s t Hs Ht,
    cases Hs with Us HUs,
    cases Ht with Ut HUt,
    let Ust := Us ∩ Ut,
    existsi Ust,
    split,
      exact X.is_open_inter Us Ut HUs.1 HUt.1,
    have H1 : Ust ∩ A = (Us ∩ A) ∩ (Ut ∩ A),
      rw inter_right_comm Us A (Ut ∩ A),
      simp [inter_assoc],
    rw H1,
    rw [← HUs.2, ← HUt.2],
    rw set.image_inter,
    exact subtype.val_injective,
  end,
  is_open_sUnion := begin
    intros I HI,
    let Uset := {U : set α | topological_space.is_open X U ∧ ∃ t ∈ I, subtype.val '' t = U ∩ A},
    let Uunion := ⋃₀ Uset,
    existsi Uunion,
    split,
      have H1 : (∀ (t : set α), t ∈ Uset → is_open t),
        intros t Ht,
        exact Ht.1,
      exact is_open_sUnion H1,
    apply set.ext,
    intro x,
    split,
      swap,
      intro Hx,
      cases Hx with Hx1 Hx2,
      simp at Hx1,
      cases Hx1 with U HU,
      simp,
      existsi Hx2,
      cases HU with HU HxU,
      cases HU with HUopen HU,
      cases HU with t Ht,
      existsi t,
      apply and.intro Ht.1,
      rw ← preimage_image_eq t subtype.val_injective,
      show x ∈ subtype.val '' t,
      rw Ht.2,
      exact ⟨HxU,Hx2⟩,
    simp,
    intros Hx HxinU0I,
    cases HxinU0I with t Ht,
    split,
      swap,
      exact Hx,
    have Hnext := HI t Ht.1,
    cases Hnext with Unext HUnext,
    existsi Unext,
    split,
      apply and.intro HUnext.1,
      existsi t,
      exact ⟨Ht.1, HUnext.2⟩,
    have x_in_val_t : x ∈ subtype.val '' t,
      simp,
      existsi Hx,
      exact Ht.2,
    rw HUnext.2 at x_in_val_t,
    exact x_in_val_t.1,
  end,
}

--Proof of equivalence of definitions
theorem subspace_top_eq_subtype_top {α : Type u} [X : topological_space α] (A : set α) :
(subspace_topology A).is_open = (subtype.topological_space).is_open :=
begin
  dunfold subtype.topological_space,
  unfold topological_space.induced,
  simp,
  funext V,
  apply propext,
  split,
    intro HU,
    cases HU with U HU,
    existsi U,
    apply and.intro HU.1,
    have H0 : subtype.val ⁻¹' (subtype.val '' V) = subtype.val ⁻¹' (A ∩ U),
      rw HU.2,
      simp,
      apply inter_comm,
    have H1 : V = subtype.val ⁻¹' (A ∩ U),
      rw ← H0,
      rw preimage_image_eq,
      exact subtype.val_injective,
    rw H1,
    simp,
    have preimage_A_eq_univ : subtype.val ⁻¹' A = @univ (subtype A),
      apply set.ext,
      intro x,
      simp,
      exact x.2,
    rw preimage_A_eq_univ,
    apply univ_inter,
  intro HU,
  cases HU with U HU,
  existsi U,
  apply and.intro HU.1,
  have H0 :  subtype.val '' V = subtype.val '' (subtype.val ⁻¹' U), by rw HU.2,
  rw H0,
  apply set.ext,
  intro x,
  simp,
  split,
    intro Hx,
    cases Hx with a Ha,
    rw ← Ha.2.2,
    apply and.intro Ha.2.1,
    exact Ha.1,
  intro Hx,
  existsi x,
  exact ⟨Hx.2, Hx.1, refl x⟩,
end

--Prop 10.4
theorem inclusion_cont_subtype_top {α : Type u} [X : topological_space α] (A : set α) : @continuous _ _ (subtype.topological_space) _ (λ (a : A), (a : α)) :=
begin
unfold continuous,
unfold is_open,
intros s Hs,
simp,
unfold subtype.topological_space,
unfold topological_space.induced,
simp,
existsi s,
apply and.intro Hs,
unfold coe,
unfold lift_t,
unfold has_lift_t.lift,
unfold coe_t,
unfold has_coe_t.coe,
unfold coe_b,
unfold has_coe.coe,
end

--Prop 10.4 but with subspace topology (I won't do any more with the subspace topology)
theorem inclusion_cont_subspace_top {α : Type u} [X : topological_space α] (A : set α) : @continuous _ _ (subspace_topology A) _ (λ (a : A), (a : α)) :=
begin
unfold continuous,
unfold is_open,
rw subspace_top_eq_subtype_top,
exact inclusion_cont_subtype_top A,
end

--Corollary 10.5
theorem restriction_cont {α : Type u} [X : topological_space α] {β : Type v} [Y : topological_space β]
(f : α → β) (H : continuous f) (A : set α) : continuous (λ (x : A), f x) :=
begin
  have H0 : (λ (x : A), f ↑x) = f ∘ (λ (a : A), (a : α)), by simp,
  rw H0,
  exact (continuous.comp (inclusion_cont_subtype_top A) H),
end

--Proposition 10.6
theorem inclusion_comp_cont_iff_cont {α : Type*} [X : topological_space α] {A : set α} {γ : Type*} [Z : topological_space γ]
(g : γ → A) : continuous g ↔ continuous ((λ (a : A), (a : α)) ∘ g) :=
begin
  split,
    intro Hg,
    exact continuous.comp Hg (inclusion_cont_subtype_top A),
  simp,
  unfold continuous,
  unfold is_open,
  intro H_i_comp_g,
  intros V HV,
  unfold subtype.topological_space at HV,
  unfold topological_space.induced at HV,
  simp at HV,
  cases HV with U HU,
  have H1 := H_i_comp_g U HU.1,
  rw HU.2,
  exact H1,
end

--Proposition 10.8
theorem inclusion_comp_cont_iff_cont_to_subtype_top {α : Type u} [X : topological_space α] {A : set α} (Trandom : topological_space A) :
(∀ {γ : Type u} [Z : topological_space γ]
(g : γ → A), (@continuous γ ↥A Z _ g ↔ @continuous γ α Z _ ((λ (a : A), (a : α)) ∘ g))) ↔ Trandom.is_open = (subtype.topological_space).is_open :=
begin
  split,
    swap,
    { intros H _ _ _,
      rw ←(@inclusion_comp_cont_iff_cont _ _ _ _ Z g),
      unfold continuous,
      unfold is_open,
      rw H,
    },
  intro H,
  apply set.ext, intro V, split,
    swap,
    have H1 := (@H (↥A) Trandom (@id A)).1 id_map_continuous,
    intro HV,
    unfold subtype.topological_space at HV, unfold topological_space.induced at HV, simp at HV,
    cases HV with U HU,
    have H2 :  Trandom.is_open (subtype.val ⁻¹' U),
      simp at H1, unfold continuous at H1,
      exact H1 U HU.1,
    rw ← HU.2 at H2, assumption,
  have H1 := (@H (↥A) subtype.topological_space (@id A)).2,
  simp at H1,
  intro HV,
  have H2 := H1 _,
     unfold continuous at H2,
  exact H2 V HV,

  exact continuous_subtype_val,
end

--Product Topologies
def product_top {α : Type*} {β : Type*} (X : topological_space α) (Y : topological_space β) : topological_space (α × β) :=
{is_open := λ (W : set (α × β)), ∃ (I ⊆ { b : set (α × β) | ∃ (U : set α) (V : set β),
  is_open U ∧ is_open V ∧ b = set.prod U V}), W = ⋃₀ I,
  is_open_univ := begin
    existsi {d : set (α × β) | d = set.prod univ univ},
    have H : set.subset {d : set (α × β) | d = set.prod univ univ} {b : set (α × β) | ∃ (U : set α) (V : set β), is_open U ∧ is_open V ∧   b = set.prod U V},
      rw univ_prod_univ,
      unfold set.subset,
      intros a Ha,
      rw mem_set_of_eq at Ha,
      rw Ha,
      existsi univ,
      existsi univ, apply and.intro is_open_univ, apply and.intro is_open_univ, rw univ_prod_univ,
    existsi H,
    rw univ_prod_univ,
    have H1 : {d : set (α × β) | d = univ} = {univ},
      apply set.ext,
      intro x, rw mem_set_of_eq, rw mem_singleton_iff,
    rw H1,
    rw sUnion_singleton,
  end,

  is_open_inter := begin
    intros W1 W2 HW1 HW2,
    cases HW1 with I1 HI1, cases HI1 with HI1 HWI1,
    cases HW2 with I2 HI2, cases HI2 with HI2 HWI2,
    existsi {e : set (α × β) | ∃ (U ∈ I1) (V ∈ I2), e = U ∩ V},
    have H : set.subset
        {e : set (α × β) | ∃ (U : set (α × β)) (H : U ∈ I1) (V : set (α × β)) (H : V ∈ I2), e = U ∩ V}
        {b : set (α × β) | ∃ (U : set α) (V : set β), is_open U ∧ is_open V ∧ b = set.prod U V},
      unfold set.subset,
      simp,
      intros a w1 Hw1 w2 Hw2 Ha,
      rw Ha,
      have H1 := HI1 Hw1, rw mem_set_of_eq at H1,
      have H2 := HI2 Hw2, rw mem_set_of_eq at H2,
      rcases H1 with ⟨U1, V1, HU1, HV1, H1UV⟩,
      rcases H2 with ⟨U2, V2, HU2, HV2, H2UV⟩,
      existsi (U1 ∩ U2), apply and.intro (X.is_open_inter U1 U2 HU1 HU2),
      existsi (V1 ∩ V2), apply and.intro (Y.is_open_inter V1 V2 HV1 HV2),
      rw H1UV, rw H2UV,
      apply prod_inter_prod,
    existsi H,
    rw HWI1, rw HWI2,
    apply set.ext,
    intro x,
    rw mem_set_of_eq, unfold set.inter, rw mem_set_of_eq, unfold set.sUnion, rw mem_set_of_eq, rw mem_set_of_eq,
    split,
      intro Hx,
      rcases Hx with ⟨HU, V, HV1, HV2⟩, rcases HU with ⟨U, HU1, HU2⟩,
      existsi (U ∩ V),
      existsi _,
      exact ⟨HU2, HV2⟩,
      rw mem_set_of_eq,
      existsi [U, HU1, V, HV1],
      trivial,
    intro Hx,
    rcases Hx with ⟨a, Ha1, Ha2⟩, rw mem_set_of_eq at Ha1, rcases Ha1 with ⟨U, HU, V, HV, HUV⟩,
    rw HUV at Ha2,
    split,
      existsi [U, HU],
      exact Ha2.1,
    existsi [V, HV],
    exact Ha2.2,
  end,
  is_open_sUnion := begin
    intros I2 HI2,
    let Iset := {I | set.subset I
      {b : set (α × β) | ∃ (U : set α) (V : set β), is_open U ∧ is_open V ∧ b = set.prod U V} ∧ (∃ t ∈ I2, t = ⋃₀ I)},
    existsi ⋃₀ Iset,
    existsi _,
    swap,
    intros x Hx,
    rw mem_set_of_eq at Hx, rcases Hx with ⟨a, Ha, Ha2⟩,
    rw mem_set_of_eq at Ha,
    exact Ha.1 Ha2,
    apply set.ext, intro s, simp,
    split,
      intro HW, rcases HW with ⟨W, HW, HW2⟩,
        have H := HI2 W HW,
        rcases H with ⟨IW, HIW, HIIW⟩,
        rw HIIW at HW2, rw mem_sUnion_eq at HW2, rcases HW2 with ⟨square, Hsquare, Hsquare_s⟩,
        existsi square, split, existsi IW, refine ⟨_, Hsquare⟩, rw HIIW at HW, refine ⟨_, HW⟩,
        have Hsame : {b : set (α × β) | ∃ (U : set α) (V : set β), is_open U ∧ is_open V ∧ b = set.prod U V} = {b : set (α × β) | ∃ (U : set α), is_open U ∧ ∃ (V : set β), is_open V ∧ b = set.prod U V},
          apply set.ext, intro x, simp,
        rw ←Hsame, exact HIW,
      exact Hsquare_s,
    intro HW, cases HW with W HW, cases HW with HW HsW, cases HW with I HI,
    existsi ⋃₀ I,
    refine ⟨HI.1.2, _⟩,
    rw mem_sUnion_eq,
    existsi W, existsi HI.2, exact HsW,
  end
}

--Product Topology Basis
definition product_top_basis {α : Type*} {β : Type*} (X : topological_space α) (Y : topological_space β) :
set (set (α × β)) := { b : set (α × β) | ∃ (U : set α) (V : set β),
  is_open U ∧ is_open V ∧ b = set.prod U V}

theorem is_basis_product_top_basis {α : Type*} {β : Type*} (X : topological_space α) (Y : topological_space β) :
@topological_space.is_topological_basis _ (product_top X Y) (product_top_basis X Y) :=
begin
  unfold topological_space.is_topological_basis, split,
    intros t1 Ht1 t2 Ht2 x Hx, unfold product_top_basis at Ht1, rw mem_set_of_eq at Ht1,
    unfold product_top_basis at Ht2, rw mem_set_of_eq at Ht2,
    rcases Ht1 with ⟨U1, V1, Ht1⟩, rcases Ht2 with ⟨U2, V2, Ht2⟩,
    existsi (set.prod (U1 ∩ U2) (V1 ∩ V2)),
    refine ⟨_,_⟩,
    unfold product_top_basis, rw mem_set_of_eq, existsi [U1 ∩ U2, V1 ∩ V2],
    exact ⟨is_open_inter Ht1.1 Ht2.1, is_open_inter Ht1.2.1 Ht2.2.1, refl (set.prod (U1 ∩ U2) (V1 ∩ V2))⟩,
    rw mem_prod, cases Hx with Hx1 Hx2, rw Ht1.2.2 at Hx1, rw Ht2.2.2 at Hx2, rw mem_prod at Hx1, rw mem_prod at Hx2,
    refine ⟨⟨⟨Hx1.1,Hx2.1⟩,Hx1.2,Hx2.2⟩,_⟩,
    rw Ht1.2.2, rw Ht2.2.2, intros y Hy, rw mem_prod at Hy, split,
    exact ⟨Hy.1.1, Hy.2.1⟩,
  exact ⟨Hy.1.2, Hy.2.2⟩,
  split,
    apply eq_univ_of_univ_subset, apply subset_sUnion_of_mem,
    existsi [univ, univ], apply and.intro is_open_univ, apply and.intro is_open_univ,
    rw ← univ_prod_univ,
    unfold product_top, unfold topological_space.generate_from,
    apply topological_space_eq,
    apply set.ext, intro W, split,
      intro HW, rcases HW with ⟨open_rects_set, Hopen_rects_set, HW⟩,
      unfold product_top_basis,
      rw HW,
      exact topological_space.generate_open.sUnion open_rects_set
      (λ (s : set (α × β)) (H : s ∈ open_rects_set),
      topological_space.generate_open.basic s (Hopen_rects_set H)),

    apply topological_space.generate_open.rec,
    --THIS IS THE CORRECT PATH
          intros s Hs,
          unfold product_top_basis at Hs,
          rcases Hs with ⟨U, V, HU, HV, HW⟩,
          existsi {set.prod U V},
          have H :  {set.prod U V} ⊆
              {b : set (α × β) | ∃ (U : set α) (V : set β), is_open U ∧ is_open V ∧ b = set.prod U V},
            intros s Hs, rw mem_singleton_iff at Hs, rw Hs,
            existsi [U, V],
            exact ⟨HU, HV, refl (set.prod U V)⟩,
          existsi H,
          rw sUnion_singleton,
          exact HW,
        existsi {univ},
        have H :  {univ} ⊆
              {b : set (α × β) | ∃ (U : set α) (V : set β), is_open U ∧ is_open V ∧ b = set.prod U V},
          intros UNI HUNI,
          existsi [univ, univ],
          rw mem_singleton_iff at HUNI, rw HUNI,
          apply and.intro is_open_univ, apply and.intro is_open_univ,
          exact eq.symm univ_prod_univ,
        existsi H,
        rw sUnion_singleton,
      intros s t Hs1 Ht1 Hs Ht,
      rcases Hs with ⟨Is, HIs, HsUnionIs⟩,
      rcases Ht with ⟨It, HIt, HsUnionIt⟩,
      apply is_open_inter,
        existsi [Is, HIs], assumption,
      existsi [It, HIt], assumption,
    intros I HI_gen_prod_top_bas HI_open_sets,
    -- WHat set do I need? The set that contains all open rectangles appearing in any element of I
    existsi { b : set (α × β) | (∃ (U : set α) (V : set β),
             is_open U ∧ is_open V ∧ b = set.prod U V) ∧ ∃ s ∈ I, b ⊆ s},
    existsi _, swap,
      intros x Hx, rw mem_set_of_eq, rw mem_set_of_eq at Hx,
      cases Hx with Hx1 Hx2, exact Hx1,
    apply eq_of_subset_of_subset,
      intros x Hx,
      rw mem_sUnion_eq at Hx,
      rcases Hx with ⟨t, Ht, Hxt⟩,
 -- Need to existsi the open rectangle that x is in
      have H := HI_open_sets t Ht, cases H with It HIt, cases HIt with HIt HIt2,
      rw HIt2 at Hxt, rcases Hxt with ⟨rect,rectIt,xrect⟩,
      existsi rect, refine ⟨⟨HIt rectIt,_⟩, _⟩,
        existsi [t, Ht],
        rw HIt2, apply subset_sUnion_of_mem rectIt,
      exact xrect,
    apply sUnion_subset,
    intros t Ht,
    cases Ht, rcases Ht_right, cases Ht_right_h,
    apply subset.trans Ht_right_h_h (subset_sUnion_of_mem Ht_right_h_w),
end

--Proof that our definition of product top is equivalent to the instance built into mathlib.
theorem product_top_eq_induced_prod_top {α : Type*} {β : Type*} (X : topological_space α) (Y : topological_space β) :
product_top X Y = topological_space.induced prod.fst X ⊔ topological_space.induced prod.snd Y :=
begin
  apply topological_space_eq,
  unfold product_top, unfold lattice.has_sup.sup, unfold semilattice_sup.sup, unfold semilattice_sup_bot.sup,
  unfold bounded_lattice.sup, unfold complete_lattice.sup, unfold Inf, unfold has_Inf.Inf,
  simp only [exists_prop, mem_set_of_eq, not_and, and_imp],
  apply set.ext,
  intro U, split,
    intro HU, rcases HU with ⟨I_U,HI_U,HI_U2⟩,
    intros T HXT HYT,
    unfold has_le.le at HXT, unfold preorder.le at HXT, unfold partial_order.le at HXT, unfold has_le.le at HXT, unfold preorder.le at HXT, unfold has_le.le at HXT, unfold preorder.le at HXT, unfold partial_order.le at HXT, unfold order_bot.le at HXT, unfold bounded_lattice.le at HXT, unfold complete_lattice.le at HXT, unfold bounded_lattice.le at HXT,
    --THe following should be each prod U1 univ, prod univ V1 for all rectangles prod U1 V1
    --in U. Then intersect each pair and union them.
    rw HI_U2,
    apply is_open_sUnion,
    intros rect Hrect,
    --Split rect into the intersection of prod U1 univ and prod univ V1
    have Hrect2 := HI_U Hrect,
    rcases Hrect2 with ⟨Urect,Vrect,HUrect,HVrect,HUrectVrect⟩,
    have HUrectuniv : topological_space.is_open T (set.prod Urect univ),
      apply HXT, existsi Urect, split,
        exact HUrect,
      unfold preimage,
      apply set.ext, intro x,
      rw mem_set_of_eq, rw mem_prod,
      rw and_iff_left, exact mem_univ _,
    have HunivVrect : topological_space.is_open T (set.prod univ Vrect),
      apply HYT, existsi Vrect, split,
        exact HVrect,
      unfold preimage,
      apply set.ext, intro x,
      rw mem_set_of_eq, rw mem_prod,
      rw and_iff_right, exact mem_univ _,
    have H_open_rect := T.is_open_inter _ _ HUrectuniv HunivVrect,
    have Hrect_prod : set.prod Urect univ ∩ set.prod univ Vrect = rect,
      rw prod_inter_prod,
      rw inter_univ, rw univ_inter, rw HUrectVrect,
    rw Hrect_prod at H_open_rect,
    exact H_open_rect,
  intro HU,
  have H := HU (product_top X Y),
  have HX : topological_space.induced prod.fst X ≤ product_top X Y,
    intros V HV, unfold topological_space.induced at HV, cases HV with S HS, cases HS with HS HV,
    unfold preimage at HV, rw HV,
    existsi {set.prod S univ}, existsi _,
      rw sUnion_singleton, apply set.ext, intro x, rw mem_set_of_eq,rw mem_prod, rw and_iff_left, exact mem_univ _,
    intros x Hx, existsi S, existsi univ, exact ⟨HS, is_open_univ, mem_singleton_iff.1 Hx⟩,
  have HY :  topological_space.induced prod.snd Y ≤ product_top X Y,
    intros V HV, cases HV with S HS, cases HS with HS HV, unfold preimage at HV, rw HV,
    existsi {set.prod univ S}, existsi _,
      rw sUnion_singleton, apply set.ext, intro x, rw mem_set_of_eq, rw mem_prod, rw and_iff_right, exact mem_univ _,
    intros x Hx, existsi univ, existsi S, exact ⟨is_open_univ, HS, mem_singleton_iff.1 Hx⟩,
  have H1 := H HX HY,
  unfold product_top at H1,
   simp only [exists_prop, mem_set_of_eq, not_and, and_imp] at H1,
  exact H1,
end

#print prefix set
--Proposition 10.10
theorem left_proj_cont {α : Type*} {β : Type*} (X : topological_space α) (Y : topological_space β)
: @continuous (α × β) α (product_top X Y) X (λ p, p.1) :=
begin
  unfold continuous,
  unfold is_open,
  intros s Hs,
  unfold product_top,
  existsi {set.prod s (univ : set β)}, split,
    intros pre Hpre, rw mem_singleton_iff at Hpre, rw Hpre,
    rw mem_set_of_eq, existsi [s, univ], exact ⟨Hs, Y.is_open_univ, rfl⟩,
  apply set.ext, intro x, rw mem_preimage_eq, rw sUnion_singleton, rw mem_prod,
  rw and_iff_left, exact mem_univ x.snd,
end

theorem right_proj_cont {α : Type*} {β : Type*} (X : topological_space α) (Y : topological_space β)
: @continuous (α × β) β (product_top X Y) Y (λ p, p.2) :=
begin
  unfold continuous,
  unfold is_open,
  intros s Hs,
  unfold product_top,
  existsi {set.prod (univ : set α) s}, split,
    intros pre Hpre, rw @mem_singleton_iff at Hpre, rw Hpre,
    rw mem_set_of_eq, existsi [univ, s], exact ⟨X.is_open_univ, Hs, rfl⟩,
  apply set.ext, intro x, rw mem_preimage_eq, rw sUnion_singleton, rw mem_prod,
  rw and_iff_right, exact mem_univ x.fst,
end

--set_option pp.implicit true
set_option trace.simplify.rewrite true

theorem cont_iff_proj_cont {α : Type*} {β : Type*} {γ : Type*} (X : topological_space α)
(Y : topological_space β) (Z : topological_space γ) (f : γ → (α × β)) :
@continuous _ _ Z (product_top X Y) f ↔ (continuous ((λ (p : α × β), p.2) ∘ f) ∧ continuous ((λ (p : α × β), p.1) ∘ f)) :=
begin
    split,
    intro Hf, split,
      exact @continuous.comp _ _ _ _ (product_top X Y) _ _ _ Hf (right_proj_cont X Y),
    exact @continuous.comp _ _ _ _ (product_top X Y) _ _ _ Hf (left_proj_cont X Y),
  intro Hf,
  apply continuous_basis_to_continuous,
  apply is_basis_product_top_basis,
  intro b,
  unfold product_top_basis at b, rename b b1,
  rcases b.property with ⟨U, V, HU, HV,HB⟩,
  cases Hf with Hfsnd Hffst,
  have Hsnd := Hfsnd V HV,
  have Hfst := Hffst U HU,
  have H1 := is_open_inter Hfst Hsnd,
  have EQ : (λ (p : α × β), p.fst) ∘ f ⁻¹' U ∩ (λ (p : α × β), p.snd) ∘ f ⁻¹' V = (f ⁻¹' ↑b),
    rw preimage_comp, rw @preimage_comp _ _ _  f (λ (p : α × β), p.snd) _,
    rw ← preimage_inter,
    have H2 : prod.fst ⁻¹' U = set.prod U univ,
      apply set.ext, intro x, split,
        intro Hx, rw mem_preimage_eq at Hx, split, exact Hx, exact @mem_univ β x.snd,
      intro Hx, rw mem_preimage_eq, exact Hx.1,
    rw H2,
    have H3 : prod.snd ⁻¹' V = set.prod univ V,
      apply set.ext, intro x, split,
        intro Hx, rw mem_preimage_eq at Hx, split, exact @mem_univ α x.fst, exact Hx,
      intro Hx, rw mem_preimage_eq, exact Hx.2,
    rw H3,
    rw prod_inter_prod,
    rw inter_univ, rw univ_inter, rw ← HB,
    have H4 : b.val = ↑b,
      trivial,
    rw H4,
  rw ← EQ,
  exact H1,
end


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

! This file was ported from Lean 3 source module probability.martingale.centering
! leanprover-community/mathlib commit bea6c853b6edbd15e9d0941825abd04d77933ed0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Probability.Martingale.Basic

/-!
# Centering lemma for stochastic processes

Any `ℕ`-indexed stochastic process which is adapted and integrable can be written as the sum of a
martingale and a predictable process. This result is also known as **Doob's decomposition theorem**.
From a process `f`, a filtration `ℱ` and a measure `μ`, we define two processes
`martingale_part f ℱ μ` and `predictable_part f ℱ μ`.

## Main definitions

* `measure_theory.predictable_part f ℱ μ`: a predictable process such that
  `f = predictable_part f ℱ μ + martingale_part f ℱ μ`
* `measure_theory.martingale_part f ℱ μ`: a martingale such that
  `f = predictable_part f ℱ μ + martingale_part f ℱ μ`

## Main statements

* `measure_theory.adapted_predictable_part`: `(λ n, predictable_part f ℱ μ (n+1))` is adapted. That
  is, `predictable_part` is predictable.
* `measure_theory.martingale_martingale_part`: `martingale_part f ℱ μ` is a martingale.

-/

open TopologicalSpace Filter

open NNReal ENNReal MeasureTheory ProbabilityTheory BigOperators

namespace MeasureTheory

variable {Ω E : Type _} {m0 : MeasurableSpace Ω} {μ : Measure Ω} [NormedAddCommGroup E]
  [NormedSpace ℝ E] [CompleteSpace E] {f : ℕ → Ω → E} {ℱ : Filtration ℕ m0} {n : ℕ}

/-- Any `ℕ`-indexed stochastic process can be written as the sum of a martingale and a predictable
process. This is the predictable process. See `martingale_part` for the martingale. -/
noncomputable def predictablePart {m0 : MeasurableSpace Ω} (f : ℕ → Ω → E) (ℱ : Filtration ℕ m0)
    (μ : Measure Ω := by exact MeasureTheory.MeasureSpace.volume) : ℕ → Ω → E := fun n =>
  ∑ i in Finset.range n, μ[f (i + 1) - f i|ℱ i]
#align measure_theory.predictable_part MeasureTheory.predictablePart

@[simp]
theorem predictablePart_zero : predictablePart f ℱ μ 0 = 0 := by
  simp_rw [predictable_part, Finset.range_zero, Finset.sum_empty]
#align measure_theory.predictable_part_zero MeasureTheory.predictablePart_zero

theorem adapted_predictablePart : Adapted ℱ fun n => predictablePart f ℱ μ (n + 1) := fun n =>
  Finset.stronglyMeasurable_sum' _ fun i hin =>
    stronglyMeasurable_condexp.mono (ℱ.mono (Finset.mem_range_succ_iff.mp hin))
#align measure_theory.adapted_predictable_part MeasureTheory.adapted_predictablePart

theorem adapted_predictable_part' : Adapted ℱ fun n => predictablePart f ℱ μ n := fun n =>
  Finset.stronglyMeasurable_sum' _ fun i hin =>
    stronglyMeasurable_condexp.mono (ℱ.mono (Finset.mem_range_le hin))
#align measure_theory.adapted_predictable_part' MeasureTheory.adapted_predictable_part'

/-- Any `ℕ`-indexed stochastic process can be written as the sum of a martingale and a predictable
process. This is the martingale. See `predictable_part` for the predictable process. -/
noncomputable def martingalePart {m0 : MeasurableSpace Ω} (f : ℕ → Ω → E) (ℱ : Filtration ℕ m0)
    (μ : Measure Ω := by exact MeasureTheory.MeasureSpace.volume) : ℕ → Ω → E := fun n =>
  f n - predictablePart f ℱ μ n
#align measure_theory.martingale_part MeasureTheory.martingalePart

theorem martingalePart_add_predictablePart (ℱ : Filtration ℕ m0) (μ : Measure Ω) (f : ℕ → Ω → E) :
    martingalePart f ℱ μ + predictablePart f ℱ μ = f :=
  sub_add_cancel _ _
#align measure_theory.martingale_part_add_predictable_part MeasureTheory.martingalePart_add_predictablePart

theorem martingalePart_eq_sum :
    martingalePart f ℱ μ = fun n =>
      f 0 + ∑ i in Finset.range n, f (i + 1) - f i - μ[f (i + 1) - f i|ℱ i] :=
  by
  rw [martingale_part, predictable_part]
  ext1 n
  rw [Finset.eq_sum_range_sub f n, ← add_sub, ← Finset.sum_sub_distrib]
#align measure_theory.martingale_part_eq_sum MeasureTheory.martingalePart_eq_sum

theorem adapted_martingalePart (hf : Adapted ℱ f) : Adapted ℱ (martingalePart f ℱ μ) :=
  Adapted.sub hf adapted_predictable_part'
#align measure_theory.adapted_martingale_part MeasureTheory.adapted_martingalePart

theorem integrableMartingalePart (hf_int : ∀ n, Integrable (f n) μ) (n : ℕ) :
    Integrable (martingalePart f ℱ μ n) μ :=
  by
  rw [martingale_part_eq_sum]
  exact
    (hf_int 0).add
      (integrable_finset_sum' _ fun i hi => ((hf_int _).sub (hf_int _)).sub integrable_condexp)
#align measure_theory.integrable_martingale_part MeasureTheory.integrableMartingalePart

theorem martingaleMartingalePart (hf : Adapted ℱ f) (hf_int : ∀ n, Integrable (f n) μ)
    [SigmaFiniteFiltration μ ℱ] : Martingale (martingalePart f ℱ μ) ℱ μ :=
  by
  refine' ⟨adapted_martingale_part hf, fun i j hij => _⟩
  -- ⊢ μ[martingale_part f ℱ μ j | ℱ i] =ᵐ[μ] martingale_part f ℱ μ i
  have h_eq_sum :
    μ[martingale_part f ℱ μ j|ℱ i] =ᵐ[μ]
      f 0 + ∑ k in Finset.range j, μ[f (k + 1) - f k|ℱ i] - μ[μ[f (k + 1) - f k|ℱ k]|ℱ i] :=
    by
    rw [martingale_part_eq_sum]
    refine' (condexp_add (hf_int 0) _).trans _
    · exact integrable_finset_sum' _ fun i hij => ((hf_int _).sub (hf_int _)).sub integrable_condexp
    refine' (eventually_eq.add eventually_eq.rfl (condexp_finset_sum fun i hij => _)).trans _
    · exact ((hf_int _).sub (hf_int _)).sub integrable_condexp
    refine' eventually_eq.add _ _
    · rw [condexp_of_strongly_measurable (ℱ.le _) _ (hf_int 0)]
      · infer_instance
      · exact (hf 0).mono (ℱ.mono (zero_le i))
    · exact eventuallyEq_sum fun k hkj => condexp_sub ((hf_int _).sub (hf_int _)) integrable_condexp
  refine' h_eq_sum.trans _
  have h_ge : ∀ k, i ≤ k → μ[f (k + 1) - f k|ℱ i] - μ[μ[f (k + 1) - f k|ℱ k]|ℱ i] =ᵐ[μ] 0 :=
    by
    intro k hk
    have : μ[μ[f (k + 1) - f k|ℱ k]|ℱ i] =ᵐ[μ] μ[f (k + 1) - f k|ℱ i] :=
      condexp_condexp_of_le (ℱ.mono hk) (ℱ.le k)
    filter_upwards [this]with x hx
    rw [Pi.sub_apply, Pi.zero_apply, hx, sub_self]
  have h_lt :
    ∀ k,
      k < i →
        μ[f (k + 1) - f k|ℱ i] - μ[μ[f (k + 1) - f k|ℱ k]|ℱ i] =ᵐ[μ]
          f (k + 1) - f k - μ[f (k + 1) - f k|ℱ k] :=
    by
    refine' fun k hk => eventually_eq.sub _ _
    · rw [condexp_of_strongly_measurable]
      · exact ((hf (k + 1)).mono (ℱ.mono (Nat.succ_le_of_lt hk))).sub ((hf k).mono (ℱ.mono hk.le))
      · exact (hf_int _).sub (hf_int _)
    · rw [condexp_of_strongly_measurable]
      · exact strongly_measurable_condexp.mono (ℱ.mono hk.le)
      · exact integrable_condexp
  rw [martingale_part_eq_sum]
  refine' eventually_eq.add eventually_eq.rfl _
  rw [← Finset.sum_range_add_sum_Ico _ hij, ←
    add_zero (∑ i in Finset.range i, f (i + 1) - f i - μ[f (i + 1) - f i|ℱ i])]
  refine' (eventuallyEq_sum fun k hk => h_lt k (finset.mem_range.mp hk)).add _
  refine' (eventuallyEq_sum fun k hk => h_ge k (finset.mem_Ico.mp hk).1).trans _
  simp only [Finset.sum_const_zero, Pi.zero_apply]
  rfl
#align measure_theory.martingale_martingale_part MeasureTheory.martingaleMartingalePart

-- The following two lemmas demonstrate the essential uniqueness of the decomposition
theorem martingalePart_add_ae_eq [SigmaFiniteFiltration μ ℱ] {f g : ℕ → Ω → E}
    (hf : Martingale f ℱ μ) (hg : Adapted ℱ fun n => g (n + 1)) (hg0 : g 0 = 0)
    (hgint : ∀ n, Integrable (g n) μ) (n : ℕ) : martingalePart (f + g) ℱ μ n =ᵐ[μ] f n :=
  by
  set h := f - martingale_part (f + g) ℱ μ with hhdef
  have hh : h = predictable_part (f + g) ℱ μ - g := by
    rw [hhdef, sub_eq_sub_iff_add_eq_add, add_comm (predictable_part (f + g) ℱ μ),
      martingale_part_add_predictable_part]
  have hhpred : adapted ℱ fun n => h (n + 1) :=
    by
    rw [hh]
    exact adapted_predictable_part.sub hg
  have hhmgle : martingale h ℱ μ :=
    hf.sub
      (martingale_martingale_part
        (hf.adapted.add <| predictable.adapted hg <| hg0.symm ▸ strongly_measurable_zero) fun n =>
        (hf.integrable n).add <| hgint n)
  refine' (eventually_eq_iff_sub.2 _).symm
  filter_upwards [hhmgle.eq_zero_of_predictable hhpred n]with ω hω
  rw [hhdef, Pi.sub_apply] at hω
  rw [hω, Pi.sub_apply, martingale_part]
  simp [hg0]
#align measure_theory.martingale_part_add_ae_eq MeasureTheory.martingalePart_add_ae_eq

theorem predictablePart_add_ae_eq [SigmaFiniteFiltration μ ℱ] {f g : ℕ → Ω → E}
    (hf : Martingale f ℱ μ) (hg : Adapted ℱ fun n => g (n + 1)) (hg0 : g 0 = 0)
    (hgint : ∀ n, Integrable (g n) μ) (n : ℕ) : predictablePart (f + g) ℱ μ n =ᵐ[μ] g n :=
  by
  filter_upwards [martingale_part_add_ae_eq hf hg hg0 hgint n]with ω hω
  rw [← add_right_inj (f n ω)]
  conv_rhs =>
    rw [← Pi.add_apply, ← Pi.add_apply, ← martingale_part_add_predictable_part ℱ μ (f + g)]
  rw [Pi.add_apply, Pi.add_apply, hω]
#align measure_theory.predictable_part_add_ae_eq MeasureTheory.predictablePart_add_ae_eq

section Difference

theorem predictablePart_bdd_difference {R : ℝ≥0} {f : ℕ → Ω → ℝ} (ℱ : Filtration ℕ m0)
    (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) :
    ∀ᵐ ω ∂μ, ∀ i, |predictablePart f ℱ μ (i + 1) ω - predictablePart f ℱ μ i ω| ≤ R :=
  by
  simp_rw [predictable_part, Finset.sum_apply, Finset.sum_range_succ_sub_sum]
  exact ae_all_iff.2 fun i => ae_bdd_condexp_of_ae_bdd <| ae_all_iff.1 hbdd i
#align measure_theory.predictable_part_bdd_difference MeasureTheory.predictablePart_bdd_difference

theorem martingalePart_bdd_difference {R : ℝ≥0} {f : ℕ → Ω → ℝ} (ℱ : Filtration ℕ m0)
    (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) :
    ∀ᵐ ω ∂μ, ∀ i, |martingalePart f ℱ μ (i + 1) ω - martingalePart f ℱ μ i ω| ≤ ↑(2 * R) :=
  by
  filter_upwards [hbdd, predictable_part_bdd_difference ℱ hbdd]with ω hω₁ hω₂ i
  simp only [two_mul, martingale_part, Pi.sub_apply]
  have :
    |f (i + 1) ω - predictable_part f ℱ μ (i + 1) ω - (f i ω - predictable_part f ℱ μ i ω)| =
      |f (i + 1) ω - f i ω - (predictable_part f ℱ μ (i + 1) ω - predictable_part f ℱ μ i ω)| :=
    by ring_nf
  -- `ring` suggests `ring_nf` despite proving the goal
  rw [this]
  exact (abs_sub _ _).trans (add_le_add (hω₁ i) (hω₂ i))
#align measure_theory.martingale_part_bdd_difference MeasureTheory.martingalePart_bdd_difference

end Difference

end MeasureTheory


-- CS menor o igual que cero
-- =========================

import data.real.basic
variable (x : ℝ)

-- 1ª demostración
example :
  (∀ ε > 0, x ≤ ε) → x ≤ 0 :=
begin
  contrapose,
  push_neg,
  intro h,
  use x/2,
  split ; linarith,
end

-- 2ª demostración
example :
  (∀ ε > 0, x ≤ ε) → x ≤ 0 :=
begin
  contrapose!,
  intro h,
  use x/2,
  split ; linarith,
end


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Heather Macbeth

! This file was ported from Lean 3 source module topology.continuous_function.stone_weierstrass
! 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.Topology.ContinuousFunction.Weierstrass
import Mathbin.Data.IsROrC.Basic

/-!
# The Stone-Weierstrass theorem

If a subalgebra `A` of `C(X, ℝ)`, where `X` is a compact topological space,
separates points, then it is dense.

We argue as follows.

* In any subalgebra `A` of `C(X, ℝ)`, if `f ∈ A`, then `abs f ∈ A.topological_closure`.
  This follows from the Weierstrass approximation theorem on `[-‖f‖, ‖f‖]` by
  approximating `abs` uniformly thereon by polynomials.
* This ensures that `A.topological_closure` is actually a sublattice:
  if it contains `f` and `g`, then it contains the pointwise supremum `f ⊔ g`
  and the pointwise infimum `f ⊓ g`.
* Any nonempty sublattice `L` of `C(X, ℝ)` which separates points is dense,
  by a nice argument approximating a given `f` above and below using separating functions.
  For each `x y : X`, we pick a function `g x y ∈ L` so `g x y x = f x` and `g x y y = f y`.
  By continuity these functions remain close to `f` on small patches around `x` and `y`.
  We use compactness to identify a certain finitely indexed infimum of finitely indexed supremums
  which is then close to `f` everywhere, obtaining the desired approximation.
* Finally we put these pieces together. `L = A.topological_closure` is a nonempty sublattice
  which separates points since `A` does, and so is dense (in fact equal to `⊤`).

We then prove the complex version for self-adjoint subalgebras `A`, by separately approximating
the real and imaginary parts using the real subalgebra of real-valued functions in `A`
(which still separates points, by taking the norm-square of a separating function).

## Future work

Extend to cover the case of subalgebras of the continuous functions vanishing at infinity,
on non-compact spaces.

-/

noncomputable section

namespace ContinuousMap

variable {X : Type _} [TopologicalSpace X] [CompactSpace X]

open Polynomial

/-- Turn a function `f : C(X, ℝ)` into a continuous map into `set.Icc (-‖f‖) (‖f‖)`,
thereby explicitly attaching bounds.
-/
def attachBound (f : C(X, ℝ)) : C(X, Set.Icc (-‖f‖) ‖f‖)
    where toFun x := ⟨f x, ⟨neg_norm_le_apply f x, apply_le_norm f x⟩⟩
#align continuous_map.attach_bound ContinuousMap.attachBound

@[simp]
theorem attachBound_apply_coe (f : C(X, ℝ)) (x : X) : ((attachBound f) x : ℝ) = f x :=
  rfl
#align continuous_map.attach_bound_apply_coe ContinuousMap.attachBound_apply_coe

theorem polynomial_comp_attachBound (A : Subalgebra ℝ C(X, ℝ)) (f : A) (g : ℝ[X]) :
    (g.toContinuousMapOn (Set.Icc (-‖f‖) ‖f‖)).comp (f : C(X, ℝ)).attachBound =
      Polynomial.aeval f g :=
  by
  ext
  simp only [ContinuousMap.coe_comp, Function.comp_apply, ContinuousMap.attachBound_apply_coe,
    Polynomial.toContinuousMapOn_apply, Polynomial.aeval_subalgebra_coe,
    Polynomial.aeval_continuousMap_apply, Polynomial.toContinuousMap_apply]
#align continuous_map.polynomial_comp_attach_bound ContinuousMap.polynomial_comp_attachBound

/-- Given a continuous function `f` in a subalgebra of `C(X, ℝ)`, postcomposing by a polynomial
gives another function in `A`.

This lemma proves something slightly more subtle than this:
we take `f`, and think of it as a function into the restricted target `set.Icc (-‖f‖) ‖f‖)`,
and then postcompose with a polynomial function on that interval.
This is in fact the same situation as above, and so also gives a function in `A`.
-/
theorem polynomial_comp_attachBound_mem (A : Subalgebra ℝ C(X, ℝ)) (f : A) (g : ℝ[X]) :
    (g.toContinuousMapOn (Set.Icc (-‖f‖) ‖f‖)).comp (f : C(X, ℝ)).attachBound ∈ A :=
  by
  rw [polynomial_comp_attach_bound]
  apply SetLike.coe_mem
#align continuous_map.polynomial_comp_attach_bound_mem ContinuousMap.polynomial_comp_attachBound_mem

theorem comp_attachBound_mem_closure (A : Subalgebra ℝ C(X, ℝ)) (f : A)
    (p : C(Set.Icc (-‖f‖) ‖f‖, ℝ)) : p.comp (attachBound f) ∈ A.topologicalClosure :=
  by
  -- `p` itself is in the closure of polynomials, by the Weierstrass theorem,
  have mem_closure : p ∈ (polynomialFunctions (Set.Icc (-‖f‖) ‖f‖)).topologicalClosure :=
    continuousMap_mem_polynomialFunctions_closure _ _ p
  -- and so there are polynomials arbitrarily close.
  have frequently_mem_polynomials := mem_closure_iff_frequently.mp mem_closure
  -- To prove `p.comp (attached_bound f)` is in the closure of `A`,
  -- we show there are elements of `A` arbitrarily close.
  apply mem_closure_iff_frequently.mpr
  -- To show that, we pull back the polynomials close to `p`,
  refine'
    ((comp_right_continuous_map ℝ (attach_bound (f : C(X, ℝ)))).ContinuousAt
            p).Tendsto.frequently_map
      _ _ frequently_mem_polynomials
  -- but need to show that those pullbacks are actually in `A`.
  rintro _ ⟨g, ⟨-, rfl⟩⟩
  simp only [SetLike.mem_coe, AlgHom.coe_toRingHom, comp_right_continuous_map_apply,
    Polynomial.toContinuousMapOnAlgHom_apply]
  apply polynomial_comp_attach_bound_mem
#align continuous_map.comp_attach_bound_mem_closure ContinuousMap.comp_attachBound_mem_closure

theorem abs_mem_subalgebra_closure (A : Subalgebra ℝ C(X, ℝ)) (f : A) :
    (f : C(X, ℝ)).abs ∈ A.topologicalClosure :=
  by
  let M := ‖f‖
  let f' := attach_bound (f : C(X, ℝ))
  let abs : C(Set.Icc (-‖f‖) ‖f‖, ℝ) := { toFun := fun x : Set.Icc (-‖f‖) ‖f‖ => |(x : ℝ)| }
  change abs.comp f' ∈ A.topological_closure
  apply comp_attach_bound_mem_closure
#align continuous_map.abs_mem_subalgebra_closure ContinuousMap.abs_mem_subalgebra_closure

theorem inf_mem_subalgebra_closure (A : Subalgebra ℝ C(X, ℝ)) (f g : A) :
    (f : C(X, ℝ)) ⊓ (g : C(X, ℝ)) ∈ A.topologicalClosure :=
  by
  rw [inf_eq]
  refine'
    A.topological_closure.smul_mem
      (A.topological_closure.sub_mem
        (A.topological_closure.add_mem (A.le_topological_closure f.property)
          (A.le_topological_closure g.property))
        _)
      _
  exact_mod_cast abs_mem_subalgebra_closure A _
#align continuous_map.inf_mem_subalgebra_closure ContinuousMap.inf_mem_subalgebra_closure

theorem inf_mem_closed_subalgebra (A : Subalgebra ℝ C(X, ℝ)) (h : IsClosed (A : Set C(X, ℝ)))
    (f g : A) : (f : C(X, ℝ)) ⊓ (g : C(X, ℝ)) ∈ A :=
  by
  convert inf_mem_subalgebra_closure A f g
  apply SetLike.ext'
  symm
  erw [closure_eq_iff_isClosed]
  exact h
#align continuous_map.inf_mem_closed_subalgebra ContinuousMap.inf_mem_closed_subalgebra

theorem sup_mem_subalgebra_closure (A : Subalgebra ℝ C(X, ℝ)) (f g : A) :
    (f : C(X, ℝ)) ⊔ (g : C(X, ℝ)) ∈ A.topologicalClosure :=
  by
  rw [sup_eq]
  refine'
    A.topological_closure.smul_mem
      (A.topological_closure.add_mem
        (A.topological_closure.add_mem (A.le_topological_closure f.property)
          (A.le_topological_closure g.property))
        _)
      _
  exact_mod_cast abs_mem_subalgebra_closure A _
#align continuous_map.sup_mem_subalgebra_closure ContinuousMap.sup_mem_subalgebra_closure

theorem sup_mem_closed_subalgebra (A : Subalgebra ℝ C(X, ℝ)) (h : IsClosed (A : Set C(X, ℝ)))
    (f g : A) : (f : C(X, ℝ)) ⊔ (g : C(X, ℝ)) ∈ A :=
  by
  convert sup_mem_subalgebra_closure A f g
  apply SetLike.ext'
  symm
  erw [closure_eq_iff_isClosed]
  exact h
#align continuous_map.sup_mem_closed_subalgebra ContinuousMap.sup_mem_closed_subalgebra

open Topology

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (f g «expr ∈ » L) -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (f g «expr ∈ » L) -/
-- Here's the fun part of Stone-Weierstrass!
theorem sublattice_closure_eq_top (L : Set C(X, ℝ)) (nA : L.Nonempty)
    (inf_mem : ∀ (f) (_ : f ∈ L) (g) (_ : g ∈ L), f ⊓ g ∈ L)
    (sup_mem : ∀ (f) (_ : f ∈ L) (g) (_ : g ∈ L), f ⊔ g ∈ L) (sep : L.SeparatesPointsStrongly) :
    closure L = ⊤ :=
  by
  -- We start by boiling down to a statement about close approximation.
  apply eq_top_iff.mpr
  rintro f -
  refine'
    Filter.Frequently.mem_closure
      ((Filter.HasBasis.frequently_iff Metric.nhds_basis_ball).mpr fun ε pos => _)
  simp only [exists_prop, Metric.mem_ball]
  -- It will be helpful to assume `X` is nonempty later,
  -- so we get that out of the way here.
  by_cases nX : Nonempty X
  swap
  exact ⟨nA.some, (dist_lt_iff Pos).mpr fun x => False.elim (nX ⟨x⟩), nA.some_spec⟩
  /-
    The strategy now is to pick a family of continuous functions `g x y` in `A`
    with the property that `g x y x = f x` and `g x y y = f y`
    (this is immediate from `h : separates_points_strongly`)
    then use continuity to see that `g x y` is close to `f` near both `x` and `y`,
    and finally using compactness to produce the desired function `h`
    as a maximum over finitely many `x` of a minimum over finitely many `y` of the `g x y`.
    -/
  dsimp [Set.SeparatesPointsStrongly] at sep
  let g : X → X → L := fun x y => (sep f x y).some
  have w₁ : ∀ x y, g x y x = f x := fun x y => (sep f x y).choose_spec.1
  have w₂ : ∀ x y, g x y y = f y := fun x y => (sep f x y).choose_spec.2
  -- For each `x y`, we define `U x y` to be `{z | f z - ε < g x y z}`,
  -- and observe this is a neighbourhood of `y`.
  let U : X → X → Set X := fun x y => { z | f z - ε < g x y z }
  have U_nhd_y : ∀ x y, U x y ∈ 𝓝 y := by
    intro x y
    refine' IsOpen.mem_nhds _ _
    · apply isOpen_lt <;> continuity
    · rw [Set.mem_setOf_eq, w₂]
      exact sub_lt_self _ Pos
  -- Fixing `x` for a moment, we have a family of functions `λ y, g x y`
  -- which on different patches (the `U x y`) are greater than `f z - ε`.
  -- Taking the supremum of these functions
  -- indexed by a finite collection of patches which cover `X`
  -- will give us an element of `A` that is globally greater than `f z - ε`
  -- and still equal to `f x` at `x`.
  -- Since `X` is compact, for every `x` there is some finset `ys t`
  -- so the union of the `U x y` for `y ∈ ys x` still covers everything.
  let ys : ∀ x, Finset X := fun x => (CompactSpace.elim_nhds_subcover (U x) (U_nhd_y x)).some
  let ys_w : ∀ x, (⋃ y ∈ ys x, U x y) = ⊤ := fun x =>
    (CompactSpace.elim_nhds_subcover (U x) (U_nhd_y x)).choose_spec
  have ys_nonempty : ∀ x, (ys x).Nonempty := fun x =>
    Set.nonempty_of_union_eq_top_of_nonempty _ _ nX (ys_w x)
  -- Thus for each `x` we have the desired `h x : A` so `f z - ε < h x z` everywhere
  -- and `h x x = f x`.
  let h : ∀ x, L := fun x =>
    ⟨(ys x).sup' (ys_nonempty x) fun y => (g x y : C(X, ℝ)),
      Finset.sup'_mem _ sup_mem _ _ _ fun y _ => (g x y).2⟩
  have lt_h : ∀ x z, f z - ε < h x z := by
    intro x z
    obtain ⟨y, ym, zm⟩ := Set.exists_set_mem_of_union_eq_top _ _ (ys_w x) z
    dsimp [h]
    simp only [coeFn_coe_base', Subtype.coe_mk, sup'_coe, Finset.sup'_apply, Finset.lt_sup'_iff]
    exact ⟨y, ym, zm⟩
  have h_eq : ∀ x, h x x = f x := by
    intro x
    simp only [coeFn_coe_base'] at w₁
    simp [coeFn_coe_base', w₁]
  -- For each `x`, we define `W x` to be `{z | h x z < f z + ε}`,
  let W : ∀ x, Set X := fun x => { z | h x z < f z + ε }
  -- This is still a neighbourhood of `x`.
  have W_nhd : ∀ x, W x ∈ 𝓝 x := by
    intro x
    refine' IsOpen.mem_nhds _ _
    · apply isOpen_lt <;> continuity
    · dsimp only [W, Set.mem_setOf_eq]
      rw [h_eq]
      exact lt_add_of_pos_right _ Pos
  -- Since `X` is compact, there is some finset `ys t`
  -- so the union of the `W x` for `x ∈ xs` still covers everything.
  let xs : Finset X := (CompactSpace.elim_nhds_subcover W W_nhd).some
  let xs_w : (⋃ x ∈ xs, W x) = ⊤ := (CompactSpace.elim_nhds_subcover W W_nhd).choose_spec
  have xs_nonempty : xs.nonempty := Set.nonempty_of_union_eq_top_of_nonempty _ _ nX xs_w
  -- Finally our candidate function is the infimum over `x ∈ xs` of the `h x`.
  -- This function is then globally less than `f z + ε`.
  let k : (L : Type _) :=
    ⟨xs.inf' xs_nonempty fun x => (h x : C(X, ℝ)),
      Finset.inf'_mem _ inf_mem _ _ _ fun x _ => (h x).2⟩
  refine' ⟨k.1, _, k.2⟩
  -- We just need to verify the bound, which we do pointwise.
  rw [dist_lt_iff Pos]
  intro z
  -- We rewrite into this particular form,
  -- so that simp lemmas about inequalities involving `finset.inf'` can fire.
  rw [show ∀ a b ε : ℝ, dist a b < ε ↔ a < b + ε ∧ b - ε < a
      by
      intros
      simp only [← Metric.mem_ball, Real.ball_eq_Ioo, Set.mem_Ioo, and_comm']]
  fconstructor
  · dsimp [k]
    simp only [Finset.inf'_lt_iff, ContinuousMap.inf'_apply]
    exact Set.exists_set_mem_of_union_eq_top _ _ xs_w z
  · dsimp [k]
    simp only [Finset.lt_inf'_iff, ContinuousMap.inf'_apply]
    intro x xm
    apply lt_h
#align continuous_map.sublattice_closure_eq_top ContinuousMap.sublattice_closure_eq_top

/-- The **Stone-Weierstrass Approximation Theorem**,
that a subalgebra `A` of `C(X, ℝ)`, where `X` is a compact topological space,
is dense if it separates points.
-/
theorem subalgebra_topologicalClosure_eq_top_of_separatesPoints (A : Subalgebra ℝ C(X, ℝ))
    (w : A.SeparatesPoints) : A.topologicalClosure = ⊤ :=
  by
  -- The closure of `A` is closed under taking `sup` and `inf`,
  -- and separates points strongly (since `A` does),
  -- so we can apply `sublattice_closure_eq_top`.
  apply SetLike.ext'
  let L := A.topological_closure
  have n : Set.Nonempty (L : Set C(X, ℝ)) := ⟨(1 : C(X, ℝ)), A.le_topological_closure A.one_mem⟩
  convert sublattice_closure_eq_top (L : Set C(X, ℝ)) n
      (fun f fm g gm => inf_mem_closed_subalgebra L A.is_closed_topological_closure ⟨f, fm⟩ ⟨g, gm⟩)
      (fun f fm g gm => sup_mem_closed_subalgebra L A.is_closed_topological_closure ⟨f, fm⟩ ⟨g, gm⟩)
      (Subalgebra.SeparatesPoints.strongly
        (Subalgebra.separatesPoints_monotone A.le_topological_closure w))
  · simp
#align continuous_map.subalgebra_topological_closure_eq_top_of_separates_points ContinuousMap.subalgebra_topologicalClosure_eq_top_of_separatesPoints

/-- An alternative statement of the Stone-Weierstrass theorem.

If `A` is a subalgebra of `C(X, ℝ)` which separates points (and `X` is compact),
every real-valued continuous function on `X` is a uniform limit of elements of `A`.
-/
theorem continuousMap_mem_subalgebra_closure_of_separatesPoints (A : Subalgebra ℝ C(X, ℝ))
    (w : A.SeparatesPoints) (f : C(X, ℝ)) : f ∈ A.topologicalClosure :=
  by
  rw [subalgebra_topological_closure_eq_top_of_separates_points A w]
  simp
#align continuous_map.continuous_map_mem_subalgebra_closure_of_separates_points ContinuousMap.continuousMap_mem_subalgebra_closure_of_separatesPoints

/-- An alternative statement of the Stone-Weierstrass theorem,
for those who like their epsilons.

If `A` is a subalgebra of `C(X, ℝ)` which separates points (and `X` is compact),
every real-valued continuous function on `X` is within any `ε > 0` of some element of `A`.
-/
theorem exists_mem_subalgebra_near_continuousMap_of_separatesPoints (A : Subalgebra ℝ C(X, ℝ))
    (w : A.SeparatesPoints) (f : C(X, ℝ)) (ε : ℝ) (pos : 0 < ε) :
    ∃ g : A, ‖(g : C(X, ℝ)) - f‖ < ε :=
  by
  have w :=
    mem_closure_iff_frequently.mp (continuous_map_mem_subalgebra_closure_of_separates_points A w f)
  rw [metric.nhds_basis_ball.frequently_iff] at w
  obtain ⟨g, H, m⟩ := w ε Pos
  rw [Metric.mem_ball, dist_eq_norm] at H
  exact ⟨⟨g, m⟩, H⟩
#align continuous_map.exists_mem_subalgebra_near_continuous_map_of_separates_points ContinuousMap.exists_mem_subalgebra_near_continuousMap_of_separatesPoints

/-- An alternative statement of the Stone-Weierstrass theorem,
for those who like their epsilons and don't like bundled continuous functions.

If `A` is a subalgebra of `C(X, ℝ)` which separates points (and `X` is compact),
every real-valued continuous function on `X` is within any `ε > 0` of some element of `A`.
-/
theorem exists_mem_subalgebra_near_continuous_of_separatesPoints (A : Subalgebra ℝ C(X, ℝ))
    (w : A.SeparatesPoints) (f : X → ℝ) (c : Continuous f) (ε : ℝ) (pos : 0 < ε) :
    ∃ g : A, ∀ x, ‖g x - f x‖ < ε :=
  by
  obtain ⟨g, b⟩ := exists_mem_subalgebra_near_continuous_map_of_separates_points A w ⟨f, c⟩ ε Pos
  use g
  rwa [norm_lt_iff _ Pos] at b
#align continuous_map.exists_mem_subalgebra_near_continuous_of_separates_points ContinuousMap.exists_mem_subalgebra_near_continuous_of_separatesPoints

end ContinuousMap

section IsROrC

open IsROrC

-- Redefine `X`, since for the next few lemmas it need not be compact
variable {𝕜 : Type _} {X : Type _} [IsROrC 𝕜] [TopologicalSpace X]

namespace ContinuousMap

/-- A real subalgebra of `C(X, 𝕜)` is `conj_invariant`, if it contains all its conjugates. -/
def ConjInvariantSubalgebra (A : Subalgebra ℝ C(X, 𝕜)) : Prop :=
  A.map (conjAe.toAlgHom.compLeftContinuous ℝ conjCle.Continuous) ≤ A
#align continuous_map.conj_invariant_subalgebra ContinuousMap.ConjInvariantSubalgebra

theorem mem_conjInvariantSubalgebra {A : Subalgebra ℝ C(X, 𝕜)} (hA : ConjInvariantSubalgebra A)
    {f : C(X, 𝕜)} (hf : f ∈ A) : (conjAe.toAlgHom.compLeftContinuous ℝ conjCle.Continuous) f ∈ A :=
  hA ⟨f, hf, rfl⟩
#align continuous_map.mem_conj_invariant_subalgebra ContinuousMap.mem_conjInvariantSubalgebra

/-- If a set `S` is conjugation-invariant, then its `𝕜`-span is conjugation-invariant. -/
theorem subalgebra_conj_invariant {S : Set C(X, 𝕜)}
    (hS : ∀ f, f ∈ S → (conjAe.toAlgHom.compLeftContinuous ℝ conjCle.Continuous) f ∈ S) :
    ConjInvariantSubalgebra ((Algebra.adjoin 𝕜 S).restrictScalars ℝ) :=
  by
  rintro _ ⟨f, hf, rfl⟩
  change _ ∈ (Algebra.adjoin 𝕜 S).restrictScalars ℝ
  change _ ∈ (Algebra.adjoin 𝕜 S).restrictScalars ℝ at hf
  rw [Subalgebra.mem_restrictScalars] at hf⊢
  apply Algebra.adjoin_induction hf
  · exact fun g hg => Algebra.subset_adjoin (hS g hg)
  · exact fun c => Subalgebra.algebraMap_mem _ (starRingEnd 𝕜 c)
  · intro f g hf hg
    convert Subalgebra.add_mem _ hf hg
    exact AlgHom.map_add _ f g
  · intro f g hf hg
    convert Subalgebra.mul_mem _ hf hg
    exact AlgHom.map_mul _ f g
#align continuous_map.subalgebra_conj_invariant ContinuousMap.subalgebra_conj_invariant

end ContinuousMap

open ContinuousMap

/-- If a conjugation-invariant subalgebra of `C(X, 𝕜)` separates points, then the real subalgebra
of its purely real-valued elements also separates points. -/
theorem Subalgebra.SeparatesPoints.isROrC_to_real {A : Subalgebra 𝕜 C(X, 𝕜)}
    (hA : A.SeparatesPoints) (hA' : ConjInvariantSubalgebra (A.restrictScalars ℝ)) :
    ((A.restrictScalars ℝ).comap
        (ofRealAm.compLeftContinuous ℝ continuous_of_real)).SeparatesPoints :=
  by
  intro x₁ x₂ hx
  -- Let `f` in the subalgebra `A` separate the points `x₁`, `x₂`
  obtain ⟨_, ⟨f, hfA, rfl⟩, hf⟩ := hA hx
  let F : C(X, 𝕜) := f - const _ (f x₂)
  -- Subtract the constant `f x₂` from `f`; this is still an element of the subalgebra
  have hFA : F ∈ A :=
    by
    refine' A.sub_mem hfA (@Eq.subst _ (· ∈ A) _ _ _ <| A.smul_mem A.one_mem <| f x₂)
    ext1
    simp only [coe_smul, coe_one, Pi.smul_apply, Pi.one_apply, Algebra.id.smul_eq_mul, mul_one,
      const_apply]
  -- Consider now the function `λ x, |f x - f x₂| ^ 2`
  refine' ⟨_, ⟨(⟨IsROrC.normSq, continuous_norm_sq⟩ : C(𝕜, ℝ)).comp F, _, rfl⟩, _⟩
  · -- This is also an element of the subalgebra, and takes only real values
    rw [SetLike.mem_coe, Subalgebra.mem_comap]
    convert(A.restrict_scalars ℝ).mul_mem (mem_conj_invariant_subalgebra hA' hFA) hFA
    ext1
    rw [mul_comm]
    exact (IsROrC.mul_conj _).symm
  · -- And it also separates the points `x₁`, `x₂`
    have : f x₁ - f x₂ ≠ 0 := sub_ne_zero.mpr hf
    simpa only [comp_apply, coe_sub, coe_const, Pi.sub_apply, coe_mk, sub_self, map_zero, Ne.def,
      norm_sq_eq_zero] using this
#align subalgebra.separates_points.is_R_or_C_to_real Subalgebra.SeparatesPoints.isROrC_to_real

variable [CompactSpace X]

/-- The Stone-Weierstrass approximation theorem, `is_R_or_C` version,
that a subalgebra `A` of `C(X, 𝕜)`, where `X` is a compact topological space and `is_R_or_C 𝕜`,
is dense if it is conjugation-invariant and separates points.
-/
theorem ContinuousMap.subalgebra_isROrC_topologicalClosure_eq_top_of_separatesPoints
    (A : Subalgebra 𝕜 C(X, 𝕜)) (hA : A.SeparatesPoints)
    (hA' : ConjInvariantSubalgebra (A.restrictScalars ℝ)) : A.topologicalClosure = ⊤ :=
  by
  rw [Algebra.eq_top_iff]
  -- Let `I` be the natural inclusion of `C(X, ℝ)` into `C(X, 𝕜)`
  let I : C(X, ℝ) →ₗ[ℝ] C(X, 𝕜) := of_real_clm.comp_left_continuous ℝ X
  -- The main point of the proof is that its range (i.e., every real-valued function) is contained
  -- in the closure of `A`
  have key : I.range ≤ (A.to_submodule.restrict_scalars ℝ).topologicalClosure :=
    by
    -- Let `A₀` be the subalgebra of `C(X, ℝ)` consisting of `A`'s purely real elements; it is the
    -- preimage of `A` under `I`.  In this argument we only need its submodule structure.
    let A₀ : Submodule ℝ C(X, ℝ) := (A.to_submodule.restrict_scalars ℝ).comap I
    -- By `subalgebra.separates_points.complex_to_real`, this subalgebra also separates points, so
    -- we may apply the real Stone-Weierstrass result to it.
    have SW : A₀.topological_closure = ⊤ :=
      haveI :=
        subalgebra_topological_closure_eq_top_of_separates_points _ (hA.is_R_or_C_to_real hA')
      congr_arg Subalgebra.toSubmodule this
    rw [← Submodule.map_top, ← SW]
    -- So it suffices to prove that the image under `I` of the closure of `A₀` is contained in the
    -- closure of `A`, which follows by abstract nonsense
    have h₁ := A₀.topological_closure_map ((@of_real_clm 𝕜 _).compLeftContinuousCompact X)
    have h₂ := (A.to_submodule.restrict_scalars ℝ).map_comap_le I
    exact h₁.trans (Submodule.topologicalClosure_mono h₂)
  -- In particular, for a function `f` in `C(X, 𝕜)`, the real and imaginary parts of `f` are in the
  -- closure of `A`
  intro f
  let f_re : C(X, ℝ) := (⟨IsROrC.re, is_R_or_C.re_clm.continuous⟩ : C(𝕜, ℝ)).comp f
  let f_im : C(X, ℝ) := (⟨IsROrC.im, is_R_or_C.im_clm.continuous⟩ : C(𝕜, ℝ)).comp f
  have h_f_re : I f_re ∈ A.topological_closure := key ⟨f_re, rfl⟩
  have h_f_im : I f_im ∈ A.topological_closure := key ⟨f_im, rfl⟩
  -- So `f_re + I • f_im` is in the closure of `A`
  convert A.topological_closure.add_mem h_f_re (A.topological_closure.smul_mem h_f_im IsROrC.i)
  -- And this, of course, is just `f`
  ext
  apply Eq.symm
  simp [I, mul_comm IsROrC.i _]
#align continuous_map.subalgebra_is_R_or_C_topological_closure_eq_top_of_separates_points ContinuousMap.subalgebra_isROrC_topologicalClosure_eq_top_of_separatesPoints

end IsROrC


import libs.tuto_lib

section
/-
The first part of this file makes sure you can negate quantified statements
in your head without the help of `push_neg`.

You need to complete the statement and then use the `check_me` tactic
to check your answer. This tactic exists only for those exercises,
it mostly calls `push_neg` and then cleans up a bit.

def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε
-/

-- In this section, u denotes a sequence of real numbers
-- f is a function from ℝ to ℝ
-- x₀ and l are real numbers
variables (u : ℕ → ℝ) (f : ℝ → ℝ) (x₀ l : ℝ)

/- Negation of "u tends to l" -/
-- 0062
example : ¬ (∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε) ↔
sorry
:=
begin
  sorry
end

/- Negation of "f is continuous at x₀" -/
-- 0063
example : ¬ (∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ →  |f x - f x₀| ≤ ε) ↔
sorry
:=
begin
  sorry
end

/-
In the next exercise, we need to keep in mind that
`∀ x x', ...` is the abbreviation of
`∀ x, ∀ x', ... `.

Also, `∃ x x', ...` is the abbreviation of `∃ x, ∃ x', ...`.
-/

/- Negation of "f is uniformly continuous on ℝ" -/
-- 0064
example : ¬ (∀ ε > 0, ∃ δ > 0, ∀ x x', |x' - x| ≤ δ →  |f x' - f x| ≤ ε) ↔
sorry
:=
begin
  sorry
end

/- Negation of "f is sequentially continuous at x₀" -/
-- 0065
example : ¬ (∀ u : ℕ → ℝ, (∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - x₀| ≤ ε) → (∀ ε > 0, ∃ N, ∀ n ≥ N, |(f ∘ u) n - f x₀| ≤ ε))  ↔
sorry
:=
begin
  sorry
end
end

/-
We now turn to elementary applications of negations to limits of sequences.
Remember that `linarith` can find easy numerical contradictions.

Also recall the following lemmas:

abs_le {x y : ℝ} : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

ge_max_iff (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

le_max_left p q : p ≤ max p q

le_max_right p q : q ≤ max p q

/-- The sequence `u` tends to `+∞`. -/
def tendsto_infinity (u : ℕ → ℝ) := ∀ A, ∃ N, ∀ n ≥ N, u n ≥ A
-/

-- 0066
example {u : ℕ → ℝ} : tendsto_infinity u → ∀ l, ¬ seq_limit u l :=
begin
  intros u_inf l,
  unfold seq_limit,
  push_neg,
  use (1:ℝ),
  norm_num, -- I don't need to split! Before, I had `split,linarith`
  intro N,
  specialize u_inf (l+2),
  cases u_inf with M HM,
  let Max := max M N,
  use Max,
  specialize HM Max (by norm_num),
  norm_num,
  calc
  1   < 2           : by linarith
  ... ≤ u Max - l   : by linarith
  ... = |u Max - l| : by { rw abs_eq_self.2, linarith },
  -- `rw` will put assumptions in as the new targets
end

def nondecreasing_seq (u : ℕ → ℝ) := ∀ n m, n ≤ m → u n ≤ u m

-- 0067
example (u : ℕ → ℝ) (l : ℝ) (h : seq_limit u l) (h' : nondecreasing_seq u) :
  ∀ n, u n ≤ l :=
begin
  sorry
end

/-
In the following exercises, `A : set ℝ` means that A is a set of real numbers.
We can use the usual notation x ∈ A.

The notation `∀ x ∈ A, ...` is the abbreviation of `∀ x, x ∈ A → ... `

The notation `∃ x ∈ A, ...` is the abbreviation of `∃ x, x ∈ A ∧ ... `.
More precisely it is the abbreviation of `∃ x (H : x ∈ A), ...`
which is Lean's strange way of saying `∃ x, x ∈ A ∧ ... `.
You can convert between these forms using the lemma
  exists_prop {p q : Prop} : (∃ (h : p), q) ↔ p ∧ q

We'll work with upper bounds and supremums.
Again we'll introduce specialized definitions for the sake of exercises, but mathlib
has more general versions.

def upper_bound (A : set ℝ) (x : ℝ) := ∀ a ∈ A, a ≤ x

def is_sup (A : set ℝ) (x : ℝ) := upper_bound A x ∧ ∀ y, upper_bound A y → x ≤ y

Remark: one can easily show that a set of real numbers has at most one sup,
but we won't need this.
-/

-- 0068
example {A : set ℝ} {x : ℝ} (hx : is_sup A x) :
∀ y, y < x → ∃ a ∈ A, y < a :=
begin
  sorry
end

/-
Let's do a variation on an example from file 07 that will be useful in the last
exercise below.
-/

-- 0069
lemma le_of_le_add_all' {x y : ℝ} :
  (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  sorry
end

-- 0070
example {x y : ℝ} {u : ℕ → ℝ} (hu : seq_limit u x)
  (ineg : ∀ n, u n ≤ y) : x ≤ y :=
begin
  sorry
end


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

import tactic

/-

# Constructive bijections

I'm generally quite anti-constructive mathematics; it makes stuff harder
to do in Lean whilst only providing benefits such as computational content
which I am typically not interested in (I never `#eval` stuff, I just
want to prove theorems and I don't care if the proof isn't `refl`).

But one example of where I love constructivism is `X ≃ Y`, the class
of constructive bijections from `X` to `Y`. What is a constructive
bijection? It is a function `f : X → Y` plus some more data, but here
the data is *not* just the propositional claim that `f` is bijective
(i.e. the *existence* of a two-sided inverse) -- it is the actual
data of the two-sided inverse too.

`X ≃ Y` is notation for `equiv X Y`. This is the type of constructive
bijections from `X` to `Y`. To make a term of type `X ≃ Y` you need
to give a 4-tuple consisting of two functions `f : X → Y` and `g : Y → X`,
plus also two proofs: firstly a proof of `∀ y, f (g y) = y`, and secondly
a proof of `∀ x, g (f x) = x`.

Note that `X ≃ Y` has type `Type`, not `Prop`. It does *not* mean "there exists
a bijection from `X` to `Y`", it is the actual data of a bijection
from `X` to `Y`.

Let's build two different bijections from ℚ to ℚ.

The first one is easy; I'll do it for you, to show you the syntax.

-/

def bijection1 : ℚ ≃ ℚ :=
{ to_fun := id, -- use the identity function from ℚ to ℚ
  inv_fun := id, -- its inverse is also the identity function
  left_inv := begin -- we have to prove ∀ q, id (id q) = q
    intro q,
    refl,
  end,
  right_inv := λ q, rfl } -- same proof but in term mode

-- Now see if you can do a harder one.
def bijection2 : ℚ ≃ ℚ :=
{ to_fun := λ q, 3 * q + 4,
  inv_fun := λ r, (r - 4) / 3,
  left_inv := begin -- start with `intro r`, then use `dsimp` to tidy up the mess
    sorry,
  end,
  right_inv := begin
    sorry,
  end }


import algebra.big_operators.intervals algebra.big_operators.order algebra.big_operators.ring

/-! # IMO 2021 A5 -/

namespace IMOSL
namespace IMO2021A5

open finset

variables {F : Type*} [linear_ordered_field F]

private lemma bound1 {a : ℕ → F} (h : ∀ n : ℕ, 0 < a n) {n : ℕ} (h0 : (range n.succ).sum a ≤ 1) :
  a n / (1 - a n) * ((range n).sum a) ^ 2 ≤ (((range n.succ).sum a) ^ 3 - ((range n).sum a) ^ 3) / 3 :=
begin
  rcases nat.eq_zero_or_pos n with rfl | h1,
  rw [sum_range_zero, sum_range_one, zero_pow two_pos, mul_zero, zero_pow three_pos, sub_zero],
  exact div_nonneg (pow_nonneg (le_of_lt (h 0)) 3) zero_le_three,
  rw [sum_range_succ, add_comm] at h0 ⊢,
  have h2 : 0 ≤ (range n).sum a := sum_nonneg (λ i _, le_of_lt (h i)),
  replace h := h n,
  generalizes [hx : a n = x, hy : (range n).sum a = y],
  rw ← hx at h0 h; rw ← hy at h0 h2,
  clear h1 hx hy a n,
  suffices : x / (1 - x) * y ^ 2 ≤ x ^ 2 * y + x * y ^ 2,
  { apply le_trans this,
    rw ← sub_nonneg; ring_nf,
    exact mul_nonneg (div_nonneg zero_le_one zero_le_three) (pow_nonneg (le_of_lt h) 3) },
  rw [← le_sub_iff_add_le', le_iff_eq_or_lt] at h0,
  rcases h0 with rfl | h0,
  { rw le_iff_eq_or_lt at h2,
    rcases h2 with h2 | h2,
    rw [← h2, sq, mul_zero, mul_zero, ← add_mul, mul_zero],
    rw [sq, ← mul_assoc, div_mul_cancel x (ne_of_gt h2), sq, mul_assoc,
        ← mul_add, ← add_mul, add_sub_cancel'_right, one_mul] },
  { have h1 := ne_of_gt (lt_of_le_of_lt h2 h0),
    rw [div_eq_mul_inv, mul_right_comm, ← sub_le_iff_le_add, ← mul_sub_one, inv_eq_one_div,
        div_sub_one h1, sub_sub_cancel, ← mul_div_assoc, mul_right_comm, ← sq, sq y,
        ← mul_assoc, mul_div_assoc, ← sub_nonpos, ← mul_sub_one, div_sub_one h1],
    refine mul_nonpos_of_nonneg_of_nonpos (mul_nonneg _ h2) (div_nonpos_of_nonpos_of_nonneg _ _),
    exacts [sq_nonneg x, le_of_lt (by rwa sub_neg), le_trans h2 (le_of_lt h0)] }
end

/-- Final solution -/
theorem final_solution {a : ℕ → F} (h : ∀ n : ℕ, 0 < a n) {n : ℕ} (h0 : (range n).sum a ≤ 1) :
  (range n).sum (λ k, a k / (1 - a k) * ((range k).sum a) ^ 2) < 1 / 3 :=
begin
  rcases nat.eq_zero_or_pos n with rfl | h1,
  rw [sum_range_zero, one_div, inv_pos]; exact three_pos,
  refine lt_of_lt_of_le (sum_lt_sum (λ i h2, bound1 h _) _) _,
  { rw [mem_range, ← nat.succ_le_iff] at h2,
    refine le_trans _ h0,
    rw [← sum_range_add_sum_Ico a h2, le_add_iff_nonneg_right],
    exact sum_nonneg (λ i _, (le_of_lt (h i))) },
  { use 0; split,
    rwa mem_range,
    rw [sum_range_zero, zero_pow two_pos, mul_zero, zero_pow three_pos, sub_zero, sum_range_one],
    exact div_pos (pow_pos (h 0) 3) three_pos },
  { rw [← sum_div, sum_range_sub (λ i, (range i).sum a ^ 3)],
    simp only [sub_zero, sum_range_zero, zero_pow three_pos],
    exact div_le_div_of_le zero_le_three (pow_le_one 3 (sum_nonneg (λ i _, le_of_lt (h i))) h0) }
end

end IMO2021A5
end IMOSL


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

/-!
# Measure preserving maps

We say that `f : α → β` is a measure preserving map w.r.t. measures `μ : measure α` and
`ν : measure β` if `f` is measurable and `map f μ = ν`. In this file we define the predicate
`measure_theory.measure_preserving` and prove its basic properties.

We use the term "measure preserving" because in many applications `α = β` and `μ = ν`.

## References

Partially based on
[this](https://www.isa-afp.org/browser_info/current/AFP/Ergodic_Theory/Measure_Preserving_Transformations.html)
Isabelle formalization.

## Tags

measure preserving map, measure
-/

variables {α β γ δ : Type*} [measurable_space α] [measurable_space β] [measurable_space γ]
  [measurable_space δ]

namespace measure_theory

open measure function set

variables {μa : measure α} {μb : measure β} {μc : measure γ} {μd : measure δ}

/-- `f` is a measure preserving map w.r.t. measures `μa` and `μb` if `f` is measurable
and `map f μa = μb`. -/
@[protect_proj]
structure measure_preserving (f : α → β) (μa : measure α . volume_tac)
  (μb : measure β . volume_tac) : Prop :=
(measurable : measurable f)
(map_eq : map f μa = μb)

namespace measure_preserving

protected lemma id (μ : measure α) : measure_preserving id μ μ :=
⟨measurable_id, map_id⟩

protected lemma quasi_measure_preserving {f : α → β} (hf : measure_preserving f μa μb) :
  quasi_measure_preserving f μa μb :=
⟨hf.1, hf.2.absolutely_continuous⟩

lemma comp {g : β → γ} {f : α → β} (hg : measure_preserving g μb μc)
  (hf : measure_preserving f μa μb) :
  measure_preserving (g ∘ f) μa μc :=
⟨hg.1.comp hf.1, by rw [← map_map hg.1 hf.1, hf.2, hg.2]⟩

protected lemma sigma_finite {f : α → β} (hf : measure_preserving f μa μb) [sigma_finite μb] :
  sigma_finite μa :=
sigma_finite.of_map μa hf.1 (by rwa hf.map_eq)

lemma measure_preimage {f : α → β} (hf : measure_preserving f μa μb)
  {s : set β} (hs : measurable_set s) :
  μa (f ⁻¹' s) = μb s :=
by rw [← hf.map_eq, map_apply hf.1 hs]

protected lemma iterate {f : α → α} (hf : measure_preserving f μa μa) :
  ∀ n, measure_preserving (f^[n]) μa μa
| 0 := measure_preserving.id μa
| (n + 1) := (iterate n).comp hf

lemma skew_product [sigma_finite μb] [sigma_finite μd]
  {f : α → β} (hf : measure_preserving f μa μb) {g : α → γ → δ}
  (hgm : measurable (uncurry g)) (hg : ∀ᵐ x ∂μa, map (g x) μc = μd) :
  measure_preserving (λ p : α × γ, (f p.1, g p.1 p.2)) (μa.prod μc) (μb.prod μd) :=
begin
  classical,
  have : measurable (λ p : α × γ, (f p.1, g p.1 p.2)) := (hf.1.comp measurable_fst).prod_mk hgm,
  /- if `μa = 0`, then the lemma is trivial, otherwise we can use `hg`
  to deduce `sigma_finite μc`. -/
  by_cases ha : μa = 0,
  { rw [← hf.map_eq, ha, zero_prod, (map f).map_zero, zero_prod],
    exact ⟨this, (map _).map_zero⟩ },
  haveI : μa.ae.ne_bot := ae_ne_bot.2 ha,
  rcases hg.exists with ⟨x, hx⟩,
  haveI : sigma_finite μc := sigma_finite.of_map _ hgm.of_uncurry_left (by rwa hx),
  clear hx x,
  refine ⟨this, (prod_eq $ λ s t hs ht, _).symm⟩,
  rw [map_apply this (hs.prod ht)],
  refine (prod_apply (this $ hs.prod ht)).trans _,
  have : ∀ᵐ x ∂μa, μc ((λ y, (f x, g x y)) ⁻¹' s.prod t) = indicator (f ⁻¹' s) (λ y, μd t) x,
  { refine hg.mono (λ x hx, _),
    simp only [mk_preimage_prod_right_fn_eq_if, indicator_apply, mem_preimage],
    split_ifs,
    { rw [← map_apply hgm.of_uncurry_left ht, hx] },
    { exact measure_empty } },
  simp only [preimage_preimage],
  rw [lintegral_congr_ae this, lintegral_indicator _ (hf.1 hs),
    set_lintegral_const, hf.measure_preimage hs, mul_comm]
end

/-- If `f : α → β` sends the measure `μa` to `μb` and `g : γ → δ` sends the measure `μc` to `μd`,
then `prod.map f g` sends `μa.prod μc` to `μb.prod μd`. -/
lemma prod [sigma_finite μb] [sigma_finite μd] {f : α → β} {g : γ → δ}
  (hf : measure_preserving f μa μb) (hg : measure_preserving g μc μd) :
  measure_preserving (prod.map f g) (μa.prod μc) (μb.prod μd) :=
have measurable (uncurry $ λ _ : α, g), from (hg.1.comp measurable_snd),
hf.skew_product this $ filter.eventually_of_forall $ λ _, hg.map_eq

variables {μ : measure α} {f : α → α} {s : set α}

/-- If `μ univ < n * μ s` and `f` is a map preserving measure `μ`,
then for some `x ∈ s` and `0 < m < n`, `f^[m] x ∈ s`. -/
lemma exists_mem_image_mem_of_volume_lt_mul_volume (hf : measure_preserving f μ μ)
  (hs : measurable_set s) {n : ℕ} (hvol : μ (univ : set α) < n * μ s) :
  ∃ (x ∈ s) (m ∈ Ioo 0 n), f^[m] x ∈ s :=
begin
  have A : ∀ m, measurable_set (f^[m] ⁻¹' s) := λ m, (hf.iterate m).measurable hs,
  have B : ∀ m, μ (f^[m] ⁻¹' s) = μ s, from λ m, (hf.iterate m).measure_preimage hs,
  have : μ (univ : set α) < (finset.range n).sum (λ m, μ (f^[m] ⁻¹' s)),
    by simpa only [B, nsmul_eq_mul, finset.sum_const, finset.card_range],
  rcases exists_nonempty_inter_of_measure_univ_lt_sum_measure μ (λ m hm, A m) this
    with ⟨i, hi, j, hj, hij, x, hxi, hxj⟩,
  -- without `tactic.skip` Lean closes the extra goal but it takes a long time; not sure why
  wlog hlt : i < j := hij.lt_or_lt using [i j, j i] tactic.skip,
  { simp only [set.mem_preimage, finset.mem_range] at hi hj hxi hxj,
    refine ⟨f^[i] x, hxi, j - i, ⟨nat.sub_pos_of_lt hlt, lt_of_le_of_lt (j.sub_le i) hj⟩, _⟩,
    rwa [← iterate_add_apply, nat.sub_add_cancel hlt.le] },
  { exact λ hi hj hij hxi hxj, this hj hi hij.symm hxj hxi }
end

/-- A self-map preserving a finite measure is conservative: if `μ s ≠ 0`, then at least one point
`x ∈ s` comes back to `s` under iterations of `f`. Actually, a.e. point of `s` comes back to `s`
infinitely many times, see `measure_theory.measure_preserving.conservative` and theorems about
`measure_theory.conservative`. -/
lemma exists_mem_image_mem [finite_measure μ] (hf : measure_preserving f μ μ)
  (hs : measurable_set s) (hs' : μ s ≠ 0) :
  ∃ (x ∈ s) (m ≠ 0), f^[m] x ∈ s :=
begin
  rcases ennreal.exists_nat_mul_gt hs' (measure_ne_top μ (univ : set α)) with ⟨N, hN⟩,
  rcases hf.exists_mem_image_mem_of_volume_lt_mul_volume hs hN with ⟨x, hx, m, hm, hmx⟩,
  exact ⟨x, hx, m, hm.1.ne', hmx⟩
end

end measure_preserving

end measure_theory