/-
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ä

! This file was ported from Lean 3 source module measure_theory.measure.probability_measure
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Measure.FiniteMeasure
import Mathbin.MeasureTheory.Integral.Average
import Mathbin.Probability.ConditionalProbability

/-!
# Probability measures

This file defines the type of probability measures on a given measurable space. When the underlying
space has a topology and the measurable space structure (sigma algebra) is finer than the Borel
sigma algebra, then the type of probability measures is equipped with the topology of convergence
in distribution (weak convergence of measures). The topology of convergence in distribution is the
coarsest topology w.r.t. which for every bounded continuous `ℝ≥0`-valued random variable `X`, the
expected value of `X` depends continuously on the choice of probability measure. This is a special
case of the topology of weak convergence of finite measures.

## Main definitions

The main definitions are
 * the type `measure_theory.probability_measure Ω` with the topology of convergence in
   distribution (a.k.a. convergence in law, weak convergence of measures);
 * `measure_theory.probability_measure.to_finite_measure`: Interpret a probability measure as
   a finite measure;
 * `measure_theory.finite_measure.normalize`: Normalize a finite measure to a probability measure
   (returns junk for the zero measure).

## Main results

 * `measure_theory.probability_measure.tendsto_iff_forall_integral_tendsto`: Convergence of
   probability measures is characterized by the convergence of expected values of all bounded
   continuous random variables. This shows that the chosen definition of topology coincides with
   the common textbook definition of convergence in distribution, i.e., weak convergence of
   measures. A similar characterization by the convergence of expected values (in the
   `measure_theory.lintegral` sense) of all bounded continuous nonnegative random variables is
   `measure_theory.probability_measure.tendsto_iff_forall_lintegral_tendsto`.
 * `measure_theory.finite_measure.tendsto_normalize_iff_tendsto`: The convergence of finite
   measures to a nonzero limit is characterized by the convergence of the probability-normalized
   versions and of the total masses.

TODO:
 * Probability measures form a convex space.

## Implementation notes

The topology of convergence in distribution on `measure_theory.probability_measure Ω` is inherited
weak convergence of finite measures via the mapping
`measure_theory.probability_measure.to_finite_measure`.

Like `measure_theory.finite_measure Ω`, the implementation of `measure_theory.probability_measure Ω`
is directly as a subtype of `measure_theory.measure Ω`, and the coercion to a function is the
composition `ennreal.to_nnreal` and the coercion to function of `measure_theory.measure Ω`.

## References

* [Billingsley, *Convergence of probability measures*][billingsley1999]

## Tags

convergence in distribution, convergence in law, weak convergence of measures, probability measure

-/

noncomputable section

open MeasureTheory

open Set

open Filter

open BoundedContinuousFunction

open Topology ENNReal NNReal BoundedContinuousFunction

namespace MeasureTheory

section ProbabilityMeasure

/-! ### Probability measures

In this section we define the type of probability measures on a measurable space `Ω`, denoted by
`measure_theory.probability_measure Ω`.

If `Ω` is moreover a topological space and the sigma algebra on `Ω` is finer than the Borel sigma
algebra (i.e. `[opens_measurable_space Ω]`), then `measure_theory.probability_measure Ω` is
equipped with the topology of weak convergence of measures. Since every probability measure is a
finite measure, this is implemented as the induced topology from the mapping
`measure_theory.probability_measure.to_finite_measure`.
-/

/-- Probability measures are defined as the subtype of measures that have the property of being
probability measures (i.e., their total mass is one). -/
def ProbabilityMeasure (Ω : Type _) [MeasurableSpace Ω] : Type _ :=
  { μ : Measure Ω // IsProbabilityMeasure μ }
#align measure_theory.probability_measure MeasureTheory.ProbabilityMeasure

namespace ProbabilityMeasure

variable {Ω : Type _} [MeasurableSpace Ω]

instance [Inhabited Ω] : Inhabited (ProbabilityMeasure Ω) :=
  ⟨⟨Measure.dirac default, Measure.dirac.isProbabilityMeasure⟩⟩

/-- A probability measure can be interpreted as a measure. -/
instance : Coe (ProbabilityMeasure Ω) (MeasureTheory.Measure Ω) :=
  coeSubtype

instance : CoeFun (ProbabilityMeasure Ω) fun _ => Set Ω → ℝ≥0 :=
  ⟨fun μ s => (μ s).toNNReal⟩

instance (μ : ProbabilityMeasure Ω) : IsProbabilityMeasure (μ : Measure Ω) :=
  μ.Prop

theorem coeFn_eq_toNNReal_coeFn_to_measure (ν : ProbabilityMeasure Ω) :
    (ν : Set Ω → ℝ≥0) = fun s => ((ν : Measure Ω) s).toNNReal :=
  rfl
#align measure_theory.probability_measure.coe_fn_eq_to_nnreal_coe_fn_to_measure MeasureTheory.ProbabilityMeasure.coeFn_eq_toNNReal_coeFn_to_measure

@[simp]
theorem val_eq_to_measure (ν : ProbabilityMeasure Ω) : ν.val = (ν : Measure Ω) :=
  rfl
#align measure_theory.probability_measure.val_eq_to_measure MeasureTheory.ProbabilityMeasure.val_eq_to_measure

theorem coe_injective : Function.Injective (coe : ProbabilityMeasure Ω → Measure Ω) :=
  Subtype.coe_injective
#align measure_theory.probability_measure.coe_injective MeasureTheory.ProbabilityMeasure.coe_injective

@[simp]
theorem coeFn_univ (ν : ProbabilityMeasure Ω) : ν univ = 1 :=
  congr_arg ENNReal.toNNReal ν.Prop.measure_univ
#align measure_theory.probability_measure.coe_fn_univ MeasureTheory.ProbabilityMeasure.coeFn_univ

theorem coeFn_univ_ne_zero (ν : ProbabilityMeasure Ω) : ν univ ≠ 0 := by
  simp only [coe_fn_univ, Ne.def, one_ne_zero, not_false_iff]
#align measure_theory.probability_measure.coe_fn_univ_ne_zero MeasureTheory.ProbabilityMeasure.coeFn_univ_ne_zero

/-- A probability measure can be interpreted as a finite measure. -/
def toFiniteMeasure (μ : ProbabilityMeasure Ω) : FiniteMeasure Ω :=
  ⟨μ, inferInstance⟩
#align measure_theory.probability_measure.to_finite_measure MeasureTheory.ProbabilityMeasure.toFiniteMeasure

@[simp]
theorem coe_comp_toFiniteMeasure_eq_coe (ν : ProbabilityMeasure Ω) :
    (ν.toFiniteMeasure : Measure Ω) = (ν : Measure Ω) :=
  rfl
#align measure_theory.probability_measure.coe_comp_to_finite_measure_eq_coe MeasureTheory.ProbabilityMeasure.coe_comp_toFiniteMeasure_eq_coe

@[simp]
theorem coeFn_comp_toFiniteMeasure_eq_coeFn (ν : ProbabilityMeasure Ω) :
    (ν.toFiniteMeasure : Set Ω → ℝ≥0) = (ν : Set Ω → ℝ≥0) :=
  rfl
#align measure_theory.probability_measure.coe_fn_comp_to_finite_measure_eq_coe_fn MeasureTheory.ProbabilityMeasure.coeFn_comp_toFiniteMeasure_eq_coeFn

@[simp]
theorem eNNReal_coeFn_eq_coeFn_to_measure (ν : ProbabilityMeasure Ω) (s : Set Ω) :
    (ν s : ℝ≥0∞) = (ν : Measure Ω) s := by
  rw [← coe_fn_comp_to_finite_measure_eq_coe_fn, finite_measure.ennreal_coe_fn_eq_coe_fn_to_measure,
    coe_comp_to_finite_measure_eq_coe]
#align measure_theory.probability_measure.ennreal_coe_fn_eq_coe_fn_to_measure MeasureTheory.ProbabilityMeasure.eNNReal_coeFn_eq_coeFn_to_measure

theorem apply_mono (μ : ProbabilityMeasure Ω) {s₁ s₂ : Set Ω} (h : s₁ ⊆ s₂) : μ s₁ ≤ μ s₂ :=
  by
  rw [← coe_fn_comp_to_finite_measure_eq_coe_fn]
  exact MeasureTheory.FiniteMeasure.apply_mono _ h
#align measure_theory.probability_measure.apply_mono MeasureTheory.ProbabilityMeasure.apply_mono

theorem nonempty_of_probabilityMeasure (μ : ProbabilityMeasure Ω) : Nonempty Ω :=
  by
  by_contra maybe_empty
  have zero : (μ : Measure Ω) univ = 0 := by
    rw [univ_eq_empty_iff.mpr (not_nonempty_iff.mp maybe_empty), measure_empty]
  rw [measure_univ] at zero
  exact zero_ne_one zero.symm
#align measure_theory.probability_measure.nonempty_of_probability_measure MeasureTheory.ProbabilityMeasure.nonempty_of_probabilityMeasure

@[ext]
theorem eq_of_forall_measure_apply_eq (μ ν : ProbabilityMeasure Ω)
    (h : ∀ s : Set Ω, MeasurableSet s → (μ : Measure Ω) s = (ν : Measure Ω) s) : μ = ν :=
  by
  ext1
  ext1 s s_mble
  exact h s s_mble
#align measure_theory.probability_measure.eq_of_forall_measure_apply_eq MeasureTheory.ProbabilityMeasure.eq_of_forall_measure_apply_eq

theorem eq_of_forall_apply_eq (μ ν : ProbabilityMeasure Ω)
    (h : ∀ s : Set Ω, MeasurableSet s → μ s = ν s) : μ = ν :=
  by
  ext1 s s_mble
  simpa [ennreal_coe_fn_eq_coe_fn_to_measure] using congr_arg (coe : ℝ≥0 → ℝ≥0∞) (h s s_mble)
#align measure_theory.probability_measure.eq_of_forall_apply_eq MeasureTheory.ProbabilityMeasure.eq_of_forall_apply_eq

@[simp]
theorem mass_toFiniteMeasure (μ : ProbabilityMeasure Ω) : μ.toFiniteMeasure.mass = 1 :=
  μ.coeFn_univ
#align measure_theory.probability_measure.mass_to_finite_measure MeasureTheory.ProbabilityMeasure.mass_toFiniteMeasure

theorem toFiniteMeasure_nonzero (μ : ProbabilityMeasure Ω) : μ.toFiniteMeasure ≠ 0 :=
  by
  rw [← finite_measure.mass_nonzero_iff, μ.mass_to_finite_measure]
  exact one_ne_zero
#align measure_theory.probability_measure.to_finite_measure_nonzero MeasureTheory.ProbabilityMeasure.toFiniteMeasure_nonzero

variable [TopologicalSpace Ω] [OpensMeasurableSpace Ω]

theorem testAgainstNn_lipschitz (μ : ProbabilityMeasure Ω) :
    LipschitzWith 1 fun f : Ω →ᵇ ℝ≥0 => μ.toFiniteMeasure.testAgainstNn f :=
  μ.mass_toFiniteMeasure ▸ μ.toFiniteMeasure.testAgainstNn_lipschitz
#align measure_theory.probability_measure.test_against_nn_lipschitz MeasureTheory.ProbabilityMeasure.testAgainstNn_lipschitz

/-- The topology of weak convergence on `measure_theory.probability_measure Ω`. This is inherited
(induced) from the topology of weak convergence of finite measures via the inclusion
`measure_theory.probability_measure.to_finite_measure`. -/
instance : TopologicalSpace (ProbabilityMeasure Ω) :=
  TopologicalSpace.induced toFiniteMeasure inferInstance

theorem toFiniteMeasure_continuous :
    Continuous (toFiniteMeasure : ProbabilityMeasure Ω → FiniteMeasure Ω) :=
  continuous_induced_dom
#align measure_theory.probability_measure.to_finite_measure_continuous MeasureTheory.ProbabilityMeasure.toFiniteMeasure_continuous

/-- Probability measures yield elements of the `weak_dual` of bounded continuous nonnegative
functions via `measure_theory.finite_measure.test_against_nn`, i.e., integration. -/
def toWeakDualBcnn : ProbabilityMeasure Ω → WeakDual ℝ≥0 (Ω →ᵇ ℝ≥0) :=
  FiniteMeasure.toWeakDualBcnn ∘ toFiniteMeasure
#align measure_theory.probability_measure.to_weak_dual_bcnn MeasureTheory.ProbabilityMeasure.toWeakDualBcnn

@[simp]
theorem coe_toWeakDualBcnn (μ : ProbabilityMeasure Ω) :
    ⇑μ.toWeakDualBcnn = μ.toFiniteMeasure.testAgainstNn :=
  rfl
#align measure_theory.probability_measure.coe_to_weak_dual_bcnn MeasureTheory.ProbabilityMeasure.coe_toWeakDualBcnn

@[simp]
theorem toWeakDualBcnn_apply (μ : ProbabilityMeasure Ω) (f : Ω →ᵇ ℝ≥0) :
    μ.toWeakDualBcnn f = (∫⁻ ω, f ω ∂(μ : Measure Ω)).toNNReal :=
  rfl
#align measure_theory.probability_measure.to_weak_dual_bcnn_apply MeasureTheory.ProbabilityMeasure.toWeakDualBcnn_apply

theorem toWeakDualBcnn_continuous : Continuous fun μ : ProbabilityMeasure Ω => μ.toWeakDualBcnn :=
  FiniteMeasure.toWeakDualBcnn_continuous.comp toFiniteMeasure_continuous
#align measure_theory.probability_measure.to_weak_dual_bcnn_continuous MeasureTheory.ProbabilityMeasure.toWeakDualBcnn_continuous

/- Integration of (nonnegative bounded continuous) test functions against Borel probability
measures depends continuously on the measure. -/
theorem continuous_testAgainstNn_eval (f : Ω →ᵇ ℝ≥0) :
    Continuous fun μ : ProbabilityMeasure Ω => μ.toFiniteMeasure.testAgainstNn f :=
  (FiniteMeasure.continuous_testAgainstNn_eval f).comp toFiniteMeasure_continuous
#align measure_theory.probability_measure.continuous_test_against_nn_eval MeasureTheory.ProbabilityMeasure.continuous_testAgainstNn_eval

-- The canonical mapping from probability measures to finite measures is an embedding.
theorem toFiniteMeasure_embedding (Ω : Type _) [MeasurableSpace Ω] [TopologicalSpace Ω]
    [OpensMeasurableSpace Ω] :
    Embedding (toFiniteMeasure : ProbabilityMeasure Ω → FiniteMeasure Ω) :=
  { induced := rfl
    inj := fun μ ν h => Subtype.eq (by convert congr_arg coe h) }
#align measure_theory.probability_measure.to_finite_measure_embedding MeasureTheory.ProbabilityMeasure.toFiniteMeasure_embedding

theorem tendsto_nhds_iff_to_finite_measures_tendsto_nhds {δ : Type _} (F : Filter δ)
    {μs : δ → ProbabilityMeasure Ω} {μ₀ : ProbabilityMeasure Ω} :
    Tendsto μs F (𝓝 μ₀) ↔ Tendsto (toFiniteMeasure ∘ μs) F (𝓝 μ₀.toFiniteMeasure) :=
  Embedding.tendsto_nhds_iff (toFiniteMeasure_embedding Ω)
#align measure_theory.probability_measure.tendsto_nhds_iff_to_finite_measures_tendsto_nhds MeasureTheory.ProbabilityMeasure.tendsto_nhds_iff_to_finite_measures_tendsto_nhds

/-- A characterization of weak convergence of probability measures by the condition that the
integrals of every continuous bounded nonnegative function converge to the integral of the function
against the limit measure. -/
theorem tendsto_iff_forall_lintegral_tendsto {γ : Type _} {F : Filter γ}
    {μs : γ → ProbabilityMeasure Ω} {μ : ProbabilityMeasure Ω} :
    Tendsto μs F (𝓝 μ) ↔
      ∀ f : Ω →ᵇ ℝ≥0,
        Tendsto (fun i => ∫⁻ ω, f ω ∂(μs i : Measure Ω)) F (𝓝 (∫⁻ ω, f ω ∂(μ : Measure Ω))) :=
  by
  rw [tendsto_nhds_iff_to_finite_measures_tendsto_nhds]
  exact finite_measure.tendsto_iff_forall_lintegral_tendsto
#align measure_theory.probability_measure.tendsto_iff_forall_lintegral_tendsto MeasureTheory.ProbabilityMeasure.tendsto_iff_forall_lintegral_tendsto

/-- The characterization of weak convergence of probability measures by the usual (defining)
condition that the integrals of every continuous bounded function converge to the integral of the
function against the limit measure. -/
theorem tendsto_iff_forall_integral_tendsto {γ : Type _} {F : Filter γ}
    {μs : γ → ProbabilityMeasure Ω} {μ : ProbabilityMeasure Ω} :
    Tendsto μs F (𝓝 μ) ↔
      ∀ f : Ω →ᵇ ℝ,
        Tendsto (fun i => ∫ ω, f ω ∂(μs i : Measure Ω)) F (𝓝 (∫ ω, f ω ∂(μ : Measure Ω))) :=
  by
  rw [tendsto_nhds_iff_to_finite_measures_tendsto_nhds]
  rw [finite_measure.tendsto_iff_forall_integral_tendsto]
  simp only [coe_comp_to_finite_measure_eq_coe]
#align measure_theory.probability_measure.tendsto_iff_forall_integral_tendsto MeasureTheory.ProbabilityMeasure.tendsto_iff_forall_integral_tendsto

end ProbabilityMeasure

-- namespace
end ProbabilityMeasure

-- section
section NormalizeFiniteMeasure

/-! ### Normalization of finite measures to probability measures

This section is about normalizing finite measures to probability measures.

The weak convergence of finite measures to nonzero limit measures is characterized by
the convergence of the total mass and the convergence of the normalized probability
measures.
-/

namespace FiniteMeasure

variable {Ω : Type _} [Nonempty Ω] {m0 : MeasurableSpace Ω} (μ : FiniteMeasure Ω)

/-- Normalize a finite measure so that it becomes a probability measure, i.e., divide by the
total mass. -/
def normalize : ProbabilityMeasure Ω :=
  if zero : μ.mass = 0 then ⟨Measure.dirac ‹Nonempty Ω›.some, Measure.dirac.isProbabilityMeasure⟩
  else
    { val := μ.mass⁻¹ • μ
      property := by
        refine' ⟨_⟩
        simp only [mass, measure.coe_nnreal_smul_apply, ←
          ennreal_coe_fn_eq_coe_fn_to_measure μ univ]
        norm_cast
        exact inv_mul_cancel zero }
#align measure_theory.finite_measure.normalize MeasureTheory.FiniteMeasure.normalize

@[simp]
theorem self_eq_mass_mul_normalize (s : Set Ω) : μ s = μ.mass * μ.normalize s :=
  by
  obtain rfl | h := eq_or_ne μ 0
  · simp only [zero.mass, coe_fn_zero, Pi.zero_apply, MulZeroClass.zero_mul]
  have mass_nonzero : μ.mass ≠ 0 := by rwa [μ.mass_nonzero_iff]
  simp only [normalize, dif_neg mass_nonzero, ENNReal.toNNReal_mul, Subtype.coe_mk,
    probability_measure.coe_fn_eq_to_nnreal_coe_fn_to_measure, ENNReal.toNNReal_coe,
    MeasureTheory.Measure.coe_nNReal_smul_apply, mul_inv_cancel_left₀ mass_nonzero,
    finite_measure.coe_fn_eq_to_nnreal_coe_fn_to_measure]
#align measure_theory.finite_measure.self_eq_mass_mul_normalize MeasureTheory.FiniteMeasure.self_eq_mass_mul_normalize

theorem self_eq_mass_smul_normalize : μ = μ.mass • μ.normalize.toFiniteMeasure :=
  by
  apply eq_of_forall_apply_eq
  intro s s_mble
  rw [μ.self_eq_mass_mul_normalize s, coe_fn_smul_apply, smul_eq_mul,
    probability_measure.coe_fn_comp_to_finite_measure_eq_coe_fn]
#align measure_theory.finite_measure.self_eq_mass_smul_normalize MeasureTheory.FiniteMeasure.self_eq_mass_smul_normalize

theorem normalize_eq_of_nonzero (nonzero : μ ≠ 0) (s : Set Ω) : μ.normalize s = μ.mass⁻¹ * μ s := by
  simp only [μ.self_eq_mass_mul_normalize, μ.mass_nonzero_iff.mpr nonzero, inv_mul_cancel_left₀,
    Ne.def, not_false_iff]
#align measure_theory.finite_measure.normalize_eq_of_nonzero MeasureTheory.FiniteMeasure.normalize_eq_of_nonzero

theorem normalize_eq_inv_mass_smul_of_nonzero (nonzero : μ ≠ 0) :
    μ.normalize.toFiniteMeasure = μ.mass⁻¹ • μ :=
  by
  nth_rw 3 [μ.self_eq_mass_smul_normalize]
  rw [← smul_assoc]
  simp only [μ.mass_nonzero_iff.mpr nonzero, Algebra.id.smul_eq_mul, inv_mul_cancel, Ne.def,
    not_false_iff, one_smul]
#align measure_theory.finite_measure.normalize_eq_inv_mass_smul_of_nonzero MeasureTheory.FiniteMeasure.normalize_eq_inv_mass_smul_of_nonzero

theorem coe_normalize_eq_of_nonzero (nonzero : μ ≠ 0) : (μ.normalize : Measure Ω) = μ.mass⁻¹ • μ :=
  by
  ext1 s s_mble
  simp only [← μ.normalize.ennreal_coe_fn_eq_coe_fn_to_measure s,
    μ.normalize_eq_of_nonzero nonzero s, ENNReal.coe_mul, ennreal_coe_fn_eq_coe_fn_to_measure,
    measure.coe_nnreal_smul_apply]
#align measure_theory.finite_measure.coe_normalize_eq_of_nonzero MeasureTheory.FiniteMeasure.coe_normalize_eq_of_nonzero

@[simp]
theorem ProbabilityMeasure.toFiniteMeasure_normalize_eq_self {m0 : MeasurableSpace Ω}
    (μ : ProbabilityMeasure Ω) : μ.toFiniteMeasure.normalize = μ :=
  by
  apply probability_measure.eq_of_forall_apply_eq
  intro s s_mble
  rw [μ.to_finite_measure.normalize_eq_of_nonzero μ.to_finite_measure_nonzero s]
  simp only [probability_measure.mass_to_finite_measure, inv_one, one_mul,
    probability_measure.coe_fn_comp_to_finite_measure_eq_coe_fn]
#align probability_measure.to_finite_measure_normalize_eq_self ProbabilityMeasure.toFiniteMeasure_normalize_eq_self

/-- Averaging with respect to a finite measure is the same as integraing against
`measure_theory.finite_measure.normalize`. -/
theorem average_eq_integral_normalize {E : Type _} [NormedAddCommGroup E] [NormedSpace ℝ E]
    [CompleteSpace E] (nonzero : μ ≠ 0) (f : Ω → E) :
    average (μ : Measure Ω) f = ∫ ω, f ω ∂(μ.normalize : Measure Ω) :=
  by
  rw [μ.coe_normalize_eq_of_nonzero nonzero, average]
  congr
  simp only [RingHom.toFun_eq_coe, ENNReal.coe_ofNNRealHom,
    ENNReal.coe_inv (μ.mass_nonzero_iff.mpr nonzero), ennreal_mass]
#align measure_theory.finite_measure.average_eq_integral_normalize MeasureTheory.FiniteMeasure.average_eq_integral_normalize

variable [TopologicalSpace Ω]

theorem testAgainstNn_eq_mass_mul (f : Ω →ᵇ ℝ≥0) :
    μ.testAgainstNn f = μ.mass * μ.normalize.toFiniteMeasure.testAgainstNn f :=
  by
  nth_rw 1 [μ.self_eq_mass_smul_normalize]
  rw [μ.normalize.to_finite_measure.smul_test_against_nn_apply μ.mass f, smul_eq_mul]
#align measure_theory.finite_measure.test_against_nn_eq_mass_mul MeasureTheory.FiniteMeasure.testAgainstNn_eq_mass_mul

theorem normalize_testAgainstNn (nonzero : μ ≠ 0) (f : Ω →ᵇ ℝ≥0) :
    μ.normalize.toFiniteMeasure.testAgainstNn f = μ.mass⁻¹ * μ.testAgainstNn f := by
  simp [μ.test_against_nn_eq_mass_mul, μ.mass_nonzero_iff.mpr nonzero]
#align measure_theory.finite_measure.normalize_test_against_nn MeasureTheory.FiniteMeasure.normalize_testAgainstNn

variable [OpensMeasurableSpace Ω]

variable {μ}

theorem tendsto_testAgainstNn_of_tendsto_normalize_testAgainstNn_of_tendsto_mass {γ : Type _}
    {F : Filter γ} {μs : γ → FiniteMeasure Ω}
    (μs_lim : Tendsto (fun i => (μs i).normalize) F (𝓝 μ.normalize))
    (mass_lim : Tendsto (fun i => (μs i).mass) F (𝓝 μ.mass)) (f : Ω →ᵇ ℝ≥0) :
    Tendsto (fun i => (μs i).testAgainstNn f) F (𝓝 (μ.testAgainstNn f)) :=
  by
  by_cases h_mass : μ.mass = 0
  · simp only [μ.mass_zero_iff.mp h_mass, zero.test_against_nn_apply, zero.mass,
      eq_self_iff_true] at *
    exact tendsto_zero_test_against_nn_of_tendsto_zero_mass mass_lim f
  simp_rw [fun i => (μs i).testAgainstNn_eq_mass_mul f, μ.test_against_nn_eq_mass_mul f]
  rw [probability_measure.tendsto_nhds_iff_to_finite_measures_tendsto_nhds] at μs_lim
  rw [tendsto_iff_forall_test_against_nn_tendsto] at μs_lim
  have lim_pair :
    tendsto (fun i => (⟨(μs i).mass, (μs i).normalize.toFiniteMeasure.testAgainstNn f⟩ : ℝ≥0 × ℝ≥0))
      F (𝓝 ⟨μ.mass, μ.normalize.to_finite_measure.test_against_nn f⟩) :=
    (Prod.tendsto_iff _ _).mpr ⟨mass_lim, μs_lim f⟩
  exact tendsto_mul.comp lim_pair
#align measure_theory.finite_measure.tendsto_test_against_nn_of_tendsto_normalize_test_against_nn_of_tendsto_mass MeasureTheory.FiniteMeasure.tendsto_testAgainstNn_of_tendsto_normalize_testAgainstNn_of_tendsto_mass

theorem tendsto_normalize_testAgainstNn_of_tendsto {γ : Type _} {F : Filter γ}
    {μs : γ → FiniteMeasure Ω} (μs_lim : Tendsto μs F (𝓝 μ)) (nonzero : μ ≠ 0) (f : Ω →ᵇ ℝ≥0) :
    Tendsto (fun i => (μs i).normalize.toFiniteMeasure.testAgainstNn f) F
      (𝓝 (μ.normalize.toFiniteMeasure.testAgainstNn f)) :=
  by
  have lim_mass := μs_lim.mass
  have aux : {(0 : ℝ≥0)}ᶜ ∈ 𝓝 μ.mass :=
    is_open_compl_singleton.mem_nhds (μ.mass_nonzero_iff.mpr nonzero)
  have eventually_nonzero : ∀ᶠ i in F, μs i ≠ 0 :=
    by
    simp_rw [← mass_nonzero_iff]
    exact lim_mass aux
  have eve :
    ∀ᶠ i in F,
      (μs i).normalize.toFiniteMeasure.testAgainstNn f = (μs i).mass⁻¹ * (μs i).testAgainstNn f :=
    by
    filter_upwards [eventually_iff.mp eventually_nonzero]
    intro i hi
    apply normalize_test_against_nn _ hi
  simp_rw [tendsto_congr' eve, μ.normalize_test_against_nn nonzero]
  have lim_pair :
    tendsto (fun i => (⟨(μs i).mass⁻¹, (μs i).testAgainstNn f⟩ : ℝ≥0 × ℝ≥0)) F
      (𝓝 ⟨μ.mass⁻¹, μ.test_against_nn f⟩) :=
    by
    refine' (Prod.tendsto_iff _ _).mpr ⟨_, _⟩
    · exact (continuous_on_inv₀.continuous_at aux).Tendsto.comp lim_mass
    · exact tendsto_iff_forall_test_against_nn_tendsto.mp μs_lim f
  exact tendsto_mul.comp lim_pair
#align measure_theory.finite_measure.tendsto_normalize_test_against_nn_of_tendsto MeasureTheory.FiniteMeasure.tendsto_normalize_testAgainstNn_of_tendsto

/-- If the normalized versions of finite measures converge weakly and their total masses
also converge, then the finite measures themselves converge weakly. -/
theorem tendsto_of_tendsto_normalize_test_against_nn_of_tendsto_mass {γ : Type _} {F : Filter γ}
    {μs : γ → FiniteMeasure Ω} (μs_lim : Tendsto (fun i => (μs i).normalize) F (𝓝 μ.normalize))
    (mass_lim : Tendsto (fun i => (μs i).mass) F (𝓝 μ.mass)) : Tendsto μs F (𝓝 μ) :=
  by
  rw [tendsto_iff_forall_test_against_nn_tendsto]
  exact fun f =>
    tendsto_test_against_nn_of_tendsto_normalize_test_against_nn_of_tendsto_mass μs_lim mass_lim f
#align measure_theory.finite_measure.tendsto_of_tendsto_normalize_test_against_nn_of_tendsto_mass MeasureTheory.FiniteMeasure.tendsto_of_tendsto_normalize_test_against_nn_of_tendsto_mass

/-- If finite measures themselves converge weakly to a nonzero limit measure, then their
normalized versions also converge weakly. -/
theorem tendsto_normalize_of_tendsto {γ : Type _} {F : Filter γ} {μs : γ → FiniteMeasure Ω}
    (μs_lim : Tendsto μs F (𝓝 μ)) (nonzero : μ ≠ 0) :
    Tendsto (fun i => (μs i).normalize) F (𝓝 μ.normalize) :=
  by
  rw [probability_measure.tendsto_nhds_iff_to_finite_measures_tendsto_nhds,
    tendsto_iff_forall_test_against_nn_tendsto]
  exact fun f => tendsto_normalize_test_against_nn_of_tendsto μs_lim nonzero f
#align measure_theory.finite_measure.tendsto_normalize_of_tendsto MeasureTheory.FiniteMeasure.tendsto_normalize_of_tendsto

/-- The weak convergence of finite measures to a nonzero limit can be characterized by the weak
convergence of both their normalized versions (probability measures) and their total masses. -/
theorem tendsto_normalize_iff_tendsto {γ : Type _} {F : Filter γ} {μs : γ → FiniteMeasure Ω}
    (nonzero : μ ≠ 0) :
    Tendsto (fun i => (μs i).normalize) F (𝓝 μ.normalize) ∧
        Tendsto (fun i => (μs i).mass) F (𝓝 μ.mass) ↔
      Tendsto μs F (𝓝 μ) :=
  by
  constructor
  · rintro ⟨normalized_lim, mass_lim⟩
    exact tendsto_of_tendsto_normalize_test_against_nn_of_tendsto_mass normalized_lim mass_lim
  · intro μs_lim
    refine' ⟨tendsto_normalize_of_tendsto μs_lim nonzero, μs_lim.mass⟩
#align measure_theory.finite_measure.tendsto_normalize_iff_tendsto MeasureTheory.FiniteMeasure.tendsto_normalize_iff_tendsto

end FiniteMeasure

--namespace
end NormalizeFiniteMeasure

-- section
end MeasureTheory


-- Copyright © 2019 François G. Dorais. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.

import .basic
import .semigroup
import .unital

set_option default_priority 0

namespace algebra

signature monoid (α : Type*) :=
(op : α → α → α)
(id : α)

namespace monoid_sig
variables {α : Type*} (s : monoid_sig α)

@[signature_instance]
definition to_semigroup : semigroup_sig α :=
{ op := s.op
}

@[signature_instance]
definition to_unital : unital_sig α :=
{ op := s.op
, id := s.id
}

end monoid_sig

variables {α : Type*} (s : monoid_sig α)

local infix ∙ := s.op
local notation `e` := s.id

@[theory]
class monoid : Prop := intro ::
(associative : identity.op_associative s.op)
(left_identity : identity.op_left_identity s.op s.id)
(right_identity : identity.op_right_identity s.op s.id)

namespace monoid
variable [i : monoid s]
include i

instance to_semigroup : semigroup s.to_semigroup := semigroup.infer _

instance to_unital : unital s.to_unital := unital.infer _

end monoid

@[theory]
class cancel_monoid : Prop := intro ::
(associative : identity.op_associative s.op)
(left_identity : identity.op_left_identity s.op s.id)
(right_identity : identity.op_right_identity s.op s.id)
(left_cancellative : identity.op_left_cancellative s.op)
(right_cancellative : identity.op_right_cancellative s.op)

namespace cancel_monoid
variable [i : cancel_monoid s]
include i

instance to_monoid : monoid s := monoid.infer _

instance to_cancel_semigroup : cancel_semigroup s.to_semigroup := cancel_semigroup.infer _

instance to_cancel_unital : cancel_unital s.to_unital := cancel_unital.infer _

end cancel_monoid

@[theory]
class comm_monoid : Prop := intro ::
(associative : identity.op_associative s.op)
(commutative : identity.op_commutative s.op)
(right_identity : identity.op_right_identity s.op s.id)

namespace comm_monoid
variables [i : comm_monoid s]
include i

@[identity_instance]
theorem left_identity : identity.op_left_identity s.op s.id :=
λ x, show e ∙ x = x, from calc _
= x ∙ e : by rw op_commutative s.op ...
= x : by rw op_right_identity s.op

instance to_monoid : monoid s := monoid.infer _

instance to_comm_semigroup : comm_semigroup s.to_semigroup := comm_semigroup.infer _

instance to_comm_unital : comm_unital s.to_unital := comm_unital.infer _

end comm_monoid

@[theory]
class cancel_comm_monoid : Prop := intro ::
(associative : identity.op_associative s.op)
(commutative : identity.op_commutative s.op)
(right_identity : identity.op_right_identity s.op s.id)
(right_cancellative : identity.op_right_cancellative s.op)

namespace cancel_comm_monoid
variable [i : cancel_comm_monoid s]
include i

instance to_comm_monoid : comm_monoid s := comm_monoid.infer _

instance to_cancel_comm_semigroup : cancel_comm_semigroup s.to_semigroup := cancel_comm_semigroup.infer _

instance to_cancel_monoid : cancel_monoid s := cancel_monoid.infer _

instance to_cancel_comm_unital : cancel_comm_unital s.to_unital := cancel_comm_unital.infer _

end cancel_comm_monoid

@[theory]
class left_monoid_action {β : Type*} (t : left_action_sig α β) : Prop := intro ::
(left_compatible : identity.op_left_compatible t.act s.op)
(left_identity : identity.op_left_identity t.act s.id)

@[theory]
class right_monoid_action {β : Type*} (t : right_action_sig α β) : Prop := intro ::
(right_compatible : identity.op_right_compatible t.act s.op)
(right_identity : identity.op_right_identity t.act s.id)

end algebra


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

import data.mv_polynomial.rename

/-!

# Monad operations on `mv_polynomial`

This file defines two monadic operations on `mv_polynomial`. Given `p : mv_polynomial σ R`,

* `mv_polynomial.bind₁` and `mv_polynomial.join₁` operate on the variable type `σ`.
* `mv_polynomial.bind₂` and `mv_polynomial.join₂` operate on the coefficient type `R`.

- `mv_polynomial.bind₁ f φ` with `f : σ → mv_polynomial τ R` and `φ : mv_polynomial σ R`,
  is the polynomial `φ(f 1, ..., f i, ...) : mv_polynomial τ R`.
- `mv_polynomial.join₁ φ` with `φ : mv_polynomial (mv_polynomial σ R) R` collapses `φ` to
  a `mv_polynomial σ R`, by evaluating `φ` under the map `X f ↦ f` for `f : mv_polynomial σ R`.
  In other words, if you have a polynomial `φ` in a set of variables indexed by a polynomial ring,
  you evaluate the polynomial in these indexing polynomials.
- `mv_polynomial.bind₂ f φ` with `f : R →+* mv_polynomial σ S` and `φ : mv_polynomial σ R`
  is the `mv_polynomial σ S` obtained from `φ` by mapping the coefficients of `φ` through `f`
  and considering the resulting polynomial as polynomial expression in `mv_polynomial σ R`.
- `mv_polynomial.join₂ φ` with `φ : mv_polynomial σ (mv_polynomial σ R)` collapses `φ` to
  a `mv_polynomial σ R`, by considering `φ` as polynomial expression in `mv_polynomial σ R`.

These operations themselves have algebraic structure: `mv_polynomial.bind₁`
and `mv_polynomial.join₁` are algebra homs and
`mv_polynomial.bind₂` and `mv_polynomial.join₂` are ring homs.

They interact in convenient ways with `mv_polynomial.rename`, `mv_polynomial.map`,
`mv_polynomial.vars`, and other polynomial operations.
Indeed, `mv_polynomial.rename` is the "map" operation for the (`bind₁`, `join₁`) pair,
whereas `mv_polynomial.map` is the "map" operation for the other pair.

## Implementation notes

We add an `is_lawful_monad` instance for the (`bind₁`, `join₁`) pair.
The second pair cannot be instantiated as a `monad`,
since it is not a monad in `Type` but in `CommRing` (or rather `CommSemiRing`).

-/

open_locale big_operators
noncomputable theory
namespace mv_polynomial
open finsupp

variables {σ : Type*} {τ : Type*}
variables {R S T : Type*} [comm_semiring R] [comm_semiring S] [comm_semiring T]

/--
`bind₁` is the "left hand side" bind operation on `mv_polynomial`, operating on the variable type.
Given a polynomial `p : mv_polynomial σ R` and a map `f : σ → mv_polynomial τ R` taking variables
in `p` to polynomials in the variable type `τ`, `bind₁ f p` replaces each variable in `p` with
its value under `f`, producing a new polynomial in `τ`. The coefficient type remains the same.
This operation is an algebra hom.
-/
def bind₁ (f : σ → mv_polynomial τ R) : mv_polynomial σ R →ₐ[R] mv_polynomial τ R :=
aeval f

/--
`bind₂` is the "right hand side" bind operation on `mv_polynomial`,
operating on the coefficient type.
Given a polynomial `p : mv_polynomial σ R` and
a map `f : R → mv_polynomial σ S` taking coefficients in `p` to polynomials over a new ring `S`,
`bind₂ f p` replaces each coefficient in `p` with its value under `f`,
producing a new polynomial over `S`.
The variable type remains the same. This operation is a ring hom.
-/
def bind₂ (f : R →+* mv_polynomial σ S) : mv_polynomial σ R →+* mv_polynomial σ S :=
eval₂_hom f X

/--
`join₁` is the monadic join operation corresponding to `mv_polynomial.bind₁`. Given a polynomial `p`
with coefficients in `R` whose variables are polynomials in `σ` with coefficients in `R`,
`join₁ p` collapses `p` to a polynomial with variables in `σ` and coefficients in `R`.
This operation is an algebra hom.
-/
def join₁ : mv_polynomial (mv_polynomial σ R) R →ₐ[R] mv_polynomial σ R :=
aeval id

/--
`join₂` is the monadic join operation corresponding to `mv_polynomial.bind₂`. Given a polynomial `p`
with variables in `σ` whose coefficients are polynomials in `σ` with coefficients in `R`,
`join₂ p` collapses `p` to a polynomial with variables in `σ` and coefficients in `R`.
This operation is a ring hom.
-/
def join₂ : mv_polynomial σ (mv_polynomial σ R) →+* mv_polynomial σ R :=
eval₂_hom (ring_hom.id _) X

@[simp] lemma aeval_eq_bind₁ (f : σ → mv_polynomial τ R) :
  aeval f = bind₁ f := rfl

@[simp] lemma eval₂_hom_C_eq_bind₁ (f : σ → mv_polynomial τ R) :
  eval₂_hom C f = bind₁ f := rfl

@[simp] lemma eval₂_hom_eq_bind₂ (f : R →+* mv_polynomial σ S) :
  eval₂_hom f X = bind₂ f := rfl

section
variables (σ R)
@[simp] lemma aeval_id_eq_join₁ :
  aeval id = @join₁ σ R _ := rfl

lemma eval₂_hom_C_id_eq_join₁ (φ : mv_polynomial (mv_polynomial σ R) R) :
  eval₂_hom C id φ = join₁ φ := rfl

@[simp] lemma eval₂_hom_id_X_eq_join₂ :
  eval₂_hom (ring_hom.id _) X = @join₂ σ R _ := rfl

end

-- In this file, we don't want to use these simp lemmas,
-- because we first need to show how these new definitions interact
-- and the proofs fall back on unfolding the definitions and call simp afterwards

local attribute [-simp] aeval_eq_bind₁ eval₂_hom_C_eq_bind₁ eval₂_hom_eq_bind₂
                        aeval_id_eq_join₁ eval₂_hom_id_X_eq_join₂

@[simp]
lemma bind₁_X_right (f : σ → mv_polynomial τ R) (i : σ) : bind₁ f (X i) = f i :=
aeval_X f i

@[simp]
lemma bind₂_X_right (f : R →+* mv_polynomial σ S) (i : σ) : bind₂ f (X i) = X i :=
eval₂_hom_X' f X i

@[simp]
lemma bind₁_X_left : bind₁ (X : σ → mv_polynomial σ R) = alg_hom.id R _ :=
by { ext1 i, simp }

lemma aeval_X_left : aeval (X : σ → mv_polynomial σ R) = alg_hom.id R _ :=
by rw [aeval_eq_bind₁, bind₁_X_left]

lemma aeval_X_left_apply (φ : mv_polynomial σ R) : aeval X φ = φ :=
by rw [aeval_eq_bind₁, bind₁_X_left, alg_hom.id_apply]

variable (f : σ → mv_polynomial τ R)

@[simp]
lemma bind₁_C_right (f : σ → mv_polynomial τ R) (x) : bind₁ f (C x) = C x :=
by simp [bind₁, C, aeval_monomial, finsupp.prod_zero_index]; refl

@[simp]
lemma bind₂_C_right (f : R →+* mv_polynomial σ S) (r : R) : bind₂ f (C r) = f r :=
eval₂_hom_C f X r

@[simp]
lemma bind₂_C_left : bind₂ (C : R →+* mv_polynomial σ R) = ring_hom.id _ :=
by { ext1; simp }

@[simp]
lemma bind₂_comp_C (f : R →+* mv_polynomial σ S) :
  (bind₂ f).comp C = f :=
ring_hom.ext $ bind₂_C_right _

@[simp]
lemma join₂_map (f : R →+* mv_polynomial σ S) (φ : mv_polynomial σ R) :
  join₂ (map f φ) = bind₂ f φ :=
by simp only [join₂, bind₂, eval₂_hom_map_hom, ring_hom.id_comp]

@[simp]
lemma join₂_comp_map (f : R →+* mv_polynomial σ S) :
  join₂.comp (map f) = bind₂ f :=
ring_hom.ext $ join₂_map _

lemma aeval_id_rename (f : σ → mv_polynomial τ R) (p : mv_polynomial σ R) :
  aeval id (rename f p) = aeval f p :=
by rw [aeval_rename, function.comp.left_id]

@[simp]
lemma join₁_rename (f : σ → mv_polynomial τ R) (φ : mv_polynomial σ R) :
  join₁ (rename f φ) = bind₁ f φ :=
aeval_id_rename _ _

@[simp]
lemma bind₁_id : bind₁ (@id (mv_polynomial σ R)) = join₁ := rfl

@[simp]
lemma bind₂_id : bind₂ (ring_hom.id (mv_polynomial σ R)) = join₂ := rfl

lemma bind₁_bind₁ {υ : Type*} (f : σ → mv_polynomial τ R) (g : τ → mv_polynomial υ R)
  (φ : mv_polynomial σ R) :
  (bind₁ g) (bind₁ f φ) = bind₁ (λ i, bind₁ g (f i)) φ :=
by simp [bind₁, ← comp_aeval]

lemma bind₁_comp_bind₁ {υ : Type*} (f : σ → mv_polynomial τ R) (g : τ → mv_polynomial υ R) :
  (bind₁ g).comp (bind₁ f) = bind₁ (λ i, bind₁ g (f i)) :=
by { ext1, apply bind₁_bind₁ }

lemma bind₂_comp_bind₂ (f : R →+* mv_polynomial σ S) (g : S →+* mv_polynomial σ T) :
  (bind₂ g).comp (bind₂ f) = bind₂ ((bind₂ g).comp f) :=
by { ext1; simp }

lemma bind₂_bind₂ (f : R →+* mv_polynomial σ S) (g : S →+* mv_polynomial σ T)
  (φ : mv_polynomial σ R) :
  (bind₂ g) (bind₂ f φ) = bind₂ ((bind₂ g).comp f) φ :=
ring_hom.congr_fun (bind₂_comp_bind₂ f g) φ

lemma rename_comp_bind₁ {υ : Type*} (f : σ → mv_polynomial τ R) (g : τ → υ) :
  (rename g).comp (bind₁ f) = bind₁ (λ i, rename g $ f i) :=
by { ext1 i, simp }

lemma rename_bind₁ {υ : Type*} (f : σ → mv_polynomial τ R) (g : τ → υ) (φ : mv_polynomial σ R) :
  rename g (bind₁ f φ) = bind₁ (λ i, rename g $ f i) φ :=
alg_hom.congr_fun (rename_comp_bind₁ f g) φ

lemma map_bind₂ (f : R →+* mv_polynomial σ S) (g : S →+* T) (φ : mv_polynomial σ R) :
  map g (bind₂ f φ) = bind₂ ((map g).comp f) φ :=
begin
  simp only [bind₂, eval₂_comp_right, coe_eval₂_hom, eval₂_map],
  congr' 1 with : 1,
  simp only [function.comp_app, map_X]
end

lemma bind₁_comp_rename {υ : Type*} (f : τ → mv_polynomial υ R) (g : σ → τ) :
  (bind₁ f).comp (rename g) = bind₁ (f ∘ g) :=
by { ext1 i, simp }

lemma bind₁_rename {υ : Type*} (f : τ → mv_polynomial υ R) (g : σ → τ) (φ : mv_polynomial σ R) :
  bind₁ f (rename g φ) = bind₁ (f ∘ g) φ :=
alg_hom.congr_fun (bind₁_comp_rename f g) φ

lemma bind₂_map (f : S →+* mv_polynomial σ T) (g : R →+* S) (φ : mv_polynomial σ R) :
  bind₂ f (map g φ) = bind₂ (f.comp g) φ :=
by simp [bind₂]

@[simp]
lemma map_comp_C (f : R →+* S) : (map f).comp (C : R →+* mv_polynomial σ R) = C.comp f :=
by { ext1, apply map_C }

-- mixing the two monad structures

lemma map_bind₁ (f : R →+* S) (g : σ → mv_polynomial τ R) (φ : mv_polynomial σ R) :
  map f (bind₁ g φ) = bind₁ (λ (i : σ), (map f) (g i)) (map f φ) :=
by { rw [hom_bind₁, map_comp_C, ← eval₂_hom_map_hom], refl }

@[simp]
lemma eval₂_hom_comp_C (f : R →+* S) (g : σ → S) :
  (eval₂_hom f g).comp C = f :=
by { ext1 r, exact eval₂_C f g r }

lemma eval₂_hom_bind₁ (f : R →+* S) (g : τ → S) (h : σ → mv_polynomial τ R)
  (φ : mv_polynomial σ R) :
  eval₂_hom f g (bind₁ h φ) = eval₂_hom f (λ i, eval₂_hom f g (h i)) φ :=
by rw [hom_bind₁, eval₂_hom_comp_C]

lemma aeval_bind₁ [algebra R S] (f : τ → S) (g : σ → mv_polynomial τ R) (φ : mv_polynomial σ R) :
  aeval f (bind₁ g φ) = aeval (λ i, aeval f (g i)) φ :=
eval₂_hom_bind₁ _ _ _ _

lemma aeval_comp_bind₁ [algebra R S] (f : τ → S) (g : σ → mv_polynomial τ R) :
  (aeval f).comp (bind₁ g) = aeval (λ i, aeval f (g i)) :=
by { ext1, apply aeval_bind₁ }

lemma eval₂_hom_comp_bind₂ (f : S →+* T) (g : σ → T) (h : R →+* mv_polynomial σ S) :
  (eval₂_hom f g).comp (bind₂ h) = eval₂_hom ((eval₂_hom f g).comp h) g :=
by { ext1; simp }

lemma eval₂_hom_bind₂ (f : S →+* T) (g : σ → T) (h : R →+* mv_polynomial σ S)
  (φ : mv_polynomial σ R) :
  eval₂_hom f g (bind₂ h φ) = eval₂_hom ((eval₂_hom f g).comp h) g φ :=
ring_hom.congr_fun (eval₂_hom_comp_bind₂ f g h) φ

lemma aeval_bind₂ [algebra S T] (f : σ → T) (g : R →+* mv_polynomial σ S) (φ : mv_polynomial σ R) :
  aeval f (bind₂ g φ) = eval₂_hom ((↑(aeval f : _ →ₐ[S] _) : _ →+* _).comp g) f φ :=
eval₂_hom_bind₂ _ _ _ _

lemma eval₂_hom_C_left (f : σ → mv_polynomial τ R) : eval₂_hom C f = bind₁ f := rfl

lemma bind₁_monomial (f : σ → mv_polynomial τ R) (d : σ →₀ ℕ) (r : R) :
  bind₁ f (monomial d r) = C r * ∏ i in d.support, f i ^ d i :=
by simp only [monomial_eq, alg_hom.map_mul, bind₁_C_right, finsupp.prod,
  alg_hom.map_prod, alg_hom.map_pow, bind₁_X_right]

lemma bind₂_monomial (f : R →+* mv_polynomial σ S) (d : σ →₀ ℕ) (r : R) :
  bind₂ f (monomial d r) = f r * monomial d 1 :=
by simp only [monomial_eq, ring_hom.map_mul, bind₂_C_right, finsupp.prod,
  ring_hom.map_prod, ring_hom.map_pow, bind₂_X_right, C_1, one_mul]

@[simp]
lemma bind₂_monomial_one (f : R →+* mv_polynomial σ S) (d : σ →₀ ℕ) :
  bind₂ f (monomial d 1) = monomial d 1 :=
by rw [bind₂_monomial, f.map_one, one_mul]

instance monad : monad (λ σ, mv_polynomial σ R) :=
{ map := λ α β f p, rename f p,
  pure := λ _, X,
  bind := λ _ _ p f, bind₁ f p }

instance is_lawful_functor : is_lawful_functor (λ σ, mv_polynomial σ R) :=
{ id_map := by intros; simp [(<$>)],
  comp_map := by intros; simp [(<$>)] }

instance is_lawful_monad : is_lawful_monad (λ σ, mv_polynomial σ R) :=
{ pure_bind := by intros; simp [pure, bind],
  bind_assoc := by intros; simp [bind, ← bind₁_comp_bind₁] }

/-
Possible TODO for the future:
Enable the following definitions, and write a lot of supporting lemmas.

def bind (f : R →+* mv_polynomial τ S) (g : σ → mv_polynomial τ S) :
  mv_polynomial σ R →+* mv_polynomial τ S :=
eval₂_hom f g

def join (f : R →+* S) : mv_polynomial (mv_polynomial σ R) S →ₐ[S] mv_polynomial σ S :=
aeval (map f)

def ajoin [algebra R S] : mv_polynomial (mv_polynomial σ R) S →ₐ[S] mv_polynomial σ S :=
join (algebra_map R S)

-/

end mv_polynomial


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury G. Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.basic
import Mathlib.logic.function.iterate
import Mathlib.data.nat.basic
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Inequalities on iterates

In this file we prove some inequalities comparing `f^[n] x` and `g^[n] x` where `f` and `g` are
two self-maps that commute with each other.

Current selection of inequalities is motivated by formalization of the rotation number of
a circle homeomorphism.
-/

namespace monotone

theorem seq_le_seq {α : Type u_1} [preorder α] {f : α → α} {x : ℕ → α} {y : ℕ → α} (hf : monotone f) (n : ℕ) (h₀ : x 0 ≤ y 0) (hx : ∀ (k : ℕ), k < n → x (k + 1) ≤ f (x k)) (hy : ∀ (k : ℕ), k < n → f (y k) ≤ y (k + 1)) : x n ≤ y n := sorry

theorem seq_pos_lt_seq_of_lt_of_le {α : Type u_1} [preorder α] {f : α → α} {x : ℕ → α} {y : ℕ → α} (hf : monotone f) {n : ℕ} (hn : 0 < n) (h₀ : x 0 ≤ y 0) (hx : ∀ (k : ℕ), k < n → x (k + 1) < f (x k)) (hy : ∀ (k : ℕ), k < n → f (y k) ≤ y (k + 1)) : x n < y n := sorry

theorem seq_pos_lt_seq_of_le_of_lt {α : Type u_1} [preorder α] {f : α → α} {x : ℕ → α} {y : ℕ → α} (hf : monotone f) {n : ℕ} (hn : 0 < n) (h₀ : x 0 ≤ y 0) (hx : ∀ (k : ℕ), k < n → x (k + 1) ≤ f (x k)) (hy : ∀ (k : ℕ), k < n → f (y k) < y (k + 1)) : x n < y n :=
  seq_pos_lt_seq_of_lt_of_le (monotone.order_dual hf) hn h₀ hy hx

theorem seq_lt_seq_of_lt_of_le {α : Type u_1} [preorder α] {f : α → α} {x : ℕ → α} {y : ℕ → α} (hf : monotone f) (n : ℕ) (h₀ : x 0 < y 0) (hx : ∀ (k : ℕ), k < n → x (k + 1) < f (x k)) (hy : ∀ (k : ℕ), k < n → f (y k) ≤ y (k + 1)) : x n < y n := sorry

theorem seq_lt_seq_of_le_of_lt {α : Type u_1} [preorder α] {f : α → α} {x : ℕ → α} {y : ℕ → α} (hf : monotone f) (n : ℕ) (h₀ : x 0 < y 0) (hx : ∀ (k : ℕ), k < n → x (k + 1) ≤ f (x k)) (hy : ∀ (k : ℕ), k < n → f (y k) < y (k + 1)) : x n < y n :=
  seq_lt_seq_of_lt_of_le (monotone.order_dual hf) n h₀ hy hx

end monotone

namespace function

namespace commute

theorem iterate_le_of_map_le {α : Type u_1} [preorder α] {f : α → α} {g : α → α} (h : commute f g) (hf : monotone f) (hg : monotone g) {x : α} (hx : f x ≤ g x) (n : ℕ) : nat.iterate f n x ≤ nat.iterate g n x := sorry

theorem iterate_pos_lt_of_map_lt {α : Type u_1} [preorder α] {f : α → α} {g : α → α} (h : commute f g) (hf : monotone f) (hg : strict_mono g) {x : α} (hx : f x < g x) {n : ℕ} (hn : 0 < n) : nat.iterate f n x < nat.iterate g n x := sorry

theorem iterate_pos_lt_of_map_lt' {α : Type u_1} [preorder α] {f : α → α} {g : α → α} (h : commute f g) (hf : strict_mono f) (hg : monotone g) {x : α} (hx : f x < g x) {n : ℕ} (hn : 0 < n) : nat.iterate f n x < nat.iterate g n x :=
  iterate_pos_lt_of_map_lt (symm h) (monotone.order_dual hg) (strict_mono.order_dual hf) hx hn

theorem iterate_pos_lt_iff_map_lt {α : Type u_1} [linear_order α] {f : α → α} {g : α → α} (h : commute f g) (hf : monotone f) (hg : strict_mono g) {x : α} {n : ℕ} (hn : 0 < n) : nat.iterate f n x < nat.iterate g n x ↔ f x < g x := sorry

theorem iterate_pos_lt_iff_map_lt' {α : Type u_1} [linear_order α] {f : α → α} {g : α → α} (h : commute f g) (hf : strict_mono f) (hg : monotone g) {x : α} {n : ℕ} (hn : 0 < n) : nat.iterate f n x < nat.iterate g n x ↔ f x < g x :=
  iterate_pos_lt_iff_map_lt (symm h) (monotone.order_dual hg) (strict_mono.order_dual hf) hn

theorem iterate_pos_le_iff_map_le {α : Type u_1} [linear_order α] {f : α → α} {g : α → α} (h : commute f g) (hf : monotone f) (hg : strict_mono g) {x : α} {n : ℕ} (hn : 0 < n) : nat.iterate f n x ≤ nat.iterate g n x ↔ f x ≤ g x := sorry

theorem iterate_pos_le_iff_map_le' {α : Type u_1} [linear_order α] {f : α → α} {g : α → α} (h : commute f g) (hf : strict_mono f) (hg : monotone g) {x : α} {n : ℕ} (hn : 0 < n) : nat.iterate f n x ≤ nat.iterate g n x ↔ f x ≤ g x := sorry

theorem iterate_pos_eq_iff_map_eq {α : Type u_1} [linear_order α] {f : α → α} {g : α → α} (h : commute f g) (hf : monotone f) (hg : strict_mono g) {x : α} {n : ℕ} (hn : 0 < n) : nat.iterate f n x = nat.iterate g n x ↔ f x = g x := sorry

end commute

end function

namespace monotone

/-- If `f ≤ g` and `f` is monotone, then `f^[n] ≤ g^[n]`. -/
theorem iterate_le_of_le {α : Type u_1} [preorder α] {f : α → α} {g : α → α} (hf : monotone f) (h : f ≤ g) (n : ℕ) : nat.iterate f n ≤ nat.iterate g n := sorry

/-- If `f ≤ g` and `f` is monotone, then `f^[n] ≤ g^[n]`. -/
theorem iterate_ge_of_ge {α : Type u_1} [preorder α] {f : α → α} {g : α → α} (hg : monotone g) (h : f ≤ g) (n : ℕ) : nat.iterate f n ≤ nat.iterate g n :=
  iterate_le_of_le (monotone.order_dual hg) h n


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

import analysis.normed_space.star.gelfand_duality
import topology.algebra.star_subalgebra

/-! # Continuous functional calculus

In this file we construct the `continuous_functional_calculus` for a normal element `a` of a
(unital) C⋆-algebra over `ℂ`. This is a star algebra equivalence
`C(spectrum ℂ a, ℂ) ≃⋆ₐ[ℂ] elemental_star_algebra ℂ a` which sends the (restriction of) the
identity map `continuous_map.id ℂ` to the (unique) preimage of `a` under the coercion of
`elemental_star_algebra ℂ a` to `A`.

Being a star algebra equivalence between C⋆-algebras, this map is continuous (even an isometry),
and by the Stone-Weierstrass theorem it is the unique star algebra equivalence which extends the
polynomial functional calculus (i.e., `polynomial.aeval`).

For any continuous function `f : spectrum ℂ a →  ℂ`, this makes it possible to define an element
`f a` (not valid notation) in the original algebra, which heuristically has the same eigenspaces as
`a` and acts on eigenvector of `a` for an eigenvalue `λ` as multiplication by `f λ`. This
description is perfectly accurate in finite dimension, but only heuristic in infinite dimension as
there might be no genuine eigenvector. In particular, when `f` is a polynomial `∑ cᵢ Xⁱ`, then
`f a` is `∑ cᵢ aⁱ`. Also, `id a = a`.

This file also includes a proof of the **spectral permanence** theorem for (unital) C⋆-algebras
(see `star_subalgebra.spectrum_eq`)

## Main definitions

* `continuous_functional_calculus : C(spectrum ℂ a, ℂ) ≃⋆ₐ[ℂ] elemental_star_algebra ℂ a`: this
  is the composition of the inverse of the `gelfand_star_transform` with the natural isomorphism
  induced by the homeomorphism `elemental_star_algebra.character_space_homeo`.
* `elemental_star_algebra.character_space_homeo :
  `character_space ℂ (elemental_star_algebra ℂ a) ≃ₜ spectrum ℂ a`: this homeomorphism is defined
  by evaluating a character `φ` at `a`, and noting that `φ a ∈ spectrum ℂ a` since `φ` is an
  algebra homomorphism. Moreover, this map is continuous and bijective and since the spaces involved
  are compact Hausdorff, it is a homeomorphism.

## Main statements

* `star_subalgebra.coe_is_unit`: for `x : S` in a C⋆-subalgebra `S` of `A`, then `↑x : A` is a unit
  if and only if `x` is a unit.
* `star_subalgebra.spectrum_eq`: **spectral_permanence** for `x : S`, where `S` is a C⋆-subalgebra
  of `A`, `spectrum ℂ x = spectrum ℂ (x : A)`.

## Notes

The result we have established here is the strongest possible, but it is likely not the version
which will be most useful in practice. Future work will include developing an appropriate API for
the continuous functional calculus (including one for real-valued functions with real argument that
applies to self-adjoint elements of the algebra). -/

open_locale pointwise ennreal nnreal complex_order

open weak_dual weak_dual.character_space elemental_star_algebra

variables {A : Type*} [normed_ring A] [normed_algebra ℂ A]
variables [star_ring A] [cstar_ring A] [star_module ℂ A]

instance {R A : Type*} [comm_ring R] [star_ring R] [normed_ring A] [algebra R A] [star_ring A]
  [has_continuous_star A] [star_module R A] (a : A) [is_star_normal a] :
  normed_comm_ring (elemental_star_algebra R a) :=
{ mul_comm := mul_comm, .. subring_class.to_normed_ring (elemental_star_algebra R a) }

instance {R A : Type*} [normed_field R] [star_ring R] [normed_ring A] [normed_algebra R A]
  [star_ring A] [has_continuous_star A] [star_module R A] (a : A) :
  normed_algebra R (elemental_star_algebra R a) :=
star_subalgebra.to_normed_algebra (elemental_star_algebra R a)

instance {R A : Type*} [normed_field R] [star_ring R] [normed_ring A] [normed_algebra R A]
  [star_ring A] [has_continuous_star A] [star_module R A] (a : A) :
  normed_space R (elemental_star_algebra R a) :=
normed_algebra.to_normed_space _

-- without this instance type class search causes timeouts
noncomputable instance elemental_star_algebra.complex.normed_algebra (a : A) :
  normed_algebra ℂ (elemental_star_algebra ℂ a) :=
infer_instance

variables [complete_space A] (a : A) [is_star_normal a] (S : star_subalgebra ℂ A)

/-- This lemma is used in the proof of `star_subalgebra.is_unit_of_is_unit_of_is_star_normal`,
which in turn is the key to spectral permanence `star_subalgebra.spectrum_eq`, which is itself
necessary for the continuous functional calculus. Using the continuous functional calculus, this
lemma can be superseded by one that omits the `is_star_normal` hypothesis. -/
lemma spectrum_star_mul_self_of_is_star_normal :
  spectrum ℂ (star a * a) ⊆ set.Icc (0 : ℂ) (‖star a * a‖) :=
begin
  -- this instance should be found automatically, but without providing it Lean goes on a wild
  -- goose chase when trying to apply `spectrum.gelfand_transform_eq`.
  letI := elemental_star_algebra.complex.normed_algebra a,
  unfreezingI { rcases subsingleton_or_nontrivial A },
  { simp only [spectrum.of_subsingleton, set.empty_subset] },
  { set a' : elemental_star_algebra ℂ a := ⟨a, self_mem ℂ a⟩,
    refine (spectrum.subset_star_subalgebra (star a' * a')).trans _,
    rw [←spectrum.gelfand_transform_eq (star a' * a'), continuous_map.spectrum_eq_range],
    rintro - ⟨φ, rfl⟩,
    rw [gelfand_transform_apply_apply ℂ _ (star a' * a') φ, map_mul φ, map_star φ],
    rw [complex.eq_coe_norm_of_nonneg star_mul_self_nonneg, ←map_star, ←map_mul],
    exact ⟨complex.zero_le_real.2 (norm_nonneg _),
      complex.real_le_real.2 (alg_hom.norm_apply_le_self φ (star a' * a'))⟩, }
end

variables {a}

/-- This is the key lemma on the way to establishing spectral permanence for C⋆-algebras, which is
established in `star_subalgebra.spectrum_eq`. This lemma is superseded by
`star_subalgebra.coe_is_unit`, which does not require an `is_star_normal` hypothesis and holds for
any closed star subalgebra. -/
lemma elemental_star_algebra.is_unit_of_is_unit_of_is_star_normal (h : is_unit a) :
  is_unit (⟨a, self_mem ℂ a⟩ : elemental_star_algebra ℂ a) :=
begin
  /- Sketch of proof: Because `a` is normal, it suffices to prove that `star a * a` is invertible
  in `elemental_star_algebra ℂ a`. For this it suffices to prove that it is sufficiently close to a
  unit, namely `algebra_map ℂ _ ‖star a * a‖`, and in this case the required distance is
  `‖star a * a‖`. So one must show `‖star a * a - algebra_map ℂ _ ‖star a * a‖‖ < ‖star a * a‖`.
  Since `star a * a - algebra_map ℂ _ ‖star a * a‖` is selfadjoint, by a corollary of Gelfand's
  formula for the spectral radius (`is_self_adjoint.spectral_radius_eq_nnnorm`) its norm is the
  supremum of the norms of elements in its spectrum (we may use the spectrum in `A` here because
  the norm in `A` and the norm in the subalgebra coincide).

  By `spectrum_star_mul_self_of_is_star_normal`, the spectrum (in the algebra `A`) of `star a * a`
  is contained in the interval `[0, ‖star a * a‖]`, and since `a` (and hence `star a * a`) is
  invertible in `A`, we may omit `0` from this interval. Therefore, by basic spectral mapping
  properties, the spectrum (in the algebra `A`) of `star a * a - algebra_map ℂ _ ‖star a * a‖` is
  contained in `[0, ‖star a * a‖)`. The supremum of the (norms of) elements of the spectrum must be
  *strictly* less that `‖star a * a‖` because the spectrum is compact, which completes the proof. -/

  /- We may assume `A` is nontrivial. It suffices to show that `star a * a` is invertible in the
  commutative (because `a` is normal) ring `elemental_star_algebra ℂ a`. Indeed, by commutativity,
  if `star a * a` is invertible, then so is `a`. -/
  nontriviality A,
  set a' : elemental_star_algebra ℂ a := ⟨a, self_mem ℂ a⟩,
  suffices : is_unit (star a' * a'), from (is_unit.mul_iff.1 this).2,
  replace h := (show commute (star a) a, from star_comm_self' a).is_unit_mul_iff.2 ⟨h.star, h⟩,
  /- Since `a` is invertible, `‖star a * a‖ ≠ 0`, so `‖star a * a‖ • 1` is invertible in
  `elemental_star_algebra ℂ a`, and so it suffices to show that the distance between this unit and
  `star a * a` is less than `‖star a * a‖`. -/
  have h₁ : (‖star a * a‖ : ℂ) ≠ 0 := complex.of_real_ne_zero.mpr (norm_ne_zero_iff.mpr h.ne_zero),
  set u : units (elemental_star_algebra ℂ a) :=
    units.map (algebra_map ℂ (elemental_star_algebra ℂ a)).to_monoid_hom (units.mk0 _ h₁),
  refine ⟨u.unit_of_nearby _ _, rfl⟩,
  simp only [complex.abs_of_real, map_inv₀, units.coe_map, units.coe_inv, ring_hom.coe_monoid_hom,
    ring_hom.to_monoid_hom_eq_coe, units.coe_mk0, units.coe_map_inv, norm_algebra_map',
    inv_inv, complex.norm_eq_abs, abs_norm_eq_norm, subtype.val_eq_coe, coe_coe],
  /- Since `a` is invertible, by `spectrum_star_mul_self_of_is_star_normal`, the spectrum (in `A`)
  of `star a * a` is contained in the half-open interval `(0, ‖star a * a‖]`. Therefore, by basic
  spectral mapping properties, the spectrum of `‖star a * a‖ • 1 - star a * a` is contained in
  `[0, ‖star a * a‖)`. -/
  have h₂ : ∀ z ∈ spectrum ℂ (algebra_map ℂ A (‖star a * a‖) - star a * a), ‖z‖₊ < ‖star a * a‖₊,
  { intros z hz,
    rw [←spectrum.singleton_sub_eq, set.singleton_sub] at hz,
    have h₃ : z ∈ set.Icc (0 : ℂ) (‖star a * a‖),
    { replace hz := set.image_subset _ (spectrum_star_mul_self_of_is_star_normal a) hz,
      rwa [set.image_const_sub_Icc, sub_self, sub_zero] at hz },
    refine lt_of_le_of_ne (complex.real_le_real.1 $ complex.eq_coe_norm_of_nonneg h₃.1 ▸ h₃.2) _,
    { intros hz',
      replace hz' := congr_arg (λ (x : ℝ≥0), ((x : ℝ) : ℂ)) hz',
      simp only [coe_nnnorm] at hz',
      rw ←complex.eq_coe_norm_of_nonneg h₃.1 at hz',
      obtain ⟨w, hw₁, hw₂⟩ := hz,
      refine (spectrum.zero_not_mem_iff ℂ).mpr h _,
      rw [hz', sub_eq_self] at hw₂,
      rwa hw₂ at hw₁ } },
  /- The norm of `‖star a * a‖ • 1 - star a * a` in the subalgebra and in `A` coincide. In `A`,
  because this element is selfadjoint, by `is_self_adjoint.spectral_radius_eq_nnnorm`, its norm is
  the supremum of the norms of the elements of the spectrum, which is strictly less than
  `‖star a * a‖` by `h₂` and because the spectrum is compact. -/
  exact ennreal.coe_lt_coe.1
  (calc (‖star a' * a' - algebra_map ℂ _ (‖star a * a‖)‖₊ : ℝ≥0∞)
      = ‖algebra_map ℂ A (‖star a * a‖) - star a * a‖₊ : by { rw [←nnnorm_neg, neg_sub], refl }
  ... = spectral_radius ℂ (algebra_map ℂ A (‖star a * a‖) - star a * a)
      : begin
          refine (is_self_adjoint.spectral_radius_eq_nnnorm _).symm,
          rw [is_self_adjoint, star_sub, star_mul, star_star, ←algebra_map_star_comm,
            is_R_or_C.star_def, is_R_or_C.conj_of_real],
        end
  ... < ‖star a * a‖₊ : spectrum.spectral_radius_lt_of_forall_lt _ h₂ ),
end

/-- For `x : A` which is invertible in `A`, the inverse lies in any unital C⋆-subalgebra `S`
containing `x`. -/
lemma star_subalgebra.is_unit_coe_inv_mem {S : star_subalgebra ℂ A} (hS : is_closed (S : set A))
  {x : A} (h : is_unit x) (hxS : x ∈ S) : ↑h.unit⁻¹ ∈ S :=
begin
  have hx := h.star.mul h,
  suffices this : (↑hx.unit⁻¹ : A) ∈ S,
  { rw [←one_mul (↑h.unit⁻¹ : A), ←hx.unit.inv_mul, mul_assoc, is_unit.unit_spec, mul_assoc,
      h.mul_coe_inv, mul_one],
    exact mul_mem this (star_mem hxS) },
  refine le_of_is_closed_of_mem ℂ hS (mul_mem (star_mem hxS) hxS) _,
  haveI := (is_self_adjoint.star_mul_self x).is_star_normal,
  have hx' := elemental_star_algebra.is_unit_of_is_unit_of_is_star_normal hx,
  convert (↑hx'.unit⁻¹ : elemental_star_algebra ℂ (star x * x)).prop using 1,
  exact left_inv_eq_right_inv hx.unit.inv_mul (congr_arg coe hx'.unit.mul_inv),
end

/-- For a unital C⋆-subalgebra `S` of `A` and `x : S`, if `↑x : A` is invertible in `A`, then
`x` is invertible in `S`. -/
lemma star_subalgebra.coe_is_unit {S : star_subalgebra ℂ A} (hS : is_closed (S : set A)) {x : S} :
  is_unit (x : A) ↔ is_unit x :=
begin
  refine ⟨λ hx, ⟨⟨x, ⟨(↑hx.unit⁻¹ : A), star_subalgebra.is_unit_coe_inv_mem hS hx x.prop⟩, _, _⟩,
    rfl⟩, λ hx, hx.map S.subtype⟩,
  exacts [subtype.coe_injective hx.mul_coe_inv, subtype.coe_injective hx.coe_inv_mul],
end

lemma star_subalgebra.mem_spectrum_iff {S : star_subalgebra ℂ A} (hS : is_closed (S : set A))
  {x : S} {z : ℂ} : z ∈ spectrum ℂ x ↔ z ∈ spectrum ℂ (x : A) :=
not_iff_not.2 (star_subalgebra.coe_is_unit hS).symm

/-- **Spectral permanence.** The spectrum of an element is invariant of the (closed)
`star_subalgebra` in which it is contained. -/
lemma star_subalgebra.spectrum_eq {S : star_subalgebra ℂ A} (hS : is_closed (S : set A)) (x : S) :
  spectrum ℂ x = spectrum ℂ (x : A) :=
set.ext $ λ z, star_subalgebra.mem_spectrum_iff hS

variables (a)

/-- The natural map from `character_space ℂ (elemental_star_algebra ℂ x)` to `spectrum ℂ x` given
by evaluating `φ` at `x`. This is essentially just evaluation of the `gelfand_transform` of `x`,
but because we want something in `spectrum ℂ x`, as opposed to
`spectrum ℂ ⟨x, elemental_star_algebra.self_mem ℂ x⟩` there is slightly more work to do. -/
@[simps]
noncomputable def elemental_star_algebra.character_space_to_spectrum (x : A)
  (φ : character_space ℂ (elemental_star_algebra ℂ x)) : spectrum ℂ x :=
{ val := φ ⟨x, self_mem ℂ x⟩,
  property := by simpa only [star_subalgebra.spectrum_eq (elemental_star_algebra.is_closed ℂ x)
    ⟨x, self_mem ℂ x⟩] using alg_hom.apply_mem_spectrum φ (⟨x, self_mem ℂ x⟩) }

lemma elemental_star_algebra.continuous_character_space_to_spectrum (x : A) :
  continuous (elemental_star_algebra.character_space_to_spectrum x) :=
continuous_induced_rng.2
  (map_continuous $ gelfand_transform ℂ (elemental_star_algebra ℂ x) ⟨x, self_mem ℂ x⟩)

lemma elemental_star_algebra.bijective_character_space_to_spectrum :
  function.bijective (elemental_star_algebra.character_space_to_spectrum a) :=
begin
  refine ⟨λ φ ψ h, star_alg_hom_class_ext ℂ (map_continuous φ) (map_continuous ψ)
    (by simpa only [elemental_star_algebra.character_space_to_spectrum, subtype.mk_eq_mk,
      continuous_map.coe_mk] using h), _⟩,
  rintros ⟨z, hz⟩,
  have hz' := (star_subalgebra.spectrum_eq (elemental_star_algebra.is_closed ℂ a)
    ⟨a, self_mem ℂ a⟩).symm.subst hz,
  rw character_space.mem_spectrum_iff_exists at hz',
  obtain ⟨φ, rfl⟩ := hz',
  exact ⟨φ, rfl⟩,
end

/-- The homeomorphism between the character space of the unital C⋆-subalgebra generated by a
single normal element `a : A` and `spectrum ℂ a`. -/
noncomputable def elemental_star_algebra.character_space_homeo :
  character_space ℂ (elemental_star_algebra ℂ a) ≃ₜ spectrum ℂ a :=
@continuous.homeo_of_equiv_compact_to_t2 _ _ _ _ _ _
  (equiv.of_bijective (elemental_star_algebra.character_space_to_spectrum a)
    (elemental_star_algebra.bijective_character_space_to_spectrum a))
    (elemental_star_algebra.continuous_character_space_to_spectrum a)

/-- **Continuous functional calculus.** Given a normal element `a : A` of a unital C⋆-algebra,
the continuous functional calculus is a `star_alg_equiv` from the complex-valued continuous
functions on the spectrum of `a` to the unital C⋆-subalgebra generated by `a`. Moreover, this
equivalence identifies `(continuous_map.id ℂ).restrict (spectrum ℂ a))` with `a`; see
`continuous_functional_calculus_map_id`. As such it extends the polynomial functional calculus. -/
noncomputable def continuous_functional_calculus :
  C(spectrum ℂ a, ℂ) ≃⋆ₐ[ℂ] elemental_star_algebra ℂ a :=
((elemental_star_algebra.character_space_homeo a).comp_star_alg_equiv' ℂ ℂ).trans
  (gelfand_star_transform (elemental_star_algebra ℂ a)).symm

lemma continuous_functional_calculus_map_id :
  continuous_functional_calculus a ((continuous_map.id ℂ).restrict (spectrum ℂ a)) =
    ⟨a, self_mem ℂ a⟩ :=
star_alg_equiv.symm_apply_apply _ _


/-
Copyright (c) 2022 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/
import algebraic_geometry.prime_spectrum.basic
import ring_theory.dedekind_domain
import topology.algebra.valued_field

/-!
# Adic valuations on Dedekind domains
Given a Dedekind domain `R` of Krull dimension 1 and a maximal ideal `v` of `R`, we define the
`v`-adic valuation on `R` and its extension to the field of fractions `K` of `R`.
We prove several properties of this valuation, including the existence of uniformizers.

## Main definitions
 - `maximal_spectrum` defines the set of nonzero prime ideals of `R`. When `R` is a Dedekind domain
   of Krull dimension 1, this is the set of maximal ideals of `R`.
 - `maximal_spectrum.int_valuation v` is the `v`-adic valuation on `R`.
 - `maximal_spectrum.valuation v` is the `v`-adic valuation on `K`.

## Main results
- `int_valuation_le_one` : The `v`-adic valuation on `R` is bounded above by 1.
- `int_valuation_lt_one_iff_dvd` : The `v`-adic valuation of `r ∈ R` is less than 1 if and only if
  `v` divides the ideal `(r)`.
- `int_valuation_le_pow_iff_dvd` : The `v`-adic valuation of `r ∈ R` is less than or equal to
  `multiplicative.of_add (-n)` if and only if `vⁿ` divides the ideal `(r)`.
- `int_valuation_exists_uniformizer` : There exists `π ∈ R` with `v`-adic valuation
  `multiplicative.of_add (-1)`.
- `valuation_well_defined` : The valuation of `k ∈ K` is independent on how we express `k`
  as a fraction.
- `valuation_of_mk'` : The `v`-adic valuation of `r/s ∈ K` is the valuation of `r` divided by
  the valuation of `s`.
- `valuation_of_algebra_map` : The `v`-adic valuation on `K` extends the `v`-adic valuation on `R`.
- `valuation_exists_uniformizer` : There exists `π ∈ K` with `v`-adic valuation
  `multiplicative.of_add (-1)`.

## Implementation notes
We are only interested in Dedekind domains with Krull dimension 1. Dedekind domains of Krull
dimension 0 are fields, and for them `maximal_spectrum` is the empty set, which does not agree with
the set of maximal ideals (which is {(0)}).

## References
* [G. J. Janusz, *Algebraic Number Fields*][janusz1996]
* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]
* [J. Neukirch, *Algebraic Number Theory*][Neukirch1992]

## Tags
dedekind domain, dedekind ring, adic valuation
-/

noncomputable theory
open_locale classical

variables (R : Type*) [comm_ring R] [is_domain R] [is_dedekind_domain R] {K : Type*} [field K]
  [algebra R K] [is_fraction_ring R K]

/-!
### Maximal spectrum of a Dedekind domain
If `R` is a Dedekind domain of Krull dimension 1, the maximal ideals of `R` are exactly its nonzero
prime ideals.

We define `maximal_spectrum` and provide lemmas to recover the facts that maximal ideals are prime
and irreducible. -/

/-- The maximal spectrum of a Dedekind domain `R` of Krull dimension 1 is its set of nonzero prime
ideals. Note that this is not the maximal spectrum if `R` has Krull dimension 0. -/
def maximal_spectrum := {v : prime_spectrum R // v.val ≠ 0 }
variable (v : maximal_spectrum R)

variable {R}
--Maximal spectrum lemmas
lemma ideal.prime_of_maximal (v : maximal_spectrum R) :
  prime v.val.val :=
by apply ideal.prime_of_is_prime v.property v.val.property

lemma ideal.irreducible_of_maximal (v : maximal_spectrum R) :
  irreducible v.val.val :=
begin
  rw [unique_factorization_monoid.irreducible_iff_prime],
  apply ideal.prime_of_maximal v,
end

lemma associates.irreducible_of_maximal (v : maximal_spectrum R) :
  irreducible (associates.mk v.val.val) :=
begin
  rw [associates.irreducible_mk _],
  apply ideal.irreducible_of_maximal v,
end

/-!
### Auxiliary lemmas
We provide auxiliary lemmas about `multiplicative.of_add`, `is_localization`, `associates` and
`ideal`. They will be moved to the appropriate files when the code is integrated in `mathlib`. -/

-- of_add lemmas
lemma of_add_le (α : Type*) [partial_order α] (x y : α) :
  multiplicative.of_add x ≤ multiplicative.of_add y ↔ x ≤ y := by refl

lemma of_add_lt (α : Type*) [partial_order α] (x y : α) :
  multiplicative.of_add x < multiplicative.of_add y ↔ x < y := by refl

lemma of_add_inj (α : Type*) (x y : α)
  (hxy : multiplicative.of_add x = multiplicative.of_add y) : x = y :=
by rw [← to_add_of_add x, ← to_add_of_add y, hxy]

-- is_localization lemmas
lemma is_localization.mk'_zero {R : Type*} [comm_ring R] {M : submonoid R}
  {S : Type*} [comm_ring S] [algebra R S] [is_localization M S] {y : M} :
  is_localization.mk' S 0 y = 0 :=
by rw [eq_comm, is_localization.eq_mk'_iff_mul_eq, zero_mul, map_zero]

lemma is_localization.mk'_num_ne_zero_of_ne_zero {R : Type*} [comm_ring R] {M : submonoid R}
  {S : Type*} [comm_ring S] [algebra R S] [is_localization M S] {z : S}  {x : R} {y : M}
  (hxyz : z = is_localization.mk' S x y) (hz : z ≠ 0) : x ≠ 0 :=
begin
  intro hx,
  rw [hx, is_localization.mk'_zero] at hxyz,
  exact hz hxyz,
end

variables {A : Type*} [comm_ring A] [is_domain A] {S : Type*} [field S] [algebra A S]
  [is_fraction_ring A S]

lemma is_localization.mk'_eq_zero {r : A} {s : non_zero_divisors A}
  (h : is_localization.mk' S r s = 0) : r = 0 :=
begin
  rw [is_fraction_ring.mk'_eq_div, div_eq_zero_iff] at h,
  apply is_fraction_ring.injective A S,
  rw (algebra_map A S).map_zero,
  exact or.resolve_right h (is_fraction_ring.to_map_ne_zero_of_mem_non_zero_divisors s.property)
end

variable (S)
lemma is_localization.mk'_eq_one {r : A} {s : non_zero_divisors A}
  (h : is_localization.mk' S r s = 1) : r = s :=
begin
  rw [is_fraction_ring.mk'_eq_div, div_eq_one_iff_eq] at h,
  { exact is_fraction_ring.injective A S h },
  { exact is_fraction_ring.to_map_ne_zero_of_mem_non_zero_divisors s.property }
end

-- Ideal associates lemmas
lemma associates.mk_ne_zero' {α : Type*} [comm_ring α] {x : α} :
  (associates.mk (ideal.span{x} : ideal α)) ≠ 0 ↔ (x ≠ 0):=
by rw [associates.mk_ne_zero, ideal.zero_eq_bot, ne.def, ideal.span_singleton_eq_bot]

lemma associates.le_singleton_iff (x : R) (n : ℕ) (I : ideal R) :
  associates.mk I^n ≤ associates.mk (ideal.span {x}) ↔ x ∈ I^n :=
begin
  rw [← associates.dvd_eq_le, ← associates.mk_pow, associates.mk_dvd_mk, ideal.dvd_span_singleton],
end

-- Ideal lemmas
lemma ideal.mem_pow_count {x : R} (hx : x ≠ 0) {I : ideal R} (hI : irreducible I) :
  x ∈ I^((associates.mk I).count (associates.mk (ideal.span {x})).factors) :=
begin
  have hx' := associates.mk_ne_zero'.mpr hx,
  rw [← associates.le_singleton_iff,
    associates.prime_pow_dvd_iff_le hx' ((associates.irreducible_mk I).mpr hI)],
end

lemma ideal.mem_le_pow {x : R} {I : ideal R} {n : ℕ} (hxI : x ∈ I^n) (m : ℕ) (hm : m ≤ n) :
  x ∈ I^m := ideal.pow_le_pow hm hxI

lemma ideal.is_nonunit_iff {I : ideal R} : ¬ is_unit I ↔ I ≠ ⊤ := not_congr ideal.is_unit_iff

namespace maximal_spectrum
/-! ### Adic valuations on the Dedekind domain R -/

/-- The additive `v`-adic valuation of `r ∈ R` is the exponent of `v` in the factorization of the
ideal `(r)`, if `r` is nonzero, or infinity, if `r = 0`. `int_valuation_def` is the corresponding
multiplicative valuation. -/
def int_valuation_def (r : R) : with_zero (multiplicative ℤ) :=
ite (r = 0) 0 (multiplicative.of_add
  (-(associates.mk v.val.val).count (associates.mk (ideal.span{r} : ideal R)).factors : ℤ))

lemma int_valuation_def_if_pos {r : R} (hr : r = 0) :
  v.int_valuation_def r = 0 :=
if_pos hr

lemma int_valuation_def_if_neg {r : R} (hr : r ≠ 0) :
  v.int_valuation_def r = (multiplicative.of_add
  (-(associates.mk v.val.val).count (associates.mk (ideal.span{r} : ideal R)).factors : ℤ)) :=
if_neg hr

/-- Nonzero elements have nonzero adic valuation. -/
lemma int_valuation_ne_zero' (x : R) (hx : x ≠ 0) : v.int_valuation_def x ≠ 0 :=
begin
  rw [int_valuation_def, if_neg hx],
  exact with_zero.coe_ne_zero,
end

/-- Nonzero divisors have nonzero valuation. -/
lemma int_valuation_ne_zero (x : non_zero_divisors R) : v.int_valuation_def x ≠ 0 :=
int_valuation_ne_zero' v x (non_zero_divisors.coe_ne_zero x)

/-- Nonzero divisors have valuation greater than zero. -/
lemma int_valuation_zero_le (x : non_zero_divisors R) : 0 < v.int_valuation_def x :=
begin
  rw [int_valuation_def, if_neg (non_zero_divisors.coe_ne_zero x)],
  exact with_zero.zero_lt_coe _,
end

/-- The `v`-adic valuation on `R` is bounded above by 1. -/
lemma int_valuation_le_one (x : R) : v.int_valuation_def x ≤ 1 :=
begin
  rw int_valuation_def,
  by_cases hx : x = 0,
  { rw if_pos hx, exact with_zero.zero_le 1,},
  { rw [if_neg hx, ← with_zero.coe_one, ← of_add_zero, with_zero.coe_le_coe, of_add_le,
      right.neg_nonpos_iff],
    exact int.coe_nat_nonneg _, }
end

/-- The `v`-adic valuation of `r ∈ R` is less than 1 if and only if `v` divides the ideal `(r)`. -/
lemma int_valuation_lt_one_iff_dvd (r : R) :
  v.int_valuation_def r < 1 ↔ v.val.val ∣ ideal.span {r} :=
begin
  rw int_valuation_def,
  split_ifs with hr,
  { simpa [hr] using (with_zero.zero_lt_coe _) },
  { rw [← with_zero.coe_one, ← of_add_zero, with_zero.coe_lt_coe, of_add_lt, neg_lt_zero,
      ← int.coe_nat_zero, int.coe_nat_lt, zero_lt_iff],
    apply associates.count_ne_zero_iff_dvd,
    { rw [ne.def, ideal.zero_eq_bot, ideal.span_singleton_eq_bot], exact hr },
    { apply ideal.irreducible_of_maximal v }}
end

/-- The `v`-adic valuation of `r ∈ R` is less than `multiplicative.of_add (-n)` if and only if
`vⁿ` divides the ideal `(r)`. -/
lemma int_valuation_le_pow_iff_dvd (r : R) (n : ℕ) :
  v.int_valuation_def r ≤ multiplicative.of_add (-(n : ℤ)) ↔ v.val.val^n ∣ ideal.span {r} :=
begin
  rw int_valuation_def,
  split_ifs with hr,
  { simp only [hr, ideal.dvd_span_singleton, zero_le', submodule.zero_mem], },
  { norm_cast,
    rw [of_add_le, neg_le_neg_iff, int.coe_nat_le, ideal.dvd_span_singleton,
    ← associates.le_singleton_iff,
    associates.prime_pow_dvd_iff_le (associates.mk_ne_zero'.mpr hr) _],
    { apply (associates.irreducible_of_maximal v) }}
end

/-- The `v`-adic valuation of `0 : R` equals 0. -/
lemma int_valuation.map_zero' : v.int_valuation_def 0 = 0 :=
by { rw [int_valuation_def, if_pos], refl, }

/-- The `v`-adic valuation of `1 : R` equals 1. -/
lemma int_valuation.map_one' : v.int_valuation_def 1 = 1 :=
begin
  rw [int_valuation_def, if_neg (zero_ne_one.symm : (1 : R) ≠ 0)],
  simp [← ideal.one_eq_top, -subtype.val_eq_coe,
    associates.count_zero (associates.irreducible_of_maximal v)],
end

/-- The `v`-adic valuation of a product equals the product of the valuations. -/
lemma int_valuation.map_mul' (x y : R) :
  v.int_valuation_def (x * y) = v.int_valuation_def x * v.int_valuation_def y :=
begin
  rw [int_valuation_def, int_valuation_def, int_valuation_def],
  by_cases hx : x = 0,
  { rw [hx, zero_mul, if_pos (eq.refl _), zero_mul] },
  { by_cases hy : y = 0,
    { rw [hy, mul_zero, if_pos (eq.refl _), mul_zero] },
    { rw [if_neg hx, if_neg hy, if_neg (mul_ne_zero hx hy), ← with_zero.coe_mul,
        with_zero.coe_inj, ← of_add_add],
      have hx' : associates.mk (ideal.span{x} : ideal R) ≠ 0 := associates.mk_ne_zero'.mpr hx,
      have hy' : associates.mk (ideal.span{y} : ideal R) ≠ 0 := associates.mk_ne_zero'.mpr hy,
      rw [← ideal.span_singleton_mul_span_singleton, ← associates.mk_mul_mk, ← neg_add,
        associates.count_mul hx' hy' _],
      { refl },
      { apply (associates.irreducible_of_maximal v), }}}
end

lemma int_valuation.le_max_iff_min_le {a b c : ℕ} :  multiplicative.of_add(-c : ℤ) ≤
  max (multiplicative.of_add(-a : ℤ)) (multiplicative.of_add(-b : ℤ)) ↔ min a b ≤ c :=
by rw [le_max_iff, of_add_le, of_add_le, neg_le_neg_iff, neg_le_neg_iff, int.coe_nat_le,
    int.coe_nat_le, ← min_le_iff]

@[simp] lemma with_zero.le_max_iff {M : Type} [linear_ordered_comm_monoid M] {a b c : M} :
  (a : with_zero M) ≤ max b c ↔ a ≤ max b c :=
by simp only [with_zero.coe_le_coe, le_max_iff]

/-- The `v`-adic valuation of a sum is bounded above by the maximum of the valuations. -/
lemma int_valuation.map_add' (x y : R) : v.int_valuation_def (x + y) ≤
  max (v.int_valuation_def x) (v.int_valuation_def y) :=
begin
  by_cases hx : x = 0,
  { rw [hx, zero_add],
    conv_rhs {rw [int_valuation_def, if_pos (eq.refl _)]},
    rw max_eq_right (with_zero.zero_le (v.int_valuation_def y)),
    exact le_refl _, },
  { by_cases hy : y = 0,
    { rw [hy, add_zero],
      conv_rhs {rw [max_comm, int_valuation_def, if_pos (eq.refl _)]},
      rw max_eq_right (with_zero.zero_le (v.int_valuation_def x)),
      exact le_refl _ },
    { by_cases hxy : x + y = 0,
      { rw [int_valuation_def, if_pos hxy], exact zero_le',},
      { rw [v.int_valuation_def_if_neg hxy, v.int_valuation_def_if_neg hx,
          v.int_valuation_def_if_neg hy, with_zero.le_max_iff, int_valuation.le_max_iff_min_le],
      set nmin := min
        ((associates.mk v.val.val).count (associates.mk (ideal.span {x})).factors)
        ((associates.mk v.val.val).count (associates.mk (ideal.span {y})).factors),
      have h_dvd_x : x ∈ v.val.val ^ (nmin),
      { rw [← associates.le_singleton_iff x nmin _,
          associates.prime_pow_dvd_iff_le (associates.mk_ne_zero'.mpr hx) _],
        exact min_le_left _ _,
        apply associates.irreducible_of_maximal v, },
      have h_dvd_y : y ∈ v.val.val ^ nmin,
      { rw [← associates.le_singleton_iff y nmin _,
          associates.prime_pow_dvd_iff_le (associates.mk_ne_zero'.mpr hy) _],
        exact min_le_right _ _,
        apply associates.irreducible_of_maximal v, },
      have h_dvd_xy : associates.mk v.val.val^nmin ≤ associates.mk (ideal.span {x + y}),
      { rw associates.le_singleton_iff,
        exact ideal.add_mem (v.val.val^nmin) h_dvd_x h_dvd_y, },
      rw (associates.prime_pow_dvd_iff_le (associates.mk_ne_zero'.mpr hxy) _) at h_dvd_xy,
      exact h_dvd_xy,
      apply associates.irreducible_of_maximal v, }}}
end

/-- The `v`-adic valuation on `R`. -/
def int_valuation (v : maximal_spectrum R) : valuation R (with_zero (multiplicative ℤ)) :=
{ to_fun          := v.int_valuation_def,
  map_zero'       := int_valuation.map_zero' v,
  map_one'        := int_valuation.map_one' v,
  map_mul'        := int_valuation.map_mul' v,
  map_add_le_max' := int_valuation.map_add' v }

/-- There exists `π ∈ R` with `v`-adic valuation `multiplicative.of_add (-1)`. -/
lemma int_valuation_exists_uniformizer :
  ∃ (π : R), v.int_valuation_def π = multiplicative.of_add (-1 : ℤ) :=
begin
  have hv : irreducible (associates.mk v.val.val) := associates.irreducible_of_maximal v,
  have hlt : v.val.val^2 < v.val.val,
  { rw ← ideal.dvd_not_unit_iff_lt,
    exact ⟨v.property, v.val.val,
     ideal.is_nonunit_iff.mpr (ideal.is_prime.ne_top v.val.property), sq v.val.val⟩ } ,
  obtain ⟨π, mem, nmem⟩ := set_like.exists_of_lt hlt,
  have hπ : associates.mk (ideal.span {π}) ≠ 0,
  { rw associates.mk_ne_zero',
    intro h,
    rw h at nmem,
    exact nmem (submodule.zero_mem (v.val.val^2)), },
  use π,
  rw [int_valuation_def, if_neg (associates.mk_ne_zero'.mp hπ), with_zero.coe_inj],
  apply congr_arg,
  rw [neg_inj, ← int.coe_nat_one, int.coe_nat_inj'],
  rw [← ideal.dvd_span_singleton, ← associates.mk_le_mk_iff_dvd_iff] at mem nmem,
  rw [← pow_one ( associates.mk v.val.val),
    associates.prime_pow_dvd_iff_le hπ hv]  at mem,
  rw [associates.mk_pow, associates.prime_pow_dvd_iff_le hπ hv, not_le] at nmem,
  exact nat.eq_of_le_of_lt_succ mem nmem,
end

/-! ### Adic valuations on the field of fractions `K` -/
/-- The `v`-adic valuation of `x ∈ K` is the valuation of `r` divided by the valuation of `s`,
where `r` and `s` are chosen so that `x = r/s`. -/
def valuation_def (x : K) : (with_zero (multiplicative ℤ)) :=
let s := classical.some (classical.some_spec (is_localization.mk'_surjective
  (non_zero_divisors R) x)) in (v.int_valuation_def (classical.some
    (is_localization.mk'_surjective (non_zero_divisors R) x)))/(v.int_valuation_def s)

variable (K)
/-- The valuation of `k ∈ K` is independent on how we express `k` as a fraction. -/
lemma valuation_well_defined {r r' : R} {s s' : non_zero_divisors R}
  (h_mk : is_localization.mk' K r s = is_localization.mk' K r' s') :
  (v.int_valuation_def r)/(v.int_valuation_def s) =
  (v.int_valuation_def r')/(v.int_valuation_def s') :=
begin
  rw [div_eq_div_iff (int_valuation_ne_zero v s) (int_valuation_ne_zero v s'),
  ← int_valuation.map_mul', ← int_valuation.map_mul',
  is_fraction_ring.injective R K (is_localization.mk'_eq_iff_eq.mp h_mk)],
end

/-- The `v`-adic valuation of `r/s ∈ K` is the valuation of `r` divided by the valuation of `s`. -/
lemma valuation_of_mk' {r : R} {s : non_zero_divisors R} :
  v.valuation_def (is_localization.mk' K r s) =
   (v.int_valuation_def r)/(v.int_valuation_def s) :=
begin
  rw valuation_def,
  exact valuation_well_defined K v
    (classical.some_spec (classical.some_spec (is_localization.mk'_surjective (non_zero_divisors R)
    (is_localization.mk' K r s)))),
end

variable {K}
/-- The `v`-adic valuation on `K` extends the `v`-adic valuation on `R`. -/
lemma valuation_of_algebra_map {r : R} :
  v.valuation_def (algebra_map R K r) = v.int_valuation_def r :=
by rw [← is_localization.mk'_one K r, valuation_of_mk', submonoid.coe_one,
    int_valuation.map_one', div_one _]

/-- The `v`-adic valuation on `R` is bounded above by 1. -/
lemma valuation_le_one (r : R) : v.valuation_def (algebra_map R K r) ≤ 1 :=
by { rw valuation_of_algebra_map, exact v.int_valuation_le_one r }

/-- The `v`-adic valuation of `r ∈ R` is less than 1 if and only if `v` divides the ideal `(r)`. -/
lemma valuation_lt_one_iff_dvd (r : R) :
  v.valuation_def (algebra_map R K r) < 1 ↔ v.val.val ∣ ideal.span {r} :=
by { rw valuation_of_algebra_map, exact v.int_valuation_lt_one_iff_dvd r }

/-- The `v`-adic valuation of `0 : R` equals 0. -/
lemma valuation.map_zero' (v : maximal_spectrum R) :
  v.valuation_def (0 : K) = 0 :=
begin
  rw [← (algebra_map R K).map_zero, valuation_of_algebra_map v],
  exact v.int_valuation.map_zero',
end

/-- The `v`-adic valuation of `1 : R` equals 1. -/
lemma valuation.map_one' (v : maximal_spectrum R) :
  v.valuation_def (1 : K) = 1 :=
begin
  rw [← (algebra_map R K).map_one, valuation_of_algebra_map v],
  exact v.int_valuation.map_one',
end

/-- The `v`-adic valuation of a product is the product of the valuations. -/
lemma valuation.map_mul' (v : maximal_spectrum R) (x y : K) :
  v.valuation_def (x * y) = v.valuation_def x * v.valuation_def y :=
begin
  rw [valuation_def, valuation_def, valuation_def, div_mul_div _ _ _ _,
    ← int_valuation.map_mul', ← int_valuation.map_mul', ← submonoid.coe_mul],
  apply valuation_well_defined K v,
  rw [(classical.some_spec (valuation_def._proof_2 (x * y))), is_fraction_ring.mk'_eq_div,
    (algebra_map R K).map_mul, submonoid.coe_mul, (algebra_map R K).map_mul, ← div_mul_div,
    ← is_fraction_ring.mk'_eq_div, ← is_fraction_ring.mk'_eq_div,
    (classical.some_spec (valuation_def._proof_2 x)),
    (classical.some_spec (valuation_def._proof_2 y))],
end

/-- The `v`-adic valuation of a sum is bounded above by the maximum of the valuations. -/
lemma valuation.map_add' (v : maximal_spectrum R) (x y : K) :
  v.valuation_def (x + y) ≤ max (v.valuation_def x) (v.valuation_def y) :=
begin
  obtain ⟨rx, sx, hx⟩ := is_localization.mk'_surjective (non_zero_divisors R) x,
  obtain ⟨rxy, sxy, hxy⟩ := is_localization.mk'_surjective (non_zero_divisors R) (x + y),
  obtain ⟨ry, sy, hy⟩ := is_localization.mk'_surjective (non_zero_divisors R) y,
  rw [← hxy, ← hx, ← hy, valuation_of_mk', valuation_of_mk', valuation_of_mk'],
  have h_frac_xy : is_localization.mk' K rxy sxy =
    is_localization.mk' K (rx*(sy : R) + ry*(sx : R)) (sx*sy),
  { rw [is_localization.mk'_add, hx, hy, hxy], },
  have h_frac_x : is_localization.mk' K rx sx = is_localization.mk' K (rx*(sy : R)) (sx*sy),
  { rw [is_localization.mk'_eq_iff_eq, submonoid.coe_mul, mul_assoc, mul_comm (sy : R) _], },
  have h_frac_y : is_localization.mk' K ry sy = is_localization.mk' K (ry*(sx : R)) (sx*sy),
  { rw [is_localization.mk'_eq_iff_eq, submonoid.coe_mul, mul_assoc], },
  have h_denom : 0 < v.int_valuation_def ↑(sx * sy),
  { rw [int_valuation_def, if_neg _],
    { exact with_zero.zero_lt_coe _ },
    { exact non_zero_divisors.ne_zero
        (submonoid.mul_mem (non_zero_divisors R) sx.property sy.property), }},
  rw [valuation_well_defined K v h_frac_x, valuation_well_defined K v h_frac_y,
    valuation_well_defined K v h_frac_xy, le_max_iff, div_le_div_right₀ (ne_of_gt h_denom),
    div_le_div_right₀ (ne_of_gt h_denom), ← le_max_iff],
  exact v.int_valuation.map_add_le_max' _ _,
end

/-- The `v`-adic valuation on `K`. -/
def valuation (v : maximal_spectrum R) : valuation K (with_zero (multiplicative ℤ)) := {
  to_fun          := v.valuation_def,
  map_zero'       := valuation.map_zero' v,
  map_one'        := valuation.map_one' v,
  map_mul'        := valuation.map_mul' v,
  map_add_le_max' := valuation.map_add' v }

variable (K)
/-- There exists `π ∈ K` with `v`-adic valuation `multiplicative.of_add (-1)`. -/
lemma valuation_exists_uniformizer :
  ∃ (π : K), v.valuation_def π = multiplicative.of_add (-1 : ℤ) :=
begin
  obtain ⟨r, hr⟩ := v.int_valuation_exists_uniformizer,
  use algebra_map R K r,
  rw valuation_of_algebra_map v,
  exact hr,
end

/-- Uniformizers are nonzero. -/
lemma valuation_uniformizer_ne_zero :
  (classical.some (v.valuation_exists_uniformizer K)) ≠ 0 :=
begin
  have hu := (classical.some_spec (v.valuation_exists_uniformizer K)),
  have h : v.valuation_def (classical.some _) = valuation v (classical.some _) := rfl,
  rw h at hu,
  exact (valuation.ne_zero_iff _).mp (ne_of_eq_of_ne hu with_zero.coe_ne_zero),
end

end maximal_spectrum