/-
Copyright (c) 2021 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying
-/
import measure_theory.measure.complex
import measure_theory.measure.sub
import measure_theory.decomposition.jordan
import measure_theory.measure.with_density_vector_measure
import measure_theory.function.ae_eq_of_integral

/-!
# Lebesgue decomposition

This file proves the Lebesgue decomposition theorem. The Lebesgue decomposition theorem states that,
given two σ-finite measures `μ` and `ν`, there exists a σ-finite measure `ξ` and a measurable
function `f` such that `μ = ξ + fν` and `ξ` is mutually singular with respect to `ν`.

The Lebesgue decomposition provides the Radon-Nikodym theorem readily.

## Main definitions

* `measure_theory.measure.have_lebesgue_decomposition` : A pair of measures `μ` and `ν` is said
  to `have_lebesgue_decomposition` if there exist a measure `ξ` and a measurable function `f`,
  such that `ξ` is mutually singular with respect to `ν` and `μ = ξ + ν.with_density f`
* `measure_theory.measure.singular_part` : If a pair of measures `have_lebesgue_decomposition`,
  then `singular_part` chooses the measure from `have_lebesgue_decomposition`, otherwise it
  returns the zero measure.
* `measure_theory.measure.rn_deriv`: If a pair of measures
  `have_lebesgue_decomposition`, then `rn_deriv` chooses the measurable function from
  `have_lebesgue_decomposition`, otherwise it returns the zero function.
* `measure_theory.signed_measure.have_lebesgue_decomposition` : A signed measure `s` and a
  measure `μ` is said to `have_lebesgue_decomposition` if both the positive part and negative
  part of `s` `have_lebesgue_decomposition` with respect to `μ`.
* `measure_theory.signed_measure.singular_part` : The singular part between a signed measure `s`
  and a measure `μ` is simply the singular part of the positive part of `s` with respect to `μ`
  minus the singular part of the negative part of `s` with respect to `μ`.
* `measure_theory.signed_measure.rn_deriv` : The Radon-Nikodym derivative of a signed
  measure `s` with respect to a measure `μ` is the Radon-Nikodym derivative of the positive part of
  `s` with respect to `μ` minus the Radon-Nikodym derivative of the negative part of `s` with
  respect to `μ`.

## Main results

* `measure_theory.measure.have_lebesgue_decomposition_of_sigma_finite` :
  the Lebesgue decomposition theorem.
* `measure_theory.measure.eq_singular_part` : Given measures `μ` and `ν`, if `s` is a measure
  mutually singular to `ν` and `f` is a measurable function such that `μ = s + fν`, then
  `s = μ.singular_part ν`.
* `measure_theory.measure.eq_rn_deriv` : Given measures `μ` and `ν`, if `s` is a
  measure mutually singular to `ν` and `f` is a measurable function such that `μ = s + fν`,
  then `f = μ.rn_deriv ν`.
* `measure_theory.signed_measure.singular_part_add_with_density_rn_deriv_eq` :
  the Lebesgue decomposition theorem between a signed measure and a σ-finite positive measure.

# Tags

Lebesgue decomposition theorem
-/

noncomputable theory
open_locale classical measure_theory nnreal ennreal
open set

variables {α β : Type*} {m : measurable_space α} {μ ν : measure_theory.measure α}
include m

namespace measure_theory

namespace measure

/-- A pair of measures `μ` and `ν` is said to `have_lebesgue_decomposition` if there exists a
measure `ξ` and a measurable function `f`, such that `ξ` is mutually singular with respect to
`ν` and `μ = ξ + ν.with_density f`. -/
class have_lebesgue_decomposition (μ ν : measure α) : Prop :=
(lebesgue_decomposition :
  ∃ (p : measure α × (α → ℝ≥0∞)), measurable p.2 ∧ p.1 ⟂ₘ ν ∧ μ = p.1 + ν.with_density p.2)

/-- If a pair of measures `have_lebesgue_decomposition`, then `singular_part` chooses the
measure from `have_lebesgue_decomposition`, otherwise it returns the zero measure. For sigma-finite
measures, `μ = μ.singular_part ν + ν.with_density (μ.rn_deriv ν)`. -/
@[irreducible]
def singular_part (μ ν : measure α) : measure α :=
if h : have_lebesgue_decomposition μ ν then (classical.some h.lebesgue_decomposition).1 else 0

/-- If a pair of measures `have_lebesgue_decomposition`, then `rn_deriv` chooses the
measurable function from `have_lebesgue_decomposition`, otherwise it returns the zero function.
For sigma-finite measures, `μ = μ.singular_part ν + ν.with_density (μ.rn_deriv ν)`.-/
@[irreducible]
def rn_deriv (μ ν : measure α) : α → ℝ≥0∞ :=
if h : have_lebesgue_decomposition μ ν then (classical.some h.lebesgue_decomposition).2 else 0

lemma have_lebesgue_decomposition_spec (μ ν : measure α)
  [h : have_lebesgue_decomposition μ ν] :
  measurable (μ.rn_deriv ν) ∧ (μ.singular_part ν) ⟂ₘ ν ∧
  μ = (μ.singular_part ν) + ν.with_density (μ.rn_deriv ν) :=
begin
  rw [singular_part, rn_deriv, dif_pos h, dif_pos h],
  exact classical.some_spec h.lebesgue_decomposition,
end

lemma have_lebesgue_decomposition_add (μ ν : measure α)
  [have_lebesgue_decomposition μ ν] :
  μ = (μ.singular_part ν) + ν.with_density (μ.rn_deriv ν) :=
(have_lebesgue_decomposition_spec μ ν).2.2

instance have_lebesgue_decomposition_smul
  (μ ν : measure α) [have_lebesgue_decomposition μ ν] (r : ℝ≥0) :
  (r • μ).have_lebesgue_decomposition ν :=
{ lebesgue_decomposition :=
  begin
    obtain ⟨hmeas, hsing, hadd⟩ := have_lebesgue_decomposition_spec μ ν,
    refine ⟨⟨r • μ.singular_part ν, r • μ.rn_deriv ν⟩, _, hsing.smul _, _⟩,
    { change measurable ((r : ℝ≥0∞) • _), -- cannot remove this line
      exact hmeas.const_smul _ },
    { change _ = (r : ℝ≥0∞) • _ + ν.with_density ((r : ℝ≥0∞) • _),
      rw [with_density_smul _ hmeas, ← smul_add, ← hadd],
      refl }
  end }

@[measurability]
lemma measurable_rn_deriv (μ ν : measure α) :
  measurable $ μ.rn_deriv ν :=
begin
  by_cases h : have_lebesgue_decomposition μ ν,
  { exactI (have_lebesgue_decomposition_spec μ ν).1 },
  { rw [rn_deriv, dif_neg h],
    exact measurable_zero }
end

lemma singular_part_le (μ ν : measure α) : μ.singular_part ν ≤ μ :=
begin
  by_cases hl : have_lebesgue_decomposition μ ν,
  { casesI (have_lebesgue_decomposition_spec μ ν).2 with _ h,
    conv_rhs { rw h },
    exact measure.le_add_right le_rfl },
  { rw [singular_part, dif_neg hl],
    exact measure.zero_le μ }
end

lemma with_density_rn_deriv_le (μ ν : measure α) :
  ν.with_density (μ.rn_deriv ν) ≤ μ :=
begin
  by_cases hl : have_lebesgue_decomposition μ ν,
  { casesI (have_lebesgue_decomposition_spec μ ν).2 with _ h,
    conv_rhs { rw h },
    exact measure.le_add_left le_rfl },
  { rw [rn_deriv, dif_neg hl, with_density_zero],
    exact measure.zero_le μ }
end

instance [is_finite_measure μ] : is_finite_measure (μ.singular_part ν) :=
is_finite_measure_of_le μ $ singular_part_le μ ν

instance [sigma_finite μ] : sigma_finite (μ.singular_part ν) :=
sigma_finite_of_le μ $ singular_part_le μ ν

instance [topological_space α] [is_locally_finite_measure μ] :
  is_locally_finite_measure (μ.singular_part ν) :=
is_locally_finite_measure_of_le $ singular_part_le μ ν

instance [is_finite_measure μ] : is_finite_measure (ν.with_density $ μ.rn_deriv ν) :=
is_finite_measure_of_le μ $ with_density_rn_deriv_le μ ν

instance [sigma_finite μ] : sigma_finite (ν.with_density $ μ.rn_deriv ν) :=
sigma_finite_of_le μ $ with_density_rn_deriv_le μ ν

instance [topological_space α] [is_locally_finite_measure μ] :
  is_locally_finite_measure (ν.with_density $ μ.rn_deriv ν) :=
is_locally_finite_measure_of_le $ with_density_rn_deriv_le μ ν

lemma lintegral_rn_deriv_lt_top_of_measure_ne_top
  {μ : measure α} (ν : measure α) {s : set α} (hs : μ s ≠ ∞) :
  ∫⁻ x in s, μ.rn_deriv ν x ∂ν < ∞ :=
begin
  by_cases hl : have_lebesgue_decomposition μ ν,
  { haveI := hl,
    obtain ⟨-, -, hadd⟩ := have_lebesgue_decomposition_spec μ ν,
    suffices : ∫⁻ x in to_measurable μ s, μ.rn_deriv ν x ∂ν < ∞,
      from lt_of_le_of_lt (lintegral_mono_set (subset_to_measurable _ _)) this,
    rw [← with_density_apply _ (measurable_set_to_measurable _ _)],
    refine lt_of_le_of_lt
      (le_add_left le_rfl : _ ≤ μ.singular_part ν (to_measurable μ s) +
        ν.with_density (μ.rn_deriv ν) (to_measurable μ s)) _,
    rw [← measure.add_apply, ← hadd, measure_to_measurable],
    exact hs.lt_top },
  { erw [measure.rn_deriv, dif_neg hl, lintegral_zero],
    exact with_top.zero_lt_top },
end

lemma lintegral_rn_deriv_lt_top
  (μ ν : measure α) [is_finite_measure μ] :
  ∫⁻ x, μ.rn_deriv ν x ∂ν < ∞ :=
begin
  rw [← set_lintegral_univ],
  exact lintegral_rn_deriv_lt_top_of_measure_ne_top _ (measure_lt_top _ _).ne,
end

/-- The Radon-Nikodym derivative of a sigma-finite measure `μ` with respect to another
measure `ν` is `ν`-almost everywhere finite. -/
theorem rn_deriv_lt_top (μ ν : measure α) [sigma_finite μ] :
  ∀ᵐ x ∂ν, μ.rn_deriv ν x < ∞ :=
begin
  suffices : ∀ n, ∀ᵐ x ∂ν, x ∈ spanning_sets μ n → μ.rn_deriv ν x < ∞,
  { filter_upwards [ae_all_iff.2 this] with _ hx using hx _ (mem_spanning_sets_index _ _), },
  assume n,
  rw ← ae_restrict_iff' (measurable_spanning_sets _ _),
  apply ae_lt_top (measurable_rn_deriv _ _),
  refine (lintegral_rn_deriv_lt_top_of_measure_ne_top _ _).ne,
  exact (measure_spanning_sets_lt_top _ _).ne
end

/-- Given measures `μ` and `ν`, if `s` is a measure mutually singular to `ν` and `f` is a
measurable function such that `μ = s + fν`, then `s = μ.singular_part μ`.

This theorem provides the uniqueness of the `singular_part` in the Lebesgue decomposition theorem,
while `measure_theory.measure.eq_rn_deriv` provides the uniqueness of the
`rn_deriv`. -/
theorem eq_singular_part {s : measure α} {f : α → ℝ≥0∞} (hf : measurable f)
  (hs : s ⟂ₘ ν) (hadd : μ = s + ν.with_density f) :
  s = μ.singular_part ν :=
begin
  haveI : have_lebesgue_decomposition μ ν := ⟨⟨⟨s, f⟩, hf, hs, hadd⟩⟩,
  obtain ⟨hmeas, hsing, hadd'⟩ := have_lebesgue_decomposition_spec μ ν,
  obtain ⟨⟨S, hS₁, hS₂, hS₃⟩, ⟨T, hT₁, hT₂, hT₃⟩⟩ := ⟨hs, hsing⟩,
  rw hadd' at hadd,
  have hνinter : ν (S ∩ T)ᶜ = 0,
  { rw compl_inter,
    refine nonpos_iff_eq_zero.1 (le_trans (measure_union_le _ _) _),
    rw [hT₃, hS₃, add_zero],
    exact le_rfl },
  have heq : s.restrict (S ∩ T)ᶜ = (μ.singular_part ν).restrict (S ∩ T)ᶜ,
  { ext1 A hA,
    have hf : ν.with_density f (A ∩ (S ∩ T)ᶜ) = 0,
    { refine with_density_absolutely_continuous ν _ _,
      rw ← nonpos_iff_eq_zero,
      exact hνinter ▸ measure_mono (inter_subset_right _ _) },
    have hrn : ν.with_density (μ.rn_deriv ν) (A ∩ (S ∩ T)ᶜ) = 0,
    { refine with_density_absolutely_continuous ν _ _,
      rw ← nonpos_iff_eq_zero,
      exact hνinter ▸ measure_mono (inter_subset_right _ _) },
    rw [restrict_apply hA, restrict_apply hA, ← add_zero (s (A ∩ (S ∩ T)ᶜ)), ← hf,
        ← add_apply, ← hadd, add_apply, hrn, add_zero] },
  have heq' : ∀ A : set α, measurable_set A → s A = s.restrict (S ∩ T)ᶜ A,
  { intros A hA,
    have hsinter : s (A ∩ (S ∩ T)) = 0,
    { rw ← nonpos_iff_eq_zero,
      exact hS₂ ▸ measure_mono ((inter_subset_right _ _).trans (inter_subset_left _ _)) },
    rw [restrict_apply hA, ← diff_eq, ae_disjoint.measure_diff_left hsinter] },
  ext1 A hA,
  have hμinter : μ.singular_part ν (A ∩ (S ∩ T)) = 0,
  { rw ← nonpos_iff_eq_zero,
    exact hT₂ ▸ measure_mono ((inter_subset_right _ _).trans (inter_subset_right _ _)) },
  rw [heq' A hA, heq, restrict_apply hA, ← diff_eq, ae_disjoint.measure_diff_left hμinter]
end

lemma singular_part_zero (ν : measure α) : (0 : measure α).singular_part ν = 0 :=
begin
  refine (eq_singular_part measurable_zero mutually_singular.zero_left _).symm,
  rw [zero_add, with_density_zero],
end

lemma singular_part_smul (μ ν : measure α) (r : ℝ≥0) :
  (r • μ).singular_part ν = r • (μ.singular_part ν) :=
begin
  by_cases hr : r = 0,
  { rw [hr, zero_smul, zero_smul, singular_part_zero] },
  by_cases hl : have_lebesgue_decomposition μ ν,
  { haveI := hl,
    refine (eq_singular_part ((measurable_rn_deriv μ ν).const_smul (r : ℝ≥0∞))
      (mutually_singular.smul r (have_lebesgue_decomposition_spec _ _).2.1) _).symm,
    rw [with_density_smul _ (measurable_rn_deriv _ _), ← smul_add,
      ← have_lebesgue_decomposition_add μ ν, ennreal.smul_def] },
  { rw [singular_part, singular_part, dif_neg hl, dif_neg, smul_zero],
    refine λ hl', hl _,
    rw ← inv_smul_smul₀ hr μ,
    exact @measure.have_lebesgue_decomposition_smul _ _ _ _ hl' _ }
end

lemma singular_part_add (μ₁ μ₂ ν : measure α)
  [have_lebesgue_decomposition μ₁ ν] [have_lebesgue_decomposition μ₂ ν] :
  (μ₁ + μ₂).singular_part ν = μ₁.singular_part ν + μ₂.singular_part ν :=
begin
  refine (eq_singular_part
    ((measurable_rn_deriv μ₁ ν).add (measurable_rn_deriv μ₂ ν))
    ((have_lebesgue_decomposition_spec _ _).2.1.add_left (have_lebesgue_decomposition_spec _ _).2.1)
    _).symm,
  erw with_density_add_left (measurable_rn_deriv μ₁ ν),
  conv_rhs { rw [add_assoc, add_comm (μ₂.singular_part ν), ← add_assoc, ← add_assoc] },
  rw [← have_lebesgue_decomposition_add μ₁ ν, add_assoc,
      add_comm (ν.with_density (μ₂.rn_deriv ν)),
      ← have_lebesgue_decomposition_add μ₂ ν]
end

lemma singular_part_with_density (ν : measure α) {f : α → ℝ≥0∞} (hf : measurable f) :
  (ν.with_density f).singular_part ν = 0 :=
begin
  have : ν.with_density f = 0 + ν.with_density f, by rw zero_add,
  exact (eq_singular_part hf mutually_singular.zero_left this).symm,
end

/-- Given measures `μ` and `ν`, if `s` is a measure mutually singular to `ν` and `f` is a
measurable function such that `μ = s + fν`, then `f = μ.rn_deriv ν`.

This theorem provides the uniqueness of the `rn_deriv` in the Lebesgue decomposition
theorem, while `measure_theory.measure.eq_singular_part` provides the uniqueness of the
`singular_part`. Here, the uniqueness is given in terms of the measures, while the uniqueness in
terms of the functions is given in `eq_rn_deriv`. -/
theorem eq_with_density_rn_deriv {s : measure α} {f : α → ℝ≥0∞} (hf : measurable f)
  (hs : s ⟂ₘ ν) (hadd : μ = s + ν.with_density f) :
  ν.with_density f = ν.with_density (μ.rn_deriv ν) :=
begin
  haveI : have_lebesgue_decomposition μ ν := ⟨⟨⟨s, f⟩, hf, hs, hadd⟩⟩,
  obtain ⟨hmeas, hsing, hadd'⟩ := have_lebesgue_decomposition_spec μ ν,
  obtain ⟨⟨S, hS₁, hS₂, hS₃⟩, ⟨T, hT₁, hT₂, hT₃⟩⟩ := ⟨hs, hsing⟩,
  rw hadd' at hadd,
  have hνinter : ν (S ∩ T)ᶜ = 0,
  { rw compl_inter,
    refine nonpos_iff_eq_zero.1 (le_trans (measure_union_le _ _) _),
    rw [hT₃, hS₃, add_zero],
    exact le_rfl },
  have heq : (ν.with_density f).restrict (S ∩ T) =
              (ν.with_density (μ.rn_deriv ν)).restrict (S ∩ T),
  { ext1 A hA,
    have hs : s (A ∩ (S ∩ T)) = 0,
    { rw ← nonpos_iff_eq_zero,
      exact hS₂ ▸ measure_mono ((inter_subset_right _ _).trans (inter_subset_left _ _)) },
    have hsing : μ.singular_part ν (A ∩ (S ∩ T)) = 0,
    { rw ← nonpos_iff_eq_zero,
      exact hT₂ ▸ measure_mono
        ((inter_subset_right _ _).trans (inter_subset_right _ _)) },
    rw [restrict_apply hA, restrict_apply hA, ← add_zero (ν.with_density f (A ∩ (S ∩ T))),
        ← hs, ← add_apply, add_comm, ← hadd, add_apply, hsing, zero_add] },
  have heq' : ∀ A : set α, measurable_set A →
    ν.with_density f A = (ν.with_density f).restrict (S ∩ T) A,
  { intros A hA,
    have hνfinter : ν.with_density f (A ∩ (S ∩ T)ᶜ) = 0,
    { rw ← nonpos_iff_eq_zero,
      exact with_density_absolutely_continuous ν f hνinter ▸
        measure_mono (inter_subset_right _ _) },
    rw [restrict_apply hA, ← add_zero (ν.with_density f (A ∩ (S ∩ T))), ← hνfinter,
        ← diff_eq, measure_inter_add_diff _ (hS₁.inter hT₁)] },
  ext1 A hA,
  have hνrn : ν.with_density (μ.rn_deriv ν) (A ∩ (S ∩ T)ᶜ) = 0,
  { rw ← nonpos_iff_eq_zero,
    exact with_density_absolutely_continuous ν (μ.rn_deriv ν) hνinter ▸
      measure_mono (inter_subset_right _ _) },
  rw [heq' A hA, heq, ← add_zero ((ν.with_density (μ.rn_deriv ν)).restrict (S ∩ T) A),
      ← hνrn, restrict_apply hA, ← diff_eq, measure_inter_add_diff _ (hS₁.inter hT₁)]
end

/-- Given measures `μ` and `ν`, if `s` is a measure mutually singular to `ν` and `f` is a
measurable function such that `μ = s + fν`, then `f = μ.rn_deriv ν`.

This theorem provides the uniqueness of the `rn_deriv` in the Lebesgue decomposition
theorem, while `measure_theory.measure.eq_singular_part` provides the uniqueness of the
`singular_part`. Here, the uniqueness is given in terms of the functions, while the uniqueness in
terms of the functions is given in `eq_with_density_rn_deriv`. -/
theorem eq_rn_deriv [sigma_finite ν] {s : measure α} {f : α → ℝ≥0∞} (hf : measurable f)
  (hs : s ⟂ₘ ν) (hadd : μ = s + ν.with_density f) :
  f =ᵐ[ν] μ.rn_deriv ν :=
begin
  refine ae_eq_of_forall_set_lintegral_eq_of_sigma_finite hf (measurable_rn_deriv μ ν) _,
  assume a ha h'a,
  calc ∫⁻ (x : α) in a, f x ∂ν = ν.with_density f a : (with_density_apply f ha).symm
  ... = ν.with_density (μ.rn_deriv ν) a : by rw eq_with_density_rn_deriv hf hs hadd
  ... = ∫⁻ (x : α) in a, μ.rn_deriv ν x ∂ν : with_density_apply _ ha
end

/-- The Radon-Nikodym derivative of `f ν` with respect to `ν` is `f`. -/
theorem rn_deriv_with_density (ν : measure α) [sigma_finite ν] {f : α → ℝ≥0∞} (hf : measurable f) :
  (ν.with_density f).rn_deriv ν =ᵐ[ν] f :=
begin
  have : ν.with_density f = 0 + ν.with_density f, by rw zero_add,
  exact (eq_rn_deriv hf mutually_singular.zero_left this).symm,
end

/-- The Radon-Nikodym derivative of the restriction of a measure to a measurable set is the
indicator function of this set. -/
theorem rn_deriv_restrict (ν : measure α) [sigma_finite ν] {s : set α} (hs : measurable_set s) :
  (ν.restrict s).rn_deriv ν =ᵐ[ν] s.indicator 1 :=
begin
  rw ← with_density_indicator_one hs,
  exact rn_deriv_with_density _ (measurable_one.indicator hs)
end

open vector_measure signed_measure

/-- If two finite measures `μ` and `ν` are not mutually singular, there exists some `ε > 0` and
a measurable set `E`, such that `ν(E) > 0` and `E` is positive with respect to `μ - εν`.

This lemma is useful for the Lebesgue decomposition theorem. -/
lemma exists_positive_of_not_mutually_singular
  (μ ν : measure α) [is_finite_measure μ] [is_finite_measure ν] (h : ¬ μ ⟂ₘ ν) :
  ∃ ε : ℝ≥0, 0 < ε ∧ ∃ E : set α, measurable_set E ∧ 0 < ν E ∧
  0 ≤[E] μ.to_signed_measure - (ε • ν).to_signed_measure :=
begin
  -- for all `n : ℕ`, obtain the Hahn decomposition for `μ - (1 / n) ν`
  have : ∀ n : ℕ, ∃ i : set α, measurable_set i ∧
    0 ≤[i] (μ.to_signed_measure - ((1 / (n + 1) : ℝ≥0) • ν).to_signed_measure) ∧
    (μ.to_signed_measure - ((1 / (n + 1) : ℝ≥0) • ν).to_signed_measure) ≤[iᶜ] 0,
  { intro, exact exists_compl_positive_negative _ },
  choose f hf₁ hf₂ hf₃ using this,
  -- set `A` to be the intersection of all the negative parts of obtained Hahn decompositions
  -- and we show that `μ A = 0`
  set A := ⋂ n, (f n)ᶜ with hA₁,
  have hAmeas : measurable_set A,
  { exact measurable_set.Inter (λ n, (hf₁ n).compl) },
  have hA₂ : ∀ n : ℕ, (μ.to_signed_measure - ((1 / (n + 1) : ℝ≥0) • ν).to_signed_measure) ≤[A] 0,
  { intro n, exact restrict_le_restrict_subset _ _ (hf₁ n).compl (hf₃ n) (Inter_subset _ _) },
  have hA₃ : ∀ n : ℕ, μ A ≤ (1 / (n + 1) : ℝ≥0) * ν A,
  { intro n,
    have := nonpos_of_restrict_le_zero _ (hA₂ n),
    rwa [to_signed_measure_sub_apply hAmeas, sub_nonpos, ennreal.to_real_le_to_real] at this,
    exacts [ne_of_lt (measure_lt_top _ _), ne_of_lt (measure_lt_top _ _)] },
  have hμ : μ A = 0,
  { lift μ A to ℝ≥0 using ne_of_lt (measure_lt_top _ _) with μA,
    lift ν A to ℝ≥0 using ne_of_lt (measure_lt_top _ _) with νA,
    rw ennreal.coe_eq_zero,
    by_cases hb : 0 < νA,
    { suffices : ∀ b, 0 < b → μA ≤ b,
      { by_contra,
        have h' := this (μA / 2) (half_pos (zero_lt_iff.2 h)),
        rw ← @not_not (μA ≤ μA / 2) at h',
        exact h' (not_le.2 (nnreal.half_lt_self h)) },
      intros c hc,
      have : ∃ n : ℕ, 1 / (n + 1 : ℝ) < c * νA⁻¹, refine exists_nat_one_div_lt _,
      { refine mul_pos hc _,
        rw _root_.inv_pos, exact hb },
      rcases this with ⟨n, hn⟩,
      have hb₁ : (0 : ℝ) < νA⁻¹, { rw _root_.inv_pos, exact hb },
      have h' : 1 / (↑n + 1) * νA < c,
      { rw [← nnreal.coe_lt_coe, ← mul_lt_mul_right hb₁, nnreal.coe_mul, mul_assoc,
            ← nnreal.coe_inv, ← nnreal.coe_mul, _root_.mul_inv_cancel, ← nnreal.coe_mul,
            mul_one, nnreal.coe_inv],
        { exact hn },
        { exact ne.symm (ne_of_lt hb) } },
      refine le_trans _ (le_of_lt h'),
      rw [← ennreal.coe_le_coe, ennreal.coe_mul],
      exact hA₃ n },
    { rw [not_lt, le_zero_iff] at hb,
      specialize hA₃ 0,
      simp [hb, le_zero_iff] at hA₃,
      assumption } },
  -- since `μ` and `ν` are not mutually singular, `μ A = 0` implies `ν Aᶜ > 0`
  rw mutually_singular at h, push_neg at h,
  have := h _ hAmeas hμ,
  simp_rw [hA₁, compl_Inter, compl_compl] at this,
  -- as `Aᶜ = ⋃ n, f n`, `ν Aᶜ > 0` implies there exists some `n` such that `ν (f n) > 0`
  obtain ⟨n, hn⟩ := exists_measure_pos_of_not_measure_Union_null this,
  -- thus, choosing `f n` as the set `E` suffices
  exact ⟨1 / (n + 1), by simp, f n, hf₁ n, hn, hf₂ n⟩,
end

namespace lebesgue_decomposition

/-- Given two measures `μ` and `ν`, `measurable_le μ ν` is the set of measurable
functions `f`, such that, for all measurable sets `A`, `∫⁻ x in A, f x ∂μ ≤ ν A`.

This is useful for the Lebesgue decomposition theorem. -/
def measurable_le (μ ν : measure α) : set (α → ℝ≥0∞) :=
{ f | measurable f ∧ ∀ (A : set α) (hA : measurable_set A), ∫⁻ x in A, f x ∂μ ≤ ν A }

lemma zero_mem_measurable_le : (0 : α → ℝ≥0∞) ∈ measurable_le μ ν :=
⟨measurable_zero, λ A hA, by simp⟩

lemma sup_mem_measurable_le {f g : α → ℝ≥0∞}
  (hf : f ∈ measurable_le μ ν) (hg : g ∈ measurable_le μ ν) :
  (λ a, f a ⊔ g a) ∈ measurable_le μ ν :=
begin
  simp_rw ennreal.sup_eq_max,
  refine ⟨measurable.max hf.1 hg.1, λ A hA, _⟩,
  have h₁ := hA.inter (measurable_set_le hf.1 hg.1),
  have h₂ := hA.inter (measurable_set_lt hg.1 hf.1),
  rw [set_lintegral_max hf.1 hg.1],
  refine (add_le_add (hg.2 _ h₁) (hf.2 _ h₂)).trans_eq _,
  { simp only [← not_le, ← compl_set_of, ← diff_eq],
    exact measure_inter_add_diff _ (measurable_set_le hf.1 hg.1) }
end

lemma supr_succ_eq_sup {α} (f : ℕ → α → ℝ≥0∞) (m : ℕ) (a : α) :
  (⨆ (k : ℕ) (hk : k ≤ m + 1), f k a) = f m.succ a ⊔ ⨆ (k : ℕ) (hk : k ≤ m), f k a :=
begin
  ext x,
  simp only [option.mem_def, ennreal.some_eq_coe],
  split; intro h; rw ← h, symmetry,
  all_goals
  { set c := (⨆ (k : ℕ) (hk : k ≤ m + 1), f k a) with hc,
    set d := (f m.succ a ⊔ ⨆ (k : ℕ) (hk : k ≤ m), f k a) with hd,
    rw [@le_antisymm_iff ℝ≥0∞, hc, hd], -- Specifying the type is weirdly necessary
    refine ⟨_, _⟩,
    { refine supr₂_le (λ n hn, _),
      rcases nat.of_le_succ hn with (h | h),
      { exact le_sup_of_le_right (le_supr₂ n h) },
      { exact h ▸ le_sup_left } },
    { refine sup_le _ (bsupr_mono $ λ n hn, hn.trans m.le_succ),
      convert @le_supr₂ _ _ (λ i, i ≤ m + 1) _ _ m.succ le_rfl,
      refl } }
end

lemma supr_mem_measurable_le
  (f : ℕ → α → ℝ≥0∞) (hf : ∀ n, f n ∈ measurable_le μ ν) (n : ℕ) :
  (λ x, ⨆ k (hk : k ≤ n), f k x) ∈ measurable_le μ ν :=
begin
  induction n with m hm,
  { refine ⟨_, _⟩,
    { simp [(hf 0).1] },
    { intros A hA, simp [(hf 0).2 A hA] } },
  { have : (λ (a : α), ⨆ (k : ℕ) (hk : k ≤ m + 1), f k a) =
      (λ a, f m.succ a ⊔ ⨆ (k : ℕ) (hk : k ≤ m), f k a),
    { exact funext (λ _, supr_succ_eq_sup _ _ _) },
    refine ⟨measurable_supr (λ n, measurable.supr_Prop _ (hf n).1), λ A hA, _⟩,
    rw this, exact (sup_mem_measurable_le (hf m.succ) hm).2 A hA }
end

lemma supr_mem_measurable_le'
  (f : ℕ → α → ℝ≥0∞) (hf : ∀ n, f n ∈ measurable_le μ ν) (n : ℕ) :
  (⨆ k (hk : k ≤ n), f k) ∈ measurable_le μ ν :=
begin
  convert supr_mem_measurable_le f hf n,
  ext, simp
end

section supr_lemmas --TODO: these statements should be moved elsewhere
omit m

lemma supr_monotone {α : Type*} (f : ℕ → α → ℝ≥0∞) :
  monotone (λ n x, ⨆ k (hk : k ≤ n), f k x) :=
λ n m hnm x, bsupr_mono $ λ i, ge_trans hnm

lemma supr_monotone' {α : Type*} (f : ℕ → α → ℝ≥0∞) (x : α) :
  monotone (λ n, ⨆ k (hk : k ≤ n), f k x) :=
λ n m hnm, supr_monotone f hnm x

lemma supr_le_le {α : Type*} (f : ℕ → α → ℝ≥0∞) (n k : ℕ) (hk : k ≤ n) :
  f k ≤ λ x, ⨆ k (hk : k ≤ n), f k x :=
λ x, le_supr₂ k hk

end supr_lemmas

/-- `measurable_le_eval μ ν` is the set of `∫⁻ x, f x ∂μ` for all `f ∈ measurable_le μ ν`. -/
def measurable_le_eval (μ ν : measure α) : set ℝ≥0∞ :=
(λ f : α → ℝ≥0∞, ∫⁻ x, f x ∂μ) '' measurable_le μ ν

end lebesgue_decomposition

open lebesgue_decomposition

/-- Any pair of finite measures `μ` and `ν`, `have_lebesgue_decomposition`. That is to say,
there exist a measure `ξ` and a measurable function `f`, such that `ξ` is mutually singular
with respect to `ν` and `μ = ξ + ν.with_density f`.

This is not an instance since this is also shown for the more general σ-finite measures with
`measure_theory.measure.have_lebesgue_decomposition_of_sigma_finite`. -/
theorem have_lebesgue_decomposition_of_finite_measure [is_finite_measure μ] [is_finite_measure ν] :
  have_lebesgue_decomposition μ ν :=
⟨begin
  have h := @exists_seq_tendsto_Sup _ _ _ _ _ (measurable_le_eval ν μ)
    ⟨0, 0, zero_mem_measurable_le, by simp⟩ (order_top.bdd_above _),
  choose g hmono hg₂ f hf₁ hf₂ using h,
  -- we set `ξ` to be the supremum of an increasing sequence of functions obtained from above
  set ξ := ⨆ n k (hk : k ≤ n), f k with hξ,
  -- we see that `ξ` has the largest integral among all functions in `measurable_le`
  have hξ₁ : Sup (measurable_le_eval ν μ) = ∫⁻ a, ξ a ∂ν,
  { have := @lintegral_tendsto_of_tendsto_of_monotone _ _ ν
      (λ n, ⨆ k (hk : k ≤ n), f k) (⨆ n k (hk : k ≤ n), f k) _ _ _,
    { refine tendsto_nhds_unique _ this,
      refine tendsto_of_tendsto_of_tendsto_of_le_of_le hg₂ tendsto_const_nhds _ _,
      { intro n, rw ← hf₂ n,
        apply lintegral_mono,
        simp only [supr_apply, supr_le_le f n n le_rfl] },
      { intro n,
        exact le_Sup ⟨⨆ (k : ℕ) (hk : k ≤ n), f k, supr_mem_measurable_le' _ hf₁ _, rfl⟩ } },
    { intro n,
      refine measurable.ae_measurable _,
      convert (supr_mem_measurable_le _ hf₁ n).1,
      ext, simp },
    { refine filter.eventually_of_forall (λ a, _),
      simp [supr_monotone' f _] },
    { refine filter.eventually_of_forall (λ a, _),
      simp [tendsto_at_top_supr (supr_monotone' f a)] } },
  have hξm : measurable ξ,
  { convert measurable_supr (λ n, (supr_mem_measurable_le _ hf₁ n).1),
    ext, simp [hξ] },
  -- `ξ` is the `f` in the theorem statement and we set `μ₁` to be `μ - ν.with_density ξ`
  -- since we need `μ₁ + ν.with_density ξ = μ`
  set μ₁ := μ - ν.with_density ξ with hμ₁,
  have hle : ν.with_density ξ ≤ μ,
  { intros B hB,
    rw [hξ, with_density_apply _ hB],
    simp_rw [supr_apply],
    rw lintegral_supr (λ i, (supr_mem_measurable_le _ hf₁ i).1) (supr_monotone _),
    exact supr_le (λ i, (supr_mem_measurable_le _ hf₁ i).2 B hB) },
  haveI : is_finite_measure (ν.with_density ξ),
  { refine is_finite_measure_with_density _,
    have hle' := hle univ measurable_set.univ,
    rw [with_density_apply _ measurable_set.univ, measure.restrict_univ] at hle',
    exact ne_top_of_le_ne_top (measure_ne_top _ _) hle' },
  refine ⟨⟨μ₁, ξ⟩, hξm, _, _⟩,
  { by_contra,
  -- if they are not mutually singular, then from `exists_positive_of_not_mutually_singular`,
  -- there exists some `ε > 0` and a measurable set `E`, such that `μ(E) > 0` and `E` is
  -- positive with respect to `ν - εμ`
    obtain ⟨ε, hε₁, E, hE₁, hE₂, hE₃⟩ := exists_positive_of_not_mutually_singular μ₁ ν h,
    simp_rw hμ₁ at hE₃,
    have hξle : ∀ A, measurable_set A → ∫⁻ a in A, ξ a ∂ν ≤ μ A,
    { intros A hA, rw hξ,
      simp_rw [supr_apply],
      rw lintegral_supr (λ n, (supr_mem_measurable_le _ hf₁ n).1) (supr_monotone _),
      exact supr_le (λ n, (supr_mem_measurable_le _ hf₁ n).2 A hA) },
  -- since `E` is positive, we have `∫⁻ a in A ∩ E, ε + ξ a ∂ν ≤ μ (A ∩ E)` for all `A`
    have hε₂ : ∀ A : set α, measurable_set A → ∫⁻ a in A ∩ E, ε + ξ a ∂ν ≤ μ (A ∩ E),
    { intros A hA,
      have := subset_le_of_restrict_le_restrict _ _ hE₁ hE₃ (inter_subset_right A E),
      rwa [zero_apply, to_signed_measure_sub_apply (hA.inter hE₁),
            measure.sub_apply (hA.inter hE₁) hle,
            ennreal.to_real_sub_of_le _ (ne_of_lt (measure_lt_top _ _)), sub_nonneg,
            le_sub_iff_add_le, ← ennreal.to_real_add, ennreal.to_real_le_to_real,
            measure.coe_smul, pi.smul_apply, with_density_apply _ (hA.inter hE₁),
            show ε • ν (A ∩ E) = (ε : ℝ≥0∞) * ν (A ∩ E), by refl,
            ← set_lintegral_const, ← lintegral_add_left measurable_const] at this,
      { rw [ne.def, ennreal.add_eq_top, not_or_distrib],
        exact ⟨ne_of_lt (measure_lt_top _ _), ne_of_lt (measure_lt_top _ _)⟩ },
      { exact ne_of_lt (measure_lt_top _ _) },
      { exact ne_of_lt (measure_lt_top _ _) },
      { exact ne_of_lt (measure_lt_top _ _) },
      { rw with_density_apply _ (hA.inter hE₁),
        exact hξle (A ∩ E) (hA.inter hE₁) },
      { apply_instance } },
  -- from this, we can show `ξ + ε * E.indicator` is a function in `measurable_le` with
  -- integral greater than `ξ`
    have hξε : ξ + E.indicator (λ _, ε) ∈ measurable_le ν μ,
    { refine ⟨measurable.add hξm (measurable.indicator measurable_const hE₁), λ A hA, _⟩,
      have : ∫⁻ a in A, (ξ + E.indicator (λ _, ε)) a ∂ν =
            ∫⁻ a in A ∩ E, ε + ξ a ∂ν + ∫⁻ a in A \ E, ξ a ∂ν,
      { simp only [lintegral_add_left measurable_const, lintegral_add_left hξm,
          set_lintegral_const, add_assoc, lintegral_inter_add_diff _ _ hE₁, pi.add_apply,
          lintegral_indicator _ hE₁, restrict_apply hE₁],
        rw [inter_comm, add_comm] },
      rw [this, ← measure_inter_add_diff A hE₁],
      exact add_le_add (hε₂ A hA) (hξle (A \ E) (hA.diff hE₁)) },
      have : ∫⁻ a, ξ a + E.indicator (λ _, ε) a ∂ν ≤ Sup (measurable_le_eval ν μ) :=
        le_Sup ⟨ξ + E.indicator (λ _, ε), hξε, rfl⟩,
  -- but this contradicts the maximality of `∫⁻ x, ξ x ∂ν`
      refine not_lt.2 this _,
      rw [hξ₁, lintegral_add_left hξm, lintegral_indicator _ hE₁, set_lintegral_const],
      refine ennreal.lt_add_right _ (ennreal.mul_pos_iff.2 ⟨ennreal.coe_pos.2 hε₁, hE₂⟩).ne',
      have := measure_ne_top (ν.with_density ξ) univ,
      rwa [with_density_apply _ measurable_set.univ, measure.restrict_univ] at this },
  -- since `ν.with_density ξ ≤ μ`, it is clear that `μ = μ₁ + ν.with_density ξ`
  { rw hμ₁, ext1 A hA,
    rw [measure.coe_add, pi.add_apply, measure.sub_apply hA hle,
        add_comm, add_tsub_cancel_of_le (hle A hA)] },
end⟩

local attribute [instance] have_lebesgue_decomposition_of_finite_measure

instance {S : μ.finite_spanning_sets_in {s : set α | measurable_set s}} (n : ℕ) :
  is_finite_measure (μ.restrict $ S.set n) :=
⟨by { rw [restrict_apply measurable_set.univ, univ_inter], exact S.finite _ }⟩

/-- **The Lebesgue decomposition theorem**: Any pair of σ-finite measures `μ` and `ν`
`have_lebesgue_decomposition`. That is to say, there exist a measure `ξ` and a measurable function
`f`, such that `ξ` is mutually singular with respect to `ν` and `μ = ξ + ν.with_density f` -/
@[priority 100] -- see Note [lower instance priority]
instance have_lebesgue_decomposition_of_sigma_finite
  (μ ν : measure α) [sigma_finite μ] [sigma_finite ν] :
  have_lebesgue_decomposition μ ν :=
⟨begin
  -- Since `μ` and `ν` are both σ-finite, there exists a sequence of pairwise disjoint spanning
  -- sets which are finite with respect to both `μ` and `ν`
  obtain ⟨S, T, h₁, h₂⟩ := exists_eq_disjoint_finite_spanning_sets_in μ ν,
  have h₃ : pairwise (disjoint on T.set) := h₁ ▸ h₂,
  -- We define `μn` and `νn` as sequences of measures such that `μn n = μ ∩ S n` and
  -- `νn n = ν ∩ S n` where `S` is the aforementioned finite spanning set sequence.
  -- Since `S` is spanning, it is clear that `sum μn = μ` and `sum νn = ν`
  set μn : ℕ → measure α := λ n, μ.restrict (S.set n) with hμn,
  have hμ : μ = sum μn,
    { rw [hμn, ← restrict_Union h₂ S.set_mem, S.spanning, restrict_univ] },
  set νn : ℕ → measure α := λ n, ν.restrict (T.set n) with hνn,
  have hν : ν = sum νn,
    { rw [hνn, ← restrict_Union h₃ T.set_mem, T.spanning, restrict_univ] },
  -- As `S` is finite with respect to both `μ` and `ν`, it is clear that `μn n` and `νn n` are
  -- finite measures for all `n : ℕ`. Thus, we may apply the finite Lebesgue decomposition theorem
  -- to `μn n` and `νn n`. We define `ξ` as the sum of the singular part of the Lebesgue
  -- decompositions of `μn n` and `νn n`, and `f` as the sum of the Radon-Nikodym derviatives of
  -- `μn n` and `νn n` restricted on `S n`
  set ξ := sum (λ n, singular_part (μn n) (νn n)) with hξ,
  set f := ∑' n, (S.set n).indicator (rn_deriv (μn n) (νn n)) with hf,
  -- I claim `ξ` and `f` form a Lebesgue decomposition of `μ` and `ν`
  refine ⟨⟨ξ, f⟩, _, _, _⟩,
  { exact measurable.ennreal_tsum' (λ n, measurable.indicator
      (measurable_rn_deriv (μn n) (νn n)) (S.set_mem n)) },
  -- We show that `ξ` is mutually singular with respect to `ν`
  { choose A hA₁ hA₂ hA₃ using λ n, mutually_singular_singular_part (μn n) (νn n),
    simp only [hξ],
  -- We use the set `B := ⋃ j, (S.set j) ∩ A j` where `A n` is the set provided as
  -- `singular_part (μn n) (νn n) ⟂ₘ νn n`
    refine ⟨⋃ j, (S.set j) ∩ A j,
      measurable_set.Union (λ n, (S.set_mem n).inter (hA₁ n)), _, _⟩,
  -- `ξ B = 0` since `ξ B = ∑ i j, singular_part (μn j) (νn j) (S.set i ∩ A i)`
  --                     `= ∑ i, singular_part (μn i) (νn i) (S.set i ∩ A i)`
  --                     `≤ ∑ i, singular_part (μn i) (νn i) (A i) = 0`
  -- where the second equality follows as `singular_part (μn j) (νn j) (S.set i ∩ A i)` vanishes
  -- for all `i ≠ j`
    { rw [measure_Union],
      { have : ∀ i, (sum (λ n, (μn n).singular_part (νn n))) (S.set i ∩ A i) =
          (μn i).singular_part (νn i) (S.set i ∩ A i),
        { intro i, rw [sum_apply _ ((S.set_mem i).inter (hA₁ i)), tsum_eq_single i],
          { intros j hij,
            rw [hμn, ← nonpos_iff_eq_zero],
            refine le_trans ((singular_part_le _ _) _ ((S.set_mem i).inter (hA₁ i))) (le_of_eq _),
            rw [restrict_apply ((S.set_mem i).inter (hA₁ i)), inter_comm, ← inter_assoc],
            have : disjoint (S.set j) (S.set i) := h₂ hij,
            rw disjoint_iff_inter_eq_empty at this,
            rw [this, empty_inter, measure_empty] },
          { apply_instance } },
        simp_rw [this, tsum_eq_zero_iff ennreal.summable],
        intro n, exact measure_mono_null (inter_subset_right _ _) (hA₂ n) },
      { exact h₂.mono (λ i j, disjoint.mono inf_le_left inf_le_left) },
      { exact λ n, (S.set_mem n).inter (hA₁ n) } },
  -- We will now show `ν Bᶜ = 0`. This follows since `Bᶜ = ⋃ n, S.set n ∩ (A n)ᶜ` and thus,
  -- `ν Bᶜ = ∑ i, ν (S.set i ∩ (A i)ᶜ) = ∑ i, (νn i) (A i)ᶜ = 0`
    { have hcompl : is_compl (⋃ n, (S.set n ∩ A n)) (⋃ n, S.set n ∩ (A n)ᶜ),
      { split,
        { rw disjoint_iff_inf_le,
          rintro x ⟨hx₁, hx₂⟩, rw mem_Union at hx₁ hx₂,
          obtain ⟨⟨i, hi₁, hi₂⟩, ⟨j, hj₁, hj₂⟩⟩ := ⟨hx₁, hx₂⟩,
          have : i = j,
          { by_contra hij, exact (h₂ hij).le_bot ⟨hi₁, hj₁⟩ },
          exact hj₂ (this ▸ hi₂) },
        { rw codisjoint_iff_le_sup,
          intros x hx,
          simp only [mem_Union, sup_eq_union, mem_inter_iff,
                    mem_union, mem_compl_iff, or_iff_not_imp_left],
          intro h, push_neg at h,
          rw [top_eq_univ, ← S.spanning, mem_Union] at hx,
          obtain ⟨i, hi⟩ := hx,
          exact ⟨i, hi, h i hi⟩ } },
      rw [hcompl.compl_eq, measure_Union, tsum_eq_zero_iff ennreal.summable],
      { intro n, rw [inter_comm, ← restrict_apply (hA₁ n).compl, ← hA₃ n, hνn, h₁] },
      { exact h₂.mono (λ i j, disjoint.mono inf_le_left inf_le_left) },
      { exact λ n, (S.set_mem n).inter (hA₁ n).compl } } },
  -- Finally, it remains to show `μ = ξ + ν.with_density f`. Since `μ = sum μn`, and
  -- `ξ + ν.with_density f = ∑ n, singular_part (μn n) (νn n)`
  --                        `+ ν.with_density (rn_deriv (μn n) (νn n)) ∩ (S.set n)`,
  -- it suffices to show that the individual summands are equal. This follows by the
  -- Lebesgue decomposition properties on the individual `μn n` and `νn n`
  { simp only [hξ, hf, hμ],
    rw [with_density_tsum _, sum_add_sum],
    { refine sum_congr (λ n, _),
      conv_lhs { rw have_lebesgue_decomposition_add (μn n) (νn n) },
      suffices heq : (νn n).with_density ((μn n).rn_deriv (νn n)) =
        ν.with_density ((S.set n).indicator ((μn n).rn_deriv (νn n))),
      { rw heq },
      rw [hν, with_density_indicator (S.set_mem n), restrict_sum _ (S.set_mem n)],
      suffices hsumeq : sum (λ (i : ℕ), (νn i).restrict (S.set n)) = νn n,
      { rw hsumeq },
      ext1 s hs,
      rw [sum_apply _ hs, tsum_eq_single n, hνn, h₁,
          restrict_restrict (T.set_mem n), inter_self],
      { intros m hm,
        rw [hνn, h₁, restrict_restrict (T.set_mem n), (h₃ hm.symm).inter_eq, restrict_empty,
            coe_zero, pi.zero_apply] },
      { apply_instance } },
    { exact λ n, measurable.indicator (measurable_rn_deriv _ _) (S.set_mem n) } },
end⟩

end measure

namespace signed_measure

open measure

/-- A signed measure `s` is said to `have_lebesgue_decomposition` with respect to a measure `μ`
if the positive part and the negative part of `s` both `have_lebesgue_decomposition` with
respect to `μ`. -/
class have_lebesgue_decomposition (s : signed_measure α) (μ : measure α) : Prop :=
(pos_part : s.to_jordan_decomposition.pos_part.have_lebesgue_decomposition μ)
(neg_part : s.to_jordan_decomposition.neg_part.have_lebesgue_decomposition μ)

attribute [instance] have_lebesgue_decomposition.pos_part
attribute [instance] have_lebesgue_decomposition.neg_part

lemma not_have_lebesgue_decomposition_iff (s : signed_measure α)
  (μ : measure α) :
  ¬ s.have_lebesgue_decomposition μ ↔
  ¬ s.to_jordan_decomposition.pos_part.have_lebesgue_decomposition μ ∨
  ¬ s.to_jordan_decomposition.neg_part.have_lebesgue_decomposition μ :=
⟨λ h, not_or_of_imp (λ hp hn, h ⟨hp, hn⟩), λ h hl, (not_and_distrib.2 h) ⟨hl.1, hl.2⟩⟩

-- `infer_instance` directly does not work
@[priority 100] -- see Note [lower instance priority]
instance have_lebesgue_decomposition_of_sigma_finite
  (s : signed_measure α) (μ : measure α) [sigma_finite μ] :
  s.have_lebesgue_decomposition μ :=
{ pos_part := infer_instance,
  neg_part := infer_instance }

instance have_lebesgue_decomposition_neg
  (s : signed_measure α) (μ : measure α) [s.have_lebesgue_decomposition μ] :
  (-s).have_lebesgue_decomposition μ :=
{ pos_part :=
    by { rw [to_jordan_decomposition_neg, jordan_decomposition.neg_pos_part],
         apply_instance },
  neg_part :=
    by { rw [to_jordan_decomposition_neg, jordan_decomposition.neg_neg_part],
         apply_instance } }

instance have_lebesgue_decomposition_smul
  (s : signed_measure α) (μ : measure α) [s.have_lebesgue_decomposition μ] (r : ℝ≥0) :
  (r • s).have_lebesgue_decomposition μ :=
{ pos_part :=
    by { rw [to_jordan_decomposition_smul, jordan_decomposition.smul_pos_part],
         apply_instance },
  neg_part :=
    by { rw [to_jordan_decomposition_smul, jordan_decomposition.smul_neg_part],
         apply_instance } }

instance have_lebesgue_decomposition_smul_real
  (s : signed_measure α) (μ : measure α) [s.have_lebesgue_decomposition μ] (r : ℝ) :
  (r • s).have_lebesgue_decomposition μ :=
begin
  by_cases hr : 0 ≤ r,
  { lift r to ℝ≥0 using hr,
    exact s.have_lebesgue_decomposition_smul μ _ },
  { rw not_le at hr,
    refine
    { pos_part :=
      by { rw [to_jordan_decomposition_smul_real,
               jordan_decomposition.real_smul_pos_part_neg _ _ hr],
           apply_instance },
      neg_part :=
      by { rw [to_jordan_decomposition_smul_real,
               jordan_decomposition.real_smul_neg_part_neg _ _ hr],
           apply_instance } } }
end

/-- Given a signed measure `s` and a measure `μ`, `s.singular_part μ` is the signed measure
such that `s.singular_part μ + μ.with_densityᵥ (s.rn_deriv μ) = s` and
`s.singular_part μ` is mutually singular with respect to `μ`. -/
def singular_part (s : signed_measure α) (μ : measure α) : signed_measure α :=
(s.to_jordan_decomposition.pos_part.singular_part μ).to_signed_measure -
(s.to_jordan_decomposition.neg_part.singular_part μ).to_signed_measure

section

lemma singular_part_mutually_singular (s : signed_measure α) (μ : measure α) :
  s.to_jordan_decomposition.pos_part.singular_part μ ⟂ₘ
  s.to_jordan_decomposition.neg_part.singular_part μ :=
begin
  by_cases hl : s.have_lebesgue_decomposition μ,
  { haveI := hl,
    obtain ⟨i, hi, hpos, hneg⟩ := s.to_jordan_decomposition.mutually_singular,
    rw s.to_jordan_decomposition.pos_part.have_lebesgue_decomposition_add μ at hpos,
    rw s.to_jordan_decomposition.neg_part.have_lebesgue_decomposition_add μ at hneg,
    rw [add_apply, add_eq_zero_iff] at hpos hneg,
    exact ⟨i, hi, hpos.1, hneg.1⟩ },
  { rw not_have_lebesgue_decomposition_iff at hl,
    cases hl with hp hn,
    { rw [measure.singular_part, dif_neg hp],
      exact mutually_singular.zero_left },
    { rw [measure.singular_part, measure.singular_part, dif_neg hn],
      exact mutually_singular.zero_right } }
end

lemma singular_part_total_variation (s : signed_measure α) (μ : measure α) :
  (s.singular_part μ).total_variation =
  s.to_jordan_decomposition.pos_part.singular_part μ +
  s.to_jordan_decomposition.neg_part.singular_part μ :=
begin
  have : (s.singular_part μ).to_jordan_decomposition =
    ⟨s.to_jordan_decomposition.pos_part.singular_part μ,
     s.to_jordan_decomposition.neg_part.singular_part μ, singular_part_mutually_singular s μ⟩,
  { refine jordan_decomposition.to_signed_measure_injective _,
    rw to_signed_measure_to_jordan_decomposition,
    refl },
  { rw [total_variation, this] },
end

lemma mutually_singular_singular_part (s : signed_measure α) (μ : measure α) :
  singular_part s μ ⟂ᵥ μ.to_ennreal_vector_measure :=
begin
  rw [mutually_singular_ennreal_iff, singular_part_total_variation],
  change _ ⟂ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ),
  rw vector_measure.equiv_measure.right_inv μ,
  exact (mutually_singular_singular_part _ _).add_left (mutually_singular_singular_part _ _)
end

end

/-- The Radon-Nikodym derivative between a signed measure and a positive measure.

`rn_deriv s μ` satisfies `μ.with_densityᵥ (s.rn_deriv μ) = s`
if and only if `s` is absolutely continuous with respect to `μ` and this fact is known as
`measure_theory.signed_measure.absolutely_continuous_iff_with_density_rn_deriv_eq`
and can be found in `measure_theory.decomposition.radon_nikodym`. -/
def rn_deriv (s : signed_measure α) (μ : measure α) : α → ℝ := λ x,
(s.to_jordan_decomposition.pos_part.rn_deriv μ x).to_real -
(s.to_jordan_decomposition.neg_part.rn_deriv μ x).to_real

variables {s t : signed_measure α}

@[measurability]
lemma measurable_rn_deriv (s : signed_measure α) (μ : measure α) :
  measurable (rn_deriv s μ) :=
begin
  rw [rn_deriv],
  measurability,
end

lemma integrable_rn_deriv (s : signed_measure α) (μ : measure α) :
  integrable (rn_deriv s μ) μ :=
begin
  refine integrable.sub _ _;
  { split,
    { apply measurable.ae_strongly_measurable, measurability },
    exact has_finite_integral_to_real_of_lintegral_ne_top
      (lintegral_rn_deriv_lt_top _ μ).ne }
end

variables (s μ)

/-- **The Lebesgue Decomposition theorem between a signed measure and a measure**:
Given a signed measure `s` and a σ-finite measure `μ`, there exist a signed measure `t` and a
measurable and integrable function `f`, such that `t` is mutually singular with respect to `μ`
and `s = t + μ.with_densityᵥ f`. In this case `t = s.singular_part μ` and
`f = s.rn_deriv μ`. -/
theorem singular_part_add_with_density_rn_deriv_eq
  [s.have_lebesgue_decomposition μ] :
  s.singular_part μ + μ.with_densityᵥ (s.rn_deriv μ) = s :=
begin
  conv_rhs { rw [← to_signed_measure_to_jordan_decomposition s,
                 jordan_decomposition.to_signed_measure] },
  rw [singular_part, rn_deriv, with_densityᵥ_sub'
        (integrable_to_real_of_lintegral_ne_top _ _) (integrable_to_real_of_lintegral_ne_top _ _),
      with_densityᵥ_to_real, with_densityᵥ_to_real, sub_eq_add_neg, sub_eq_add_neg,
      add_comm (s.to_jordan_decomposition.pos_part.singular_part μ).to_signed_measure, ← add_assoc,
      add_assoc (-(s.to_jordan_decomposition.neg_part.singular_part μ).to_signed_measure),
      ← to_signed_measure_add, add_comm, ← add_assoc, ← neg_add, ← to_signed_measure_add,
      add_comm, ← sub_eq_add_neg],
  convert rfl, -- `convert rfl` much faster than `congr`
  { exact (s.to_jordan_decomposition.pos_part.have_lebesgue_decomposition_add μ) },
  { rw add_comm,
    exact (s.to_jordan_decomposition.neg_part.have_lebesgue_decomposition_add μ) },
  all_goals { exact (lintegral_rn_deriv_lt_top _ _).ne <|> measurability }
end

variables {s μ}

lemma jordan_decomposition_add_with_density_mutually_singular
  {f : α → ℝ} (hf : measurable f) (htμ : t ⟂ᵥ μ.to_ennreal_vector_measure) :
  t.to_jordan_decomposition.pos_part + μ.with_density (λ (x : α), ennreal.of_real (f x)) ⟂ₘ
  t.to_jordan_decomposition.neg_part + μ.with_density (λ (x : α), ennreal.of_real (-f x)) :=
begin
  rw [mutually_singular_ennreal_iff, total_variation_mutually_singular_iff] at htμ,
  change _ ⟂ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ) ∧
         _ ⟂ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ) at htμ,
  rw [vector_measure.equiv_measure.right_inv] at htμ,
  exact ((jordan_decomposition.mutually_singular _).add_right
    (htμ.1.mono_ac (refl _) (with_density_absolutely_continuous _ _))).add_left
    ((htμ.2.symm.mono_ac (with_density_absolutely_continuous _ _) (refl _)).add_right
    (with_density_of_real_mutually_singular hf))
end

lemma to_jordan_decomposition_eq_of_eq_add_with_density
  {f : α → ℝ} (hf : measurable f) (hfi : integrable f μ)
  (htμ : t ⟂ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
  s.to_jordan_decomposition = @jordan_decomposition.mk α _
    (t.to_jordan_decomposition.pos_part + μ.with_density (λ x, ennreal.of_real (f x)))
    (t.to_jordan_decomposition.neg_part + μ.with_density (λ x, ennreal.of_real (- f x)))
    (by { haveI := is_finite_measure_with_density_of_real hfi.2, apply_instance })
    (by { haveI := is_finite_measure_with_density_of_real hfi.neg.2, apply_instance })
    (jordan_decomposition_add_with_density_mutually_singular hf htμ) :=
begin
  haveI := is_finite_measure_with_density_of_real hfi.2,
  haveI := is_finite_measure_with_density_of_real hfi.neg.2,
  refine to_jordan_decomposition_eq _,
  simp_rw [jordan_decomposition.to_signed_measure, hadd],
  ext i hi,
  rw [vector_measure.sub_apply, to_signed_measure_apply_measurable hi,
      to_signed_measure_apply_measurable hi, add_apply, add_apply,
      ennreal.to_real_add, ennreal.to_real_add, add_sub_add_comm,
      ← to_signed_measure_apply_measurable hi, ← to_signed_measure_apply_measurable hi,
      ← vector_measure.sub_apply, ← jordan_decomposition.to_signed_measure,
      to_signed_measure_to_jordan_decomposition, vector_measure.add_apply,
      ← to_signed_measure_apply_measurable hi, ← to_signed_measure_apply_measurable hi,
      with_densityᵥ_eq_with_density_pos_part_sub_with_density_neg_part hfi,
      vector_measure.sub_apply];
  exact (measure_lt_top _ _).ne
end

private lemma have_lebesgue_decomposition_mk' (μ : measure α)
  {f : α → ℝ} (hf : measurable f) (hfi : integrable f μ)
  (htμ : t ⟂ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
  s.have_lebesgue_decomposition μ :=
begin
  have htμ' := htμ,
  rw mutually_singular_ennreal_iff at htμ,
  change _ ⟂ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ) at htμ,
  rw [vector_measure.equiv_measure.right_inv, total_variation_mutually_singular_iff] at htμ,
  refine
    { pos_part :=
      by { use ⟨t.to_jordan_decomposition.pos_part, λ x, ennreal.of_real (f x)⟩,
          refine ⟨hf.ennreal_of_real, htμ.1, _⟩,
          rw to_jordan_decomposition_eq_of_eq_add_with_density hf hfi htμ' hadd },
      neg_part :=
      by { use ⟨t.to_jordan_decomposition.neg_part, λ x, ennreal.of_real (-f x)⟩,
           refine ⟨hf.neg.ennreal_of_real, htμ.2, _⟩,
           rw to_jordan_decomposition_eq_of_eq_add_with_density hf hfi htμ' hadd } }
end

lemma have_lebesgue_decomposition_mk (μ : measure α) {f : α → ℝ} (hf : measurable f)
  (htμ : t ⟂ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
  s.have_lebesgue_decomposition μ :=
begin
  by_cases hfi : integrable f μ,
  { exact have_lebesgue_decomposition_mk' μ hf hfi htμ hadd },
  { rw [with_densityᵥ, dif_neg hfi, add_zero] at hadd,
    refine have_lebesgue_decomposition_mk' μ measurable_zero (integrable_zero _ _ μ) htμ _,
    rwa [with_densityᵥ_zero, add_zero] }
end

private theorem eq_singular_part'
  (t : signed_measure α) {f : α → ℝ} (hf : measurable f) (hfi : integrable f μ)
  (htμ : t ⟂ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
  t = s.singular_part μ :=
begin
  have htμ' := htμ,
  rw [mutually_singular_ennreal_iff, total_variation_mutually_singular_iff] at htμ,
  change _ ⟂ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ) ∧
         _ ⟂ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ) at htμ,
  rw [vector_measure.equiv_measure.right_inv] at htμ,
  { rw [singular_part, ← t.to_signed_measure_to_jordan_decomposition,
        jordan_decomposition.to_signed_measure],
    congr,
    { have hfpos : measurable (λ x, ennreal.of_real (f x)), { measurability },
      refine eq_singular_part hfpos htμ.1 _,
      rw to_jordan_decomposition_eq_of_eq_add_with_density hf hfi htμ' hadd },
    { have hfneg : measurable (λ x, ennreal.of_real (-f x)), { measurability },
      refine eq_singular_part hfneg htμ.2 _,
      rw to_jordan_decomposition_eq_of_eq_add_with_density hf hfi htμ' hadd } },
end

/-- Given a measure `μ`, signed measures `s` and `t`, and a function `f` such that `t` is
mutually singular with respect to `μ` and `s = t + μ.with_densityᵥ f`, we have
`t = singular_part s μ`, i.e. `t` is the singular part of the Lebesgue decomposition between
`s` and `μ`. -/
theorem eq_singular_part (t : signed_measure α) (f : α → ℝ)
  (htμ : t ⟂ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
  t = s.singular_part μ :=
begin
  by_cases hfi : integrable f μ,
  { refine eq_singular_part' t hfi.1.measurable_mk (hfi.congr hfi.1.ae_eq_mk) htμ _,
    convert hadd using 2,
    exact with_densityᵥ_eq.congr_ae hfi.1.ae_eq_mk.symm },
  { rw [with_densityᵥ, dif_neg hfi, add_zero] at hadd,
    refine eq_singular_part' t measurable_zero (integrable_zero _ _ μ) htμ _,
    rwa [with_densityᵥ_zero, add_zero] }
end

lemma singular_part_zero (μ : measure α) : (0 : signed_measure α).singular_part μ = 0 :=
begin
  refine (eq_singular_part 0 0
    vector_measure.mutually_singular.zero_left _).symm,
  rw [zero_add, with_densityᵥ_zero],
end

lemma singular_part_neg (s : signed_measure α) (μ : measure α) :
  (-s).singular_part μ = - s.singular_part μ :=
begin
  have h₁ : ((-s).to_jordan_decomposition.pos_part.singular_part μ).to_signed_measure =
    (s.to_jordan_decomposition.neg_part.singular_part μ).to_signed_measure,
  { refine to_signed_measure_congr _,
    rw [to_jordan_decomposition_neg, jordan_decomposition.neg_pos_part] },
  have h₂ : ((-s).to_jordan_decomposition.neg_part.singular_part μ).to_signed_measure =
    (s.to_jordan_decomposition.pos_part.singular_part μ).to_signed_measure,
  { refine to_signed_measure_congr _,
    rw [to_jordan_decomposition_neg, jordan_decomposition.neg_neg_part] },
  rw [singular_part, singular_part, neg_sub, h₁, h₂],
end

lemma singular_part_smul_nnreal (s : signed_measure α) (μ : measure α) (r : ℝ≥0) :
  (r • s).singular_part μ = r • s.singular_part μ :=
begin
  rw [singular_part, singular_part, smul_sub, ← to_signed_measure_smul, ← to_signed_measure_smul],
  conv_lhs { congr, congr,
             rw [to_jordan_decomposition_smul, jordan_decomposition.smul_pos_part,
                 singular_part_smul], skip, congr,
             rw [to_jordan_decomposition_smul, jordan_decomposition.smul_neg_part,
                 singular_part_smul] }
end

lemma singular_part_smul (s : signed_measure α) (μ : measure α) (r : ℝ) :
  (r • s).singular_part μ = r • s.singular_part μ :=
begin
  by_cases hr : 0 ≤ r,
  { lift r to ℝ≥0 using hr,
    exact singular_part_smul_nnreal s μ r },
  { rw [singular_part, singular_part],
    conv_lhs { congr, congr,
      rw [to_jordan_decomposition_smul_real,
          jordan_decomposition.real_smul_pos_part_neg _ _ (not_le.1 hr), singular_part_smul],
              skip, congr,
      rw [to_jordan_decomposition_smul_real,
          jordan_decomposition.real_smul_neg_part_neg _ _ (not_le.1 hr), singular_part_smul] },
    rw [to_signed_measure_smul, to_signed_measure_smul, ← neg_sub, ← smul_sub],
    change -(((-r).to_nnreal : ℝ) • _) = _,
    rw [← neg_smul, real.coe_to_nnreal _ (le_of_lt (neg_pos.mpr (not_le.1 hr))), neg_neg] }
end

lemma singular_part_add (s t : signed_measure α) (μ : measure α)
  [s.have_lebesgue_decomposition μ] [t.have_lebesgue_decomposition μ] :
  (s + t).singular_part μ = s.singular_part μ + t.singular_part μ :=
begin
  refine (eq_singular_part _ (s.rn_deriv μ + t.rn_deriv μ)
    ((mutually_singular_singular_part s μ).add_left (mutually_singular_singular_part t μ)) _).symm,
  erw [with_densityᵥ_add (integrable_rn_deriv s μ) (integrable_rn_deriv t μ)],
  rw [add_assoc, add_comm (t.singular_part μ), add_assoc, add_comm _ (t.singular_part μ),
      singular_part_add_with_density_rn_deriv_eq, ← add_assoc,
      singular_part_add_with_density_rn_deriv_eq],
end

lemma singular_part_sub (s t : signed_measure α) (μ : measure α)
  [s.have_lebesgue_decomposition μ] [t.have_lebesgue_decomposition μ] :
  (s - t).singular_part μ = s.singular_part μ - t.singular_part μ :=
by { rw [sub_eq_add_neg, sub_eq_add_neg, singular_part_add, singular_part_neg] }

/-- Given a measure `μ`, signed measures `s` and `t`, and a function `f` such that `t` is
mutually singular with respect to `μ` and `s = t + μ.with_densityᵥ f`, we have
`f = rn_deriv s μ`, i.e. `f` is the Radon-Nikodym derivative of `s` and `μ`. -/
theorem eq_rn_deriv (t : signed_measure α) (f : α → ℝ) (hfi : integrable f μ)
  (htμ : t ⟂ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
  f =ᵐ[μ] s.rn_deriv μ :=
begin
  set f' := hfi.1.mk f,
  have hadd' : s = t + μ.with_densityᵥ f',
  { convert hadd using 2,
    exact with_densityᵥ_eq.congr_ae hfi.1.ae_eq_mk.symm },
  haveI := have_lebesgue_decomposition_mk μ hfi.1.measurable_mk htμ hadd',
  refine (integrable.ae_eq_of_with_densityᵥ_eq (integrable_rn_deriv _ _) hfi _).symm,
  rw [← add_right_inj t, ← hadd, eq_singular_part _ f htμ hadd,
      singular_part_add_with_density_rn_deriv_eq],
end

lemma rn_deriv_neg (s : signed_measure α) (μ : measure α) [s.have_lebesgue_decomposition μ] :
  (-s).rn_deriv μ =ᵐ[μ] - s.rn_deriv μ :=
begin
  refine integrable.ae_eq_of_with_densityᵥ_eq
    (integrable_rn_deriv _ _) (integrable_rn_deriv _ _).neg _,
  rw [with_densityᵥ_neg, ← add_right_inj ((-s).singular_part μ),
      singular_part_add_with_density_rn_deriv_eq, singular_part_neg, ← neg_add,
      singular_part_add_with_density_rn_deriv_eq]
end

lemma rn_deriv_smul (s : signed_measure α) (μ : measure α) [s.have_lebesgue_decomposition μ]
  (r : ℝ) :
  (r • s).rn_deriv μ =ᵐ[μ] r • s.rn_deriv μ :=
begin
  refine integrable.ae_eq_of_with_densityᵥ_eq
    (integrable_rn_deriv _ _) ((integrable_rn_deriv _ _).smul r) _,
  change _ = μ.with_densityᵥ ((r : ℝ) • s.rn_deriv μ),
  rw [with_densityᵥ_smul (rn_deriv s μ) (r : ℝ),
      ← add_right_inj ((r • s).singular_part μ),
      singular_part_add_with_density_rn_deriv_eq, singular_part_smul],
  change _ = _ + r • _,
  rw [← smul_add, singular_part_add_with_density_rn_deriv_eq],
end

lemma rn_deriv_add (s t : signed_measure α) (μ : measure α)
  [s.have_lebesgue_decomposition μ] [t.have_lebesgue_decomposition μ]
  [(s + t).have_lebesgue_decomposition μ] :
  (s + t).rn_deriv μ =ᵐ[μ] s.rn_deriv μ + t.rn_deriv μ :=
begin
  refine integrable.ae_eq_of_with_densityᵥ_eq
    (integrable_rn_deriv _ _)
    ((integrable_rn_deriv _ _).add (integrable_rn_deriv _ _)) _,
  rw [← add_right_inj ((s + t).singular_part μ),
      singular_part_add_with_density_rn_deriv_eq,
      with_densityᵥ_add (integrable_rn_deriv _ _) (integrable_rn_deriv _ _),
      singular_part_add, add_assoc, add_comm (t.singular_part μ), add_assoc,
      add_comm _ (t.singular_part μ), singular_part_add_with_density_rn_deriv_eq,
      ← add_assoc, singular_part_add_with_density_rn_deriv_eq],
end

lemma rn_deriv_sub (s t : signed_measure α) (μ : measure α)
  [s.have_lebesgue_decomposition μ] [t.have_lebesgue_decomposition μ]
  [hst : (s - t).have_lebesgue_decomposition μ] :
  (s - t).rn_deriv μ =ᵐ[μ] s.rn_deriv μ - t.rn_deriv μ :=
begin
  rw sub_eq_add_neg at hst,
  rw [sub_eq_add_neg, sub_eq_add_neg],
  exactI ae_eq_trans (rn_deriv_add _ _ _)
    (filter.eventually_eq.add (ae_eq_refl _) (rn_deriv_neg _ _)),
end

end signed_measure

namespace complex_measure

/-- A complex measure is said to `have_lebesgue_decomposition` with respect to a positive measure
if both its real and imaginary part `have_lebesgue_decomposition` with respect to that measure. -/
class have_lebesgue_decomposition (c : complex_measure α) (μ : measure α) : Prop :=
(re_part : c.re.have_lebesgue_decomposition μ)
(im_part : c.im.have_lebesgue_decomposition μ)

attribute [instance] have_lebesgue_decomposition.re_part
attribute [instance] have_lebesgue_decomposition.im_part

/-- The singular part between a complex measure `c` and a positive measure `μ` is the complex
measure satisfying `c.singular_part μ + μ.with_densityᵥ (c.rn_deriv μ) = c`. This property is given
by `measure_theory.complex_measure.singular_part_add_with_density_rn_deriv_eq`. -/
def singular_part (c : complex_measure α) (μ : measure α) : complex_measure α :=
(c.re.singular_part μ).to_complex_measure (c.im.singular_part μ)

/-- The Radon-Nikodym derivative between a complex measure and a positive measure. -/
def rn_deriv (c : complex_measure α) (μ : measure α) : α → ℂ :=
λ x, ⟨c.re.rn_deriv μ x, c.im.rn_deriv μ x⟩

variable {c : complex_measure α}

lemma integrable_rn_deriv (c : complex_measure α) (μ : measure α) :
  integrable (c.rn_deriv μ) μ :=
begin
  rw [← mem_ℒp_one_iff_integrable, ← mem_ℒp_re_im_iff],
  exact ⟨mem_ℒp_one_iff_integrable.2 (signed_measure.integrable_rn_deriv _ _),
         mem_ℒp_one_iff_integrable.2 (signed_measure.integrable_rn_deriv _ _)⟩
end

theorem singular_part_add_with_density_rn_deriv_eq [c.have_lebesgue_decomposition μ] :
  c.singular_part μ + μ.with_densityᵥ (c.rn_deriv μ) = c :=
begin
  conv_rhs { rw [← c.to_complex_measure_to_signed_measure] },
  ext i hi : 1,
  rw [vector_measure.add_apply, signed_measure.to_complex_measure_apply],
  ext,
  { rw [complex.add_re, with_densityᵥ_apply (c.integrable_rn_deriv μ) hi,
      ←is_R_or_C.re_eq_complex_re, ←integral_re (c.integrable_rn_deriv μ).integrable_on,
      is_R_or_C.re_eq_complex_re, ← with_densityᵥ_apply _ hi],
    { change (c.re.singular_part μ + μ.with_densityᵥ (c.re.rn_deriv μ)) i = _,
      rw c.re.singular_part_add_with_density_rn_deriv_eq μ },
    { exact (signed_measure.integrable_rn_deriv _ _) } },
  { rw [complex.add_im, with_densityᵥ_apply (c.integrable_rn_deriv μ) hi,
      ←is_R_or_C.im_eq_complex_im, ←integral_im (c.integrable_rn_deriv μ).integrable_on,
      is_R_or_C.im_eq_complex_im, ← with_densityᵥ_apply _ hi],
    { change (c.im.singular_part μ + μ.with_densityᵥ (c.im.rn_deriv μ)) i = _,
      rw c.im.singular_part_add_with_density_rn_deriv_eq μ },
    { exact (signed_measure.integrable_rn_deriv _ _) } },
end

end complex_measure

end measure_theory


import mynat.definition
import mynat.add

namespace mynat

theorem succ_ne_zero (a : mynat) : succ(a) ≠ 0 :=
begin [nat_num_game]
    symmetry,
    exact zero_ne_succ a,
end

end mynat


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem amc12a_2011_p18
  (x y : ℝ)
  (h₀ : abs (x + y) + abs (x - y) = 2) :
  x^2 - 6 * x + y^2 ≤ 9 :=
begin
  simp [abs_eq_max_neg, abs_le] at h₀,
  norm_num [max_def, le_refl] at *,
  split_ifs at *,
  all_goals { nlinarith },
end


import tactic

-- lets work in a namespace to avoid changing anything in mathlib
namespace british_natural_numbers

-- In Britain Natural numbers start with 1
inductive bnat
| one             : bnat
| succ (n : bnat) : bnat

-- defining addition on bnat
def add : bnat → bnat → bnat
| n bnat.one   := bnat.succ n              -- adding one to any number is just the successor of that number
| n (bnat.succ(d)) := bnat.succ(add n d)   -- adding n with succ(d) is defined as succ (n + d)

-- I don't want to type bnat all the time
open bnat

def two   := succ(one)
def three := succ(two)
def four  := succ(three)

lemma test : add two two = four :=
begin
  -- goal is add two two = four
  -- lets unfold two as succ one
  unfold two at *,
  -- we now have add one.succ one.succ so rw add
  rw add,
  rw add,
  -- goal is now one.succ.succ.succ = four
  -- so lets unfold definition of four
  unfold four,
  unfold three,
  unfold two,
  -- here the proof is complete, because unfold two automatically does refl
  -- if it didn't our goal would have been.
  -- one.succ.succ.succ = one.succ.succ.succ
  -- which is closed by reflexivity
end

-- What about zero ?

end british_natural_numbers


/-
Construct a natural deduction proof of ¬𝐴∨¬𝐵 from ¬(𝐴∧𝐵).
You can do it as follows:

First, prove ¬𝐵, and hence ¬𝐴∨¬𝐵, from ¬(𝐴∧𝐵) and 𝐴.

Use this to construct a proof of ¬𝐴, and hence ¬𝐴∨¬𝐵,
from ¬(𝐴∧𝐵) and ¬(¬𝐴∨¬𝐵).

Use this to construct a proof of a contradiction from
¬(𝐴∧𝐵) and ¬(¬𝐴∨¬𝐵).

Using proof by contradiction, this gives you a proof of
¬𝐴∨¬𝐵 from ¬(𝐴∧𝐵).
-/

open classical

variables (A B: Prop)

example (h: ¬ (A ∧ B)): ¬ A ∨ ¬ B :=
  -- I couldn't understand what the proof hints in the instructions meant
  -- so I just proved it using em and or.elim ¯\_(ツ)_/¯
  or.elim(em(A))(
    assume hA: A,
    have hnB: ¬ B, from by_contradiction(
      assume hnnB: ¬¬ B,
      -- this seems so stupid, there must be a better way to get ¬¬B → B
      have hB: B, from by_contradiction(assume hnB, hnnB(hnB)),
      have hAB: A ∧ B, from ⟨hA, hB⟩,
      show false, from h(hAB)
    ),
    show ¬ A ∨ ¬ B, from or.inr hnB
  ) (
    assume hnA: ¬ A,
    show ¬ A ∨ ¬ B, from or.inl hnA
  )


inductive zfc : Type
| empty  : zfc
| insert : zfc → zfc → zfc

instance : has_emptyc zfc := ⟨zfc.empty⟩
instance : has_insert zfc zfc := ⟨zfc.insert⟩

instance : has_zero zfc := ⟨{}⟩
instance : has_one zfc := ⟨{0}⟩

def succ (a : zfc) : zfc := has_insert.insert a a

def zfc_add : zfc → zfc → zfc
| m 0 := m
| m (zfc.insert n p) := succ (zfc_add m n)

instance : has_add zfc := ⟨zfc_add⟩

inductive member : zfc → zfc → Prop
| left {a b c : zfc} : member a c → member a (has_insert.insert b c)
| right {a b : zfc} : member a (has_insert.insert a b)

instance : has_mem zfc zfc := ⟨member⟩
instance : has_subset zfc := ⟨(λ a b:zfc, (∀ z:zfc, z ∈ a → z ∈ b))⟩

axiom member.ext (a b : zfc) : (∀ x, x ∈ a ↔ x ∈ b) ↔ a=b

export zfc
export member

definition A : zfc := {1,2,{1,2}}
definition B : zfc := {1,2,A}

theorem M1F_Sheet01_Q06a_is_true : (1:zfc) ∈ A :=
begin
    left, left, right
end

theorem M1F_Sheet01_Q06b_is_false: ({1}:zfc) ∉ A :=
begin
    intro h,
    cases h,
    cases a_1,
    cases a_2,
    cases a_3
end

theorem M1F_Sheet01_Q06c_is_true: ({1,2}:zfc) ∈ A :=
begin
    right
end

theorem M1F_Sheet01_Q06d_is_true: ({1,2}:zfc) ⊆ A :=
begin
    intro x,
    intro h,
    cases h,
    cases a_1,
    cases a_2,
    left, left, right,
    left, right
end

theorem M1F_Sheet01_Q06e_is_true: (1:zfc) ∈ B :=
begin
    left, left, right
end

theorem M1F_Sheet01_Q06f_is_false: ({1}:zfc) ∉ B :=
begin
    intro h,
    cases h,
    cases a_1,
    cases a_2,
    cases a_3
end

theorem M1F_Sheet01_Q06g_is_true: ({1,2}:zfc) ∈ B → (1:zfc) ∈ A :=
begin
    intro h,
    cases h,
    cases a_1,
    cases a_2,
    cases a_3
end

theorem M1F_Sheet01_Q06h_is_true: ({1,2}:zfc) ⊆ B ∨ (1:zfc) ∉ A :=
begin
    left,
    intro x,
    intro h,
    cases h,
    cases a_1,
    cases a_2,
    left, left, right,
    left, right
end


inductive TreeNode :=
 | mkLeaf (name : String) : TreeNode
 | mkNode (name : String) (children : List TreeNode) : TreeNode

def treeToList (t : TreeNode) : List String :=
 match t with
 | .mkLeaf name => [name]
 | .mkNode name children => Id.run do
   let mut r := [name]
   for h : child in children do
     -- We will not this the following `have` in the future
     have : sizeOf child < 1 + sizeOf name + sizeOf children := Nat.lt_trans (List.sizeOf_lt_of_mem h) (by simp_arith)
     r := r ++ treeToList child
   return r

@[simp] theorem treeToList_eq (name : String) (children : List TreeNode) : treeToList (.mkNode name children) =  name :: List.join (children.map treeToList) := by
  simp [treeToList, Id.run, forIn, List.forIn]
  have : ∀ acc, (Id.run do List.forIn.loop (fun a b => ForInStep.yield (b ++ treeToList a)) children acc) = acc ++ List.join (List.map treeToList children) := by
    intro acc
    induction children generalizing acc with simp [List.forIn.loop, List.map, List.join, Id.run]
    | cons c cs ih => simp [Id.run] at ih; simp [ih, List.append_assoc]
  apply this

mutual
  def numNames : TreeNode → Nat
    | .mkLeaf _  => 1
    | .mkNode _ cs => 1 + numNamesLst cs
  def numNamesLst : List TreeNode → Nat
    | [] => 0
    | a :: as => numNames a + numNamesLst as
end

theorem length_treeToList_eq_numNames (t : TreeNode) : (treeToList t).length = numNames t := by
  match t with
  | .mkLeaf .. => simp [treeToList, numNames]
  | .mkNode _ cs => simp_arith [numNames, helper cs]
where
  helper (cs : List TreeNode) : (cs.map treeToList).join.length = numNamesLst cs := by
    match cs with
    | [] => rfl
    | c::cs' => simp [List.join, List.map, numNamesLst, length_treeToList_eq_numNames c, helper cs']


/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import data.complex.is_R_or_C
import analysis.normed_space.operator_norm
import analysis.normed_space.pointwise

/-!
# Normed spaces over R or C

This file is about results on normed spaces over the fields `ℝ` and `ℂ`.

## Main definitions

None.

## Main theorems

* `continuous_linear_map.op_norm_bound_of_ball_bound`: A bound on the norms of values of a linear
  map in a ball yields a bound on the operator norm.

## Notes

This file exists mainly to avoid importing `is_R_or_C` in the main normed space theory files.
-/

open metric

@[simp, is_R_or_C_simps] lemma is_R_or_C.norm_coe_norm {𝕜 : Type*} [is_R_or_C 𝕜]
  {E : Type*} [normed_group E] {z : E} : ∥(∥z∥ : 𝕜)∥ = ∥z∥ :=
by { unfold_coes, simp only [norm_algebra_map_eq, ring_hom.to_fun_eq_coe, norm_norm], }

variables {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E]

/-- Lemma to normalize a vector in a normed space `E` over either `ℂ` or `ℝ` to unit length. -/
@[simp] lemma norm_smul_inv_norm {x : E} (hx : x ≠ 0) : ∥(∥x∥⁻¹ : 𝕜) • x∥ = 1 :=
begin
  have : ∥x∥ ≠ 0 := by simp [hx],
  field_simp [norm_smul]
end

/-- Lemma to normalize a vector in a normed space `E` over either `ℂ` or `ℝ` to length `r`. -/
lemma norm_smul_inv_norm' {r : ℝ} (r_nonneg : 0 ≤ r) {x : E} (hx : x ≠ 0) :
  ∥(r * ∥x∥⁻¹ : 𝕜) • x∥ = r :=
begin
  have : ∥x∥ ≠ 0 := by simp [hx],
  field_simp [norm_smul, is_R_or_C.norm_eq_abs, r_nonneg] with is_R_or_C_simps
end

lemma linear_map.bound_of_sphere_bound
  {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →ₗ[𝕜] 𝕜) (h : ∀ z ∈ sphere (0 : E) r, ∥f z∥ ≤ c) (z : E) :
  ∥f z∥ ≤ c / r * ∥z∥ :=
begin
  by_cases z_zero : z = 0,
  { rw z_zero, simp only [linear_map.map_zero, norm_zero, mul_zero], },
  set z₁ := (r * ∥z∥⁻¹ : 𝕜) • z with hz₁,
  have norm_f_z₁ : ∥f z₁∥ ≤ c,
  { apply h,
    rw mem_sphere_zero_iff_norm,
    exact norm_smul_inv_norm' r_pos.le z_zero },
  have r_ne_zero : (r : 𝕜) ≠ 0 := (algebra_map ℝ 𝕜).map_ne_zero.mpr r_pos.ne.symm,
  have eq : f z = ∥z∥ / r * (f z₁),
  { rw [hz₁, linear_map.map_smul, smul_eq_mul],
    rw [← mul_assoc, ← mul_assoc, div_mul_cancel _ r_ne_zero, mul_inv_cancel, one_mul],
    simp only [z_zero, is_R_or_C.of_real_eq_zero, norm_eq_zero, ne.def, not_false_iff], },
  rw [eq, normed_field.norm_mul, normed_field.norm_div, is_R_or_C.norm_coe_norm,
      is_R_or_C.norm_of_nonneg r_pos.le, div_mul_eq_mul_div, div_mul_eq_mul_div, mul_comm],
  apply div_le_div _ _ r_pos rfl.ge,
  { exact mul_nonneg ((norm_nonneg _).trans norm_f_z₁) (norm_nonneg z), },
  apply mul_le_mul norm_f_z₁ rfl.le (norm_nonneg z) ((norm_nonneg _).trans norm_f_z₁),
end

/--
`linear_map.bound_of_ball_bound` is a version of this over arbitrary nondiscrete normed fields.
It produces a less precise bound so we keep both versions. -/
lemma linear_map.bound_of_ball_bound' {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →ₗ[𝕜] 𝕜)
  (h : ∀ z ∈ closed_ball (0 : E) r, ∥f z∥ ≤ c) (z : E) :
  ∥f z∥ ≤ c / r * ∥z∥ :=
f.bound_of_sphere_bound r_pos c (λ z hz, h z hz.le) z

lemma continuous_linear_map.op_norm_bound_of_ball_bound
  {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →L[𝕜] 𝕜) (h : ∀ z ∈ closed_ball (0 : E) r, ∥f z∥ ≤ c) :
  ∥f∥ ≤ c / r :=
begin
  apply continuous_linear_map.op_norm_le_bound,
  { apply div_nonneg _ r_pos.le,
    exact (norm_nonneg _).trans
          (h 0 (by simp only [norm_zero, mem_closed_ball, dist_zero_left, r_pos.le])), },
  apply linear_map.bound_of_ball_bound' r_pos,
  exact λ z hz, h z hz,
end

variables (𝕜)
include 𝕜
lemma normed_space.sphere_nonempty_is_R_or_C [nontrivial E] {r : ℝ} (hr : 0 ≤ r) :
  nonempty (sphere (0:E) r) :=
begin
  letI : normed_space ℝ E := normed_space.restrict_scalars ℝ 𝕜 E,
  exact (sphere (0:E) r).nonempty_coe_sort.mpr (normed_space.sphere_nonempty.mpr hr),
end


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import order.conditionally_complete_lattice
import algebra.big_operators.basic
import algebra.group.prod
import algebra.group.pi
import algebra.module.pi

/-!
# Support of a function

In this file we define `function.support f = {x | f x ≠ 0}` and prove its basic properties.
We also define `function.mul_support f = {x | f x ≠ 1}`.
-/

open set
open_locale big_operators
namespace function

variables {α β A B M N P R S G M₀ G₀ : Type*} {ι : Sort*}

section has_one

variables [has_one M] [has_one N] [has_one P]

/-- `support` of a function is the set of points `x` such that `f x ≠ 0`. -/
def support [has_zero A] (f : α → A) : set α := {x | f x ≠ 0}

/-- `mul_support` of a function is the set of points `x` such that `f x ≠ 1`. -/
@[to_additive] def mul_support (f : α → M) : set α := {x | f x ≠ 1}

@[to_additive] lemma nmem_mul_support {f : α → M} {x : α} :
  x ∉ mul_support f ↔ f x = 1 :=
not_not

@[to_additive] lemma compl_mul_support {f : α → M} :
  (mul_support f)ᶜ = {x | f x = 1} :=
ext $ λ x, nmem_mul_support

@[simp, to_additive] lemma mem_mul_support {f : α → M} {x : α} :
  x ∈ mul_support f ↔ f x ≠ 1 :=
iff.rfl

@[simp, to_additive] lemma mul_support_subset_iff {f : α → M} {s : set α} :
  mul_support f ⊆ s ↔ ∀ x, f x ≠ 1 → x ∈ s :=
iff.rfl

@[to_additive] lemma mul_support_subset_iff' {f : α → M} {s : set α} :
  mul_support f ⊆ s ↔ ∀ x ∉ s, f x = 1 :=
forall_congr $ λ x, not_imp_comm

@[simp, to_additive] lemma mul_support_eq_empty_iff {f : α → M} :
  mul_support f = ∅ ↔ f = 1 :=
by { simp_rw [← subset_empty_iff, mul_support_subset_iff', funext_iff], simp }

@[simp, to_additive] lemma mul_support_one' : mul_support (1 : α → M) = ∅ :=
mul_support_eq_empty_iff.2 rfl

@[simp, to_additive] lemma mul_support_one : mul_support (λ x : α, (1 : M)) = ∅ :=
mul_support_one'

@[to_additive] lemma mul_support_binop_subset (op : M → N → P) (op1 : op 1 1 = 1)
  (f : α → M) (g : α → N) :
  mul_support (λ x, op (f x) (g x)) ⊆ mul_support f ∪ mul_support g :=
λ x hx, classical.by_cases
  (λ hf : f x = 1, or.inr $ λ hg, hx $ by simp only [hf, hg, op1])
  or.inl

@[to_additive] lemma mul_support_sup [semilattice_sup M] (f g : α → M) :
  mul_support (λ x, f x ⊔ g x) ⊆ mul_support f ∪ mul_support g :=
mul_support_binop_subset (⊔) sup_idem f g

@[to_additive] lemma mul_support_inf [semilattice_inf M] (f g : α → M) :
  mul_support (λ x, f x ⊓ g x) ⊆ mul_support f ∪ mul_support g :=
mul_support_binop_subset (⊓) inf_idem f g

@[to_additive] lemma mul_support_max [linear_order M] (f g : α → M) :
  mul_support (λ x, max (f x) (g x)) ⊆ mul_support f ∪ mul_support g :=
mul_support_sup f g

@[to_additive] lemma mul_support_min [linear_order M] (f g : α → M) :
  mul_support (λ x, min (f x) (g x)) ⊆ mul_support f ∪ mul_support g :=
mul_support_inf f g

@[to_additive] lemma mul_support_supr [conditionally_complete_lattice M] [nonempty ι]
  (f : ι → α → M) :
  mul_support (λ x, ⨆ i, f i x) ⊆ ⋃ i, mul_support (f i) :=
begin
  rw mul_support_subset_iff',
  simp only [mem_Union, not_exists, nmem_mul_support],
  intros x hx,
  simp only [hx, csupr_const]
end

@[to_additive] lemma mul_support_infi [conditionally_complete_lattice M] [nonempty ι]
  (f : ι → α → M) :
  mul_support (λ x, ⨅ i, f i x) ⊆ ⋃ i, mul_support (f i) :=
@mul_support_supr _ (order_dual M) ι ⟨(1:M)⟩ _ _ f

@[to_additive] lemma mul_support_comp_subset {g : M → N} (hg : g 1 = 1) (f : α → M) :
  mul_support (g ∘ f) ⊆ mul_support f :=
λ x, mt $ λ h, by simp only [(∘), *]

@[to_additive] lemma mul_support_subset_comp {g : M → N} (hg : ∀ {x}, g x = 1 → x = 1)
  (f : α → M) :
  mul_support f ⊆ mul_support (g ∘ f) :=
λ x, mt hg

@[to_additive] lemma mul_support_comp_eq (g : M → N) (hg : ∀ {x}, g x = 1 ↔ x = 1)
  (f : α → M) :
  mul_support (g ∘ f) = mul_support f :=
set.ext $ λ x, not_congr hg

@[to_additive] lemma mul_support_comp_eq_preimage (g : β → M) (f : α → β) :
  mul_support (g ∘ f) = f ⁻¹' mul_support g :=
rfl

@[to_additive support_prod_mk] lemma mul_support_prod_mk (f : α → M) (g : α → N) :
  mul_support (λ x, (f x, g x)) = mul_support f ∪ mul_support g :=
set.ext $ λ x, by simp only [mul_support, not_and_distrib, mem_union_eq, mem_set_of_eq,
  prod.mk_eq_one, ne.def]

@[to_additive support_prod_mk'] lemma mul_support_prod_mk' (f : α → M × N) :
  mul_support f = mul_support (λ x, (f x).1) ∪ mul_support (λ x, (f x).2) :=
by simp only [← mul_support_prod_mk, prod.mk.eta]

end has_one

@[to_additive] lemma mul_support_mul [monoid M] (f g : α → M) :
  mul_support (λ x, f x * g x) ⊆ mul_support f ∪ mul_support g :=
mul_support_binop_subset (*) (one_mul _) f g

@[simp, to_additive] lemma mul_support_inv [group G] (f : α → G) :
  mul_support (λ x, (f x)⁻¹) = mul_support f :=
set.ext $ λ x, not_congr inv_eq_one

@[simp, to_additive support_neg'] lemma mul_support_inv'' [group G] (f : α → G) :
  mul_support (f⁻¹) = mul_support f :=
mul_support_inv f

@[simp] lemma mul_support_inv' [group_with_zero G₀] (f : α → G₀) :
  mul_support (λ x, (f x)⁻¹) = mul_support f :=
set.ext $ λ x, not_congr inv_eq_one'

@[to_additive] lemma mul_support_mul_inv [group G] (f g : α → G) :
  mul_support (λ x, f x * (g x)⁻¹) ⊆ mul_support f ∪ mul_support g :=
mul_support_binop_subset (λ a b, a * b⁻¹) (by simp) f g

@[to_additive support_sub] lemma mul_support_group_div [group G] (f g : α → G) :
  mul_support (λ x, f x / g x) ⊆ mul_support f ∪ mul_support g :=
mul_support_binop_subset (/) (by simp only [one_div, one_inv]) f g

lemma mul_support_div [group_with_zero G₀] (f g : α → G₀) :
  mul_support (λ x, f x / g x) ⊆ mul_support f ∪ mul_support g :=
mul_support_binop_subset (/) (by simp only [div_one]) f g

@[simp] lemma support_mul [mul_zero_class R] [no_zero_divisors R] (f g : α → R) :
  support (λ x, f x * g x) = support f ∩ support g :=
set.ext $ λ x, by simp only [mem_support, mul_ne_zero_iff, mem_inter_eq, not_or_distrib]

lemma support_smul_subset_right [add_monoid A] [monoid B] [distrib_mul_action B A]
  (b : B) (f : α → A) :
  support (b • f) ⊆ support f :=
λ x hbf hf, hbf $ by rw [pi.smul_apply, hf, smul_zero]

lemma support_smul_subset_left [semiring R] [add_comm_monoid M] [module R M]
  (f : α → R) (g : α → M) :
  support (f • g) ⊆ support f :=
λ x hfg hf, hfg $ by rw [pi.smul_apply', hf, zero_smul]

lemma support_smul [semiring R] [add_comm_monoid M] [module R M]
  [no_zero_smul_divisors R M] (f : α → R) (g : α → M) :
  support (f • g) = support f ∩ support g :=
ext $ λ x, smul_ne_zero

@[simp] lemma support_inv [group_with_zero G₀] (f : α → G₀) :
  support (λ x, (f x)⁻¹) = support f :=
set.ext $ λ x, not_congr inv_eq_zero

@[simp] lemma support_div [group_with_zero G₀] (f g : α → G₀) :
  support (λ x, f x / g x) = support f ∩ support g :=
by simp [div_eq_mul_inv]

@[to_additive] lemma mul_support_prod [comm_monoid M] (s : finset α) (f : α → β → M) :
  mul_support (λ x, ∏ i in s, f i x) ⊆ ⋃ i ∈ s, mul_support (f i) :=
begin
  rw mul_support_subset_iff',
  simp only [mem_Union, not_exists, nmem_mul_support],
  exact λ x, finset.prod_eq_one
end

lemma support_prod_subset [comm_monoid_with_zero A] (s : finset α) (f : α → β → A) :
  support (λ x, ∏ i in s, f i x) ⊆ ⋂ i ∈ s, support (f i) :=
λ x hx, mem_bInter_iff.2 $ λ i hi H, hx $ finset.prod_eq_zero hi H

lemma support_prod [comm_monoid_with_zero A] [no_zero_divisors A] [nontrivial A]
  (s : finset α) (f : α → β → A) :
  support (λ x, ∏ i in s, f i x) = ⋂ i ∈ s, support (f i) :=
set.ext $ λ x, by
  simp only [support, ne.def, finset.prod_eq_zero_iff, mem_set_of_eq, set.mem_Inter, not_exists]

lemma mul_support_one_add [has_one R] [add_left_cancel_monoid R] (f : α → R) :
  mul_support (λ x, 1 + f x) = support f :=
set.ext $ λ x, not_congr add_right_eq_self

lemma mul_support_one_add' [has_one R] [add_left_cancel_monoid R] (f : α → R) :
  mul_support (1 + f) = support f :=
mul_support_one_add f

lemma mul_support_add_one [has_one R] [add_right_cancel_monoid R] (f : α → R) :
  mul_support (λ x, f x + 1) = support f :=
set.ext $ λ x, not_congr add_left_eq_self

lemma mul_support_add_one' [has_one R] [add_right_cancel_monoid R] (f : α → R) :
  mul_support (f + 1) = support f :=
mul_support_add_one f

lemma mul_support_one_sub' [has_one R] [add_group R] (f : α → R) :
  mul_support (1 - f) = support f :=
by rw [sub_eq_add_neg, mul_support_one_add', support_neg']

lemma mul_support_one_sub [has_one R] [add_group R] (f : α → R) :
  mul_support (λ x, 1 - f x) = support f :=
mul_support_one_sub' f

end function

namespace set

open function

variables {α β M : Type*} [has_one M] {f : α → M}

@[to_additive] lemma image_inter_mul_support_eq {s : set β} {g : β → α} :
  (g '' s ∩ mul_support f) = g '' (s ∩ mul_support (f ∘ g)) :=
by rw [mul_support_comp_eq_preimage f g, image_inter_preimage]

end set

namespace pi
variables {A : Type*} {B : Type*} [decidable_eq A] [has_zero B] {a : A} {b : B}

lemma support_single_zero : function.support (pi.single a (0 : B)) = ∅ := by simp

@[simp] lemma support_single_of_ne (h : b ≠ 0) :
  function.support (pi.single a b) = {a} :=
begin
  ext,
  simp only [mem_singleton_iff, ne.def, function.mem_support],
  split,
  { contrapose!,
    exact λ h', single_eq_of_ne h' b },
  { rintro rfl,
    rw single_eq_same,
    exact h }
end

lemma support_single [decidable_eq B] :
  function.support (pi.single a b) = if b = 0 then ∅ else {a} := by { split_ifs with h; simp [h] }

lemma support_single_subset : function.support (pi.single a b) ⊆ {a} :=
begin
  classical,
  rw support_single,
  split_ifs; simp
end

lemma support_single_disjoint {b' : B} (hb : b ≠ 0) (hb' : b' ≠ 0) {i j : A} :
  disjoint (function.support (single i b)) (function.support (single j b')) ↔ i ≠ j :=
by simpa [support_single, hb, hb'] using ne_comm

end pi


/-
Copyright (c) 2021 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn

! This file was ported from Lean 3 source module topology.algebra.semigroup
! leanprover-community/mathlib commit 4c19a16e4b705bf135cf9a80ac18fcc99c438514
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Separation

/-!
# Idempotents in topological semigroups

This file provides a sufficient condition for a semigroup `M` to contain an idempotent (i.e. an
element `m` such that `m * m = m `), namely that `M` is a nonempty compact Hausdorff space where
right-multiplication by constants is continuous.

We also state a corresponding lemma guaranteeing that a subset of `M` contains an idempotent.
-/

/- ./././Mathport/Syntax/Translate/Basic.lean:628:2: warning: expanding binder
  collection (m m' «expr ∈ » N) -/
/-- Any nonempty compact Hausdorff semigroup where right-multiplication is continuous contains
an idempotent, i.e. an `m` such that `m * m = m`. -/
@[to_additive
      "Any nonempty compact Hausdorff additive semigroup where right-addition is continuous
      contains an idempotent, i.e. an `m` such that `m + m = m`"]
theorem exists_idempotent_of_compact_t2_of_continuous_mul_left {M} [Nonempty M] [Semigroup M]
    [TopologicalSpace M] [CompactSpace M] [T2Space M]
    (continuous_mul_left : ∀ r : M, Continuous (· * r)) : ∃ m : M, m * m = m := by
  /- We apply Zorn's lemma to the poset of nonempty closed subsemigroups of `M`.
     It will turn out that any minimal element is `{m}` for an idempotent `m : M`. -/
  let S : Set (Set M) :=
    { N | IsClosed N ∧ N.Nonempty ∧ ∀ (m) (_ : m ∈ N) (m') (_ : m' ∈ N), m * m' ∈ N }
  obtain ⟨N, ⟨N_closed, ⟨m, hm⟩, N_mul⟩, N_minimal⟩ : ∃ N ∈ S, ∀ N' ∈ S, N' ⊆ N → N' = N
  rotate_left -- Porting note: restore to `rsuffices`
  · use m
    /- We now have an element `m : M` of a minimal subsemigroup `N`, and want to show `m + m = m`.
    We first show that every element of `N` is of the form `m' + m`.-/
    have scaling_eq_self : (· * m) '' N = N :=
      by
      apply N_minimal
      · refine' ⟨(continuous_mul_left m).isClosedMap _ N_closed, ⟨_, ⟨m, hm, rfl⟩⟩, _⟩
        rintro _ ⟨m'', hm'', rfl⟩ _ ⟨m', hm', rfl⟩
        refine' ⟨m'' * m * m', N_mul _ (N_mul _ hm'' _ hm) _ hm', mul_assoc _ _ _⟩
      · rintro _ ⟨m', hm', rfl⟩
        exact N_mul _ hm' _ hm
    /- In particular, this means that `m' * m = m` for some `m'`. We now use minimality again
       to show that this holds for all `m' ∈ N`. -/
    have absorbing_eq_self : N ∩ { m' | m' * m = m } = N :=
      by
      apply N_minimal
      · refine' ⟨N_closed.inter ((T1Space.t1 m).preimage (continuous_mul_left m)), _, _⟩
        · rwa [← scaling_eq_self] at hm
        · rintro m'' ⟨mem'', eq'' : _ = m⟩ m' ⟨mem', eq' : _ = m⟩
          refine' ⟨N_mul _ mem'' _ mem', _⟩
          rw [Set.mem_setOf_eq, mul_assoc, eq', eq'']
      apply Set.inter_subset_left
    -- Thus `m * m = m` as desired.
    rw [← absorbing_eq_self] at hm
    exact hm.2
  refine' zorn_superset _ fun c hcs hc => _
  refine'
    ⟨⋂₀ c, ⟨isClosed_interₛ fun t ht => (hcs ht).1, _, fun m hm m' hm' => _⟩, fun s hs =>
      Set.interₛ_subset_of_mem hs⟩
  · obtain rfl | hcnemp := c.eq_empty_or_nonempty
    · rw [Set.interₛ_empty]
      apply Set.univ_nonempty
    convert
      @IsCompact.nonempty_interᵢ_of_directed_nonempty_compact_closed _ _ _ hcnemp.coe_sort
        ((↑) : c → Set M) ?_ ?_ ?_ ?_
    · simp only [Subtype.range_coe_subtype, Set.setOf_mem_eq]
      exact Set.interₛ_eq_interᵢ
    · refine' DirectedOn.directed_val (IsChain.directedOn hc.symm)
    exacts[fun i => (hcs i.prop).2.1, fun i => (hcs i.prop).1.isCompact, fun i => (hcs i.prop).1]
  · rw [Set.mem_interₛ]
    exact fun t ht => (hcs ht).2.2 m (Set.mem_interₛ.mp hm t ht) m' (Set.mem_interₛ.mp hm' t ht)
#align exists_idempotent_of_compact_t2_of_continuous_mul_left exists_idempotent_of_compact_t2_of_continuous_mul_left
#align exists_idempotent_of_compact_t2_of_continuous_add_left exists_idempotent_of_compact_t2_of_continuous_add_left

/- ./././Mathport/Syntax/Translate/Basic.lean:628:2: warning:
   expanding binder collection (x y «expr ∈ » s) -/
/-- A version of `exists_idempotent_of_compact_t2_of_continuous_mul_left` where the idempotent lies
in some specified nonempty compact subsemigroup. -/
@[to_additive exists_idempotent_in_compact_add_subsemigroup
      "A version of
      `exists_idempotent_of_compact_t2_of_continuous_add_left` where the idempotent lies in
      some specified nonempty compact additive subsemigroup."]
theorem exists_idempotent_in_compact_subsemigroup {M} [Semigroup M] [TopologicalSpace M] [T2Space M]
    (continuous_mul_left : ∀ r : M, Continuous (· * r)) (s : Set M) (snemp : s.Nonempty)
    (s_compact : IsCompact s) (s_add : ∀ (x) (_ : x ∈ s) (y) (_ : y ∈ s), x * y ∈ s) :
    ∃ m ∈ s, m * m = m := by
  let M' := { m // m ∈ s }
  letI : Semigroup M' :=
    { mul := fun p q => ⟨p.1 * q.1, s_add _ p.2 _ q.2⟩
      mul_assoc := fun p q r => Subtype.eq (mul_assoc _ _ _) }
  haveI : CompactSpace M' := isCompact_iff_compactSpace.mp s_compact
  haveI : Nonempty M' := nonempty_subtype.mpr snemp
  have : ∀ p : M', Continuous (· * p) := fun p =>
    ((continuous_mul_left p.1).comp continuous_subtype_val).subtype_mk _
  obtain ⟨⟨m, hm⟩, idem⟩ := exists_idempotent_of_compact_t2_of_continuous_mul_left this
  exact ⟨m, hm, Subtype.ext_iff.mp idem⟩
#align exists_idempotent_in_compact_subsemigroup exists_idempotent_in_compact_subsemigroup
#align exists_idempotent_in_compact_add_subsemigroup exists_idempotent_in_compact_add_subsemigroup


import analysis.special_functions.trigonometric.deriv
import analysis.calculus.mean_value

open set filter
open_locale topological_space filter classical real

noncomputable theory

/- TEXT:
.. index:: elementary calculus

.. _elementary_differential_calculus:

Elementary Differential Calculus
--------------------------------

Let ``f`` be a function from the reals to the reals. There is a difference
between talking about the derivative of ``f`` at a single point and
talking about the derivative function.
In mathlib, the first notion is represented as follows.
EXAMPLES: -/
-- QUOTE:
open real

/-- The sin function has derivative 1 at 0. -/
example : has_deriv_at sin 1 0 :=
by simpa using has_deriv_at_sin 0
-- QUOTE.

/- TEXT:
We can also express that ``f`` is differentiable at a point without
specifying its derivative there
by writing ``differentiable_at ℝ``.
We specify ``ℝ`` explicitly because in a slightly more general context,
when talking about functions from ``ℂ`` to ``ℂ``,
we want to be able to distinguish between being differentiable in the real sense
and being differentiable in the sense of the complex derivative.
EXAMPLES: -/
-- QUOTE:
example (x : ℝ) : differentiable_at ℝ sin x :=
(has_deriv_at_sin x).differentiable_at
-- QUOTE.

/- TEXT:
It would be inconvenient to have to provide a proof of differentiability
every time we want to refer to a deriviative.
So mathlib provides a function ``deriv f : ℝ → ℝ`` that is defined for any
function ``f : ℝ → ℝ``
but is defined to take the value ``0`` at any point where ``f`` is not differentiable.
EXAMPLES: -/
-- QUOTE:
example {f : ℝ → ℝ} {x a : ℝ} (h : has_deriv_at f a x) : deriv f x = a :=
h.deriv

example {f : ℝ → ℝ} {x : ℝ} (h : ¬ differentiable_at ℝ f x) : deriv f x = 0 :=
deriv_zero_of_not_differentiable_at h
-- QUOTE.

/- TEXT:
Of course there are many lemmas about ``deriv`` that do require differentiability assumptions.
For instance, you should think about a counterexample to the next lemma without the
differentiability assumptions.
EXAMPLES: -/
-- QUOTE:
example {f g : ℝ → ℝ} {x : ℝ} (hf : differentiable_at ℝ f x) (hg : differentiable_at ℝ g x) :
  deriv (f + g) x = deriv f x + deriv g x :=
deriv_add hf hg
-- QUOTE.

/- TEXT:
Interestingly, however, there are statements that can avoid differentiability
assumptions by taking advanting
of the fact that the value of ``deriv`` defaults to zero when the function is
not differentiable.
So making sense of the following statement requires knowing the precise
definition of ``deriv``.
EXAMPLES: -/
-- QUOTE:
example {f : ℝ → ℝ} {a : ℝ} (h : is_local_min f a) : deriv f a = 0 :=
h.deriv_eq_zero
-- QUOTE.

/- TEXT:
We can eve state Rolle's theorem without any differentiability assumptions, which
seems even weirder.
EXAMPLES: -/
-- QUOTE:
example {f : ℝ → ℝ} {a b : ℝ} (hab : a < b)
  (hfc : continuous_on f (Icc a b)) (hfI : f a = f b) :
  ∃ c ∈ Ioo a b, deriv f c = 0 :=
exists_deriv_eq_zero f hab hfc hfI
-- QUOTE.

/- TEXT:
Of course, this trick does not work for the general mean value theorem.
EXAMPLES: -/
-- QUOTE:
example (f : ℝ → ℝ) {a b : ℝ} (hab : a < b) (hf : continuous_on f (Icc a b))
 (hf' : differentiable_on ℝ f (Ioo a b)) :
 ∃ c ∈ Ioo a b, deriv f c = (f b - f a) / (b - a) :=
exists_deriv_eq_slope f hab hf hf'
-- QUOTE.

/- TEXT:
Lean can automatically compute some simple derivatives using the ``simp`` tactic.
EXAMPLES: -/
-- QUOTE:
example : deriv (λ x : ℝ, x^5) 6 = 5 * 6^4 := by simp

example (x₀ : ℝ) (h₀ : x₀ ≠ 0) : deriv (λ x : ℝ, 1 / x) x₀ = -(x₀^2)⁻¹ := by simp

example : deriv sin π = -1 := by simp
-- QUOTE.

/- TEXT:
Sometimes we need to use ``ring`` and/or ``field_simp`` after ``simp``.`
EXAMPLES: -/
-- QUOTE:
example (x₀ : ℝ) (h : x₀ ≠ 0) :
  deriv (λ x : ℝ, exp(x^2) / x^5) x₀ = (2 * x₀^2 - 5) * exp (x₀^2) / x₀^6 :=
begin
  have : x₀^5 ≠ 0, { exact pow_ne_zero 5 h, },
  field_simp,
  ring,
end

example (y : ℝ) : has_deriv_at (λ x : ℝ, 2 * x + 5) 2 y :=
begin
  have := ((has_deriv_at_id y).const_mul 2).add_const 5,
  rwa [mul_one] at this,
end

example (y : ℝ) : deriv (λ x : ℝ, 2 * x + 5) y = 2 := by simp
-- QUOTE.