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

The (classical) real numbers ℝ. This is a direct construction
from Cauchy sequences.
-/
import order.conditionally_complete_lattice data.real.cau_seq_completion
  algebra.big_operators algebra.archimedean order.bounds

def real := @cau_seq.completion.Cauchy ℚ _ _ _ abs _
notation `ℝ` := real

namespace real
open cau_seq cau_seq.completion

def of_rat (x : ℚ) : ℝ := of_rat x

def mk (x : cau_seq ℚ abs) : ℝ := cau_seq.completion.mk x

def comm_ring_aux : comm_ring ℝ := cau_seq.completion.comm_ring

instance : comm_ring ℝ := { ..comm_ring_aux }

/- Extra instances to short-circuit type class resolution -/
instance : ring ℝ               := by apply_instance
instance : comm_semiring ℝ      := by apply_instance
instance : semiring ℝ           := by apply_instance
instance : add_comm_group ℝ     := by apply_instance
instance : add_group ℝ          := by apply_instance
instance : add_comm_monoid ℝ    := by apply_instance
instance : add_monoid ℝ         := by apply_instance
instance : add_left_cancel_semigroup ℝ := by apply_instance
instance : add_right_cancel_semigroup ℝ := by apply_instance
instance : add_comm_semigroup ℝ := by apply_instance
instance : add_semigroup ℝ      := by apply_instance
instance : comm_monoid ℝ        := by apply_instance
instance : monoid ℝ             := by apply_instance
instance : comm_semigroup ℝ     := by apply_instance
instance : semigroup ℝ          := by apply_instance
instance : inhabited ℝ := ⟨0⟩

theorem of_rat_sub (x y : ℚ) : of_rat (x - y) = of_rat x - of_rat y :=
congr_arg mk (const_sub _ _)

instance : has_lt ℝ :=
⟨λ x y, quotient.lift_on₂ x y (<) $
  λ f₁ g₁ f₂ g₂ hf hg, propext $
  ⟨λ h, lt_of_eq_of_lt (setoid.symm hf) (lt_of_lt_of_eq h hg),
   λ h, lt_of_eq_of_lt hf (lt_of_lt_of_eq h (setoid.symm hg))⟩⟩

@[simp] theorem mk_lt {f g : cau_seq ℚ abs} : mk f < mk g ↔ f < g := iff.rfl

theorem mk_eq {f g : cau_seq ℚ abs} : mk f = mk g ↔ f ≈ g := mk_eq

theorem quotient_mk_eq_mk (f : cau_seq ℚ abs) : ⟦f⟧ = mk f := rfl

theorem mk_eq_mk {f : cau_seq ℚ abs} : cau_seq.completion.mk f = mk f := rfl

@[simp] theorem mk_pos {f : cau_seq ℚ abs} : 0 < mk f ↔ pos f :=
iff_of_eq (congr_arg pos (sub_zero f))

protected def le (x y : ℝ) : Prop := x < y ∨ x = y
instance : has_le ℝ := ⟨real.le⟩

@[simp] theorem mk_le {f g : cau_seq ℚ abs} : mk f ≤ mk g ↔ f ≤ g :=
or_congr iff.rfl quotient.eq

theorem add_lt_add_iff_left {a b : ℝ} (c : ℝ) : c + a < c + b ↔ a < b :=
quotient.induction_on₃ a b c (λ f g h,
  iff_of_eq (congr_arg pos $ by rw add_sub_add_left_eq_sub))

instance : linear_order ℝ :=
{ le := (≤), lt := (<),
  le_refl := λ a, or.inr rfl,
  le_trans := λ a b c, quotient.induction_on₃ a b c $
    λ f g h, by simpa [quotient_mk_eq_mk] using le_trans,
  lt_iff_le_not_le := λ a b, quotient.induction_on₂ a b $
    λ f g, by simpa [quotient_mk_eq_mk] using lt_iff_le_not_le,
  le_antisymm := λ a b, quotient.induction_on₂ a b $
    λ f g, by simpa [mk_eq, quotient_mk_eq_mk] using @cau_seq.le_antisymm _ _ f g,
  le_total := λ a b, quotient.induction_on₂ a b $
    λ f g, by simpa [quotient_mk_eq_mk] using le_total f g }

instance : partial_order ℝ := by apply_instance
instance : preorder ℝ      := by apply_instance

theorem of_rat_lt {x y : ℚ} : of_rat x < of_rat y ↔ x < y := const_lt

protected theorem zero_lt_one : (0 : ℝ) < 1 := of_rat_lt.2 zero_lt_one

protected theorem mul_pos {a b : ℝ} : 0 < a → 0 < b → 0 < a * b :=
quotient.induction_on₂ a b $ λ f g,
  show pos (f - 0) → pos (g - 0) → pos (f * g - 0),
  by simpa using cau_seq.mul_pos

instance : linear_ordered_comm_ring ℝ :=
{ add_le_add_left := λ a b h c,
    (le_iff_le_iff_lt_iff_lt.2 $ real.add_lt_add_iff_left c).2 h,
  zero_ne_one := ne_of_lt real.zero_lt_one,
  mul_nonneg := λ a b a0 b0,
    match a0, b0 with
    | or.inl a0, or.inl b0 := le_of_lt (real.mul_pos a0 b0)
    | or.inr a0, _ := by simp [a0.symm]
    | _, or.inr b0 := by simp [b0.symm]
    end,
  mul_pos := @real.mul_pos,
  zero_lt_one := real.zero_lt_one,
  add_lt_add_left := λ a b h c, (real.add_lt_add_iff_left c).2 h,
  ..real.comm_ring, ..real.linear_order }

/- Extra instances to short-circuit type class resolution -/
instance : linear_ordered_ring ℝ        := by apply_instance
instance : ordered_ring ℝ               := by apply_instance
instance : linear_ordered_semiring ℝ    := by apply_instance
instance : ordered_semiring ℝ           := by apply_instance
instance : ordered_comm_group ℝ         := by apply_instance
instance : ordered_cancel_comm_monoid ℝ := by apply_instance
instance : ordered_comm_monoid ℝ        := by apply_instance
instance : domain ℝ                     := by apply_instance

local attribute [instance] classical.prop_decidable

noncomputable instance : discrete_linear_ordered_field ℝ :=
{ decidable_le := by apply_instance,
  ..real.linear_ordered_comm_ring,
  ..real.domain,
  ..cau_seq.completion.discrete_field }

/- Extra instances to short-circuit type class resolution -/

noncomputable instance : linear_ordered_field ℝ    := by apply_instance
noncomputable instance : decidable_linear_ordered_comm_ring ℝ := by apply_instance
noncomputable instance : decidable_linear_ordered_semiring ℝ := by apply_instance
noncomputable instance : decidable_linear_ordered_comm_group ℝ := by apply_instance
noncomputable instance discrete_field : discrete_field ℝ := by apply_instance
noncomputable instance : field ℝ                   := by apply_instance
noncomputable instance : division_ring ℝ           := by apply_instance
noncomputable instance : integral_domain ℝ         := by apply_instance
noncomputable instance : nonzero_comm_ring ℝ       := by apply_instance
noncomputable instance : decidable_linear_order ℝ  := by apply_instance
noncomputable instance : lattice.distrib_lattice ℝ := by apply_instance
noncomputable instance : lattice.lattice ℝ         := by apply_instance
noncomputable instance : lattice.semilattice_inf ℝ := by apply_instance
noncomputable instance : lattice.semilattice_sup ℝ := by apply_instance
noncomputable instance : lattice.has_inf ℝ         := by apply_instance
noncomputable instance : lattice.has_sup ℝ         := by apply_instance

lemma le_of_forall_epsilon_le {a b : real} (h : ∀ε, ε > 0 → a ≤ b + ε) : a ≤ b :=
le_of_forall_le_of_dense $ assume x hxb,
calc  a ≤ b + (x - b) : h (x-b) $ sub_pos.2 hxb
    ... = x : by rw [add_comm]; simp

open rat

@[simp] theorem of_rat_eq_cast : ∀ x : ℚ, of_rat x = x :=
eq_cast of_rat rfl of_rat_add of_rat_mul

theorem le_mk_of_forall_le {x : ℝ} {f : cau_seq ℚ abs} :
  (∃ i, ∀ j ≥ i, x ≤ f j) → x ≤ mk f :=
quotient.induction_on x $ λ g h, le_of_not_lt $
λ ⟨K, K0, hK⟩,
let ⟨i, H⟩ := exists_forall_ge_and h $
  exists_forall_ge_and hK (f.cauchy₃ $ half_pos K0) in
begin
  apply not_lt_of_le (H _ (le_refl _)).1,
  rw ← of_rat_eq_cast,
  refine ⟨_, half_pos K0, i, λ j ij, _⟩,
  have := add_le_add (H _ ij).2.1
    (le_of_lt (abs_lt.1 $ (H _ (le_refl _)).2.2 _ ij).1),
  rwa [← sub_eq_add_neg, sub_self_div_two, sub_apply, sub_add_sub_cancel] at this
end

theorem mk_near_of_forall_near {f : cau_seq ℚ abs} {x : ℝ} {ε : ℝ}
  (H : ∃ i, ∀ j ≥ i, abs ((f j : ℝ) - x) ≤ ε) : abs (mk f - x) ≤ ε :=
abs_sub_le_iff.2
  ⟨sub_le_iff_le_add'.2 $ mk_le_of_forall_le $
    H.imp $ λ i h j ij, sub_le_iff_le_add'.1 (abs_sub_le_iff.1 $ h j ij).1,
  sub_le.1 $ le_mk_of_forall_le $
    H.imp $ λ i h j ij, sub_le.1 (abs_sub_le_iff.1 $ h j ij).2⟩

instance : archimedean ℝ :=
archimedean_iff_rat_le.2 $ λ x, quotient.induction_on x $ λ f,
let ⟨M, M0, H⟩ := f.bounded' 0 in
⟨M, mk_le_of_forall_le ⟨0, λ i _,
  rat.cast_le.2 $ le_of_lt (abs_lt.1 (H i)).2⟩⟩

/- mark `real` irreducible in order to prevent `auto_cases` unfolding reals,
since users rarely want to consider real numbers as Cauchy sequences.
Marking `comm_ring_aux` `irreducible` is done to ensure that there are no problems
with non definitionally equal instances, caused by making `real` irreducible-/
attribute [irreducible] real comm_ring_aux

noncomputable instance : floor_ring ℝ := archimedean.floor_ring _

theorem is_cau_seq_iff_lift {f : ℕ → ℚ} : is_cau_seq abs f ↔ is_cau_seq abs (λ i, (f i : ℝ)) :=
⟨λ H ε ε0,
  let ⟨δ, δ0, δε⟩ := exists_pos_rat_lt ε0 in
  (H _ δ0).imp $ λ i hi j ij, lt_trans
    (by simpa using (@rat.cast_lt ℝ _ _ _).2 (hi _ ij)) δε,
 λ H ε ε0, (H _ (rat.cast_pos.2 ε0)).imp $
   λ i hi j ij, (@rat.cast_lt ℝ _ _ _).1 $ by simpa using hi _ ij⟩

theorem of_near (f : ℕ → ℚ) (x : ℝ)
  (h : ∀ ε > 0, ∃ i, ∀ j ≥ i, abs ((f j : ℝ) - x) < ε) :
  ∃ h', real.mk ⟨f, h'⟩ = x :=
⟨is_cau_seq_iff_lift.2 (of_near _ (const abs x) h),
 sub_eq_zero.1 $ abs_eq_zero.1 $
  eq_of_le_of_forall_le_of_dense (abs_nonneg _) $ λ ε ε0,
    mk_near_of_forall_near $
    (h _ ε0).imp (λ i h j ij, le_of_lt (h j ij))⟩

theorem exists_floor (x : ℝ) : ∃ (ub : ℤ), (ub:ℝ) ≤ x ∧
   ∀ (z : ℤ), (z:ℝ) ≤ x → z ≤ ub :=
int.exists_greatest_of_bdd
  (let ⟨n, hn⟩ := exists_int_gt x in ⟨n, λ z h',
    int.cast_le.1 $ le_trans h' $ le_of_lt hn⟩)
  (let ⟨n, hn⟩ := exists_int_lt x in ⟨n, le_of_lt hn⟩)

theorem exists_sup (S : set ℝ) : (∃ x, x ∈ S) → (∃ x, ∀ y ∈ S, y ≤ x) →
  ∃ x, ∀ y, x ≤ y ↔ ∀ z ∈ S, z ≤ y
| ⟨L, hL⟩ ⟨U, hU⟩ := begin
  choose f hf using begin
    refine λ d : ℕ, @int.exists_greatest_of_bdd
      (λ n, ∃ y ∈ S, (n:ℝ) ≤ y * d) _ _ _,
    { cases exists_int_gt U with k hk,
      refine ⟨k * d, λ z h, _⟩,
      rcases h with ⟨y, yS, hy⟩,
      refine int.cast_le.1 (le_trans hy _),
      simp,
      exact mul_le_mul_of_nonneg_right
        (le_trans (hU _ yS) (le_of_lt hk)) (nat.cast_nonneg _) },
    { exact ⟨⌊L * d⌋, L, hL, floor_le _⟩ }
  end,
  have hf₁ : ∀ n > 0, ∃ y ∈ S, ((f n / n:ℚ):ℝ) ≤ y := λ n n0,
    let ⟨y, yS, hy⟩ := (hf n).1 in
    ⟨y, yS, by simpa using (div_le_iff ((nat.cast_pos.2 n0):((_:ℝ) < _))).2 hy⟩,
  have hf₂ : ∀ (n > 0) (y ∈ S), (y - (n:ℕ)⁻¹ : ℝ) < (f n / n:ℚ),
  { intros n n0 y yS,
    have := lt_of_lt_of_le (sub_one_lt_floor _)
      (int.cast_le.2 $ (hf n).2 _ ⟨y, yS, floor_le _⟩),
    simp [-sub_eq_add_neg],
    rwa [lt_div_iff ((nat.cast_pos.2 n0):((_:ℝ) < _)), sub_mul, _root_.inv_mul_cancel],
    exact ne_of_gt (nat.cast_pos.2 n0) },
  suffices hg, let g : cau_seq ℚ abs := ⟨λ n, f n / n, hg⟩,
  refine ⟨mk g, λ y, ⟨λ h x xS, le_trans _ h, λ h, _⟩⟩,
  { refine le_of_forall_ge_of_dense (λ z xz, _),
    cases exists_nat_gt (x - z)⁻¹ with K hK,
    refine le_mk_of_forall_le ⟨K, λ n nK, _⟩,
    replace xz := sub_pos.2 xz,
    replace hK := le_trans (le_of_lt hK) (nat.cast_le.2 nK),
    have n0 : 0 < n := nat.cast_pos.1 (lt_of_lt_of_le (inv_pos xz) hK),
    refine le_trans _ (le_of_lt $ hf₂ _ n0 _ xS),
    rwa [le_sub, inv_le ((nat.cast_pos.2 n0):((_:ℝ) < _)) xz] },
  { exact mk_le_of_forall_le ⟨1, λ n n1,
      let ⟨x, xS, hx⟩ := hf₁ _ n1 in le_trans hx (h _ xS)⟩ },
  intros ε ε0,
  suffices : ∀ j k ≥ nat_ceil ε⁻¹, (f j / j - f k / k : ℚ) < ε,
  { refine ⟨_, λ j ij, abs_lt.2 ⟨_, this _ _ ij (le_refl _)⟩⟩,
    rw [neg_lt, neg_sub], exact this _ _ (le_refl _) ij },
  intros j k ij ik,
  replace ij := le_trans (le_nat_ceil _) (nat.cast_le.2 ij),
  replace ik := le_trans (le_nat_ceil _) (nat.cast_le.2 ik),
  have j0 := nat.cast_pos.1 (lt_of_lt_of_le (inv_pos ε0) ij),
  have k0 := nat.cast_pos.1 (lt_of_lt_of_le (inv_pos ε0) ik),
  rcases hf₁ _ j0 with ⟨y, yS, hy⟩,
  refine lt_of_lt_of_le ((@rat.cast_lt ℝ _ _ _).1 _)
    ((inv_le ε0 (nat.cast_pos.2 k0)).1 ik),
  simpa using sub_lt_iff_lt_add'.2
    (lt_of_le_of_lt hy $ sub_lt_iff_lt_add.1 $ hf₂ _ k0 _ yS)
end

noncomputable def Sup (S : set ℝ) : ℝ :=
if h : (∃ x, x ∈ S) ∧ (∃ x, ∀ y ∈ S, y ≤ x)
then classical.some (exists_sup S h.1 h.2) else 0

theorem Sup_le (S : set ℝ) (h₁ : ∃ x, x ∈ S) (h₂ : ∃ x, ∀ y ∈ S, y ≤ x)
  {y} : Sup S ≤ y ↔ ∀ z ∈ S, z ≤ y :=
by simp [Sup, h₁, h₂]; exact
classical.some_spec (exists_sup S h₁ h₂) y

theorem lt_Sup (S : set ℝ) (h₁ : ∃ x, x ∈ S) (h₂ : ∃ x, ∀ y ∈ S, y ≤ x)
  {y} : y < Sup S ↔ ∃ z ∈ S, y < z :=
by simpa [not_forall] using not_congr (@Sup_le S h₁ h₂ y)

theorem le_Sup (S : set ℝ) (h₂ : ∃ x, ∀ y ∈ S, y ≤ x) {x} (xS : x ∈ S) : x ≤ Sup S :=
(Sup_le S ⟨_, xS⟩ h₂).1 (le_refl _) _ xS

theorem Sup_le_ub (S : set ℝ) (h₁ : ∃ x, x ∈ S) {ub} (h₂ : ∀ y ∈ S, y ≤ ub) : Sup S ≤ ub :=
(Sup_le S h₁ ⟨_, h₂⟩).2 h₂

protected lemma is_lub_Sup {s : set ℝ} {a b : ℝ} (ha : a ∈ s) (hb : b ∈ upper_bounds s) :
  is_lub s (Sup s) :=
⟨λ x xs, real.le_Sup s ⟨_, hb⟩ xs,
 λ u h, real.Sup_le_ub _ ⟨_, ha⟩ h⟩

noncomputable def Inf (S : set ℝ) : ℝ := -Sup {x | -x ∈ S}

theorem le_Inf (S : set ℝ) (h₁ : ∃ x, x ∈ S) (h₂ : ∃ x, ∀ y ∈ S, x ≤ y)
  {y} : y ≤ Inf S ↔ ∀ z ∈ S, y ≤ z :=
begin
  refine le_neg.trans ((Sup_le _ _ _).trans _),
  { cases h₁ with x xS, exact ⟨-x, by simp [xS]⟩ },
  { cases h₂ with ub h, exact ⟨-ub, λ y hy, le_neg.1 $ h _ hy⟩ },
  split; intros H z hz,
  { exact neg_le_neg_iff.1 (H _ $ by simp [hz]) },
  { exact le_neg.2 (H _ hz) }
end

theorem Inf_lt (S : set ℝ) (h₁ : ∃ x, x ∈ S) (h₂ : ∃ x, ∀ y ∈ S, x ≤ y)
  {y} : Inf S < y ↔ ∃ z ∈ S, z < y :=
by simpa [not_forall] using not_congr (@le_Inf S h₁ h₂ y)

theorem Inf_le (S : set ℝ) (h₂ : ∃ x, ∀ y ∈ S, x ≤ y) {x} (xS : x ∈ S) : Inf S ≤ x :=
(le_Inf S ⟨_, xS⟩ h₂).1 (le_refl _) _ xS

theorem lb_le_Inf (S : set ℝ) (h₁ : ∃ x, x ∈ S) {lb} (h₂ : ∀ y ∈ S, lb ≤ y) : lb ≤ Inf S :=
(le_Inf S h₁ ⟨_, h₂⟩).2 h₂

open lattice
noncomputable instance lattice : lattice ℝ := by apply_instance

noncomputable instance : conditionally_complete_linear_order ℝ :=
{ Sup := real.Sup,
  Inf := real.Inf,
  le_cSup :=
    assume (s : set ℝ) (a : ℝ) (_ : bdd_above s) (_ : a ∈ s),
    show a ≤ Sup s,
      from le_Sup s ‹bdd_above s› ‹a ∈ s›,
  cSup_le :=
    assume (s : set ℝ) (a : ℝ) (_ : s ≠ ∅) (H : ∀b∈s, b ≤ a),
    show Sup s ≤ a,
      from Sup_le_ub s (set.exists_mem_of_ne_empty ‹s ≠ ∅›) H,
  cInf_le :=
    assume (s : set ℝ) (a : ℝ) (_ : bdd_below s) (_ : a ∈ s),
    show Inf s ≤ a,
      from Inf_le s ‹bdd_below s› ‹a ∈ s›,
  le_cInf :=
    assume (s : set ℝ) (a : ℝ) (_ : s ≠ ∅) (H : ∀b∈s, a ≤ b),
    show a ≤ Inf s,
      from lb_le_Inf s (set.exists_mem_of_ne_empty ‹s ≠ ∅›) H,
  decidable_le := classical.dec_rel _,
 ..real.linear_order, ..real.lattice}

theorem Sup_empty : lattice.Sup (∅ : set ℝ) = 0 := dif_neg $ by simp

theorem Sup_of_not_bdd_above {s : set ℝ} (hs : ¬ bdd_above s) : lattice.Sup s = 0 :=
dif_neg $ assume h, hs h.2

theorem Inf_empty : lattice.Inf (∅ : set ℝ) = 0 :=
show Inf ∅ = 0, by simp [Inf]; exact Sup_empty

theorem Inf_of_not_bdd_below {s : set ℝ} (hs : ¬ bdd_below s) : lattice.Inf s = 0 :=
have bdd_above {x | -x ∈ s} → bdd_below s, from
  assume ⟨b, hb⟩, ⟨-b, assume x hxs, neg_le.2 $ hb _ $ by simp [hxs]⟩,
have ¬ bdd_above {x | -x ∈ s}, from mt this hs,
neg_eq_zero.2 $ Sup_of_not_bdd_above $ this

theorem cau_seq_converges (f : cau_seq ℝ abs) : ∃ x, f ≈ const abs x :=
begin
  let S := {x : ℝ | const abs x < f},
  have lb : ∃ x, x ∈ S := exists_lt f,
  have ub' : ∀ x, f < const abs x → ∀ y ∈ S, y ≤ x :=
    λ x h y yS, le_of_lt $ const_lt.1 $ cau_seq.lt_trans yS h,
  have ub : ∃ x, ∀ y ∈ S, y ≤ x := (exists_gt f).imp ub',
  refine ⟨Sup S,
    ((lt_total _ _).resolve_left (λ h, _)).resolve_right (λ h, _)⟩,
  { rcases h with ⟨ε, ε0, i, ih⟩,
    refine not_lt_of_le (Sup_le_ub S lb (ub' _ _))
      ((sub_lt_self_iff _).2 (half_pos ε0)),
    refine ⟨_, half_pos ε0, i, λ j ij, _⟩,
    rw [sub_apply, const_apply, sub_right_comm,
      le_sub_iff_add_le, add_halves],
    exact ih _ ij },
  { rcases h with ⟨ε, ε0, i, ih⟩,
    refine not_lt_of_le (le_Sup S ub _)
      ((lt_add_iff_pos_left _).2 (half_pos ε0)),
    refine ⟨_, half_pos ε0, i, λ j ij, _⟩,
    rw [sub_apply, const_apply, add_comm, ← sub_sub,
      le_sub_iff_add_le, add_halves],
    exact ih _ ij }
end

noncomputable instance : cau_seq.is_complete ℝ abs := ⟨cau_seq_converges⟩

theorem sqrt_exists : ∀ {x : ℝ}, 0 ≤ x → ∃ y, 0 ≤ y ∧ y * y = x :=
suffices H : ∀ {x : ℝ}, 0 < x → x ≤ 1 → ∃ y, 0 < y ∧ y * y = x, begin
  intros x x0, cases x0,
  cases le_total x 1 with x1 x1,
  { rcases H x0 x1 with ⟨y, y0, hy⟩,
    exact ⟨y, le_of_lt y0, hy⟩ },
  { have := (inv_le_inv x0 zero_lt_one).2 x1,
    rw inv_one at this,
    rcases H (inv_pos x0) this with ⟨y, y0, hy⟩,
    refine ⟨y⁻¹, le_of_lt (inv_pos y0), _⟩, rw [← mul_inv', hy, inv_inv'] },
  { exact ⟨0, by simp [x0.symm]⟩ }
end,
λ x x0 x1, begin
  let S := {y | 0 < y ∧ y * y ≤ x},
  have lb : x ∈ S := ⟨x0, by simpa using (mul_le_mul_right x0).2 x1⟩,
  have ub : ∀ y ∈ S, (y:ℝ) ≤ 1,
  { intros y yS, cases yS with y0 yx,
    refine (mul_self_le_mul_self_iff (le_of_lt y0) zero_le_one).2 _,
    simpa using le_trans yx x1 },
  have S0 : 0 < Sup S := lt_of_lt_of_le x0 (le_Sup _ ⟨_, ub⟩ lb),
  refine ⟨Sup S, S0, le_antisymm (not_lt.1 $ λ h, _) (not_lt.1 $ λ h, _)⟩,
  { rw [← div_lt_iff S0, lt_Sup S ⟨_, lb⟩ ⟨_, ub⟩] at h,
    rcases h with ⟨y, ⟨y0, yx⟩, hy⟩,
    rw [div_lt_iff S0, ← div_lt_iff' y0, lt_Sup S ⟨_, lb⟩ ⟨_, ub⟩] at hy,
    rcases hy with ⟨z, ⟨z0, zx⟩, hz⟩,
    rw [div_lt_iff y0] at hz,
    exact not_lt_of_lt
      ((mul_lt_mul_right y0).1 (lt_of_le_of_lt yx hz))
      ((mul_lt_mul_left z0).1 (lt_of_le_of_lt zx hz)) },
  { let s := Sup S, let y := s + (x - s * s) / 3,
    replace h : 0 < x - s * s := sub_pos.2 h,
    have _30 := bit1_pos zero_le_one,
    have : s < y := (lt_add_iff_pos_right _).2 (div_pos h _30),
    refine not_le_of_lt this (le_Sup S ⟨_, ub⟩ ⟨lt_trans S0 this, _⟩),
    rw [add_mul_self_eq, add_assoc, ← le_sub_iff_add_le', ← add_mul,
      ← le_div_iff (div_pos h _30), div_div_cancel (ne_of_gt h)],
    apply add_le_add,
    { simpa using (mul_le_mul_left (@two_pos ℝ _)).2 (Sup_le_ub _ ⟨_, lb⟩ ub) },
    { rw [div_le_one_iff_le _30],
      refine le_trans (sub_le_self _ (mul_self_nonneg _)) (le_trans x1 _),
      exact (le_add_iff_nonneg_left _).2 (le_of_lt two_pos) } }
end

def sqrt_aux (f : cau_seq ℚ abs) : ℕ → ℚ
| 0       := rat.mk_nat (f 0).num.to_nat.sqrt (f 0).denom.sqrt
| (n + 1) := let s := sqrt_aux n in max 0 $ (s + f (n+1) / s) / 2

theorem sqrt_aux_nonneg (f : cau_seq ℚ abs) : ∀ i : ℕ, 0 ≤ sqrt_aux f i
| 0       := by rw [sqrt_aux, mk_nat_eq, mk_eq_div];
  apply div_nonneg'; exact int.cast_nonneg.2 (int.of_nat_nonneg _)
| (n + 1) := le_max_left _ _

/- TODO(Mario): finish the proof
theorem sqrt_aux_converges (f : cau_seq ℚ abs) : ∃ h x, 0 ≤ x ∧ x * x = max 0 (mk f) ∧
  mk ⟨sqrt_aux f, h⟩ = x :=
begin
  rcases sqrt_exists (le_max_left 0 (mk f)) with ⟨x, x0, hx⟩,
  suffices : ∃ h, mk ⟨sqrt_aux f, h⟩ = x,
  { exact this.imp (λ h e, ⟨x, x0, hx, e⟩) },
  apply of_near,

  suffices : ∃ δ > 0, ∀ i, abs (↑(sqrt_aux f i) - x) < δ / 2 ^ i,
  { rcases this with ⟨δ, δ0, hδ⟩,
    intros,
     }
end -/

noncomputable def sqrt (x : ℝ) : ℝ :=
classical.some (sqrt_exists (le_max_left 0 x))
/-quotient.lift_on x
  (λ f, mk ⟨sqrt_aux f, (sqrt_aux_converges f).fst⟩)
  (λ f g e, begin
    rcases sqrt_aux_converges f with ⟨hf, x, x0, xf, xs⟩,
    rcases sqrt_aux_converges g with ⟨hg, y, y0, yg, ys⟩,
    refine xs.trans (eq.trans _ ys.symm),
    rw [← @mul_self_inj_of_nonneg ℝ _ x y x0 y0, xf, yg],
    congr' 1, exact quotient.sound e
  end)-/

theorem sqrt_prop (x : ℝ) : 0 ≤ sqrt x ∧ sqrt x * sqrt x = max 0 x :=
classical.some_spec (sqrt_exists (le_max_left 0 x))
/-quotient.induction_on x $ λ f,
by rcases sqrt_aux_converges f with ⟨hf, _, x0, xf, rfl⟩; exact ⟨x0, xf⟩-/

theorem sqrt_eq_zero_of_nonpos {x : ℝ} (h : x ≤ 0) : sqrt x = 0 :=
eq_zero_of_mul_self_eq_zero $ (sqrt_prop x).2.trans $ max_eq_left h

theorem sqrt_nonneg (x : ℝ) : 0 ≤ sqrt x := (sqrt_prop x).1

@[simp] theorem mul_self_sqrt {x : ℝ} (h : 0 ≤ x) : sqrt x * sqrt x = x :=
(sqrt_prop x).2.trans (max_eq_right h)

@[simp] theorem sqrt_mul_self {x : ℝ} (h : 0 ≤ x) : sqrt (x * x) = x :=
(mul_self_inj_of_nonneg (sqrt_nonneg _) h).1 (mul_self_sqrt (mul_self_nonneg _))

theorem sqrt_eq_iff_mul_self_eq {x y : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) :
  sqrt x = y ↔ y * y = x :=
⟨λ h, by rw [← h, mul_self_sqrt hx],
 λ h, by rw [← h, sqrt_mul_self hy]⟩

@[simp] theorem sqr_sqrt {x : ℝ} (h : 0 ≤ x) : sqrt x ^ 2 = x :=
by rw [pow_two, mul_self_sqrt h]

@[simp] theorem sqrt_sqr {x : ℝ} (h : 0 ≤ x) : sqrt (x ^ 2) = x :=
by rw [pow_two, sqrt_mul_self h]

theorem sqrt_eq_iff_sqr_eq {x y : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) :
  sqrt x = y ↔ y ^ 2 = x :=
by rw [pow_two, sqrt_eq_iff_mul_self_eq hx hy]

theorem sqrt_mul_self_eq_abs (x : ℝ) : sqrt (x * x) = abs x :=
(le_total 0 x).elim
  (λ h, (sqrt_mul_self h).trans (abs_of_nonneg h).symm)
  (λ h, by rw [← neg_mul_neg,
    sqrt_mul_self (neg_nonneg.2 h), abs_of_nonpos h])

theorem sqrt_sqr_eq_abs (x : ℝ) : sqrt (x ^ 2) = abs x :=
by rw [pow_two, sqrt_mul_self_eq_abs]

@[simp] theorem sqrt_zero : sqrt 0 = 0 :=
by simpa using sqrt_mul_self (le_refl _)

@[simp] theorem sqrt_one : sqrt 1 = 1 :=
by simpa using sqrt_mul_self zero_le_one

@[simp] theorem sqrt_le {x y : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) : sqrt x ≤ sqrt y ↔ x ≤ y :=
by rw [mul_self_le_mul_self_iff (sqrt_nonneg _) (sqrt_nonneg _),
       mul_self_sqrt hx, mul_self_sqrt hy]

@[simp] theorem sqrt_lt {x y : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) : sqrt x < sqrt y ↔ x < y :=
lt_iff_lt_of_le_iff_le (sqrt_le hy hx)

@[simp] theorem sqrt_inj {x y : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) : sqrt x = sqrt y ↔ x = y :=
by simp [le_antisymm_iff, hx, hy]

@[simp] theorem sqrt_eq_zero {x : ℝ} (h : 0 ≤ x) : sqrt x = 0 ↔ x = 0 :=
by simpa using sqrt_inj h (le_refl _)

theorem sqrt_eq_zero' {x : ℝ} : sqrt x = 0 ↔ x ≤ 0 :=
(le_total x 0).elim
  (λ h, by simp [h, sqrt_eq_zero_of_nonpos])
  (λ h, by simp [h]; simp [le_antisymm_iff, h])

@[simp] theorem sqrt_pos {x : ℝ} : 0 < sqrt x ↔ 0 < x :=
lt_iff_lt_of_le_iff_le (iff.trans
  (by simp [le_antisymm_iff, sqrt_nonneg]) sqrt_eq_zero')

@[simp] theorem sqrt_mul' (x) {y : ℝ} (hy : 0 ≤ y) : sqrt (x * y) = sqrt x * sqrt y :=
begin
  cases le_total 0 x with hx hx,
  { refine (mul_self_inj_of_nonneg _ (mul_nonneg _ _)).1 _; try {apply sqrt_nonneg},
    rw [mul_self_sqrt (mul_nonneg hx hy), mul_assoc,
        mul_left_comm (sqrt y), mul_self_sqrt hy, ← mul_assoc, mul_self_sqrt hx] },
  { rw [sqrt_eq_zero'.2 (mul_nonpos_of_nonpos_of_nonneg hx hy),
        sqrt_eq_zero'.2 hx, zero_mul] }
end

@[simp] theorem sqrt_mul {x : ℝ} (hx : 0 ≤ x) (y : ℝ) : sqrt (x * y) = sqrt x * sqrt y :=
by rw [mul_comm, sqrt_mul' _ hx, mul_comm]

@[simp] theorem sqrt_inv (x : ℝ) : sqrt x⁻¹ = (sqrt x)⁻¹ :=
(le_or_lt x 0).elim
  (λ h, by simp [sqrt_eq_zero'.2, inv_nonpos, h])
  (λ h, by rw [
    ← mul_self_inj_of_nonneg (sqrt_nonneg _) (le_of_lt $ inv_pos $ sqrt_pos.2 h),
    mul_self_sqrt (le_of_lt $ inv_pos h), ← mul_inv', mul_self_sqrt (le_of_lt h)])

@[simp] theorem sqrt_div {x : ℝ} (hx : 0 ≤ x) (y : ℝ) : sqrt (x / y) = sqrt x / sqrt y :=
by rw [division_def, sqrt_mul hx, sqrt_inv]; refl

attribute [irreducible] real.le

end real


/-
Copyright (c) 2022 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Devon Tuma
-/
import to_mathlib.sums
import probability.probability_mass_function.uniform

/-!
# Lemmas about probability mass functions to move to mathlib
-/

open_locale measure_theory nnreal ennreal big_operators classical
open measure_theory

variables {α β γ : Type*}

section monad

lemma pmf.pure_eq_iff (a : α) (p : pmf α) : pmf.pure a = p ↔ ∀ x ≠ a, p x = 0 :=
(pmf.ext_iff).trans ⟨λ h x hx, (h x).symm.trans (if_neg hx), λ h x, ite_eq_iff'.2 ⟨λ hxa,
  p.tsum_coe.symm.trans (tsum_eq_single x (λ y hy, h y (hxa ▸ hy))), λ hxa, symm $ h x hxa⟩⟩

@[simp] lemma pmf.map_pure {α β : Type*} (f : α → β) (a : α) :
  (pmf.pure a).map f = pmf.pure (f a) := pmf.pure_map _ _

lemma pmf.bind_apply_eq_one_iff {α β : Type*} (p : pmf α) (q : α → pmf β) (y : β) :
  (p.bind q) y = 1 ↔ ∀ x ∈ p.support, (q x).support ⊆ {y} :=
begin
  rw [pmf.apply_eq_one_iff, pmf.support_bind],
  refine ⟨λ h x hx y' hy', _, λ h, set.subset.antisymm _ _⟩,
  {
    rw ← h,
    simp only [set.mem_Union],
    refine ⟨x, hx, hy'⟩,
  },
  {
    rintro y' ⟨s, ⟨x, hx⟩, hs⟩,
    simp only [] at hx,
    rw ← hx at hs,
    simp only [set.mem_Union] at hs,
    obtain ⟨hx, hx'⟩ := hs,
    refine h x hx hx',
  },
  {
    intros y' hy',
    rw [set.mem_singleton_iff] at hy',

    obtain ⟨rfl⟩ := hy',
    clear hy',
    simp only [set.mem_Union],
    obtain ⟨x, hx⟩ := p.support_nonempty,
    obtain ⟨y', hy'⟩ := (q x).support_nonempty,
    specialize h x hx hy',
    refine ⟨x, hx, _⟩,
    rw [set.mem_singleton_iff] at h,
    refine h ▸ hy'
  }
end

end monad

section union

lemma pmf.measurable_set_to_outer_measure_caratheodory (p : pmf α) (s : set α) :
  measurable_set[p.to_outer_measure.caratheodory] s :=
p.to_outer_measure_caratheodory.symm ▸ measurable_space.measurable_set_top

lemma pmf.to_measure_apply_Union {α : Type*} [measurable_space α] (p : pmf α)
  {f : ℕ → set α} (hf : ∀ n, measurable_set (f n)) (h : pairwise (disjoint on f)) :
  p.to_measure (⋃ n, f n) = ∑' n, p.to_measure (f n) :=
p.to_measure.m_Union hf h

lemma pmf.to_measure_apply_union {α : Type*} [measurable_space α] (p : pmf α)
  {s t : set α} (ht : measurable_set t) (h : disjoint s t) :
  p.to_measure (s ∪ t) = p.to_measure s + p.to_measure t :=
measure_theory.measure_union h ht

lemma pmf.to_outer_measure_apply_Union {α : Type*} (p : pmf α) {f : ℕ → set α}
  (h : pairwise (disjoint on f)) : p.to_outer_measure (⋃ n, f n) = ∑' n, p.to_outer_measure (f n) :=
measure_theory.outer_measure.Union_eq_of_caratheodory _
  (λ n, pmf.measurable_set_to_outer_measure_caratheodory _ (f n)) h

lemma pmf.to_outer_measure_apply_union {α : Type*} (p : pmf α) {s t : set α}
  (h : disjoint s t) : p.to_outer_measure (s ∪ t) = p.to_outer_measure s + p.to_outer_measure t :=
begin
  sorry
end

lemma pmf.to_measure_apply_union_add_inter [measurable_space α]
  (p : pmf α) (s t : set α) (h : measurable_set t) :
  p.to_measure (s ∪ t) + p.to_measure (s ∩ t) = p.to_measure s + p.to_measure t :=
measure_theory.measure_union_add_inter s h

lemma pmf.to_outer_measure_apply_union_add_inter (p : pmf α) (s t : set α) :
  p.to_outer_measure (s ∪ t) + p.to_outer_measure (s ∩ t) =
    p.to_outer_measure s + p.to_outer_measure t :=
begin
  sorry
end

end union

section prod

/-- If and intermediate distribution is a product, can express the probability as a
double sum rather than a sum over a `prod` type. -/
lemma pmf.prod_bind_apply {α β γ : Type*}
  (p : pmf (α × β)) (q : α × β → pmf γ) (c : γ) :
  p.bind q c = ∑' (a : α) (b : β), p (a, b) * q (a, b) c :=
tsum_prod' ennreal.summable $ λ _, ennreal.summable

lemma pmf.prod_bind_apply' {α β γ : Type*}
  (p : pmf (α × β)) (q : α × β → pmf γ) (c : γ) :
  p.bind q c = ∑' (b : β) (a : α), p (a, b) * q (a, b) c :=
(pmf.prod_bind_apply p q c).trans (by rw ennreal.tsum_comm)

/-- First output of a computation of a `prod` type as a summation over possible second outputs. -/
lemma pmf.map_fst_apply {α β : Type*} (p : pmf (α × β)) (a : α) :
  p.map prod.fst a = ∑' (b : β), p (a, b) :=
calc p.map prod.fst a = ∑' (a' : α) (b : β), ite (a = a') (p (a', b)) 0 :
    by simp_rw [pmf.map, pmf.prod_bind_apply p, function.comp_apply,
      pmf.pure_apply, mul_ite, mul_one, mul_zero]
  ... = ∑' (b : β), ite (a = a) (p (a, b)) 0 :
    tsum_eq_single _ (λ a' ha', by simp only [ne.symm ha', if_false, tsum_zero])
  ... = ∑' (b : β), p (a, b) : by simp only [eq_self_iff_true, if_true]

/-- Second output of a computation of a `prod` type as a summation over possible first outputs. -/
lemma pmf.map_snd_apply {α β : Type*} (p : pmf (α × β)) (b : β) :
  p.map prod.snd b = ∑' (a : α), p (a, b) :=
calc p.map prod.snd b = ∑' (b' : β) (a : α), ite (b = b') (p (a, b')) 0 :
    by simp_rw [pmf.map, pmf.prod_bind_apply' p, function.comp_apply,
      pmf.pure_apply, mul_ite, mul_one, mul_zero]
  ... = ∑' (a : α), ite (b = b) (p (a, b)) 0 :
    tsum_eq_single _ (λ a' ha', by simp only [ne.symm ha', if_false, tsum_zero])
  ... = ∑' (a : α), p (a, b) : by simp only [eq_self_iff_true, if_true]

end prod

section outer_measure

lemma pmf.to_outer_measure_apply_insert (p : pmf α) (x : α) (s : set α) :
  p.to_outer_measure (insert x s) = p x + p.to_outer_measure (s \ {x}) :=
begin
  rw [← set.union_singleton], sorry
  -- rw [pmf.to_outer_measure_apply_Union]
end

lemma pmf.to_outer_measure_apply_diff (p : pmf α) (s t : set α) :
  p.to_outer_measure (s \ t) = p.to_outer_measure s - p.to_outer_measure (s ∩ t) :=
sorry

end outer_measure


/-
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, Jeremy Avigad, Yury Kudryashov
-/
import order.filter.cofinite
import order.zorn

/-!
# Ultrafilters

An ultrafilter is a minimal (maximal in the set order) proper filter.
In this file we define

* `ultrafilter.of`: an ultrafilter that is less than or equal to a given filter;
* `ultrafilter`: subtype of ultrafilters;
* `ultrafilter.pure`: `pure x` as an `ultrafiler`;
* `ultrafilter.map`, `ultrafilter.bind`, `ultrafilter.comap` : operations on ultrafilters;
* `hyperfilter`: the ultrafilter extending the cofinite filter.
-/

universes u v
variables {α : Type u} {β : Type v}

open set zorn filter function
open_locale classical filter

/-- An ultrafilter is a minimal (maximal in the set order) proper filter. -/
@[protect_proj]
structure ultrafilter (α : Type*) extends filter α :=
(ne_bot' : ne_bot to_filter)
(le_of_le : ∀ g, filter.ne_bot g → g ≤ to_filter → to_filter ≤ g)

namespace ultrafilter

variables {f g : ultrafilter α} {s t : set α} {p q : α → Prop}

instance : has_coe_t (ultrafilter α) (filter α) := ⟨ultrafilter.to_filter⟩

instance : has_mem (set α) (ultrafilter α) := ⟨λ s f, s ∈ (f : filter α)⟩

lemma unique (f : ultrafilter α) {g : filter α} (h : g ≤ f)
  (hne : ne_bot g . tactic.apply_instance) : g = f :=
le_antisymm h $ f.le_of_le g hne h

instance ne_bot (f : ultrafilter α) : ne_bot (f : filter α) := f.ne_bot'

@[simp, norm_cast] lemma mem_coe : s ∈ (f : filter α) ↔ s ∈ f := iff.rfl

lemma coe_injective : injective (coe : ultrafilter α → filter α)
| ⟨f, h₁, h₂⟩ ⟨g, h₃, h₄⟩ rfl := by congr

lemma eq_of_le {f g : ultrafilter α} (h : (f : filter α) ≤ g) : f = g :=
coe_injective (g.unique h)

@[simp, norm_cast] lemma coe_le_coe {f g : ultrafilter α} : (f : filter α) ≤ g ↔ f = g :=
⟨λ h, eq_of_le h, λ h, h ▸ le_rfl⟩

@[simp, norm_cast] lemma coe_inj : (f : filter α) = g ↔ f = g := coe_injective.eq_iff

@[ext] lemma ext ⦃f g : ultrafilter α⦄ (h : ∀ s, s ∈ f ↔ s ∈ g) : f = g :=
coe_injective $ filter.ext h

lemma le_of_inf_ne_bot (f : ultrafilter α) {g : filter α} (hg : ne_bot (↑f ⊓ g)) : ↑f ≤ g :=
le_of_inf_eq (f.unique inf_le_left hg)

lemma le_of_inf_ne_bot' (f : ultrafilter α) {g : filter α} (hg : ne_bot (g ⊓ f)) : ↑f ≤ g :=
f.le_of_inf_ne_bot $ by rwa inf_comm

@[simp] lemma compl_not_mem_iff : sᶜ ∉ f ↔ s ∈ f :=
⟨λ hsc, le_principal_iff.1 $ f.le_of_inf_ne_bot
  ⟨λ h, hsc $ mem_of_eq_bot$ by rwa compl_compl⟩, compl_not_mem⟩

@[simp] lemma frequently_iff_eventually : (∃ᶠ x in f, p x) ↔ ∀ᶠ x in f, p x :=
compl_not_mem_iff

alias frequently_iff_eventually ↔ filter.frequently.eventually _

lemma compl_mem_iff_not_mem : sᶜ ∈ f ↔ s ∉ f := by rw [← compl_not_mem_iff, compl_compl]

lemma diff_mem_iff (f : ultrafilter α) : s \ t ∈ f ↔ s ∈ f ∧ t ∉ f :=
inter_mem_iff.trans $ and_congr iff.rfl compl_mem_iff_not_mem

/-- If `sᶜ ∉ f ↔ s ∈ f`, then `f` is an ultrafilter. The other implication is given by
`ultrafilter.compl_not_mem_iff`.  -/
def of_compl_not_mem_iff (f : filter α) (h : ∀ s, sᶜ ∉ f ↔ s ∈ f) : ultrafilter α :=
{ to_filter := f,
  ne_bot' := ⟨λ hf, by simpa [hf] using h⟩,
  le_of_le := λ g hg hgf s hs, (h s).1 $ λ hsc, by exactI compl_not_mem hs (hgf hsc) }

lemma nonempty_of_mem (hs : s ∈ f) : s.nonempty := nonempty_of_mem hs
lemma ne_empty_of_mem (hs : s ∈ f) : s ≠ ∅ := (nonempty_of_mem hs).ne_empty
@[simp] lemma empty_not_mem : ∅ ∉ f := empty_not_mem f

lemma mem_or_compl_mem (f : ultrafilter α) (s : set α) : s ∈ f ∨ sᶜ ∈ f :=
or_iff_not_imp_left.2 compl_mem_iff_not_mem.2

protected lemma em (f : ultrafilter α) (p : α → Prop) :
  (∀ᶠ x in f, p x) ∨ ∀ᶠ x in f, ¬p x :=
f.mem_or_compl_mem {x | p x}

lemma eventually_or : (∀ᶠ x in f, p x ∨ q x) ↔ (∀ᶠ x in f, p x) ∨ ∀ᶠ x in f, q x :=
⟨λ H, (f.em p).imp_right $ λ hp, (H.and hp).mono $ λ x ⟨hx, hnx⟩, hx.resolve_left hnx,
  λ H, H.elim (λ hp, hp.mono $ λ x, or.inl) (λ hp, hp.mono $ λ x, or.inr)⟩

lemma union_mem_iff : s ∪ t ∈ f ↔ s ∈ f ∨ t ∈ f := eventually_or

lemma eventually_not : (∀ᶠ x in f, ¬p x) ↔ ¬∀ᶠ x in f, p x := compl_mem_iff_not_mem

lemma eventually_imp : (∀ᶠ x in f, p x → q x) ↔ (∀ᶠ x in f, p x) → ∀ᶠ x in f, q x :=
by simp only [imp_iff_not_or, eventually_or, eventually_not]

lemma finite_sUnion_mem_iff {s : set (set α)} (hs : finite s) : ⋃₀ s ∈ f ↔ ∃t∈s, t ∈ f :=
finite.induction_on hs (by simp) $ λ a s ha hs his,
  by simp [union_mem_iff, his, or_and_distrib_right, exists_or_distrib]

lemma finite_bUnion_mem_iff {is : set β} {s : β → set α} (his : finite is) :
  (⋃i∈is, s i) ∈ f ↔ ∃i∈is, s i ∈ f :=
by simp only [← sUnion_image, finite_sUnion_mem_iff (his.image s), bex_image_iff]

/-- Pushforward for ultrafilters. -/
def map (m : α → β) (f : ultrafilter α) : ultrafilter β :=
of_compl_not_mem_iff (map m f) $ λ s, @compl_not_mem_iff _ f (m ⁻¹' s)

@[simp, norm_cast] lemma coe_map (m : α → β) (f : ultrafilter α) :
  (map m f : filter β) = filter.map m ↑f := rfl

@[simp] lemma mem_map {m : α → β} {f : ultrafilter α} {s : set β} :
  s ∈ map m f ↔ m ⁻¹' s ∈ f := iff.rfl

/-- The pullback of an ultrafilter along an injection whose range is large with respect to the given
ultrafilter. -/
def comap {m : α → β} (u : ultrafilter β) (inj : injective m)
  (large : set.range m ∈ u) : ultrafilter α :=
{ to_filter := comap m u,
  ne_bot' := u.ne_bot'.comap_of_range_mem large,
  le_of_le := λ g hg hgu, by { resetI,
    simp only [← u.unique (map_le_iff_le_comap.2 hgu), comap_map inj, le_rfl] } }

@[simp] lemma mem_comap {m : α → β} (u : ultrafilter β) (inj : injective m)
  (large : set.range m ∈ u) {s : set α} :
  s ∈ u.comap inj large ↔ m '' s ∈ u :=
mem_comap_iff inj large

@[simp] lemma coe_comap {m : α → β} (u : ultrafilter β) (inj : injective m)
  (large : set.range m ∈ u) : (u.comap inj large : filter α) = filter.comap m u := rfl

/-- The principal ultrafilter associated to a point `x`. -/
instance : has_pure ultrafilter :=
⟨λ α a, of_compl_not_mem_iff (pure a) $ λ s, by simp⟩

@[simp] lemma mem_pure {a : α} {s : set α} : s ∈ (pure a : ultrafilter α) ↔ a ∈ s := iff.rfl

instance [inhabited α] : inhabited (ultrafilter α) := ⟨pure default⟩
instance [nonempty α] : nonempty (ultrafilter α) := nonempty.map pure infer_instance

lemma eq_principal_of_finite_mem {f : ultrafilter α} {s : set α} (h : s.finite) (h' : s ∈ f) :
  ∃ x ∈ s, (f : filter α) = pure x :=
begin
  rw ← bUnion_of_singleton s at h',
  rcases (ultrafilter.finite_bUnion_mem_iff h).mp h' with ⟨a, has, haf⟩,
  use [a, has],
  change (f : filter α) = (pure a : ultrafilter α),
  rw [ultrafilter.coe_inj, ← ultrafilter.coe_le_coe],
  change (f : filter α) ≤ pure a,
  rwa [← principal_singleton, le_principal_iff]
end

/-- Monadic bind for ultrafilters, coming from the one on filters
defined in terms of map and join.-/
def bind (f : ultrafilter α) (m : α → ultrafilter β) : ultrafilter β :=
of_compl_not_mem_iff (bind ↑f (λ x, ↑(m x))) $ λ s,
  by simp only [mem_bind', mem_coe, ← compl_mem_iff_not_mem, compl_set_of, compl_compl]

instance has_bind : has_bind ultrafilter := ⟨@ultrafilter.bind⟩
instance functor : functor ultrafilter := { map := @ultrafilter.map }
instance monad : monad ultrafilter := { map := @ultrafilter.map }

section

local attribute [instance] filter.monad filter.is_lawful_monad

instance is_lawful_monad : is_lawful_monad ultrafilter :=
{ id_map := assume α f, coe_injective (id_map f.1),
  pure_bind := assume α β a f, coe_injective (pure_bind a (coe ∘ f)),
  bind_assoc := assume α β γ f m₁ m₂, coe_injective (filter_eq rfl),
  bind_pure_comp_eq_map := assume α β f x, coe_injective (bind_pure_comp_eq_map f x.1) }

end

/-- The ultrafilter lemma: Any proper filter is contained in an ultrafilter. -/

alias exists_le ← filter.exists_ultrafilter_le

/-- Construct an ultrafilter extending a given filter.
  The ultrafilter lemma is the assertion that such a filter exists;
  we use the axiom of choice to pick one. -/
noncomputable def of (f : filter α) [ne_bot f] : ultrafilter α :=
classical.some (exists_le f)

lemma of_le (f : filter α) [ne_bot f] : ↑(of f) ≤ f := classical.some_spec (exists_le f)

lemma of_coe (f : ultrafilter α) : of ↑f = f :=
coe_inj.1 $ f.unique (of_le f)

lemma exists_ultrafilter_of_finite_inter_nonempty (S : set (set α))
  (cond : ∀ T : finset (set α), (↑T : set (set α)) ⊆ S → (⋂₀ (↑T : set (set α))).nonempty) :
  ∃ F : ultrafilter α, S ⊆ F.sets :=
begin
  suffices : ∃ F : filter α, ne_bot F ∧ S ⊆ F.sets,
  { rcases this with ⟨F, cond, hF⟩,
    resetI,
    obtain ⟨G : ultrafilter α, h1 : ↑G ≤ F⟩ := exists_le F,
    exact ⟨G, λ T hT, h1 (hF hT)⟩ },
  use filter.generate S,
  refine ⟨_, λ T hT, filter.generate_sets.basic hT⟩,
  rw ← forall_mem_nonempty_iff_ne_bot,
  intros T hT,
  rcases mem_generate_iff.mp hT with ⟨A, h1, h2, h3⟩,
  let B := set.finite.to_finset h2,
  rw (show A = ↑B, by simp) at *,
  rcases cond B h1 with ⟨x, hx⟩,
  exact ⟨x, h3 hx⟩,
end

end ultrafilter

namespace filter

open ultrafilter

lemma mem_iff_ultrafilter {s : set α} {f : filter α} :
  s ∈ f ↔ ∀ g : ultrafilter α, ↑g ≤ f → s ∈ g :=
begin
  refine ⟨λ hf g hg, hg hf, λ H, by_contra $ λ hf, _⟩,
  set g : filter ↥sᶜ := comap coe f,
  haveI : ne_bot g := comap_ne_bot_iff_compl_range.2 (by simpa [compl_set_of]),
  simpa using H ((of g).map coe) (map_le_iff_le_comap.mpr (of_le g))
end

lemma le_iff_ultrafilter {f₁ f₂ : filter α} : f₁ ≤ f₂ ↔ ∀ g : ultrafilter α, ↑g ≤ f₁ → ↑g ≤ f₂ :=
⟨λ h g h₁, h₁.trans h, λ h s hs, mem_iff_ultrafilter.2 $ λ g hg, h g hg hs⟩

/-- A filter equals the intersection of all the ultrafilters which contain it. -/
lemma supr_ultrafilter_le_eq (f : filter α) :
  (⨆ (g : ultrafilter α) (hg : ↑g ≤ f), (g : filter α)) = f :=
eq_of_forall_ge_iff $ λ f', by simp only [supr_le_iff, ← le_iff_ultrafilter]

/-- The `tendsto` relation can be checked on ultrafilters. -/
lemma tendsto_iff_ultrafilter (f : α → β) (l₁ : filter α) (l₂ : filter β) :
  tendsto f l₁ l₂ ↔ ∀ g : ultrafilter α, ↑g ≤ l₁ → tendsto f g l₂ :=
by simpa only [tendsto_iff_comap] using le_iff_ultrafilter

lemma exists_ultrafilter_iff {f : filter α} : (∃ (u : ultrafilter α), ↑u ≤ f) ↔ ne_bot f :=
⟨λ ⟨u, uf⟩, ne_bot_of_le uf, λ h, @exists_ultrafilter_le _ _ h⟩

lemma forall_ne_bot_le_iff {g : filter α} {p : filter α → Prop} (hp : monotone p) :
  (∀ f : filter α, ne_bot f → f ≤ g → p f) ↔ ∀ f : ultrafilter α, ↑f ≤ g → p f :=
begin
  refine ⟨λ H f hf, H f f.ne_bot hf, _⟩,
  introsI H f hf hfg,
  exact hp (of_le f) (H _ ((of_le f).trans hfg))
end

section hyperfilter

variables (α) [infinite α]

/-- The ultrafilter extending the cofinite filter. -/
noncomputable def hyperfilter : ultrafilter α := ultrafilter.of cofinite

variable {α}

lemma hyperfilter_le_cofinite : ↑(hyperfilter α) ≤ @cofinite α :=
ultrafilter.of_le cofinite

@[simp] lemma bot_ne_hyperfilter : (⊥ : filter α) ≠ hyperfilter α :=
(by apply_instance : ne_bot ↑(hyperfilter α)).1.symm

theorem nmem_hyperfilter_of_finite {s : set α} (hf : s.finite) : s ∉ hyperfilter α :=
λ hy, compl_not_mem hy $ hyperfilter_le_cofinite hf.compl_mem_cofinite

alias nmem_hyperfilter_of_finite ← set.finite.nmem_hyperfilter

theorem compl_mem_hyperfilter_of_finite {s : set α} (hf : set.finite s) :
  sᶜ ∈ hyperfilter α :=
compl_mem_iff_not_mem.2 hf.nmem_hyperfilter

alias compl_mem_hyperfilter_of_finite ← set.finite.compl_mem_hyperfilter

theorem mem_hyperfilter_of_finite_compl {s : set α} (hf : set.finite sᶜ) :
  s ∈ hyperfilter α :=
compl_compl s ▸ hf.compl_mem_hyperfilter

end hyperfilter

end filter

namespace ultrafilter

open filter

variables {m : α → β} {s : set α} {g : ultrafilter β}

lemma comap_inf_principal_ne_bot_of_image_mem (h : m '' s ∈ g) :
  (filter.comap m g ⊓ 𝓟 s).ne_bot :=
filter.comap_inf_principal_ne_bot_of_image_mem g.ne_bot h

/-- Ultrafilter extending the inf of a comapped ultrafilter and a principal ultrafilter. -/
noncomputable def of_comap_inf_principal (h : m '' s ∈ g) : ultrafilter α :=
@of _ (filter.comap m g ⊓ 𝓟 s) (comap_inf_principal_ne_bot_of_image_mem h)

lemma of_comap_inf_principal_mem (h : m '' s ∈ g) : s ∈ of_comap_inf_principal h :=
begin
  let f := filter.comap m g ⊓ 𝓟 s,
  haveI : f.ne_bot := comap_inf_principal_ne_bot_of_image_mem h,
  have : s ∈ f := mem_inf_of_right (mem_principal_self s),
  exact le_def.mp (of_le _) s this
end

lemma of_comap_inf_principal_eq_of_map (h : m '' s ∈ g) :
  (of_comap_inf_principal h).map m = g :=
begin
  let f := filter.comap m g ⊓ 𝓟 s,
  haveI : f.ne_bot := comap_inf_principal_ne_bot_of_image_mem h,
  apply eq_of_le,
  calc filter.map m (of f) ≤ filter.map m f : map_mono (of_le _)
  ... ≤ (filter.map m $ filter.comap m g) ⊓ filter.map m (𝓟 s) : map_inf_le
  ... = (filter.map m $ filter.comap m g) ⊓ (𝓟 $ m '' s) : by rw map_principal
  ... ≤ g ⊓ (𝓟 $ m '' s) : inf_le_inf_right _ map_comap_le
  ... = g : inf_of_le_left (le_principal_iff.mpr h)
end

end ultrafilter


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import measure_theory.measure.giry_monad
import dynamics.ergodic.measure_preserving
import measure_theory.integral.set_integral
import measure_theory.measure.open_pos

/-!
# The product measure

In this file we define and prove properties about the binary product measure. If `α` and `β` have
σ-finite measures `μ` resp. `ν` then `α × β` can be equipped with a σ-finite measure `μ.prod ν` that
satisfies `(μ.prod ν) s = ∫⁻ x, ν {y | (x, y) ∈ s} ∂μ`.
We also have `(μ.prod ν) (s ×ˢ t) = μ s * ν t`, i.e. the measure of a rectangle is the product of
the measures of the sides.

We also prove Tonelli's theorem and Fubini's theorem.

## Main definition

* `measure_theory.measure.prod`: The product of two measures.

## Main results

* `measure_theory.measure.prod_apply` states `μ.prod ν s = ∫⁻ x, ν {y | (x, y) ∈ s} ∂μ`
  for measurable `s`. `measure_theory.measure.prod_apply_symm` is the reversed version.
* `measure_theory.measure.prod_prod` states `μ.prod ν (s ×ˢ t) = μ s * ν t` for measurable sets
  `s` and `t`.
* `measure_theory.lintegral_prod`: Tonelli's theorem. It states that for a measurable function
  `α × β → ℝ≥0∞` we have `∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ x, ∫⁻ y, f (x, y) ∂ν ∂μ`. The version
  for functions `α → β → ℝ≥0∞` is reversed, and called `lintegral_lintegral`. Both versions have
  a variant with `_symm` appended, where the order of integration is reversed.
  The lemma `measurable.lintegral_prod_right'` states that the inner integral of the right-hand side
  is measurable.
* `measure_theory.integrable_prod_iff` states that a binary function is integrable iff both
  * `y ↦ f (x, y)` is integrable for almost every `x`, and
  * the function `x ↦ ∫ ‖f (x, y)‖ dy` is integrable.
* `measure_theory.integral_prod`: Fubini's theorem. It states that for a integrable function
  `α × β → E` (where `E` is a second countable Banach space) we have
  `∫ z, f z ∂(μ.prod ν) = ∫ x, ∫ y, f (x, y) ∂ν ∂μ`. This theorem has the same variants as
  Tonelli's theorem. The lemma `measure_theory.integrable.integral_prod_right` states that the
  inner integral of the right-hand side is integrable.

## Implementation Notes

Many results are proven twice, once for functions in curried form (`α → β → γ`) and one for
functions in uncurried form (`α × β → γ`). The former often has an assumption
`measurable (uncurry f)`, which could be inconvenient to discharge, but for the latter it is more
common that the function has to be given explicitly, since Lean cannot synthesize the function by
itself. We name the lemmas about the uncurried form with a prime.
Tonelli's theorem and Fubini's theorem have a different naming scheme, since the version for the
uncurried version is reversed.

## Tags

product measure, Fubini's theorem, Tonelli's theorem, Fubini-Tonelli theorem
-/

noncomputable theory
open_locale classical topology ennreal measure_theory
open set function real ennreal
open measure_theory measurable_space measure_theory.measure
open topological_space (hiding generate_from)
open filter (hiding prod_eq map)

variables {α α' β β' γ E : Type*}

/-- Rectangles formed by π-systems form a π-system. -/
lemma is_pi_system.prod {C : set (set α)} {D : set (set β)} (hC : is_pi_system C)
  (hD : is_pi_system D) : is_pi_system (image2 (×ˢ) C D) :=
begin
  rintro _ ⟨s₁, t₁, hs₁, ht₁, rfl⟩ _ ⟨s₂, t₂, hs₂, ht₂, rfl⟩ hst,
  rw [prod_inter_prod] at hst ⊢, rw [prod_nonempty_iff] at hst,
  exact mem_image2_of_mem (hC _ hs₁ _ hs₂ hst.1) (hD _ ht₁ _ ht₂ hst.2)
end

/-- Rectangles of countably spanning sets are countably spanning. -/
lemma is_countably_spanning.prod {C : set (set α)} {D : set (set β)}
  (hC : is_countably_spanning C) (hD : is_countably_spanning D) :
  is_countably_spanning (image2 (×ˢ) C D) :=
begin
  rcases ⟨hC, hD⟩ with ⟨⟨s, h1s, h2s⟩, t, h1t, h2t⟩,
  refine ⟨λ n, (s n.unpair.1) ×ˢ (t n.unpair.2), λ n, mem_image2_of_mem (h1s _) (h1t _), _⟩,
  rw [Union_unpair_prod, h2s, h2t, univ_prod_univ]
end

variables [measurable_space α] [measurable_space α'] [measurable_space β] [measurable_space β']
variables [measurable_space γ]
variables {μ μ' : measure α} {ν ν' : measure β} {τ : measure γ}
variables [normed_add_comm_group E]

/-! ### Measurability

Before we define the product measure, we can talk about the measurability of operations on binary
functions. We show that if `f` is a binary measurable function, then the function that integrates
along one of the variables (using either the Lebesgue or Bochner integral) is measurable.
-/

/-- The product of generated σ-algebras is the one generated by rectangles, if both generating sets
  are countably spanning. -/
lemma generate_from_prod_eq {α β} {C : set (set α)} {D : set (set β)}
  (hC : is_countably_spanning C) (hD : is_countably_spanning D) :
  @prod.measurable_space _ _ (generate_from C) (generate_from D) =
    generate_from (image2 (×ˢ) C D) :=
begin
  apply le_antisymm,
  { refine sup_le _ _; rw [comap_generate_from];
      apply generate_from_le; rintro _ ⟨s, hs, rfl⟩,
    { rcases hD with ⟨t, h1t, h2t⟩,
      rw [← prod_univ, ← h2t, prod_Union],
      apply measurable_set.Union,
      intro n, apply measurable_set_generate_from,
      exact ⟨s, t n, hs, h1t n, rfl⟩ },
    { rcases hC with ⟨t, h1t, h2t⟩,
      rw [← univ_prod, ← h2t, Union_prod_const],
      apply measurable_set.Union,
      rintro n, apply measurable_set_generate_from,
      exact mem_image2_of_mem (h1t n) hs } },
  { apply generate_from_le, rintro _ ⟨s, t, hs, ht, rfl⟩, rw [prod_eq],
    apply (measurable_fst _).inter (measurable_snd _),
    { exact measurable_set_generate_from hs },
    { exact measurable_set_generate_from ht } }
end

/-- If `C` and `D` generate the σ-algebras on `α` resp. `β`, then rectangles formed by `C` and `D`
  generate the σ-algebra on `α × β`. -/
lemma generate_from_eq_prod {C : set (set α)} {D : set (set β)} (hC : generate_from C = ‹_›)
  (hD : generate_from D = ‹_›) (h2C : is_countably_spanning C) (h2D : is_countably_spanning D) :
    generate_from (image2 (×ˢ) C D) = prod.measurable_space :=
by rw [← hC, ← hD, generate_from_prod_eq h2C h2D]

/-- The product σ-algebra is generated from boxes, i.e. `s ×ˢ t` for sets `s : set α` and
  `t : set β`. -/
lemma generate_from_prod :
  generate_from (image2 (×ˢ) {s : set α | measurable_set s} {t : set β | measurable_set t}) =
  prod.measurable_space :=
generate_from_eq_prod generate_from_measurable_set generate_from_measurable_set
  is_countably_spanning_measurable_set is_countably_spanning_measurable_set

/-- Rectangles form a π-system. -/
lemma is_pi_system_prod :
  is_pi_system (image2 (×ˢ) {s : set α | measurable_set s} {t : set β | measurable_set t}) :=
is_pi_system_measurable_set.prod is_pi_system_measurable_set

/-- If `ν` is a finite measure, and `s ⊆ α × β` is measurable, then `x ↦ ν { y | (x, y) ∈ s }` is
  a measurable function. `measurable_measure_prod_mk_left` is strictly more general. -/
lemma measurable_measure_prod_mk_left_finite [is_finite_measure ν] {s : set (α × β)}
  (hs : measurable_set s) : measurable (λ x, ν (prod.mk x ⁻¹' s)) :=
begin
  refine induction_on_inter generate_from_prod.symm is_pi_system_prod _ _ _ _ hs,
  { simp [measurable_zero, const_def] },
  { rintro _ ⟨s, t, hs, ht, rfl⟩, simp only [mk_preimage_prod_right_eq_if, measure_if],
    exact measurable_const.indicator hs },
  { intros t ht h2t,
    simp_rw [preimage_compl, measure_compl (measurable_prod_mk_left ht) (measure_ne_top ν _)],
    exact h2t.const_sub _ },
  { intros f h1f h2f h3f, simp_rw [preimage_Union],
    have : ∀ b, ν (⋃ i, prod.mk b ⁻¹' f i) = ∑' i, ν (prod.mk b ⁻¹' f i) :=
      λ b, measure_Union (λ i j hij, disjoint.preimage _ (h1f hij))
        (λ i, measurable_prod_mk_left (h2f i)),
    simp_rw [this], apply measurable.ennreal_tsum h3f },
end

/-- If `ν` is a σ-finite measure, and `s ⊆ α × β` is measurable, then `x ↦ ν { y | (x, y) ∈ s }` is
  a measurable function. -/
lemma measurable_measure_prod_mk_left [sigma_finite ν] {s : set (α × β)}
  (hs : measurable_set s) : measurable (λ x, ν (prod.mk x ⁻¹' s)) :=
begin
  have : ∀ x, measurable_set (prod.mk x ⁻¹' s) := λ x, measurable_prod_mk_left hs,
  simp only [← @supr_restrict_spanning_sets _ _ ν, this],
  apply measurable_supr, intro i,
  haveI := fact.mk (measure_spanning_sets_lt_top ν i),
  exact measurable_measure_prod_mk_left_finite hs
end

/-- If `μ` is a σ-finite measure, and `s ⊆ α × β` is measurable, then `y ↦ μ { x | (x, y) ∈ s }` is
  a measurable function. -/
lemma measurable_measure_prod_mk_right {μ : measure α} [sigma_finite μ] {s : set (α × β)}
  (hs : measurable_set s) : measurable (λ y, μ ((λ x, (x, y)) ⁻¹' s)) :=
measurable_measure_prod_mk_left (measurable_set_swap_iff.mpr hs)

lemma measurable.map_prod_mk_left [sigma_finite ν] : measurable (λ x : α, map (prod.mk x) ν) :=
begin
  apply measurable_of_measurable_coe, intros s hs,
  simp_rw [map_apply measurable_prod_mk_left hs],
  exact measurable_measure_prod_mk_left hs
end

lemma measurable.map_prod_mk_right {μ : measure α} [sigma_finite μ] :
  measurable (λ y : β, map (λ x : α, (x, y)) μ) :=
begin
  apply measurable_of_measurable_coe, intros s hs,
  simp_rw [map_apply measurable_prod_mk_right hs],
  exact measurable_measure_prod_mk_right hs
end

/-- The Lebesgue integral is measurable. This shows that the integrand of (the right-hand-side of)
  Tonelli's theorem is measurable. -/
lemma measurable.lintegral_prod_right' [sigma_finite ν] :
  ∀ {f : α × β → ℝ≥0∞} (hf : measurable f), measurable (λ x, ∫⁻ y, f (x, y) ∂ν) :=
begin
  have m := @measurable_prod_mk_left,
  refine measurable.ennreal_induction _ _ _,
  { intros c s hs, simp only [← indicator_comp_right],
    suffices : measurable (λ x, c * ν (prod.mk x ⁻¹' s)),
    { simpa [lintegral_indicator _ (m hs)] },
    exact (measurable_measure_prod_mk_left hs).const_mul _ },
  { rintro f g - hf hg h2f h2g, simp_rw [pi.add_apply, lintegral_add_left (hf.comp m)],
    exact h2f.add h2g },
  { intros f hf h2f h3f,
    have := measurable_supr h3f,
    have : ∀ x, monotone (λ n y, f n (x, y)) := λ x i j hij y, h2f hij (x, y),
    simpa [lintegral_supr (λ n, (hf n).comp m), this] }
end

/-- The Lebesgue integral is measurable. This shows that the integrand of (the right-hand-side of)
  Tonelli's theorem is measurable.
  This version has the argument `f` in curried form. -/
lemma measurable.lintegral_prod_right [sigma_finite ν] {f : α → β → ℝ≥0∞}
  (hf : measurable (uncurry f)) : measurable (λ x, ∫⁻ y, f x y ∂ν) :=
hf.lintegral_prod_right'

/-- The Lebesgue integral is measurable. This shows that the integrand of (the right-hand-side of)
  the symmetric version of Tonelli's theorem is measurable. -/
lemma measurable.lintegral_prod_left' [sigma_finite μ] {f : α × β → ℝ≥0∞}
  (hf : measurable f) : measurable (λ y, ∫⁻ x, f (x, y) ∂μ) :=
(measurable_swap_iff.mpr hf).lintegral_prod_right'

/-- The Lebesgue integral is measurable. This shows that the integrand of (the right-hand-side of)
  the symmetric version of Tonelli's theorem is measurable.
  This version has the argument `f` in curried form. -/
lemma measurable.lintegral_prod_left [sigma_finite μ] {f : α → β → ℝ≥0∞}
  (hf : measurable (uncurry f)) : measurable (λ y, ∫⁻ x, f x y ∂μ) :=
hf.lintegral_prod_left'

lemma measurable_set_integrable [sigma_finite ν] ⦃f : α → β → E⦄
  (hf : strongly_measurable (uncurry f)) : measurable_set {x | integrable (f x) ν} :=
begin
  simp_rw [integrable, hf.of_uncurry_left.ae_strongly_measurable, true_and],
  exact measurable_set_lt (measurable.lintegral_prod_right hf.ennnorm) measurable_const
end

section
variables [normed_space ℝ E] [complete_space E]

/-- The Bochner integral is measurable. This shows that the integrand of (the right-hand-side of)
  Fubini's theorem is measurable.
  This version has `f` in curried form. -/
lemma measure_theory.strongly_measurable.integral_prod_right [sigma_finite ν] ⦃f : α → β → E⦄
  (hf : strongly_measurable (uncurry f)) : strongly_measurable (λ x, ∫ y, f x y ∂ν) :=
begin
  borelize E,
  haveI : separable_space (range (uncurry f) ∪ {0} : set E) :=
    hf.separable_space_range_union_singleton,
  let s : ℕ → simple_func (α × β) E := simple_func.approx_on _ hf.measurable
    (range (uncurry f) ∪ {0}) 0 (by simp),
  let s' : ℕ → α → simple_func β E := λ n x, (s n).comp (prod.mk x) measurable_prod_mk_left,
  let f' : ℕ → α → E := λ n, {x | integrable (f x) ν}.indicator
    (λ x, (s' n x).integral ν),
  have hf' : ∀ n, strongly_measurable (f' n),
  { intro n, refine strongly_measurable.indicator _ (measurable_set_integrable hf),
    have : ∀ x, (s' n x).range.filter (λ x, x ≠ 0) ⊆ (s n).range,
    { intros x, refine finset.subset.trans (finset.filter_subset _ _) _, intro y,
      simp_rw [simple_func.mem_range], rintro ⟨z, rfl⟩, exact ⟨(x, z), rfl⟩ },
    simp only [simple_func.integral_eq_sum_of_subset (this _)],
    refine finset.strongly_measurable_sum _ (λ x _, _),
    refine (measurable.ennreal_to_real _).strongly_measurable.smul_const _,
    simp only [simple_func.coe_comp, preimage_comp] {single_pass := tt},
    apply measurable_measure_prod_mk_left,
    exact (s n).measurable_set_fiber x },
  have h2f' : tendsto f' at_top (𝓝 (λ (x : α), ∫ (y : β), f x y ∂ν)),
  { rw [tendsto_pi_nhds], intro x,
    by_cases hfx : integrable (f x) ν,
    { have : ∀ n, integrable (s' n x) ν,
      { intro n, apply (hfx.norm.add hfx.norm).mono' (s' n x).ae_strongly_measurable,
        apply eventually_of_forall, intro y,
        simp_rw [s', simple_func.coe_comp], exact simple_func.norm_approx_on_zero_le _ _ (x, y) n },
      simp only [f', hfx, simple_func.integral_eq_integral _ (this _), indicator_of_mem,
        mem_set_of_eq],
      refine tendsto_integral_of_dominated_convergence (λ y, ‖f x y‖ + ‖f x y‖)
        (λ n, (s' n x).ae_strongly_measurable) (hfx.norm.add hfx.norm) _ _,
      { exact λ n, eventually_of_forall (λ y, simple_func.norm_approx_on_zero_le _ _ (x, y) n) },
      { refine eventually_of_forall (λ y, simple_func.tendsto_approx_on _ _ _),
        apply subset_closure,
        simp [-uncurry_apply_pair], } },
    { simp [f', hfx, integral_undef], } },
  exact strongly_measurable_of_tendsto _ hf' h2f'
end

/-- The Bochner integral is measurable. This shows that the integrand of (the right-hand-side of)
  Fubini's theorem is measurable. -/
lemma measure_theory.strongly_measurable.integral_prod_right' [sigma_finite ν] ⦃f : α × β → E⦄
  (hf : strongly_measurable f) : strongly_measurable (λ x, ∫ y, f (x, y) ∂ν) :=
by { rw [← uncurry_curry f] at hf, exact hf.integral_prod_right }

/-- The Bochner integral is measurable. This shows that the integrand of (the right-hand-side of)
  the symmetric version of Fubini's theorem is measurable.
  This version has `f` in curried form. -/
lemma measure_theory.strongly_measurable.integral_prod_left [sigma_finite μ] ⦃f : α → β → E⦄
  (hf : strongly_measurable (uncurry f)) : strongly_measurable (λ y, ∫ x, f x y ∂μ) :=
(hf.comp_measurable measurable_swap).integral_prod_right'

/-- The Bochner integral is measurable. This shows that the integrand of (the right-hand-side of)
  the symmetric version of Fubini's theorem is measurable. -/
lemma measure_theory.strongly_measurable.integral_prod_left' [sigma_finite μ] ⦃f : α × β → E⦄
  (hf : strongly_measurable f) : strongly_measurable (λ y, ∫ x, f (x, y) ∂μ) :=
(hf.comp_measurable measurable_swap).integral_prod_right'

end

/-! ### The product measure -/

namespace measure_theory

namespace measure

/-- The binary product of measures. They are defined for arbitrary measures, but we basically
  prove all properties under the assumption that at least one of them is σ-finite. -/
@[irreducible] protected def prod (μ : measure α) (ν : measure β) : measure (α × β) :=
bind μ $ λ x : α, map (prod.mk x) ν

instance prod.measure_space {α β} [measure_space α] [measure_space β] : measure_space (α × β) :=
{ volume := volume.prod volume }

variables [sigma_finite ν]

lemma volume_eq_prod (α β) [measure_space α] [measure_space β] :
  (volume : measure (α × β)) = (volume : measure α).prod (volume : measure β) :=
rfl

lemma prod_apply {s : set (α × β)} (hs : measurable_set s) :
  μ.prod ν s = ∫⁻ x, ν (prod.mk x ⁻¹' s) ∂μ :=
by simp_rw [measure.prod, bind_apply hs measurable.map_prod_mk_left,
  map_apply measurable_prod_mk_left hs]

/-- The product measure of the product of two sets is the product of their measures. Note that we
do not need the sets to be measurable. -/
@[simp] lemma prod_prod (s : set α) (t : set β) : μ.prod ν (s ×ˢ t) = μ s * ν t :=
begin
  apply le_antisymm,
  { set ST := (to_measurable μ s) ×ˢ (to_measurable ν t),
    have hSTm : measurable_set ST :=
      (measurable_set_to_measurable _ _).prod (measurable_set_to_measurable _ _),
    calc μ.prod ν (s ×ˢ t) ≤ μ.prod ν ST :
      measure_mono $ set.prod_mono (subset_to_measurable _ _) (subset_to_measurable _ _)
    ... = μ (to_measurable μ s) * ν (to_measurable ν t) :
      by simp_rw [prod_apply hSTm, mk_preimage_prod_right_eq_if, measure_if,
        lintegral_indicator _ (measurable_set_to_measurable _ _), lintegral_const,
        restrict_apply_univ, mul_comm]
    ... = μ s * ν t : by rw [measure_to_measurable, measure_to_measurable] },
  { /- Formalization is based on https://mathoverflow.net/a/254134/136589 -/
    set ST := to_measurable (μ.prod ν) (s ×ˢ t),
    have hSTm : measurable_set ST := measurable_set_to_measurable _ _,
    have hST : s ×ˢ t ⊆ ST := subset_to_measurable _ _,
    set f : α → ℝ≥0∞ := λ x, ν (prod.mk x ⁻¹' ST),
    have hfm : measurable f := measurable_measure_prod_mk_left hSTm,
    set s' : set α := {x | ν t ≤ f x},
    have hss' : s ⊆ s' := λ x hx, measure_mono (λ y hy, hST $ mk_mem_prod hx hy),
    calc μ s * ν t ≤ μ s' * ν t : mul_le_mul_right' (measure_mono hss') _
    ... = ∫⁻ x in s', ν t ∂μ    : by rw [set_lintegral_const, mul_comm]
    ... ≤ ∫⁻ x in s', f x ∂μ    : set_lintegral_mono measurable_const hfm (λ x, id)
    ... ≤ ∫⁻ x, f x ∂μ          : lintegral_mono' restrict_le_self le_rfl
    ... = μ.prod ν ST           : (prod_apply hSTm).symm
    ... = μ.prod ν (s ×ˢ t)     : measure_to_measurable _ }
end

instance {X Y : Type*} [topological_space X] [topological_space Y]
  {m : measurable_space X} {μ : measure X} [is_open_pos_measure μ]
  {m' : measurable_space Y} {ν : measure Y} [is_open_pos_measure ν] [sigma_finite ν] :
  is_open_pos_measure (μ.prod ν) :=
begin
  constructor,
  rintros U U_open ⟨⟨x, y⟩, hxy⟩,
  rcases is_open_prod_iff.1 U_open x y hxy with ⟨u, v, u_open, v_open, xu, yv, huv⟩,
  refine ne_of_gt (lt_of_lt_of_le _ (measure_mono huv)),
  simp only [prod_prod, canonically_ordered_comm_semiring.mul_pos],
  split,
  { exact u_open.measure_pos μ ⟨x, xu⟩ },
  { exact v_open.measure_pos ν ⟨y, yv⟩ }
end

instance {α β : Type*} {mα : measurable_space α} {mβ : measurable_space β}
  (μ : measure α) (ν : measure β) [is_finite_measure μ] [is_finite_measure ν] :
  is_finite_measure (μ.prod ν) :=
begin
  constructor,
  rw [← univ_prod_univ, prod_prod],
  exact mul_lt_top (measure_lt_top _ _).ne (measure_lt_top _ _).ne,
end

instance {α β : Type*} {mα : measurable_space α} {mβ : measurable_space β}
  (μ : measure α) (ν : measure β) [is_probability_measure μ] [is_probability_measure ν] :
  is_probability_measure (μ.prod ν) :=
⟨by rw [← univ_prod_univ, prod_prod, measure_univ, measure_univ, mul_one]⟩

instance {α β : Type*} [topological_space α] [topological_space β]
  {mα : measurable_space α} {mβ : measurable_space β} (μ : measure α) (ν : measure β)
  [is_finite_measure_on_compacts μ] [is_finite_measure_on_compacts ν] [sigma_finite ν] :
  is_finite_measure_on_compacts (μ.prod ν) :=
begin
  refine ⟨λ K hK, _⟩,
  set L := (prod.fst '' K) ×ˢ (prod.snd '' K) with hL,
  have : K ⊆ L,
  { rintros ⟨x, y⟩ hxy,
    simp only [prod_mk_mem_set_prod_eq, mem_image, prod.exists, exists_and_distrib_right,
      exists_eq_right],
    exact ⟨⟨y, hxy⟩, ⟨x, hxy⟩⟩ },
  apply lt_of_le_of_lt (measure_mono this),
  rw [hL, prod_prod],
  exact mul_lt_top ((is_compact.measure_lt_top ((hK.image continuous_fst))).ne)
                   ((is_compact.measure_lt_top ((hK.image continuous_snd))).ne)
end

lemma ae_measure_lt_top {s : set (α × β)} (hs : measurable_set s)
  (h2s : (μ.prod ν) s ≠ ∞) : ∀ᵐ x ∂μ, ν (prod.mk x ⁻¹' s) < ∞ :=
by { simp_rw [prod_apply hs] at h2s, refine ae_lt_top (measurable_measure_prod_mk_left hs) h2s }

lemma integrable_measure_prod_mk_left {s : set (α × β)}
  (hs : measurable_set s) (h2s : (μ.prod ν) s ≠ ∞) :
  integrable (λ x, (ν (prod.mk x ⁻¹' s)).to_real) μ :=
begin
  refine ⟨(measurable_measure_prod_mk_left hs).ennreal_to_real.ae_measurable.ae_strongly_measurable,
    _⟩,
  simp_rw [has_finite_integral, ennnorm_eq_of_real to_real_nonneg],
  convert h2s.lt_top using 1, simp_rw [prod_apply hs], apply lintegral_congr_ae,
  refine (ae_measure_lt_top hs h2s).mp _, apply eventually_of_forall, intros x hx,
  rw [lt_top_iff_ne_top] at hx, simp [of_real_to_real, hx],
end

/-- Note: the assumption `hs` cannot be dropped. For a counterexample, see
  Walter Rudin *Real and Complex Analysis*, example (c) in section 8.9. -/
lemma measure_prod_null {s : set (α × β)}
  (hs : measurable_set s) : μ.prod ν s = 0 ↔ (λ x, ν (prod.mk x ⁻¹' s)) =ᵐ[μ] 0 :=
by simp_rw [prod_apply hs, lintegral_eq_zero_iff (measurable_measure_prod_mk_left hs)]

/-- Note: the converse is not true without assuming that `s` is measurable. For a counterexample,
  see Walter Rudin *Real and Complex Analysis*, example (c) in section 8.9. -/
lemma measure_ae_null_of_prod_null {s : set (α × β)}
  (h : μ.prod ν s = 0) : (λ x, ν (prod.mk x ⁻¹' s)) =ᵐ[μ] 0 :=
begin
  obtain ⟨t, hst, mt, ht⟩ := exists_measurable_superset_of_null h,
  simp_rw [measure_prod_null mt] at ht,
  rw [eventually_le_antisymm_iff],
  exact ⟨eventually_le.trans_eq
    (eventually_of_forall $ λ x, (measure_mono (preimage_mono hst) : _)) ht,
    eventually_of_forall $ λ x, zero_le _⟩
end

lemma absolutely_continuous.prod [sigma_finite ν'] (h1 : μ ≪ μ') (h2 : ν ≪ ν') :
  μ.prod ν ≪ μ'.prod ν' :=
begin
  refine absolutely_continuous.mk (λ s hs h2s, _),
  simp_rw [measure_prod_null hs] at h2s ⊢,
  exact (h2s.filter_mono h1.ae_le).mono (λ _ h, h2 h)
end

/-- Note: the converse is not true. For a counterexample, see
  Walter Rudin *Real and Complex Analysis*, example (c) in section 8.9. -/
lemma ae_ae_of_ae_prod {p : α × β → Prop} (h : ∀ᵐ z ∂μ.prod ν, p z) :
  ∀ᵐ x ∂ μ, ∀ᵐ y ∂ ν, p (x, y) :=
measure_ae_null_of_prod_null h

/-- `μ.prod ν` has finite spanning sets in rectangles of finite spanning sets. -/
noncomputable! def finite_spanning_sets_in.prod {ν : measure β} {C : set (set α)} {D : set (set β)}
  (hμ : μ.finite_spanning_sets_in C) (hν : ν.finite_spanning_sets_in D) :
  (μ.prod ν).finite_spanning_sets_in (image2 (×ˢ) C D) :=
begin
  haveI := hν.sigma_finite,
  refine ⟨λ n, hμ.set n.unpair.1 ×ˢ hν.set n.unpair.2,
    λ n, mem_image2_of_mem (hμ.set_mem _) (hν.set_mem _), λ n, _, _⟩,
  { rw [prod_prod],
    exact mul_lt_top (hμ.finite _).ne (hν.finite _).ne },
  { simp_rw [Union_unpair_prod, hμ.spanning, hν.spanning, univ_prod_univ] }
end

lemma quasi_measure_preserving_fst : quasi_measure_preserving prod.fst (μ.prod ν) μ :=
begin
  refine ⟨measurable_fst, absolutely_continuous.mk (λ s hs h2s, _)⟩,
  rw [map_apply measurable_fst hs, ← prod_univ, prod_prod, h2s, zero_mul],
end

lemma quasi_measure_preserving_snd : quasi_measure_preserving prod.snd (μ.prod ν) ν :=
begin
  refine ⟨measurable_snd, absolutely_continuous.mk (λ s hs h2s, _)⟩,
  rw [map_apply measurable_snd hs, ← univ_prod, prod_prod, h2s, mul_zero]
end

variables [sigma_finite μ]

instance prod.sigma_finite : sigma_finite (μ.prod ν) :=
(μ.to_finite_spanning_sets_in.prod ν.to_finite_spanning_sets_in).sigma_finite

/-- A measure on a product space equals the product measure if they are equal on rectangles
  with as sides sets that generate the corresponding σ-algebras. -/
lemma prod_eq_generate_from {μ : measure α} {ν : measure β} {C : set (set α)}
  {D : set (set β)} (hC : generate_from C = ‹_›)
  (hD : generate_from D = ‹_›) (h2C : is_pi_system C) (h2D : is_pi_system D)
  (h3C : μ.finite_spanning_sets_in C) (h3D : ν.finite_spanning_sets_in D)
  {μν : measure (α × β)}
  (h₁ : ∀ (s ∈ C) (t ∈ D), μν (s ×ˢ t) = μ s * ν t) : μ.prod ν = μν :=
begin
  refine (h3C.prod h3D).ext
    (generate_from_eq_prod hC hD h3C.is_countably_spanning h3D.is_countably_spanning).symm
    (h2C.prod h2D) _,
  { rintro _ ⟨s, t, hs, ht, rfl⟩, haveI := h3D.sigma_finite,
    rw [h₁ s hs t ht, prod_prod] }
end

/-- A measure on a product space equals the product measure if they are equal on rectangles. -/
lemma prod_eq {μν : measure (α × β)}
  (h : ∀ s t, measurable_set s → measurable_set t → μν (s ×ˢ t) = μ s * ν t) : μ.prod ν = μν :=
prod_eq_generate_from generate_from_measurable_set generate_from_measurable_set
  is_pi_system_measurable_set is_pi_system_measurable_set
  μ.to_finite_spanning_sets_in ν.to_finite_spanning_sets_in (λ s hs t ht, h s t hs ht)

lemma prod_swap : map prod.swap (μ.prod ν) = ν.prod μ :=
begin
  refine (prod_eq _).symm,
  intros s t hs ht,
  simp_rw [map_apply measurable_swap (hs.prod ht), preimage_swap_prod, prod_prod, mul_comm]
end

lemma measure_preserving_swap : measure_preserving prod.swap (μ.prod ν) (ν.prod μ) :=
⟨measurable_swap, prod_swap⟩

lemma prod_apply_symm {s : set (α × β)} (hs : measurable_set s) :
  μ.prod ν s = ∫⁻ y, μ ((λ x, (x, y)) ⁻¹' s) ∂ν :=
by { rw [← prod_swap, map_apply measurable_swap hs],
     simp only [prod_apply (measurable_swap hs)], refl }

lemma prod_assoc_prod [sigma_finite τ] :
  map measurable_equiv.prod_assoc ((μ.prod ν).prod τ) = μ.prod (ν.prod τ) :=
begin
  refine (prod_eq_generate_from generate_from_measurable_set generate_from_prod
    is_pi_system_measurable_set is_pi_system_prod μ.to_finite_spanning_sets_in
    (ν.to_finite_spanning_sets_in.prod τ.to_finite_spanning_sets_in) _).symm,
  rintro s hs _ ⟨t, u, ht, hu, rfl⟩, rw [mem_set_of_eq] at hs ht hu,
  simp_rw [map_apply (measurable_equiv.measurable _) (hs.prod (ht.prod hu)),
    measurable_equiv.prod_assoc, measurable_equiv.coe_mk, equiv.prod_assoc_preimage,
    prod_prod, mul_assoc]
end

/-! ### The product of specific measures -/

lemma prod_restrict (s : set α) (t : set β) :
  (μ.restrict s).prod (ν.restrict t) = (μ.prod ν).restrict (s ×ˢ t) :=
begin
  refine prod_eq (λ s' t' hs' ht', _),
  rw [restrict_apply (hs'.prod ht'), prod_inter_prod, prod_prod, restrict_apply hs',
    restrict_apply ht']
end

lemma restrict_prod_eq_prod_univ (s : set α) :
  (μ.restrict s).prod ν = (μ.prod ν).restrict (s ×ˢ (univ : set β)) :=
begin
  have : ν = ν.restrict set.univ := measure.restrict_univ.symm,
  rwa [this, measure.prod_restrict, ← this],
end

lemma prod_dirac (y : β) : μ.prod (dirac y) = map (λ x, (x, y)) μ :=
begin
  refine prod_eq (λ s t hs ht, _),
  simp_rw [map_apply measurable_prod_mk_right (hs.prod ht), mk_preimage_prod_left_eq_if, measure_if,
    dirac_apply' _ ht, ← indicator_mul_right _ (λ x, μ s), pi.one_apply, mul_one]
end

lemma dirac_prod (x : α) : (dirac x).prod ν = map (prod.mk x) ν :=
begin
  refine prod_eq (λ s t hs ht, _),
  simp_rw [map_apply measurable_prod_mk_left (hs.prod ht), mk_preimage_prod_right_eq_if, measure_if,
    dirac_apply' _ hs, ← indicator_mul_left _ _ (λ x, ν t), pi.one_apply, one_mul]
end

lemma dirac_prod_dirac {x : α} {y : β} : (dirac x).prod (dirac y) = dirac (x, y) :=
by rw [prod_dirac, map_dirac measurable_prod_mk_right]

lemma prod_sum {ι : Type*} [finite ι] (ν : ι → measure β) [∀ i, sigma_finite (ν i)] :
  μ.prod (sum ν) = sum (λ i, μ.prod (ν i)) :=
begin
  refine prod_eq (λ s t hs ht, _),
  simp_rw [sum_apply _ (hs.prod ht), sum_apply _ ht, prod_prod, ennreal.tsum_mul_left]
end

lemma sum_prod {ι : Type*} [finite ι] (μ : ι → measure α) [∀ i, sigma_finite (μ i)] :
  (sum μ).prod ν = sum (λ i, (μ i).prod ν) :=
begin
  refine prod_eq (λ s t hs ht, _),
  simp_rw [sum_apply _ (hs.prod ht), sum_apply _ hs, prod_prod, ennreal.tsum_mul_right]
end

lemma prod_add (ν' : measure β) [sigma_finite ν'] : μ.prod (ν + ν') = μ.prod ν + μ.prod ν' :=
by { refine prod_eq (λ s t hs ht, _), simp_rw [add_apply, prod_prod, left_distrib] }

lemma add_prod (μ' : measure α) [sigma_finite μ'] : (μ + μ').prod ν = μ.prod ν + μ'.prod ν :=
by { refine prod_eq (λ s t hs ht, _), simp_rw [add_apply, prod_prod, right_distrib] }

@[simp] lemma zero_prod (ν : measure β) : (0 : measure α).prod ν = 0 :=
by { rw measure.prod, exact bind_zero_left _ }

@[simp] lemma prod_zero (μ : measure α) : μ.prod (0 : measure β) = 0 :=
by simp [measure.prod]

lemma map_prod_map {δ} [measurable_space δ] {f : α → β} {g : γ → δ}
  {μa : measure α} {μc : measure γ} (hfa : sigma_finite (map f μa))
  (hgc : sigma_finite (map g μc)) (hf : measurable f) (hg : measurable g) :
  (map f μa).prod (map g μc) = map (prod.map f g) (μa.prod μc) :=
begin
  haveI := hgc.of_map μc hg.ae_measurable,
  refine prod_eq (λ s t hs ht, _),
  rw [map_apply (hf.prod_map hg) (hs.prod ht), map_apply hf hs, map_apply hg ht],
  exact prod_prod (f ⁻¹' s) (g ⁻¹' t)
end

end measure

open measure

namespace measure_preserving

variables {δ : Type*} [measurable_space δ] {μa : measure α} {μb : measure β}
  {μc : measure γ} {μd : measure δ}

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`. -/
  rcases eq_or_ne μa 0 with (rfl|ha),
  { rw [← hf.map_eq, zero_prod, measure.map_zero, zero_prod],
    exact ⟨this, by simp only [measure.map_zero]⟩ },
  haveI : sigma_finite μc,
  { rcases (ae_ne_bot.2 ha).nonempty_of_mem hg with ⟨x, hx : map (g x) μc = μd⟩,
    exact sigma_finite.of_map _ hgm.of_uncurry_left.ae_measurable (by rwa hx) },
  -- Thus we can apply `measure.prod_eq` to prove equality of measures.
  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 ×ˢ t) = indicator (f ⁻¹' s) (λ y, μd t) x,
  { refine hg.mono (λ x hx, _), unfreezingI { subst hx },
    simp only [mk_preimage_prod_right_fn_eq_if, indicator_apply, mem_preimage],
    split_ifs,
    exacts [(map_apply hgm.of_uncurry_left ht).symm, 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`. -/
protected 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

end measure_preserving

namespace quasi_measure_preserving

lemma prod_of_right {f : α × β → γ} {μ : measure α} {ν : measure β} {τ : measure γ}
  (hf : measurable f) [sigma_finite ν]
  (h2f : ∀ᵐ x ∂μ, quasi_measure_preserving (λ y, f (x, y)) ν τ) :
  quasi_measure_preserving f (μ.prod ν) τ :=
begin
  refine ⟨hf, _⟩,
  refine absolutely_continuous.mk (λ s hs h2s, _),
  simp_rw [map_apply hf hs, prod_apply (hf hs), preimage_preimage,
    lintegral_congr_ae (h2f.mono (λ x hx, hx.preimage_null h2s)), lintegral_zero],
end

lemma prod_of_left {α β γ} [measurable_space α] [measurable_space β]
  [measurable_space γ] {f : α × β → γ} {μ : measure α} {ν : measure β} {τ : measure γ}
  (hf : measurable f) [sigma_finite μ] [sigma_finite ν]
  (h2f : ∀ᵐ y ∂ν, quasi_measure_preserving (λ x, f (x, y)) μ τ) :
  quasi_measure_preserving f (μ.prod ν) τ :=
begin
  rw [← prod_swap],
  convert (quasi_measure_preserving.prod_of_right (hf.comp measurable_swap) h2f).comp
    ((measurable_swap.measure_preserving (ν.prod μ)).symm measurable_equiv.prod_comm)
    .quasi_measure_preserving,
  ext ⟨x, y⟩, refl,
end

end quasi_measure_preserving

end measure_theory

open measure_theory.measure

section

lemma ae_measurable.prod_swap [sigma_finite μ] [sigma_finite ν] {f : β × α → γ}
  (hf : ae_measurable f (ν.prod μ)) : ae_measurable (λ (z : α × β), f z.swap) (μ.prod ν) :=
by { rw ← prod_swap at hf, exact hf.comp_measurable measurable_swap }

lemma measure_theory.ae_strongly_measurable.prod_swap
  {γ : Type*} [topological_space γ] [sigma_finite μ] [sigma_finite ν] {f : β × α → γ}
  (hf : ae_strongly_measurable f (ν.prod μ)) :
  ae_strongly_measurable (λ (z : α × β), f z.swap) (μ.prod ν) :=
by { rw ← prod_swap at hf, exact hf.comp_measurable measurable_swap }

lemma ae_measurable.fst [sigma_finite ν] {f : α → γ}
  (hf : ae_measurable f μ) : ae_measurable (λ (z : α × β), f z.1) (μ.prod ν) :=
hf.comp_quasi_measure_preserving quasi_measure_preserving_fst

lemma ae_measurable.snd [sigma_finite ν] {f : β → γ}
  (hf : ae_measurable f ν) : ae_measurable (λ (z : α × β), f z.2) (μ.prod ν) :=
hf.comp_quasi_measure_preserving quasi_measure_preserving_snd

lemma measure_theory.ae_strongly_measurable.fst {γ} [topological_space γ] [sigma_finite ν]
  {f : α → γ} (hf : ae_strongly_measurable f μ) :
  ae_strongly_measurable (λ (z : α × β), f z.1) (μ.prod ν) :=
hf.comp_quasi_measure_preserving quasi_measure_preserving_fst

lemma measure_theory.ae_strongly_measurable.snd {γ} [topological_space γ] [sigma_finite ν]
  {f : β → γ} (hf : ae_strongly_measurable f ν) :
  ae_strongly_measurable (λ (z : α × β), f z.2) (μ.prod ν) :=
hf.comp_quasi_measure_preserving quasi_measure_preserving_snd

/-- The Bochner integral is a.e.-measurable.
  This shows that the integrand of (the right-hand-side of) Fubini's theorem is a.e.-measurable. -/
lemma measure_theory.ae_strongly_measurable.integral_prod_right' [sigma_finite ν]
  [normed_space ℝ E] [complete_space E]
  ⦃f : α × β → E⦄ (hf : ae_strongly_measurable f (μ.prod ν)) :
  ae_strongly_measurable (λ x, ∫ y, f (x, y) ∂ν) μ :=
⟨λ x, ∫ y, hf.mk f (x, y) ∂ν, hf.strongly_measurable_mk.integral_prod_right',
  by { filter_upwards [ae_ae_of_ae_prod hf.ae_eq_mk] with _ hx using integral_congr_ae hx }⟩

lemma measure_theory.ae_strongly_measurable.prod_mk_left
  {γ : Type*} [sigma_finite ν] [topological_space γ] {f : α × β → γ}
  (hf : ae_strongly_measurable f (μ.prod ν)) : ∀ᵐ x ∂μ, ae_strongly_measurable (λ y, f (x, y)) ν :=
begin
  filter_upwards [ae_ae_of_ae_prod hf.ae_eq_mk] with x hx,
  exact ⟨λ y, hf.mk f (x, y), hf.strongly_measurable_mk.comp_measurable measurable_prod_mk_left, hx⟩
end

end

namespace measure_theory

/-! ### The Lebesgue integral on a product -/

variables [sigma_finite ν]

lemma lintegral_prod_swap [sigma_finite μ] (f : α × β → ℝ≥0∞)
  (hf : ae_measurable f (μ.prod ν)) : ∫⁻ z, f z.swap ∂(ν.prod μ) = ∫⁻ z, f z ∂(μ.prod ν) :=
by { rw ← prod_swap at hf, rw [← lintegral_map' hf measurable_swap.ae_measurable, prod_swap] }

/-- **Tonelli's Theorem**: For `ℝ≥0∞`-valued measurable functions on `α × β`,
  the integral of `f` is equal to the iterated integral. -/
lemma lintegral_prod_of_measurable :
  ∀ (f : α × β → ℝ≥0∞) (hf : measurable f), ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ x, ∫⁻ y, f (x, y) ∂ν ∂μ :=
begin
  have m := @measurable_prod_mk_left,
  refine measurable.ennreal_induction _ _ _,
  { intros c s hs, simp only [← indicator_comp_right],
    simp [lintegral_indicator, m hs, hs, lintegral_const_mul, measurable_measure_prod_mk_left hs,
      prod_apply] },
  { rintro f g - hf hg h2f h2g,
    simp [lintegral_add_left, measurable.lintegral_prod_right', hf.comp m, hf, h2f, h2g] },
  { intros f hf h2f h3f,
    have kf : ∀ x n, measurable (λ y, f n (x, y)) := λ x n, (hf n).comp m,
    have k2f : ∀ x, monotone (λ n y, f n (x, y)) := λ x i j hij y, h2f hij (x, y),
    have lf : ∀ n, measurable (λ x, ∫⁻ y, f n (x, y) ∂ν) := λ n, (hf n).lintegral_prod_right',
    have l2f : monotone (λ n x, ∫⁻ y, f n (x, y) ∂ν) := λ i j hij x, lintegral_mono (k2f x hij),
    simp only [lintegral_supr hf h2f, lintegral_supr (kf _), k2f, lintegral_supr lf l2f, h3f] },
end

/-- **Tonelli's Theorem**: For `ℝ≥0∞`-valued almost everywhere measurable functions on `α × β`,
  the integral of `f` is equal to the iterated integral. -/
lemma lintegral_prod (f : α × β → ℝ≥0∞) (hf : ae_measurable f (μ.prod ν)) :
  ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ x, ∫⁻ y, f (x, y) ∂ν ∂μ :=
begin
  have A : ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ z, hf.mk f z ∂(μ.prod ν) :=
    lintegral_congr_ae hf.ae_eq_mk,
  have B : ∫⁻ x, ∫⁻ y, f (x, y) ∂ν ∂μ = ∫⁻ x, ∫⁻ y, hf.mk f (x, y) ∂ν ∂μ,
  { apply lintegral_congr_ae,
    filter_upwards [ae_ae_of_ae_prod hf.ae_eq_mk] with _ ha using lintegral_congr_ae ha, },
  rw [A, B, lintegral_prod_of_measurable _ hf.measurable_mk],
  apply_instance
end

/-- The symmetric verion of Tonelli's Theorem: For `ℝ≥0∞`-valued almost everywhere measurable
functions on `α × β`,  the integral of `f` is equal to the iterated integral, in reverse order. -/
lemma lintegral_prod_symm [sigma_finite μ] (f : α × β → ℝ≥0∞)
  (hf : ae_measurable f (μ.prod ν)) : ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ y, ∫⁻ x, f (x, y) ∂μ ∂ν :=
by { simp_rw [← lintegral_prod_swap f hf], exact lintegral_prod _ hf.prod_swap }

/-- The symmetric verion of Tonelli's Theorem: For `ℝ≥0∞`-valued measurable
functions on `α × β`,  the integral of `f` is equal to the iterated integral, in reverse order. -/
lemma lintegral_prod_symm' [sigma_finite μ] (f : α × β → ℝ≥0∞)
  (hf : measurable f) : ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ y, ∫⁻ x, f (x, y) ∂μ ∂ν :=
lintegral_prod_symm f hf.ae_measurable

/-- The reversed version of **Tonelli's Theorem**. In this version `f` is in curried form, which
makes it easier for the elaborator to figure out `f` automatically. -/
lemma lintegral_lintegral ⦃f : α → β → ℝ≥0∞⦄
  (hf : ae_measurable (uncurry f) (μ.prod ν)) :
  ∫⁻ x, ∫⁻ y, f x y ∂ν ∂μ = ∫⁻ z, f z.1 z.2 ∂(μ.prod ν) :=
(lintegral_prod _ hf).symm

/-- The reversed version of **Tonelli's Theorem** (symmetric version). In this version `f` is in
curried form, which makes it easier for the elaborator to figure out `f` automatically. -/
lemma lintegral_lintegral_symm [sigma_finite μ] ⦃f : α → β → ℝ≥0∞⦄
  (hf : ae_measurable (uncurry f) (μ.prod ν)) :
  ∫⁻ x, ∫⁻ y, f x y ∂ν ∂μ = ∫⁻ z, f z.2 z.1 ∂(ν.prod μ) :=
(lintegral_prod_symm _ hf.prod_swap).symm

/-- Change the order of Lebesgue integration. -/
lemma lintegral_lintegral_swap [sigma_finite μ] ⦃f : α → β → ℝ≥0∞⦄
  (hf : ae_measurable (uncurry f) (μ.prod ν)) :
  ∫⁻ x, ∫⁻ y, f x y ∂ν ∂μ = ∫⁻ y, ∫⁻ x, f x y ∂μ ∂ν :=
(lintegral_lintegral hf).trans (lintegral_prod_symm _ hf)

lemma lintegral_prod_mul {f : α → ℝ≥0∞} {g : β → ℝ≥0∞}
  (hf : ae_measurable f μ) (hg : ae_measurable g ν) :
  ∫⁻ z, f z.1 * g z.2 ∂(μ.prod ν) = ∫⁻ x, f x ∂μ * ∫⁻ y, g y ∂ν :=
by simp [lintegral_prod _ (hf.fst.mul hg.snd), lintegral_lintegral_mul hf hg]

/-! ### Integrability on a product -/
section

lemma integrable.swap [sigma_finite μ] ⦃f : α × β → E⦄
  (hf : integrable f (μ.prod ν)) : integrable (f ∘ prod.swap) (ν.prod μ) :=
⟨hf.ae_strongly_measurable.prod_swap,
  (lintegral_prod_swap _ hf.ae_strongly_measurable.ennnorm : _).le.trans_lt hf.has_finite_integral⟩

lemma integrable_swap_iff [sigma_finite μ] ⦃f : α × β → E⦄ :
  integrable (f ∘ prod.swap) (ν.prod μ) ↔ integrable f (μ.prod ν) :=
⟨λ hf, by { convert hf.swap, ext ⟨x, y⟩, refl }, λ hf, hf.swap⟩

lemma has_finite_integral_prod_iff ⦃f : α × β → E⦄ (h1f : strongly_measurable f) :
  has_finite_integral f (μ.prod ν) ↔ (∀ᵐ x ∂ μ, has_finite_integral (λ y, f (x, y)) ν) ∧
    has_finite_integral (λ x, ∫ y, ‖f (x, y)‖ ∂ν) μ :=
begin
  simp only [has_finite_integral, lintegral_prod_of_measurable _ h1f.ennnorm],
  have : ∀ x, ∀ᵐ y ∂ν, 0 ≤ ‖f (x, y)‖ := λ x, eventually_of_forall (λ y, norm_nonneg _),
  simp_rw [integral_eq_lintegral_of_nonneg_ae (this _)
    (h1f.norm.comp_measurable measurable_prod_mk_left).ae_strongly_measurable,
    ennnorm_eq_of_real to_real_nonneg, of_real_norm_eq_coe_nnnorm],
  -- this fact is probably too specialized to be its own lemma
  have : ∀ {p q r : Prop} (h1 : r → p), (r ↔ p ∧ q) ↔ (p → (r ↔ q)) :=
  λ p q r h1, by rw [← and.congr_right_iff, and_iff_right_of_imp h1],
  rw [this],
  { intro h2f, rw lintegral_congr_ae,
    refine h2f.mp _, apply eventually_of_forall, intros x hx, dsimp only,
    rw [of_real_to_real], rw [← lt_top_iff_ne_top], exact hx },
  { intro h2f, refine ae_lt_top _ h2f.ne, exact h1f.ennnorm.lintegral_prod_right' },
end

lemma has_finite_integral_prod_iff' ⦃f : α × β → E⦄ (h1f : ae_strongly_measurable f (μ.prod ν)) :
  has_finite_integral f (μ.prod ν) ↔ (∀ᵐ x ∂ μ, has_finite_integral (λ y, f (x, y)) ν) ∧
    has_finite_integral (λ x, ∫ y, ‖f (x, y)‖ ∂ν) μ :=
begin
  rw [has_finite_integral_congr h1f.ae_eq_mk,
    has_finite_integral_prod_iff h1f.strongly_measurable_mk],
  apply and_congr,
  { apply eventually_congr,
    filter_upwards [ae_ae_of_ae_prod h1f.ae_eq_mk.symm],
    assume x hx,
    exact has_finite_integral_congr hx },
  { apply has_finite_integral_congr,
    filter_upwards [ae_ae_of_ae_prod h1f.ae_eq_mk.symm] with _ hx
      using integral_congr_ae (eventually_eq.fun_comp hx _), },
  { apply_instance, },
end

/-- A binary function is integrable if the function `y ↦ f (x, y)` is integrable for almost every
  `x` and the function `x ↦ ∫ ‖f (x, y)‖ dy` is integrable. -/
lemma integrable_prod_iff ⦃f : α × β → E⦄ (h1f : ae_strongly_measurable f (μ.prod ν)) :
  integrable f (μ.prod ν) ↔
    (∀ᵐ x ∂ μ, integrable (λ y, f (x, y)) ν) ∧ integrable (λ x, ∫ y, ‖f (x, y)‖ ∂ν) μ :=
by simp [integrable, h1f, has_finite_integral_prod_iff', h1f.norm.integral_prod_right',
         h1f.prod_mk_left]

/-- A binary function is integrable if the function `x ↦ f (x, y)` is integrable for almost every
  `y` and the function `y ↦ ∫ ‖f (x, y)‖ dx` is integrable. -/
lemma integrable_prod_iff' [sigma_finite μ] ⦃f : α × β → E⦄
  (h1f : ae_strongly_measurable f (μ.prod ν)) :
  integrable f (μ.prod ν) ↔
    (∀ᵐ y ∂ ν, integrable (λ x, f (x, y)) μ) ∧ integrable (λ y, ∫ x, ‖f (x, y)‖ ∂μ) ν :=
by { convert integrable_prod_iff (h1f.prod_swap) using 1, rw [integrable_swap_iff] }

lemma integrable.prod_left_ae [sigma_finite μ] ⦃f : α × β → E⦄
  (hf : integrable f (μ.prod ν)) : ∀ᵐ y ∂ ν, integrable (λ x, f (x, y)) μ :=
((integrable_prod_iff' hf.ae_strongly_measurable).mp hf).1

lemma integrable.prod_right_ae [sigma_finite μ] ⦃f : α × β → E⦄
  (hf : integrable f (μ.prod ν)) : ∀ᵐ x ∂ μ, integrable (λ y, f (x, y)) ν :=
hf.swap.prod_left_ae

lemma integrable.integral_norm_prod_left ⦃f : α × β → E⦄
  (hf : integrable f (μ.prod ν)) : integrable (λ x, ∫ y, ‖f (x, y)‖ ∂ν) μ :=
((integrable_prod_iff hf.ae_strongly_measurable).mp hf).2

lemma integrable.integral_norm_prod_right [sigma_finite μ] ⦃f : α × β → E⦄
  (hf : integrable f (μ.prod ν)) : integrable (λ y, ∫ x, ‖f (x, y)‖ ∂μ) ν :=
hf.swap.integral_norm_prod_left

lemma integrable_prod_mul {L : Type*} [is_R_or_C L]
  {f : α → L} {g : β → L} (hf : integrable f μ) (hg : integrable g ν) :
  integrable (λ (z : α × β), f z.1 * g z.2) (μ.prod ν) :=
begin
  refine (integrable_prod_iff _).2 ⟨_, _⟩,
  { exact hf.1.fst.mul hg.1.snd },
  { exact eventually_of_forall (λ x, hg.const_mul (f x)) },
  { simpa only [norm_mul, integral_mul_left] using hf.norm.mul_const _ }
end

end

variables [normed_space ℝ E] [complete_space E]

lemma integrable.integral_prod_left ⦃f : α × β → E⦄
  (hf : integrable f (μ.prod ν)) : integrable (λ x, ∫ y, f (x, y) ∂ν) μ :=
integrable.mono hf.integral_norm_prod_left hf.ae_strongly_measurable.integral_prod_right' $
  eventually_of_forall $ λ x, (norm_integral_le_integral_norm _).trans_eq $
  (norm_of_nonneg $ integral_nonneg_of_ae $ eventually_of_forall $
  λ y, (norm_nonneg (f (x, y)) : _)).symm

lemma integrable.integral_prod_right [sigma_finite μ] ⦃f : α × β → E⦄
  (hf : integrable f (μ.prod ν)) : integrable (λ y, ∫ x, f (x, y) ∂μ) ν :=
hf.swap.integral_prod_left

/-! ### The Bochner integral on a product -/

variables [sigma_finite μ]

lemma integral_prod_swap (f : α × β → E)
  (hf : ae_strongly_measurable f (μ.prod ν)) : ∫ z, f z.swap ∂(ν.prod μ) = ∫ z, f z ∂(μ.prod ν) :=
begin
  rw ← prod_swap at hf,
  rw [← integral_map measurable_swap.ae_measurable hf, prod_swap]
end

variables {E' : Type*} [normed_add_comm_group E'] [complete_space E'] [normed_space ℝ E']

/-! Some rules about the sum/difference of double integrals. They follow from `integral_add`, but
  we separate them out as separate lemmas, because they involve quite some steps. -/

/-- Integrals commute with addition inside another integral. `F` can be any function. -/
lemma integral_fn_integral_add ⦃f g : α × β → E⦄ (F : E → E')
  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
  ∫ x, F (∫ y, f (x, y) + g (x, y) ∂ν) ∂μ = ∫ x, F (∫ y, f (x, y) ∂ν + ∫ y, g (x, y) ∂ν) ∂μ :=
begin
  refine integral_congr_ae _,
  filter_upwards [hf.prod_right_ae, hg.prod_right_ae] with _ h2f h2g,
  simp [integral_add h2f h2g],
end

/-- Integrals commute with subtraction inside another integral.
  `F` can be any measurable function. -/
lemma integral_fn_integral_sub ⦃f g : α × β → E⦄ (F : E → E')
  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
  ∫ x, F (∫ y, f (x, y) - g (x, y) ∂ν) ∂μ = ∫ x, F (∫ y, f (x, y) ∂ν - ∫ y, g (x, y) ∂ν) ∂μ :=
begin
  refine integral_congr_ae _,
  filter_upwards [hf.prod_right_ae, hg.prod_right_ae] with _ h2f h2g,
  simp [integral_sub h2f h2g],
end

/-- Integrals commute with subtraction inside a lower Lebesgue integral.
  `F` can be any function. -/
lemma lintegral_fn_integral_sub ⦃f g : α × β → E⦄
  (F : E → ℝ≥0∞) (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
  ∫⁻ x, F (∫ y, f (x, y) - g (x, y) ∂ν) ∂μ = ∫⁻ x, F (∫ y, f (x, y) ∂ν - ∫ y, g (x, y) ∂ν) ∂μ :=
begin
  refine lintegral_congr_ae _,
  filter_upwards [hf.prod_right_ae, hg.prod_right_ae] with _ h2f h2g,
  simp [integral_sub h2f h2g],
end

/-- Double integrals commute with addition. -/
lemma integral_integral_add ⦃f g : α × β → E⦄
  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
  ∫ x, ∫ y, f (x, y) + g (x, y) ∂ν ∂μ = ∫ x, ∫ y, f (x, y) ∂ν ∂μ + ∫ x, ∫ y, g (x, y) ∂ν ∂μ :=
(integral_fn_integral_add id hf hg).trans $
  integral_add hf.integral_prod_left hg.integral_prod_left

/-- Double integrals commute with addition. This is the version with `(f + g) (x, y)`
  (instead of `f (x, y) + g (x, y)`) in the LHS. -/
lemma integral_integral_add' ⦃f g : α × β → E⦄
  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
  ∫ x, ∫ y, (f + g) (x, y) ∂ν ∂μ = ∫ x, ∫ y, f (x, y) ∂ν ∂μ + ∫ x, ∫ y, g (x, y) ∂ν ∂μ :=
integral_integral_add hf hg

/-- Double integrals commute with subtraction. -/
lemma integral_integral_sub ⦃f g : α × β → E⦄
  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
  ∫ x, ∫ y, f (x, y) - g (x, y) ∂ν ∂μ = ∫ x, ∫ y, f (x, y) ∂ν ∂μ - ∫ x, ∫ y, g (x, y) ∂ν ∂μ :=
(integral_fn_integral_sub id hf hg).trans $
  integral_sub hf.integral_prod_left hg.integral_prod_left

/-- Double integrals commute with subtraction. This is the version with `(f - g) (x, y)`
  (instead of `f (x, y) - g (x, y)`) in the LHS. -/
lemma integral_integral_sub' ⦃f g : α × β → E⦄
  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
  ∫ x, ∫ y, (f - g) (x, y) ∂ν ∂μ = ∫ x, ∫ y, f (x, y) ∂ν ∂μ - ∫ x, ∫ y, g (x, y) ∂ν ∂μ :=
integral_integral_sub hf hg

/-- The map that sends an L¹-function `f : α × β → E` to `∫∫f` is continuous. -/
lemma continuous_integral_integral :
  continuous (λ (f : α × β →₁[μ.prod ν] E), ∫ x, ∫ y, f (x, y) ∂ν ∂μ) :=
begin
  rw [continuous_iff_continuous_at], intro g,
  refine tendsto_integral_of_L1 _ (L1.integrable_coe_fn g).integral_prod_left
    (eventually_of_forall $ λ h, (L1.integrable_coe_fn h).integral_prod_left) _,
  simp_rw [← lintegral_fn_integral_sub (λ x, (‖x‖₊ : ℝ≥0∞)) (L1.integrable_coe_fn _)
    (L1.integrable_coe_fn g)],
  refine tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds _ (λ i, zero_le _) _,
  { exact λ i, ∫⁻ x, ∫⁻ y, ‖i (x, y) - g (x, y)‖₊ ∂ν ∂μ },
  swap, { exact λ i, lintegral_mono (λ x, ennnorm_integral_le_lintegral_ennnorm _) },
  show tendsto (λ (i : α × β →₁[μ.prod ν] E),
    ∫⁻ x, ∫⁻ (y : β), ‖i (x, y) - g (x, y)‖₊ ∂ν ∂μ) (𝓝 g) (𝓝 0),
  have : ∀ (i : α × β →₁[μ.prod ν] E), measurable (λ z, (‖i z - g z‖₊ : ℝ≥0∞)) :=
  λ i, ((Lp.strongly_measurable i).sub (Lp.strongly_measurable g)).ennnorm,
  simp_rw [← lintegral_prod_of_measurable _ (this _), ← L1.of_real_norm_sub_eq_lintegral,
    ← of_real_zero],
  refine (continuous_of_real.tendsto 0).comp _,
  rw [← tendsto_iff_norm_tendsto_zero], exact tendsto_id
end

/-- **Fubini's Theorem**: For integrable functions on `α × β`,
  the Bochner integral of `f` is equal to the iterated Bochner integral.
  `integrable_prod_iff` can be useful to show that the function in question in integrable.
  `measure_theory.integrable.integral_prod_right` is useful to show that the inner integral
  of the right-hand side is integrable. -/
lemma integral_prod : ∀ (f : α × β → E) (hf : integrable f (μ.prod ν)),
  ∫ z, f z ∂(μ.prod ν) = ∫ x, ∫ y, f (x, y) ∂ν ∂μ :=
begin
  apply integrable.induction,
  { intros c s hs h2s,
    simp_rw [integral_indicator hs, ← indicator_comp_right,
      function.comp, integral_indicator (measurable_prod_mk_left hs),
      set_integral_const, integral_smul_const,
      integral_to_real (measurable_measure_prod_mk_left hs).ae_measurable
      (ae_measure_lt_top hs h2s.ne), prod_apply hs] },
  { intros f g hfg i_f i_g hf hg,
    simp_rw [integral_add' i_f i_g, integral_integral_add' i_f i_g, hf, hg] },
  { exact is_closed_eq continuous_integral continuous_integral_integral },
  { intros f g hfg i_f hf, convert hf using 1,
    { exact integral_congr_ae hfg.symm },
    { refine integral_congr_ae _,
      refine (ae_ae_of_ae_prod hfg).mp _,
      apply eventually_of_forall, intros x hfgx,
      exact integral_congr_ae (ae_eq_symm hfgx) } }
end

/-- Symmetric version of **Fubini's Theorem**: For integrable functions on `α × β`,
  the Bochner integral of `f` is equal to the iterated Bochner integral.
  This version has the integrals on the right-hand side in the other order. -/
lemma integral_prod_symm (f : α × β → E) (hf : integrable f (μ.prod ν)) :
  ∫ z, f z ∂(μ.prod ν) = ∫ y, ∫ x, f (x, y) ∂μ ∂ν :=
by { simp_rw [← integral_prod_swap f hf.ae_strongly_measurable], exact integral_prod _ hf.swap }

/-- Reversed version of **Fubini's Theorem**. -/
lemma integral_integral {f : α → β → E} (hf : integrable (uncurry f) (μ.prod ν)) :
  ∫ x, ∫ y, f x y ∂ν ∂μ = ∫ z, f z.1 z.2 ∂(μ.prod ν) :=
(integral_prod _ hf).symm

/-- Reversed version of **Fubini's Theorem** (symmetric version). -/
lemma integral_integral_symm {f : α → β → E} (hf : integrable (uncurry f) (μ.prod ν)) :
  ∫ x, ∫ y, f x y ∂ν ∂μ = ∫ z, f z.2 z.1 ∂(ν.prod μ) :=
(integral_prod_symm _ hf.swap).symm

/-- Change the order of Bochner integration. -/
lemma integral_integral_swap ⦃f : α → β → E⦄ (hf : integrable (uncurry f) (μ.prod ν)) :
  ∫ x, ∫ y, f x y ∂ν ∂μ = ∫ y, ∫ x, f x y ∂μ ∂ν :=
(integral_integral hf).trans (integral_prod_symm _ hf)

/-- **Fubini's Theorem** for set integrals. -/
lemma set_integral_prod (f : α × β → E) {s : set α} {t : set β}
  (hf : integrable_on f (s ×ˢ t) (μ.prod ν)) :
  ∫ z in s ×ˢ t, f z ∂(μ.prod ν) = ∫ x in s, ∫ y in t, f (x, y) ∂ν ∂μ :=
begin
  simp only [← measure.prod_restrict s t, integrable_on] at hf ⊢,
  exact integral_prod f hf
end

lemma integral_prod_mul {L : Type*} [is_R_or_C L] (f : α → L) (g : β → L) :
  ∫ z, f z.1 * g z.2 ∂(μ.prod ν) = (∫ x, f x ∂μ) * (∫ y, g y ∂ν) :=
begin
  by_cases h : integrable (λ (z : α × β), f z.1 * g z.2) (μ.prod ν),
  { rw integral_prod _ h,
    simp_rw [integral_mul_left, integral_mul_right] },
  have H : ¬(integrable f μ) ∨ ¬(integrable g ν),
  { contrapose! h,
    exact integrable_prod_mul h.1 h.2 },
  cases H;
  simp [integral_undef h, integral_undef H],
end

lemma set_integral_prod_mul {L : Type*} [is_R_or_C L]
  (f : α → L) (g : β → L) (s : set α) (t : set β) :
  ∫ z in s ×ˢ t, f z.1 * g z.2 ∂(μ.prod ν) = (∫ x in s, f x ∂μ) * (∫ y in t, g y ∂ν) :=
by simp only [← measure.prod_restrict s t, integrable_on, integral_prod_mul]

end measure_theory


/-
Copyright (c) 2022 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis, Heather Macbeth, Johan Commelin
-/

import ring_theory.witt_vector.domain
import ring_theory.witt_vector.mul_coeff
import ring_theory.discrete_valuation_ring
import tactic.linear_combination

/-!

# Witt vectors over a perfect ring

This file establishes that Witt vectors over a perfect field are a discrete valuation ring.
When `k` is a perfect ring, a nonzero `a : 𝕎 k` can be written as `p^m * b` for some `m : ℕ` and
`b : 𝕎 k` with nonzero 0th coefficient.
When `k` is also a field, this `b` can be chosen to be a unit of `𝕎 k`.

## Main declarations

* `witt_vector.exists_eq_pow_p_mul`: the existence of this element `b` over a perfect ring
* `witt_vector.exists_eq_pow_p_mul'`: the existence of this unit `b` over a perfect field
* `witt_vector.discrete_valuation_ring`: `𝕎 k` is a discrete valuation ring if `k` is a perfect
    field

-/

noncomputable theory

namespace witt_vector

variables {p : ℕ} [hp : fact p.prime]
include hp
local notation `𝕎` := witt_vector p

section comm_ring
variables {k : Type*} [comm_ring k] [char_p k p]

/-- This is the `n+1`st coefficient of our inverse. -/
def succ_nth_val_units (n : ℕ) (a : units k) (A : 𝕎 k) (bs : fin (n+1) → k) : k :=
- ↑(a⁻¹ ^ (p^(n+1)))
* (A.coeff (n + 1) * ↑(a⁻¹ ^ (p^(n+1))) + nth_remainder p n (truncate_fun (n+1) A) bs)

/--
Recursively defines the sequence of coefficients for the inverse to a Witt vector whose first entry
is a unit.
-/
noncomputable def inverse_coeff (a : units k) (A : 𝕎 k) : ℕ → k
| 0       := ↑a⁻¹
| (n + 1) := succ_nth_val_units n a A (λ i, inverse_coeff i.val)
              using_well_founded { dec_tac := `[apply fin.is_lt] }

/--
Upgrade a Witt vector `A` whose first entry `A.coeff 0` is a unit to be, itself, a unit in `𝕎 k`.
-/
def mk_unit {a : units k} {A : 𝕎 k} (hA : A.coeff 0 = a) : units (𝕎 k) :=
units.mk_of_mul_eq_one A (witt_vector.mk p (inverse_coeff a A))
  begin
    ext n,
    induction n with n ih,
    { simp [witt_vector.mul_coeff_zero, inverse_coeff, hA] },
    let H_coeff := A.coeff (n + 1) * ↑(a⁻¹ ^ p ^ (n + 1))
      + nth_remainder p n (truncate_fun (n + 1) A) (λ (i : fin (n + 1)), inverse_coeff a A i),
    have H := units.mul_inv (a ^ p ^ (n + 1)),
    linear_combination -H_coeff*H with { normalize := ff },
    have ha : (a:k) ^ (p ^ (n + 1)) = ↑(a ^ (p ^ (n + 1))) := by norm_cast,
    have ha_inv : (↑(a⁻¹):k) ^ (p ^ (n + 1)) = ↑(a ^ (p ^ (n + 1)))⁻¹ :=
      by exact_mod_cast inv_pow _ _,
    simp only [nth_remainder_spec, inverse_coeff, succ_nth_val_units, hA, fin.val_eq_coe,
      one_coeff_eq_of_pos, nat.succ_pos', H_coeff, ha_inv, ha, inv_pow],
    ring!,
  end

@[simp] lemma coe_mk_unit {a : units k} {A : 𝕎 k} (hA : A.coeff 0 = a) : (mk_unit hA : 𝕎 k) = A :=
rfl

end comm_ring

section field
variables {k : Type*} [field k] [char_p k p]

lemma is_unit_of_coeff_zero_ne_zero (x : 𝕎 k) (hx : x.coeff 0 ≠ 0) : is_unit x :=
begin
  let y : kˣ := units.mk0 (x.coeff 0) hx,
  have hy : x.coeff 0 = y := rfl,
  exact (mk_unit hy).is_unit
end

variables (p)
lemma irreducible : irreducible (p : 𝕎 k) :=
begin
  have hp : ¬ is_unit (p : 𝕎 k),
  { intro hp,
    simpa only [constant_coeff_apply, coeff_p_zero, not_is_unit_zero]
      using (constant_coeff : witt_vector p k →+* _).is_unit_map hp, },
  refine ⟨hp, λ a b hab, _⟩,
  obtain ⟨ha0, hb0⟩ : a ≠ 0 ∧ b ≠ 0,
  { rw ← mul_ne_zero_iff, intro h, rw h at hab, exact p_nonzero p k hab },
  obtain ⟨m, a, ha, rfl⟩ := verschiebung_nonzero ha0,
  obtain ⟨n, b, hb, rfl⟩ := verschiebung_nonzero hb0,
  cases m, { exact or.inl (is_unit_of_coeff_zero_ne_zero a ha) },
  cases n, { exact or.inr (is_unit_of_coeff_zero_ne_zero b hb) },
  rw iterate_verschiebung_mul at hab,
  apply_fun (λ x, coeff x 1) at hab,
  simp only [coeff_p_one, nat.add_succ, add_comm _ n, function.iterate_succ', function.comp_app,
    verschiebung_coeff_add_one, verschiebung_coeff_zero] at hab,
  exact (one_ne_zero hab).elim
end

end field

section perfect_ring
variables {k : Type*} [comm_ring k] [char_p k p] [perfect_ring k p]

lemma exists_eq_pow_p_mul (a : 𝕎 k) (ha : a ≠ 0) :
  ∃ (m : ℕ) (b : 𝕎 k), b.coeff 0 ≠ 0 ∧ a = p ^ m * b :=
begin
  obtain ⟨m, c, hc, hcm⟩ := witt_vector.verschiebung_nonzero ha,
  obtain ⟨b, rfl⟩ := (frobenius_bijective p k).surjective.iterate m c,
  rw witt_vector.iterate_frobenius_coeff at hc,
  have := congr_fun (witt_vector.verschiebung_frobenius_comm.comp_iterate m) b,
  simp only [function.comp_app] at this,
  rw ← this at hcm,
  refine ⟨m, b, _, _⟩,
  { contrapose! hc,
    have : 0 < p ^ m := pow_pos (nat.prime.pos (fact.out _)) _,
    simp [hc, zero_pow this] },
  { rw ← mul_left_iterate (p : 𝕎 k) m,
    convert hcm,
    ext1 x,
    rw [mul_comm, ← witt_vector.verschiebung_frobenius x] },
end

end perfect_ring

section perfect_field
variables {k : Type*} [field k] [char_p k p] [perfect_ring k p]

lemma exists_eq_pow_p_mul' (a : 𝕎 k) (ha : a ≠ 0) :
  ∃ (m : ℕ) (b : units (𝕎 k)), a = p ^ m * b :=
begin
  obtain ⟨m, b, h₁, h₂⟩ := exists_eq_pow_p_mul a ha,
  let b₀ := units.mk0 (b.coeff 0) h₁,
  have hb₀ : b.coeff 0 = b₀ := rfl,
  exact ⟨m, mk_unit hb₀, h₂⟩,
end

/-
Note: The following lemma should be an instance, but it seems to cause some
exponential blowups in certain typeclass resolution problems.
See the following Lean4 issue as well as the zulip discussion linked there:
https://github.com/leanprover/lean4/issues/1102
-/

/--
The ring of Witt Vectors of a perfect field of positive characteristic is a DVR.
-/
lemma discrete_valuation_ring : discrete_valuation_ring (𝕎 k) :=
discrete_valuation_ring.of_has_unit_mul_pow_irreducible_factorization
begin
  refine ⟨p, irreducible p, λ x hx, _⟩,
  obtain ⟨n, b, hb⟩ := exists_eq_pow_p_mul' x hx,
  exact ⟨n, b, hb.symm⟩,
end

end perfect_field
end witt_vector