diff --git a/Statlib.lean b/Statlib.lean index b1d94d2..477e0c0 100644 --- a/Statlib.lean +++ b/Statlib.lean @@ -1,5 +1,38 @@ import Statlib.Causal.PotentialResponse import Statlib.Contiguity.Def +import Statlib.Divergence.BretagnolleHuber +import Statlib.Divergence.Chernoff +import Statlib.Divergence.FDiv.Basic +import Statlib.Divergence.FDiv.CompProd +import Statlib.Divergence.FDiv.CondFDiv +import Statlib.Divergence.FDiv.Conj +import Statlib.Divergence.FDiv.Convex +import Statlib.Divergence.FDiv.DivFunction.Basic +import Statlib.Divergence.FDiv.DivFunction.CompAffine +import Statlib.Divergence.FDiv.DivFunction.Conj +import Statlib.Divergence.FDiv.DivFunction.CurvatureMeasure +import Statlib.Divergence.FDiv.DivFunction.DerivAtTop +import Statlib.Divergence.FDiv.DivFunction.OfReal +import Statlib.Divergence.FDiv.DivFunction.RightDerivStieltjes +import Statlib.Divergence.FDiv.IntegralRepresentation +import Statlib.Divergence.FDiv.Measurable +import Statlib.Divergence.FDiv.Trim +import Statlib.Divergence.Hellinger.Basic +import Statlib.Divergence.Hellinger.CondHellinger +import Statlib.Divergence.Hellinger.HellingerDivFun +import Statlib.Divergence.Hellinger.HellingerFun +import Statlib.Divergence.KullbackLeibler.Basic +import Statlib.Divergence.KullbackLeibler.CondKL +import Statlib.Divergence.KullbackLeibler.KLDivFun +import Statlib.Divergence.Renyi.Basic +import Statlib.Divergence.Renyi.Bernoulli +import Statlib.Divergence.Renyi.CondRenyi +import Statlib.Divergence.Renyi.Variational +import Statlib.Divergence.StatInfo.Basic +import Statlib.Divergence.StatInfo.FDiv +import Statlib.Divergence.StatInfo.StatInfoDivFun +import Statlib.Divergence.StatInfo.StatInfoFun +import Statlib.Divergence.TotalVariation import Statlib.EValues.Bernoulli import Statlib.EValues.DPI import Statlib.EValues.Divergence @@ -12,20 +45,38 @@ import Statlib.EValues.Product import Statlib.EValues.RIPr import Statlib.EValues.Utility.Basic import Statlib.EValues.Utility.Log +import Statlib.ForMathlib.Analysis.Calculus.LocalExtr.Basic +import Statlib.ForMathlib.Analysis.Convex.DerivAtTop import Statlib.ForMathlib.Analysis.SpecialFunctions.Log.Basic import Statlib.ForMathlib.Convex import Statlib.ForMathlib.ENNReal import Statlib.ForMathlib.EReal import Statlib.ForMathlib.ISup +import Statlib.ForMathlib.InformationTheory.KullbackLeibler.Basic import Statlib.ForMathlib.InformationTheory.KullbackLeibler.Bernoulli +import Statlib.ForMathlib.InformationTheory.KullbackLeibler.DataProcessing +import Statlib.ForMathlib.InformationTheory.KullbackLeibler.EIntegral import Statlib.ForMathlib.MeasureTheory.Integral.EReal.Bochner import Statlib.ForMathlib.MeasureTheory.Integral.EReal.EIntegrable import Statlib.ForMathlib.MeasureTheory.Integral.EReal.EIntegral import Statlib.ForMathlib.MeasureTheory.Integral.EReal.Kernel import Statlib.ForMathlib.MeasureTheory.Integral.EReal.Prod import Statlib.ForMathlib.MeasureTheory.Komlos +import Statlib.ForMathlib.MeasureTheory.Measure.Bool +import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.IntegralRNDeriv +import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.IntegralRPowRNDeriv +import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.RadonNikodym +import Statlib.ForMathlib.MeasureTheory.Measure.ERealStieltjes +import Statlib.ForMathlib.MeasureTheory.Measure.Lebesgue.Basic import Statlib.ForMathlib.MeasureTheory.Measure.LogLikelihoodRatio import Statlib.ForMathlib.MeasureTheory.Order.Group.Lattice +import Statlib.ForMathlib.Probability.Decision.BayesEstimator import Statlib.ForMathlib.Probability.Distributions.Bernoulli +import Statlib.ForMathlib.Probability.Kernel.Composition.MeasureCompProd +import Statlib.ForMathlib.Probability.Kernel.Composition.RadonNikodym +import Statlib.ForMathlib.Topology.Order.MonotoneConvergence import Statlib.Inference.Inference import Statlib.Inference.QMD +import Statlib.Testing.Binary +import Statlib.Testing.ChangeMeasure +import Statlib.Testing.RenyiChangeMeasure diff --git a/Statlib/Divergence/BretagnolleHuber.lean b/Statlib/Divergence/BretagnolleHuber.lean new file mode 100644 index 0000000..6fded03 --- /dev/null +++ b/Statlib/Divergence/BretagnolleHuber.lean @@ -0,0 +1,182 @@ +/- +Copyright (c) 2026 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne +-/ +module + +public import Statlib.Divergence.FDiv.Conj +public import Statlib.Divergence.KullbackLeibler.Basic +public import Statlib.Divergence.TotalVariation + +/-! +# The Bretagnolle-Huber inequality + +We prove lower bounds on f-divergences between probability measures in terms of their total +variation distance, and deduce the Bretagnolle-Huber inequality for the Kullback-Leibler divergence. + +We use Mathlib's convention for the total variation distance: `tvDist μ ν ∈ [0, 2]` for probability +measures `μ, ν`, and the bounds are stated in terms of `tvDist μ ν / 2 ∈ [0, 1]`. + +## Main statements + +* `apply_one_add_etvDist_div_two_add_apply_one_sub_le_fDiv`: for probability measures, + `f (1 + etvDist μ ν / 2) + f (1 - etvDist μ ν / 2) ≤ fDiv f μ ν`. +* `conj_one_add_etvDist_div_two_add_conj_one_sub_le_fDiv`: the same bound for the conjugate + function `f.conj`. +* `neg_log_one_sub_tvDist_div_two_sq_le_klDiv`: the **Bretagnolle-Huber inequality** + `-log (1 - (tvDist μ ν / 2) ^ 2) ≤ klDiv μ ν`. +* `exp_neg_klDiv_le_one_sub_tvDist_div_two_sq`, `exp_neg_klDiv_le_two_sub_tvDist`: exponential forms + of the Bretagnolle-Huber inequality, for `klDiv μ ν ≠ ∞`. + +## References + +* J. Bretagnolle and C. Huber, *Estimation des densités : risque minimax*, + Z. Wahrscheinlichkeitstheorie verw. Gebiete 47 (1979). + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open MeasureTheory Set InformationTheory + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {f : DivFunction} + +/-- **Bretagnolle-Huber** type lower bound on an f-divergence in terms of the total variation +distance. -/ +theorem apply_one_add_etvDist_div_two_add_apply_one_sub_le_fDiv (μ ν : Measure α) + [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + f (1 + etvDist μ ν / 2) + f (1 - etvDist μ ν / 2) ≤ fDiv f μ ν := by + set T := etvDist μ ν / 2 + have hT : ∫⁻ x, 1 - (∂μ/∂ν) x ∂ν = T := lintegral_one_sub_rnDeriv_eq_etvDist_div_two (by simp) + have hT_ne_top : T ≠ ∞ := ENNReal.div_ne_top (etvDist_ne_top μ ν) two_ne_zero + have hr : Measurable (∂μ/∂ν) := Measure.measurable_rnDeriv μ ν + -- We split `∂μ/∂ν` into `max (∂μ/∂ν) 1` and `min (∂μ/∂ν) 1`, and apply Jensen's inequality to + -- each part. The integrals of the two parts are `1 + T` (with the singular part of `μ`) and + -- `1 - T`. + have h_min : ∫⁻ x, min ((∂μ/∂ν) x) 1 ∂ν = 1 - T := by + have h_eq x : min ((∂μ/∂ν) x) 1 = 1 - (1 - (∂μ/∂ν) x) := by + rcases le_total ((∂μ/∂ν) x) 1 with h | h + · rw [min_eq_left h, ENNReal.sub_sub_cancel ENNReal.one_ne_top h] + · rw [min_eq_right h, tsub_eq_zero_of_le h, tsub_zero] + simp_rw [h_eq] + rw [lintegral_sub (g := fun x ↦ 1 - (∂μ/∂ν) x) (measurable_const.sub hr) (hT ▸ hT_ne_top) + (ae_of_all _ fun _ ↦ tsub_le_self), lintegral_const, measure_univ, one_mul, hT] + have h_max : ∫⁻ x, max ((∂μ/∂ν) x) 1 ∂ν + μ.singularPart ν univ = 1 + T := by + have h_eq x : max ((∂μ/∂ν) x) 1 = (∂μ/∂ν) x + (1 - (∂μ/∂ν) x) := by + rcases le_total ((∂μ/∂ν) x) 1 with h | h + · rw [max_eq_right h, add_tsub_cancel_of_le h] + · rw [max_eq_left h, tsub_eq_zero_of_le h, add_zero] + simp_rw [h_eq] + rw [lintegral_add_left hr, hT, add_right_comm, add_comm (∫⁻ x, (∂μ/∂ν) x ∂ν), + Measure.singularPart_add_lintegral_rnDeriv, measure_univ] + have h_split x : f ((∂μ/∂ν) x) = f (max ((∂μ/∂ν) x) 1) + f (min ((∂μ/∂ν) x) 1) := by + rcases le_total ((∂μ/∂ν) x) 1 with h | h + · simp [max_eq_right h, min_eq_left h] + · simp [max_eq_left h, min_eq_right h] + have h_max_ne_top : ∫⁻ x, max ((∂μ/∂ν) x) 1 ∂ν ≠ ∞ := + ne_top_of_le_ne_top (ENNReal.add_ne_top.mpr ⟨ENNReal.one_ne_top, hT_ne_top⟩) + (le_self_add.trans h_max.le) + have h_min_ne_top : ∫⁻ x, min ((∂μ/∂ν) x) 1 ∂ν ≠ ∞ := by + rw [h_min] + exact ne_top_of_le_ne_top ENNReal.one_ne_top tsub_le_self + have h_jensen_max := f.map_lintegral_le (hr.max measurable_const).aemeasurable h_max_ne_top + have h_jensen_min := f.map_lintegral_le (hr.min measurable_const).aemeasurable h_min_ne_top + rw [h_min] at h_jensen_min + calc f (1 + T) + f (1 - T) + = f (∫⁻ x, max ((∂μ/∂ν) x) 1 ∂ν + μ.singularPart ν univ) + f (1 - T) := by rw [h_max] + _ ≤ f (∫⁻ x, max ((∂μ/∂ν) x) 1 ∂ν) + f.derivAtTop * μ.singularPart ν univ + + ∫⁻ x, f (min ((∂μ/∂ν) x) 1) ∂ν := by + gcongr + exact f.apply_add_le _ _ + _ ≤ ∫⁻ x, f (max ((∂μ/∂ν) x) 1) ∂ν + f.derivAtTop * μ.singularPart ν univ + + ∫⁻ x, f (min ((∂μ/∂ν) x) 1) ∂ν := by gcongr + _ = fDiv f μ ν := by + have h_meas : Measurable fun x ↦ f (max ((∂μ/∂ν) x) 1) := + f.measurable.comp (hr.max measurable_const) + rw [fDiv, lintegral_congr (fun x ↦ h_split x), lintegral_add_left h_meas] + ring + +/-- **Bretagnolle-Huber** type lower bound on an f-divergence in terms of the total variation +distance, obtained by applying `apply_one_add_etvDist_div_two_add_apply_one_sub_le_fDiv` to +`f.conj`. For `t ≠ 0`, `f.conj t = t * f t⁻¹`. -/ +theorem conj_one_add_etvDist_div_two_add_conj_one_sub_le_fDiv (μ ν : Measure α) + [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + f.conj (1 + etvDist μ ν / 2) + f.conj (1 - etvDist μ ν / 2) ≤ fDiv f μ ν := by + rw [← fDiv_conj, etvDist_comm] + exact apply_one_add_etvDist_div_two_add_apply_one_sub_le_fDiv ν μ + +/-- **Bretagnolle-Huber inequality**: `-log (1 - (tvDist μ ν / 2) ^ 2) ≤ klDiv μ ν`. +If `tvDist μ ν = 2`, the left-hand side is `0` since `Real.log 0 = 0`. -/ +theorem neg_log_one_sub_tvDist_div_two_sq_le_klDiv (μ ν : Measure α) [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] : + ENNReal.ofReal (-Real.log (1 - (tvDist μ ν / 2) ^ 2)) ≤ klDiv μ ν := by + have h := conj_one_add_etvDist_div_two_add_conj_one_sub_le_fDiv (f := klDivFun) μ ν + rw [← klDiv_eq_fDiv] at h + refine le_trans ?_ h + set t := tvDist μ ν / 2 with ht + have hT : etvDist μ ν / 2 = ENNReal.ofReal t := by + rw [ht, ← ofReal_tvDist, ENNReal.ofReal_div_of_pos two_pos, ENNReal.ofReal_ofNat] + have ht0 : 0 ≤ t := div_nonneg tvDist_nonneg zero_le_two + have ht1 : t ≤ 1 := by + have := tvDist_le_add (μ := μ) (ν := ν) + simp only [probReal_univ] at this + linarith + rcases ht1.lt_or_eq with ht1 | ht1 + swap + · simp [ht1] + rw [hT, ← ENNReal.ofReal_one, ← ENNReal.ofReal_add zero_le_one ht0, ← ENNReal.ofReal_sub _ ht0, + conj_klDivFun_ofReal (by linarith), conj_klDivFun_ofReal (by linarith), + ← ENNReal.ofReal_add (sub_nonneg.2 (Real.log_le_sub_one_of_pos (by linarith))) + (sub_nonneg.2 (Real.log_le_sub_one_of_pos (by linarith)))] + refine ENNReal.ofReal_le_ofReal (le_of_eq ?_) + rw [show 1 - t ^ 2 = (1 + t) * (1 - t) by ring, Real.log_mul (by linarith) (by linarith)] + ring + +/-- If the Kullback-Leibler divergence between probability measures is finite, then their total +variation distance is less than `2`, its maximal value. -/ +lemma tvDist_lt_two_of_klDiv_ne_top {μ ν : Measure α} [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] (h : klDiv μ ν ≠ ∞) : + tvDist μ ν < 2 := by + refine (tvDist_le_add.trans_eq (by rw [probReal_univ, probReal_univ]; norm_num)).lt_of_ne + fun h_eq ↦ h ?_ + -- if `tvDist μ ν = 2`, the lower bound contains `klDivFun.conj 0 = ∞` + have h_conj := conj_one_add_etvDist_div_two_add_conj_one_sub_le_fDiv (f := klDivFun) μ ν + have hT : etvDist μ ν / 2 = 1 := by + rw [← ofReal_tvDist, h_eq, ENNReal.ofReal_ofNat, + ENNReal.div_self two_ne_zero ENNReal.ofNat_ne_top] + rw [hT, tsub_self, DivFunction.conj_zero, derivAtTop_klDivFun, add_top, top_le_iff, + ← klDiv_eq_fDiv] at h_conj + exact h_conj + +/-- **Bretagnolle-Huber inequality**, exponential form: if `klDiv μ ν ≠ ∞`, then +`exp (-klDiv μ ν) ≤ 1 - (tvDist μ ν / 2) ^ 2`. -/ +theorem exp_neg_klDiv_le_one_sub_tvDist_div_two_sq (μ ν : Measure α) [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] (h : klDiv μ ν ≠ ∞) : + Real.exp (-(klDiv μ ν).toReal) ≤ 1 - (tvDist μ ν / 2) ^ 2 := by + have h_pos : 0 < 1 - (tvDist μ ν / 2) ^ 2 := by + have := tvDist_lt_two_of_klDiv_ne_top h + nlinarith [tvDist_nonneg (μ := μ) (ν := ν)] + have h_log := neg_log_one_sub_tvDist_div_two_sq_le_klDiv μ ν + rw [ENNReal.ofReal_le_iff_le_toReal h] at h_log + calc Real.exp (-(klDiv μ ν).toReal) + _ ≤ Real.exp (Real.log (1 - (tvDist μ ν / 2) ^ 2)) := by gcongr; linarith + _ = 1 - (tvDist μ ν / 2) ^ 2 := Real.exp_log h_pos + +/-- **Bretagnolle-Huber inequality**: if `klDiv μ ν ≠ ∞`, then +`exp (-klDiv μ ν) ≤ 2 - tvDist μ ν`. Since the sum of the errors `μ s + ν sᶜ` of a test is at least +`1 - tvDist μ ν / 2`, it is at least `exp (-klDiv μ ν) / 2`. -/ +theorem exp_neg_klDiv_le_two_sub_tvDist (μ ν : Measure α) [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] (h : klDiv μ ν ≠ ∞) : + Real.exp (-(klDiv μ ν).toReal) ≤ 2 - tvDist μ ν := by + have h_sq := exp_neg_klDiv_le_one_sub_tvDist_div_two_sq μ ν h + have h_lt := tvDist_lt_two_of_klDiv_ne_top h + nlinarith [tvDist_nonneg (μ := μ) (ν := ν)] + +end ProbabilityTheory diff --git a/Statlib/Divergence/Chernoff.lean b/Statlib/Divergence/Chernoff.lean new file mode 100644 index 0000000..ffdd84e --- /dev/null +++ b/Statlib/Divergence/Chernoff.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne +-/ +module + +public import Statlib.Divergence.Renyi.Basic + +/-! +# Chernoff divergence + +## Main definitions + +* `chernoffDiv a μ ν`: the Chernoff divergence of order `a`, + `⨅ ξ, max (renyiDiv a ξ μ) (renyiDiv a ξ ν)` over probability measures `ξ`. + +## Main statements + +* `chernoffDiv_one`: the Chernoff divergence of order `1` as an infimum of Kullback-Leibler + divergences. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Real MeasureTheory InformationTheory + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {a : ℝ} + +/-- Chernoff divergence of order `a` between two measures `μ, ν`. +This is the infimum over probability measures `ξ` of the maximum of the Rényi divergences +of order `a` from `ξ` to `μ` and from `ξ` to `ν`. -/ +noncomputable def chernoffDiv (a : ℝ) (μ ν : Measure α) : ℝ≥0∞ := + ⨅ (ξ : Measure α) (_hξ : IsProbabilityMeasure ξ), max (renyiDiv a ξ μ) (renyiDiv a ξ ν) + +lemma chernoffDiv_one [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + chernoffDiv 1 μ ν + = ⨅ (ξ : Measure α) (_hξ : IsProbabilityMeasure ξ), max (klDiv ξ μ) (klDiv ξ ν) := by + simp_rw [chernoffDiv] + congr with ξ + congr with hξ + rw [renyiDiv_one_of_isProbabilityMeasure, renyiDiv_one_of_isProbabilityMeasure] + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/Basic.lean b/Statlib/Divergence/FDiv/Basic.lean new file mode 100644 index 0000000..2b8672e --- /dev/null +++ b/Statlib/Divergence/FDiv/Basic.lean @@ -0,0 +1,505 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.Analysis.Convex.Integral +public import Mathlib.Probability.Notation +public import Statlib.Divergence.FDiv.DivFunction.OfReal +public import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.RadonNikodym +public import Mathlib.MeasureTheory.Measure.Decomposition.IntegralRNDeriv + +/-! +# f-Divergences + +## Main definitions + +* `fDiv f μ ν`: the f-divergence between the measures `μ` and `ν` for the divergence function + `f : DivFunction`, defined as `∫⁻ x, f (∂μ/∂ν x) ∂ν + f.derivAtTop * μ.singularPart ν univ`. + +## Main statements + +* `fDiv_of_absolutelyContinuous`, `fDiv_of_mutuallySingular`: values of `fDiv` in the two extreme + cases of the Lebesgue decomposition. +* `fDiv_eq_add_withDensity_derivAtTop`, `fDiv_add_eq_add_withDensity_singularPart`: + decompositions of `fDiv` according to the Lebesgue decomposition of `μ` with respect to `ν`. +* `fDiv_eq_top_iff`, `fDiv_ne_top_iff`: finiteness of `fDiv`. +* `le_fDiv`: Jensen-type lower bound, `ν univ * f (μ univ / ν univ) ≤ fDiv f μ ν`. For probability + measures it reads `f 1 = 0 ≤ fDiv f μ ν`, and in general it bounds `fDiv` by the masses. +* `fDiv_eq_zero_iff`: for a divergence function which is strictly convex on a neighborhood of `1`, + `fDiv f μ ν = 0 ↔ μ = ν` for finite measures. +* `fDiv_map_measurableEmbedding`: invariance under measurable embeddings. + +## Implementation details + +The divergence function `f` is a `DivFunction`: a function `ℝ≥0∞ → ℝ≥0∞` which is convex, +continuous and vanishes at `1`. We use `ℝ≥0∞ → ℝ≥0∞` so that `fDiv` can be defined with a +Lebesgue integral, without integrability conditions, and takes values in `ℝ≥0∞`. +The results that need derivatives or the convexity lemmas of Mathlib use the real function +`f.realFun : ℝ → ℝ` instead. + +-/ + +@[expose] public section + +open Real MeasureTheory Filter Set MeasurableSpace + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {α β : Type*} {m mα : MeasurableSpace α} {mβ : MeasurableSpace β} + {μ ν : Measure α} {f g : DivFunction} + +/-- f-Divergence of two measures. -/ +noncomputable +def fDiv (f : DivFunction) (μ ν : Measure α) : ℝ≥0∞ := + ∫⁻ x, f ((∂μ/∂ν) x) ∂ν + f.derivAtTop * μ.singularPart ν .univ + +lemma fDiv_of_lintegral_eq_top (hf : ∫⁻ x, f ((∂μ/∂ν) x) ∂ν = ∞) : fDiv f μ ν = ∞ := by + simp [fDiv, hf] + +section SimpleValues + +@[simp] lemma fDiv_zero (μ ν : Measure α) : fDiv 0 μ ν = 0 := by simp [fDiv] + +@[simp] +lemma fDiv_zero_measure_left (ν : Measure α) : fDiv f 0 ν = f 0 * ν .univ := by + have : (fun x ↦ f ((∂0/∂ν) x)) =ᵐ[ν] fun _ ↦ f 0 := by + filter_upwards [ν.rnDeriv_zero] with x hx + rw [hx] + simp + simp [fDiv, lintegral_congr_ae this] + +@[simp] +lemma fDiv_zero_measure_right (μ : Measure α) : fDiv f μ 0 = f.derivAtTop * μ .univ := by + simp [fDiv] + +lemma fDiv_self (μ : Measure α) [SigmaFinite μ] : fDiv f μ μ = 0 := by + have h : (fun x ↦ f (μ.rnDeriv μ x)) =ᵐ[μ] 0 := by + filter_upwards [μ.rnDeriv_self] with x hx + rw [hx, f.one] + rfl + simp [fDiv, lintegral_congr_ae h] + +end SimpleValues + +section Congr + +/-- `fDiv f μ ν` depends on `f` only through its values on the range of `∂μ/∂ν` and through +`f.derivAtTop`. -/ +lemma fDiv_congr (hfg : f =ᵐ[ν.map (∂μ/∂ν)] g) (hfg' : f.derivAtTop = g.derivAtTop) : + fDiv f μ ν = fDiv g μ ν := by + have h : (fun x ↦ f ((∂μ/∂ν) x)) =ᵐ[ν] fun x ↦ g ((∂μ/∂ν) x) := + ae_of_ae_map (μ.measurable_rnDeriv ν).aemeasurable hfg + rw [fDiv, fDiv, hfg', lintegral_congr_ae h] + +lemma fDiv_congr_measure {μ ν : Measure α} {μ' ν' : Measure β} + (h_eq : ∫⁻ x, f ((∂μ/∂ν) x) ∂ν = ∫⁻ x, f ((∂μ'/∂ν') x) ∂ν') + (h_sing : μ.singularPart ν univ = μ'.singularPart ν' univ) : + fDiv f μ ν = fDiv f μ' ν' := by + rw [fDiv, fDiv, h_sing, h_eq] + +end Congr + +section MulAdd + +lemma fDiv_smul (c : ℝ≥0) (μ ν : Measure α) : fDiv (c • f) μ ν = c * fDiv f μ ν := by + rw [fDiv] + simp only [DivFunction.smul_apply, DivFunction.derivAtTop_smul] + rw [lintegral_const_mul _ DivFunction.measurable_comp_rnDeriv, fDiv, mul_add, ← mul_assoc] + +/-- Scaling the second measure by `c ≠ 0` is the same as scaling the first by `c⁻¹` and +multiplying the divergence by `c`. -/ +lemma fDiv_smul_right [SigmaFinite μ] [SigmaFinite ν] (c : ℝ≥0) (hc : c ≠ 0) : + fDiv f μ (c • ν) = c * fDiv f (c⁻¹ • μ) ν := by + have h : (fun x ↦ f ((∂μ/∂(c • ν)) x)) =ᵐ[ν] fun x ↦ f ((∂(c⁻¹ • μ)/∂ν) x) := by + filter_upwards [Measure.rnDeriv_smul_right' μ ν hc, Measure.rnDeriv_smul_left' μ ν c⁻¹] + with x hx hy + rw [hx, hy] + rw [fDiv, fDiv, lintegral_smul_measure, lintegral_congr_ae h, + Measure.singularPart_smul_right _ _ _ hc, Measure.singularPart_smul, + Measure.coe_nnreal_smul_apply, mul_add, ENNReal.smul_def, smul_eq_mul, ENNReal.coe_inv hc] + congr 1 + rw [mul_left_comm (c : ℝ≥0∞), ← mul_assoc (c : ℝ≥0∞), + ENNReal.mul_inv_cancel (by exact_mod_cast hc) ENNReal.coe_ne_top, one_mul] + +/-- Scaling both measures by the same constant scales the f-divergence. -/ +lemma fDiv_smul_smul (c : ℝ≥0) (μ ν : Measure α) [SigmaFinite μ] [SigmaFinite ν] : + fDiv f (c • μ) (c • ν) = c * fDiv f μ ν := by + rcases eq_or_ne c 0 with rfl | hc + · simp + rw [fDiv_smul_right _ hc, smul_smul, inv_mul_cancel₀ hc, one_smul] + +lemma fDiv_add : fDiv (f + g) μ ν = fDiv f μ ν + fDiv g μ ν := by + simp only [fDiv, DivFunction.add_apply, DivFunction.derivAtTop_add] + rw [lintegral_add_left DivFunction.measurable_comp_rnDeriv] + ring + +end MulAdd + +section AbsolutelyContinuousMutuallySingular + +lemma fDiv_of_mutuallySingular [SigmaFinite μ] [SigmaFinite ν] (h : μ ⟂ₘ ν) : + fDiv f μ ν = f 0 * ν .univ + f.derivAtTop * μ .univ := by + have : μ.singularPart ν = μ := (μ.singularPart_eq_self).mpr h + have hf_rnDeriv : (fun x ↦ f ((∂μ/∂ν) x)) =ᵐ[ν] fun _ ↦ f 0 := by + filter_upwards [Measure.rnDeriv_eq_zero_of_mutuallySingular h Measure.AbsolutelyContinuous.rfl] + with x hx using by simp [hx] + simp [fDiv, lintegral_congr_ae hf_rnDeriv, this] + +lemma fDiv_of_absolutelyContinuous (h : μ ≪ ν) : fDiv f μ ν = ∫⁻ x, f ((∂μ/∂ν) x) ∂ν := by + simp [fDiv, Measure.singularPart_eq_zero_of_ac h] + +lemma fDiv_absolutelyContinuous_add_mutuallySingular {μ₁ μ₂ ν : Measure α} + [SigmaFinite μ₁] [SigmaFinite μ₂] [SigmaFinite ν] (h₁ : μ₁ ≪ ν) (h₂ : μ₂ ⟂ₘ ν) : + fDiv f (μ₁ + μ₂) ν = fDiv f μ₁ ν + f.derivAtTop * μ₂ .univ := by + have h1 : μ₁.singularPart ν = 0 := (Measure.singularPart_eq_zero _ _).mpr h₁ + have h2 : (μ₁ + μ₂).singularPart ν = μ₂ := by + rw [Measure.singularPart_add, h1, zero_add, Measure.singularPart_eq_self.mpr h₂] + have h_ae : (fun x ↦ f ((∂μ₁ + μ₂/∂ν) x)) =ᵐ[ν] (fun x ↦ f ((∂μ₁/∂ν) x)) := by + have h_zero : (∂μ₂/∂ν) =ᵐ[ν] 0 := (Measure.rnDeriv_eq_zero _ _).mpr h₂ + filter_upwards [h_zero, Measure.rnDeriv_add' μ₁ μ₂ ν] with x hx_zero hx_add + rw [hx_add, Pi.add_apply, hx_zero] + simp only [Pi.zero_apply, add_zero] + simp [fDiv, lintegral_congr_ae h_ae, h1, h2] + +lemma fDiv_eq_add_withDensity_derivAtTop + (μ ν : Measure α) [SigmaFinite μ] [SigmaFinite ν] : + fDiv f μ ν = fDiv f (ν.withDensity (∂μ/∂ν)) ν + f.derivAtTop * μ.singularPart ν .univ := by + conv_lhs => rw [μ.haveLebesgueDecomposition_add ν, add_comm, + fDiv_absolutelyContinuous_add_mutuallySingular (withDensity_absolutelyContinuous _ _) + (Measure.mutuallySingular_singularPart _ _)] + +end AbsolutelyContinuousMutuallySingular + +section AddMeasure + +/-- Auxiliary lemma for `fDiv_add_measure_le`. -/ +lemma fDiv_add_measure_le_of_ac {μ₁ μ₂ ν : Measure α} [SigmaFinite μ₁] [SigmaFinite μ₂] + [SigmaFinite ν] (h₁ : μ₁ ≪ ν) (h₂ : μ₂ ≪ ν) : + fDiv f (μ₁ + μ₂) ν ≤ fDiv f μ₁ ν + f.derivAtTop * μ₂ univ := by + have h_le : ∀ᵐ x ∂ν, f ((∂μ₁ + μ₂/∂ν) x) + ≤ f ((∂μ₁/∂ν) x) + f.derivAtTop * ((∂μ₂/∂ν) x) := by + filter_upwards [μ₁.rnDeriv_add' μ₂ ν] with x hx + rw [hx, Pi.add_apply] + exact f.apply_add_le _ _ + rw [fDiv_of_absolutelyContinuous (Measure.AbsolutelyContinuous.add_left_iff.mpr ⟨h₁, h₂⟩), + fDiv_of_absolutelyContinuous h₁] + calc ∫⁻ x, f ((∂μ₁ + μ₂/∂ν) x) ∂ν + ≤ ∫⁻ x, f ((∂μ₁/∂ν) x) + f.derivAtTop * (∂μ₂/∂ν) x ∂ν := lintegral_mono_ae h_le + _ ≤ ∫⁻ x, f ((∂μ₁/∂ν) x) ∂ν + f.derivAtTop * μ₂ .univ := by + rw [lintegral_add_left DivFunction.measurable_comp_rnDeriv, + lintegral_const_mul _ (Measure.measurable_rnDeriv _ _), Measure.lintegral_rnDeriv h₂] + +/-- Decomposition of `fDiv f μ ν` according to the Lebesgue decomposition of `μ` with respect to +`ν`, in additive form: the term `f 0 * ν univ` accounts for the value of `f` at `0` on the singular +part. -/ +lemma fDiv_add_eq_add_withDensity_singularPart + (μ ν : Measure α) [SigmaFinite μ] [SigmaFinite ν] : + fDiv f μ ν + f 0 * ν .univ + = fDiv f (ν.withDensity (∂μ/∂ν)) ν + fDiv f (μ.singularPart ν) ν := by + rw [fDiv_of_mutuallySingular (μ.mutuallySingular_singularPart ν), + fDiv_eq_add_withDensity_derivAtTop μ ν] + ring + +lemma fDiv_add_measure_le (μ₁ μ₂ ν : Measure α) [SigmaFinite μ₁] [SigmaFinite μ₂] + [SigmaFinite ν] : + fDiv f (μ₁ + μ₂) ν ≤ fDiv f μ₁ ν + f.derivAtTop * μ₂ .univ := by + rw [μ₂.haveLebesgueDecomposition_add ν, μ₁.haveLebesgueDecomposition_add ν] + have : μ₁.singularPart ν + ν.withDensity (∂μ₁/∂ν) + (μ₂.singularPart ν + ν.withDensity (∂μ₂/∂ν)) + = (ν.withDensity (∂μ₁/∂ν) + ν.withDensity (∂μ₂/∂ν)) + + (μ₁.singularPart ν + μ₂.singularPart ν) := by + abel + rw [this, fDiv_absolutelyContinuous_add_mutuallySingular + ((withDensity_absolutelyContinuous _ _).add_left (withDensity_absolutelyContinuous _ _)) + ((μ₁.mutuallySingular_singularPart _).add_left (μ₂.mutuallySingular_singularPart _))] + simp only [Measure.coe_add, Pi.add_apply] + conv_rhs => rw [add_comm (μ₁.singularPart ν)] + rw [fDiv_absolutelyContinuous_add_mutuallySingular (withDensity_absolutelyContinuous _ _) + (μ₁.mutuallySingular_singularPart _)] + calc fDiv f (ν.withDensity (∂μ₁/∂ν) + ν.withDensity (∂μ₂/∂ν)) ν + + f.derivAtTop * (μ₁.singularPart ν univ + μ₂.singularPart ν univ) + _ ≤ fDiv f (ν.withDensity (∂μ₁/∂ν)) ν + f.derivAtTop * ν.withDensity (∂μ₂/∂ν) univ + + f.derivAtTop * μ₁.singularPart ν univ + f.derivAtTop * μ₂.singularPart ν univ := by + rw [mul_add, add_assoc] + gcongr + exact fDiv_add_measure_le_of_ac (withDensity_absolutelyContinuous _ _) + (withDensity_absolutelyContinuous _ _) + _ = fDiv f (ν.withDensity (∂μ₁/∂ν)) ν + f.derivAtTop * μ₁.singularPart ν univ + + f.derivAtTop * (μ₂.singularPart ν univ + ν.withDensity (∂μ₂/∂ν) univ) := by + ring + +lemma fDiv_le_zero_add_top [SigmaFinite μ] [SigmaFinite ν] : + fDiv f μ ν ≤ f 0 * ν .univ + f.derivAtTop * μ .univ := by + simpa using fDiv_add_measure_le (f := f) 0 μ ν + +end AddMeasure + +section derivAtTopTop + +lemma fDiv_of_not_ac [SigmaFinite μ] [SigmaFinite ν] (hf : f.derivAtTop = ∞) (hμν : ¬ μ ≪ ν) : + fDiv f μ ν = ∞ := by + rw [fDiv, hf] + suffices μ.singularPart ν .univ ≠ 0 by + rw [ENNReal.add_eq_top, ENNReal.top_mul this] + exact Or.inr rfl + simp only [ne_eq, Measure.measure_univ_eq_zero] + rw [Measure.singularPart_eq_zero] + exact hμν + +lemma fDiv_ne_top_iff_ac [SigmaFinite μ] [SigmaFinite ν] (hf : f.derivAtTop = ∞) + (h_int : ∫⁻ x, f ((∂μ/∂ν) x) ∂ν ≠ ∞) : + fDiv f μ ν ≠ ∞ ↔ μ ≪ ν := by + refine ⟨fun h ↦ ?_, fun h ↦ by rwa [fDiv_of_absolutelyContinuous h]⟩ + by_contra h_not_ac + exact h (fDiv_of_not_ac hf h_not_ac) + +lemma fDiv_of_derivAtTop_eq_top [SigmaFinite μ] [SigmaFinite ν] (hf : f.derivAtTop = ∞) + [Decidable (μ ≪ ν)] : + fDiv f μ ν = if μ ≪ ν then ∫⁻ x, f ((∂μ/∂ν) x) ∂ν else ∞ := by + split_ifs with h + · rw [fDiv_of_absolutelyContinuous h] + · rw [fDiv_of_not_ac _ h] + exact hf + +end derivAtTopTop + +lemma fDiv_eq_top_iff_of_derivAtTop_ne_top [IsFiniteMeasure μ] (hf : f.derivAtTop ≠ ∞) : + fDiv f μ ν = ∞ ↔ ∫⁻ x, f ((∂μ/∂ν) x) ∂ν = ∞ := by + simp [fDiv, ENNReal.mul_eq_top, hf] + +lemma fDiv_ne_top_iff_of_derivAtTop_ne_top [IsFiniteMeasure μ] (hf : f.derivAtTop ≠ ∞) : + fDiv f μ ν ≠ ∞ ↔ ∫⁻ x, f ((∂μ/∂ν) x) ∂ν ≠ ∞ := + (fDiv_eq_top_iff_of_derivAtTop_ne_top hf).not + +lemma fDiv_ne_top_of_derivAtTop_ne_top [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (h_zero : f 0 ≠ ∞) (h_top : f.derivAtTop ≠ ∞) : + fDiv f μ ν ≠ ∞ := + (fDiv_ne_top_iff_of_derivAtTop_ne_top h_top).mpr + (f.lintegral_comp_rnDeriv_ne_top μ ν h_zero h_top) + +lemma fDiv_eq_top_iff [IsFiniteMeasure μ] [SigmaFinite ν] : + fDiv f μ ν = ∞ + ↔ (∫⁻ x, f ((∂μ/∂ν) x) ∂ν = ∞) ∨ (f.derivAtTop = ∞ ∧ ¬ μ ≪ ν) := by + simp [fDiv, ENNReal.mul_eq_top, Measure.singularPart_eq_zero] + +lemma fDiv_eq_top_iff' [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + fDiv f μ ν = ∞ + ↔ (f.derivAtTop = ∞ ∧ ¬ μ ≪ ν) + ∨ ((f 0 = ∞ ∨ f.derivAtTop = ∞) ∧ ∫⁻ x, f ((∂μ/∂ν) x) ∂ν = ∞) := by + by_cases h_top : f.derivAtTop = ∞ + · rw [fDiv_eq_top_iff] + simp only [h_top, true_and] + tauto + by_cases h_zero : f 0 = ∞ + · rw [fDiv_eq_top_iff] + simp [h_top, h_zero] + simp only [h_top, false_and, h_zero, or_self, iff_false] + exact fDiv_ne_top_of_derivAtTop_ne_top h_zero h_top + +lemma fDiv_ne_top_iff [IsFiniteMeasure μ] [SigmaFinite ν] : + fDiv f μ ν ≠ ∞ + ↔ (∫⁻ x, f ((∂μ/∂ν) x) ∂ν ≠ ∞) ∧ (f.derivAtTop = ∞ → μ ≪ ν) := by + rw [ne_eq, fDiv_eq_top_iff] + push Not + rfl + +lemma fDiv_ne_top_iff' [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + fDiv f μ ν ≠ ∞ + ↔ ((f.derivAtTop = ∞ → μ ≪ ν) + ∧ ((f 0 = ∞ ∨ f.derivAtTop = ∞) → ∫⁻ x, f ((∂μ/∂ν) x) ∂ν ≠ ∞)) := by + rw [ne_eq, fDiv_eq_top_iff'] + push Not + rfl + +/-- Jensen-type lower bound on `fDiv` for absolutely continuous measures. -/ +lemma le_fDiv_of_ac [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hμν : μ ≪ ν) : + ν .univ * f (μ .univ / ν .univ) ≤ fDiv f μ ν := by + rcases eq_zero_or_neZero ν with rfl | hν + · simp + rw [fDiv_of_absolutelyContinuous hμν, ← Measure.lintegral_rnDeriv hμν, ← laverage_eq] + calc ν .univ * f (⨍⁻ x, (∂μ/∂ν) x ∂ν) + _ ≤ ν .univ * ⨍⁻ x, f ((∂μ/∂ν) x) ∂ν := by + gcongr + exact f.map_laverage_le (μ.measurable_rnDeriv ν).aemeasurable + (Measure.lintegral_rnDeriv_lt_top _ _).ne + _ = ∫⁻ x, f ((∂μ/∂ν) x) ∂ν := by + rw [laverage_eq, ENNReal.mul_div_cancel (by simp [NeZero.ne ν]) (measure_ne_top _ _)] + +/-- Jensen-type lower bound on `fDiv`. For probability measures, it reads +`f (μ univ) ≤ fDiv f μ ν`. -/ +lemma le_fDiv [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + ν .univ * f (μ .univ / ν .univ) ≤ fDiv f μ ν := by + rcases eq_zero_or_neZero ν with rfl | hν + · simp + have hμ : μ .univ = ν.withDensity (∂μ/∂ν) .univ + μ.singularPart ν .univ := by + conv_lhs => rw [μ.haveLebesgueDecomposition_add ν, add_comm] + simp + calc ν .univ * f (μ .univ / ν .univ) + _ ≤ ν .univ * (f (ν.withDensity (∂μ/∂ν) .univ / ν .univ) + + f.derivAtTop * (μ.singularPart ν .univ / ν .univ)) := by + rw [hμ, ENNReal.add_div] + gcongr + exact f.apply_add_le _ _ + _ = ν .univ * f (ν.withDensity (∂μ/∂ν) .univ / ν .univ) + + f.derivAtTop * μ.singularPart ν .univ := by + rw [mul_add, mul_left_comm (ν .univ), + ENNReal.mul_div_cancel (by simp [NeZero.ne ν]) (measure_ne_top _ _)] + _ ≤ fDiv f (ν.withDensity (∂μ/∂ν)) ν + f.derivAtTop * μ.singularPart ν .univ := by + gcongr + exact le_fDiv_of_ac (withDensity_absolutelyContinuous _ _) + _ = fDiv f μ ν := (fDiv_eq_add_withDensity_derivAtTop μ ν).symm + +/-- If `f ≤ g` almost everywhere on the image of `∂μ/∂ν` and `f.derivAtTop ≤ g.derivAtTop`, then +`fDiv f μ ν ≤ fDiv g μ ν`. -/ +lemma fDiv_mono_ae (hfg : f ≤ᵐ[ν.map (∂μ/∂ν)] g) (hfg' : f.derivAtTop ≤ g.derivAtTop) : + fDiv f μ ν ≤ fDiv g μ ν := by + rw [fDiv, fDiv] + refine add_le_add (lintegral_mono_ae ?_) (by gcongr) + exact ae_of_ae_map (μ.measurable_rnDeriv ν).aemeasurable hfg + +/-- If `f ≤ g` then `fDiv f μ ν ≤ fDiv g μ ν`. -/ +lemma fDiv_mono (hfg : ∀ x, f x ≤ g x) : fDiv f μ ν ≤ fDiv g μ ν := + fDiv_mono_ae (.of_forall hfg) (DivFunction.derivAtTop_mono hfg) + +/-- For a divergence function which is strictly convex on a neighborhood `(a, b)` of `1`, +`fDiv f μ ν = 0 ↔ μ = ν`. -/ +lemma fDiv_eq_zero_iff [IsFiniteMeasure μ] [IsFiniteMeasure ν] {a b : ℝ} (ha : a < 1) + (hb : 1 < b) (hf_cvx : StrictConvexOn ℝ (Ioo a b) f.realFun) : + fDiv f μ ν = 0 ↔ μ = ν := by + refine ⟨fun h ↦ ?_, fun h ↦ h ▸ fDiv_self _⟩ + have h_eq_zero_iff x : f x = 0 ↔ x = 1 := f.eq_zero_iff ha hb hf_cvx + -- by strict convexity, `f 2 ≠ 0`, hence `f.derivAtTop ≠ 0` + have h_deriv : f.derivAtTop ≠ 0 := by + intro h0 + have h2 := f.apply_le_derivAtTop_mul (y := 2) one_le_two + rw [h0, zero_mul, nonpos_iff_eq_zero, h_eq_zero_iff] at h2 + norm_num at h2 + rw [fDiv, add_eq_zero, mul_eq_zero, + lintegral_eq_zero_iff DivFunction.measurable_comp_rnDeriv] at h + have hμν : μ ≪ ν := by + rw [← Measure.singularPart_eq_zero] + simpa [h_deriv] using h.2 + refine (Measure.rnDeriv_eq_one_iff_eq hμν).mp ?_ + filter_upwards [h.1] with x hx + simpa [h_eq_zero_iff] using hx + +lemma fDiv_map_measurableEmbedding [SigmaFinite μ] [SigmaFinite ν] + {g : α → β} (hg : MeasurableEmbedding g) : + fDiv f (μ.map g) (ν.map g) = fDiv f μ ν := by + rw [fDiv, fDiv, hg.lintegral_map] + congr 1 + · refine lintegral_congr_ae ?_ + filter_upwards [hg.rnDeriv_map μ ν] with a ha using ha ▸ rfl + · rw [hg.singularPart_map μ ν, hg.map_apply, preimage_univ] + +section Restrict + +lemma fDiv_restrict (μ ν : Measure α) [SigmaFinite μ] [SigmaFinite ν] + {s : Set α} (hs : MeasurableSet s) : + fDiv f (μ.restrict s) ν = ∫⁻ x in s, f ((∂μ/∂ν) x) ∂ν + + f 0 * ν sᶜ + f.derivAtTop * (μ.singularPart ν s) := by + classical + have h : (fun x ↦ f ((∂μ.restrict s/∂ν) x)) + =ᵐ[ν] s.piecewise (fun x ↦ f ((∂μ/∂ν) x)) (fun _ ↦ f 0) := by + filter_upwards [μ.rnDeriv_restrict ν hs] with a ha + rw [ha] + by_cases has : a ∈ s <;> simp [has] + rw [fDiv, μ.singularPart_restrict ν hs, Measure.restrict_apply_univ, lintegral_congr_ae h, + lintegral_piecewise hs.nullMeasurableSet, setLIntegral_const] + +lemma fDiv_restrict_restrict (μ ν : Measure α) [SigmaFinite μ] [SigmaFinite ν] + {s : Set α} (hs : MeasurableSet s) : + fDiv f (μ.restrict s) (ν.restrict s) + = ∫⁻ x in s, f ((∂μ/∂ν) x) ∂ν + f.derivAtTop * μ.singularPart ν s := by + rw [fDiv, Measure.singularPart_restrict_restrict μ ν hs, Measure.restrict_apply_univ, + lintegral_congr_ae ?_] + filter_upwards [Measure.rnDeriv_restrict_restrict μ ν hs] with x hx + rw [hx] + +/-- An f-divergence splits as the sum of the divergences of the restrictions to a measurable set +and to its complement. -/ +lemma fDiv_eq_fDiv_restrict_add_fDiv_restrict_compl (μ ν : Measure α) [SigmaFinite μ] + [SigmaFinite ν] {s : Set α} (hs : MeasurableSet s) : + fDiv f μ ν = fDiv f (μ.restrict s) (ν.restrict s) + fDiv f (μ.restrict sᶜ) (ν.restrict sᶜ) := by + rw [fDiv_restrict_restrict μ ν hs, fDiv_restrict_restrict μ ν hs.compl, add_add_add_comm, + lintegral_add_compl _ hs, ← mul_add, measure_add_measure_compl hs, fDiv] + +end Restrict + +section OfReal + +/-! ### f-divergences for a `DivFunction` given by `DivFunction.ofReal` -/ + +variable {f : ℝ → ℝ} {hf : ConvexOn ℝ (Ioi 0) f} {hf_one : f 1 = 0} + +lemma fDiv_ofReal_of_not_integrable [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (hf_nonneg : ∀ x, 0 ≤ x → 0 ≤ f x) + (h : ¬ Integrable (fun x ↦ f ((∂μ/∂ν) x).toReal) ν) : + fDiv (.ofReal f hf hf_one) μ ν = ∞ := + fDiv_of_lintegral_eq_top <| + DivFunction.lintegral_ofReal_eq_top_of_not_integrable hf_nonneg h + +lemma fDiv_ofReal_eq_integral_add [IsFiniteMeasure μ] + (hf_nonneg : ∀ x, 0 ≤ x → 0 ≤ f x) (h_cont : ContinuousWithinAt f (Ioi 0) 0) + (h_int : Integrable (fun x ↦ f ((∂μ/∂ν) x).toReal) ν) : + fDiv (.ofReal f hf hf_one) μ ν + = ENNReal.ofReal (∫ x, f ((∂μ/∂ν) x).toReal ∂ν) + + (DivFunction.ofReal f hf hf_one).derivAtTop * μ.singularPart ν univ := by + rw [fDiv, DivFunction.lintegral_ofReal_eq_integral_of_continuous hf_nonneg h_cont h_int] + +lemma fDiv_ofReal_eq_top_iff_of_derivAtTop_eq_top [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (hf_nonneg : ∀ x, 0 ≤ x → 0 ≤ f x) (h_cont : ContinuousWithinAt f (Ioi 0) 0) + (h_top : (DivFunction.ofReal f hf hf_one).derivAtTop = ∞) : + fDiv (.ofReal f hf hf_one) μ ν = ∞ + ↔ ¬ Integrable (fun x ↦ f ((∂μ/∂ν) x).toReal) ν ∨ ¬ μ ≪ ν := by + by_cases h_int : Integrable (fun x ↦ f ((∂μ/∂ν) x).toReal) ν + · simp only [fDiv_ofReal_eq_integral_add hf_nonneg h_cont h_int, h_top, ENNReal.add_eq_top, + ENNReal.ofReal_ne_top, ENNReal.mul_eq_top, ne_eq, ENNReal.top_ne_zero, not_false_eq_true, + measure_ne_top, and_false, Measure.measure_univ_eq_zero, true_and, false_or, h_int, + not_true_eq_false, Measure.singularPart_eq_zero] + · simp [h_int, fDiv_ofReal_of_not_integrable hf_nonneg h_int] + +lemma fDiv_ofReal_eq_integral_of_ac [IsFiniteMeasure μ] + (hf_nonneg : ∀ x, 0 ≤ x → 0 ≤ f x) (h_cont : ContinuousWithinAt f (Ioi 0) 0) + (h_int : Integrable (fun x ↦ f ((∂μ/∂ν) x).toReal) ν) (hμν : μ ≪ ν) : + fDiv (.ofReal f hf hf_one) μ ν = ENNReal.ofReal (∫ x, f ((∂μ/∂ν) x).toReal ∂ν) := by + rw [fDiv_ofReal_eq_integral_add hf_nonneg h_cont h_int, Measure.singularPart_eq_zero_of_ac hμν] + simp + +lemma fDiv_ofReal_eq_lintegral_of_ac [IsFiniteMeasure μ] + (hf_nonneg : ∀ x, 0 ≤ x → 0 ≤ f x) (h_cont : ContinuousWithinAt f (Ioi 0) 0) + (h_int : Integrable (fun x ↦ f ((∂μ/∂ν) x).toReal) ν) (hμν : μ ≪ ν) : + fDiv (.ofReal f hf hf_one) μ ν + = ∫⁻ x, ENNReal.ofReal (f ((∂μ/∂ν) x).toReal) ∂ν := by + rw [fDiv_ofReal_eq_integral_of_ac hf_nonneg h_cont h_int hμν, + ofReal_integral_eq_lintegral_ofReal h_int] + exact ae_of_all _ fun x ↦ hf_nonneg _ ENNReal.toReal_nonneg + +lemma toReal_fDiv_ofReal_eq_integral_add [IsFiniteMeasure μ] + (hf_nonneg : ∀ x, 0 ≤ x → 0 ≤ f x) (h_cont : ContinuousWithinAt f (Ioi 0) 0) + (h_int : Integrable (fun x ↦ f ((∂μ/∂ν) x).toReal) ν) + (h_ne : (DivFunction.ofReal f hf hf_one).derivAtTop ≠ ∞) : + (fDiv (.ofReal f hf hf_one) μ ν).toReal + = ∫ x, f ((∂μ/∂ν) x).toReal ∂ν + + (DivFunction.ofReal f hf hf_one).derivAtTop.toReal * (μ.singularPart ν univ).toReal := by + rw [fDiv_ofReal_eq_integral_add hf_nonneg h_cont h_int, ENNReal.toReal_add, ENNReal.toReal_mul, + ENNReal.toReal_ofReal] + · exact integral_nonneg (fun _ ↦ hf_nonneg _ ENNReal.toReal_nonneg) + · exact ENNReal.ofReal_ne_top + · exact ENNReal.mul_ne_top h_ne (measure_ne_top _ _) + +lemma toReal_fDiv_ofReal_eq_integral_add_of_ac [IsFiniteMeasure μ] + (hf_nonneg : ∀ x, 0 ≤ x → 0 ≤ f x) (h_cont : ContinuousWithinAt f (Ioi 0) 0) + (h_int : Integrable (fun x ↦ f ((∂μ/∂ν) x).toReal) ν) + (h_ac : μ ≪ ν) : + (fDiv (.ofReal f hf hf_one) μ ν).toReal = ∫ x, f ((∂μ/∂ν) x).toReal ∂ν := by + rw [fDiv_ofReal_eq_integral_of_ac hf_nonneg h_cont h_int h_ac, + ENNReal.toReal_ofReal (integral_nonneg fun _ ↦ hf_nonneg _ ENNReal.toReal_nonneg)] + +end OfReal + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/CompProd.lean b/Statlib/Divergence/FDiv/CompProd.lean new file mode 100644 index 0000000..3277257 --- /dev/null +++ b/Statlib/Divergence/FDiv/CompProd.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.Probability.Kernel.Composition.RadonNikodym +public import Statlib.Divergence.FDiv.Trim +public import Statlib.ForMathlib.Probability.Kernel.Composition.MeasureCompProd + +/-! +# f-Divergences of composition-products and data-processing inequalities + +## Main statements + +* `fDiv_compProd_left`: `fDiv f (μ ⊗ₘ κ) (ν ⊗ₘ κ) = fDiv f μ ν` for a Markov kernel `κ`. +* `fDiv_prod_left`: `fDiv f (μ.prod ξ) (ν.prod ξ) = fDiv f μ ν` for a probability measure `ξ`. +* `fDiv_comp_right_le`: **data-processing inequality**, + `fDiv f (κ ∘ₘ μ) (κ ∘ₘ ν) ≤ fDiv f μ ν` for a Markov kernel `κ`. +* `fDiv_fst_le`, `fDiv_snd_le`, `le_fDiv_compProd`, `fDiv_comp_le_compProd`: other forms of the + data-processing inequality. +* `fDiv_comp_eq_of_comp_eq_id`: a kernel with a Markov left inverse preserves f-divergences. + For example, a kernel `κ : α → α × β` with `κ.fst = Kernel.id` (`fDiv_comp_eq_of_fst_eq_id`). + +The data-processing inequalities follow from the data-processing inequality for measurable maps +`fDiv_map_le`, which rests on Jensen's inequality for the conditional Lebesgue expectation. They +hold without any assumption on the measurable spaces. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds), which also proves these inequalities through +the disintegration of the composition-product, under assumptions on the measurable spaces. +-/ + +@[expose] public section + +open MeasureTheory + +namespace ProbabilityTheory + +variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} {f : DivFunction} + +@[simp] +lemma fDiv_compProd_left (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ : Kernel α β) [IsMarkovKernel κ] : + fDiv f (μ ⊗ₘ κ) (ν ⊗ₘ κ) = fDiv f μ ν := by + refine fDiv_congr_measure ?_ ?_ + · have h_eq : (fun x ↦ f ((∂μ ⊗ₘ κ/∂ν ⊗ₘ κ) x)) + =ᵐ[ν ⊗ₘ κ] fun x ↦ f ((∂μ/∂ν) x.1) := by + filter_upwards [rnDeriv_measure_compProd_left μ ν κ] with x hx + rw [hx] + rw [lintegral_congr_ae h_eq, Measure.lintegral_compProd] + · simp + · exact DivFunction.measurable_comp_rnDeriv.comp measurable_fst + · rw [singularPart_compProd_left, Measure.compProd_apply_univ] + +/-- The f-divergence is invariant under taking the product with a probability measure. -/ +lemma fDiv_prod_left (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ξ : Measure β) [IsProbabilityMeasure ξ] : + fDiv f (μ.prod ξ) (ν.prod ξ) = fDiv f μ ν := by + simpa [Measure.compProd_const] using fDiv_compProd_left (f := f) μ ν (Kernel.const α ξ) + +lemma fDiv_fst_le (μ ν : Measure (α × β)) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + fDiv f μ.fst ν.fst ≤ fDiv f μ ν := + fDiv_map_le measurable_fst + +lemma fDiv_snd_le (μ ν : Measure (α × β)) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + fDiv f μ.snd ν.snd ≤ fDiv f μ ν := + fDiv_map_le measurable_snd + +/-- Composing with Markov kernels can only increase an f-divergence, even with different kernels +on the two sides. -/ +lemma le_fDiv_compProd (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ η : Kernel α β) [IsMarkovKernel κ] [IsMarkovKernel η] : + fDiv f μ ν ≤ fDiv f (μ ⊗ₘ κ) (ν ⊗ₘ η) := by + have h := fDiv_fst_le (f := f) (μ ⊗ₘ κ) (ν ⊗ₘ η) + rwa [Measure.fst_compProd, Measure.fst_compProd] at h + +lemma fDiv_comp_le_compProd (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + fDiv f (κ ∘ₘ μ) (η ∘ₘ ν) ≤ fDiv f (μ ⊗ₘ κ) (ν ⊗ₘ η) := by + simp_rw [← Measure.snd_compProd] + exact fDiv_snd_le _ _ + +/-- **Data processing inequality** for the f-divergence. -/ +theorem fDiv_comp_right_le (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ : Kernel α β) [IsMarkovKernel κ] : + fDiv f (κ ∘ₘ μ) (κ ∘ₘ ν) ≤ fDiv f μ ν := + (fDiv_comp_le_compProd μ ν κ κ).trans_eq (fDiv_compProd_left μ ν κ) + +/-- A kernel `κ` with a Markov left inverse `η`, that is `η ∘ₖ κ = Kernel.id`, preserves +f-divergences. Such a kernel is Markov. -/ +lemma fDiv_comp_eq_of_comp_eq_id (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ : Kernel α β) (η : Kernel β α) [IsMarkovKernel η] (h : η ∘ₖ κ = Kernel.id) : + fDiv f (κ ∘ₘ μ) (κ ∘ₘ ν) = fDiv f μ ν := by + have : IsMarkovKernel κ := ⟨fun x ↦ ⟨by + simpa [Kernel.comp_apply' _ _ _ MeasurableSet.univ] using congr(($h x) Set.univ)⟩⟩ + refine le_antisymm (fDiv_comp_right_le μ ν κ) ?_ + calc fDiv f μ ν = fDiv f (η ∘ₘ (κ ∘ₘ μ)) (η ∘ₘ (κ ∘ₘ ν)) := by + rw [Measure.comp_assoc, Measure.comp_assoc, h, Measure.id_comp, Measure.id_comp] + _ ≤ fDiv f (κ ∘ₘ μ) (κ ∘ₘ ν) := fDiv_comp_right_le _ _ η + +/-- A kernel `κ : α → α × β` such that the first marginal of `κ x` is `δ_x` for all `x` +preserves f-divergences. -/ +lemma fDiv_comp_eq_of_fst_eq_id (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ : Kernel α (α × β)) (hκ : κ.fst = Kernel.id) : + fDiv f (κ ∘ₘ μ) (κ ∘ₘ ν) = fDiv f μ ν := + fDiv_comp_eq_of_comp_eq_id μ ν κ (Kernel.deterministic Prod.fst measurable_fst) + (by rwa [Kernel.deterministic_comp_eq_map, ← Kernel.fst_eq]) + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/CondFDiv.lean b/Statlib/Divergence/FDiv/CondFDiv.lean new file mode 100644 index 0000000..b1f36fb --- /dev/null +++ b/Statlib/Divergence/FDiv/CondFDiv.lean @@ -0,0 +1,279 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Statlib.ForMathlib.Probability.Kernel.Composition.MeasureCompProd +public import Mathlib.MeasureTheory.Order.Group.Lattice +public import Mathlib.Probability.Kernel.Integral +public import Statlib.Divergence.FDiv.CompProd +public import Statlib.Divergence.FDiv.Measurable +public import Mathlib.MeasureTheory.MeasurableSpace.CountablyGenerated + +/-! + +# Conditional f-divergence + +## Main definitions + +* `condFDiv f κ η μ`: the conditional f-divergence `∫⁻ x, fDiv f (κ x) (η x) ∂μ` between the + kernels `κ` and `η` with respect to the measure `μ`. + +## Main statements + +* `condFDiv_ne_top_iff`, `condFDiv_eq_top_iff`: finiteness of the conditional f-divergence. +* `fDiv_compProd_right`: `fDiv f (μ ⊗ₘ κ) (μ ⊗ₘ η) = condFDiv f κ η μ`. +* `fDiv_comp_left_le`: `fDiv f (κ ∘ₘ μ) (η ∘ₘ μ) ≤ condFDiv f κ η μ`. +* `condFDiv_measure_compProd`: the conditional f-divergence with respect to a + composition-product `μ ⊗ₘ ξ` is an iterated conditional f-divergence. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Real MeasureTheory Filter MeasurableSpace Set + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} + {μ ν : Measure α} {κ η : Kernel α β} {f g : DivFunction} + +section Conditional + +/-- Conditional f-divergence. -/ +noncomputable +def condFDiv (f : DivFunction) (κ η : Kernel α β) (μ : Measure α) : ℝ≥0∞ := + ∫⁻ x, fDiv f (κ x) (η x) ∂μ + +/-- Equivalence between two possible versions of the first condition for the finiteness of the +conditional f divergence, the second version is the preferred one. -/ +lemma fDiv_ae_ne_top_iff [IsFiniteKernel κ] [IsFiniteKernel η] : + (∀ᵐ a ∂μ, fDiv f (κ a) (η a) ≠ ∞) + ↔ (∀ᵐ a ∂μ, ∫⁻ x, f ((∂κ a/∂η a) x) ∂η a ≠ ∞) ∧ (f.derivAtTop = ∞ → ∀ᵐ a ∂μ, κ a ≪ η a) := by + simp_rw [fDiv_ne_top_iff, eventually_and, eventually_all] + +section CondFDivEq + +variable [CountableOrCountablyGenerated α β] + +/-- Equivalence between two possible versions of the second condition for the finiteness of the +conditional f divergence, the second version is the preferred one. -/ +lemma lintegral_fDiv_ne_top_iff [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] + (h_ac : f.derivAtTop = ∞ → ∀ᵐ a ∂μ, κ a ≪ η a) : + ∫⁻ x, fDiv f (κ x) (η x) ∂μ ≠ ∞ ↔ ∫⁻ a, ∫⁻ b, f ((∂κ a/∂η a) b) ∂η a ∂μ ≠ ∞ := by + by_cases h_top : f.derivAtTop = ∞ + · rw [lintegral_congr_ae] + filter_upwards [h_ac h_top] with a ha + rw [fDiv_of_absolutelyContinuous ha] + · simp_rw [fDiv] + rw [lintegral_add_right] + swap + · simp_rw [← Kernel.singularPart_eq_singularPart_measure] + exact (Kernel.measurable_coe _ .univ).const_mul _ + simp only [ne_eq, ENNReal.add_eq_top, not_or, and_iff_left_iff_imp] + intro _ + rw [lintegral_const_mul] + swap + · simp_rw [← Kernel.singularPart_eq_singularPart_measure] + exact Kernel.measurable_coe _ .univ + refine ENNReal.mul_ne_top h_top ?_ + rw [lintegral_singularPart _ _ _ .univ] + simp + +@[simp] +lemma condFDiv_of_not_ae_finite [IsFiniteKernel κ] [IsFiniteKernel η] + (h : ¬ ∀ᵐ a ∂μ, fDiv f (κ a) (η a) ≠ ∞) : + condFDiv f κ η μ = ∞ := by + rw [condFDiv] + by_contra h_not + exact h <| (ae_lt_top (measurable_fDiv κ η) h_not).mono fun _ ha ↦ ha.ne + +@[simp] +lemma condFDiv_of_not_ae_ac [IsFiniteKernel κ] [IsFiniteKernel η] (h_top : f.derivAtTop = ∞) + (h : ¬ ∀ᵐ a ∂μ, κ a ≪ η a) : + condFDiv f κ η μ = ∞ := by + apply condFDiv_of_not_ae_finite + rw [fDiv_ae_ne_top_iff] + tauto + +@[simp] +lemma condFDiv_of_lintegral_eq_top [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] + (hf : ∫⁻ a, ∫⁻ b, f ((∂κ a/∂η a) b) ∂η a ∂μ = ∞) : + condFDiv f κ η μ = ∞ := by + by_cases h_top : ∀ᵐ a ∂μ, fDiv f (κ a) (η a) ≠ ∞ + swap; · exact condFDiv_of_not_ae_finite h_top + by_contra h_ne + exact (lintegral_fDiv_ne_top_iff (fDiv_ae_ne_top_iff.mp h_top).2).mp h_ne hf + +lemma condFDiv_ne_top_iff [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] : + condFDiv f κ η μ ≠ ∞ ↔ + ∫⁻ a, ∫⁻ b, f ((∂κ a/∂η a) b) ∂(η a) ∂μ ≠ ∞ + ∧ (f.derivAtTop = ∞ → ∀ᵐ a ∂μ, κ a ≪ η a) := by + refine ⟨fun h ↦ ⟨fun h_eq ↦ h (condFDiv_of_lintegral_eq_top h_eq), fun h_eq_top ↦ ?_⟩, + fun ⟨h1, h2⟩ ↦ (lintegral_fDiv_ne_top_iff h2).mpr h1⟩ + by_contra h_not + exact h <| condFDiv_of_not_ae_ac h_eq_top h_not + +lemma condFDiv_eq_top_iff [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] : + condFDiv f κ η μ = ∞ ↔ + ∫⁻ a, ∫⁻ b, f ((∂κ a/∂η a) b) ∂(η a) ∂μ = ∞ + ∨ (f.derivAtTop = ∞ ∧ ¬ ∀ᵐ a ∂μ, κ a ≪ η a) := by + have h := condFDiv_ne_top_iff (κ := κ) (η := η) (μ := μ) (f := f) + tauto + +lemma toReal_condFDiv_eq_integral [IsFiniteKernel κ] [IsFiniteKernel η] + (h : condFDiv f κ η μ ≠ ∞) : + (condFDiv f κ η μ).toReal = ∫ x, (fDiv f (κ x) (η x)).toReal ∂μ := by + rw [condFDiv, integral_toReal (measurable_fDiv _ _).aemeasurable] + exact ae_lt_top (measurable_fDiv _ _) h + +lemma condFDiv_eq_add [IsFiniteKernel κ] [IsFiniteKernel η] : + condFDiv f κ η μ = ∫⁻ a, ∫⁻ y, f ((∂κ a/∂η a) y) ∂η a ∂μ + + f.derivAtTop * ∫⁻ a, (κ a).singularPart (η a) .univ ∂μ := by + simp_rw [condFDiv, fDiv] + rw [lintegral_add_right] + swap; · exact ((Measure.measurable_coe .univ).comp (κ.measurable_singularPart η)).const_mul _ + rw [lintegral_const_mul] + exact (Measure.measurable_coe .univ).comp (κ.measurable_singularPart η) + +lemma condFDiv_of_ae_ac [IsFiniteKernel κ] [IsFiniteKernel η] (h_ac : ∀ᵐ a ∂μ, κ a ≪ η a) : + condFDiv f κ η μ = ∫⁻ a, ∫⁻ y, f ((∂κ a/∂η a) y) ∂η a ∂μ := by + rw [condFDiv_eq_add] + suffices ∫⁻ a, ((κ a).singularPart (η a)) univ ∂μ = 0 by simp [this] + rw [lintegral_eq_zero_iff] + swap; · exact (Measure.measurable_coe .univ).comp (κ.measurable_singularPart η) + filter_upwards [h_ac] with x hx + simp only [Pi.zero_apply, Measure.measure_univ_eq_zero] + exact Measure.singularPart_eq_zero_of_ac hx + +end CondFDivEq + +@[simp] +lemma condFDiv_self (κ : Kernel α β) (μ : Measure α) [IsFiniteKernel κ] : + condFDiv f κ κ μ = 0 := by + simp [condFDiv, fDiv_self] + +@[simp] +lemma condFDiv_zero_left : + condFDiv f 0 η μ = f 0 * ∫⁻ a, ((η a) .univ) ∂μ := by + rw [condFDiv] + simp only [zero_apply, fDiv_zero_measure_left] + rw [lintegral_const_mul] + exact Kernel.measurable_coe _ .univ + +@[simp] +lemma condFDiv_zero_measure : condFDiv f κ η 0 = 0 := by simp [condFDiv] + +@[simp] +lemma condFDiv_of_isEmpty_left [IsEmpty α] : condFDiv f κ η μ = 0 := by + simp [condFDiv] + +@[simp] +lemma condFDiv_of_isEmpty_right [IsEmpty β] [IsFiniteKernel κ] : + condFDiv f κ η μ = 0 := by + suffices κ = η from by exact this ▸ condFDiv_self κ _ + ext x s _ + simp [s.eq_empty_of_isEmpty] + +@[simp] +lemma condFDiv_const {ξ : Measure β} : + condFDiv f (Kernel.const β μ) (Kernel.const β ν) ξ = (fDiv f μ ν) * ξ .univ := by + simp [condFDiv] + +section CompProd + +variable [CountableOrCountablyGenerated α β] + +/-- For f-divergences, the divergence between two composition-products with same first measure is +equal to the conditional divergence. -/ +theorem fDiv_compProd_right (μ : Measure α) [IsFiniteMeasure μ] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + fDiv f (μ ⊗ₘ κ) (μ ⊗ₘ η) = condFDiv f κ η μ := by + rw [fDiv, condFDiv_eq_add, Measure.lintegral_compProd DivFunction.measurable_comp_rnDeriv, + lintegral_singularPart _ _ _ .univ, univ_prod_univ] + congr 1 + refine lintegral_congr_ae ?_ + filter_upwards [Kernel.rnDeriv_measure_compProd_right' μ κ η] with a ha + refine lintegral_congr_ae ?_ + filter_upwards [ha] with b hb + rw [hb] + +lemma condFDiv_ne_top_iff_fDiv_compProd_ne_top [IsFiniteMeasure μ] + [IsFiniteKernel κ] [IsFiniteKernel η] : + condFDiv f κ η μ ≠ ∞ ↔ fDiv f (μ ⊗ₘ κ) (μ ⊗ₘ η) ≠ ∞ := by + rw [fDiv_compProd_right] + +lemma fDiv_comp_left_le (μ : Measure α) [IsFiniteMeasure μ] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + fDiv f (κ ∘ₘ μ) (η ∘ₘ μ) ≤ condFDiv f κ η μ := by + calc fDiv f (κ ∘ₘ μ) (η ∘ₘ μ) + ≤ fDiv f (μ ⊗ₘ κ) (μ ⊗ₘ η) := fDiv_comp_le_compProd μ μ κ η + _ = condFDiv f κ η μ := fDiv_compProd_right μ κ η + +end CompProd + +section CompProdMeasure + +variable {γ : Type*} {mγ : MeasurableSpace γ} + +/-- The conditional f-divergence with respect to a composition-product `μ ⊗ₘ ξ` is an iterated +conditional f-divergence. -/ +lemma condFDiv_measure_compProd [CountableOrCountablyGenerated (α × β) γ] [SFinite μ] + {ξ : Kernel α β} [IsSFiniteKernel ξ] + {κ η : Kernel (α × β) γ} [IsFiniteKernel κ] [IsFiniteKernel η] : + condFDiv f κ η (μ ⊗ₘ ξ) = ∫⁻ x, condFDiv f (κ.sectR x) (η.sectR x) (ξ x) ∂μ := by + rw [condFDiv, Measure.lintegral_compProd (measurable_fDiv _ _)] + rfl + +end CompProdMeasure + +end Conditional + +section OfReal + +/-! ### Conditional f-divergences for a `DivFunction` given by `DivFunction.ofReal` -/ + +variable {μ : Measure α} {κ η : Kernel α β} + +lemma integrable_fDiv_ofReal_iff_of_ne_top [CountableOrCountablyGenerated α β] + [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] + {f : ℝ → ℝ} {hf : ConvexOn ℝ (Set.Ioi 0) f} {hf_one : f 1 = 0} + (hf_nonneg : ∀ x, 0 ≤ x → 0 ≤ f x) (h_cont : ContinuousWithinAt f (Set.Ioi 0) 0) + (h_int : ∀ᵐ a ∂μ, Integrable (fun x ↦ f ((∂κ a/∂η a) x).toReal) (η a)) + (h_ne : (DivFunction.ofReal f hf hf_one).derivAtTop ≠ ∞) : + Integrable (fun a ↦ (fDiv (.ofReal f hf hf_one) (κ a) (η a)).toReal) μ + ↔ Integrable (fun a ↦ ∫ x, f ((∂κ a/∂η a) x).toReal ∂(η a)) μ := by + have h : ∀ᵐ a ∂μ, (fDiv (.ofReal f hf hf_one) (κ a) (η a)).toReal + = ∫ x, f ((∂κ a/∂η a) x).toReal ∂(η a) + + (DivFunction.ofReal f hf hf_one).derivAtTop.toReal + * ((κ a).singularPart (η a) .univ).toReal := by + filter_upwards [h_int] with a h_int + exact toReal_fDiv_ofReal_eq_integral_add hf_nonneg h_cont h_int h_ne + rw [integrable_congr h, integrable_add_iff_integrable_left'] + refine Integrable.const_mul ?_ _ + refine integrable_toReal_of_lintegral_ne_top ?_ ?_ + · simp_rw [← Kernel.singularPart_eq_singularPart_measure] + exact (Kernel.measurable_coe _ .univ).aemeasurable + · rw [lintegral_singularPart _ _ _ .univ] + simp + +lemma integrable_fDiv_ofReal_iff_of_ac [IsFiniteKernel κ] + {f : ℝ → ℝ} {hf : ConvexOn ℝ (Set.Ioi 0) f} {hf_one : f 1 = 0} + (hf_nonneg : ∀ x, 0 ≤ x → 0 ≤ f x) (h_cont : ContinuousWithinAt f (Set.Ioi 0) 0) + (h_int : ∀ᵐ a ∂μ, Integrable (fun x ↦ f ((∂κ a/∂η a) x).toReal) (η a)) + (hμη : ∀ᵐ a ∂μ, κ a ≪ η a) : + Integrable (fun a ↦ (fDiv (.ofReal f hf hf_one) (κ a) (η a)).toReal) μ + ↔ Integrable (fun a ↦ ∫ x, f ((∂κ a/∂η a) x).toReal ∂(η a)) μ := by + refine integrable_congr ?_ + filter_upwards [h_int, hμη] with a h_int hμη + exact toReal_fDiv_ofReal_eq_integral_add_of_ac hf_nonneg h_cont h_int hμη + +end OfReal + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/Conj.lean b/Statlib/Divergence/FDiv/Conj.lean new file mode 100644 index 0000000..690dab0 --- /dev/null +++ b/Statlib/Divergence/FDiv/Conj.lean @@ -0,0 +1,148 @@ +/- +Copyright (c) 2026 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne +-/ +module + +public import Statlib.Divergence.FDiv.Basic +public import Statlib.Divergence.FDiv.DivFunction.CompAffine +public import Statlib.Divergence.FDiv.DivFunction.Conj + +/-! # f-Divergence of the conjugate divergence function + +## Main statements + +* `fDiv_conj`: `fDiv f.conj μ ν = fDiv f ν μ`. + +The f-divergences involving mixtures `a • μ + b • ν` (with `a + b = 1`) are f-divergences between +`μ` and `ν` for modified divergence functions: +* `fDiv_smul_add_smul_left`: `fDiv f (a • μ + b • ν) ν = fDiv (f.compAffine a b _) μ ν`. +* `fDiv_smul_add_smul_right`: `fDiv f μ (a • μ + b • ν)`, for the function + `x ↦ (a * x + b) * f (x / (a * x + b))`. +* `fDiv_smul_add_smul_right_self`: `fDiv f ν (a • μ + b • ν)`, for the function + `x ↦ (a * x + b) * f (1 / (a * x + b))`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open MeasureTheory Set + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {f : DivFunction} + +/-- The f-divergence for the conjugate function `f.conj` is the f-divergence for `f` with the +measures swapped. -/ +lemma fDiv_conj (μ ν : Measure α) [SigmaFinite μ] [SigmaFinite ν] : + fDiv f.conj μ ν = fDiv f ν μ := by + have h_left : ∫⁻ x, f.conj ((∂μ/∂ν) x) ∂ν + = f.derivAtTop * ν.singularPart μ univ + ∫⁻ x, (∂ν/∂μ) x * f.conj ((∂μ/∂ν) x) ∂μ := by + rw [lintegral_eq_add_singularPart_withDensity μ ν DivFunction.measurable_comp_rnDeriv] + congr 1 + have h : (fun x ↦ f.conj ((∂μ/∂ν) x)) =ᵐ[ν.singularPart μ] fun _ ↦ f.derivAtTop := by + filter_upwards [Measure.rnDeriv_eq_zero_ae_singularPart μ ν] with x hx + simp [hx] + rw [lintegral_congr_ae h, lintegral_const] + have h_right : ∫⁻ x, f ((∂ν/∂μ) x) ∂μ + = f 0 * μ.singularPart ν univ + ∫⁻ x, (∂μ/∂ν) x * f ((∂ν/∂μ) x) ∂ν := by + rw [lintegral_eq_add_singularPart_withDensity ν μ DivFunction.measurable_comp_rnDeriv] + congr 1 + have h : (fun x ↦ f ((∂ν/∂μ) x)) =ᵐ[μ.singularPart ν] fun _ ↦ f 0 := by + filter_upwards [Measure.rnDeriv_eq_zero_ae_singularPart ν μ] with x hx + simp [hx] + rw [lintegral_congr_ae h, lintegral_const] + have h_key : ∫⁻ x, (∂ν/∂μ) x * f.conj ((∂μ/∂ν) x) ∂μ + = ∫⁻ x, (∂μ/∂ν) x * f ((∂ν/∂μ) x) ∂ν := by + rw [lintegral_eq_add_singularPart_withDensity ν μ (g := fun x ↦ (∂ν/∂μ) x * f.conj ((∂μ/∂ν) x)) + ((Measure.measurable_rnDeriv _ _).mul DivFunction.measurable_comp_rnDeriv)] + have h0 : ∫⁻ x, (∂ν/∂μ) x * f.conj ((∂μ/∂ν) x) ∂(μ.singularPart ν) = 0 := by + have h : (fun x ↦ (∂ν/∂μ) x * f.conj ((∂μ/∂ν) x)) =ᵐ[μ.singularPart ν] fun _ ↦ 0 := by + filter_upwards [Measure.rnDeriv_eq_zero_ae_singularPart ν μ] with x hx + simp [hx] + rw [lintegral_congr_ae h, lintegral_zero] + rw [h0, zero_add] + refine lintegral_congr_ae ?_ + filter_upwards [Measure.rnDeriv_eq_inv_rnDeriv_of_ne_zero μ ν, Measure.rnDeriv_ne_top μ ν] + with x hx hx_top + by_cases h0 : (∂μ/∂ν) x = 0 + · simp [h0] + rw [hx h0, DivFunction.conj_of_ne_zero h0, ← mul_assoc, ENNReal.mul_inv_cancel h0 hx_top, + one_mul] + rw [fDiv, fDiv, DivFunction.derivAtTop_conj, h_left, h_right, h_key] + ring + +section Mixture + +variable {a b : ℝ≥0} + +/-- `fDiv f (a • μ + b • ν) ν` is the f-divergence between `μ` and `ν` for the function +`x ↦ f (a * x + b)`. -/ +lemma fDiv_smul_add_smul_left (hab : a + b = 1) (μ ν : Measure α) [SigmaFinite μ] + [SigmaFinite ν] : + fDiv f (a • μ + b • ν) ν = fDiv (f.compAffine a b hab) μ ν := by + have h_rn : (fun x ↦ f ((∂(a • μ + b • ν)/∂ν) x)) =ᵐ[ν] fun x ↦ f (a * (∂μ/∂ν) x + b) := by + filter_upwards [Measure.rnDeriv_add' (a • μ) (b • ν) ν, Measure.rnDeriv_smul_left' μ ν a, + Measure.rnDeriv_smul_left' ν ν b, ν.rnDeriv_self] with x h1 h2 h3 h4 + rw [h1, Pi.add_apply, h2, h3, Pi.smul_apply, Pi.smul_apply, h4] + simp [ENNReal.smul_def] + have h_sing : (a • μ + b • ν).singularPart ν = a • μ.singularPart ν := by + rw [Measure.singularPart_add, Measure.singularPart_smul, Measure.singularPart_smul, + Measure.singularPart_self, smul_zero, add_zero] + rw [fDiv, fDiv, lintegral_congr_ae h_rn, h_sing, DivFunction.derivAtTop_compAffine] + simp only [DivFunction.compAffine_apply, Measure.coe_nnreal_smul_apply] + ring + +/-- `fDiv f ν (a • μ + b • ν)` is the f-divergence between `μ` and `ν` for the function +`x ↦ (a * x + b) * f (1 / (a * x + b))`. -/ +lemma fDiv_smul_add_smul_right_self (hab : a + b = 1) (μ ν : Measure α) [SigmaFinite μ] + [SigmaFinite ν] : + fDiv f ν (a • μ + b • ν) = fDiv (f.conj.compAffine a b hab) μ ν := by + rw [← fDiv_conj, fDiv_smul_add_smul_left] + +/-- `fDiv f μ (a • μ + b • ν)` is the f-divergence between `μ` and `ν` for the function +`x ↦ (a * x + b) * f (x / (a * x + b))`. -/ +lemma fDiv_smul_add_smul_right (hab : a + b = 1) (μ ν : Measure α) [SigmaFinite μ] + [SigmaFinite ν] : + fDiv f μ (a • μ + b • ν) + = fDiv (f.conj.compAffine b a (by rwa [add_comm])).conj μ ν := by + rw [← fDiv_conj, add_comm, fDiv_smul_add_smul_left, fDiv_conj] + +private lemma coe_mul_add_ne_zero (hab : a + b = 1) {x : ℝ≥0∞} (hx0 : x ≠ 0) : + (a : ℝ≥0∞) * x + b ≠ 0 := by + intro h + rw [add_eq_zero, mul_eq_zero] at h + obtain ⟨ha | hx, hb⟩ := h + · simp_all + · exact hx0 hx + +/-- Value of the divergence function of `fDiv_smul_add_smul_right_self` away from `0`. -/ +lemma DivFunction.conj_compAffine_apply (hab : a + b = 1) {x : ℝ≥0∞} (hx0 : x ≠ 0) : + f.conj.compAffine a b hab x = (a * x + b) * f (a * x + b)⁻¹ := by + rw [DivFunction.compAffine_apply, DivFunction.conj_of_ne_zero (coe_mul_add_ne_zero hab hx0)] + +/-- Value of the divergence function of `fDiv_smul_add_smul_right` away from `0` and `∞`. -/ +lemma DivFunction.conj_compAffine_conj_apply (hab : a + b = 1) {x : ℝ≥0∞} (hx0 : x ≠ 0) + (hx : x ≠ ∞) : + (f.conj.compAffine b a (by rwa [add_comm])).conj x = (a * x + b) * f (x / (a * x + b)) := by + have hx_inv : x⁻¹ ≠ 0 := ENNReal.inv_ne_zero.2 hx + have hx_inv' : x⁻¹ ≠ ∞ := ENNReal.inv_ne_top.2 hx0 + have h_eq : (b : ℝ≥0∞) * x⁻¹ + a = x⁻¹ * (a * x + b) := by + rw [mul_add, ← mul_assoc, mul_comm x⁻¹, mul_assoc, ENNReal.inv_mul_cancel hx0 hx, mul_one, + add_comm, mul_comm] + have h0 : (b : ℝ≥0∞) * x⁻¹ + a ≠ 0 := by + rw [h_eq] + exact mul_ne_zero hx_inv (coe_mul_add_ne_zero hab hx0) + rw [DivFunction.conj_of_ne_zero hx0, DivFunction.compAffine_apply, + DivFunction.conj_of_ne_zero h0, h_eq, ← mul_assoc, ← mul_assoc, + ENNReal.mul_inv_cancel hx0 hx, one_mul, ENNReal.mul_inv (Or.inl hx_inv) (Or.inl hx_inv'), + inv_inv, div_eq_mul_inv] + +end Mixture + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/Convex.lean b/Statlib/Divergence/FDiv/Convex.lean new file mode 100644 index 0000000..4c1a47b --- /dev/null +++ b/Statlib/Divergence/FDiv/Convex.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2026 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne +-/ +module + +public import Statlib.Divergence.FDiv.CompProd + +/-! +# Joint convexity of f-divergences + +## Main statements + +* `fDiv_add_add_le`: `fDiv f (μ₀ + μ₁) (ν₀ + ν₁) ≤ fDiv f μ₀ ν₀ + fDiv f μ₁ ν₁`. +* `fDiv_smul_add_smul_le`: **joint convexity** of f-divergences, + `fDiv f (a • μ₀ + b • μ₁) (a • ν₀ + b • ν₁) ≤ a * fDiv f μ₀ ν₀ + b * fDiv f μ₁ ν₁`. + +Both are proved by embedding the measures in `Bool × α` and applying the data-processing +inequality to the projection `Prod.snd`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open MeasureTheory Set + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {f : DivFunction} + +/-- The f-divergence of the sum of two pairs of measures is at most the sum of the +f-divergences. -/ +theorem fDiv_add_add_le (μ₀ μ₁ ν₀ ν₁ : Measure α) [IsFiniteMeasure μ₀] [IsFiniteMeasure μ₁] + [IsFiniteMeasure ν₀] [IsFiniteMeasure ν₁] : + fDiv f (μ₀ + μ₁) (ν₀ + ν₁) ≤ fDiv f μ₀ ν₀ + fDiv f μ₁ ν₁ := by + -- we embed the measures in `Bool × α` and use the data-processing inequality for `Prod.snd` + let P : Measure (Bool × α) := μ₀.map (Prod.mk false) + μ₁.map (Prod.mk true) + let Q : Measure (Bool × α) := ν₀.map (Prod.mk false) + ν₁.map (Prod.mk true) + have h_snd (ξ₀ ξ₁ : Measure α) : + (ξ₀.map (Prod.mk false) + ξ₁.map (Prod.mk true)).snd = ξ₀ + ξ₁ := by + rw [Measure.snd_add, Measure.snd, Measure.snd, + Measure.map_map measurable_snd measurable_prodMk_left, + Measure.map_map measurable_snd measurable_prodMk_left] + simp [Function.comp_def] + -- `P` and `Q` restricted to `{false} × α` and to its complement are the two pairs of measures + set s : Set (Bool × α) := {p | p.1 = false} + have hs : MeasurableSet s := measurable_fst (measurableSet_singleton false) + have h_restrict (ξ₀ ξ₁ : Measure α) : + (ξ₀.map (Prod.mk false) + ξ₁.map (Prod.mk true)).restrict s = ξ₀.map (Prod.mk false) := by + rw [Measure.restrict_add, Measure.restrict_map measurable_prodMk_left hs, + Measure.restrict_map measurable_prodMk_left hs] + simp [s, preimage] + have h_restrict_compl (ξ₀ ξ₁ : Measure α) : + (ξ₀.map (Prod.mk false) + ξ₁.map (Prod.mk true)).restrict sᶜ = ξ₁.map (Prod.mk true) := by + rw [Measure.restrict_add, Measure.restrict_map measurable_prodMk_left hs.compl, + Measure.restrict_map measurable_prodMk_left hs.compl] + simp [s, preimage] + calc fDiv f (μ₀ + μ₁) (ν₀ + ν₁) = fDiv f P.snd Q.snd := by rw [h_snd, h_snd] + _ ≤ fDiv f P Q := fDiv_snd_le P Q + _ = fDiv f μ₀ ν₀ + fDiv f μ₁ ν₁ := by + rw [fDiv_eq_fDiv_restrict_add_fDiv_restrict_compl P Q hs, h_restrict, h_restrict, + h_restrict_compl, h_restrict_compl, + fDiv_map_measurableEmbedding (measurableEmbedding_prodMk_left false), + fDiv_map_measurableEmbedding (measurableEmbedding_prodMk_left true)] + +/-- **Joint convexity** of f-divergences. -/ +theorem fDiv_smul_add_smul_le (μ₀ μ₁ ν₀ ν₁ : Measure α) [IsFiniteMeasure μ₀] + [IsFiniteMeasure μ₁] [IsFiniteMeasure ν₀] [IsFiniteMeasure ν₁] (a b : ℝ≥0) : + fDiv f (a • μ₀ + b • μ₁) (a • ν₀ + b • ν₁) ≤ a * fDiv f μ₀ ν₀ + b * fDiv f μ₁ ν₁ := by + rw [← fDiv_smul_smul, ← fDiv_smul_smul] + exact fDiv_add_add_le _ _ _ _ + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/DivFunction/Basic.lean b/Statlib/Divergence/FDiv/DivFunction/Basic.lean new file mode 100644 index 0000000..b745f8e --- /dev/null +++ b/Statlib/Divergence/FDiv/DivFunction/Basic.lean @@ -0,0 +1,704 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.Analysis.Convex.Continuous +public import Mathlib.MeasureTheory.Integral.Average +public import Mathlib.MeasureTheory.Integral.Bochner.Basic +public import Mathlib.MeasureTheory.Measure.Decomposition.RadonNikodym +public import Statlib.ForMathlib.Analysis.Calculus.LocalExtr.Basic +public import Statlib.ForMathlib.Convex +public import Statlib.ForMathlib.ENNReal + +/-! +# Divergence functions + +A divergence function is a convex and continuous function `f : ℝ≥0∞ → ℝ≥0∞` with `f 1 = 0`. +These are the functions used to define f-divergences. + +## Main definitions + +* `DivFunction`: the type of divergence functions. It is an `ℝ≥0`-module. +* `DivFunction.xmin`, `DivFunction.xmax`: the endpoints of the effective domain `{x | f x ≠ ∞}` + of `f`, which is an interval containing `1` in its interior. +* `DivFunction.realFun`: the function `x ↦ (f (ENNReal.ofReal x)).toReal` from `ℝ` to `ℝ`. It is + convex on `ENNReal.toReal '' Ioo f.xmin f.xmax`. +* `DivFunction.rightDeriv`: the right derivative of `f.realFun` at `x.toReal`, for `x : ℝ≥0∞`. + +## Main statements + +* `DivFunction.antitoneOn`, `DivFunction.monotoneOn`: a divergence function is nonincreasing on + `[0, 1]` and nondecreasing on `[1, ∞]`. +* `DivFunction.apply_add_le_apply_add`: `f` lies above its supporting lines at the interior points + of its effective domain. +* `DivFunction.le_of_forall_rat_tangent_le`: if `g` dominates the supporting lines of `f` at all + rational interior points, evaluated at `y`, then `f y ≤ g`. +* `DivFunction.map_lintegral_le`, `DivFunction.map_laverage_le`: **Jensen's inequality** for a + divergence function. + +-/ + +@[expose] public section + +open Real MeasureTheory Filter Set MeasurableSpace + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} + +/-- A divergence function: a convex and continuous function `ℝ≥0∞ → ℝ≥0∞` with value `0` at `1`. +These are the functions used to define f-divergences. -/ +structure DivFunction where + /-- The underlying function `ℝ≥0∞ → ℝ≥0∞`. -/ + toFun : ℝ≥0∞ → ℝ≥0∞ + one : toFun 1 = 0 + convexOn' : ConvexOn ℝ≥0 univ toFun + -- the continuity everywhere but 0 and ∞ is implied by the convexity + continuous' : Continuous toFun + +namespace DivFunction + +attribute [coe] toFun + +instance instCoeFun : CoeFun DivFunction fun _ ↦ ℝ≥0∞ → ℝ≥0∞ := ⟨toFun⟩ + +initialize_simps_projections DivFunction (toFun → apply) + +@[ext] lemma ext {f g : DivFunction} (h : ∀ x, f x = g x) : f = g := + (DivFunction.mk.injEq ..).mpr (funext h) + +section Def +variable (f : DivFunction) + +@[simp] lemma apply_one : f 1 = 0 := f.one + +lemma convexOn : ConvexOn ℝ≥0 univ f := f.convexOn' + +lemma continuous : Continuous f := f.continuous' + +lemma measurable : Measurable f := f.continuous.measurable + +/-- The real function `x ↦ (f (ENNReal.ofReal x)).toReal` associated with a `DivFunction`. -/ +noncomputable def realFun : ℝ → ℝ := fun x ↦ (f (ENNReal.ofReal x)).toReal + +/-- The right derivative of `f`: the right derivative of `f.realFun` at `x.toReal`. At an interior +point `x` of the effective domain of `f`, it is the slope of a supporting line of `f` at `x` +(`apply_add_le_apply_add`). -/ +noncomputable def rightDeriv (x : ℝ≥0∞) : ℝ := derivWithin f.realFun (Ioi x.toReal) x.toReal + +lemma rightDeriv_def (x : ℝ≥0∞) : + f.rightDeriv x = derivWithin f.realFun (Ioi x.toReal) x.toReal := rfl + +end Def + +section Monotone +variable (f : DivFunction) + +/-- A `DivFunction` is nondecreasing on `[1, ∞]`. -/ +lemma monotoneOn : MonotoneOn f (Ici 1) := by + have key {x y : ℝ≥0∞} (hx : 1 ≤ x) (hxy : x ≤ y) (hy : y ≠ ∞) : f x ≤ f y := by + obtain ⟨u, v, huv, hxuv⟩ := ENNReal.exists_nnreal_smul_add_eq hy hx hxy + calc f x = f (u • 1 + v • y) := by rw [hxuv] + _ ≤ u • f 1 + v • f y := f.convexOn.2 (mem_univ _) (mem_univ _) zero_le zero_le huv + _ = v • f y := by simp + _ ≤ f y := by + rw [ENNReal.smul_def, smul_eq_mul] + exact mul_le_of_le_one_left' (ENNReal.coe_le_one_iff.mpr (le_add_self.trans_eq huv)) + intro x hx y _ hxy + rcases eq_or_ne y ∞ with rfl | hy_top + · rcases eq_or_lt_of_le hxy with rfl | hx_lt + · exact le_rfl + refine (isClosed_le continuous_const f.continuous).closure_subset_iff.mpr + (fun z (hz : z ∈ Ioo x ∞) ↦ key hx hz.1.le hz.2.ne) ?_ + rw [closure_Ioo hx_lt.ne] + exact right_mem_Icc.mpr le_top + · exact key hx hxy hy_top + +/-- A `DivFunction` is nonincreasing on `[0, 1]`. -/ +lemma antitoneOn : AntitoneOn f (Iic 1) := by + intro x _ y hy hxy + obtain ⟨u, v, huv, hyuv⟩ := ENNReal.exists_nnreal_smul_add_eq ENNReal.one_ne_top hxy hy + calc f y = f (u • x + v • 1) := by rw [hyuv] + _ ≤ u • f x + v • f 1 := f.convexOn.2 (mem_univ _) (mem_univ _) zero_le zero_le huv + _ = u • f x := by simp + _ ≤ f x := by + rw [ENNReal.smul_def, smul_eq_mul] + exact mul_le_of_le_one_left' (ENNReal.coe_le_one_iff.mpr ((self_le_add_right u v).trans_eq huv)) + +lemma apply_eq_zero_of_le_one (h0 : f 0 = 0) {x : ℝ≥0∞} (hx : x ≤ 1) : f x = 0 := + le_antisymm ((f.antitoneOn (mem_Iic.2 zero_le_one) (mem_Iic.2 hx) zero_le).trans_eq h0) + zero_le + +end Monotone + +section EffectiveDomain +variable {f : DivFunction} + +/-- Lower bound of the effective domain of `f`. -/ +noncomputable def xmin (f : DivFunction) : ℝ≥0∞ := sInf {x | f x ≠ ∞} +/-- Upper bound of the effective domain of `f`. -/ +noncomputable def xmax (f : DivFunction) : ℝ≥0∞ := sSup {x | f x ≠ ∞} + +lemma eventually_ne_top_nhds_one (f : DivFunction) : ∀ᶠ a in 𝓝 1, f a ≠ ∞ := + f.continuous.continuousAt.eventually_ne (by simp) + +lemma xmin_lt_one : f.xmin < 1 := by + obtain ⟨a, ha_lt, ha⟩ := f.eventually_ne_top_nhds_one.exists_lt + exact sInf_lt_iff.mpr ⟨a, ha, ha_lt⟩ + +lemma one_lt_xmax : 1 < f.xmax := by + obtain ⟨a, ha_gt, ha⟩ := f.eventually_ne_top_nhds_one.exists_gt + exact lt_sSup_iff.mpr ⟨a, ha, ha_gt⟩ + +lemma xmin_lt_xmax : f.xmin < f.xmax := xmin_lt_one.trans one_lt_xmax + +lemma xmax_pos : 0 < f.xmax := zero_lt_one.trans one_lt_xmax + +lemma xmin_lt_top : f.xmin < ∞ := lt_top_of_lt xmin_lt_one + +lemma xmin_ne_top : f.xmin ≠ ∞ := xmin_lt_top.ne + +lemma eq_top_of_lt_xmin {x : ℝ≥0∞} (hx : x < f.xmin) : f x = ∞ := by + by_contra h + exact hx.not_ge (sInf_le h) + +lemma eq_top_of_xmax_lt {x : ℝ≥0∞} (hx : f.xmax < x) : f x = ∞ := by + by_contra h + exact hx.not_ge (le_sSup h) + +lemma lt_top_of_mem_Ioo {x : ℝ≥0∞} (hx : x ∈ Ioo f.xmin f.xmax) : f x < ∞ := by + rw [mem_Ioo, xmin, sInf_lt_iff, xmax, lt_sSup_iff] at hx + obtain ⟨a, ha, hax⟩ := hx.1 + obtain ⟨b, hb, hxb⟩ := hx.2 + rcases le_total x 1 with hx1 | h1x + · exact (f.antitoneOn (hax.le.trans hx1) hx1 hax.le).trans_lt (Ne.lt_top ha) + · exact (f.monotoneOn h1x (h1x.trans hxb.le) hxb.le).trans_lt (Ne.lt_top hb) + +lemma apply_xmin_eq_top (h : 0 < f.xmin) : f f.xmin = ∞ := by + refine (isClosed_eq f.continuous continuous_const).closure_subset_iff.mpr + (fun _ (hx : _ ∈ Iio f.xmin) ↦ eq_top_of_lt_xmin hx) ?_ + rw [closure_Iio' ⟨0, h⟩] + exact mem_Iic.mpr le_rfl + +lemma apply_xmax_eq_top (h : f.xmax ≠ ∞) : f f.xmax = ∞ := by + refine (isClosed_eq f.continuous continuous_const).closure_subset_iff.mpr + (fun _ (hx : _ ∈ Ioi f.xmax) ↦ eq_top_of_xmax_lt hx) ?_ + rw [closure_Ioi' ⟨∞, h.lt_top⟩] + exact mem_Ici.mpr le_rfl + +lemma isOpen_toReal_Ioo (f : DivFunction) : IsOpen (ENNReal.toReal '' Ioo f.xmin f.xmax) := by + rcases eq_or_ne f.xmax ∞ with h_top | h_top + · rw [h_top, ENNReal.toReal_image_Ioo_top xmin_ne_top] + exact isOpen_Ioi + · rw [ENNReal.toReal_image_Ioo xmin_ne_top h_top] + exact isOpen_Ioo + +lemma convex_toReal_Ioo (f : DivFunction) : Convex ℝ (ENNReal.toReal '' Ioo f.xmin f.xmax) := by + rcases eq_or_ne f.xmax ∞ with h_top | h_top + · rw [h_top, ENNReal.toReal_image_Ioo_top xmin_ne_top] + exact convex_Ioi _ + · rw [ENNReal.toReal_image_Ioo xmin_ne_top h_top] + exact convex_Ioo _ _ + +lemma mem_toReal_Ioo_iff {x : ℝ} : + x ∈ ENNReal.toReal '' Ioo f.xmin f.xmax + ↔ f.xmin < ENNReal.ofReal x ∧ ENNReal.ofReal x < f.xmax := by + refine ⟨?_, fun h ↦ ⟨ENNReal.ofReal x, h, ENNReal.toReal_ofReal ?_⟩⟩ + · rintro ⟨y, hy, rfl⟩ + rwa [ENNReal.ofReal_toReal (ne_top_of_lt hy.2)] + · by_contra hx + simp [ENNReal.ofReal_of_nonpos (not_le.mp hx).le] at h + +end EffectiveDomain + +section RealFun +variable (f : DivFunction) + +@[simp] lemma realFun_one : f.realFun 1 = 0 := by simp [realFun] + +lemma realFun_nonneg (x : ℝ) : 0 ≤ f.realFun x := ENNReal.toReal_nonneg + +lemma realFun_toReal {x : ℝ≥0∞} (hx : x ≠ ⊤) : + f.realFun x.toReal = (f x).toReal := by rw [realFun, ENNReal.ofReal_toReal hx] + +/-- Convexity inequality for `f` at points `ENNReal.ofReal x` and `ENNReal.ofReal y`. -/ +private lemma apply_ofReal_add_le {x y a b : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) (ha : 0 ≤ a) (hb : 0 ≤ b) + (hab : a + b = 1) : + f (ENNReal.ofReal (a * x + b * y)) + ≤ ENNReal.ofReal a * f (ENNReal.ofReal x) + ENNReal.ofReal b * f (ENNReal.ofReal y) := by + have h := f.convexOn.2 (mem_univ (ENNReal.ofReal x)) (mem_univ (ENNReal.ofReal y)) + (zero_le (a := a.toNNReal)) (zero_le (a := b.toNNReal)) + (by rw [← Real.toNNReal_add ha hb, hab, Real.toNNReal_one]) + simp only [ENNReal.smul_def, smul_eq_mul] at h + rwa [ENNReal.ofReal_add (by positivity) (by positivity), ENNReal.ofReal_mul ha, + ENNReal.ofReal_mul hb] + +/-- The set of nonnegative reals at which `f` is finite is convex. -/ +lemma convex_setOf_ne_top : Convex ℝ {x : ℝ | 0 ≤ x ∧ f (ENNReal.ofReal x) ≠ ∞} := by + intro x hx y hy a b ha hb hab + refine ⟨add_nonneg (mul_nonneg ha hx.1) (mul_nonneg hb hy.1), ne_top_of_le_ne_top ?_ + (f.apply_ofReal_add_le hx.1 hy.1 ha hb hab)⟩ + exact ENNReal.add_ne_top.mpr ⟨ENNReal.mul_ne_top ENNReal.ofReal_ne_top hx.2, + ENNReal.mul_ne_top ENNReal.ofReal_ne_top hy.2⟩ + +/-- `f.realFun` is convex on the set of nonnegative reals at which `f` is finite. -/ +lemma convexOn_realFun_setOf_ne_top : + ConvexOn ℝ {x : ℝ | 0 ≤ x ∧ f (ENNReal.ofReal x) ≠ ∞} f.realFun := by + refine ⟨f.convex_setOf_ne_top, fun x ⟨hx, hfx⟩ y ⟨hy, hfy⟩ a b ha hb hab ↦ ?_⟩ + simp only [realFun, smul_eq_mul] + refine (ENNReal.toReal_mono (by finiteness) (f.apply_ofReal_add_le hx hy ha hb hab)).trans_eq ?_ + rw [ENNReal.toReal_add (by finiteness) (by finiteness), ENNReal.toReal_mul, ENNReal.toReal_mul, + ENNReal.toReal_ofReal ha, ENNReal.toReal_ofReal hb] + +lemma toReal_Ioo_subset_setOf_ne_top : + ENNReal.toReal '' Ioo f.xmin f.xmax ⊆ {y : ℝ | 0 ≤ y ∧ f (ENNReal.ofReal y) ≠ ∞} := by + rintro _ ⟨z, hz, rfl⟩ + refine ⟨ENNReal.toReal_nonneg, ?_⟩ + rw [ENNReal.ofReal_toReal (ne_top_of_lt hz.2)] + exact (f.lt_top_of_mem_Ioo hz).ne + +lemma convexOn_Ioo_realFun : ConvexOn ℝ (ENNReal.toReal '' Ioo f.xmin f.xmax) f.realFun := + f.convexOn_realFun_setOf_ne_top.subset f.toReal_Ioo_subset_setOf_ne_top f.convex_toReal_Ioo + +lemma toReal_mem_interior_setOf_ne_top {x : ℝ≥0∞} (hx : x ∈ Ioo f.xmin f.xmax) : + x.toReal ∈ interior {y : ℝ | 0 ≤ y ∧ f (ENNReal.ofReal y) ≠ ∞} := by + refine interior_mono f.toReal_Ioo_subset_setOf_ne_top ?_ + rw [f.isOpen_toReal_Ioo.interior_eq] + exact mem_image_of_mem _ hx + +/-- Supporting line inequality for `f`, written without subtraction in `ℝ≥0∞`. -/ +lemma apply_add_le_apply_add {x : ℝ≥0∞} (hx : x ∈ Ioo f.xmin f.xmax) {y : ℝ≥0∞} (hy : y ≠ ∞) : + f x + ENNReal.ofReal (max (f.rightDeriv x) 0) * y + + ENNReal.ofReal (max (-f.rightDeriv x) 0) * x + ≤ f y + ENNReal.ofReal (max (f.rightDeriv x) 0) * x + + ENNReal.ofReal (max (-f.rightDeriv x) 0) * y := by + by_cases hfy : f y = ∞ + · simp [hfy] + have hx_top : x ≠ ∞ := ne_top_of_lt hx.2 + have hfx : f x ≠ ∞ := (f.lt_top_of_mem_Ioo hx).ne + have h_tangent := f.convexOn_realFun_setOf_ne_top.add_rightDeriv_mul_le (x := y.toReal) + ⟨ENNReal.toReal_nonneg, by rwa [ENNReal.ofReal_toReal hy]⟩ + (f.toReal_mem_interior_setOf_ne_top hx) + rw [realFun_toReal f hx_top, realFun_toReal f hy, ← f.rightDeriv_def] at h_tangent + set c := f.rightDeriv x + have key : c = max c 0 - max (-c) 0 := (max_zero_sub_max_neg_zero_eq_self c).symm + have e (a u v : ℝ≥0∞) (ha : a ≠ ∞) (hu : u ≠ ∞) (hv : v ≠ ∞) : + ENNReal.ofReal (a.toReal + max c 0 * u.toReal + max (-c) 0 * v.toReal) + = a + ENNReal.ofReal (max c 0) * u + ENNReal.ofReal (max (-c) 0) * v := by + rw [ENNReal.ofReal_add (by positivity) (by positivity), + ENNReal.ofReal_add (by positivity) (by positivity), + ENNReal.ofReal_mul (le_max_right _ _), ENNReal.ofReal_mul (le_max_right _ _), + ENNReal.ofReal_toReal ha, ENNReal.ofReal_toReal hu, ENNReal.ofReal_toReal hv] + rw [← e _ _ _ hfx hy hx_top, ← e _ _ _ hfy hx_top hy] + refine ENNReal.ofReal_le_ofReal ?_ + rw [key] at h_tangent + linarith + +/-- The right derivative of `f` is nondecreasing on the interior of its effective domain. -/ +lemma monotoneOn_rightDeriv : MonotoneOn f.rightDeriv (Ioo f.xmin f.xmax) := by + intro x hx y hy hxy + have h := f.convexOn_Ioo_realFun.monotoneOn_rightDeriv + rw [f.isOpen_toReal_Ioo.interior_eq] at h + exact h (mem_image_of_mem _ hx) (mem_image_of_mem _ hy) + (ENNReal.toReal_mono (ne_top_of_lt hy.2) hxy) + +/-- Consequence of the supporting line inequality at `x ≤ y`. -/ +private lemma apply_le_add_of_le {a x y g : ℝ≥0∞} (hx_top : x ≠ ∞) (hxy : x ≤ y) {c : ℝ} + (h : a + ENNReal.ofReal (max c 0) * y + ENNReal.ofReal (max (-c) 0) * x + ≤ g + ENNReal.ofReal (max c 0) * x + ENNReal.ofReal (max (-c) 0) * y) : + a ≤ g + ENNReal.ofReal (max (-c) 0) * (y - x) := by + obtain ⟨d, rfl⟩ : ∃ d, y = x + d := ⟨y - x, (add_tsub_cancel_of_le hxy).symm⟩ + rw [ENNReal.add_sub_cancel_left hx_top] + refine (le_self_add : a ≤ a + ENNReal.ofReal (max c 0) * d).trans + (ENNReal.le_of_add_le_add_right (a := ENNReal.ofReal (max c 0) * x + + ENNReal.ofReal (max (-c) 0) * x) (by finiteness) ?_) + convert h using 1 <;> ring + +/-- Consequence of the supporting line inequality at `x ≥ y`. -/ +private lemma apply_le_add_of_ge {a x y g : ℝ≥0∞} (hy_top : y ≠ ∞) (hyx : y ≤ x) {c : ℝ} + (h : a + ENNReal.ofReal (max c 0) * y + ENNReal.ofReal (max (-c) 0) * x + ≤ g + ENNReal.ofReal (max c 0) * x + ENNReal.ofReal (max (-c) 0) * y) : + a ≤ g + ENNReal.ofReal (max c 0) * (x - y) := by + obtain ⟨d, rfl⟩ : ∃ d, x = y + d := ⟨x - y, (add_tsub_cancel_of_le hyx).symm⟩ + rw [ENNReal.add_sub_cancel_left hy_top] + refine (le_self_add : a ≤ a + ENNReal.ofReal (max (-c) 0) * d).trans + (ENNReal.le_of_add_le_add_right (a := ENNReal.ofReal (max c 0) * y + + ENNReal.ofReal (max (-c) 0) * y) (by finiteness) ?_) + convert h using 1 <;> ring + +/-- If `g` dominates the supporting lines of `f` at all rational interior points, evaluated at +`y`, then `f y ≤ g`. This is the pointwise step of Jensen's inequality for conditional +expectations. -/ +lemma le_of_forall_rat_tangent_le {y g : ℝ≥0∞} (hy_top : y ≠ ∞) + (h : ∀ q : ℚ, ENNReal.ofReal q ∈ Ioo f.xmin f.xmax → + f (ENNReal.ofReal q) + + ENNReal.ofReal (max (f.rightDeriv (ENNReal.ofReal q)) 0) * y + + ENNReal.ofReal (max (-f.rightDeriv (ENNReal.ofReal q)) 0) * ENNReal.ofReal q + ≤ g + ENNReal.ofReal (max (f.rightDeriv (ENNReal.ofReal q)) 0) * ENNReal.ofReal q + + ENNReal.ofReal (max (-f.rightDeriv (ENNReal.ofReal q)) 0) * y) : + f y ≤ g := by + have h1 : (1 : ℝ≥0∞) ∈ Ioo f.xmin f.xmax := ⟨xmin_lt_one, one_lt_xmax⟩ + have h_tendsto {q : ℕ → ℚ} {z : ℝ≥0∞} (hz : z ≠ ∞) + (hq : Tendsto (fun n ↦ (q n : ℝ)) atTop (𝓝 z.toReal)) : + Tendsto (fun n ↦ ENNReal.ofReal (q n)) atTop (𝓝 z) := by + rw [← ENNReal.ofReal_toReal hz] + exact (ENNReal.continuous_ofReal.tendsto _).comp hq + -- approximate a point `z ≤ y` of the closure of the domain from below by rational points + have h_below {z a : ℝ≥0∞} (ha : a ∈ Ioo f.xmin f.xmax) (haz : a < z) (hzy : z ≤ y) + (hz : z ≤ f.xmax) (hz_top : z ≠ ∞) : + f z ≤ g + ENNReal.ofReal (max (-f.rightDeriv a) 0) + * (y - z) := by + have ha_top : a ≠ ∞ := ne_top_of_lt ha.2 + obtain ⟨q, -, hq, hq_tendsto⟩ := Rat.denseRange_cast.exists_seq_strictMono_tendsto_of_lt + Rat.cast_mono (ENNReal.toReal_strict_mono hz_top haz) + have hq' n : ENNReal.ofReal (q n) ∈ Ioo a z := + ⟨(ENNReal.lt_ofReal_iff_toReal_lt ha_top).mpr (hq n).1, + (ENNReal.ofReal_lt_iff_lt_toReal (ENNReal.toReal_nonneg.trans (hq n).1.le) hz_top).mpr + (hq n).2⟩ + have hq_mem n : ENNReal.ofReal (q n) ∈ Ioo f.xmin f.xmax := + ⟨ha.1.trans (hq' n).1, (hq' n).2.trans_le hz⟩ + have h_lim := h_tendsto hz_top hq_tendsto + refine le_of_tendsto_of_tendsto' ((f.continuous.tendsto z).comp h_lim) + (tendsto_const_nhds.add (ENNReal.Tendsto.const_mul + (ENNReal.Tendsto.sub tendsto_const_nhds h_lim (Or.inl hy_top)) + (Or.inr ENNReal.ofReal_ne_top))) fun n ↦ ?_ + refine (apply_le_add_of_le ENNReal.ofReal_ne_top ((hq' n).2.le.trans hzy) + (h (q n) (hq_mem n))).trans ?_ + gcongr + exact f.monotoneOn_rightDeriv ha (hq_mem n) (hq' n).1.le + -- approximate a point `z ≥ y` of the closure of the domain from above by rational points + have h_above {z b : ℝ≥0∞} (hb : b ∈ Ioo f.xmin f.xmax) (hzb : z < b) (hyz : y ≤ z) + (hz : f.xmin ≤ z) : + f z ≤ g + ENNReal.ofReal (max (f.rightDeriv b) 0) + * (z - y) := by + have hb_top : b ≠ ∞ := ne_top_of_lt hb.2 + have hz_top : z ≠ ∞ := ne_top_of_lt hzb + obtain ⟨q, -, hq, hq_tendsto⟩ := Rat.denseRange_cast.exists_seq_strictAnti_tendsto_of_lt + Rat.cast_mono (ENNReal.toReal_strict_mono hb_top hzb) + have hq' n : ENNReal.ofReal (q n) ∈ Ioo z b := + ⟨(ENNReal.lt_ofReal_iff_toReal_lt hz_top).mpr (hq n).1, + (ENNReal.ofReal_lt_iff_lt_toReal (ENNReal.toReal_nonneg.trans (hq n).1.le) hb_top).mpr + (hq n).2⟩ + have hq_mem n : ENNReal.ofReal (q n) ∈ Ioo f.xmin f.xmax := + ⟨hz.trans_lt (hq' n).1, (hq' n).2.trans hb.2⟩ + have h_lim := h_tendsto hz_top hq_tendsto + refine le_of_tendsto_of_tendsto' ((f.continuous.tendsto z).comp h_lim) + (tendsto_const_nhds.add (ENNReal.Tendsto.const_mul + (ENNReal.Tendsto.sub h_lim tendsto_const_nhds (Or.inl hz_top)) + (Or.inr ENNReal.ofReal_ne_top))) fun n ↦ ?_ + refine (apply_le_add_of_ge hy_top (hyz.trans (hq' n).1.le) (h (q n) (hq_mem n))).trans ?_ + gcongr + exact f.monotoneOn_rightDeriv (hq_mem n) hb (hq' n).2.le + -- at an endpoint `z ≠ y` of the domain, `f z = ∞` and the bound forces `g = ∞` + have of_eq_top {z d : ℝ≥0∞} {K : ℝ} (hz : f z = ∞) (hd : d ≠ ∞) + (h_le : f z ≤ g + ENNReal.ofReal K * d) : f y ≤ g := by + rw [hz, top_le_iff, ENNReal.add_eq_top] at h_le + rcases h_le with hg | hg + · simp [hg] + · exact absurd hg (ENNReal.mul_ne_top ENNReal.ofReal_ne_top hd) + rcases le_or_gt y f.xmin with hy_le | hy_gt + · have h_le := h_above h1 xmin_lt_one hy_le le_rfl + rcases hy_le.eq_or_lt with rfl | hy_lt + · simpa using h_le + · exact of_eq_top (apply_xmin_eq_top (bot_le.trans_lt hy_lt)) + (ENNReal.sub_ne_top xmin_ne_top) h_le + rcases lt_or_ge y f.xmax with hy_lt | hy_ge + · obtain ⟨a, ha_gt, ha_lt⟩ := exists_between hy_gt + simpa using h_below ⟨ha_gt, ha_lt.trans hy_lt⟩ ha_lt le_rfl hy_lt.le hy_top + · have hmax_top : f.xmax ≠ ∞ := ne_top_of_le_ne_top hy_top hy_ge + have h_le := h_below h1 one_lt_xmax hy_ge le_rfl hmax_top + rcases hy_ge.eq_or_lt with rfl | hy_gt' + · simpa using h_le + · exact of_eq_top (apply_xmax_eq_top hmax_top) (ENNReal.sub_ne_top hy_top) h_le + +lemma isMinOn_realFun_one (s : Set ℝ) : IsMinOn f.realFun s 1 := + fun _ _ ↦ by simp [realFun_nonneg] + +lemma continuousOn_realFun_Ioo : + ContinuousOn f.realFun (ENNReal.toReal '' Ioo f.xmin f.xmax) := + f.convexOn_Ioo_realFun.continuousOn f.isOpen_toReal_Ioo + +lemma differentiableWithinAt_realFun {x : ℝ} (hx : ENNReal.ofReal x ∈ Ioo f.xmin f.xmax) : + DifferentiableWithinAt ℝ f.realFun (Ioi x) x := by + refine f.convexOn_Ioo_realFun.differentiableWithinAt_Ioi_of_mem_interior ?_ + rw [f.isOpen_toReal_Ioo.interior_eq] + exact mem_toReal_Ioo_iff.mpr hx + +/-- The right derivative of `f.realFun` is monotone on the interior of the effective domain. -/ +lemma monotoneOn_derivWithin_realFun : + MonotoneOn (fun x ↦ derivWithin f.realFun (Ioi x) x) (ENNReal.toReal '' Ioo f.xmin f.xmax) := by + have h := f.convexOn_Ioo_realFun.monotoneOn_rightDeriv + rwa [f.isOpen_toReal_Ioo.interior_eq] at h + +lemma derivWithin_realFun_mono {x y : ℝ} (hxy : x ≤ y) (hx : f.xmin < ENNReal.ofReal x) + (hy : ENNReal.ofReal y < f.xmax) : + derivWithin f.realFun (Ioi x) x ≤ derivWithin f.realFun (Ioi y) y := + f.monotoneOn_derivWithin_realFun + (mem_toReal_Ioo_iff.mpr ⟨hx, (ENNReal.ofReal_le_ofReal hxy).trans_lt hy⟩) + (mem_toReal_Ioo_iff.mpr ⟨hx.trans_le (ENNReal.ofReal_le_ofReal hxy), hy⟩) hxy + +lemma rightDeriv_one_nonneg : 0 ≤ f.rightDeriv 1 := by + rw [rightDeriv_def, ENNReal.toReal_one] + exact (f.isMinOn_realFun_one univ).isLocalMin univ_mem |>.rightDeriv_nonneg + +/-- If `f.realFun` is strictly convex on a neighborhood of `1`, then `1` is the only zero of `f`. -/ +lemma eq_zero_iff {a b : ℝ} (ha : a < 1) (hb : 1 < b) + (hf_cvx : StrictConvexOn ℝ (Ioo a b) f.realFun) {x : ℝ≥0∞} : + f x = 0 ↔ x = 1 := by + have key z (hz : z ∈ Ioo (ENNReal.ofReal a) (ENNReal.ofReal b)) (hfz : f z = 0) : z = 1 := by + have hz_top : z ≠ ∞ := ne_top_of_lt hz.2 + have h_mem : z.toReal ∈ Ioo a b := by + refine ⟨(ENNReal.ofReal_lt_ofReal_iff'.mp ?_).1, + (ENNReal.lt_ofReal_iff_toReal_lt hz_top).mp hz.2⟩ + rw [ENNReal.ofReal_toReal hz_top] + exact hz.1 + have h_min : IsMinOn f.realFun (Ioo a b) z.toReal := + fun _ _ ↦ by simp [realFun_toReal f hz_top, hfz, realFun_nonneg] + rw [← ENNReal.ofReal_toReal hz_top, + hf_cvx.eq_of_isMinOn h_min (f.isMinOn_realFun_one _) h_mem ⟨ha, hb⟩, ENNReal.ofReal_one] + refine ⟨fun h ↦ ?_, fun h ↦ by simp [h]⟩ + rcases lt_trichotomy x 1 with hx1 | rfl | h1x + · obtain ⟨z, hxz, hz1⟩ := exists_between (max_lt hx1 (ENNReal.ofReal_lt_one.mpr ha)) + have hfz : f z = 0 := le_antisymm + ((f.antitoneOn ((le_max_left _ _).trans hxz.le |>.trans hz1.le) hz1.le + ((le_max_left _ _).trans hxz.le)).trans_eq h) zero_le + exact absurd (key z ⟨(le_max_right _ _).trans_lt hxz, + hz1.trans (ENNReal.one_lt_ofReal.mpr hb)⟩ hfz) hz1.ne + · rfl + · obtain ⟨z, h1z, hzx⟩ := exists_between (lt_min h1x (ENNReal.one_lt_ofReal.mpr hb)) + have hfz : f z = 0 := le_antisymm + ((f.monotoneOn h1z.le (h1z.le.trans (hzx.le.trans (min_le_left _ _))) + (hzx.le.trans (min_le_left _ _))).trans_eq h) zero_le + exact absurd (key z ⟨(ENNReal.ofReal_lt_one.mpr ha).trans h1z, + hzx.trans_le (min_le_right _ _)⟩ hfz) h1z.ne' + +end RealFun + +variable {f g : DivFunction} + +section Module + +/-- The zero divergence function. -/ +protected def zero : DivFunction where + toFun := 0 + one := rfl + convexOn' := convexOn_const _ convex_univ + continuous' := continuous_const + +/-- Sum of two divergence functions. -/ +protected noncomputable def add (f g : DivFunction) : DivFunction where + toFun := fun x ↦ f x + g x + one := by simp + convexOn' := f.convexOn.add g.convexOn + continuous' := f.continuous.add g.continuous + +noncomputable +instance : AddZeroClass DivFunction where + add := DivFunction.add + zero := DivFunction.zero + zero_add _ := ext fun _ ↦ zero_add _ + add_zero _ := ext fun _ ↦ add_zero _ + +@[simp] lemma zero_apply (x : ℝ≥0∞) : (0 : DivFunction) x = 0 := rfl + +@[simp] lemma add_apply (f g : DivFunction) (x : ℝ≥0∞) : (f + g) x = f x + g x := rfl + +noncomputable +instance : AddCommMonoid DivFunction where + nsmul n f := nsmulRec n f + add_assoc _ _ _ := ext fun _ ↦ add_assoc _ _ _ + add_comm _ _ := ext fun _ ↦ add_comm _ _ + __ := DivFunction.instAddZeroClass + +noncomputable +instance : SMul ℝ≥0 DivFunction where + smul c f := { + toFun := fun x ↦ c * f x + one := by simp + convexOn' := ⟨convex_univ, fun x _ y _ a b ha hb hab ↦ by + have h := f.convexOn.2 (mem_univ x) (mem_univ y) ha hb hab + calc (c : ℝ≥0∞) * f (a • x + b • y) + _ ≤ (c : ℝ≥0∞) * (a • f x + b • f y) := by gcongr + _ = a • ((c : ℝ≥0∞) * f x) + b • ((c : ℝ≥0∞) * f y) := by + simp only [ENNReal.smul_def, smul_eq_mul]; ring⟩ + continuous' := (ENNReal.continuous_const_mul ENNReal.coe_ne_top).comp f.continuous} + +@[simp] lemma smul_apply (c : ℝ≥0) (f : DivFunction) (x : ℝ≥0∞) : (c • f) x = c * f x := rfl + +lemma realFun_smul (c : ℝ≥0) (f : DivFunction) : (c • f).realFun = fun x ↦ c * f.realFun x := by + ext x + simp [realFun, ENNReal.toReal_mul] + +@[simp] lemma xmin_add : (f + g).xmin = max f.xmin g.xmin := by + simp only [xmin, add_apply, ne_eq, ENNReal.add_eq_top, not_or] + refine le_antisymm ?_ (max_le (sInf_le_sInf fun _ hx ↦ hx.1) (sInf_le_sInf fun _ hx ↦ hx.2)) + refine le_of_forall_gt_imp_ge_of_dense fun y hy ↦ ?_ + rw [max_lt_iff, sInf_lt_iff, sInf_lt_iff] at hy + obtain ⟨⟨a, ha, hay⟩, ⟨b, hb, hby⟩⟩ := hy + rcases lt_or_ge 1 y with hy1 | hy1 + · exact (sInf_le (a := 1) (by simp)).trans hy1.le + -- for `y ≤ 1`, `max a b < y` is in the effective domains of `f` and `g`, which are intervals + have hmax : max a b ≤ 1 := (max_lt hay hby).le.trans hy1 + refine sInf_le_of_le (b := max a b) ⟨?_, ?_⟩ (max_lt hay hby).le + · exact ne_top_of_le_ne_top ha + (f.antitoneOn ((le_max_left a b).trans hmax) hmax (le_max_left _ _)) + · exact ne_top_of_le_ne_top hb + (g.antitoneOn ((le_max_right a b).trans hmax) hmax (le_max_right _ _)) + +@[simp] lemma xmax_add : (f + g).xmax = min f.xmax g.xmax := by + simp only [xmax, add_apply, ne_eq, ENNReal.add_eq_top, not_or] + refine le_antisymm (le_min (sSup_le_sSup fun _ hx ↦ hx.1) (sSup_le_sSup fun _ hx ↦ hx.2)) ?_ + refine le_of_forall_lt fun y hy ↦ ?_ + rw [lt_min_iff, lt_sSup_iff, lt_sSup_iff] at hy + obtain ⟨⟨a, ha, hya⟩, ⟨b, hb, hyb⟩⟩ := hy + rw [lt_sSup_iff] + rcases lt_or_ge y 1 with hy1 | hy1 + · exact ⟨1, by simp, hy1⟩ + -- for `1 ≤ y`, `min a b > y` is in the effective domains of `f` and `g`, which are intervals + refine ⟨min a b, ⟨?_, ?_⟩, lt_min hya hyb⟩ + · exact ne_top_of_le_ne_top ha + (f.monotoneOn (hy1.trans (lt_min hya hyb).le) (hy1.trans hya.le) (min_le_left _ _)) + · exact ne_top_of_le_ne_top hb + (g.monotoneOn (hy1.trans (lt_min hya hyb).le) (hy1.trans hyb.le) (min_le_right _ _)) + +@[simp] lemma xmin_smul {c : ℝ≥0} (hc : c ≠ 0) : (c • f).xmin = f.xmin := by + simp [xmin, hc, ENNReal.mul_eq_top] + +@[simp] lemma xmax_smul {c : ℝ≥0} (hc : c ≠ 0) : (c • f).xmax = f.xmax := by + simp [xmax, hc, ENNReal.mul_eq_top] + +noncomputable +instance : Module ℝ≥0 DivFunction where + one_smul _ := ext fun _ ↦ one_mul _ + mul_smul _ _ _ := ext fun _ ↦ by simp [mul_assoc] + smul_zero _ := ext fun _ ↦ mul_zero _ + smul_add _ _ _ := ext fun _ ↦ mul_add _ _ _ + add_smul _ _ _ := ext fun _ ↦ by simp [add_mul] + zero_smul _ := ext fun _ ↦ zero_mul _ + +end Module + +end DivFunction + +variable {f : DivFunction} + +lemma DivFunction.measurable_comp_rnDeriv : Measurable (fun x ↦ f (μ.rnDeriv ν x)) := + f.measurable.comp (μ.measurable_rnDeriv ν) + +lemma integrable_realFun {g : α → ℝ≥0∞} (hg : AEMeasurable g ν) (hg_lt : ∀ᵐ x ∂ν, g x < ∞) + (h_int : ∫⁻ x, f (g x) ∂ν ≠ ∞) : + Integrable (fun x ↦ f.realFun (g x).toReal) ν := by + have h_eq : (fun x ↦ f (ENNReal.ofReal (g x).toReal)) =ᵐ[ν] fun x ↦ f (g x) := by + filter_upwards [hg_lt] with x hx + rw [ENNReal.ofReal_toReal hx.ne] + refine integrable_toReal_of_lintegral_ne_top + (f.measurable.comp_aemeasurable hg.ennreal_toReal.ennreal_ofReal) ?_ + rwa [lintegral_congr_ae h_eq] + +lemma lintegral_eq_top_of_not_integrable_realFun [SigmaFinite μ] + (h_int : ¬ Integrable (fun x ↦ f.realFun (μ.rnDeriv ν x).toReal) ν) : + ∫⁻ x, f (μ.rnDeriv ν x) ∂ν = ∞ := by + by_contra h + exact h_int (integrable_realFun (μ.measurable_rnDeriv ν).aemeasurable (μ.rnDeriv_lt_top ν) h) + +/-- Jensen's inequality for a `DivFunction` and a probability measure. -/ +theorem DivFunction.map_lintegral_le [IsProbabilityMeasure μ] {h : α → ℝ≥0∞} (hh : AEMeasurable h μ) + (hhi : ∫⁻ x, h x ∂μ ≠ ∞) : + f (∫⁻ x, h x ∂μ) ≤ ∫⁻ x, f (h x) ∂μ := by + by_cases hJ : ∫⁻ x, f (h x) ∂μ = ∞ + · rw [hJ] + exact le_top + have hfh : AEMeasurable (fun x ↦ f (h x)) μ := f.measurable.comp_aemeasurable hh + have h_lt_top : ∀ᵐ x ∂μ, h x < ∞ := ae_lt_top' hh hhi + have hf_lt_top : ∀ᵐ x ∂μ, f (h x) < ∞ := ae_lt_top' hfh hJ + have h_le_xmax : ∀ᵐ x ∂μ, h x ≤ f.xmax := by + filter_upwards [hf_lt_top] with x hx + by_contra h_gt + exact hx.ne (f.eq_top_of_xmax_lt (not_le.mp h_gt)) + have h_xmin_le : ∀ᵐ x ∂μ, f.xmin ≤ h x := by + filter_upwards [hf_lt_top] with x hx + by_contra h_gt + exact hx.ne (f.eq_top_of_lt_xmin (not_le.mp h_gt)) + set m := ∫⁻ x, h x ∂μ with hm + -- integrated supporting-line inequality at any interior point + have h_key : ∀ x ∈ Ioo f.xmin f.xmax, + f x + ENNReal.ofReal (max (f.rightDeriv x) 0) * m + + ENNReal.ofReal (max (-f.rightDeriv x) 0) * x + ≤ (∫⁻ y, f (h y) ∂μ) + + ENNReal.ofReal (max (f.rightDeriv x) 0) * x + + ENNReal.ofReal (max (-f.rightDeriv x) 0) * m := by + intro x hx + have h_ae : ∀ᵐ y ∂μ, + f x + ENNReal.ofReal (max (f.rightDeriv x) 0) * h y + + ENNReal.ofReal (max (-f.rightDeriv x) 0) * x + ≤ f (h y) + ENNReal.ofReal (max (f.rightDeriv x) 0) * x + + ENNReal.ofReal (max (-f.rightDeriv x) 0) * h y := by + filter_upwards [h_lt_top] with y hy + exact f.apply_add_le_apply_add hx hy.ne + have h_int := lintegral_mono_ae h_ae + rwa [lintegral_add_right' _ aemeasurable_const, lintegral_add_left' aemeasurable_const, + lintegral_const_mul' _ _ ENNReal.ofReal_ne_top, lintegral_const, lintegral_const, + measure_univ, mul_one, mul_one, lintegral_add_right' _ (hh.const_mul _), + lintegral_add_right' _ aemeasurable_const, lintegral_const, measure_univ, mul_one, + lintegral_const_mul' _ _ ENNReal.ofReal_ne_top] at h_int + have hm_le : m ≤ f.xmax := by + calc m ≤ ∫⁻ _, f.xmax ∂μ := lintegral_mono_ae h_le_xmax + _ = f.xmax := by simp + have hm_ge : f.xmin ≤ m := by + calc f.xmin = ∫⁻ _, f.xmin ∂μ := by simp + _ ≤ m := lintegral_mono_ae h_xmin_le + rcases lt_or_eq_of_le hm_le with hm_lt | hm_eq + swap + · -- `m = xmax`: impossible, since `h < xmax` a.e. and the measure is a probability measure + exfalso + have h_top : f.xmax ≠ ∞ := hm_eq ▸ hhi + have h_lt : ∀ᵐ x ∂μ, h x < f.xmax := by + filter_upwards [h_le_xmax, hf_lt_top] with x hx hx' + refine lt_of_le_of_ne hx fun h_eq ↦ hx'.ne ?_ + rw [h_eq] + exact f.apply_xmax_eq_top h_top + have := lintegral_strict_mono (NeZero.ne μ) aemeasurable_const hhi h_lt + simp only [lintegral_const, measure_univ, mul_one] at this + exact this.ne hm_eq + rcases lt_or_eq_of_le hm_ge with hm_gt | hm_eq + swap + · -- `m = xmin`: either `xmin = 0` and `h = 0` a.e., or `h > xmin` a.e., which is impossible + by_cases h0 : f.xmin = 0 + · have hm0 : m = 0 := by rw [← hm_eq, h0] + have h_zero : h =ᵐ[μ] 0 := (lintegral_eq_zero_iff' hh).mp hm0 + rw [hm0] + refine le_of_eq ?_ + calc f 0 = ∫⁻ _, f 0 ∂μ := by simp + _ = ∫⁻ y, f (h y) ∂μ := by + refine lintegral_congr_ae ?_ + filter_upwards [h_zero] with y hy + rw [hy, Pi.zero_apply] + · exfalso + have h_lt : ∀ᵐ x ∂μ, f.xmin < h x := by + filter_upwards [h_xmin_le, hf_lt_top] with x hx hx' + refine lt_of_le_of_ne hx fun h_eq ↦ hx'.ne ?_ + rw [← h_eq] + exact f.apply_xmin_eq_top (pos_iff_ne_zero.mpr h0) + have := lintegral_strict_mono (NeZero.ne μ) hh (by simp [xmin_ne_top]) h_lt + simp only [lintegral_const, measure_univ, mul_one] at this + exact this.ne hm_eq + -- interior case: cancel the finite terms + have h := h_key m ⟨hm_gt, hm_lt⟩ + rw [add_assoc, add_assoc] at h + exact ENNReal.le_of_add_le_add_right (by finiteness) h + +/-- Jensen's inequality for a `DivFunction` and a finite measure. -/ +theorem DivFunction.map_laverage_le [IsFiniteMeasure μ] [NeZero μ] {h : α → ℝ≥0∞} + (hh : AEMeasurable h μ) (hhi : ∫⁻ x, h x ∂μ ≠ ∞) : + f (⨍⁻ x, h x ∂μ) ≤ ⨍⁻ x, f (h x) ∂μ := by + rw [laverage_eq', laverage_eq'] + refine f.map_lintegral_le (hh.smul_measure _) ?_ + rw [lintegral_smul_measure, smul_eq_mul] + exact ENNReal.mul_ne_top (ENNReal.inv_ne_top.mpr (NeZero.ne _)) hhi + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/DivFunction/CompAffine.lean b/Statlib/Divergence/FDiv/DivFunction/CompAffine.lean new file mode 100644 index 0000000..8ad725f --- /dev/null +++ b/Statlib/Divergence/FDiv/DivFunction/CompAffine.lean @@ -0,0 +1,112 @@ +/- +Copyright (c) 2026 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne +-/ +module + +public import Statlib.Divergence.FDiv.DivFunction.DerivAtTop + +/-! # Composition of a divergence function with an affine map + +For a divergence function `f` and `a b : ℝ≥0` with `a + b = 1`, the function `x ↦ f (a * x + b)` +is again a divergence function. + +## Main definitions + +* `DivFunction.compAffine f a b hab`: the divergence function `x ↦ f (a * x + b)`. + +## Main statements + +* `DivFunction.derivAtTop_compAffine`: `(f.compAffine a b hab).derivAtTop = a * f.derivAtTop`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Filter Set +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +namespace DivFunction + +variable {f : DivFunction} {a b : ℝ≥0} + +lemma convexOn_comp_affine (f : DivFunction) (a b : ℝ≥0) : + ConvexOn ℝ≥0 univ (fun x : ℝ≥0∞ ↦ f (a * x + b)) := by + refine ⟨convex_univ, fun x _ y _ l m _ _ hlm ↦ ?_⟩ + have hlm' : (l : ℝ≥0∞) + m = 1 := by exact_mod_cast hlm + simp only [ENNReal.smul_def, smul_eq_mul] + have h_eq : (a : ℝ≥0∞) * (l * x + m * y) + b = l * (a * x + b) + m * (a * y + b) := by + calc (a : ℝ≥0∞) * (l * x + m * y) + b = a * (l * x + m * y) + (l + m) * b := by + rw [hlm', one_mul] + _ = l * (a * x + b) + m * (a * y + b) := by ring + rw [h_eq] + have h := f.convexOn.2 (mem_univ (a * x + b)) (mem_univ (a * y + b)) zero_le zero_le hlm + simpa only [ENNReal.smul_def, smul_eq_mul] using h + +lemma continuous_comp_affine (f : DivFunction) (a b : ℝ≥0) : + Continuous (fun x : ℝ≥0∞ ↦ f (a * x + b)) := + f.continuous.comp ((ENNReal.continuous_const_mul ENNReal.coe_ne_top).add continuous_const) + +/-- The divergence function `x ↦ f (a * x + b)`, for `a + b = 1`. -/ +noncomputable +def compAffine (f : DivFunction) (a b : ℝ≥0) (hab : a + b = 1) : DivFunction where + toFun x := f (a * x + b) + one := by + have hab' : (a : ℝ≥0∞) + b = 1 := by exact_mod_cast hab + simp [hab'] + convexOn' := f.convexOn_comp_affine a b + continuous' := f.continuous_comp_affine a b + +@[simp] lemma compAffine_apply (hab : a + b = 1) (x : ℝ≥0∞) : + f.compAffine a b hab x = f (a * x + b) := rfl + +@[simp] lemma derivAtTop_compAffine (hab : a + b = 1) : + (f.compAffine a b hab).derivAtTop = a * f.derivAtTop := by + have : (𝓝[<] (∞ : ℝ≥0∞)).NeBot := nhdsLT_neBot_of_exists_lt ⟨0, ENNReal.zero_lt_top⟩ + refine tendsto_nhds_unique (f.compAffine a b hab).tendsto_div_nhdsLT_top ?_ + rcases eq_or_ne a 0 with rfl | ha + · have hb : b = 1 := by simpa using hab + subst hb + simp + have ha' : (a : ℝ≥0∞) ≠ 0 := by exact_mod_cast ha + -- `a * y + b` tends to `∞` from below + have h_aff : Tendsto (fun y : ℝ≥0∞ ↦ a * y + b) (𝓝[<] ∞) (𝓝[<] ∞) := by + refine tendsto_nhdsWithin_iff.2 ⟨?_, ?_⟩ + · have h := ((ENNReal.continuous_const_mul (a := (a : ℝ≥0∞)) ENNReal.coe_ne_top).add + (continuous_const (y := (b : ℝ≥0∞)))).tendsto ∞ + simp only [Pi.add_apply, ENNReal.mul_top ha', top_add] at h + exact h.mono_left nhdsWithin_le_nhds + · filter_upwards [self_mem_nhdsWithin] with y (hy : y < ∞) + exact ENNReal.add_lt_top.2 ⟨ENNReal.mul_lt_top ENNReal.coe_lt_top hy, ENNReal.coe_lt_top⟩ + -- `(a * y + b) / y` tends to `a` + have h_ratio : Tendsto (fun y : ℝ≥0∞ ↦ (a * y + b) / y) (𝓝[<] ∞) (𝓝 a) := by + have h_inv : Tendsto (fun y : ℝ≥0∞ ↦ (b : ℝ≥0∞) * y⁻¹) (𝓝[<] ∞) (𝓝 0) := by + have h := ENNReal.Tendsto.const_mul + (((continuous_inv.tendsto (∞ : ℝ≥0∞))).mono_left (nhdsWithin_le_nhds (s := Iio ∞))) + (a := (b : ℝ≥0∞)) (Or.inr ENNReal.coe_ne_top) + simpa using h + have h_add := (tendsto_const_nhds (x := (a : ℝ≥0∞))).add h_inv + rw [add_zero] at h_add + refine h_add.congr' ?_ + filter_upwards [Ioo_mem_nhdsLT ENNReal.zero_lt_top] with y hy + rw [ENNReal.add_div, ENNReal.mul_div_cancel_right hy.1.ne' hy.2.ne, div_eq_mul_inv] + have h := ENNReal.Tendsto.mul (f.tendsto_div_nhdsLT_top.comp h_aff) (Or.inr ENNReal.coe_ne_top) + h_ratio (Or.inl ha') + rw [mul_comm] + refine h.congr' ?_ + filter_upwards [Ioo_mem_nhdsLT ENNReal.zero_lt_top] with y hy + have h0 : (a : ℝ≥0∞) * y + b ≠ 0 := by + simp [ha', hy.1.ne'] + have h_top : (a : ℝ≥0∞) * y + b ≠ ∞ := + (ENNReal.add_lt_top.2 ⟨ENNReal.mul_lt_top ENNReal.coe_lt_top hy.2, ENNReal.coe_lt_top⟩).ne + simp only [Function.comp_apply, compAffine_apply, div_eq_mul_inv] + rw [mul_assoc, ← mul_assoc _ (a * y + b), ENNReal.inv_mul_cancel h0 h_top, one_mul] + +end DivFunction + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/DivFunction/Conj.lean b/Statlib/Divergence/FDiv/DivFunction/Conj.lean new file mode 100644 index 0000000..92f309e --- /dev/null +++ b/Statlib/Divergence/FDiv/DivFunction/Conj.lean @@ -0,0 +1,209 @@ +/- +Copyright (c) 2026 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne +-/ +module + +public import Statlib.Divergence.FDiv.DivFunction.DerivAtTop + +/-! # Conjugate of a divergence function + +For a divergence function `f`, its conjugate is `x ↦ x * f x⁻¹`, extended by `f.derivAtTop` at `0` +(the limit of `f y / y` as `y → ∞`, see `tendsto_div_nhdsLT_top`) and by `∞ * f 0` at `∞`. + +## Main definitions + +* `DivFunction.conj f`: the conjugate of the divergence function `f`. + +## Main statements + +* `DivFunction.derivAtTop_conj`: `f.conj.derivAtTop = f 0`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Real MeasureTheory Filter Set +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +namespace DivFunction + +variable {f : DivFunction} + +/-- The conjugate function `x ↦ x * f x⁻¹`, with value `f.derivAtTop` at `0`. -/ +noncomputable def conjFun (f : DivFunction) (x : ℝ≥0∞) : ℝ≥0∞ := + if x = 0 then f.derivAtTop else x * f x⁻¹ + +@[simp] lemma conjFun_zero : f.conjFun 0 = f.derivAtTop := by simp [conjFun] + +lemma conjFun_of_ne_zero {x : ℝ≥0∞} (hx : x ≠ 0) : f.conjFun x = x * f x⁻¹ := by + simp [conjFun, hx] + +@[simp] lemma conjFun_top : f.conjFun ∞ = ∞ * f 0 := by simp [conjFun] + +@[simp] lemma conjFun_one : f.conjFun 1 = 0 := by simp [conjFun] + +lemma continuous_conjFun : Continuous f.conjFun := by + rw [continuous_iff_continuousAt] + intro x + rcases eq_or_ne x 0 with rfl | hx0 + · have h_inv : Tendsto (fun y : ℝ≥0∞ ↦ y⁻¹) (𝓝[>] 0) (𝓝[<] ∞) := by + refine tendsto_nhdsWithin_iff.2 ⟨?_, ?_⟩ + · simpa using (continuous_inv.tendsto (0 : ℝ≥0∞)).mono_left nhdsWithin_le_nhds + · exact eventually_nhdsWithin_of_forall fun y hy ↦ ENNReal.inv_lt_top.2 hy + have h : ContinuousWithinAt f.conjFun (Ioi 0) 0 := by + rw [ContinuousWithinAt, conjFun_zero] + refine (f.tendsto_div_nhdsLT_top.comp h_inv).congr' ?_ + filter_upwards [self_mem_nhdsWithin] with y (hy : 0 < y) + simp [conjFun, hy.ne', div_eq_mul_inv, mul_comm] + rwa [continuousWithinAt_Ioi_iff_Ici, ← ENNReal.bot_eq_zero, Ici_bot, + continuousWithinAt_univ] at h + rcases eq_or_ne x ∞ with rfl | hx_top + · by_cases hf0 : f 0 = 0 + · have h_ev : f.conjFun =ᶠ[𝓝 ∞] fun _ ↦ f.conjFun ∞ := by + filter_upwards [Ioi_mem_nhds ENNReal.one_lt_top] with y (hy : 1 < y) + rw [conjFun_of_ne_zero (zero_lt_one.trans hy).ne', conjFun_top, hf0, mul_zero, + f.apply_eq_zero_of_le_one hf0 (ENNReal.inv_le_one.2 hy.le), mul_zero] + exact continuousAt_const.congr_of_eventuallyEq h_ev + · have h : Tendsto (fun y ↦ y * f y⁻¹) (𝓝 ∞) (𝓝 (∞ * f ∞⁻¹)) := + ENNReal.Tendsto.mul tendsto_id (Or.inl ENNReal.top_ne_zero) + ((f.continuous.tendsto _).comp (continuous_inv.tendsto ∞)) (Or.inl (by simpa using hf0)) + rw [ContinuousAt, conjFun_top] + simp only [ENNReal.inv_top] at h + refine Tendsto.congr' ?_ h + filter_upwards [eventually_ne_nhds ENNReal.top_ne_zero] with y hy + exact (conjFun_of_ne_zero hy).symm + · have h : Tendsto (fun y ↦ y * f y⁻¹) (𝓝 x) (𝓝 (x * f x⁻¹)) := + ENNReal.Tendsto.mul tendsto_id (Or.inl hx0) + ((f.continuous.tendsto _).comp (continuous_inv.tendsto x)) (Or.inr hx_top) + rw [ContinuousAt, conjFun_of_ne_zero hx0] + refine Tendsto.congr' ?_ h + filter_upwards [eventually_ne_nhds hx0] with y hy + exact (conjFun_of_ne_zero hy).symm + +private lemma conjFun_mul_le {a b : ℝ≥0} (hab : a + b = 1) (hb : b ≠ 0) (y : ℝ≥0∞) : + f.conjFun (b * y) ≤ a * f.derivAtTop + b * f.conjFun y := by + have hb' : (b : ℝ≥0∞) ≠ 0 := by exact_mod_cast hb + have hb1 : (b : ℝ≥0∞) ≤ 1 := by exact_mod_cast (le_add_self.trans hab.le) + have hab' : (a : ℝ≥0∞) + b = 1 := by exact_mod_cast hab + rcases eq_or_ne y 0 with rfl | hy0 + · simp only [mul_zero, conjFun_zero] + rw [← add_mul, hab', one_mul] + rcases eq_or_ne y ∞ with rfl | hy_top + · rw [ENNReal.mul_top hb', conjFun_top] + by_cases hf0 : f 0 = 0 + · simp [hf0] + · rw [ENNReal.top_mul hf0, ENNReal.mul_top hb', add_top] + have hby0 : (b : ℝ≥0∞) * y ≠ 0 := mul_ne_zero hb' hy0 + have hby_top : (b : ℝ≥0∞) * y ≠ ∞ := ENNReal.mul_ne_top ENNReal.coe_ne_top hy_top + rw [conjFun_of_ne_zero hby0, conjFun_of_ne_zero hy0] + have h_le : y⁻¹ ≤ ((b : ℝ≥0∞) * y)⁻¹ := ENNReal.inv_le_inv.2 (mul_le_of_le_one_left' hb1) + have h := f.le_add_derivAtTop h_le + have h_alg : (b : ℝ≥0∞) * y * (((b : ℝ≥0∞) * y)⁻¹ - y⁻¹) = a := by + rw [ENNReal.mul_inv (Or.inl hb') (Or.inl ENNReal.coe_ne_top), + ENNReal.mul_sub (fun _ _ ↦ hby_top), mul_mul_mul_comm, + ENNReal.mul_inv_cancel hb' ENNReal.coe_ne_top, ENNReal.mul_inv_cancel hy0 hy_top, one_mul, + mul_assoc, ENNReal.mul_inv_cancel hy0 hy_top, mul_one] + exact (ENNReal.eq_sub_of_add_eq ENNReal.coe_ne_top hab').symm + calc (b : ℝ≥0∞) * y * f ((b : ℝ≥0∞) * y)⁻¹ + ≤ (b : ℝ≥0∞) * y * (f y⁻¹ + f.derivAtTop * (((b : ℝ≥0∞) * y)⁻¹ - y⁻¹)) := by gcongr + _ = b * (y * f y⁻¹) + f.derivAtTop * ((b : ℝ≥0∞) * y * (((b : ℝ≥0∞) * y)⁻¹ - y⁻¹)) := by + ring + _ = a * f.derivAtTop + b * (y * f y⁻¹) := by rw [h_alg, add_comm, mul_comm] + +private lemma conjFun_add_le_of_ne_zero {x y : ℝ≥0∞} (hx : x ≠ 0) (hy : y ≠ 0) {a b : ℝ≥0} + (ha : a ≠ 0) (hb : b ≠ 0) (hab : a + b = 1) : + f.conjFun (a * x + b * y) ≤ a * f.conjFun x + b * f.conjFun y := by + have ha' : (a : ℝ≥0∞) ≠ 0 := by exact_mod_cast ha + have hb' : (b : ℝ≥0∞) ≠ 0 := by exact_mod_cast hb + have hab' : (a : ℝ≥0∞) + b = 1 := by exact_mod_cast hab + rcases eq_or_ne x ∞ with rfl | hx_top + · rw [ENNReal.mul_top ha', top_add, conjFun_top] + by_cases hf0 : f 0 = 0 + · simp [hf0] + · rw [ENNReal.top_mul hf0, ENNReal.mul_top ha', top_add] + rcases eq_or_ne y ∞ with rfl | hy_top + · rw [ENNReal.mul_top hb', add_top, conjFun_top] + by_cases hf0 : f 0 = 0 + · simp [hf0] + · rw [ENNReal.top_mul hf0, ENNReal.mul_top hb', add_top] + set z := (a : ℝ≥0∞) * x + b * y with hz + have hz0 : z ≠ 0 := by simp [hz, ha', hx] + have hz_top : z ≠ ∞ := by simp [hz, ENNReal.mul_eq_top, hx_top, hy_top] + rw [conjFun_of_ne_zero hz0, conjFun_of_ne_zero hx, conjFun_of_ne_zero hy] + set l₁ : ℝ≥0 := ((a : ℝ≥0∞) * x / z).toNNReal with hl₁ + set l₂ : ℝ≥0 := ((b : ℝ≥0∞) * y / z).toNNReal with hl₂ + have hl₁' : (l₁ : ℝ≥0∞) = a * x / z := + ENNReal.coe_toNNReal (ENNReal.div_ne_top (ENNReal.mul_ne_top ENNReal.coe_ne_top hx_top) hz0) + have hl₂' : (l₂ : ℝ≥0∞) = b * y / z := + ENNReal.coe_toNNReal (ENNReal.div_ne_top (ENNReal.mul_ne_top ENNReal.coe_ne_top hy_top) hz0) + have hl : l₁ + l₂ = 1 := by + rw [← ENNReal.coe_inj, ENNReal.coe_add, hl₁', hl₂', ENNReal.coe_one, ENNReal.div_add_div_same, + ← hz, ENNReal.div_self hz0 hz_top] + have h_arg : z⁻¹ = l₁ • x⁻¹ + l₂ • y⁻¹ := by + simp only [ENNReal.smul_def, smul_eq_mul, hl₁', hl₂', div_eq_mul_inv] + calc z⁻¹ = (a + b) * z⁻¹ := by rw [hab', one_mul] + _ = a * (x * x⁻¹) * z⁻¹ + b * (y * y⁻¹) * z⁻¹ := by + rw [ENNReal.mul_inv_cancel hx hx_top, ENNReal.mul_inv_cancel hy hy_top, mul_one, mul_one, + add_mul] + _ = a * x * z⁻¹ * x⁻¹ + b * y * z⁻¹ * y⁻¹ := by ring + have h_conv := f.convexOn.2 (mem_univ x⁻¹) (mem_univ y⁻¹) zero_le zero_le hl + rw [← h_arg] at h_conv + simp only [ENNReal.smul_def, smul_eq_mul, hl₁', hl₂'] at h_conv + calc z * f z⁻¹ ≤ z * (a * x / z * f x⁻¹ + b * y / z * f y⁻¹) := by gcongr + _ = (a * x * (z * z⁻¹)) * f x⁻¹ + (b * y * (z * z⁻¹)) * f y⁻¹ := by + simp only [div_eq_mul_inv]; ring + _ = a * (x * f x⁻¹) + b * (y * f y⁻¹) := by rw [ENNReal.mul_inv_cancel hz0 hz_top]; ring + +lemma convexOn_conjFun : ConvexOn ℝ≥0 univ f.conjFun := by + refine ⟨convex_univ, fun x _ y _ a b ha hb hab ↦ ?_⟩ + simp only [ENNReal.smul_def, smul_eq_mul] + rcases eq_or_ne a 0 with rfl | ha0 + · rw [zero_add] at hab + subst hab + simp + rcases eq_or_ne b 0 with rfl | hb0 + · rw [add_zero] at hab + subst hab + simp + rcases eq_or_ne x 0 with rfl | hx0 + · rw [mul_zero, zero_add, conjFun_zero] + exact f.conjFun_mul_le hab hb0 y + rcases eq_or_ne y 0 with rfl | hy0 + · rw [mul_zero, add_zero, conjFun_zero, add_comm] + exact f.conjFun_mul_le (by rwa [add_comm]) ha0 x + exact f.conjFun_add_le_of_ne_zero hx0 hy0 ha0 hb0 hab + +/-- Conjugate of a divergence function: `x ↦ x * f x⁻¹`, with value `f.derivAtTop` at `0`. -/ +noncomputable +def conj (f : DivFunction) : DivFunction where + toFun := f.conjFun + one := conjFun_one + convexOn' := convexOn_conjFun + continuous' := continuous_conjFun + +lemma conj_apply (f : DivFunction) (x : ℝ≥0∞) : + f.conj x = if x = 0 then f.derivAtTop else x * f x⁻¹ := rfl + +lemma conj_of_ne_zero {x : ℝ≥0∞} (hx : x ≠ 0) : f.conj x = x * f x⁻¹ := conjFun_of_ne_zero hx + +@[simp] lemma conj_zero : f.conj 0 = f.derivAtTop := conjFun_zero + +@[simp] lemma derivAtTop_conj : f.conj.derivAtTop = f 0 := by + have : (𝓝[<] (∞ : ℝ≥0∞)).NeBot := nhdsLT_neBot_of_exists_lt ⟨0, ENNReal.zero_lt_top⟩ + refine tendsto_nhds_unique f.conj.tendsto_div_nhdsLT_top ?_ + have h_inv : Tendsto (fun y : ℝ≥0∞ ↦ y⁻¹) (𝓝[<] ∞) (𝓝 0) := by + simpa using (continuous_inv.tendsto (∞ : ℝ≥0∞)).mono_left nhdsWithin_le_nhds + refine ((f.continuous.tendsto 0).comp h_inv).congr' ?_ + filter_upwards [Ioo_mem_nhdsLT ENNReal.zero_lt_top] with y hy + rw [Function.comp_apply, conj_of_ne_zero hy.1.ne', mul_comm, mul_div_assoc, + ENNReal.div_self hy.1.ne' hy.2.ne, mul_one] + +end DivFunction + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/DivFunction/CurvatureMeasure.lean b/Statlib/Divergence/FDiv/DivFunction/CurvatureMeasure.lean new file mode 100644 index 0000000..b1a03fc --- /dev/null +++ b/Statlib/Divergence/FDiv/DivFunction/CurvatureMeasure.lean @@ -0,0 +1,570 @@ +/- +Copyright (c) 2024 Lorenzo Luccioli. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.Analysis.Calculus.Deriv.Comp +public import Mathlib.MeasureTheory.Constructions.Polish.Basic +public import Mathlib.MeasureTheory.Integral.IntervalIntegral.FundThmCalculus +public import Statlib.Divergence.FDiv.DivFunction.RightDerivStieltjes +public import Statlib.ForMathlib.MeasureTheory.Measure.Lebesgue.Basic + +/-! # Curvature measure of a divergence function + +The curvature measure of a `DivFunction` `f` is the Lebesgue-Stieltjes measure associated to its +right derivative. Its main use is the Taylor formula expressing `f x` as an integral against the +curvature measure (`taylor_one_right`, `taylor_one_left`). + +The curvature measure is additive under assumptions on the boundary of the effective domains +(`curvatureMeasure_add`), and `(c • f).curvatureMeasure = c • f.curvatureMeasure` for `c ≠ 0` +(`curvatureMeasure_smul`). + +## Main definitions + +* `DivFunction.curvatureMeasure f`: the Stieltjes measure of `f.rightDerivStieltjes`, as a measure + on `ℝ≥0∞`. +* `DivFunction.curvatureMeasureReal f`: its pushforward to `ℝ` by `ENNReal.toReal`. + +## Main statements + +* `taylor_one_right`, `taylor_one_left`: for `1 ≤ b < ∞`, + `f b = f.rightDeriv 1 * (b - 1) + ∫⁻ x in Ioc 1 b, b - x ∂f.curvatureMeasure`, and for `b ≤ 1`, + `f b + f.rightDeriv 1 * (1 - b) = ∫⁻ x in Ioc b 1, x - b ∂f.curvatureMeasure`. +* `taylor_one_real`: the real version, for `f` with `f.rightDeriv 1 = 0`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open MeasureTheory Set StieltjesFunction Function Filter + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +namespace DivFunction + +variable {f g : DivFunction} + +/-- The curvature measure induced by a convex function. It is defined as the only measure that has +the right derivative of the function as a CDF. -/ +noncomputable +irreducible_def curvatureMeasure (f : DivFunction) : Measure ℝ≥0∞ := + f.rightDerivStieltjes.measure.map ENNReal.ofReal + +lemma curvatureMeasure_Ioi (a : ℝ≥0∞) (ha : a ≠ ∞) : + f.curvatureMeasure (Ioi a) = f.rightDerivStieltjes.measure (Ioi a.toReal) := by + rw [curvatureMeasure, Measure.map_apply] + · congr 1 + ext x + simp only [mem_preimage, mem_Ioi] + rw [ENNReal.lt_ofReal_iff_toReal_lt ha] + · fun_prop + · simp + +lemma curvatureMeasure_singleton_top : f.curvatureMeasure {∞} = 0 := by + rw [curvatureMeasure, Measure.map_apply] + · have : ENNReal.ofReal ⁻¹' {⊤} = ∅ := by ext; simp + simp [this] + · exact ENNReal.measurable_ofReal + · simp + +@[simp] +lemma curvatureMeasure_Ioo_top_eq_curvatureMeasure_Ioi {a : ℝ≥0∞} (ha : a ≠ ∞) : + f.curvatureMeasure (Ioo a ∞) = f.curvatureMeasure (Ioi a) := by + have : Ioi a = Ioo a ∞ ∪ {∞} := by + ext x + simp only [mem_Ioi, union_singleton, mem_insert_iff, mem_Ioo] + by_cases hx : x = ∞ + · simp [hx, ha.lt_top] + · simp [Ne.lt_top hx, hx] + rw [this, measure_union _ (measurableSet_singleton _), curvatureMeasure_singleton_top, add_zero] + simp + +/-- The curvature measure of `f + g` is the sum of the curvature measures of `f` and `g`, provided +that `f` and `g` have effective domains with the same endpoints, and that their right derivatives +both tend to `-∞` at the left endpoint or both have a finite limit there. Without the last +assumption, one of the two curvature measures would have an infinite atom at `f.xmin` while the +curvature measure of `f + g` has none. -/ +lemma curvatureMeasure_add (hxmin : f.xmin = g.xmin) (hxmax : f.xmax = g.xmax) + (h_deriv : Tendsto (fun y ↦ derivWithin f.realFun (Ioi y) y) (𝓝[>] f.xmin.toReal) atBot + ↔ Tendsto (fun y ↦ derivWithin g.realFun (Ioi y) y) (𝓝[>] g.xmin.toReal) atBot) : + (f + g).curvatureMeasure = f.curvatureMeasure + g.curvatureMeasure := by + simp_rw [curvatureMeasure] + rw [rightDerivStieltjes_add, ERealStieltjes.measure_add_of_eq_bot_iff_of_eq_top_iff _ _ + (rightDerivStieltjes_eq_bot_iff_of_xmin_eq hxmin h_deriv) + fun x ↦ by rw [rightDerivStieltjes_eq_top_iff, rightDerivStieltjes_eq_top_iff, hxmax], + Measure.map_add _ _ ENNReal.measurable_ofReal] + +/-- The curvature measure of `c • f` is `c` times the curvature measure of `f`, for `c ≠ 0`. For +`c = 0`, `0 • f = 0` and the curvature measure of `0` is not `0`: it has an infinite atom at `0`. -/ +lemma curvatureMeasure_smul {c : ℝ≥0} (hc : c ≠ 0) : + (c • f).curvatureMeasure = c • f.curvatureMeasure := by + simp_rw [curvatureMeasure] + rw [rightDerivStieltjes_smul hc, ERealStieltjes.measure_smul, + Measure.map_smul _ ENNReal.measurable_ofReal.aemeasurable] + +section ConvexTaylor + +/-! ### Taylor formula at `1` for a `DivFunction` + +We prove `f b = c * (b - 1) + ∫⁻ x in Ioc 1 b, (b - x) ∂f.curvatureMeasure` for `1 ≤ b` and +`f b + c * (1 - b) = ∫⁻ x in Ioc b 1, (x - b) ∂f.curvatureMeasure` for `b ≤ 1`, where +`c = f.rightDeriv 1`. In the interior of the effective domain this is the fundamental +theorem of calculus for the (monotone) right derivative of `f.realFun`, followed by Tonelli's +theorem. The formulas extend to the boundary of the effective domain by monotonicity and +monotone convergence. -/ + +lemma measure_Ioc_one_right {s : ℝ} (hs : 1 < s) (hs' : ENNReal.ofReal s < f.xmax) : + f.rightDerivStieltjes.measure (Ioc 1 s) + = ENNReal.ofReal (derivWithin f.realFun (Ioi s) s - f.rightDeriv 1) := by + rw [ERealStieltjes.measure_Ioc, rightDerivStieltjes_one, + rightDerivStieltjes_of_mem_interior (xmin_lt_one.trans (ENNReal.one_lt_ofReal.mpr hs)) hs', + ← EReal.coe_sub, EReal.toENNReal_of_ne_top (EReal.coe_ne_top _), EReal.toReal_coe] + +lemma measure_Ioc_one_left {s : ℝ} (hs : f.xmin < ENNReal.ofReal s) (hs' : s ≤ 1) : + f.rightDerivStieltjes.measure (Ioc s 1) + = ENNReal.ofReal (f.rightDeriv 1 - derivWithin f.realFun (Ioi s) s) := by + rw [ERealStieltjes.measure_Ioc, rightDerivStieltjes_one, + rightDerivStieltjes_of_mem_interior hs ((ENNReal.ofReal_le_one.mpr hs').trans_lt one_lt_xmax), + ← EReal.coe_sub, EReal.toENNReal_of_ne_top (EReal.coe_ne_top _), EReal.toReal_coe] + +lemma monotoneOn_derivWithin_realFun_Icc {a b : ℝ} (ha : f.xmin < ENNReal.ofReal a) + (hb : ENNReal.ofReal b < f.xmax) : + MonotoneOn (fun y ↦ derivWithin f.realFun (Ioi y) y) (Icc a b) := fun _ hx _ hy hxy ↦ + f.derivWithin_realFun_mono hxy (ha.trans_le (ENNReal.ofReal_le_ofReal hx.1)) + ((ENNReal.ofReal_le_ofReal hy.2).trans_lt hb) + +lemma continuousOn_realFun_Icc {a b : ℝ} (ha : f.xmin < ENNReal.ofReal a) + (hb : ENNReal.ofReal b < f.xmax) : + ContinuousOn f.realFun (Icc a b) := + f.continuousOn_realFun_Ioo.mono fun _ hx ↦ mem_toReal_Ioo_iff.mpr + ⟨ha.trans_le (ENNReal.ofReal_le_ofReal hx.1), (ENNReal.ofReal_le_ofReal hx.2).trans_lt hb⟩ + +lemma hasDerivWithinAt_realFun {x : ℝ} (hx : f.xmin < ENNReal.ofReal x) + (hx' : ENNReal.ofReal x < f.xmax) : + HasDerivWithinAt f.realFun (derivWithin f.realFun (Ioi x) x) (Ioi x) x := + (f.differentiableWithinAt_realFun ⟨hx, hx'⟩).hasDerivWithinAt + +lemma intervalIntegrable_derivWithin_realFun {a b : ℝ} (hab : a ≤ b) + (ha : f.xmin < ENNReal.ofReal a) (hb : ENNReal.ofReal b < f.xmax) : + IntervalIntegrable (fun y ↦ derivWithin f.realFun (Ioi y) y) volume a b := by + refine MonotoneOn.intervalIntegrable ?_ + rw [uIcc_of_le hab] + exact f.monotoneOn_derivWithin_realFun_Icc ha hb + +/-- Fundamental theorem of calculus for `f.realFun` on an interval inside the effective domain. -/ +lemma integral_derivWithin_realFun {a b : ℝ} (hab : a ≤ b) (ha : f.xmin < ENNReal.ofReal a) + (hb : ENNReal.ofReal b < f.xmax) : + ∫ s in a..b, derivWithin f.realFun (Ioi s) s = f.realFun b - f.realFun a := by + refine intervalIntegral.integral_eq_sub_of_hasDeriv_right ?_ ?_ + (f.intervalIntegrable_derivWithin_realFun hab ha hb) + · rw [uIcc_of_le hab] + exact f.continuousOn_realFun_Icc ha hb + · intro x hx + rw [min_eq_left hab, max_eq_right hab] at hx + exact f.hasDerivWithinAt_realFun (ha.trans_le (ENNReal.ofReal_le_ofReal hx.1.le)) + ((ENNReal.ofReal_le_ofReal hx.2.le).trans_lt hb) + +lemma integral_derivWithin_realFun_sub_rightDeriv_one {t : ℝ} (ht : 1 ≤ t) + (ht' : ENNReal.ofReal t < f.xmax) : + ∫ s in (1)..t, (derivWithin f.realFun (Ioi s) s - f.rightDeriv 1) + = f.realFun t - f.rightDeriv 1 * (t - 1) := by + rw [intervalIntegral.integral_sub + (f.intervalIntegrable_derivWithin_realFun ht (by simpa using xmin_lt_one) ht') + intervalIntegrable_const, + f.integral_derivWithin_realFun ht (by simpa using xmin_lt_one) ht', + intervalIntegral.integral_const, realFun_one, smul_eq_mul] + ring + +lemma integral_rightDeriv_one_sub_derivWithin_realFun {t : ℝ} (ht : f.xmin < ENNReal.ofReal t) + (ht' : t ≤ 1) : + ∫ s in t..(1), (f.rightDeriv 1 - derivWithin f.realFun (Ioi s) s) + = f.realFun t + f.rightDeriv 1 * (1 - t) := by + rw [intervalIntegral.integral_sub intervalIntegrable_const + (f.intervalIntegrable_derivWithin_realFun ht' ht (by simpa using one_lt_xmax)), + f.integral_derivWithin_realFun ht' ht (by simpa using one_lt_xmax), + intervalIntegral.integral_const, realFun_one, smul_eq_mul] + ring + +lemma setLIntegral_Ioc_sub_right_eq_ofReal {t : ℝ} (ht : 1 ≤ t) + (ht' : ENNReal.ofReal t < f.xmax) : + ∫⁻ x in Ioc 1 t, ENNReal.ofReal (t - x) ∂f.rightDerivStieltjes.measure + = ENNReal.ofReal (f.realFun t - f.rightDeriv 1 * (t - 1)) := by + rw [setLIntegral_Ioc_ofReal_const_sub] + have h_eq : ∀ s ∈ Ioc 1 t, f.rightDerivStieltjes.measure (Ioc 1 s) + = ENNReal.ofReal (derivWithin f.realFun (Ioi s) s - f.rightDeriv 1) := fun s hs ↦ + f.measure_Ioc_one_right hs.1 ((ENNReal.ofReal_le_ofReal hs.2).trans_lt ht') + rw [setLIntegral_congr_fun measurableSet_Ioc h_eq, ← ofReal_integral_eq_lintegral_ofReal, + ← intervalIntegral.integral_of_le ht, f.integral_derivWithin_realFun_sub_rightDeriv_one ht ht'] + · exact ((intervalIntegrable_iff_integrableOn_Ioc_of_le ht).mp + (f.intervalIntegrable_derivWithin_realFun ht (by simpa using xmin_lt_one) ht')).sub + (integrableOn_const (by rw [Real.volume_Ioc]; exact ENNReal.ofReal_ne_top)) + · refine ae_restrict_of_forall_mem measurableSet_Ioc fun s hs ↦ sub_nonneg.mpr ?_ + exact f.derivWithin_realFun_mono hs.1.le (by simpa using xmin_lt_one) + ((ENNReal.ofReal_le_ofReal hs.2).trans_lt ht') + +lemma setLIntegral_Ioc_sub_left_eq_ofReal {t : ℝ} (ht : f.xmin < ENNReal.ofReal t) + (ht' : t ≤ 1) : + ∫⁻ x in Ioc t 1, ENNReal.ofReal (x - t) ∂f.rightDerivStieltjes.measure + = ENNReal.ofReal (f.realFun t + f.rightDeriv 1 * (1 - t)) := by + rw [setLIntegral_Ioc_ofReal_sub_const] + have h_eq : ∀ s ∈ Ioc t 1, f.rightDerivStieltjes.measure (Ioc s 1) + = ENNReal.ofReal (f.rightDeriv 1 - derivWithin f.realFun (Ioi s) s) := fun s hs ↦ + f.measure_Ioc_one_left (ht.trans_le (ENNReal.ofReal_le_ofReal hs.1.le)) hs.2 + rw [setLIntegral_congr_fun measurableSet_Ioc h_eq, ← ofReal_integral_eq_lintegral_ofReal, + ← intervalIntegral.integral_of_le ht', f.integral_rightDeriv_one_sub_derivWithin_realFun ht ht'] + · exact (integrableOn_const (by rw [Real.volume_Ioc]; exact ENNReal.ofReal_ne_top)).sub + ((intervalIntegrable_iff_integrableOn_Ioc_of_le ht').mp + (f.intervalIntegrable_derivWithin_realFun ht' ht (by simpa using one_lt_xmax))) + · refine ae_restrict_of_forall_mem measurableSet_Ioc fun s hs ↦ sub_nonneg.mpr ?_ + exact f.derivWithin_realFun_mono hs.2 (ht.trans_le (ENNReal.ofReal_le_ofReal hs.1.le)) + (by simpa using one_lt_xmax) + +lemma realFun_sub_rightDeriv_one_mul_nonneg {t : ℝ} (ht : 1 ≤ t) + (ht' : ENNReal.ofReal t < f.xmax) : + 0 ≤ f.realFun t - f.rightDeriv 1 * (t - 1) := by + rw [← f.integral_derivWithin_realFun_sub_rightDeriv_one ht ht'] + refine intervalIntegral.integral_nonneg ht fun u hu ↦ sub_nonneg.mpr ?_ + exact f.derivWithin_realFun_mono hu.1 (by simpa using xmin_lt_one) + ((ENNReal.ofReal_le_ofReal hu.2).trans_lt ht') + +/-- Taylor formula at `1` on the right, inside the effective domain. -/ +lemma taylor_one_right_of_lt_xmax {b : ℝ≥0∞} (hb : 1 ≤ b) (hb' : b < f.xmax) : + f b = ENNReal.ofReal (f.rightDeriv 1) * (b - 1) + + ∫⁻ x in Ioc 1 b, b - x ∂f.curvatureMeasure := by + have hb_top : b ≠ ∞ := hb'.ne_top + have hbt : b = ENNReal.ofReal b.toReal := (ENNReal.ofReal_toReal hb_top).symm + have ht1 : 1 ≤ b.toReal := by + rw [← ENNReal.toReal_one] + exact ENNReal.toReal_mono hb_top hb + have ht' : ENNReal.ofReal b.toReal < f.xmax := by + rw [← hbt] + exact hb' + have h_lint : ∫⁻ x in Ioc 1 b, b - x ∂f.curvatureMeasure + = ∫⁻ x in Ioc 1 b.toReal, ENNReal.ofReal (b.toReal - x) ∂f.rightDerivStieltjes.measure := by + rw [curvatureMeasure, setLIntegral_map (f := fun x ↦ b - x) measurableSet_Ioc (by fun_prop) + ENNReal.measurable_ofReal] + have h_pre : ENNReal.ofReal ⁻¹' Ioc 1 b = Ioc 1 b.toReal := by + ext x + simp only [mem_preimage, mem_Ioc] + rw [ENNReal.one_lt_ofReal, ENNReal.ofReal_le_iff_le_toReal hb_top] + rw [h_pre] + refine setLIntegral_congr_fun measurableSet_Ioc fun x hx ↦ ?_ + rw [ENNReal.ofReal_sub _ (zero_le_one.trans hx.1.le), ENNReal.ofReal_toReal hb_top] + rw [h_lint, f.setLIntegral_Ioc_sub_right_eq_ofReal ht1 ht'] + have hfb : f b ≠ ∞ := (lt_top_of_mem_Ioo ⟨xmin_lt_one.trans_le hb, hb'⟩).ne + calc f b = ENNReal.ofReal (f.realFun b.toReal) := by + rw [realFun_toReal f hb_top, ENNReal.ofReal_toReal hfb] + _ = ENNReal.ofReal (f.rightDeriv 1 * (b.toReal - 1) + + (f.realFun b.toReal - f.rightDeriv 1 * (b.toReal - 1))) := by + congr 1 + ring + _ = ENNReal.ofReal (f.rightDeriv 1 * (b.toReal - 1)) + + ENNReal.ofReal (f.realFun b.toReal - f.rightDeriv 1 * (b.toReal - 1)) := + ENNReal.ofReal_add (mul_nonneg f.rightDeriv_one_nonneg (sub_nonneg.mpr ht1)) + (f.realFun_sub_rightDeriv_one_mul_nonneg ht1 ht') + _ = _ := by + rw [ENNReal.ofReal_mul f.rightDeriv_one_nonneg, ENNReal.ofReal_sub _ zero_le_one, + ENNReal.ofReal_one, ENNReal.ofReal_toReal hb_top] + +/-- Taylor formula at `1` on the left, inside the effective domain. -/ +lemma taylor_one_left_of_xmin_lt {b : ℝ≥0∞} (hb : f.xmin < b) (hb' : b ≤ 1) : + f b + ENNReal.ofReal (f.rightDeriv 1) * (1 - b) + = ∫⁻ x in Ioc b 1, x - b ∂f.curvatureMeasure := by + have hb_top : b ≠ ∞ := ne_top_of_le_ne_top ENNReal.one_ne_top hb' + have hbt : b = ENNReal.ofReal b.toReal := (ENNReal.ofReal_toReal hb_top).symm + have ht0 : 0 ≤ b.toReal := ENNReal.toReal_nonneg + have ht1 : b.toReal ≤ 1 := by + rw [← ENNReal.toReal_one] + exact ENNReal.toReal_mono ENNReal.one_ne_top hb' + have ht' : f.xmin < ENNReal.ofReal b.toReal := by + rw [← hbt] + exact hb + have h_lint : ∫⁻ x in Ioc b 1, x - b ∂f.curvatureMeasure + = ∫⁻ x in Ioc b.toReal 1, ENNReal.ofReal (x - b.toReal) ∂f.rightDerivStieltjes.measure := by + rw [curvatureMeasure, setLIntegral_map (f := fun x ↦ x - b) measurableSet_Ioc (by fun_prop) + ENNReal.measurable_ofReal] + have h_pre : ENNReal.ofReal ⁻¹' Ioc b 1 = Ioc b.toReal 1 := by + ext x + simp only [mem_preimage, mem_Ioc] + rw [ENNReal.lt_ofReal_iff_toReal_lt hb_top, ENNReal.ofReal_le_one] + rw [h_pre] + refine setLIntegral_congr_fun measurableSet_Ioc fun x hx ↦ ?_ + rw [ENNReal.ofReal_sub _ ht0, ENNReal.ofReal_toReal hb_top] + rw [h_lint, f.setLIntegral_Ioc_sub_left_eq_ofReal ht' ht1] + have hfb : f b ≠ ∞ := (lt_top_of_mem_Ioo ⟨hb, hb'.trans_lt one_lt_xmax⟩).ne + rw [ENNReal.ofReal_add (f.realFun_nonneg _) + (mul_nonneg f.rightDeriv_one_nonneg (sub_nonneg.mpr ht1)), + ENNReal.ofReal_mul f.rightDeriv_one_nonneg, ENNReal.ofReal_sub _ ht0, ENNReal.ofReal_one, + ENNReal.ofReal_toReal hb_top, realFun_toReal f hb_top, ENNReal.ofReal_toReal hfb] + +/-- Taylor formula at `1` on the right, for any finite `b ≥ 1`. -/ +theorem taylor_one_right {b : ℝ≥0∞} (hb : 1 ≤ b) (hb_top : b ≠ ∞) : + f b = ENNReal.ofReal (f.rightDeriv 1) * (b - 1) + + ∫⁻ x in Ioc 1 b, b - x ∂f.curvatureMeasure := by + by_cases hb' : b < f.xmax + · exact f.taylor_one_right_of_lt_xmax hb hb' + push Not at hb' + have hxmax : f.xmax ≠ ∞ := ne_top_of_le_ne_top hb_top hb' + have hfb : f b = ∞ := by + rcases eq_or_lt_of_le hb' with h | h + · rw [← h] + exact apply_xmax_eq_top hxmax + · exact eq_top_of_xmax_lt h + rw [hfb] + -- the right-hand side dominates `f t` for every `t ∈ [1, xmax)`, and `f t → ∞` as `t → xmax` + symm + by_contra h_ne + have h_lt := lt_top_iff_ne_top.mpr h_ne + have h_ne_bot : (𝓝[<] f.xmax).NeBot := by + refine mem_closure_iff_nhdsWithin_neBot.mp ?_ + rw [closure_Iio' ⟨0, xmax_pos⟩] + simp + have h_tendsto : Tendsto f (𝓝[<] f.xmax) (𝓝 ∞) := by + rw [← apply_xmax_eq_top hxmax] + exact (f.continuous.tendsto _).mono_left nhdsWithin_le_nhds + obtain ⟨t, ht_lt, ht⟩ := + ((h_tendsto.eventually (Ioi_mem_nhds h_lt)).and (Ioo_mem_nhdsLT one_lt_xmax)).exists + refine absurd ht_lt (not_lt.mpr ?_) + rw [f.taylor_one_right_of_lt_xmax ht.1.le ht.2] + have htb : t ≤ b := ht.2.le.trans hb' + refine add_le_add (mul_le_mul' le_rfl (tsub_le_tsub_right htb 1)) ?_ + exact (lintegral_mono fun x ↦ tsub_le_tsub_right htb x).trans + (lintegral_mono_set (Ioc_subset_Ioc_right htb)) + +/-- Taylor formula at `1` on the left, for any `b ≤ 1`. -/ +theorem taylor_one_left {b : ℝ≥0∞} (hb : b ≤ 1) : + f b + ENNReal.ofReal (f.rightDeriv 1) * (1 - b) + = ∫⁻ x in Ioc b 1, x - b ∂f.curvatureMeasure := by + by_cases hb' : f.xmin < b + · exact f.taylor_one_left_of_xmin_lt hb' hb + push Not at hb' + -- the right-hand side is antitone in `b` + have h_anti : ∀ t, b ≤ t → ∫⁻ x in Ioc t 1, x - t ∂f.curvatureMeasure + ≤ ∫⁻ x in Ioc b 1, x - b ∂f.curvatureMeasure := fun t hbt ↦ + (lintegral_mono fun x ↦ tsub_le_tsub_left hbt x).trans + (lintegral_mono_set (Ioc_subset_Ioc_left hbt)) + rcases eq_or_lt_of_le (zero_le (a := f.xmin)) with hxmin | hxmin + · -- `xmin = 0`, so `b = 0`: monotone convergence along `t n → 0` + obtain rfl : b = 0 := le_antisymm (hb'.trans hxmin.symm.le) zero_le + set t : ℕ → ℝ≥0∞ := fun n ↦ ENNReal.ofReal (1 / (n + 1)) with ht_def + have ht_pos : ∀ n, 0 < t n := fun n ↦ ENNReal.ofReal_pos.mpr Nat.one_div_pos_of_nat + have ht_le : ∀ n, t n ≤ 1 := fun n ↦ by + rw [ht_def, ENNReal.ofReal_le_one] + exact (div_le_one (Nat.cast_add_one_pos n)).mpr + (by linarith [(Nat.cast_nonneg n : (0 : ℝ) ≤ n)]) + have ht_anti : Antitone t := fun n m hnm ↦ ENNReal.ofReal_le_ofReal + (one_div_le_one_div_of_le (Nat.cast_add_one_pos n) + (by exact_mod_cast Nat.add_le_add_right hnm 1)) + have ht_tendsto : Tendsto t atTop (𝓝 0) := by + rw [← ENNReal.ofReal_zero] + exact ENNReal.tendsto_ofReal tendsto_one_div_add_atTop_nhds_zero_nat + have ht_iInf : ⨅ n, t n = 0 := tendsto_nhds_unique (tendsto_atTop_iInf ht_anti) ht_tendsto + have h_rhs : ∫⁻ x in Ioc 0 1, x - 0 ∂f.curvatureMeasure + = ⨆ n, ∫⁻ x in Ioc (t n) 1, x - t n ∂f.curvatureMeasure := by + simp_rw [← lintegral_indicator measurableSet_Ioc] + rw [← lintegral_iSup] + · congr 1 + ext x + by_cases hx : x ∈ Ioc 0 1 + · rw [indicator_of_mem hx, tsub_zero] + have : ∀ n, (Ioc (t n) 1).indicator (fun y ↦ y - t n) x = x - t n := by + intro n + by_cases hxn : x ∈ Ioc (t n) 1 + · rw [indicator_of_mem hxn] + · rw [indicator_of_notMem hxn, eq_comm, tsub_eq_zero_iff_le] + exact not_lt.mp fun h ↦ hxn ⟨h, hx.2⟩ + simp_rw [this] + rw [← ENNReal.sub_iInf, ht_iInf, tsub_zero] + · rw [indicator_of_notMem hx] + symm + exact ENNReal.iSup_eq_zero.mpr fun n ↦ + indicator_of_notMem (fun (h : x ∈ Ioc (t n) 1) ↦ hx ⟨(ht_pos n).trans h.1, h.2⟩) _ + · exact fun n ↦ (measurable_id.sub measurable_const).indicator measurableSet_Ioc + · intro n m hnm x + dsimp only + by_cases hx : x ∈ Ioc (t n) 1 + · have hxm : x ∈ Ioc (t m) 1 := ⟨(ht_anti hnm).trans_lt hx.1, hx.2⟩ + rw [indicator_of_mem hx, indicator_of_mem hxm] + exact tsub_le_tsub_left (ht_anti hnm) x + · rw [indicator_of_notMem hx] + exact zero_le + have h_lhs : f 0 + ENNReal.ofReal (f.rightDeriv 1) * (1 - 0) + = ⨆ n, (f (t n) + ENNReal.ofReal (f.rightDeriv 1) * (1 - t n)) := by + rw [← ENNReal.iSup_add_iSup_of_monotone] + · congr 1 + · refine tendsto_nhds_unique ((f.continuous.tendsto 0).comp ht_tendsto) + (tendsto_atTop_iSup fun n m hnm ↦ ?_) + exact f.antitoneOn (ht_le m) (ht_le n) (ht_anti hnm) + · rw [← ENNReal.mul_iSup, ← ENNReal.sub_iInf, ht_iInf] + · exact fun n m hnm ↦ f.antitoneOn (ht_le m) (ht_le n) (ht_anti hnm) + · exact fun n m hnm ↦ mul_le_mul' le_rfl (tsub_le_tsub_left (ht_anti hnm) 1) + rw [h_lhs, h_rhs] + congr 1 + ext n + refine f.taylor_one_left_of_xmin_lt ?_ (ht_le n) + rw [← hxmin] + exact ht_pos n + · -- `0 < xmin`, so `f b = ∞`: the right-hand side dominates `f t → ∞` as `t → xmin` + have hfb : f b = ∞ := by + rcases eq_or_lt_of_le hb' with h | h + · rw [h] + exact apply_xmin_eq_top hxmin + · exact eq_top_of_lt_xmin h + rw [hfb, top_add] + symm + by_contra h_ne + have h_lt := lt_top_iff_ne_top.mpr h_ne + have h_ne_bot : (𝓝[>] f.xmin).NeBot := by + refine mem_closure_iff_nhdsWithin_neBot.mp ?_ + rw [closure_Ioi' ⟨1, xmin_lt_one⟩] + simp + have h_tendsto : Tendsto f (𝓝[>] f.xmin) (𝓝 ∞) := by + rw [← apply_xmin_eq_top hxmin] + exact (f.continuous.tendsto _).mono_left nhdsWithin_le_nhds + obtain ⟨t, ht_lt, ht⟩ := + ((h_tendsto.eventually (Ioi_mem_nhds h_lt)).and (Ioo_mem_nhdsGT xmin_lt_one)).exists + refine absurd ht_lt (not_lt.mpr ?_) + calc f t ≤ f t + ENNReal.ofReal (f.rightDeriv 1) * (1 - t) := le_self_add + _ = ∫⁻ x in Ioc t 1, x - t ∂f.curvatureMeasure := + f.taylor_one_left_of_xmin_lt ht.1 ht.2.le + _ ≤ _ := h_anti t (hb'.trans ht.1.le) + +/-- Taylor formula at `1` on the right, for `f` with `f.rightDeriv 1 = 0`. -/ +theorem taylor_one_right_of_rightDeriv_one_eq_zero (hf : f.rightDeriv 1 = 0) {b : ℝ≥0∞} + (hb : 1 ≤ b) (hb_top : b ≠ ∞) : + f b = ∫⁻ x in Ioc 1 b, b - x ∂f.curvatureMeasure := by + rw [f.taylor_one_right hb hb_top, hf, ENNReal.ofReal_zero, zero_mul, zero_add] + +/-- Taylor formula at `1` on the left, for `f` with `f.rightDeriv 1 = 0`. -/ +theorem taylor_one_left_of_rightDeriv_one_eq_zero (hf : f.rightDeriv 1 = 0) {b : ℝ≥0∞} + (hb : b ≤ 1) : + f b = ∫⁻ x in Ioc b 1, x - b ∂f.curvatureMeasure := by + have h := f.taylor_one_left hb + rwa [hf, ENNReal.ofReal_zero, zero_mul, add_zero] at h + +/-- The curvature measure of `f`, pushed forward to `ℝ` by `ENNReal.toReal`. -/ +noncomputable +def curvatureMeasureReal (f : DivFunction) : Measure ℝ := f.curvatureMeasure.map ENNReal.toReal + +lemma curvatureMeasureReal_apply (f : DivFunction) {s : Set ℝ} (hs : MeasurableSet s) : + f.curvatureMeasureReal s = f.curvatureMeasure (ENNReal.toReal ⁻¹' s) := by + rw [curvatureMeasureReal, Measure.map_apply (by fun_prop) hs] + +instance : SFinite f.curvatureMeasure := by + rw [curvatureMeasure] + infer_instance + +instance : SFinite f.curvatureMeasureReal := by + rw [curvatureMeasureReal] + infer_instance + +lemma lintegral_curvatureMeasureReal (f : DivFunction) {g : ℝ → ℝ≥0∞} (hg : Measurable g) : + ∫⁻ x, g x ∂f.curvatureMeasureReal = ∫⁻ x, g x.toReal ∂f.curvatureMeasure := by + unfold curvatureMeasureReal + rw [lintegral_map hg (by fun_prop)] + +lemma integral_curvatureMeasureReal {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] + (f : DivFunction) {g : ℝ → E} (hg : StronglyMeasurable g) : + ∫ x, g x ∂f.curvatureMeasureReal = ∫ x, g x.toReal ∂f.curvatureMeasure := by + unfold curvatureMeasureReal + rw [integral_map _ hg.aestronglyMeasurable] + exact Measurable.aemeasurable (by fun_prop) + +lemma setLIntegral_curvatureMeasureReal (f : DivFunction) {g : ℝ → ℝ≥0∞} (hg : Measurable g) + {s : Set ℝ} (hs : MeasurableSet s) : + ∫⁻ x in s, g x ∂f.curvatureMeasureReal + = ∫⁻ x in ENNReal.toReal ⁻¹' s, g x.toReal ∂f.curvatureMeasure := by + unfold curvatureMeasureReal + rw [setLIntegral_map hs hg (by fun_prop)] + +lemma setIntegral_curvatureMeasureReal {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] + (f : DivFunction) {g : ℝ → E} (hg : StronglyMeasurable g) {s : Set ℝ} (hs : MeasurableSet s) : + ∫ x in s, g x ∂f.curvatureMeasureReal + = ∫ x in ENNReal.toReal ⁻¹' s, g x.toReal ∂f.curvatureMeasure := by + unfold curvatureMeasureReal + rw [setIntegral_map hs hg.aestronglyMeasurable] + exact Measurable.aemeasurable (by fun_prop) + +lemma setLIntegral_Ioc_curvatureMeasureReal (f : DivFunction) {g : ℝ → ℝ≥0∞} (hg : Measurable g) + {a b : ℝ} (h : 0 ≤ a) : + ∫⁻ x in Ioc a b, g x ∂f.curvatureMeasureReal + = ∫⁻ x in Ioc (ENNReal.ofReal a) (ENNReal.ofReal b), g x.toReal ∂f.curvatureMeasure := by + rw [setLIntegral_curvatureMeasureReal f hg measurableSet_Ioc, ENNReal.preimage_toReal_Ioc h] + +lemma setIntegral_Ioc_curvatureMeasureReal {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] + (f : DivFunction) {g : ℝ → E} (hg : StronglyMeasurable g) {a b : ℝ} + (h : 0 ≤ a) : + ∫ x in Ioc a b, g x ∂f.curvatureMeasureReal + = ∫ x in Ioc (ENNReal.ofReal a) (ENNReal.ofReal b), g x.toReal ∂f.curvatureMeasure := by + rw [setIntegral_curvatureMeasureReal f hg measurableSet_Ioc, ENNReal.preimage_toReal_Ioc h] + +/-- Taylor formula at `1` on the right for the real function `f.realFun`, for `f` with +`f.rightDeriv 1 = 0`. -/ +theorem taylor_one_right_real (hf : f.rightDeriv 1 = 0) {b : ℝ} (hb : 1 ≤ b) : + f.realFun b = ∫ x in Ioc 1 b, b - x ∂f.curvatureMeasureReal := by + rw [← ENNReal.ofReal_eq_ofReal_iff] + rotate_left + · exact f.realFun_nonneg _ + · exact setIntegral_nonneg measurableSet_Ioc fun x hx ↦ sub_nonneg_of_le hx.2 + rw [setIntegral_Ioc_curvatureMeasureReal f _ zero_le_one, ENNReal.ofReal_one] + swap; · refine Measurable.stronglyMeasurable ?_; fun_prop + have : ∫ x in Ioc 1 (ENNReal.ofReal b), b - x.toReal ∂f.curvatureMeasure + = ∫ x in Ioc 1 (ENNReal.ofReal b), (ENNReal.ofReal b - x).toReal ∂f.curvatureMeasure := by + refine setIntegral_congr_fun measurableSet_Ioc fun x hx ↦ ?_ + rw [ENNReal.toReal_sub_of_le hx.2 ENNReal.ofReal_ne_top, + ENNReal.toReal_ofReal (zero_le_one.trans hb)] + rw [this, integral_toReal] + rotate_left + · exact Measurable.aemeasurable (by fun_prop) + · exact ae_of_all _ fun x ↦ tsub_le_self.trans_lt ENNReal.ofReal_lt_top + rw [← taylor_one_right_of_rightDeriv_one_eq_zero hf (ENNReal.one_le_ofReal.mpr hb) + ENNReal.ofReal_ne_top, realFun] + +/-- Taylor formula at `1` on the left for the real function `f.realFun`, for `f` with +`f.rightDeriv 1 = 0`. -/ +theorem taylor_one_left_real (hf : f.rightDeriv 1 = 0) {b : ℝ} + (hb_zero : 0 ≤ b) (hb : b ≤ 1) : + f.realFun b = ∫ x in Ioc b 1, x - b ∂f.curvatureMeasureReal := by + rw [← ENNReal.ofReal_eq_ofReal_iff] + rotate_left + · exact f.realFun_nonneg _ + · exact setIntegral_nonneg measurableSet_Ioc fun x hx ↦ sub_nonneg_of_le hx.1.le + rw [setIntegral_Ioc_curvatureMeasureReal f _ hb_zero, ENNReal.ofReal_one] + swap; · refine Measurable.stronglyMeasurable ?_; fun_prop + have : ∫ x in Ioc (ENNReal.ofReal b) 1, x.toReal - b ∂f.curvatureMeasure + = ∫ x in Ioc (ENNReal.ofReal b) 1, (x - ENNReal.ofReal b).toReal ∂f.curvatureMeasure := by + refine setIntegral_congr_fun measurableSet_Ioc fun x hx ↦ ?_ + rw [ENNReal.toReal_sub_of_le hx.1.le (hx.2.trans_lt ENNReal.one_lt_top).ne, + ENNReal.toReal_ofReal hb_zero] + rw [this, integral_toReal] + rotate_left + · exact Measurable.aemeasurable (by fun_prop) + · rw [ae_restrict_iff' measurableSet_Ioc] + exact ae_of_all _ fun x hx ↦ tsub_le_self.trans_lt (hx.2.trans_lt ENNReal.one_lt_top) + rw [← taylor_one_left_of_rightDeriv_one_eq_zero hf, realFun] + simp [hb] + +/-- Taylor formula at `1` for the real function `f.realFun`, for `f` with +`f.rightDeriv 1 = 0`. -/ +theorem taylor_one_real (hf : f.rightDeriv 1 = 0) {b : ℝ} (hb_zero : 0 ≤ b) : + f.realFun b = ∫ x in (1)..b, b - x ∂f.curvatureMeasureReal := by + rcases le_or_gt 1 b with hb | hb + · simp only [intervalIntegral, not_lt, hb, Ioc_eq_empty, Measure.restrict_empty, + integral_zero_measure, sub_zero] + exact taylor_one_right_real hf hb + · simp only [intervalIntegral, not_lt, hb.le, Ioc_eq_empty, Measure.restrict_empty, + integral_zero_measure, zero_sub] + simp only [← integral_neg, neg_sub] + exact taylor_one_left_real hf hb_zero hb.le + +end ConvexTaylor + +end DivFunction + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/DivFunction/DerivAtTop.lean b/Statlib/Divergence/FDiv/DivFunction/DerivAtTop.lean new file mode 100644 index 0000000..dadc56a --- /dev/null +++ b/Statlib/Divergence/FDiv/DivFunction/DerivAtTop.lean @@ -0,0 +1,223 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Statlib.Divergence.FDiv.DivFunction.Basic + +/-! +# Derivative at infinity of a divergence function + +## Main definitions + +* `DivFunction.derivAtTop`: the limit of `f y / y` as `y → ∞`, an element of `ℝ≥0∞`. It is defined + as a `limsup`, so that it is always defined. + +## Main statements + +* `DivFunction.tendsto_div_nhdsLT_top`: `f y / y` tends to `f.derivAtTop`. More generally, so does + `f y / (y - a)` for every `a ≠ ∞` (`DivFunction.tendsto_div_sub_nhdsLT_top`). +* `DivFunction.le_add_derivAtTop`: for `y ≤ x`, `f x ≤ f y + f.derivAtTop * (x - y)`. +* `DivFunction.derivAtTop_add`, `DivFunction.derivAtTop_smul`, `DivFunction.derivAtTop_mono`: + behavior under addition, scalar multiplication and pointwise order. + +## Implementation details + +The limit of `f y / y` exists because the slope `f y / (y - 1)` of `f` from the point `1`, where `f` +vanishes, is nondecreasing on `(1, ∞)` by convexity (`DivFunction.div_sub_one_le_div_sub_one`). + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds), where `derivAtTop` was defined as the limit +of the right derivative of `f`. +-/ + +@[expose] public section + +open MeasureTheory Filter Set + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory.DivFunction + +variable {α : Type*} {mα : MeasurableSpace α} {f g : DivFunction} + +/-- The derivative at infinity of a divergence function: the limit of `f y / y` as `y → ∞` +(`tendsto_div_nhdsLT_top`). -/ +noncomputable +def derivAtTop (f : DivFunction) : ℝ≥0∞ := limsup (fun y ↦ f y / y) (𝓝[<] ∞) + +/-- If `x` is the convex combination `u • y + v • z` of `y ≤ x ≤ z`, then `x - y = v * (z - y)`. -/ +private lemma sub_eq_mul_sub {x y z : ℝ≥0∞} {u v : ℝ≥0} (hyx : y ≤ x) (hxz : x ≤ z) (hz : z ≠ ∞) + (huv : u + v = 1) (hx : u • y + v • z = x) : + x - y = v * (z - y) := by + have hx_top : x ≠ ∞ := ne_top_of_le_ne_top hz hxz + have hy_top : y ≠ ∞ := ne_top_of_le_ne_top hx_top hyx + have hu : (u : ℝ) = 1 - v := by rw [eq_sub_iff_add_eq, ← NNReal.coe_add, huv, NNReal.coe_one] + have hx_real : x.toReal = u * y.toReal + v * z.toReal := by + rw [← hx, ENNReal.smul_def, ENNReal.smul_def, smul_eq_mul, smul_eq_mul, + ENNReal.toReal_add (ENNReal.mul_ne_top ENNReal.coe_ne_top hy_top) + (ENNReal.mul_ne_top ENNReal.coe_ne_top hz), + ENNReal.toReal_mul, ENNReal.toReal_mul, ENNReal.coe_toReal, ENNReal.coe_toReal] + rw [← ENNReal.toReal_eq_toReal_iff' (ENNReal.sub_ne_top hx_top) + (ENNReal.mul_ne_top ENNReal.coe_ne_top (ENNReal.sub_ne_top hz)), + ENNReal.toReal_sub_of_le hyx hx_top, ENNReal.toReal_mul, + ENNReal.toReal_sub_of_le (hyx.trans hxz) hz, ENNReal.coe_toReal, hx_real, hu] + ring + +/-- The slope of a divergence function from the point `1`, where it vanishes, is nondecreasing on +`(1, ∞)`. -/ +lemma div_sub_one_le_div_sub_one {y z : ℝ≥0∞} (hy : 1 < y) (hyz : y ≤ z) (hz : z ≠ ∞) : + f y / (y - 1) ≤ f z / (z - 1) := by + obtain ⟨u, v, huv, hy_eq⟩ := ENNReal.exists_nnreal_smul_add_eq hz hy.le hyz + have hfy : f y ≤ v * f z := by + calc f y = f (u • 1 + v • z) := by rw [hy_eq] + _ ≤ u • f 1 + v • f z := f.convexOn.2 (mem_univ _) (mem_univ _) zero_le zero_le huv + _ = v * f z := by simp [ENNReal.smul_def] + have h_sub : y - 1 = v * (z - 1) := sub_eq_mul_sub hy.le hyz hz huv hy_eq + have hv : (v : ℝ≥0∞) ≠ 0 := by + intro hv + rw [hv, zero_mul, tsub_eq_zero_iff_le] at h_sub + exact hy.not_ge h_sub + calc f y / (y - 1) ≤ v * f z / (v * (z - 1)) := by rw [h_sub]; gcongr + _ = f z / (z - 1) := ENNReal.mul_div_mul_left _ _ hv ENNReal.coe_ne_top + +private lemma tendsto_sub_div_self {a : ℝ≥0∞} (ha : a ≠ ∞) : + Tendsto (fun z ↦ (z - a) / z) (𝓝[<] ∞) (𝓝 1) := by + have h_inv : Tendsto (fun z : ℝ≥0∞ ↦ z⁻¹) (𝓝[<] ∞) (𝓝 0) := by + simpa using (continuous_inv.tendsto ∞).mono_left nhdsWithin_le_nhds + have h_lim : Tendsto (fun z ↦ 1 - a * z⁻¹) (𝓝[<] ∞) (𝓝 1) := by + simpa using ENNReal.Tendsto.sub tendsto_const_nhds (ENNReal.Tendsto.const_mul h_inv (Or.inr ha)) + (Or.inl ENNReal.one_ne_top) + refine h_lim.congr' ?_ + filter_upwards [Ioo_mem_nhdsLT ENNReal.zero_lt_top] with z hz + rw [ENNReal.sub_div fun _ _ ↦ hz.1.ne', ENNReal.div_self hz.1.ne' hz.2.ne, div_eq_mul_inv] + +/-- The common limit of `f y / (y - a)` for all `a ≠ ∞`. -/ +private lemma exists_tendsto_div_sub (f : DivFunction) : + ∃ S, ∀ a, a ≠ ∞ → Tendsto (fun y ↦ f y / (y - a)) (𝓝[<] ∞) (𝓝 S) := by + have h_mono : MonotoneOn (fun y ↦ f y / (y - 1)) (Ioo 1 ∞) := + fun y hy z hz hyz ↦ f.div_sub_one_le_div_sub_one hy.1 hyz hz.2.ne + have h_slope := h_mono.tendsto_nhdsWithin_Ioo_left ⟨2, ENNReal.one_lt_two, ENNReal.ofNat_lt_top⟩ + (OrderTop.bddAbove _) + refine ⟨sSup ((fun y ↦ f y / (y - 1)) '' Ioo 1 ∞), fun a ha ↦ ?_⟩ + have h_ratio : Tendsto (fun y ↦ (y - 1) / y * (y / (y - a))) (𝓝[<] ∞) (𝓝 1) := by + have h_inv : Tendsto (fun y ↦ ((y - a) / y)⁻¹) (𝓝[<] ∞) (𝓝 1) := by + simpa [Function.comp_def] using (continuous_inv.tendsto 1).comp (tendsto_sub_div_self ha) + have h_eq : (fun y ↦ ((y - a) / y)⁻¹) =ᶠ[𝓝[<] ∞] fun y ↦ y / (y - a) := by + filter_upwards [Ioo_mem_nhdsLT ENNReal.zero_lt_top] with y hy + rw [ENNReal.inv_div (a := y - a) (b := y) (Or.inl hy.2.ne) (Or.inl hy.1.ne')] + simpa using ENNReal.Tendsto.mul (tendsto_sub_div_self ENNReal.one_ne_top) + (Or.inr ENNReal.one_ne_top) (h_inv.congr' h_eq) (Or.inr ENNReal.one_ne_top) + refine (ENNReal.Tendsto.mul h_slope (Or.inr ENNReal.one_ne_top) h_ratio + (Or.inl one_ne_zero)).congr' ?_ |>.mono_right (by rw [mul_one]) + filter_upwards [Ioo_mem_nhdsLT (max_lt ENNReal.one_lt_top ha.lt_top)] with y hy + have hy1 : 1 < y := (le_max_left _ _).trans_lt hy.1 + have hya : a < y := (le_max_right _ _).trans_lt hy.1 + rw [ENNReal.div_mul_div_cancel (b := y) (zero_lt_one.trans hy1).ne' hy.2.ne, + ENNReal.div_mul_div_cancel (b := y - 1) (tsub_pos_of_lt hy1).ne' (ENNReal.sub_ne_top hy.2.ne)] + +/-- `f y / (y - a)` tends to `f.derivAtTop` as `y → ∞`, for every `a ≠ ∞`. -/ +lemma tendsto_div_sub_nhdsLT_top {a : ℝ≥0∞} (ha : a ≠ ∞) : + Tendsto (fun y ↦ f y / (y - a)) (𝓝[<] ∞) (𝓝 f.derivAtTop) := by + obtain ⟨S, hS⟩ := f.exists_tendsto_div_sub + have h0 : derivAtTop f = S := by + simpa [derivAtTop] using (hS 0 ENNReal.zero_ne_top).limsup_eq + exact h0 ▸ hS a ha + +/-- `f y / y` tends to `f.derivAtTop` as `y → ∞`. -/ +lemma tendsto_div_nhdsLT_top : Tendsto (fun y ↦ f y / y) (𝓝[<] ∞) (𝓝 f.derivAtTop) := by + simpa using f.tendsto_div_sub_nhdsLT_top ENNReal.zero_ne_top + +lemma le_add_derivAtTop_of_ne_top {x y : ℝ≥0∞} (hyx : y ≤ x) (hx : x ≠ ∞) : + f x ≤ f y + f.derivAtTop * (x - y) := by + rcases hyx.eq_or_lt with rfl | hyx + · simp + have hy : y ≠ ∞ := ne_top_of_lt hyx + -- write `x` as a convex combination of `y` and `z ∈ (x, ∞)`, and let `z → ∞` + have h_le : ∀ z ∈ Ioo x ∞, f x ≤ f y + (x - y) * (f z / (z - y)) := by + intro z hz + obtain ⟨u, v, huv, hx_eq⟩ := ENNReal.exists_nnreal_smul_add_eq hz.2.ne hyx.le hz.1.le + have h_sub := sub_eq_mul_sub hyx.le hz.1.le hz.2.ne huv hx_eq + have hzy : z - y ≠ 0 := (tsub_pos_of_lt (hyx.trans hz.1)).ne' + have hv : (v : ℝ≥0∞) = (x - y) / (z - y) := by + rw [ENNReal.eq_div_iff hzy (ENNReal.sub_ne_top hz.2.ne), h_sub, mul_comm] + calc f x = f (u • y + v • z) := by rw [hx_eq] + _ ≤ u • f y + v • f z := f.convexOn.2 (mem_univ _) (mem_univ _) zero_le zero_le huv + _ ≤ f y + v * f z := by + rw [ENNReal.smul_def, ENNReal.smul_def, smul_eq_mul, smul_eq_mul] + gcongr + exact mul_le_of_le_one_left' (ENNReal.coe_le_one_iff.mpr (le_self_add.trans_eq huv)) + _ = f y + (x - y) * (f z / (z - y)) := by + rw [hv, div_eq_mul_inv, div_eq_mul_inv] + ring + have h_lim : Tendsto (fun z ↦ f y + (x - y) * (f z / (z - y))) (𝓝[<] ∞) + (𝓝 (f y + (x - y) * f.derivAtTop)) := + tendsto_const_nhds.add (ENNReal.Tendsto.const_mul (f.tendsto_div_sub_nhdsLT_top hy) + (Or.inr (ENNReal.sub_ne_top hx))) + rw [mul_comm] + exact ge_of_tendsto h_lim + (eventually_of_mem (Ioo_mem_nhdsLT (lt_top_iff_ne_top.mpr hx)) fun z hz ↦ h_le z hz) + +/-- A divergence function lies below its asymptote of slope `f.derivAtTop` through any point. -/ +lemma le_add_derivAtTop {x y : ℝ≥0∞} (hyx : y ≤ x) : + f x ≤ f y + f.derivAtTop * (x - y) := by + by_cases hx : x = ∞ + swap; · exact f.le_add_derivAtTop_of_ne_top hyx hx + subst hx + by_cases hy : y = ∞ + · simp [hy] + by_cases hd : f.derivAtTop = 0 + · simp only [hd, zero_mul, add_zero] + refine le_of_tendsto ((f.continuous.tendsto ∞).mono_left (nhdsWithin_le_nhds (s := Iio ∞))) ?_ + filter_upwards [Ioo_mem_nhdsLT (lt_top_iff_ne_top.mpr hy)] with z hz + simpa [hd] using f.le_add_derivAtTop_of_ne_top hz.1.le hz.2.ne + · rw [ENNReal.top_sub hy, ENNReal.mul_top hd] + simp + +lemma apply_add_le (x y : ℝ≥0∞) : f (x + y) ≤ f x + f.derivAtTop * y := by + by_cases hx : x = ∞ + · simp [hx] + simpa [ENNReal.add_sub_cancel_left hx] using f.le_add_derivAtTop (le_self_add : x ≤ x + y) + +/-- For `1 ≤ y`, `f y ≤ f.derivAtTop * y`. -/ +lemma apply_le_derivAtTop_mul {y : ℝ≥0∞} (hy : 1 ≤ y) : f y ≤ f.derivAtTop * y := by + have h := f.apply_add_le 1 (y - 1) + rw [add_tsub_cancel_of_le hy, apply_one, zero_add] at h + exact h.trans (by gcongr; exact tsub_le_self) + +/-- `derivAtTop` is monotone: if `f ≤ g` pointwise, then `f.derivAtTop ≤ g.derivAtTop`. -/ +lemma derivAtTop_mono (hfg : ∀ x, f x ≤ g x) : f.derivAtTop ≤ g.derivAtTop := + le_of_tendsto_of_tendsto' (b := 𝓝[<] ∞) f.tendsto_div_nhdsLT_top g.tendsto_div_nhdsLT_top + fun y ↦ ENNReal.div_le_div_right (hfg y) y + +@[simp] +lemma derivAtTop_zero : derivAtTop (0 : DivFunction) = 0 := by + simp [derivAtTop] + +@[simp] +lemma derivAtTop_add : (f + g).derivAtTop = f.derivAtTop + g.derivAtTop := by + refine tendsto_nhds_unique (f + g).tendsto_div_nhdsLT_top ?_ + simp only [add_apply, ENNReal.add_div] + exact f.tendsto_div_nhdsLT_top.add g.tendsto_div_nhdsLT_top + +@[simp] +lemma derivAtTop_smul {c : ℝ≥0} : (c • f).derivAtTop = c * f.derivAtTop := by + refine tendsto_nhds_unique (c • f).tendsto_div_nhdsLT_top ?_ + simp only [smul_apply, mul_div_assoc] + exact ENNReal.Tendsto.const_mul f.tendsto_div_nhdsLT_top (Or.inr ENNReal.coe_ne_top) + +lemma lintegral_comp_rnDeriv_ne_top (μ ν : Measure α) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] (hf_zero : f 0 ≠ ∞) (hf_deriv : f.derivAtTop ≠ ∞) : + ∫⁻ x, f (μ.rnDeriv ν x) ∂ν ≠ ∞ := by + have h x : f (μ.rnDeriv ν x) ≤ f 0 + f.derivAtTop * μ.rnDeriv ν x := by + simpa using f.apply_add_le 0 (μ.rnDeriv ν x) + refine ne_top_of_le_ne_top ?_ (lintegral_mono h) + rw [lintegral_add_left measurable_const, lintegral_const, + lintegral_const_mul _ (μ.measurable_rnDeriv ν)] + exact ENNReal.add_ne_top.mpr ⟨ENNReal.mul_ne_top hf_zero (measure_ne_top _ _), + ENNReal.mul_ne_top hf_deriv (ne_top_of_le_ne_top (measure_ne_top μ _) + Measure.lintegral_rnDeriv_le)⟩ + +end ProbabilityTheory.DivFunction diff --git a/Statlib/Divergence/FDiv/DivFunction/OfReal.lean b/Statlib/Divergence/FDiv/DivFunction/OfReal.lean new file mode 100644 index 0000000..531395b --- /dev/null +++ b/Statlib/Divergence/FDiv/DivFunction/OfReal.lean @@ -0,0 +1,351 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne +-/ +module + +public import Statlib.Divergence.FDiv.DivFunction.DerivAtTop +public import Mathlib.Topology.Order.LeftRightLim +public import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.IntegralRNDeriv + +/-! +# Divergence functions from real functions + +## Main definitions + +* `DivFunction.ofReal f hf hf_one`: the divergence function built from a function `f : ℝ → ℝ` + which is convex on `(0, ∞)` with `f 1 = 0`. It is `ENNReal.ofReal ∘ f` on `(0, ∞)`, extended by + its limits at `0` and `∞`. + +## Main statements + +* `DivFunction.derivAtTop_ofReal`: the `derivAtTop` of `ofReal f hf hf_one` is the slope at infinity + `derivAtTop f` of `f`, truncated at `0`. +* `lintegral_ofReal_eq_integral_of_continuous`, + `lintegral_ofReal_ne_top_iff_integrable_of_continuous`: relation between the integral of + `ofReal f hf hf_one` composed with a Radon-Nikodym derivative and the Bochner integral of `f` + composed with it. + +-/ + +@[expose] public section + +open Real MeasureTheory Filter Set MeasurableSpace + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {f : ℝ → ℝ} + +namespace DivFunction + +section OfReal + +section OfRealFun + +/-- The function `ℝ≥0∞ → ℝ≥0∞` underlying `DivFunction.ofReal`: it is `ENNReal.ofReal ∘ f` on +`(0, ∞)`, extended by its limits at `0` and `∞` to ensure continuity. -/ +noncomputable +def ofRealFun (f : ℝ → ℝ) (x : ℝ≥0∞) : ℝ≥0∞ := + if x = 0 then Function.rightLim (fun x ↦ ENNReal.ofReal (f x)) 0 + else if x = ∞ then limsup (fun x ↦ ENNReal.ofReal (f x)) atTop + else ENNReal.ofReal (f x.toReal) + +@[simp] +lemma ofRealFun_zero : ofRealFun f 0 = Function.rightLim (fun x ↦ ENNReal.ofReal (f x)) 0 := by + simp [ofRealFun] + +@[simp] +lemma ofRealFun_top : ofRealFun f ∞ = limsup (fun x ↦ ENNReal.ofReal (f x)) atTop := by + simp [ofRealFun] + +lemma ofRealFun_apply {x : ℝ≥0∞} (hx_zero : x ≠ 0) (hx_top : x ≠ ∞) : + ofRealFun f x = ENNReal.ofReal (f x.toReal) := by + simp [ofRealFun, hx_zero, hx_top] + +lemma tendsto_ofReal_comp_nhdsGT_zero (hf : ConvexOn ℝ (Ioi 0) f) (hf_one : f 1 = 0) : + Tendsto (fun x ↦ ENNReal.ofReal (f x)) (𝓝[>] 0) (𝓝 (ofRealFun f 0)) := by + rw [ofRealFun_zero] + -- `ENNReal.ofReal ∘ f` is antitone on `(0, 1]`: extend it to `(0, ∞)` by capping at 1 + have h_anti : AntitoneOn (fun x ↦ ENNReal.ofReal (f (min x 1))) (Ioi 0) := by + intro x hx y hy hxy + exact hf.antitoneOn_ofReal_comp hf_one ⟨lt_min hx one_pos, min_le_right _ _⟩ + ⟨lt_min hy one_pos, min_le_right _ _⟩ (min_le_min_right _ hxy) + have h_tendsto := h_anti.tendsto_nhdsGT (OrderTop.bddAbove _) + have h_eq : (fun x ↦ ENNReal.ofReal (f (min x 1))) + =ᶠ[𝓝[>] (0 : ℝ)] fun x ↦ ENNReal.ofReal (f x) := by + filter_upwards [Ioo_mem_nhdsGT zero_lt_one] with x hx + simp [min_eq_left hx.2.le] + rw [rightLim_eq_of_tendsto (h_tendsto.congr' h_eq)] + exact h_tendsto.congr' h_eq + +lemma tendsto_ofReal_comp_atTop (hf : ConvexOn ℝ (Ioi 0) f) (hf_one : f 1 = 0) : + Tendsto (fun x ↦ ENNReal.ofReal (f x)) atTop (𝓝 (ofRealFun f ∞)) := by + rw [ofRealFun_top] + obtain ⟨y, hy⟩ := (hf.monotoneOn_ofReal_comp hf_one).exists_tendsto_atTop + rw [hy.limsup_eq] + exact hy + +lemma continuous_ofRealFun (hf : ConvexOn ℝ (Ioi 0) f) (hf_one : f 1 = 0) : + Continuous (ofRealFun f) := by + have h_cont : ContinuousOn f (Ioi 0) := hf.continuousOn isOpen_Ioi + refine continuous_iff_continuousAt.mpr fun x ↦ ?_ + by_cases hx0 : x = 0 + · subst hx0 + rw [continuousAt_iff_continuous_left_right] + refine ⟨?_, ?_⟩ + · rw [← ENNReal.bot_eq_zero, Iic_bot] + exact continuousWithinAt_singleton + rw [← continuousWithinAt_Ioi_iff_Ici] + have h_toReal : Tendsto ENNReal.toReal (𝓝[>] (0 : ℝ≥0∞)) (𝓝[>] 0) := by + refine tendsto_nhdsWithin_iff.mpr ⟨?_, ?_⟩ + · exact tendsto_nhdsWithin_of_tendsto_nhds + (by simpa using ENNReal.tendsto_toReal ENNReal.zero_ne_top) + · filter_upwards [self_mem_nhdsWithin, + mem_nhdsWithin_of_mem_nhds (Iio_mem_nhds ENNReal.zero_lt_top)] with y hy hy_top + exact ENNReal.toReal_pos hy.ne' hy_top.ne + rw [ContinuousWithinAt] + refine ((tendsto_ofReal_comp_nhdsGT_zero hf hf_one).comp h_toReal).congr' ?_ + filter_upwards [self_mem_nhdsWithin, + mem_nhdsWithin_of_mem_nhds (Iio_mem_nhds ENNReal.zero_lt_top)] with y hy hy_top + simp [ofRealFun_apply hy.ne' hy_top.ne] + by_cases hx_top : x = ∞ + · subst hx_top + rw [continuousAt_iff_continuous_left_right] + refine ⟨?_, ?_⟩ + swap + · rw [Ici_top] + exact continuousWithinAt_singleton + rw [← continuousWithinAt_Iio_iff_Iic] + have h_toReal : Tendsto ENNReal.toReal (𝓝[<] (∞ : ℝ≥0∞)) atTop := by + refine tendsto_atTop.mpr fun b ↦ ?_ + filter_upwards [self_mem_nhdsWithin, + mem_nhdsWithin_of_mem_nhds (Ioi_mem_nhds ENNReal.ofReal_lt_top)] with y hy hy_gt + exact (ENNReal.ofReal_le_iff_le_toReal hy.ne).mp hy_gt.le + rw [ContinuousWithinAt] + refine ((tendsto_ofReal_comp_atTop hf hf_one).comp h_toReal).congr' ?_ + filter_upwards [self_mem_nhdsWithin, + mem_nhdsWithin_of_mem_nhds (Ioi_mem_nhds ENNReal.zero_lt_top)] with y hy hy_pos + simp [ofRealFun_apply hy_pos.ne' hy.ne] + have h1 : ContinuousAt (fun y : ℝ≥0∞ ↦ ENNReal.ofReal (f y.toReal)) x := + ENNReal.continuous_ofReal.continuousAt.comp + ((h_cont.continuousAt (Ioi_mem_nhds (ENNReal.toReal_pos hx0 hx_top))).comp + (ENNReal.continuousAt_toReal hx_top)) + refine h1.congr ?_ + filter_upwards [Ioo_mem_nhds (pos_iff_ne_zero.mpr hx0) (lt_top_iff_ne_top.mpr hx_top)] with y hy + exact (ofRealFun_apply hy.1.ne' hy.2.ne).symm + +lemma convexOn_ofRealFun (hf : ConvexOn ℝ (Ioi 0) f) (hf_one : f 1 = 0) : + ConvexOn ℝ≥0 univ (ofRealFun f) := by + have h_cont := continuous_ofRealFun hf hf_one + refine ⟨convex_univ, fun x _ y _ a b _ _ hab ↦ ?_⟩ + -- the convexity inequality on `(0, ∞) × (0, ∞)` follows from the convexity of `f` + have h_Ioo : ∀ x ∈ Ioo (0 : ℝ≥0∞) ∞, ∀ y ∈ Ioo (0 : ℝ≥0∞) ∞, + ofRealFun f (a • x + b • y) ≤ a • ofRealFun f x + b • ofRealFun f y := by + intro x hx y hy + have hxy_top : a • x + b • y ≠ ∞ := by + simp only [ENNReal.smul_def, smul_eq_mul] + exact ENNReal.add_ne_top.mpr ⟨ENNReal.mul_ne_top ENNReal.coe_ne_top hx.2.ne, + ENNReal.mul_ne_top ENNReal.coe_ne_top hy.2.ne⟩ + have hxy_zero : a • x + b • y ≠ 0 := by + intro h + rw [add_eq_zero, ENNReal.smul_def, ENNReal.smul_def, smul_eq_mul, smul_eq_mul, mul_eq_zero, + mul_eq_zero] at h + simp only [ENNReal.coe_eq_zero, hx.1.ne', hy.1.ne', or_false] at h + simp [h.1, h.2] at hab + have h_toReal : (a • x + b • y).toReal = a * x.toReal + b * y.toReal := by + simp only [ENNReal.smul_def, smul_eq_mul] + rw [ENNReal.toReal_add (ENNReal.mul_ne_top ENNReal.coe_ne_top hx.2.ne) + (ENNReal.mul_ne_top ENNReal.coe_ne_top hy.2.ne), ENNReal.toReal_mul, ENNReal.toReal_mul, + ENNReal.coe_toReal, ENNReal.coe_toReal] + rw [ofRealFun_apply hxy_zero hxy_top, ofRealFun_apply hx.1.ne' hx.2.ne, + ofRealFun_apply hy.1.ne' hy.2.ne, h_toReal] + have h_cvx := hf.2 (mem_Ioi.mpr (ENNReal.toReal_pos hx.1.ne' hx.2.ne)) + (mem_Ioi.mpr (ENNReal.toReal_pos hy.1.ne' hy.2.ne)) a.coe_nonneg b.coe_nonneg + (by rw [← NNReal.coe_add, hab, NNReal.coe_one]) + simp only [smul_eq_mul] at h_cvx + calc ENNReal.ofReal (f (a * x.toReal + b * y.toReal)) + _ ≤ ENNReal.ofReal (a * f x.toReal + b * f y.toReal) := ENNReal.ofReal_le_ofReal h_cvx + _ ≤ ENNReal.ofReal (a * f x.toReal) + ENNReal.ofReal (b * f y.toReal) := + ENNReal.ofReal_add_le + _ = a • ENNReal.ofReal (f x.toReal) + b • ENNReal.ofReal (f y.toReal) := by + rw [ENNReal.ofReal_mul a.coe_nonneg, ENNReal.ofReal_mul b.coe_nonneg, + ENNReal.ofReal_coe_nnreal, ENNReal.ofReal_coe_nnreal, ENNReal.smul_def, + ENNReal.smul_def, smul_eq_mul, smul_eq_mul] + -- the inequality is a closed condition and `(0, ∞) × (0, ∞)` is dense + have h_closed : IsClosed {p : ℝ≥0∞ × ℝ≥0∞ | + ofRealFun f (a • p.1 + b • p.2) ≤ a • ofRealFun f p.1 + b • ofRealFun f p.2} := by + simp only [ENNReal.smul_def, smul_eq_mul] + refine isClosed_le ?_ ?_ + · exact h_cont.comp (((ENNReal.continuous_const_mul ENNReal.coe_ne_top).comp continuous_fst).add + ((ENNReal.continuous_const_mul ENNReal.coe_ne_top).comp continuous_snd)) + · exact Continuous.add + ((ENNReal.continuous_const_mul ENNReal.coe_ne_top).comp (h_cont.comp continuous_fst)) + ((ENNReal.continuous_const_mul ENNReal.coe_ne_top).comp (h_cont.comp continuous_snd)) + have h_subset : Ioo (0 : ℝ≥0∞) ∞ ×ˢ Ioo (0 : ℝ≥0∞) ∞ ⊆ {p : ℝ≥0∞ × ℝ≥0∞ | + ofRealFun f (a • p.1 + b • p.2) ≤ a • ofRealFun f p.1 + b • ofRealFun f p.2} := + fun p hp ↦ h_Ioo p.1 hp.1 p.2 hp.2 + have h_closure : closure (Ioo (0 : ℝ≥0∞) ∞ ×ˢ Ioo (0 : ℝ≥0∞) ∞) = univ := by + rw [closure_prod_eq, closure_Ioo ENNReal.zero_ne_top, ← ENNReal.bot_eq_zero, Icc_bot_top, + univ_prod_univ] + have h := h_closed.closure_subset_iff.mpr h_subset + rw [h_closure] at h + exact h (mem_univ (x, y)) + +end OfRealFun + +/-- Build a `DivFunction` from a function `f : ℝ → ℝ` which is convex on `Ioi 0` and satisfies +`f 1 = 0`. On `(0, ∞)` it is `ENNReal.ofReal ∘ f`, extended by its limits at `0` and `∞`. -/ +noncomputable +def ofReal (f : ℝ → ℝ) (hf : ConvexOn ℝ (Ioi 0) f) (hf_one : f 1 = 0) : DivFunction where + toFun := ofRealFun f + one := by simp [ofRealFun, hf_one] + convexOn' := convexOn_ofRealFun hf hf_one + continuous' := continuous_ofRealFun hf hf_one + +variable {hf : ConvexOn ℝ (Ioi 0) f} {hf_one : f 1 = 0} + +section OfRealApply + +@[simp] +lemma ofReal_apply_zero : + ofReal f hf hf_one 0 = Function.rightLim (fun x ↦ ENNReal.ofReal (f x)) 0 := by + simp [ofReal] + +lemma ofReal_apply_zero_of_continuousWithinAt (hf_cont : ContinuousWithinAt f (Ioi 0) 0) : + ofReal f hf hf_one 0 = ENNReal.ofReal (f 0) := by + rw [ofReal_apply_zero] + exact rightLim_eq_of_tendsto ((ENNReal.continuous_ofReal.tendsto _).comp hf_cont) + +@[simp] +lemma ofReal_apply_top : + ofReal f hf hf_one ∞ = limsup (fun x ↦ ENNReal.ofReal (f x)) atTop := by + simp [ofReal] + +lemma ofReal_apply_top_of_tendsto_atTop (h : Tendsto f atTop atTop) : + ofReal f hf hf_one ∞ = ∞ := by + rw [ofReal_apply_top] + refine Tendsto.limsup_eq ?_ + rwa [ENNReal.tendsto_ofReal_nhds_top] + +lemma ofReal_apply {x : ℝ≥0∞} (hx_zero : x ≠ 0) (hx_top : x ≠ ∞) : + ofReal f hf hf_one x = ENNReal.ofReal (f x.toReal) := by + simp [ofReal, ofRealFun_apply hx_zero hx_top] + +lemma ofReal_apply_of_continuousWithinAt (hf_cont : ContinuousWithinAt f (Ioi 0) 0) + {x : ℝ≥0∞} (hx : x ≠ ∞) : + ofReal f hf hf_one x = ENNReal.ofReal (f x.toReal) := by + by_cases hx0 : x = 0 + · simp [hx0, ofReal_apply_zero_of_continuousWithinAt hf_cont] + · exact ofReal_apply hx0 hx + +lemma realFun_ofReal_apply (hf_nonneg : ∀ x, 0 < x → 0 ≤ f x) {x : ℝ} (hx : 0 < x) : + (ofReal f hf hf_one).realFun x = f x := by + rw [realFun, ofReal_apply (by simp [hx]) (by simp), ENNReal.toReal_ofReal hx.le, + ENNReal.toReal_ofReal (hf_nonneg x hx)] + +end OfRealApply + +section DerivAtTop + +/-- The `derivAtTop` of `ofReal f hf hf_one` is the slope at infinity `derivAtTop f` of `f`, +truncated at `0`. -/ +lemma derivAtTop_ofReal : (ofReal f hf hf_one).derivAtTop = (_root_.derivAtTop f).toENNReal := by + refine tendsto_nhds_unique (ofReal f hf hf_one).tendsto_div_nhdsLT_top ?_ + have h_lim : Tendsto (fun y : ℝ≥0∞ ↦ (((f y.toReal / y.toReal : ℝ) : EReal)).toENNReal) + (𝓝[<] ∞) (𝓝 (_root_.derivAtTop f).toENNReal) := + (EReal.continuous_toENNReal.tendsto _).comp (hf.tendsto_derivAtTop.comp + ENNReal.tendsto_toReal_atTop) + refine h_lim.congr' ?_ + filter_upwards [Ioo_mem_nhdsLT ENNReal.zero_lt_top] with y hy + have hy_pos : 0 < y.toReal := ENNReal.toReal_pos hy.1.ne' hy.2.ne + rw [EReal.real_coe_toENNReal, ofReal_apply hy.1.ne' hy.2.ne, ENNReal.ofReal_div_of_pos hy_pos, + ENNReal.ofReal_toReal hy.2.ne] + +lemma derivAtTop_ofReal_of_tendsto_nhds {y : ℝ} + (h : Tendsto (fun x ↦ derivWithin f (Ioi x) x) atTop (𝓝 y)) : + (ofReal f hf hf_one).derivAtTop = ENNReal.ofReal y := by + rw [derivAtTop_ofReal, hf.derivAtTop_eq_of_tendsto_rightDeriv h, EReal.real_coe_toENNReal] + +lemma derivAtTop_ofReal_of_tendsto_atTop + (h : Tendsto (fun x ↦ derivWithin f (Ioi x) x) atTop atTop) : + (ofReal f hf hf_one).derivAtTop = ∞ := by + rw [derivAtTop_ofReal, hf.derivAtTop_eq_top_of_tendsto_rightDeriv h, EReal.toENNReal_top] + +end DerivAtTop + +section Integral + +lemma lintegral_ofReal_eq_top_of_not_integrable [SigmaFinite μ] [IsFiniteMeasure ν] + (hf_nonneg : ∀ x, 0 ≤ x → 0 ≤ f x) + (h_int : ¬ Integrable (fun x ↦ f (μ.rnDeriv ν x).toReal) ν) : + ∫⁻ x, ofReal f hf hf_one (μ.rnDeriv ν x) ∂ν = ∞ := by + refine lintegral_eq_top_of_not_integrable_realFun ?_ + suffices ¬ IntegrableOn + (fun x ↦ (ofReal f hf hf_one).realFun (μ.rnDeriv ν x).toReal) + {x | μ.rnDeriv ν x ≠ 0} ν from + fun h ↦ this h.integrableOn + rw [← integrableOn_univ] at h_int + have : (univ : Set α) = {x | μ.rnDeriv ν x ≠ 0} ∪ {x | μ.rnDeriv ν x = 0} := by + ext x + by_cases h : μ.rnDeriv ν x = 0 <;> simp [h] + rw [this, integrableOn_union] at h_int + have h_int_zero : IntegrableOn (fun x ↦ f (μ.rnDeriv ν x).toReal) {x | μ.rnDeriv ν x = 0} ν := by + refine (integrableOn_congr_fun ?_ ?_).mpr + (integrableOn_const (C := f 0) (measure_ne_top _ _)) + · intro x hx + simp only [mem_ofPred_eq] at hx + simp [hx] + · exact μ.measurable_rnDeriv ν (measurableSet_singleton 0) + simp only [ne_eq, h_int_zero, and_true] at h_int + convert h_int using 1 + refine integrableOn_congr_fun_ae ((ae_restrict_iff' ?_).mpr ?_) + · exact (μ.measurable_rnDeriv ν (measurableSet_singleton 0)).compl + filter_upwards [μ.rnDeriv_ne_top ν] with x hx_top hx_zero + rw [DivFunction.realFun_ofReal_apply fun x hx ↦ hf_nonneg x hx.le] + exact ENNReal.toReal_pos hx_zero hx_top + +lemma lintegral_ofReal_of_continuous [SigmaFinite μ] + (hf_cont : ContinuousWithinAt f (Ioi 0) 0) : + ∫⁻ x, DivFunction.ofReal f hf hf_one (μ.rnDeriv ν x) ∂ν + = ∫⁻ x, ENNReal.ofReal (f (μ.rnDeriv ν x).toReal) ∂ν := by + refine lintegral_congr_ae ?_ + filter_upwards [μ.rnDeriv_ne_top ν] with x hx + exact ofReal_apply_of_continuousWithinAt hf_cont hx + +lemma lintegral_ofReal_eq_integral_of_continuous [SigmaFinite μ] + (hf_nonneg : ∀ x, 0 ≤ x → 0 ≤ f x) + (hf_cont : ContinuousWithinAt f (Ioi 0) 0) + (h_int : Integrable (fun x ↦ f (μ.rnDeriv ν x).toReal) ν) : + ∫⁻ x, DivFunction.ofReal f hf hf_one (μ.rnDeriv ν x) ∂ν + = ENNReal.ofReal (∫ x, f (μ.rnDeriv ν x).toReal ∂ν) := by + rw [DivFunction.lintegral_ofReal_of_continuous hf_cont, + ofReal_integral_eq_lintegral_ofReal h_int] + refine ae_of_all _ fun x ↦ hf_nonneg _ ENNReal.toReal_nonneg + +lemma lintegral_ofReal_ne_top_iff_integrable_of_continuous [SigmaFinite μ] + (hf_nonneg : ∀ x, 0 ≤ x → 0 ≤ f x) + (h_cont : ContinuousWithinAt f (Ioi 0) 0) : + ∫⁻ x, ofReal f hf hf_one (μ.rnDeriv ν x) ∂ν ≠ ∞ + ↔ Integrable (fun x ↦ f (μ.rnDeriv ν x).toReal) ν := by + rw [lintegral_ofReal_of_continuous h_cont, lintegral_ofReal_ne_top_iff_integrable] + · exact (hf.measurable_comp_of_nonneg (μ.measurable_rnDeriv ν).ennreal_toReal + fun _ ↦ ENNReal.toReal_nonneg).aestronglyMeasurable + · exact ae_of_all _ fun x ↦ hf_nonneg _ ENNReal.toReal_nonneg + +lemma lintegral_ofReal_eq_top_iff_not_integrable_of_continuous [SigmaFinite μ] + (hf_nonneg : ∀ x, 0 ≤ x → 0 ≤ f x) + (h_cont : ContinuousWithinAt f (Ioi 0) 0) : + ∫⁻ x, ofReal f hf hf_one (μ.rnDeriv ν x) ∂ν = ∞ + ↔ ¬ Integrable (fun x ↦ f (μ.rnDeriv ν x).toReal) ν := by + rw [← lintegral_ofReal_ne_top_iff_integrable_of_continuous hf_nonneg h_cont, not_not] + +end Integral + +end OfReal + +end DivFunction + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/DivFunction/RightDerivStieltjes.lean b/Statlib/Divergence/FDiv/DivFunction/RightDerivStieltjes.lean new file mode 100644 index 0000000..fd7157b --- /dev/null +++ b/Statlib/Divergence/FDiv/DivFunction/RightDerivStieltjes.lean @@ -0,0 +1,356 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Statlib.Divergence.FDiv.DivFunction.DerivAtTop +public import Statlib.ForMathlib.Analysis.Convex.DerivAtTop +public import Statlib.ForMathlib.MeasureTheory.Measure.ERealStieltjes + +/-! +# The right derivative of a divergence function as a Stieltjes function + +For a divergence function `f`, we define `f.rightDerivStieltjes`, the right derivative of `f` as a +monotone right-continuous function `ℝ → EReal` (an `ERealStieltjes` function). It is `⊥` below +`f.xmin`, `⊤` from `f.xmax` on, and it agrees with the right derivative of `f.realFun` in the +interior of the effective domain of `f`. + +## Main definitions + +* `DivFunction.rightDerivStieltjes f`: the right derivative of `f`, as an `ERealStieltjes` + function. + +## Main statements + +* `rightDerivStieltjes_of_mem_interior`: in the interior of the effective domain, + `f.rightDerivStieltjes x = derivWithin f.realFun (Ioi x) x`. +* `rightDerivStieltjes_eq_top_iff`: `f.rightDerivStieltjes x = ⊤ ↔ f.xmax ≤ ENNReal.ofReal x`. +* `rightDerivStieltjes_xmin_eq_bot_iff`: `f.rightDerivStieltjes` is `⊥` at `f.xmin` iff the right + derivative of `f.realFun` tends to `-∞` there. +* `rightDerivStieltjes_add`, `rightDerivStieltjes_smul`: compatibility with the module structure. +* `tendsto_rightDerivStieltjes_atTop`: `f.rightDerivStieltjes` tends to `f.derivAtTop` at `+∞`. + Since `f.derivAtTop` is defined as the limit of `f x / x`, this rests on the corresponding result + for convex real functions, `ConvexOn.tendsto_rightDeriv_derivAtTop`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Real MeasureTheory Filter Set MeasurableSpace + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +namespace DivFunction + +variable {f g : DivFunction} + +section RightDeriv + +lemma continuousWithinAt_derivWithin_realFun (f : DivFunction) {x : ℝ} + (hx : f.xmin < ENNReal.ofReal x) (hx' : ENNReal.ofReal x < f.xmax) : + ContinuousWithinAt (fun y ↦ derivWithin f.realFun (Ioi y) y) (Ici x) x := by + refine f.convexOn_Ioo_realFun.continuousWithinAt_rightDeriv_of_mem_interior ?_ + rw [f.isOpen_toReal_Ioo.interior_eq] + exact mem_toReal_Ioo_iff.mpr ⟨hx, hx'⟩ + +/-- Auxiliary monotone function: `⊥` up to `f.xmin`, `⊤` from `f.xmax` on, and the right +derivative of `f.realFun` in between. `f.rightDerivStieltjes` is its right-continuous +regularization. -/ +noncomputable def rightDerivAux (f : DivFunction) : ℝ → EReal := fun x ↦ + if x ≤ f.xmin.toReal then ⊥ + else if f.xmax ≤ ENNReal.ofReal x then ⊤ + else ((derivWithin f.realFun (Ioi x) x : ℝ) : EReal) + +lemma monotone_rightDerivAux (f : DivFunction) : Monotone f.rightDerivAux := by + intro x y hxy + by_cases hx1 : x ≤ f.xmin.toReal + · simp [rightDerivAux, hx1] + have hy1 : ¬ y ≤ f.xmin.toReal := fun h ↦ hx1 (hxy.trans h) + by_cases hy2 : f.xmax ≤ ENNReal.ofReal y + · simp [rightDerivAux, hy1, hy2] + have hx2 : ¬ f.xmax ≤ ENNReal.ofReal x := fun h ↦ hy2 (h.trans (ENNReal.ofReal_le_ofReal hxy)) + simp only [rightDerivAux, hx1, hy1, hx2, hy2, ↓reduceIte, EReal.coe_le_coe_iff] + exact f.derivWithin_realFun_mono hxy + ((ENNReal.lt_ofReal_iff_toReal_lt xmin_ne_top).mpr (not_le.mp hx1)) (not_le.mp hy2) + +/-- The right derivative of `f`, as a monotone right-continuous function `ℝ → EReal`: it is `⊥` +below `f.xmin`, `⊤` from `f.xmax` on, and in between it is the right limit of the right derivative +of `f.realFun` (which is that right derivative itself, except possibly at `f.xmin` where the +right derivative of `f.realFun` can be `-∞`). -/ +protected noncomputable def rightDerivStieltjes (f : DivFunction) : ERealStieltjes := + f.monotone_rightDerivAux.erealStieltjes + +lemma rightDerivStieltjes_apply (f : DivFunction) (x : ℝ) : + f.rightDerivStieltjes x = Function.rightLim f.rightDerivAux x := rfl + +lemma rightDerivStieltjes_of_lt_xmin {x : ℝ} (hx : x < f.xmin.toReal) : + f.rightDerivStieltjes x = ⊥ := by + rw [rightDerivStieltjes_apply] + refine rightLim_eq_of_tendsto ((tendsto_congr' ?_).mpr tendsto_const_nhds) + filter_upwards [Ioo_mem_nhdsGT hx] with y hy + simp [rightDerivAux, hy.2.le] + +lemma rightDerivStieltjes_of_ge_xmax {x : ℝ} (hx : f.xmax ≤ ENNReal.ofReal x) : + f.rightDerivStieltjes x = ⊤ := by + have hx1 : f.xmin.toReal < x := by + rw [← ENNReal.lt_ofReal_iff_toReal_lt xmin_ne_top] + exact xmin_lt_xmax.trans_le hx + rw [rightDerivStieltjes_apply] + refine rightLim_eq_of_tendsto ((tendsto_congr' ?_).mpr tendsto_const_nhds) + filter_upwards [self_mem_nhdsWithin] with y (hy : x < y) + simp [rightDerivAux, not_le.mpr (hx1.trans hy), hx.trans (ENNReal.ofReal_le_ofReal hy.le)] + +lemma rightDerivStieltjes_of_neg {x : ℝ} (hx : x < 0) : + f.rightDerivStieltjes x = ⊥ := + rightDerivStieltjes_of_lt_xmin (hx.trans_le ENNReal.toReal_nonneg) + +lemma eventually_mem_toReal_Ioo {x : ℝ} (hx1 : f.xmin.toReal ≤ x) + (hx2 : ENNReal.ofReal x < f.xmax) : + ∀ᶠ y in 𝓝[>] x, y ∈ ENNReal.toReal '' Ioo f.xmin f.xmax := by + filter_upwards [self_mem_nhdsWithin, nhdsWithin_le_nhds + ((ENNReal.continuous_ofReal.tendsto x).eventually (gt_mem_nhds hx2))] with y (hy : x < y) hy2 + exact mem_toReal_Ioo_iff.mpr + ⟨(ENNReal.lt_ofReal_iff_toReal_lt xmin_ne_top).mpr (hx1.trans_lt hy), hy2⟩ + +lemma rightDerivAux_eventuallyEq {x : ℝ} (hx1 : f.xmin.toReal ≤ x) + (hx2 : ENNReal.ofReal x < f.xmax) : + f.rightDerivAux =ᶠ[𝓝[>] x] fun y ↦ ((derivWithin f.realFun (Ioi y) y : ℝ) : EReal) := by + filter_upwards [f.eventually_mem_toReal_Ioo hx1 hx2] with y hy + obtain ⟨hy1, hy2⟩ := mem_toReal_Ioo_iff.mp hy + simp [rightDerivAux, not_le.mpr ((ENNReal.lt_ofReal_iff_toReal_lt xmin_ne_top).mp hy1), + not_le.mpr hy2] + +lemma tendsto_derivWithin_realFun_nhdsGT {x : ℝ} (hx1 : f.xmin.toReal ≤ x) + (hx2 : ENNReal.ofReal x < f.xmax) : + Tendsto (fun y ↦ ((derivWithin f.realFun (Ioi y) y : ℝ) : EReal)) (𝓝[>] x) + (𝓝 (f.rightDerivStieltjes x)) := by + rw [rightDerivStieltjes_apply] + exact (tendsto_congr' (rightDerivAux_eventuallyEq hx1 hx2)).mp + (f.monotone_rightDerivAux.tendsto_rightLim x) + +lemma rightDerivStieltjes_eq_rightLim {x : ℝ} (hx1 : f.xmin.toReal ≤ x) + (hx2 : ENNReal.ofReal x < f.xmax) : + f.rightDerivStieltjes x + = Function.rightLim (fun y ↦ ((derivWithin f.realFun (Ioi y) y : ℝ) : EReal)) x := + (rightLim_eq_of_tendsto (f.tendsto_derivWithin_realFun_nhdsGT hx1 hx2)).symm + +lemma rightDerivStieltjes_of_mem_interior {x : ℝ} (hx : f.xmin < ENNReal.ofReal x) + (hx' : ENNReal.ofReal x < f.xmax) : + f.rightDerivStieltjes x = derivWithin f.realFun (Ioi x) x := by + rw [rightDerivStieltjes_eq_rightLim ((ENNReal.lt_ofReal_iff_toReal_lt xmin_ne_top).mp hx).le hx'] + exact (continuous_coe_real_ereal.continuousAt.comp_continuousWithinAt + (f.continuousWithinAt_derivWithin_realFun hx hx')).rightLim_eq + +lemma rightDerivStieltjes_ne_top_of_lt_xmax {x : ℝ} (hx : ENNReal.ofReal x < f.xmax) : + f.rightDerivStieltjes x ≠ ⊤ := by + by_cases hx1 : x < f.xmin.toReal + · simp [rightDerivStieltjes_of_lt_xmin hx1] + push Not at hx1 + obtain ⟨y, hy, hxy⟩ := ((f.eventually_mem_toReal_Ioo hx1 hx).and self_mem_nhdsWithin).exists + obtain ⟨hy1, hy2⟩ := mem_toReal_Ioo_iff.mp hy + rw [rightDerivStieltjes_apply] + refine ne_top_of_le_ne_top ?_ (f.monotone_rightDerivAux.rightLim_le hxy) + simp [rightDerivAux, not_le.mpr ((ENNReal.lt_ofReal_iff_toReal_lt xmin_ne_top).mp hy1), + not_le.mpr hy2] + +lemma rightDerivStieltjes_eq_top_iff {x : ℝ} : + f.rightDerivStieltjes x = ⊤ ↔ f.xmax ≤ ENNReal.ofReal x := + ⟨fun h ↦ not_lt.mp fun hx ↦ rightDerivStieltjes_ne_top_of_lt_xmax hx h, + rightDerivStieltjes_of_ge_xmax⟩ + +lemma rightDerivStieltjes_ne_bot_of_xmin_lt {x : ℝ} (hx : f.xmin.toReal < x) : + f.rightDerivStieltjes x ≠ ⊥ := by + refine ne_bot_of_le_ne_bot ?_ (f.monotone_rightDerivAux.le_rightLim le_rfl) + simp only [rightDerivAux, not_le.mpr hx, ↓reduceIte] + split_ifs <;> simp + +/-- `f.rightDerivStieltjes` is `⊥` at `f.xmin` iff the right derivative of `f` tends to `-∞` at +`f.xmin`. -/ +lemma rightDerivStieltjes_xmin_eq_bot_iff : + f.rightDerivStieltjes f.xmin.toReal = ⊥ + ↔ Tendsto (fun y ↦ derivWithin f.realFun (Ioi y) y) (𝓝[>] f.xmin.toReal) atBot := by + have h := f.tendsto_derivWithin_realFun_nhdsGT le_rfl + (by rw [ENNReal.ofReal_toReal xmin_ne_top]; exact xmin_lt_xmax) + rw [← EReal.tendsto_coe_nhds_bot_iff] + exact ⟨fun h_eq ↦ h_eq ▸ h, fun h_bot ↦ tendsto_nhds_unique h h_bot⟩ + +@[simp] +lemma rightDerivStieltjes_one : f.rightDerivStieltjes 1 = f.rightDeriv 1 := by + rw [rightDerivStieltjes_of_mem_interior (by simpa using xmin_lt_one) (by simpa using one_lt_xmax), + rightDeriv_def, ENNReal.toReal_one] + +lemma rightDerivStieltjes_one_nonneg : 0 ≤ f.rightDerivStieltjes 1 := by + rw [rightDerivStieltjes_one] + exact EReal.coe_nonneg.mpr f.rightDeriv_one_nonneg + +@[simp] +lemma toReal_max_xmin : (max f.xmin g.xmin).toReal = max f.xmin.toReal g.xmin.toReal := + ENNReal.toReal_max xmin_ne_top xmin_ne_top + +lemma realFun_add_eventuallyEq {x : ℝ} (hxf : x ∈ ENNReal.toReal '' Ioo f.xmin f.xmax) + (hxg : x ∈ ENNReal.toReal '' Ioo g.xmin g.xmax) : + (f + g).realFun =ᶠ[𝓝 x] fun y ↦ f.realFun y + g.realFun y := by + filter_upwards [(f.isOpen_toReal_Ioo.inter g.isOpen_toReal_Ioo).mem_nhds ⟨hxf, hxg⟩] + with y ⟨hyf, hyg⟩ + simp only [realFun, add_apply] + rw [ENNReal.toReal_add (lt_top_of_mem_Ioo (mem_toReal_Ioo_iff.mp hyf)).ne + (lt_top_of_mem_Ioo (mem_toReal_Ioo_iff.mp hyg)).ne] + +lemma derivWithin_realFun_add {x : ℝ} (hxf : x ∈ ENNReal.toReal '' Ioo f.xmin f.xmax) + (hxg : x ∈ ENNReal.toReal '' Ioo g.xmin g.xmax) : + derivWithin (f + g).realFun (Ioi x) x + = derivWithin f.realFun (Ioi x) x + derivWithin g.realFun (Ioi x) x := by + rw [(realFun_add_eventuallyEq hxf hxg).derivWithin_eq_of_nhds] + exact derivWithin_fun_add (f.differentiableWithinAt_realFun (mem_toReal_Ioo_iff.mp hxf)) + (g.differentiableWithinAt_realFun (mem_toReal_Ioo_iff.mp hxg)) + +lemma rightDerivStieltjes_add : + (f + g).rightDerivStieltjes = f.rightDerivStieltjes + g.rightDerivStieltjes := by + ext x + by_cases hf_top : f.rightDerivStieltjes x = ⊤ + · rw [ERealStieltjes.add_apply_of_eq_top_left hf_top, rightDerivStieltjes_eq_top_iff, xmax_add] + exact min_le_of_left_le (rightDerivStieltjes_eq_top_iff.mp hf_top) + by_cases hg_top : g.rightDerivStieltjes x = ⊤ + · rw [ERealStieltjes.add_apply_of_eq_top_right hg_top, rightDerivStieltjes_eq_top_iff, xmax_add] + exact min_le_of_right_le (rightDerivStieltjes_eq_top_iff.mp hg_top) + rw [ERealStieltjes.add_apply_of_ne_top hf_top hg_top] + have hxf_lt : ENNReal.ofReal x < f.xmax := + not_le.mp fun h ↦ hf_top (rightDerivStieltjes_of_ge_xmax h) + have hxg_lt : ENNReal.ofReal x < g.xmax := + not_le.mp fun h ↦ hg_top (rightDerivStieltjes_of_ge_xmax h) + have hx_lt : ENNReal.ofReal x < (f + g).xmax := by + rw [xmax_add] + exact lt_min hxf_lt hxg_lt + by_cases hxf : x < f.xmin.toReal + · rw [rightDerivStieltjes_of_lt_xmin hxf, EReal.bot_add, rightDerivStieltjes_of_lt_xmin] + rw [xmin_add, toReal_max_xmin] + exact hxf.trans_le (le_max_left _ _) + by_cases hxg : x < g.xmin.toReal + · rw [rightDerivStieltjes_of_lt_xmin hxg, EReal.add_bot, rightDerivStieltjes_of_lt_xmin] + rw [xmin_add, toReal_max_xmin] + exact hxg.trans_le (le_max_right _ _) + push Not at hxf hxg + have hxfg : (f + g).xmin.toReal ≤ x := by + rw [xmin_add, toReal_max_xmin] + exact max_le hxf hxg + have h_add : Tendsto + (fun y ↦ ((derivWithin f.realFun (Ioi y) y : ℝ) : EReal) + + ((derivWithin g.realFun (Ioi y) y : ℝ) : EReal)) + (𝓝[>] x) (𝓝 (f.rightDerivStieltjes x + g.rightDerivStieltjes x)) := + (EReal.continuousAt_add (Or.inl hf_top) (Or.inr hg_top)).tendsto.comp + ((f.tendsto_derivWithin_realFun_nhdsGT hxf hxf_lt).prodMk_nhds + (g.tendsto_derivWithin_realFun_nhdsGT hxg hxg_lt)) + rw [rightDerivStieltjes_apply] + refine rightLim_eq_of_tendsto ((tendsto_congr' ?_).mpr h_add) + filter_upwards [rightDerivAux_eventuallyEq hxfg hx_lt, f.eventually_mem_toReal_Ioo hxf hxf_lt, + g.eventually_mem_toReal_Ioo hxg hxg_lt] with y hy hyf hyg + simp only [hy, derivWithin_realFun_add hyf hyg, EReal.coe_add] + +lemma rightDerivStieltjes_eq_bot_iff_of_xmin_eq (hxmin : f.xmin = g.xmin) + (h : Tendsto (fun y ↦ derivWithin f.realFun (Ioi y) y) (𝓝[>] f.xmin.toReal) atBot + ↔ Tendsto (fun y ↦ derivWithin g.realFun (Ioi y) y) (𝓝[>] g.xmin.toReal) atBot) (x : ℝ) : + f.rightDerivStieltjes x = ⊥ ↔ g.rightDerivStieltjes x = ⊥ := by + rcases lt_trichotomy x f.xmin.toReal with hx | rfl | hx + · simp [rightDerivStieltjes_of_lt_xmin hx, rightDerivStieltjes_of_lt_xmin (hxmin ▸ hx)] + · rw [rightDerivStieltjes_xmin_eq_bot_iff, h, ← rightDerivStieltjes_xmin_eq_bot_iff, hxmin] + · simp [rightDerivStieltjes_ne_bot_of_xmin_lt hx, + rightDerivStieltjes_ne_bot_of_xmin_lt (hxmin ▸ hx : g.xmin.toReal < x)] + +lemma rightDerivAux_smul {c : ℝ≥0} (hc : c ≠ 0) : + (c • f).rightDerivAux = fun x ↦ ((c : ℝ) : EReal) * f.rightDerivAux x := by + ext x + have hc' : (0 : ℝ) < c := NNReal.coe_pos.mpr (pos_iff_ne_zero.mpr hc) + simp only [rightDerivAux, xmin_smul hc, xmax_smul hc, realFun_smul, derivWithin_const_mul_field] + split_ifs + · rw [EReal.coe_mul_bot_of_pos hc'] + · rw [EReal.coe_mul_top_of_pos hc'] + · rw [EReal.coe_mul] + +lemma rightDerivStieltjes_smul {c : ℝ≥0} (hc : c ≠ 0) : + (c • f).rightDerivStieltjes = c • f.rightDerivStieltjes := by + ext x + rw [ERealStieltjes.smul_apply, rightDerivStieltjes_apply, rightDerivStieltjes_apply, + rightDerivAux_smul hc, EReal.coe_nnreal_eq_coe_real] + exact rightLim_eq_of_tendsto + (((EReal.continuous_coe_mul _).tendsto _).comp (f.monotone_rightDerivAux.tendsto_rightLim x)) + +end RightDeriv + +section DerivAtTop + +/-! ### Limit of `f.rightDerivStieltjes` at `+∞` -/ + +/-- If the effective domain of `f` is bounded, then `f.derivAtTop = ∞`. -/ +lemma derivAtTop_eq_top_of_xmax_ne_top (h : f.xmax ≠ ∞) : f.derivAtTop = ∞ := by + have : (𝓝[<] (∞ : ℝ≥0∞)).NeBot := nhdsLT_neBot_of_exists_lt ⟨0, ENNReal.zero_lt_top⟩ + refine tendsto_nhds_unique f.tendsto_div_nhdsLT_top (tendsto_const_nhds.congr' ?_) + filter_upwards [Ioo_mem_nhdsLT h.lt_top] with y hy + rw [eq_top_of_xmax_lt hy.1, ENNReal.top_div_of_ne_top hy.2.ne] + +lemma convexOn_Ioi_realFun_of_xmax_eq_top (h : f.xmax = ∞) : + ConvexOn ℝ (Ioi f.xmin.toReal) f.realFun := by + have h_cvx := f.convexOn_Ioo_realFun + rwa [h, ENNReal.toReal_image_Ioo_top xmin_ne_top] at h_cvx + +/-- If the effective domain of `f` is unbounded, then `f.derivAtTop` is the slope at infinity of +`f.realFun`. -/ +lemma derivAtTop_eq_toENNReal_derivAtTop_realFun (h : f.xmax = ∞) : + f.derivAtTop = (_root_.derivAtTop f.realFun).toENNReal := by + have : (𝓝[<] (∞ : ℝ≥0∞)).NeBot := nhdsLT_neBot_of_exists_lt ⟨0, ENNReal.zero_lt_top⟩ + refine tendsto_nhds_unique f.tendsto_div_nhdsLT_top ?_ + have h_lim : Tendsto (fun y : ℝ≥0∞ ↦ (((f.realFun y.toReal / y.toReal : ℝ) : EReal)).toENNReal) + (𝓝[<] ∞) (𝓝 (_root_.derivAtTop f.realFun).toENNReal) := + (EReal.continuous_toENNReal.tendsto _).comp + ((f.convexOn_Ioi_realFun_of_xmax_eq_top h).tendsto_derivAtTop.comp + ENNReal.tendsto_toReal_atTop) + refine h_lim.congr' ?_ + filter_upwards [Ioo_mem_nhdsLT (max_lt xmin_lt_top ENNReal.one_lt_top)] with y hy + have hy_top : y ≠ ∞ := hy.2.ne + have hy_pos : 0 < y.toReal := + ENNReal.toReal_pos ((zero_lt_one.trans_le (le_max_right _ _)).trans hy.1).ne' hy_top + have hfy : f y ≠ ∞ := (lt_top_of_mem_Ioo ⟨(le_max_left _ _).trans_lt hy.1, h ▸ hy.2⟩).ne + rw [EReal.real_coe_toENNReal, realFun_toReal f hy_top, ENNReal.ofReal_div_of_pos hy_pos, + ENNReal.ofReal_toReal hfy, ENNReal.ofReal_toReal hy_top] + +lemma tendsto_rightDerivStieltjes_atTop : + Tendsto f.rightDerivStieltjes atTop (𝓝 f.derivAtTop) := by + rcases eq_or_ne f.xmax ∞ with h | h + · -- `f.realFun` is convex on `(f.xmin, ∞)`: its right derivative tends to `f.derivAtTop` + have h_cvx := f.convexOn_Ioi_realFun_of_xmax_eq_top h + have h_nonneg : 0 ≤ _root_.derivAtTop f.realFun := + ge_of_tendsto h_cvx.tendsto_derivAtTop ((eventually_gt_atTop 0).mono fun x hx ↦ + EReal.coe_nonneg.mpr (div_nonneg (f.realFun_nonneg x) hx.le)) + rw [derivAtTop_eq_toENNReal_derivAtTop_realFun h, EReal.coe_toENNReal h_nonneg] + refine h_cvx.tendsto_rightDeriv_derivAtTop.congr' ?_ + filter_upwards [eventually_gt_atTop f.xmin.toReal] with x hx + rw [rightDerivStieltjes_of_mem_interior ((ENNReal.lt_ofReal_iff_toReal_lt xmin_ne_top).mpr hx) + (h ▸ ENNReal.ofReal_lt_top)] + · -- `f.rightDerivStieltjes` is eventually `⊤`, and `f.derivAtTop = ∞` + rw [derivAtTop_eq_top_of_xmax_ne_top h, EReal.coe_ennreal_top] + refine tendsto_const_nhds.congr' ?_ + filter_upwards [eventually_ge_atTop f.xmax.toReal] with x hx + refine (rightDerivStieltjes_of_ge_xmax ?_).symm + rw [← ENNReal.ofReal_toReal h] + exact ENNReal.ofReal_le_ofReal hx + +lemma rightDerivStieltjes_le_derivAtTop (x : ℝ) : f.rightDerivStieltjes x ≤ f.derivAtTop := + f.rightDerivStieltjes.mono.ge_of_tendsto tendsto_rightDerivStieltjes_atTop x + +lemma derivWithin_realFun_le_toReal_derivAtTop (h : f.derivAtTop ≠ ∞) {x : ℝ} + (hx : f.xmin < ENNReal.ofReal x) (hx' : ENNReal.ofReal x < f.xmax) : + derivWithin f.realFun (Ioi x) x ≤ f.derivAtTop.toReal := by + have h1 := f.rightDerivStieltjes_le_derivAtTop x + rwa [rightDerivStieltjes_of_mem_interior hx hx', ← EReal.coe_ennreal_toReal h, + EReal.coe_le_coe_iff] at h1 + +end DerivAtTop + +end DivFunction + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/IntegralRepresentation.lean b/Statlib/Divergence/FDiv/IntegralRepresentation.lean new file mode 100644 index 0000000..1dc4063 --- /dev/null +++ b/Statlib/Divergence/FDiv/IntegralRepresentation.lean @@ -0,0 +1,224 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Statlib.Divergence.FDiv.DivFunction.CurvatureMeasure +public import Statlib.Divergence.StatInfo.FDiv + +/-! +# Integral representation of f-divergences + +Every f-divergence is an integral of the f-divergences of the functions `statInfoDivFun 1 x` +(which are statistical informations, see `Statlib.Divergence.StatInfo.FDiv`), against the +curvature measure of `f`. + +## Main statements + +* `fDiv_add_eq_lintegral_fDiv_statInfoDivFun_add`: + `fDiv f μ ν + f.rightDeriv 1 * ν univ + = ∫⁻ x, fDiv (statInfoDivFun 1 x) μ ν ∂f.curvatureMeasureReal + f.rightDeriv 1 * μ univ`. +* `fDiv_eq_lintegral_fDiv_statInfoDivFun`: the same, for `f` with `f.rightDeriv 1 = 0`: + `fDiv f μ ν = ∫⁻ x, fDiv (statInfoDivFun 1 x) μ ν ∂f.curvatureMeasureReal`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open MeasureTheory Set + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +variable {𝒳 : Type*} {m𝒳 : MeasurableSpace 𝒳} {μ ν : Measure 𝒳} {f : DivFunction} + +section StatInfoFun + +open Set Filter ConvexOn + +lemma measurable_fDiv_statInfoDivFun_right [SigmaFinite μ] [SFinite ν] : + Measurable fun y ↦ fDiv (statInfoDivFun 1 y) μ ν := + (measurable_fDiv_statInfoDivFun μ ν).comp (f := fun y ↦ ((1 : ℝ), y)) measurable_prodMk_left + +lemma measurable_derivAtTop_statInfoDivFun : + Measurable fun x : ℝ ↦ (statInfoDivFun 1 x).derivAtTop := by + simp_rw [derivAtTop_statInfoDivFun_eq] + simp only [zero_le_one, ↓reduceIte, ENNReal.ofReal_one] + exact Measurable.ite measurableSet_Iic measurable_const measurable_const + +lemma lintegral_derivAtTop_statInfoDivFun_eq_toENNReal : + ∫⁻ x, (statInfoDivFun 1 x).derivAtTop ∂f.curvatureMeasureReal + = ((f.derivAtTop : EReal) - f.rightDerivStieltjes 1).toENNReal := by + simp_rw [derivAtTop_statInfoDivFun_eq] + simp only [zero_le_one, ↓reduceIte, ENNReal.ofReal_one] + have : (fun x : ℝ ↦ if x ≤ 1 then (0 : ℝ≥0∞) else 1) = (Ioi 1).indicator 1 := by + ext x + split_ifs with h + · simp [h] + · simp [not_le.mp h] + simp_rw [this, lintegral_indicator_one measurableSet_Ioi] + rw [f.curvatureMeasureReal_apply measurableSet_Ioi] + have : ENNReal.toReal ⁻¹' Ioi 1 = Ioo 1 ∞ := by + ext x + simp only [mem_preimage, mem_Ioi, mem_Ioo] + constructor <;> intro h + · by_cases hx_top : x = ∞ + · simp only [hx_top, ENNReal.toReal_top] at h + exact absurd h (not_lt.mpr zero_le_one) + · rw [← ENNReal.toReal_one, ENNReal.toReal_lt_toReal ENNReal.one_ne_top hx_top] at h + exact ⟨h, Ne.lt_top hx_top⟩ + · rw [← ENNReal.toReal_one, ENNReal.toReal_lt_toReal ENNReal.one_ne_top h.2.ne] + exact h.1 + rw [this] + simp only [ne_eq, ENNReal.one_ne_top, not_false_eq_true, + DivFunction.curvatureMeasure_Ioo_top_eq_curvatureMeasure_Ioi, f.curvatureMeasure_Ioi, + ENNReal.toReal_one] + rw [ERealStieltjes.measure_Ioi f.rightDerivStieltjes f.tendsto_rightDerivStieltjes_atTop] + +/-- The integral of the `derivAtTop` of the `statInfoDivFun 1 x` against the curvature measure of +`f` is `f.derivAtTop`, up to the right derivative of `f` at `1`. -/ +lemma lintegral_derivAtTop_statInfoDivFun : + ∫⁻ x, (statInfoDivFun 1 x).derivAtTop ∂f.curvatureMeasureReal + + ENNReal.ofReal (f.rightDeriv 1) = f.derivAtTop := by + rw [lintegral_derivAtTop_statInfoDivFun_eq_toENNReal, DivFunction.rightDerivStieltjes_one] + by_cases h_top : f.derivAtTop = ∞ + · rw [h_top, EReal.coe_ennreal_top, EReal.top_sub_coe, EReal.toENNReal_top, top_add] + · have h_le : f.rightDeriv 1 ≤ f.derivAtTop.toReal := by + rw [DivFunction.rightDeriv_def, ENNReal.toReal_one] + exact f.derivWithin_realFun_le_toReal_derivAtTop h_top + (by simpa using DivFunction.xmin_lt_one) (by simpa using DivFunction.one_lt_xmax) + rw [← EReal.coe_ennreal_toReal h_top, ← EReal.coe_sub, + EReal.toENNReal_of_ne_top (EReal.coe_ne_top _), EReal.toReal_coe, + ← ENNReal.ofReal_add (sub_nonneg.mpr h_le) f.rightDeriv_one_nonneg, sub_add_cancel, + ENNReal.ofReal_toReal h_top] + +lemma lintegral_statInfoFun_curvatureMeasureReal_add {t : ℝ≥0∞} (ht_ne : t ≠ ∞) : + ∫⁻ y, ENNReal.ofReal (statInfoFun 1 y t.toReal) ∂f.curvatureMeasureReal + + ENNReal.ofReal (f.rightDeriv 1) * t + = f t + ENNReal.ofReal (f.rightDeriv 1) := by + rcases le_total 1 t with ht | ht + · have ht' : 1 ≤ t.toReal := by + rw [← ENNReal.toReal_one] + exact ENNReal.toReal_mono ht_ne ht + have h_int : ∫⁻ y, ENNReal.ofReal (statInfoFun 1 y t.toReal) ∂f.curvatureMeasureReal + = ∫⁻ x in Ioc 1 t, t - x ∂f.curvatureMeasure := by + simp_rw [statInfoFun_of_one_of_one_le_right ht'] + have : ∀ y, ENNReal.ofReal ((Ioc 1 t.toReal).indicator (fun y ↦ t.toReal - y) y) + = (Ioc 1 t.toReal).indicator (fun y ↦ ENNReal.ofReal (t.toReal - y)) y := fun y ↦ by + by_cases hy : y ∈ Ioc 1 t.toReal <;> simp [hy] + simp_rw [this] + rw [lintegral_indicator measurableSet_Ioc, + f.setLIntegral_Ioc_curvatureMeasureReal (by fun_prop) zero_le_one, ENNReal.ofReal_one, + ENNReal.ofReal_toReal ht_ne] + refine setLIntegral_congr_fun measurableSet_Ioc fun x hx ↦ ?_ + rw [ENNReal.ofReal_sub _ ENNReal.toReal_nonneg, ENNReal.ofReal_toReal ht_ne, + ENNReal.ofReal_toReal (ne_top_of_le_ne_top ht_ne hx.2)] + rw [h_int, f.taylor_one_right ht ht_ne] + have : ENNReal.ofReal (f.rightDeriv 1) * t + = ENNReal.ofReal (f.rightDeriv 1) * (t - 1) + + ENNReal.ofReal (f.rightDeriv 1) := by + conv_lhs => rw [← tsub_add_cancel_of_le ht, mul_add, mul_one] + rw [this] + ring + · have ht' : t.toReal ≤ 1 := by + rw [← ENNReal.toReal_one] + exact ENNReal.toReal_mono ENNReal.one_ne_top ht + have h_int : ∫⁻ y, ENNReal.ofReal (statInfoFun 1 y t.toReal) ∂f.curvatureMeasureReal + = ∫⁻ x in Ioc t 1, x - t ∂f.curvatureMeasure := by + simp_rw [statInfoFun_of_one_of_right_le_one ht'] + have : ∀ y, ENNReal.ofReal ((Ioc t.toReal 1).indicator (fun y ↦ y - t.toReal) y) + = (Ioc t.toReal 1).indicator (fun y ↦ ENNReal.ofReal (y - t.toReal)) y := fun y ↦ by + by_cases hy : y ∈ Ioc t.toReal 1 <;> simp [hy] + simp_rw [this] + rw [lintegral_indicator measurableSet_Ioc, + f.setLIntegral_Ioc_curvatureMeasureReal (by fun_prop) ENNReal.toReal_nonneg, + ENNReal.ofReal_one, ENNReal.ofReal_toReal ht_ne] + refine setLIntegral_congr_fun measurableSet_Ioc fun x hx ↦ ?_ + rw [ENNReal.ofReal_sub _ ENNReal.toReal_nonneg, ENNReal.ofReal_toReal ht_ne, + ENNReal.ofReal_toReal (ne_top_of_le_ne_top ENNReal.one_ne_top hx.2)] + rw [h_int, ← f.taylor_one_left ht, add_assoc, ← mul_add, tsub_add_cancel_of_le ht, + mul_one] + +lemma lintegral_f_rnDeriv_add_eq_lintegral_fDiv_statInfoDivFun_add_of_ac + [IsFiniteMeasure μ] [IsFiniteMeasure ν] (h_ac : μ ≪ ν) : + ∫⁻ x, f ((∂μ/∂ν) x) ∂ν + ENNReal.ofReal (f.rightDeriv 1) * ν univ + = ∫⁻ x, fDiv (statInfoDivFun 1 x.toReal) μ ν ∂f.curvatureMeasure + + ENNReal.ofReal (f.rightDeriv 1) * μ univ := by + have h_meas : Measurable (fun x γ ↦ statInfoFun 1 γ ((∂μ/∂ν) x).toReal).uncurry := + measurable_statInfoFun.comp <| + (measurable_const.prodMk measurable_snd).prodMk <| + ((μ.measurable_rnDeriv ν).comp measurable_fst).ennreal_toReal + simp_rw [fDiv_statInfoDivFun_eq_lintegral_of_ac h_ac] + have : ∫⁻ x, f ((∂μ/∂ν) x) ∂ν + ENNReal.ofReal (f.rightDeriv 1) * ν univ + = ∫⁻ x, ∫⁻ y, ENNReal.ofReal (statInfoFun 1 y ((∂μ/∂ν) x).toReal) + ∂f.curvatureMeasureReal ∂ν + ENNReal.ofReal (f.rightDeriv 1) * μ univ := by + rw [← lintegral_const, ← lintegral_add_right _ measurable_const] + have h_eq : ∀ᵐ x ∂ν, f ((∂μ/∂ν) x) + ENNReal.ofReal (f.rightDeriv 1) + = ∫⁻ y, ENNReal.ofReal (statInfoFun 1 y ((∂μ/∂ν) x).toReal) ∂f.curvatureMeasureReal + + ENNReal.ofReal (f.rightDeriv 1) * (∂μ/∂ν) x := by + filter_upwards [μ.rnDeriv_ne_top ν] with x hx + rw [lintegral_statInfoFun_curvatureMeasureReal_add hx] + rw [lintegral_congr_ae h_eq, + lintegral_add_left (Measurable.lintegral_prod_right h_meas.ennreal_ofReal), + lintegral_const_mul _ (μ.measurable_rnDeriv ν), Measure.lintegral_rnDeriv h_ac] + rw [this, lintegral_lintegral_swap h_meas.ennreal_ofReal.aemeasurable, + DivFunction.lintegral_curvatureMeasureReal] + exact Measurable.lintegral_prod_left h_meas.ennreal_ofReal + +/-- Integral representation of `fDiv f μ ν` in terms of the f-divergences of the +`statInfoDivFun 1 x` and the curvature measure of `f`. The Taylor formula at `1` carries a linear +term, hence the correction term `f.rightDeriv 1 * (μ univ - ν univ)`, split here on both +sides of the equality to stay in `ℝ≥0∞`. See `fDiv_eq_lintegral_fDiv_statInfoDivFun` for the case +`f.rightDeriv 1 = 0`. -/ +theorem fDiv_add_eq_lintegral_fDiv_statInfoDivFun_add [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + fDiv f μ ν + ENNReal.ofReal (f.rightDeriv 1) * ν univ + = ∫⁻ x, fDiv (statInfoDivFun 1 x) μ ν ∂f.curvatureMeasureReal + + ENNReal.ofReal (f.rightDeriv 1) * μ univ := by + have h_ac : ν.withDensity (∂μ/∂ν) ≪ ν := withDensity_absolutelyContinuous _ _ + have hμ : μ univ = ν.withDensity (∂μ/∂ν) univ + μ.singularPart ν univ := by + conv_lhs => rw [μ.haveLebesgueDecomposition_add ν] + rw [Measure.add_apply, add_comm] + have h_in : ∀ x, fDiv (statInfoDivFun 1 x) μ ν + = fDiv (statInfoDivFun 1 x) (ν.withDensity (∂μ/∂ν)) ν + + (statInfoDivFun 1 x).derivAtTop * μ.singularPart ν univ := + fun x ↦ fDiv_eq_add_withDensity_derivAtTop μ ν + simp_rw [h_in] + rw [fDiv_eq_add_withDensity_derivAtTop, + lintegral_add_right _ (measurable_derivAtTop_statInfoDivFun.mul_const _), + lintegral_mul_const _ measurable_derivAtTop_statInfoDivFun, + fDiv_of_absolutelyContinuous h_ac, + f.lintegral_curvatureMeasureReal measurable_fDiv_statInfoDivFun_right, + ← lintegral_derivAtTop_statInfoDivFun, hμ] + have h2 := lintegral_f_rnDeriv_add_eq_lintegral_fDiv_statInfoDivFun_add_of_ac + (f := f) h_ac + calc ∫⁻ x, f ((∂ν.withDensity (∂μ/∂ν)/∂ν) x) ∂ν + + (∫⁻ x, (statInfoDivFun 1 x).derivAtTop ∂f.curvatureMeasureReal + + ENNReal.ofReal (f.rightDeriv 1)) * μ.singularPart ν univ + + ENNReal.ofReal (f.rightDeriv 1) * ν univ + = (∫⁻ x, f ((∂ν.withDensity (∂μ/∂ν)/∂ν) x) ∂ν + + ENNReal.ofReal (f.rightDeriv 1) * ν univ) + + ((∫⁻ x, (statInfoDivFun 1 x).derivAtTop ∂f.curvatureMeasureReal) + * μ.singularPart ν univ + + ENNReal.ofReal (f.rightDeriv 1) * μ.singularPart ν univ) := by ring + _ = (∫⁻ x, fDiv (statInfoDivFun 1 x.toReal) (ν.withDensity (∂μ/∂ν)) ν ∂f.curvatureMeasure + + ENNReal.ofReal (f.rightDeriv 1) * ν.withDensity (∂μ/∂ν) univ) + + ((∫⁻ x, (statInfoDivFun 1 x).derivAtTop ∂f.curvatureMeasureReal) + * μ.singularPart ν univ + + ENNReal.ofReal (f.rightDeriv 1) * μ.singularPart ν univ) := by rw [h2] + _ = _ := by ring + +/-- Integral representation of `fDiv f μ ν` in terms of the f-divergences of the +`statInfoDivFun 1 x` and the curvature measure of `f`, for `f` with `f.rightDeriv 1 = 0`. -/ +lemma fDiv_eq_lintegral_fDiv_statInfoDivFun [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (hfderiv_one : f.rightDeriv 1 = 0) : + fDiv f μ ν = ∫⁻ x, fDiv (statInfoDivFun 1 x) μ ν ∂f.curvatureMeasureReal := by + simpa [hfderiv_one] using fDiv_add_eq_lintegral_fDiv_statInfoDivFun_add (f := f) (μ := μ) (ν := ν) + +end StatInfoFun + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/Measurable.lean b/Statlib/Divergence/FDiv/Measurable.lean new file mode 100644 index 0000000..8a87ffc --- /dev/null +++ b/Statlib/Divergence/FDiv/Measurable.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.Probability.Kernel.RadonNikodym +public import Statlib.Divergence.FDiv.Basic + +/-! +# Measurability of f-divergences between kernels + +* `measurable_fDiv`: for finite kernels `κ η` (with `CountableOrCountablyGenerated α β`), the + function `a ↦ fDiv f (κ a) (η a)` is measurable. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open MeasureTheory MeasurableSpace Set + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} + [CountableOrCountablyGenerated α β] + {f : DivFunction} + +lemma measurable_lintegral_f_kernel_rnDeriv (κ η ξ : Kernel α β) [IsSFiniteKernel ξ] : + Measurable fun a ↦ ∫⁻ x, f (κ.rnDeriv η a x) ∂(ξ a) := by + refine Measurable.lintegral_kernel_prod_right ?_ + exact f.measurable.comp (κ.measurable_rnDeriv η) + +lemma measurable_lintegral_f_rnDeriv (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + Measurable fun a ↦ ∫⁻ x, f ((∂κ a/∂η a) x) ∂(η a) := by + convert measurable_lintegral_f_kernel_rnDeriv κ η η using 2 with a + · rw [lintegral_congr_ae ?_] + filter_upwards [κ.rnDeriv_eq_rnDeriv_measure] with b hb + rw [hb] + +lemma measurable_fDiv (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + Measurable (fun a ↦ fDiv f (κ a) (η a)) := + (measurable_lintegral_f_rnDeriv κ η).add + (((Measure.measurable_coe .univ).comp (κ.measurable_singularPart η)).const_mul _) + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/Trim.lean b/Statlib/Divergence/FDiv/Trim.lean new file mode 100644 index 0000000..b2756ec --- /dev/null +++ b/Statlib/Divergence/FDiv/Trim.lean @@ -0,0 +1,178 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne +-/ +module + +public import Statlib.Divergence.FDiv.Basic +public import Statlib.ForMathlib.MeasureTheory.Measure.Bool +public import Mathlib.InformationTheory.KullbackLeibler.DataProcessing +public import Mathlib.MeasureTheory.Function.ConditionalLExpectation +public import Mathlib.MeasureTheory.Function.ConditionalExpectation.RadonNikodym + +/-! + +# f-Divergences on sub-sigma-algebras + +## Main statements + +* `DivFunction.map_condLExp_le`: Jensen's inequality for the conditional Lebesgue expectation + `ν⁻[X|m]` and a `DivFunction`. It holds for every `DivFunction`, including those taking the + value `∞` at finite points. +* `fDiv_map_le`: data processing inequality for f-divergences and measurable functions +* `fDiv_boolMeasure_le`: data processing inequality for the indicator of an event +* `fDiv_trim_le`: data processing inequality for f-divergences and sub-sigma-algebras + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Real MeasureTheory Filter Set + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {α β : Type*} {m mα : MeasurableSpace α} {mβ : MeasurableSpace β} + {μ ν : Measure α} {f g : DivFunction} + +/-- To prove the DPI for an f-divergence, for the map by a function, it suffices to prove it under +an absolute continuity hypothesis. -/ +lemma fDiv_map_le_of_map_le_of_ac [IsFiniteMeasure ν] {g : α → β} (hg : Measurable g) + (h : ∀ μ : Measure α, IsFiniteMeasure μ → μ ≪ ν → fDiv f (μ.map g) (ν.map g) ≤ fDiv f μ ν) + (μ : Measure α) [IsFiniteMeasure μ] : + fDiv f (μ.map g) (ν.map g) ≤ fDiv f μ ν := by + conv_lhs => rw [← Measure.rnDeriv_add_singularPart μ ν, Measure.map_add _ _ hg] + refine (fDiv_add_measure_le _ _ _).trans ?_ + rw [fDiv_eq_add_withDensity_derivAtTop μ ν, Measure.map_apply hg MeasurableSet.univ] + exact add_le_add (h _ inferInstance (withDensity_absolutelyContinuous _ _)) le_rfl + +/-- **Jensen's inequality** for the conditional Lebesgue expectation and a `DivFunction`. -/ +theorem DivFunction.map_condLExp_le [IsFiniteMeasure ν] (hm : m ≤ mα) {X : α → ℝ≥0∞} + (hX : Measurable X) (hX_int : ∫⁻ x, X x ∂ν ≠ ∞) : + (fun x ↦ f (ν⁻[X|m] x)) ≤ᵐ[ν] ν⁻[fun x ↦ f (X x)|m] := by + -- the supporting lines of `f` at rational interior points pass to the conditional expectation + have h_all : ∀ᵐ x ∂ν, ∀ q : ℚ, ENNReal.ofReal q ∈ Ioo f.xmin f.xmax → + f (ENNReal.ofReal q) + + ENNReal.ofReal (max (f.rightDeriv (ENNReal.ofReal q)) 0) * ν⁻[X|m] x + + ENNReal.ofReal (max (-f.rightDeriv (ENNReal.ofReal q)) 0) + * ENNReal.ofReal q + ≤ ν⁻[fun x ↦ f (X x)|m] x + + ENNReal.ofReal (max (f.rightDeriv (ENNReal.ofReal q)) 0) + * ENNReal.ofReal q + + ENNReal.ofReal (max (-f.rightDeriv (ENNReal.ofReal q)) 0) + * ν⁻[X|m] x := by + refine ae_all_iff.2 fun q ↦ ?_ + by_cases hq : ENNReal.ofReal q ∈ Ioo f.xmin f.xmax + swap; · exact ae_of_all _ fun x h ↦ absurd h hq + set A := ENNReal.ofReal (max (f.rightDeriv (ENNReal.ofReal q)) 0) + set B := ENNReal.ofReal (max (-f.rightDeriv (ENNReal.ofReal q)) 0) + have h_pt : ((fun _ ↦ f (ENNReal.ofReal q)) + A • X + fun _ ↦ B * ENNReal.ofReal q) + ≤ᵐ[ν] ((fun x ↦ f (X x)) + (fun _ ↦ A * ENNReal.ofReal q) + B • X) := by + filter_upwards [ae_lt_top hX hX_int] with x hx + simp only [Pi.add_apply, Pi.smul_apply, smul_eq_mul] + exact f.apply_add_le_apply_add hq hx.ne + have hL : ν⁻[(fun _ ↦ f (ENNReal.ofReal q)) + A • X + fun _ ↦ B * ENNReal.ofReal q | m] + =ᵐ[ν] (fun _ ↦ f (ENNReal.ofReal q)) + A • ν⁻[X|m] + fun _ ↦ B * ENNReal.ofReal q := by + refine (condLExp_add_right _ aemeasurable_const).trans + (((condLExp_add_left _ aemeasurable_const).add EventuallyEq.rfl).trans ?_) + rw [condLExp_const hm, condLExp_const hm] + exact (EventuallyEq.rfl.add (condLExp_smul X hX.aemeasurable A)).add EventuallyEq.rfl + have hR : ν⁻[(fun x ↦ f (X x)) + (fun _ ↦ A * ENNReal.ofReal q) + B • X | m] + =ᵐ[ν] ν⁻[fun x ↦ f (X x)|m] + (fun _ ↦ A * ENNReal.ofReal q) + B • ν⁻[X|m] := by + refine (condLExp_add_right _ (hX.const_smul B).aemeasurable).trans + (((condLExp_add_right _ aemeasurable_const).add EventuallyEq.rfl).trans ?_) + rw [condLExp_const hm] + exact EventuallyEq.rfl.add (condLExp_smul X hX.aemeasurable B) + filter_upwards [condLExp_mono (mΩ := m) h_pt, hL, hR] with x hx hLx hRx _ + rw [hLx, hRx] at hx + simpa only [Pi.add_apply, Pi.smul_apply, smul_eq_mul] using hx + filter_upwards [h_all, condLExp_ne_top (mΩ := m) hX_int] with x hx hx_top + exact f.le_of_forall_rat_tangent_le hx_top hx + +section Map + +variable {g : α → β} + +lemma f_rnDeriv_map_le [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hμν : μ ≪ ν) + {g : α → β} (hg : Measurable g) : + (fun x ↦ f ((∂μ.map g/∂ν.map g) (g x))) + ≤ᵐ[ν] ν⁻[fun x ↦ f ((∂μ/∂ν) x) | mβ.comap g] := by + filter_upwards [rnDeriv_map hμν hg, f.map_condLExp_le hg.comap_le (μ.measurable_rnDeriv ν) + (Measure.lintegral_rnDeriv_lt_top μ ν).ne] with x hx1 hx2 + rw [hx1] + exact hx2 + +lemma lintegral_f_rnDeriv_map_le [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hμν : μ ≪ ν) + {g : α → β} (hg : Measurable g) : + ∫⁻ x, f ((∂μ.map g/∂ν.map g) x) ∂(ν.map g) ≤ ∫⁻ x, f ((∂μ/∂ν) x) ∂ν := by + rw [lintegral_map DivFunction.measurable_comp_rnDeriv hg] + calc ∫⁻ x, f ((∂μ.map g/∂ν.map g) (g x)) ∂ν + ≤ ∫⁻ x, ν⁻[fun x ↦ f ((∂μ/∂ν) x) | mβ.comap g] x ∂ν := + lintegral_mono_ae (f_rnDeriv_map_le hμν hg) + _ = ∫⁻ x, f ((∂μ/∂ν) x) ∂ν := lintegral_condLExp hg.comap_le ν _ + +lemma fDiv_map_of_ac [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hμν : μ ≪ ν) (hg : Measurable g) : + fDiv f (μ.map g) (ν.map g) = ∫⁻ x, f (ν⁻[∂μ/∂ν | mβ.comap g] x) ∂ν := by + rw [fDiv_of_absolutelyContinuous (hμν.map hg), + lintegral_map DivFunction.measurable_comp_rnDeriv hg] + refine lintegral_congr_ae ?_ + filter_upwards [rnDeriv_map hμν hg] with a ha + rw [ha] + +/-- **Data processing inequality** for f-divergences and measurable functions. -/ +theorem fDiv_map_le [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hg : Measurable g) : + fDiv f (μ.map g) (ν.map g) ≤ fDiv f μ ν := by + refine fDiv_map_le_of_map_le_of_ac hg (fun μ _ hμν ↦ ?_) _ + rw [fDiv_of_absolutelyContinuous (hμν.map hg), fDiv_of_absolutelyContinuous hμν] + exact lintegral_f_rnDeriv_map_le hμν hg + +/-- **Data processing inequality** for the indicator of an event: the f-divergence between the +laws of `x ↦ decide (x ∈ s)` under `μ` and `ν` is at most `fDiv f μ ν`. -/ +lemma fDiv_boolMeasure_le (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + {s : Set α} (hs : MeasurableSet s) : + fDiv f (Measure.boolMeasure (μ sᶜ) (μ s)) (Measure.boolMeasure (ν sᶜ) (ν s)) ≤ fDiv f μ ν := by + classical + rw [← Measure.map_decide_mem_eq_boolMeasure μ hs, ← Measure.map_decide_mem_eq_boolMeasure ν hs] + exact fDiv_map_le (measurable_decide_mem hs) + +end Map + +section Trim + +lemma fDiv_trim_of_ac [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hm : m ≤ mα) (hμν : μ ≪ ν) : + fDiv f (μ.trim hm) (ν.trim hm) = ∫⁻ x, f (ν⁻[∂μ/∂ν | m] x) ∂ν := by + simp_rw [trim_eq_map] + rw [fDiv_map_of_ac hμν (measurable_id'' hm), MeasurableSpace.comap_id] + +/-- **Data processing inequality** for f-divergences and sub-sigma-algebras. -/ +theorem fDiv_trim_le [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hm : m ≤ mα) : + fDiv f (μ.trim hm) (ν.trim hm) ≤ fDiv f μ ν := by + simp_rw [trim_eq_map] + exact fDiv_map_le (measurable_id'' hm) + +/-- The f-divergence between the images of two measures by a measurable function `g` is equal to +the f-divergence between the two measures restricted to the sigma-algebra `mβ.comap g`. -/ +lemma fDiv_map_eq_fDiv_trim_of_ac [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hμν : μ ≪ ν) + {g : α → β} (hg : Measurable g) : + fDiv f (μ.map g) (ν.map g) = fDiv f (μ.trim hg.comap_le) (ν.trim hg.comap_le) := by + rw [fDiv_map_of_ac hμν hg, fDiv_trim_of_ac hg.comap_le hμν] + +/-- The f-divergence of two measures restricted to the sigma-algebra generated by their +Radon-Nikodym derivative is the f-divergence of the unrestricted measures. That sigma-algebra is +countably generated. +The absolute continuity hypothesis is needed: since the values of `∂μ/∂ν` on `ν`-null sets are +arbitrary, the sigma-algebra it generates may not separate the singular part of `μ` from `ν`. -/ +lemma fDiv_trim_comap_rnDeriv_of_ac [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hμν : μ ≪ ν) : + fDiv f (μ.trim (μ.measurable_rnDeriv ν).comap_le) (ν.trim (μ.measurable_rnDeriv ν).comap_le) + = fDiv f μ ν := by + rw [fDiv_trim_of_ac _ hμν, + condLExp_eq_self (μ.measurable_rnDeriv ν).comap_le _ (comap_measurable _), + fDiv_of_absolutelyContinuous hμν] + +end Trim + +end ProbabilityTheory diff --git a/Statlib/Divergence/Hellinger/Basic.lean b/Statlib/Divergence/Hellinger/Basic.lean new file mode 100644 index 0000000..1bd657b --- /dev/null +++ b/Statlib/Divergence/Hellinger/Basic.lean @@ -0,0 +1,584 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Statlib.Divergence.Hellinger.HellingerDivFun +public import Statlib.Divergence.KullbackLeibler.Basic +public import Statlib.Divergence.FDiv.Basic +public import Mathlib.Analysis.Convex.SpecificFunctions.Pow +public import Mathlib.Analysis.SpecialFunctions.Pow.Deriv +public import Statlib.Divergence.FDiv.CompProd + +/-! +# Hellinger divergence + +## Main definitions + +* `hellingerDiv a μ ν`: the Hellinger divergence of order `a`, the f-divergence for the divergence + function `hellingerDivFun a`. + +## Main statements + +* `hellingerDiv_one`: the Hellinger divergence of order `1` is the Kullback-Leibler divergence. +* `hellingerDiv_of_nonpos`: `hellingerDiv a μ ν = 0` for `a ≤ 0`. +* `hellingerDiv_ne_top_of_lt_one`, `hellingerDiv_eq_top_iff`: finiteness of the divergence. +* `hellingerDiv_comp_le_compProd`, `hellingerDiv_comp_right_le`: data-processing inequalities. +* `toReal_hellingerDiv_smul_left`, `toReal_hellingerDiv_smul_right`: behaviour under scaling of + the measures. +* `sqHellinger`: the squared Hellinger distance, half of the Hellinger divergence of order `2⁻¹`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Real MeasureTheory Filter MeasurableSpace InformationTheory + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {a : ℝ} + +/-- Hellinger divergence of order `a`, the f-divergence for the function `hellingerDivFun a`. +For `a = 1` the Hellinger divergence coincides with the Kullback-Leibler divergence. +For `a ≤ 0` the divergence function is `0`, hence `hellingerDiv a μ ν = 0`. +In particular `hellingerDiv 0 μ ν = 0`: the value `ν {x | (∂μ/∂ν) x = 0}` that is sometimes used as +Hellinger divergence of order `0` in the literature is not the f-divergence of a `DivFunction`, +since such a function has to be continuous at `0`. The Rényi divergence of order `0` is defined +separately (see `renyiDiv`). -/ +noncomputable def hellingerDiv (a : ℝ) (μ ν : Measure α) : ℝ≥0∞ := fDiv (hellingerDivFun a) μ ν + +@[simp] lemma hellingerDiv_of_nonpos (ha : a ≤ 0) : + hellingerDiv a μ ν = 0 := by + rw [hellingerDiv, hellingerDivFun_of_nonpos ha, fDiv_zero] + +lemma hellingerDiv_zero : hellingerDiv 0 μ ν = 0 := by simp + +@[simp] lemma hellingerDiv_one (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + hellingerDiv 1 μ ν = klDiv μ ν := by + rw [hellingerDiv, hellingerDivFun_one, klDiv_eq_fDiv] + +@[simp] +lemma hellingerDiv_zero_measure_left (ha_pos : 0 < a) (ν : Measure α) : + hellingerDiv a 0 ν = ν .univ := by + rw [hellingerDiv, fDiv_zero_measure_left, hellingerDivFun_apply_zero_of_pos ha_pos, one_mul] + +@[simp] +lemma hellingerDiv_zero_measure_right_of_lt_one (ha_pos : 0 < a) (ha : a < 1) (μ : Measure α) : + hellingerDiv a μ 0 = ENNReal.ofReal (a * (1 - a)⁻¹) * μ Set.univ := by + rw [hellingerDiv, fDiv_zero_measure_right, derivAtTop_hellingerDivFun_of_lt_one ha_pos ha] + +@[simp] +lemma hellingerDiv_zero_measure_right_of_one_le (ha : 1 ≤ a) (μ : Measure α) [hμ : NeZero μ] : + hellingerDiv a μ 0 = ∞ := by + rw [hellingerDiv, fDiv_zero_measure_right, derivAtTop_hellingerDivFun_of_one_le ha] + simp [hμ.out] + +section HellingerEq + +lemma hellingerDiv_eq_integral_of_integrable [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_ne : a ≠ 1) (h_int : Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ a) ν) : + hellingerDiv a μ ν + = ENNReal.ofReal ((a - 1)⁻¹ * ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν + + (ν .univ).toReal + (1 - a)⁻¹ * a * (ν.withDensity (μ.rnDeriv ν) .univ).toReal) + + (hellingerDivFun a).derivAtTop * μ.singularPart ν .univ := by + have h := ν.rnDeriv_withDensity (μ.measurable_rnDeriv ν) + rw [hellingerDiv, fDiv_eq_add_withDensity_derivAtTop, fDiv_of_absolutelyContinuous, + lintegral_hellingerDivFun_of_pos_of_ne_one_of_integrable_of_ac ha_pos ha_ne] + · congr 5 + refine integral_congr_ae ?_ + filter_upwards [h] with x hx + rw [hx] + · refine (integrable_congr ?_).mp h_int + filter_upwards [h] with x hx + rw [hx] + · exact withDensity_absolutelyContinuous _ _ + · exact withDensity_absolutelyContinuous _ _ + +lemma toReal_hellingerDiv_eq_integral_of_integrable_of_ac [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_ne : a ≠ 1) + (h_int : Integrable (fun x ↦ ((∂μ/∂ν) x).toReal ^ a) ν) (hμν : μ ≪ ν) : + (hellingerDiv a μ ν).toReal + = (a - 1)⁻¹ * ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν + + (ν .univ).toReal + (1 - a)⁻¹ * a * (μ .univ).toReal := by + simp only [hellingerDiv, hellingerDivFun_of_pos ha_pos] + rw [toReal_fDiv_ofReal_eq_integral_add_of_ac (fun x hx ↦ hellingerFun_nonneg ha_pos.le hx) + (continuous_hellingerFun ha_pos).continuousWithinAt _ hμν] + swap; · rwa [integrable_hellingerFun_iff_integrable_rpow ha_ne] + rw [integral_hellingerFun_of_pos_of_ne_one_of_integrable_of_ac ha_pos ha_ne h_int hμν] + +lemma toReal_hellingerDiv_eq_integral_of_lt_one [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_lt : a < 1) : + (hellingerDiv a μ ν).toReal + = (a - 1)⁻¹ * ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν + + (ν .univ).toReal + (1 - a)⁻¹ * a * (μ .univ).toReal := by + simp only [hellingerDiv, hellingerDivFun_of_pos ha_pos] + rw [toReal_fDiv_ofReal_eq_integral_add, integral_hellingerFun_of_pos_of_lt_one ha_pos ha_lt, + ← hellingerDivFun_of_pos ha_pos, + derivAtTop_hellingerDivFun_of_lt_one ha_pos ha_lt, ENNReal.toReal_ofReal] + rotate_left + · refine mul_nonneg ha_pos.le ?_ + simp [ha_lt.le] + · exact fun x hx ↦ hellingerFun_nonneg ha_pos.le hx + · exact (continuous_hellingerFun ha_pos).continuousWithinAt + · exact integrable_hellingerFun_rnDeriv_of_lt_one ha_pos.le ha_lt + · rw [← hellingerDivFun_of_pos ha_pos, + derivAtTop_hellingerDivFun_of_lt_one ha_pos ha_lt] + simp + rw [add_assoc, add_assoc, add_assoc] + congr 2 + rw [mul_comm a, ← mul_add] + congr 1 + conv_rhs => rw [μ.haveLebesgueDecomposition_add ν, add_comm, Measure.coe_add, Pi.add_apply, + ENNReal.toReal_add (measure_ne_top _ _) (measure_ne_top _ _)] + simp only [MeasurableSet.univ, withDensity_apply, Measure.restrict_univ, add_left_inj] + rw [integral_toReal] + · exact (μ.measurable_rnDeriv ν).aemeasurable + · exact μ.rnDeriv_lt_top ν + +lemma hellingerDiv_ne_top_of_lt_one (ha : a < 1) (μ ν : Measure α) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + hellingerDiv a μ ν ≠ ∞ := by + rcases le_or_gt a 0 with ha0 | ha0 + · simp [ha0] + exact fDiv_ne_top_of_derivAtTop_ne_top (by simp [ha0.not_ge]) + (by simp [derivAtTop_hellingerDivFun_of_lt_one ha0 ha]) + +lemma hellingerDiv_eq_integral_of_lt_one [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_lt : a < 1) : + hellingerDiv a μ ν + = ENNReal.ofReal ((a - 1)⁻¹ * ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν + + (ν .univ).toReal + (1 - a)⁻¹ * a * (μ .univ).toReal) := by + rw [← toReal_hellingerDiv_eq_integral_of_lt_one ha_pos ha_lt, + ENNReal.ofReal_toReal (hellingerDiv_ne_top_of_lt_one ha_lt μ ν)] + +lemma hellingerDiv_of_not_ac (ha : 1 ≤ a) (h_ac : ¬ μ ≪ ν) + [SigmaFinite μ] [SigmaFinite ν] : + hellingerDiv a μ ν = ∞ := + fDiv_of_not_ac (derivAtTop_hellingerDivFun_of_one_le ha) h_ac + +lemma hellingerDiv_eq_top_iff (μ ν : Measure α) [IsFiniteMeasure μ] [SigmaFinite ν] : + hellingerDiv a μ ν = ∞ + ↔ ∫⁻ x, hellingerDivFun a ((∂μ/∂ν) x) ∂ν = ∞ ∨ (1 ≤ a ∧ ¬ μ ≪ ν) := by + rw [hellingerDiv, fDiv_eq_top_iff, derivAtTop_hellingerDivFun_eq_top_iff] + +lemma hellingerDiv_ne_top_iff (μ ν : Measure α) [IsFiniteMeasure μ] [SigmaFinite ν] : + hellingerDiv a μ ν ≠ ∞ + ↔ ∫⁻ x, hellingerDivFun a ((∂μ/∂ν) x) ∂ν ≠ ∞ ∧ (1 ≤ a → μ ≪ ν) := by + rw [ne_eq, hellingerDiv_eq_top_iff] + push Not + rfl + +lemma hellingerDiv_eq_top_iff_of_one_le (ha : 1 ≤ a) (μ ν : Measure α) + [IsFiniteMeasure μ] [SigmaFinite ν] : + hellingerDiv a μ ν = ∞ + ↔ ∫⁻ x, hellingerDivFun a ((∂μ/∂ν) x) ∂ν = ∞ ∨ ¬ μ ≪ ν := by + rw [hellingerDiv_eq_top_iff, and_iff_right ha] + +lemma hellingerDiv_ne_top_iff_of_one_le (ha : 1 ≤ a) (μ ν : Measure α) + [IsFiniteMeasure μ] [SigmaFinite ν] : + hellingerDiv a μ ν ≠ ∞ + ↔ ∫⁻ x, hellingerDivFun a ((∂μ/∂ν) x) ∂ν ≠ ∞ ∧ μ ≪ ν := by + rw [ne_eq, hellingerDiv_eq_top_iff_of_one_le ha] + push Not + rfl + +lemma hellingerDiv_eq_top_iff_of_one_lt (ha : 1 < a) (μ ν : Measure α) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + hellingerDiv a μ ν = ∞ + ↔ ¬ Integrable (fun x ↦ ((∂μ/∂ν) x).toReal ^ a) ν ∨ ¬ μ ≪ ν := by + rw [hellingerDiv_eq_top_iff_of_one_le ha.le, ← integrable_hellingerFun_iff_integrable_rpow ha.ne'] + rw [hellingerDivFun_of_pos (zero_lt_one.trans ha), + DivFunction.lintegral_ofReal_eq_top_iff_not_integrable_of_continuous + (fun _ hx ↦ hellingerFun_nonneg (zero_lt_one.trans ha).le hx)] + exact (continuous_hellingerFun (zero_lt_one.trans ha)).continuousWithinAt + +lemma hellingerDiv_ne_top_iff_of_one_lt (ha : 1 < a) (μ ν : Measure α) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + hellingerDiv a μ ν ≠ ∞ + ↔ Integrable (fun x ↦ ((∂μ/∂ν) x).toReal ^ a) ν ∧ μ ≪ ν := by + rw [ne_eq, hellingerDiv_eq_top_iff_of_one_lt ha] + tauto + +lemma hellingerDiv_eq_ofReal_integral_of_integrable_of_ac [IsFiniteMeasure μ] + (ha_pos : 0 < a) (h_int : Integrable (fun x ↦ hellingerFun a ((∂μ/∂ν) x).toReal) ν) + (hμν : μ ≪ ν) : + hellingerDiv a μ ν = ENNReal.ofReal (∫ x, hellingerFun a ((∂μ/∂ν) x).toReal ∂ν) := by + rw [hellingerDiv, hellingerDivFun_of_pos ha_pos] + exact fDiv_ofReal_eq_integral_of_ac (fun _ hx ↦ hellingerFun_nonneg ha_pos.le hx) + (continuous_hellingerFun ha_pos).continuousWithinAt h_int hμν + +lemma lintegral_hellingerDivFun_ne_top_iff [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_ne : a ≠ 1) : + ∫⁻ x, hellingerDivFun a ((∂μ/∂ν) x) ∂ν ≠ ∞ + ↔ Integrable (fun x ↦ ((∂μ/∂ν) x).toReal ^ a) ν := by + rw [← integrable_hellingerFun_iff_integrable_rpow ha_ne, + hellingerDivFun_of_pos ha_pos, + DivFunction.lintegral_ofReal_ne_top_iff_integrable_of_continuous + (fun _ hx ↦ hellingerFun_nonneg ha_pos.le hx) + (continuous_hellingerFun ha_pos).continuousWithinAt] + +lemma toReal_hellingerDiv_eq_integral_of_one_lt_of_ne_top [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha : 1 < a) (h : hellingerDiv a μ ν ≠ ∞) : + (hellingerDiv a μ ν).toReal + = (a - 1)⁻¹ * ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν + + (ν .univ).toReal + (1 - a)⁻¹ * a * (μ .univ).toReal := by + rw [hellingerDiv_ne_top_iff_of_one_lt ha] at h + exact toReal_hellingerDiv_eq_integral_of_integrable_of_ac (zero_lt_one.trans ha) ha.ne' h.1 h.2 + +/-- Integral form of the Hellinger divergence, for `a ∈ (0, 1) ∪ (1, ∞)` and a finite divergence. -/ +lemma toReal_hellingerDiv_eq_integral_of_ne_top [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_ne : a ≠ 1) (h : hellingerDiv a μ ν ≠ ∞) : + (hellingerDiv a μ ν).toReal + = (a - 1)⁻¹ * ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν + + (ν .univ).toReal + (1 - a)⁻¹ * a * (μ .univ).toReal := by + rcases lt_or_gt_of_ne ha_ne with ha_lt | ha_lt + · exact toReal_hellingerDiv_eq_integral_of_lt_one ha_pos ha_lt + · exact toReal_hellingerDiv_eq_integral_of_one_lt_of_ne_top ha_lt h + +lemma hellingerDiv_of_mutuallySingular_of_one_le (ha : 1 ≤ a) [hμ : NeZero μ] + [SigmaFinite μ] [IsFiniteMeasure ν] (hμν : μ ⟂ₘ ν) : + hellingerDiv a μ ν = ∞ := by + have ha_pos : 0 < a := by positivity + simp [not_le.mpr ha_pos, hellingerDiv, fDiv_of_mutuallySingular hμν, not_lt.mpr ha, + hμ.out] + +lemma hellingerDiv_of_mutuallySingular_of_lt_one (ha_pos : 0 < a) (ha : a < 1) + [SigmaFinite μ] [IsFiniteMeasure ν] (hμν : μ ⟂ₘ ν) : + hellingerDiv a μ ν = ν Set.univ + ENNReal.ofReal (a * (1 - a)⁻¹) * μ Set.univ := by + rw [hellingerDiv, fDiv_of_mutuallySingular hμν, derivAtTop_hellingerDivFun_of_lt_one ha_pos ha, + hellingerDivFun_apply_zero, ite_eq_right (not_le.mpr ha_pos), one_mul] + +lemma toReal_hellingerDiv_of_mutuallySingular_of_lt_one (ha_pos : 0 < a) (ha : a < 1) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hμν : μ ⟂ₘ ν) : + (hellingerDiv a μ ν).toReal = (ν .univ).toReal + (a * (1 - a)⁻¹) * (μ .univ).toReal := by + rw [hellingerDiv_of_mutuallySingular_of_lt_one ha_pos ha hμν] + rw [ENNReal.toReal_add (measure_ne_top _ _), ENNReal.toReal_mul, ENNReal.toReal_ofReal] + · exact mul_nonneg ha_pos.le (inv_nonneg.mpr (sub_nonneg_of_le ha.le)) + · exact ENNReal.mul_ne_top ENNReal.ofReal_ne_top (measure_ne_top _ _) + +end HellingerEq + +lemma toReal_hellingerDiv_symm (ha_pos : 0 < a) (ha : a < 1) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + (1 - a) * (hellingerDiv a μ ν).toReal = a * (hellingerDiv (1 - a) ν μ).toReal := by + rw [toReal_hellingerDiv_eq_integral_of_lt_one ha_pos ha, + toReal_hellingerDiv_eq_integral_of_lt_one] + rotate_left + · linarith + · linarith + simp only [sub_sub_cancel_left, sub_sub_cancel] + rw [integral_rpow_rnDeriv_symm ha_pos ha.ne] + rw [inv_neg, mul_add, mul_add, mul_add, mul_add, ← mul_assoc, ← mul_assoc, ← mul_assoc, + ← mul_assoc, ← mul_assoc, ← mul_assoc, mul_inv_cancel₀, mul_inv_cancel₀, one_mul, one_mul, + add_assoc, add_comm _ (a * (μ Set.univ).toReal), ← add_assoc] + rotate_left + · exact ha_pos.ne' + · linarith + congr 3 + rw [← neg_sub, neg_mul, mul_inv_cancel₀, mul_neg, mul_inv_cancel₀ ha_pos.ne'] + linarith + +lemma hellingerDiv_symm (ha_pos : 0 < a) (ha : a < 1) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + ENNReal.ofReal (1 - a) * hellingerDiv a μ ν = ENNReal.ofReal a * hellingerDiv (1 - a) ν μ := by + rw [← ENNReal.toReal_eq_toReal_iff', ENNReal.toReal_mul, ENNReal.toReal_mul] + rotate_left + · exact ENNReal.mul_ne_top ENNReal.ofReal_ne_top <| hellingerDiv_ne_top_of_lt_one ha μ ν + · refine ENNReal.mul_ne_top ENNReal.ofReal_ne_top <| hellingerDiv_ne_top_of_lt_one ?_ ν μ + linarith + rw [ENNReal.toReal_ofReal ha_pos.le, ENNReal.toReal_ofReal (by linarith)] + exact toReal_hellingerDiv_symm ha_pos ha + +section DataProcessingInequality + +variable {β : Type*} {mβ : MeasurableSpace β} {κ η : Kernel α β} + +lemma le_hellingerDiv_compProd + (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ η : Kernel α β) [IsMarkovKernel κ] [IsMarkovKernel η] : + hellingerDiv a μ ν ≤ hellingerDiv a (μ ⊗ₘ κ) (ν ⊗ₘ η) := + le_fDiv_compProd μ ν κ η + +lemma hellingerDiv_fst_le (μ ν : Measure (α × β)) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + hellingerDiv a μ.fst ν.fst ≤ hellingerDiv a μ ν := + fDiv_fst_le _ _ + +lemma hellingerDiv_snd_le (μ ν : Measure (α × β)) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + hellingerDiv a μ.snd ν.snd ≤ hellingerDiv a μ ν := + fDiv_snd_le _ _ + +lemma hellingerDiv_comp_le_compProd (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + hellingerDiv a (κ ∘ₘ μ) (η ∘ₘ ν) ≤ hellingerDiv a (μ ⊗ₘ κ) (ν ⊗ₘ η) := + fDiv_comp_le_compProd μ ν κ η + +/-- The Data Processing Inequality for the Hellinger divergence. -/ +lemma hellingerDiv_comp_right_le (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ : Kernel α β) [IsMarkovKernel κ] : + hellingerDiv a (κ ∘ₘ μ) (κ ∘ₘ ν) ≤ hellingerDiv a μ ν := + fDiv_comp_right_le μ ν κ + +end DataProcessingInequality + +section MeasUnivAddMulHellingerDiv + +/-! In this section there are results about the expression `ν(α) + (a - 1) * Hₐ(μ, ν)`, +which appears in the definition of the Renyi divergence. -/ + +lemma hellingerDiv_le_of_lt_one (ha : a < 1) (μ ν : Measure α) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + hellingerDiv a μ ν ≤ ν Set.univ + ENNReal.ofReal (a * (1 - a)⁻¹) * μ Set.univ := by + by_cases h_zero : a ≤ 0 + · simp [h_zero] + refine fDiv_le_zero_add_top.trans_eq ?_ + simp [h_zero, ha] + +lemma mul_hellingerDiv_add_meas_eq_integral [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_ne : a ≠ 1) (h : hellingerDiv a μ ν ≠ ∞) : + (1 - a) * (ν .univ).toReal + a * (μ .univ).toReal + (a - 1) * (hellingerDiv a μ ν).toReal + = ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν := by + rw [toReal_hellingerDiv_eq_integral_of_ne_top ha_pos ha_ne h] + have h1 : a - 1 ≠ 0 := sub_ne_zero.mpr ha_ne + have h2 : 1 - a ≠ 0 := sub_ne_zero.mpr ha_ne.symm + field_simp + ring + +lemma mul_hellingerDiv_add_meas_eq_integral_of_lt_one [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_lt : a < 1) : + (1 - a) * (ν .univ).toReal + a * (μ .univ).toReal + (a - 1) * (hellingerDiv a μ ν).toReal + = ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν := + mul_hellingerDiv_add_meas_eq_integral ha_pos ha_lt.ne (hellingerDiv_ne_top_of_lt_one ha_lt μ ν) + +lemma toReal_hellingerDiv_eq_add_measure_univ_iff_of_lt_one (ha_pos : 0 < a) (ha : a < 1) + (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + (hellingerDiv a μ ν).toReal = (ν .univ).toReal + (a * (1 - a)⁻¹) * (μ .univ).toReal + ↔ μ ⟂ₘ ν := by + refine ⟨fun h ↦ ?_, toReal_hellingerDiv_of_mutuallySingular_of_lt_one ha_pos ha⟩ + rw [toReal_hellingerDiv_eq_integral_of_lt_one ha_pos ha] at h + rw [← integral_rpow_rnDeriv_eq_zero_iff_mutuallySingular (a := a) ha_pos.ne'] + swap; · exact integrable_rpow_rnDeriv_of_lt_one ha_pos.le ha + rw [mul_comm a, add_assoc, add_comm, add_eq_left, mul_eq_zero, inv_eq_zero, + sub_eq_zero] at h + simpa [ha.ne] using h + +lemma toReal_hellingerDiv_ne_add_measure_univ_of_one_lt (ha_lt : 1 < a) + [NeZero μ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (h_top : hellingerDiv a μ ν ≠ ∞) : + (hellingerDiv a μ ν).toReal ≠ (ν .univ).toReal + (a * (1 - a)⁻¹) * (μ .univ).toReal := by + have h : ¬ μ ⟂ₘ ν := fun h ↦ h_top (hellingerDiv_of_mutuallySingular_of_one_le ha_lt.le h) + rw [hellingerDiv_ne_top_iff_of_one_lt ha_lt] at h_top + rw [toReal_hellingerDiv_eq_integral_of_integrable_of_ac (zero_lt_one.trans ha_lt) + ha_lt.ne' h_top.1 h_top.2] + rw [mul_comm a, add_assoc, add_comm, ne_eq, add_eq_left, mul_eq_zero, inv_eq_zero, + sub_eq_zero] + simp only [ha_lt.ne', false_or] + rwa [integral_rpow_rnDeriv_eq_zero_iff_mutuallySingular (a := a) (zero_lt_one.trans ha_lt).ne' + h_top.1] + +lemma hellingerDiv_eq_add_measure_univ_iff_of_lt_one (ha_pos : 0 < a) (ha : a < 1) + (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + hellingerDiv a μ ν = ν Set.univ + ENNReal.ofReal (a * (1 - a)⁻¹) * μ Set.univ + ↔ μ ⟂ₘ ν := by + have h_nonneg : 0 ≤ a * (1 - a)⁻¹ := mul_nonneg ha_pos.le (by simp [ha.le]) + rw [← toReal_hellingerDiv_eq_add_measure_univ_iff_of_lt_one ha_pos ha, + ← ENNReal.toReal_eq_toReal_iff' (hellingerDiv_ne_top_of_lt_one ha μ ν) (by finiteness), + ENNReal.toReal_add (measure_ne_top _ _) (by finiteness), ENNReal.toReal_mul, + ENNReal.toReal_ofReal h_nonneg] + +end MeasUnivAddMulHellingerDiv + +/-! ### Scaling + +`∫ (∂μ/∂ν)^a ∂ν` is homogeneous of degree `a` in `μ` and `1 - a` in `ν` +(`integral_rpow_rnDeriv_smul_left`, `integral_rpow_rnDeriv_smul_right`). Since +`(1 - a) ν(α) + a μ(α) + (a - 1) Hₐ(μ, ν) = ∫ (∂μ/∂ν)^a ∂ν`, the Hellinger divergence itself is +not homogeneous, but `Hₐ(c • μ, ν)` is an affine function of `Hₐ(μ, ν)`, `μ(α)` and `ν(α)`. -/ + +section Scaling + +lemma hellingerDiv_smul_left_eq_top_iff [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_ne : a ≠ 1) (c : ℝ≥0) (hc : c ≠ 0) : + hellingerDiv a (c • μ) ν = ∞ ↔ hellingerDiv a μ ν = ∞ := by + rcases lt_or_gt_of_ne ha_ne with ha_lt | ha_lt + · simp [hellingerDiv_ne_top_of_lt_one ha_lt] + rw [hellingerDiv_eq_top_iff_of_one_lt ha_lt, hellingerDiv_eq_top_iff_of_one_lt ha_lt] + have h_int : Integrable (fun x ↦ ((∂(c • μ)/∂ν) x).toReal ^ a) ν + ↔ Integrable (fun x ↦ ((∂μ/∂ν) x).toReal ^ a) ν := by + have h : (fun x ↦ ((∂(c • μ)/∂ν) x).toReal ^ a) + =ᵐ[ν] fun x ↦ (c : ℝ) ^ a * ((∂μ/∂ν) x).toReal ^ a := by + filter_upwards [Measure.rnDeriv_smul_left' μ ν c] with x hx + rw [hx, Pi.smul_apply, ENNReal.toReal_smul, NNReal.smul_def, smul_eq_mul, + mul_rpow NNReal.zero_le_coe ENNReal.toReal_nonneg] + rw [integrable_congr h, integrable_const_mul_iff] + exact isUnit_iff_ne_zero.mpr + (rpow_pos_of_pos (NNReal.coe_pos.mpr (pos_iff_ne_zero.mpr hc)) _).ne' + have h_ac : c • μ ≪ ν ↔ μ ≪ ν := + ⟨fun h ↦ (Measure.absolutelyContinuous_smul (ENNReal.coe_ne_zero.2 hc)).trans h, + fun h ↦ h.smul_left c⟩ + rw [h_int, h_ac] + +lemma hellingerDiv_smul_left_ne_top [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_ne : a ≠ 1) (h : hellingerDiv a μ ν ≠ ∞) (c : ℝ≥0) : + hellingerDiv a (c • μ) ν ≠ ∞ := by + by_cases hc : c = 0 + · simp [hc, ha_pos] + · rwa [ne_eq, hellingerDiv_smul_left_eq_top_iff ha_ne c hc] + +/-- Scaling of the Hellinger divergence in its first argument. For `a = 1` (Kullback-Leibler +divergence), see `InformationTheory.toReal_klDiv_smul_left`. -/ +lemma toReal_hellingerDiv_smul_left [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_ne : a ≠ 1) (h : hellingerDiv a μ ν ≠ ∞) (c : ℝ≥0) : + (hellingerDiv a (c • μ) ν).toReal + = c ^ a * (hellingerDiv a μ ν).toReal + + a * (a - 1)⁻¹ * (c ^ a - c) * (μ .univ).toReal + (1 - c ^ a) * (ν .univ).toReal := by + rw [toReal_hellingerDiv_eq_integral_of_ne_top ha_pos ha_ne + (hellingerDiv_smul_left_ne_top ha_pos ha_ne h c), + toReal_hellingerDiv_eq_integral_of_ne_top ha_pos ha_ne h, integral_rpow_rnDeriv_smul_left, + Measure.smul_apply, ENNReal.toReal_smul, NNReal.smul_def, smul_eq_mul] + have : (1 - a)⁻¹ = -(a - 1)⁻¹ := by rw [← neg_sub a 1, inv_neg] + rw [this] + ring + +/-- See `fDiv_smul_right`. -/ +lemma hellingerDiv_smul_right [SigmaFinite μ] [SigmaFinite ν] (c : ℝ≥0) (hc : c ≠ 0) : + hellingerDiv a μ (c • ν) = c * hellingerDiv a (c⁻¹ • μ) ν := + fDiv_smul_right c hc + +lemma hellingerDiv_smul_right_eq_top_iff [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_ne : a ≠ 1) (c : ℝ≥0) (hc : c ≠ 0) : + hellingerDiv a μ (c • ν) = ∞ ↔ hellingerDiv a μ ν = ∞ := by + rw [hellingerDiv_smul_right c hc, ENNReal.mul_eq_top, + hellingerDiv_smul_left_eq_top_iff ha_ne c⁻¹ (inv_ne_zero hc)] + simp [hc] + +/-- Scaling of the Hellinger divergence in its second argument. -/ +lemma toReal_hellingerDiv_smul_right [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_ne : a ≠ 1) (h : hellingerDiv a μ ν ≠ ∞) (c : ℝ≥0) (hc : c ≠ 0) : + (hellingerDiv a μ (c • ν)).toReal + = c ^ (1 - a) * (hellingerDiv a μ ν).toReal + + a * (a - 1)⁻¹ * (c ^ (1 - a) - 1) * (μ .univ).toReal + + (c - c ^ (1 - a)) * (ν .univ).toReal := by + have hc' : (0 : ℝ) < c := NNReal.coe_pos.mpr (pos_iff_ne_zero.mpr hc) + rw [hellingerDiv_smul_right c hc, ENNReal.toReal_mul, ENNReal.coe_toReal, + toReal_hellingerDiv_smul_left ha_pos ha_ne h c⁻¹, NNReal.coe_inv, inv_rpow hc'.le, + rpow_sub hc', rpow_one, div_eq_mul_inv] + field_simp + +lemma hellingerDiv_smul_left_eq_top_iff' [IsFiniteMeasure μ] [IsFiniteMeasure ν] (ha_ne : a ≠ 1) + {c : ℝ≥0∞} (hc : c ≠ 0) (hc_top : c ≠ ∞) : + hellingerDiv a (c • μ) ν = ∞ ↔ hellingerDiv a μ ν = ∞ := by + lift c to ℝ≥0 using hc_top + rw [← ENNReal.smul_def] + exact hellingerDiv_smul_left_eq_top_iff ha_ne c (by simpa using hc) + +lemma hellingerDiv_smul_right_eq_top_iff' [IsFiniteMeasure μ] [IsFiniteMeasure ν] (ha_ne : a ≠ 1) + {c : ℝ≥0∞} (hc : c ≠ 0) (hc_top : c ≠ ∞) : + hellingerDiv a μ (c • ν) = ∞ ↔ hellingerDiv a μ ν = ∞ := by + lift c to ℝ≥0 using hc_top + rw [← ENNReal.smul_def] + exact hellingerDiv_smul_right_eq_top_iff ha_ne c (by simpa using hc) + +lemma integral_rpow_rnDeriv_le_rpow_mul_rpow_of_lt_one (ha_pos : 0 < a) (ha_lt : a < 1) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + ∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν ≤ (μ .univ).toReal ^ a * (ν .univ).toReal ^ (1 - a) := by + rcases eq_or_ne μ 0 with rfl | hμ + · have : ∫ x, ((∂(0 : Measure α)/∂ν) x).toReal ^ a ∂ν = 0 := by + refine integral_eq_zero_of_ae ?_ + filter_upwards [ν.rnDeriv_zero] with x hx + simp [hx, ha_pos.ne'] + rw [this] + positivity + rcases eq_or_ne ν 0 with rfl | hν + · simp only [integral_zero_measure] + positivity + have : NeZero μ := ⟨hμ⟩ + have : NeZero ν := ⟨hν⟩ + rw [integral_rpow_rnDeriv_eq_mul_integral_rpow_rnDeriv_inv_smul ha_lt.ne] + refine mul_le_of_le_one_right (by positivity) ?_ + rw [← mul_hellingerDiv_add_meas_eq_integral_of_lt_one ha_pos ha_lt] + simp only [measure_univ, ENNReal.toReal_one, mul_one] + have : (a - 1) * (hellingerDiv a ((μ .univ)⁻¹ • μ) ((ν .univ)⁻¹ • ν)).toReal ≤ 0 := + mul_nonpos_of_nonpos_of_nonneg (by linarith) ENNReal.toReal_nonneg + linarith + +lemma rpow_mul_rpow_le_integral_rpow_rnDeriv_of_one_lt (ha : 1 < a) + [NeZero μ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] (h : hellingerDiv a μ ν ≠ ∞) : + (μ .univ).toReal ^ a * (ν .univ).toReal ^ (1 - a) ≤ ∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν := by + have ha_pos : 0 < a := zero_lt_one.trans ha + have : NeZero ν := + ⟨fun hν ↦ h (by rw [hν]; exact hellingerDiv_zero_measure_right_of_one_le ha.le μ)⟩ + have h' : hellingerDiv a ((μ .univ)⁻¹ • μ) ((ν .univ)⁻¹ • ν) ≠ ∞ := by + rwa [ne_eq, hellingerDiv_smul_right_eq_top_iff' ha.ne' + (ENNReal.inv_ne_zero.mpr (measure_ne_top _ _)) (ENNReal.inv_ne_top.mpr (NeZero.ne _)), + hellingerDiv_smul_left_eq_top_iff' ha.ne' (ENNReal.inv_ne_zero.mpr (measure_ne_top _ _)) + (ENNReal.inv_ne_top.mpr (NeZero.ne _))] + rw [integral_rpow_rnDeriv_eq_mul_integral_rpow_rnDeriv_inv_smul ha.ne'] + refine le_mul_of_one_le_right (by positivity) ?_ + rw [← mul_hellingerDiv_add_meas_eq_integral ha_pos ha.ne' h'] + simp only [measure_univ, ENNReal.toReal_one, mul_one] + have : 0 ≤ (a - 1) * (hellingerDiv a ((μ .univ)⁻¹ • μ) ((ν .univ)⁻¹ • ν)).toReal := + mul_nonneg (by linarith) ENNReal.toReal_nonneg + linarith + +lemma log_integral_rpow_rnDeriv_le_of_lt_one (ha_pos : 0 < a) (ha_lt : a < 1) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] (h_ms : ¬ μ ⟂ₘ ν) : + Real.log (∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν) + ≤ a * Real.log (μ .univ).toReal + (1 - a) * Real.log (ν .univ).toReal := by + have hμ : μ ≠ 0 := fun h ↦ h_ms (by rw [h]; exact .zero_left) + have hν : ν ≠ 0 := fun h ↦ h_ms (by rw [h]; exact .zero_right) + have hm : 0 < (μ .univ).toReal := + ENNReal.toReal_pos (Measure.measure_univ_ne_zero.mpr hμ) (measure_ne_top _ _) + have hn : 0 < (ν .univ).toReal := + ENNReal.toReal_pos (Measure.measure_univ_ne_zero.mpr hν) (measure_ne_top _ _) + rw [← Real.log_rpow hm, ← Real.log_rpow hn, + ← Real.log_mul (rpow_pos_of_pos hm _).ne' (rpow_pos_of_pos hn _).ne'] + refine Real.log_le_log ?_ (integral_rpow_rnDeriv_le_rpow_mul_rpow_of_lt_one ha_pos ha_lt) + exact (integral_rpow_rnDeriv_pos_iff_not_mutuallySingular ha_pos.ne' + (integrable_rpow_rnDeriv_of_lt_one ha_pos.le ha_lt)).mpr h_ms + +lemma le_log_integral_rpow_rnDeriv_of_one_lt (ha : 1 < a) + [NeZero μ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] (h : hellingerDiv a μ ν ≠ ∞) : + a * Real.log (μ .univ).toReal + (1 - a) * Real.log (ν .univ).toReal + ≤ Real.log (∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν) := by + have : NeZero ν := + ⟨fun hν ↦ h (by rw [hν]; exact hellingerDiv_zero_measure_right_of_one_le ha.le μ)⟩ + have hm : 0 < (μ .univ).toReal := ENNReal.toReal_pos (NeZero.ne _) (measure_ne_top _ _) + have hn : 0 < (ν .univ).toReal := ENNReal.toReal_pos (NeZero.ne _) (measure_ne_top _ _) + rw [← Real.log_rpow hm, ← Real.log_rpow hn, + ← Real.log_mul (rpow_pos_of_pos hm _).ne' (rpow_pos_of_pos hn _).ne'] + exact Real.log_le_log (by positivity) (rpow_mul_rpow_le_integral_rpow_rnDeriv_of_one_lt ha h) + +end Scaling + +section SqHellinger + +/-- Squared Hellinger distance between two measures. For finite measures with `μ ≪ ν`, it is +`ENNReal.ofReal (2⁻¹ * ∫ x, (1 - √((∂μ/∂ν) x).toReal) ^ 2 ∂ν)` +(`sqHellinger_eq_ofReal_integral_of_ac`). In general, it is half of the Hellinger divergence of +order `2⁻¹`. -/ +noncomputable def sqHellinger (μ ν : Measure α) : ℝ≥0∞ := 2⁻¹ * hellingerDiv 2⁻¹ μ ν + +lemma hellingerFun_inv_two {x : ℝ} (hx : 0 ≤ x) : hellingerFun 2⁻¹ x = (1 - √x) ^ 2 := by + rw [hellingerFun_of_ne_zero_of_ne_one (by norm_num) (by norm_num), Real.sqrt_eq_rpow, one_div] + beta_reduce + have hs : (x ^ (2⁻¹ : ℝ)) ^ (2 : ℕ) = x := by + rw [← Real.rpow_natCast, ← Real.rpow_mul hx] + norm_num + linear_combination (-1 : ℝ) * hs + +lemma sqHellinger_eq_ofReal_integral_of_ac [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hμν : μ ≪ ν) : + sqHellinger μ ν = ENNReal.ofReal (2⁻¹ * ∫ x, (1 - √((∂μ/∂ν) x).toReal) ^ 2 ∂ν) := by + rw [sqHellinger, hellingerDiv_eq_ofReal_integral_of_integrable_of_ac (by norm_num) ?_ hμν, + ENNReal.ofReal_mul (by norm_num), ENNReal.ofReal_inv_of_pos two_pos, ENNReal.ofReal_ofNat] + · simp_rw [hellingerFun_inv_two ENNReal.toReal_nonneg] + · rw [integrable_hellingerFun_iff_integrable_rpow (by norm_num)] + exact integrable_rpow_rnDeriv_of_lt_one (by norm_num) (by norm_num) + +end SqHellinger + +end ProbabilityTheory diff --git a/Statlib/Divergence/Hellinger/CondHellinger.lean b/Statlib/Divergence/Hellinger/CondHellinger.lean new file mode 100644 index 0000000..36dc840 --- /dev/null +++ b/Statlib/Divergence/Hellinger/CondHellinger.lean @@ -0,0 +1,201 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Statlib.ForMathlib.Probability.Kernel.Composition.MeasureCompProd +public import Statlib.Divergence.KullbackLeibler.CondKL +public import Statlib.Divergence.Hellinger.Basic + +/-! +# Conditional Hellinger divergence + +## Main definitions + +* `condHellingerDiv a κ η μ`: the conditional Hellinger divergence of order `a` between the + kernels `κ` and `η` with respect to `μ`, defined as the conditional f-divergence for the + divergence function `hellingerDivFun a`. + +## Main statements + +* `hellingerDiv_compProd_right`: `hellingerDiv a (μ ⊗ₘ κ) (μ ⊗ₘ η) = condHellingerDiv a κ η μ`. +* `hellingerDiv_comp_left_le`: `hellingerDiv a (κ ∘ₘ μ) (η ∘ₘ μ) ≤ condHellingerDiv a κ η μ`. +* `condHellingerDiv_one`: the conditional Hellinger divergence of order `1` is `condKL`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Real MeasureTheory Filter MeasurableSpace + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} + {μ ν : Measure α} {κ η : Kernel α β} + {a : ℝ} + +/-- Conditional Hellinger divergence of order `a`. -/ +noncomputable def condHellingerDiv (a : ℝ) (κ η : Kernel α β) (μ : Measure α) : ℝ≥0∞ := + condFDiv (hellingerDivFun a) κ η μ + +lemma hellingerDiv_compProd_right [CountableOrCountablyGenerated α β] + (μ : Measure α) [IsFiniteMeasure μ] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + hellingerDiv a (μ ⊗ₘ κ) (μ ⊗ₘ η) = condHellingerDiv a κ η μ := by + rw [hellingerDiv, condHellingerDiv, fDiv_compProd_right _ _ _] + +lemma hellingerDiv_comp_left_le [CountableOrCountablyGenerated α β] (μ : Measure α) + [IsFiniteMeasure μ] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + hellingerDiv a (κ ∘ₘ μ) (η ∘ₘ μ) ≤ condHellingerDiv a κ η μ := + fDiv_comp_left_le μ κ η + +/-! The normal form of the finiteness conditions for the conditional Hellinger divergence, when +`μ`, `κ` and `η` are finite and `a ∈ (0, 1) ∪ (1, +∞)`, is given by `condHellingerDiv_ne_top_iff`: +`condHellingerDiv a κ η μ ≠ ∞` iff +* `∀ᵐ x ∂μ, Integrable (fun b ↦ ((∂κ x/∂η x) b).toReal ^ a) (η x)` (`h_int`), +* `1 ≤ a → ∀ᵐ x ∂μ, (κ x) ≪ (η x)` (`h_ac`), +* `Integrable (fun x ↦ ∫ b, ((∂κ x/∂η x) b).toReal ^ a ∂η x) μ` (`h_int'`). + +Under these conditions, `toReal_condHellingerDiv_eq_integral'` gives the integral form +`(condHellingerDiv a κ η μ).toReal = (a - 1)⁻¹ * ∫ x, ∫ b, ((∂κ x/∂η x) b).toReal ^ a ∂η x ∂μ + + ((μ ⊗ₘ η) univ).toReal + (1 - a)⁻¹ * a * ((μ ⊗ₘ κ) univ).toReal`. +-/ +section CondHellingerEq + +lemma condHellingerDiv_one [IsFiniteKernel κ] [IsFiniteKernel η] : + condHellingerDiv 1 κ η μ = condKL κ η μ := by + rw [condHellingerDiv, hellingerDivFun_one, condKL_eq_condFDiv] + +lemma hellingerDiv_ae_ne_top_iff [IsFiniteKernel κ] [IsFiniteKernel η] + (ha_pos : 0 < a) (ha_ne : a ≠ 1) : + (∀ᵐ x ∂μ, hellingerDiv a (κ x) (η x) ≠ ∞) + ↔ (∀ᵐ x ∂μ, Integrable (fun b ↦ ((∂κ x/∂η x) b).toReal ^ a) (η x)) + ∧ (1 ≤ a → ∀ᵐ x ∂μ, κ x ≪ η x) := by + simp_rw [hellingerDiv] + rw [fDiv_ae_ne_top_iff, derivAtTop_hellingerDivFun_eq_top_iff] + simp_rw [lintegral_hellingerDivFun_ne_top_iff ha_pos ha_ne] + +lemma integrable_toReal_hellingerDiv_iff [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] + (ha_pos : 0 < a) (ha_ne : a ≠ 1) (h_ae : ∀ᵐ x ∂μ, hellingerDiv a (κ x) (η x) ≠ ∞) : + Integrable (fun x ↦ (hellingerDiv a (κ x) (η x)).toReal) μ + ↔ Integrable (fun x ↦ ∫ b, ((∂κ x/∂η x) b).toReal ^ a ∂η x) μ := by + have h : (fun x ↦ (hellingerDiv a (κ x) (η x)).toReal) + =ᵐ[μ] fun x ↦ (a - 1)⁻¹ * ∫ b, ((∂κ x/∂η x) b).toReal ^ a ∂η x + + ((η x) .univ).toReal + (1 - a)⁻¹ * a * ((κ x) .univ).toReal := by + filter_upwards [h_ae] with x hx + exact toReal_hellingerDiv_eq_integral_of_ne_top ha_pos ha_ne hx + have hκ : Integrable (fun x ↦ ((κ x) .univ).toReal) μ := + Kernel.IsFiniteKernel.integrable _ _ .univ + have hη : Integrable (fun x ↦ ((η x) .univ).toReal) μ := + Kernel.IsFiniteKernel.integrable _ _ .univ + rw [integrable_congr h, integrable_add_iff_integrable_left' (hκ.const_mul _), + integrable_add_iff_integrable_left' hη, + integrable_const_mul_iff (isUnit_iff_ne_zero.mpr (inv_ne_zero (sub_ne_zero.mpr ha_ne)))] + +lemma condHellingerDiv_ne_top_iff [CountableOrCountablyGenerated α β] [IsFiniteMeasure μ] + [IsFiniteKernel κ] [IsFiniteKernel η] (ha_pos : 0 < a) (ha_ne : a ≠ 1) : + condHellingerDiv a κ η μ ≠ ∞ + ↔ (∀ᵐ x ∂μ, Integrable (fun b ↦ ((∂κ x/∂η x) b).toReal ^ a) (η x)) + ∧ (1 ≤ a → ∀ᵐ x ∂μ, κ x ≪ η x) + ∧ Integrable (fun x ↦ ∫ b, ((∂κ x/∂η x) b).toReal ^ a ∂η x) μ := by + have h_meas : Measurable fun x ↦ hellingerDiv a (κ x) (η x) := measurable_fDiv _ _ + have h_eq : condHellingerDiv a κ η μ = ∫⁻ x, hellingerDiv a (κ x) (η x) ∂μ := rfl + rw [h_eq] + constructor + · intro h + have h_ae : ∀ᵐ x ∂μ, hellingerDiv a (κ x) (η x) ≠ ∞ := + (ae_lt_top h_meas h).mono fun x hx ↦ hx.ne + obtain ⟨h_int, h_ac⟩ := (hellingerDiv_ae_ne_top_iff ha_pos ha_ne).mp h_ae + exact ⟨h_int, h_ac, (integrable_toReal_hellingerDiv_iff ha_pos ha_ne h_ae).mp + ((integrable_toReal_iff h_meas.aemeasurable h_ae).mpr h)⟩ + · rintro ⟨h_int, h_ac, h_int'⟩ + have h_ae := (hellingerDiv_ae_ne_top_iff ha_pos ha_ne).mpr ⟨h_int, h_ac⟩ + exact (integrable_toReal_iff h_meas.aemeasurable h_ae).mp + ((integrable_toReal_hellingerDiv_iff ha_pos ha_ne h_ae).mpr h_int') + +lemma condHellingerDiv_eq_top_iff [CountableOrCountablyGenerated α β] [IsFiniteMeasure μ] + [IsFiniteKernel κ] [IsFiniteKernel η] (ha_pos : 0 < a) (ha_ne : a ≠ 1) : + condHellingerDiv a κ η μ = ∞ + ↔ ¬ (∀ᵐ x ∂μ, Integrable (fun b ↦ ((∂κ x/∂η x) b).toReal ^ a) (η x)) + ∨ (1 ≤ a ∧ ¬ ∀ᵐ x ∂μ, κ x ≪ η x) + ∨ ¬ Integrable (fun x ↦ ∫ b, ((∂κ x/∂η x) b).toReal ^ a ∂η x) μ := by + rw [← not_not (a := _ = ∞), ← ne_eq, condHellingerDiv_ne_top_iff ha_pos ha_ne] + tauto + +lemma condHellingerDiv_ne_top_iff_of_one_lt [CountableOrCountablyGenerated α β] + [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] (ha : 1 < a) : + condHellingerDiv a κ η μ ≠ ∞ + ↔ (∀ᵐ x ∂μ, Integrable (fun b ↦ ((∂κ x/∂η x) b).toReal ^ a) (η x)) + ∧ (∀ᵐ x ∂μ, κ x ≪ η x) + ∧ Integrable (fun x ↦ ∫ b, ((∂κ x/∂η x) b).toReal ^ a ∂η x) μ := by + rw [condHellingerDiv_ne_top_iff (zero_lt_one.trans ha) ha.ne', imp_iff_right ha.le] + +lemma condHellingerDiv_eq_top_iff_of_one_lt [CountableOrCountablyGenerated α β] + [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] (ha : 1 < a) : + condHellingerDiv a κ η μ = ∞ + ↔ ¬ (∀ᵐ x ∂μ, Integrable (fun b ↦ ((∂κ x/∂η x) b).toReal ^ a) (η x)) + ∨ ¬ (∀ᵐ x ∂μ, κ x ≪ η x) + ∨ ¬ Integrable (fun x ↦ ∫ b, ((∂κ x/∂η x) b).toReal ^ a ∂η x) μ := by + rw [← not_not (a := _ = ∞), ← ne_eq, condHellingerDiv_ne_top_iff_of_one_lt ha] + tauto + +lemma condHellingerDiv_ne_top_iff_of_lt_one [CountableOrCountablyGenerated α β] + [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] (ha_pos : 0 < a) (ha_lt : a < 1) : + condHellingerDiv a κ η μ ≠ ∞ + ↔ Integrable (fun x ↦ ∫ b, ((∂κ x/∂η x) b).toReal ^ a ∂η x) μ := by + rw [condHellingerDiv_ne_top_iff ha_pos ha_lt.ne] + simp only [not_le.mpr ha_lt, false_imp_iff, true_and] + exact and_iff_right (ae_of_all _ fun x ↦ integrable_rpow_rnDeriv_of_lt_one ha_pos.le ha_lt) + +lemma condHellingerDiv_eq_top_iff_of_lt_one [CountableOrCountablyGenerated α β] + [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] (ha_pos : 0 < a) (ha_lt : a < 1) : + condHellingerDiv a κ η μ = ∞ + ↔ ¬ Integrable (fun x ↦ ∫ b, ((∂κ x/∂η x) b).toReal ^ a ∂η x) μ := by + rw [← not_not (a := _ = ∞), ← ne_eq, condHellingerDiv_ne_top_iff_of_lt_one ha_pos ha_lt] + +lemma condHellingerDiv_of_not_ae_ac_of_one_le [CountableOrCountablyGenerated α β] + [IsFiniteKernel κ] [IsFiniteKernel η] (ha : 1 ≤ a) (h_ac : ¬ ∀ᵐ x ∂μ, κ x ≪ η x) : + condHellingerDiv a κ η μ = ∞ := + condFDiv_of_not_ae_ac (derivAtTop_hellingerDivFun_eq_top_iff.mpr ha) h_ac + +lemma toReal_condHellingerDiv_eq_integral [CountableOrCountablyGenerated α β] + [IsFiniteKernel κ] [IsFiniteKernel η] (h : condHellingerDiv a κ η μ ≠ ∞) : + (condHellingerDiv a κ η μ).toReal = ∫ x, (hellingerDiv a (κ x) (η x)).toReal ∂μ := + toReal_condFDiv_eq_integral h + +/-- Integral form of the conditional Hellinger divergence, when it is finite. -/ +lemma toReal_condHellingerDiv_eq_integral' [CountableOrCountablyGenerated α β] + [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] (ha_pos : 0 < a) (ha_ne : a ≠ 1) + (h : condHellingerDiv a κ η μ ≠ ∞) : + (condHellingerDiv a κ η μ).toReal + = (a - 1)⁻¹ * ∫ x, ∫ b, ((∂κ x/∂η x) b).toReal ^ a ∂η x ∂μ + + ((μ ⊗ₘ η) .univ).toReal + (1 - a)⁻¹ * a * ((μ ⊗ₘ κ) .univ).toReal := by + have h_meas : Measurable fun x ↦ hellingerDiv a (κ x) (η x) := measurable_fDiv _ _ + have h_ae : ∀ᵐ x ∂μ, hellingerDiv a (κ x) (η x) ≠ ∞ := + (ae_lt_top h_meas h).mono fun x hx ↦ hx.ne + obtain ⟨-, -, h_int'⟩ := (condHellingerDiv_ne_top_iff ha_pos ha_ne).mp h + rw [toReal_condHellingerDiv_eq_integral h] + calc ∫ x, (hellingerDiv a (κ x) (η x)).toReal ∂μ + _ = ∫ x, (a - 1)⁻¹ * ∫ b, ((∂κ x/∂η x) b).toReal ^ a ∂η x + + ((η x) .univ).toReal + (1 - a)⁻¹ * a * ((κ x) .univ).toReal ∂μ := by + refine integral_congr_ae ?_ + filter_upwards [h_ae] with x hx + exact toReal_hellingerDiv_eq_integral_of_ne_top ha_pos ha_ne hx + _ = _ := by + rw [integral_add, integral_add, integral_const_mul, integral_const_mul, + Measure.compProd_univ_toReal, Measure.compProd_univ_toReal] + · exact h_int'.const_mul _ + · exact Kernel.IsFiniteKernel.integrable _ _ .univ + · exact (h_int'.const_mul _).add (Kernel.IsFiniteKernel.integrable _ _ .univ) + · exact (Kernel.IsFiniteKernel.integrable _ _ .univ).const_mul _ + +end CondHellingerEq + +end ProbabilityTheory diff --git a/Statlib/Divergence/Hellinger/HellingerDivFun.lean b/Statlib/Divergence/Hellinger/HellingerDivFun.lean new file mode 100644 index 0000000..a7d51d2 --- /dev/null +++ b/Statlib/Divergence/Hellinger/HellingerDivFun.lean @@ -0,0 +1,155 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Statlib.Divergence.Hellinger.HellingerFun + +/-! +# The divergence function of the Hellinger divergence + +## Main definitions + +* `hellingerDivFun a`: the `DivFunction` of the Hellinger divergence of order `a`, obtained from + `hellingerFun a` for `0 < a` (it is `klDivFun` for `a = 1`), and equal to `0` for `a ≤ 0`. + +## Main statements + +* `hellingerDivFun_one`: `hellingerDivFun 1 = klDivFun`. +* `derivAtTop_hellingerDivFun_of_one_le`, `derivAtTop_hellingerDivFun_of_lt_one`: the derivative + at infinity is `∞` for `1 ≤ a` and `a / (1 - a)` for `a < 1`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Real MeasureTheory Filter MeasurableSpace Set + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {a : ℝ} + +/-- The divergence function of the Hellinger divergence of order `a`: for `0 < a`, it is the +`DivFunction` obtained from `hellingerFun a` (which is `klFun` for `a = 1`). For `a ≤ 0` it is `0`: +`hellingerFun a` is not convex for `a < 0`, and for `a = 0` the value of a `DivFunction` at `0` is +determined by continuity, so the indicator of `{0}` cannot be used. -/ +noncomputable +def hellingerDivFun (a : ℝ) : DivFunction := + if ha : a ≤ 0 then 0 + else DivFunction.ofReal (hellingerFun a) + ((convexOn_hellingerFun (not_le.mp ha).le).subset (Ioi_subset_Ici le_rfl) (convex_Ioi _)) + hellingerFun_apply_one_eq_zero + +@[simp] +lemma hellingerDivFun_of_nonpos (ha : a ≤ 0) : hellingerDivFun a = 0 := dite_eq_left ha + +lemma hellingerDivFun_zero : hellingerDivFun 0 = 0 := dite_eq_left le_rfl + +lemma hellingerDivFun_of_pos (ha_pos : 0 < a) : + hellingerDivFun a = DivFunction.ofReal (hellingerFun a) + ((convexOn_hellingerFun ha_pos.le).subset (Ioi_subset_Ici le_rfl) (convex_Ioi _)) + hellingerFun_apply_one_eq_zero := + dite_eq_right (not_le.mpr ha_pos) + +@[simp] +lemma hellingerDivFun_one : hellingerDivFun 1 = klDivFun := by + rw [hellingerDivFun_of_pos zero_lt_one, klDivFun] + congr 1 + ext x + simp [hellingerFun_one, InformationTheory.klFun_apply] + +lemma hellingerDivFun_apply_zero_of_pos (ha_pos : 0 < a) : hellingerDivFun a 0 = 1 := by + rw [hellingerDivFun_of_pos ha_pos, + DivFunction.ofReal_apply_zero_of_continuousWithinAt + (continuous_hellingerFun ha_pos).continuousWithinAt] + simp + +@[simp] +lemma hellingerDivFun_apply_zero : + hellingerDivFun a 0 = if a ≤ 0 then 0 else 1 := by + split_ifs with h0 + · simp [h0] + · exact hellingerDivFun_apply_zero_of_pos (not_le.mp h0) + +lemma hellingerDivFun_apply_of_pos_of_ne_one (ha_pos : 0 < a) (ha_one : a ≠ 1) + {x : ℝ≥0∞} (hx : x ≠ ∞) : + hellingerDivFun a x = ENNReal.ofReal ((a - 1)⁻¹ * (x.toReal ^ a - 1 - a * (x.toReal - 1))) := by + rw [hellingerDivFun_of_pos ha_pos] + by_cases hx0 : x = 0 + · rw [hx0, DivFunction.ofReal_apply_zero_of_continuousWithinAt] + · simp only [hellingerFun_apply_zero, ENNReal.ofReal_one, ENNReal.toReal_zero, ne_eq, + ha_pos.ne', not_false_eq_true, zero_rpow, zero_sub, mul_neg, mul_one, sub_neg_eq_add] + rw [add_comm, ← sub_eq_add_neg, inv_mul_cancel₀, ENNReal.ofReal_one] + rwa [sub_ne_zero] + · exact (continuous_hellingerFun ha_pos).continuousWithinAt + · rw [DivFunction.ofReal_apply hx0 hx, hellingerFun_of_ne_zero_of_ne_one ha_pos.ne' ha_one] + +@[simp] +lemma derivAtTop_hellingerDivFun : + (hellingerDivFun a).derivAtTop = + if a ≤ 0 then 0 + else if a < 1 then ENNReal.ofReal (a * (1 - a)⁻¹) + else ∞ := by + split_ifs with h h_one + · simp [h] + · rw [hellingerDivFun_of_pos (not_le.mp h)] + exact DivFunction.derivAtTop_ofReal_of_tendsto_nhds + (tendsto_rightDeriv_hellingerFun_atTop_of_lt_one h_one) + · by_cases ha_one : a = 1 + · simp [ha_one] + rw [hellingerDivFun_of_pos (not_le.mp h)] + exact DivFunction.derivAtTop_ofReal_of_tendsto_atTop + (tendsto_rightDeriv_hellingerFun_atTop_of_one_lt + ((not_lt.mp h_one).lt_of_ne (Ne.symm ha_one))) + +lemma derivAtTop_hellingerDivFun_of_lt_one (ha_pos : 0 < a) (ha_lt : a < 1) : + (hellingerDivFun a).derivAtTop = ENNReal.ofReal (a * (1 - a)⁻¹) := by + simp [derivAtTop_hellingerDivFun, not_le.mpr ha_pos, ha_lt] + +lemma derivAtTop_hellingerDivFun_of_one_le (ha_le : 1 ≤ a) : + (hellingerDivFun a).derivAtTop = ∞ := by + simp [derivAtTop_hellingerDivFun, not_le.mpr (zero_lt_one.trans_le ha_le), ha_le] + +lemma derivAtTop_hellingerDivFun_eq_top_iff : (hellingerDivFun a).derivAtTop = ∞ ↔ 1 ≤ a := by + simp only [derivAtTop_hellingerDivFun] + split_ifs with h1 h2 + · simp [h1.trans_lt zero_lt_one] + · simp [h2] + · simp [not_lt.mp h2] + +lemma lintegral_hellingerDivFun_of_pos_of_ne_one_of_integrable + [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_ne : a ≠ 1) (h_int : Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ a) ν) : + ∫⁻ x, hellingerDivFun a (μ.rnDeriv ν x) ∂ν + = ENNReal.ofReal ((a - 1)⁻¹ * ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν + + (ν .univ).toReal + (1 - a)⁻¹ * a * ∫ x, (μ.rnDeriv ν x).toReal ∂ν) := by + calc ∫⁻ x, hellingerDivFun a (μ.rnDeriv ν x) ∂ν + _ = ∫⁻ x, ENNReal.ofReal (hellingerFun a (μ.rnDeriv ν x).toReal) ∂ν := by + rw [hellingerDivFun_of_pos ha_pos] + exact DivFunction.lintegral_ofReal_of_continuous + (continuous_hellingerFun ha_pos).continuousWithinAt + _ = ENNReal.ofReal (∫ x, hellingerFun a (μ.rnDeriv ν x).toReal ∂ν) := by + rw [ofReal_integral_eq_lintegral_ofReal] + · rwa [integrable_hellingerFun_iff_integrable_rpow ha_ne] + · exact ae_of_all _ fun x ↦ hellingerFun_nonneg ha_pos.le ENNReal.toReal_nonneg + _ = ENNReal.ofReal ((a - 1)⁻¹ * ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν + + (ν .univ).toReal + (1 - a)⁻¹ * a * ∫ x, (μ.rnDeriv ν x).toReal ∂ν) := by + rw [integral_hellingerFun_of_pos_of_ne_one_of_integrable ha_pos ha_ne h_int] + +lemma lintegral_hellingerDivFun_of_pos_of_ne_one_of_integrable_of_ac + [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_ne : a ≠ 1) (h_int : Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ a) ν) + (hμν : μ ≪ ν) : + ∫⁻ x, hellingerDivFun a (μ.rnDeriv ν x) ∂ν + = ENNReal.ofReal ((a - 1)⁻¹ * ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν + + (ν .univ).toReal + (1 - a)⁻¹ * a * (μ univ).toReal) := by + rw [lintegral_hellingerDivFun_of_pos_of_ne_one_of_integrable ha_pos ha_ne h_int, + Measure.integral_toReal_rnDeriv hμν, measureReal_def] + +end ProbabilityTheory diff --git a/Statlib/Divergence/Hellinger/HellingerFun.lean b/Statlib/Divergence/Hellinger/HellingerFun.lean new file mode 100644 index 0000000..648f26a --- /dev/null +++ b/Statlib/Divergence/Hellinger/HellingerFun.lean @@ -0,0 +1,336 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.Analysis.Convex.SpecificFunctions.Pow +public import Mathlib.Analysis.SpecialFunctions.Log.NegMulLog +public import Mathlib.Analysis.SpecialFunctions.Pow.Deriv +public import Mathlib.MeasureTheory.Constructions.Polish.Basic +public import Mathlib.Probability.Notation +public import Statlib.Divergence.KullbackLeibler.Basic +public import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.IntegralRPowRNDeriv + +/-! +# The real function of the Hellinger divergence + +## Main definitions + +* `hellingerFun a`: the real function `x ↦ (a - 1)⁻¹ * (x ^ a - 1 - a * (x - 1))`, with special + cases at `a = 0` (indicator of `{0}`) and `a = 1` (`x * log x + 1 - x`, the function of the + Kullback-Leibler divergence). + +## Main statements + +* `convexOn_hellingerFun`: `hellingerFun a` is convex on `[0, ∞)` for `0 ≤ a`. +* `derivAtTop_hellingerFun_of_one_le`, `derivAtTop_hellingerFun_of_lt_one`: the derivative at + infinity is `⊤` for `1 ≤ a` and `a / (1 - a)` for `a < 1`. +* `integrable_hellingerFun_iff_integrable_rpow`: integrability of `hellingerFun a (∂μ/∂ν)` is + equivalent to integrability of `(∂μ/∂ν) ^ a`. + +## Implementation details + +How to define a `DivFunction` from a real function `f`: +- prove that the function is convex on `(0, ∞)` and that `f 1 = 0` +- if applicable, prove that `f` is continuous at zero +- find the limit of `f` at +∞ +- useful lemma: `f` is nonnegative +- useful lemma: `0 ≤ ∫ x, f (μ.rnDeriv ν x) ∂ν`. Simplify the integral to get other inequalities. + +Then use `DivFunction.ofReal`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Real MeasureTheory Filter MeasurableSpace InformationTheory Set + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {a : ℝ} + +section HellingerFun + +/-- Hellinger function, defined as `x ↦ (a - 1)⁻¹ * (x ^ a - 1)` for `a ∈ (0, 1) ∪ (1, + ∞)`. +At `0` the function is obtained by contiuity and is the indicator function of `{0}`. At `1` it is +defined as `x ↦ x * log x`, because in this way we obtain that the Hellinger divergence at `1` +conincides with the KL divergence, which is natural for continuity reasons. -/ +noncomputable +def hellingerFun (a : ℝ) : ℝ → ℝ := + if a = 0 then fun x ↦ if x = 0 then 1 else 0 + else if a = 1 then fun x ↦ x * log x + 1 - x + else fun x ↦ (a - 1)⁻¹ * (x ^ a - 1 - a * (x - 1)) + +@[simp] +lemma hellingerFun_zero : hellingerFun 0 = fun x ↦ if x = 0 then 1 else 0 := by + ext x + simp [hellingerFun] + +lemma hellingerFun_zero_eq_indicator : hellingerFun 0 = Set.indicator {0} 1 := by + ext x + by_cases h : x = 0 <;> simp [hellingerFun_zero, h] + +@[simp] +lemma hellingerFun_one : hellingerFun 1 = fun x ↦ x * log x + 1 - x := by + ext x + simp [hellingerFun] + +lemma hellingerFun_of_ne_zero_of_ne_one (ha_zero : a ≠ 0) (ha_one : a ≠ 1) : + hellingerFun a = fun x ↦ (a - 1)⁻¹ * (x ^ a - 1 - a * (x - 1)) := by + ext x + simp [hellingerFun, ha_zero, ha_one] + +lemma continuous_hellingerFun (ha_pos : 0 < a) : Continuous (hellingerFun a) := by + by_cases ha_eq : a = 1 + · rw [ha_eq, hellingerFun_one] + fun_prop + rw [hellingerFun, ite_eq_right ha_pos.ne', ite_eq_right ha_eq] + refine continuous_const.mul ?_ + refine ((continuous_rpow_const ha_pos.le).sub continuous_const).sub ?_ + fun_prop + +@[simp] +lemma hellingerFun_apply_one_eq_zero : hellingerFun a 1 = 0 := by + by_cases ha_one : a = 1 + · simp [ha_one, hellingerFun_one] + by_cases ha_zero : a = 0 + · simp [ha_zero, hellingerFun_zero] + simp [hellingerFun, ha_one, ha_zero] + +@[simp] +lemma hellingerFun_apply_zero : hellingerFun a 0 = 1 := by + by_cases ha_zero : a = 0 + · simp [ha_zero, hellingerFun_zero] + by_cases ha_one : a = 1 + · simp [ha_one, hellingerFun_one] + simp only [hellingerFun, ha_zero, ↓reduceIte, ha_one, ne_eq, not_false_eq_true, zero_rpow, + zero_sub, mul_neg, mul_one, sub_neg_eq_add] + rw [add_comm, ← sub_eq_add_neg, inv_mul_cancel₀] + rwa [sub_ne_zero] + +lemma convexOn_hellingerFun (ha_pos : 0 ≤ a) : ConvexOn ℝ (Set.Ici 0) (hellingerFun a) := by + by_cases ha_zero : a = 0 + · refine convexOn_iff_slope_mono_adjacent.mpr ?_ + simp only [convex_Ici, Set.mem_Ici, true_and, hellingerFun_zero, ha_zero] + intro x y z hx _ hxy hyz + simp only [(lt_of_le_of_lt hx hxy).ne', ↓reduceIte, zero_sub, + (gt_trans hyz <| lt_of_le_of_lt hx hxy).ne', sub_self, zero_div, div_nonpos_iff, + Left.nonneg_neg_iff, tsub_le_iff_right, zero_add, Left.neg_nonpos_iff, sub_nonneg] + exact Or.inr ⟨by positivity, by linarith⟩ + replace ha_pos := ha_pos.lt_of_ne fun h ↦ ha_zero h.symm + rcases (lt_trichotomy a 1) with (ha | ha | ha) + · have : hellingerFun a = - (fun x ↦ (1 - a)⁻¹ • (x ^ a - 1 - a * (x - 1))) := by + ext x + rw [Pi.neg_apply, hellingerFun_of_ne_zero_of_ne_one ha_pos.ne' ha.ne, smul_eq_mul, ← neg_mul, + neg_inv, neg_sub] + rw [this] + refine (((Real.concaveOn_rpow ha_pos.le ha.le).sub + (convexOn_const _ (convex_Ici 0))).sub ?_).smul (by simp [ha.le]) |>.neg + exact ((convexOn_id (convex_Ici 0)).sub (concaveOn_const _ (convex_Ici 0))).smul ha_pos.le + · simp only [hellingerFun, ha, one_ne_zero, ↓reduceIte] + exact convexOn_klFun + · simp_rw [hellingerFun, ← smul_eq_mul, ite_eq_right ha_pos.ne', ite_eq_right ha.ne'] + refine ((convexOn_rpow ha.le).sub (concaveOn_const _ (convex_Ici 0))).sub ?_ |>.smul + (by simp [ha.le]) + exact ((concaveOn_id (convex_Ici 0)).sub (convexOn_const _ (convex_Ici 0))).smul ha_pos.le + +lemma hasDerivAt_hellingerFun (a : ℝ) {x : ℝ} (hx : x ≠ 0) : + HasDerivAt (hellingerFun a) + (if a = 0 then 0 + else if a = 1 then log x + else (a - 1)⁻¹ * a * (x ^ (a - 1) - 1)) x := by + split_ifs with h1 h2 + · rw [h1, hellingerFun_zero] + refine HasDerivAt.congr_of_eventuallyEq (f := fun _ ↦ 0) (hasDerivAt_const _ _) ?_ + filter_upwards [eventually_ne_nhds hx] with y hy + simp [hy] + · simp only [h2, hellingerFun_one] + exact hasDerivAt_klFun hx + · rw [hellingerFun_of_ne_zero_of_ne_one h1 h2, mul_assoc] + refine HasDerivAt.const_mul _ ?_ + rw [mul_sub] + refine HasDerivAt.sub ?_ ?_ + · exact (Real.hasDerivAt_rpow_const (Or.inl hx)).sub_const _ + · exact ((hasDerivAt_id x).sub_const _).const_mul _ + +lemma rightDeriv_hellingerFun (a : ℝ) {x : ℝ} (hx : x ≠ 0) : + derivWithin (hellingerFun a) (Ioi x) x = + if a = 0 then 0 + else if a = 1 then log x + else (a - 1)⁻¹ * a * (x ^ (a - 1) - 1) := + (hasDerivAt_hellingerFun a hx).hasDerivWithinAt.derivWithin (uniqueDiffWithinAt_Ioi x) + +@[simp] +lemma rightDeriv_hellingerFun_one : + derivWithin (hellingerFun a) (Ioi 1) 1 = 0 := by + simp [rightDeriv_hellingerFun] + +lemma hellingerFun_nonneg (ha : 0 ≤ a) {x : ℝ} (hx : 0 ≤ x) : 0 ≤ hellingerFun a x := by + rcases hx.eq_or_lt with rfl | hx; · simp + have h_cvx := (convexOn_hellingerFun ha).subset (Set.Ioi_subset_Ici le_rfl) (convex_Ioi _) + have h_one : (1 : ℝ) ∈ interior (Set.Ioi 0) := by simp + simpa [hellingerFun_apply_one_eq_zero] using + h_cvx.isMinOn_of_rightDeriv_eq_zero h_one rightDeriv_hellingerFun_one hx + +lemma tendsto_rightDeriv_hellingerFun_atTop_of_one_lt (ha : 1 < a) : + Tendsto (fun x ↦ derivWithin (hellingerFun a) (Ioi x) x) atTop atTop := by + have : (fun x ↦ derivWithin (hellingerFun a) (Ioi x) x) + =ᶠ[atTop] fun x ↦ (a - 1)⁻¹ * a * (x ^ (a - 1) - 1) := by + filter_upwards [eventually_ne_atTop 0] with x hx + rw [rightDeriv_hellingerFun _ hx] + simp [(zero_lt_one.trans ha).ne', ha.ne'] + rw [tendsto_congr' this] + simp_rw [mul_assoc, tendsto_const_mul_atTop_iff] + have h1 : ¬ a < 0 := by linarith + have h2 : ¬ a < 1 := by linarith + simp only [inv_pos, sub_pos, ha, zero_lt_one.trans ha, true_and, h1, false_and, or_false, + inv_neg'', sub_neg, h2] + refine tendsto_atTop_add_const_right atTop (-1) ?_ + exact tendsto_rpow_atTop (by linarith) + +lemma tendsto_rightDeriv_hellingerFun_atTop_of_lt_one (ha : a < 1) : + Tendsto (fun x ↦ derivWithin (hellingerFun a) (Ioi x) x) atTop (𝓝 (a * (1 - a)⁻¹)) := by + by_cases ha_zero : a = 0 + · simp only [ha_zero, sub_zero, inv_one, mul_one] + have : (fun x ↦ derivWithin (hellingerFun 0) (Ioi x) x) =ᶠ[atTop] fun _ ↦ 0 := by + filter_upwards [eventually_ne_atTop 0] with x hx + rw [rightDeriv_hellingerFun _ hx] + simp + rw [tendsto_congr' this] + exact tendsto_const_nhds + · have : (fun x ↦ derivWithin (hellingerFun a) (Ioi x) x) + =ᶠ[atTop] fun x ↦ (a - 1)⁻¹ * a * (x ^ (a - 1) - 1) := by + filter_upwards [eventually_ne_atTop 0] with x hx + rw [rightDeriv_hellingerFun _ hx] + simp [ha_zero, ha.ne] + rw [tendsto_congr' this] + have h_eq : (fun x ↦ (a - 1)⁻¹ * a * (x ^ (a - 1) - 1)) + = (fun x ↦ a * (1 - x ^ (a - 1)) * (1 - a)⁻¹) := by + ext x + rw [mul_assoc, mul_comm, mul_assoc, mul_assoc] + congr 1 + rw [← neg_sub 1 a, inv_neg, mul_neg, neg_sub, ← neg_mul, neg_sub] + rw [h_eq] + refine Tendsto.mul_const _ ?_ + simp_rw [mul_sub, mul_one] + suffices Tendsto (fun k ↦ a - a * k ^ (a - 1)) atTop (𝓝 (a - a * 0)) by + simpa using this + refine Tendsto.const_sub _ ?_ + refine Tendsto.const_mul _ ?_ + have : (fun (x : ℝ) ↦ x ^ (a - 1)) = (fun x ↦ x ^ (-(1 - a))) := by ext x; simp + rw [this] + exact tendsto_rpow_neg_atTop (by linarith) + +lemma derivAtTop_hellingerFun_of_one_lt (ha : 1 < a) : derivAtTop (hellingerFun a) = ⊤ := + ((convexOn_hellingerFun (zero_le_one.trans ha.le)).subset Ioi_subset_Ici_self + (convex_Ioi 0)).derivAtTop_eq_top_of_tendsto_rightDeriv + (tendsto_rightDeriv_hellingerFun_atTop_of_one_lt ha) + +lemma derivAtTop_hellingerFun_of_one_le (ha : 1 ≤ a) : derivAtTop (hellingerFun a) = ⊤ := by + rcases ha.eq_or_lt with rfl | ha + · rw [hellingerFun_one] + exact convexOn_Ioi_klFun.derivAtTop_eq_top_of_tendsto_rightDeriv tendsto_rightDeriv_klFun_atTop + · exact derivAtTop_hellingerFun_of_one_lt ha + +/-- For `a < 1`, the derivative at infinity of `hellingerFun a` is `a / (1 - a)`. The function is +not convex for `a < 0`, so we compute the limit of `hellingerFun a x / x` directly. -/ +lemma derivAtTop_hellingerFun_of_lt_one (ha : a < 1) : + derivAtTop (hellingerFun a) = (a * (1 - a)⁻¹ : ℝ) := by + refine derivAtTop_of_tendsto (EReal.tendsto_coe.mpr ?_) + by_cases ha_zero : a = 0 + · simp only [ha_zero, zero_mul] + refine tendsto_const_nhds.congr' ?_ + filter_upwards [eventually_gt_atTop 0] with x hx + simp [hx.ne'] + -- for `x > 0`, `hellingerFun a x / x = (a - 1)⁻¹ * (x ^ (a - 1) + (a - 1) * x⁻¹ - a)` + have h_eq : (fun x ↦ (a - 1)⁻¹ * (x ^ (a - 1) + (a - 1) * x⁻¹ - a)) + =ᶠ[atTop] fun x ↦ hellingerFun a x / x := by + filter_upwards [eventually_gt_atTop 0] with x hx + rw [hellingerFun_of_ne_zero_of_ne_one ha_zero ha.ne, rpow_sub_one hx.ne'] + field_simp + ring + have h_lim : Tendsto (fun x : ℝ ↦ (a - 1)⁻¹ * (x ^ (a - 1) + (a - 1) * x⁻¹ - a)) atTop + (𝓝 ((a - 1)⁻¹ * (0 + (a - 1) * 0 - a))) := by + refine ((Tendsto.add ?_ (tendsto_inv_atTop_zero.const_mul _)).sub_const _).const_mul _ + rw [show a - 1 = -(1 - a) by ring] + exact tendsto_rpow_neg_atTop (by linarith) + convert h_lim.congr' h_eq using 2 + rw [← neg_sub 1 a, inv_neg] + ring + +lemma integrable_hellingerFun_iff_integrable_rpow (ha_one : a ≠ 1) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + Integrable (fun x ↦ hellingerFun a ((∂μ/∂ν) x).toReal) ν + ↔ Integrable (fun x ↦ ((∂μ/∂ν) x).toReal ^ a) ν := by + by_cases ha_zero : a = 0 + · simp_rw [ha_zero, hellingerFun_zero_eq_indicator, rpow_zero, integrable_const, iff_true, + ← Set.indicator_comp_right fun x ↦ ((∂μ/∂ν) x).toReal, Set.preimage, Set.mem_singleton_iff, + Pi.one_comp] + refine (integrable_indicator_iff ?_).mpr ?_ + · apply measurableSet_eq_fun <;> fun_prop + · exact integrableOn_const (measure_ne_top ν _) + rw [hellingerFun_of_ne_zero_of_ne_one ha_zero ha_one, integrable_const_mul_iff] + swap; · simp [sub_eq_zero, ha_one] + simp_rw [sub_eq_add_neg, add_assoc, ← sub_eq_add_neg] + rw [integrable_add_iff_integrable_left'] + refine (integrable_const _).add (((Integrable.sub ?_ (integrable_const _)).const_mul _).neg) + exact Measure.integrable_toReal_rnDeriv + +lemma integrable_hellingerFun_rnDeriv_of_lt_one (ha_nonneg : 0 ≤ a) (ha : a < 1) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + Integrable (fun x ↦ hellingerFun a ((∂μ/∂ν) x).toReal) ν := by + rw [integrable_hellingerFun_iff_integrable_rpow ha.ne] + exact integrable_rpow_rnDeriv_of_lt_one ha_nonneg ha + +lemma integral_hellingerFun_of_pos_of_ne_one_of_integrable [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_ne : a ≠ 1) (h_int : Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ a) ν) : + ∫ x, hellingerFun a (μ.rnDeriv ν x).toReal ∂ν + = (a - 1)⁻¹ * ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν + + (ν .univ).toReal + (1 - a)⁻¹ * a * ∫ x, (μ.rnDeriv ν x).toReal ∂ν := by + calc ∫ x, hellingerFun a (μ.rnDeriv ν x).toReal ∂ν + _ = (a - 1)⁻¹ * ∫ x, ((μ.rnDeriv ν x).toReal ^ a - 1 - a * ((μ.rnDeriv ν x).toReal - 1)) ∂ν := by + rw [← integral_const_mul] + simp_rw [hellingerFun_of_ne_zero_of_ne_one ha_pos.ne' ha_ne] + _ = (a - 1)⁻¹ * ∫ x, ((μ.rnDeriv ν x).toReal ^ a + (a - 1) - a * (μ.rnDeriv ν x).toReal) ∂ν := by + congr with x + ring + _ = (a - 1)⁻¹ * ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν + + (ν .univ).toReal + (1 - a)⁻¹ * a * ∫ x, (μ.rnDeriv ν x).toReal ∂ν := by + rw [integral_sub, integral_add, integral_const, smul_eq_mul, mul_comm _ (a - 1), + integral_const_mul, mul_sub, mul_add, ← mul_assoc, ← mul_assoc, inv_mul_cancel₀, one_mul, + sub_eq_add_neg] + · congr + rw [mul_assoc, ← neg_mul, neg_inv, neg_sub, ← mul_assoc] + · rwa [sub_ne_zero] + · exact h_int + · exact integrable_const _ + · exact h_int.add (integrable_const _) + · exact Measure.integrable_toReal_rnDeriv.const_mul _ + +lemma integral_hellingerFun_of_pos_of_ne_one_of_integrable_of_ac + [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_ne : a ≠ 1) (h_int : Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ a) ν) + (hμν : μ ≪ ν) : + ∫ x, hellingerFun a (μ.rnDeriv ν x).toReal ∂ν + = (a - 1)⁻¹ * ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν + + (ν .univ).toReal + (1 - a)⁻¹ * a * (μ .univ).toReal := by + rw [integral_hellingerFun_of_pos_of_ne_one_of_integrable ha_pos ha_ne h_int, + Measure.integral_toReal_rnDeriv hμν, measureReal_def] + +lemma integral_hellingerFun_of_pos_of_lt_one [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_lt : a < 1) : + ∫ x, hellingerFun a (μ.rnDeriv ν x).toReal ∂ν + = (a - 1)⁻¹ * ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν + + (ν .univ).toReal + (1 - a)⁻¹ * a * ∫ x, (μ.rnDeriv ν x).toReal ∂ν := + integral_hellingerFun_of_pos_of_ne_one_of_integrable ha_pos ha_lt.ne + (integrable_rpow_rnDeriv_of_lt_one ha_pos.le ha_lt) + +end HellingerFun + +end ProbabilityTheory diff --git a/Statlib/Divergence/KullbackLeibler/Basic.lean b/Statlib/Divergence/KullbackLeibler/Basic.lean new file mode 100644 index 0000000..fb30323 --- /dev/null +++ b/Statlib/Divergence/KullbackLeibler/Basic.lean @@ -0,0 +1,49 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Statlib.Divergence.KullbackLeibler.KLDivFun +public import Statlib.Divergence.FDiv.Basic +public import Statlib.Divergence.FDiv.Measurable + +/-! +# Kullback-Leibler divergence + +The Kullback-Leibler divergence `klDiv` is defined in Mathlib (`InformationTheory.klDiv`). +This file relates it to the f-divergence for the divergence function `klDivFun`. + +## Main statements + +* `klDiv_eq_fDiv`: `klDiv μ ν = fDiv klDivFun μ ν` +* `measurable_klDiv`: measurability of `a ↦ klDiv (κ a) (η a)` for finite kernels `κ, η`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Real MeasureTheory Filter MeasurableSpace Set InformationTheory + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} + +lemma klDiv_eq_fDiv [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + klDiv μ ν = fDiv klDivFun μ ν := by + classical + rw [klDiv_eq_lintegral_klFun, fDiv_of_derivAtTop_eq_top derivAtTop_klDivFun, + lintegral_klDivFun_rnDeriv] + +lemma measurable_klDiv {β : Type*} [MeasurableSpace β] [CountableOrCountablyGenerated α β] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + Measurable (fun a ↦ klDiv (κ a) (η a)) := by + simp_rw [klDiv_eq_fDiv] + exact measurable_fDiv _ _ + +end ProbabilityTheory diff --git a/Statlib/Divergence/KullbackLeibler/CondKL.lean b/Statlib/Divergence/KullbackLeibler/CondKL.lean new file mode 100644 index 0000000..ad69cd3 --- /dev/null +++ b/Statlib/Divergence/KullbackLeibler/CondKL.lean @@ -0,0 +1,278 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.InformationTheory.KullbackLeibler.ChainRule +public import Mathlib.Probability.Kernel.Disintegration.StandardBorel +public import Statlib.Divergence.KullbackLeibler.Basic +public import Statlib.ForMathlib.InformationTheory.KullbackLeibler.Basic +public import Statlib.Divergence.FDiv.CondFDiv +public import Statlib.Divergence.FDiv.CompProd + +/-! +# Conditional Kullback-Leibler divergence + +## Main definitions + +* `condKL κ η μ`: the conditional Kullback-Leibler divergence of the kernels `κ` and `η` with + respect to `μ`, `∫⁻ a, klDiv (κ a) (η a) ∂μ`. + +## Main statements + +* `condKL_ne_top_iff`: finiteness of the conditional divergence. +* `klDiv_compProd_eq_add_condKL`, `klDiv_fst_add_condKL`: chain rules for the Kullback-Leibler + divergence. +* `condKL_compProd_kernel`: chain rule for the conditional divergence. +* `klDiv_prod_two`, `klDiv_pi`: tensorization. + +These results need `CountableOrCountablyGenerated` assumptions to express the conditional +divergence through Radon-Nikodym derivatives of kernels, except for the tensorization results, +which follow from Mathlib's chain rule `InformationTheory.klDiv_compProd_eq_add`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Real MeasureTheory Filter MeasurableSpace InformationTheory + +open scoped ENNReal NNReal Topology BigOperators + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} + +section Conditional + +variable {β γ : Type*} {mβ : MeasurableSpace β} {mγ : MeasurableSpace γ} {κ η : Kernel α β} + +/-- Equivalence between two possible versions of the first condition for the finiteness of the +conditional KL divergence, the second version is the preferred one. -/ +lemma klDiv_ae_ne_top_iff : (∀ᵐ a ∂μ, klDiv (κ a) (η a) ≠ ∞) ↔ + (∀ᵐ a ∂μ, κ a ≪ η a) ∧ (∀ᵐ a ∂μ, Integrable (llr (κ a) (η a)) (κ a)) := by + simp_rw [klDiv_ne_top_iff, eventually_and] + +open Classical in +/-- +Kullback-Leibler divergence between two kernels κ and η conditional to a measure μ. +It is defined as KL(κ, η | μ) := ∫ x, KL(κ x, η x) dμ. +-/ +noncomputable +def condKL (κ η : Kernel α β) (μ : Measure α) : ℝ≥0∞ := + ∫⁻ a, klDiv (κ a) (η a) ∂μ + +lemma condKL_eq_condFDiv [IsFiniteKernel κ] [IsFiniteKernel η] : + condKL κ η μ = condFDiv klDivFun κ η μ := by + simp_rw [condKL, condFDiv, klDiv_eq_fDiv] + +section CondKLEq + +variable [CountableOrCountablyGenerated α β] [IsFiniteKernel κ] [IsFiniteKernel η] + +@[simp] +lemma condKL_of_not_ae_ne_top (h : ¬ ∀ᵐ a ∂μ, klDiv (κ a) (η a) ≠ ∞) : + condKL κ η μ = ∞ := by + rw [condKL] + by_contra h' + exact h ((ae_lt_top (measurable_klDiv _ _) h').mono fun x hx ↦ hx.ne) + +@[simp] +lemma condKL_of_not_ae_ac (h : ¬ ∀ᵐ a ∂μ, κ a ≪ η a) : + condKL κ η μ = ∞ := by + rw [condKL_eq_condFDiv] + exact condFDiv_of_not_ae_ac derivAtTop_klDivFun h + +lemma condKL_ne_top_iff : + condKL κ η μ ≠ ∞ + ↔ (∀ᵐ a ∂μ, κ a ≪ η a) ∧ (∀ᵐ a ∂μ, Integrable (llr (κ a) (η a)) (κ a)) + ∧ Integrable (fun a ↦ (klDiv (κ a) (η a)).toReal) μ := by + rw [← and_assoc, ← klDiv_ae_ne_top_iff] + refine ⟨fun h ↦ ?_, fun ⟨h_ae, h_int⟩ ↦ ?_⟩ + · have h_ae : ∀ᵐ a ∂μ, klDiv (κ a) (η a) ≠ ∞ := + (ae_lt_top (measurable_klDiv κ η) h).mono fun _ ha ↦ ha.ne + exact ⟨h_ae, (integrable_toReal_iff (measurable_klDiv κ η).aemeasurable h_ae).mpr h⟩ + · exact (integrable_toReal_iff (measurable_klDiv κ η).aemeasurable h_ae).mp h_int + +lemma condKL_eq_top_iff : + condKL κ η μ = ∞ + ↔ ¬ (∀ᵐ a ∂μ, κ a ≪ η a) ∨ ¬ (∀ᵐ a ∂μ, Integrable (llr (κ a) (η a)) (κ a)) + ∨ ¬ Integrable (fun a ↦ (klDiv (κ a) (η a)).toReal) μ := by + rw [← not_iff_not, ← ne_eq, condKL_ne_top_iff] + tauto + +lemma toReal_condKL_eq_integral (h : condKL κ η μ ≠ ∞) : + (condKL κ η μ).toReal = ∫ a, (klDiv (κ a) (η a)).toReal ∂μ := by + rw [condKL, integral_toReal (measurable_klDiv _ _).aemeasurable] + exact ae_lt_top (measurable_klDiv _ _) h + +end CondKLEq + +@[simp] +lemma condKL_self (κ : Kernel α β) (μ : Measure α) [IsFiniteKernel κ] : condKL κ κ μ = 0 := by + simp [condKL] + +@[simp] +lemma condKL_zero_left [IsFiniteKernel η] : + condKL 0 η μ = ∫⁻ a, η a Set.univ ∂μ := by simp [condKL_eq_condFDiv] + +lemma condKL_zero_right [CountableOrCountablyGenerated α β] + [IsFiniteKernel κ] (h : ∃ᵐ a ∂μ, κ a ≠ 0) : + condKL κ 0 μ = ∞ := by + rw [condKL_of_not_ae_ac] + simp [h] + +@[simp] +lemma condKL_zero_measure : condKL κ η 0 = 0 := by simp [condKL] + +@[simp] +lemma condKL_isEmpty_left [IsEmpty α] : condKL κ η μ = 0 := by simp [condKL] + +@[simp] +lemma condKL_const {ξ : Measure β} [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + condKL (Kernel.const β μ) (Kernel.const β ν) ξ = (klDiv μ ν) * ξ .univ := by + rw [condKL_eq_condFDiv, klDiv_eq_fDiv] + exact condFDiv_const + +section CompProd + +/-- The conditional KL divergence with respect to a composition-product `μ ⊗ₘ ξ` is an iterated +conditional KL divergence. -/ +lemma condKL_measure_compProd [CountableOrCountablyGenerated (α × β) γ] [SFinite μ] + {ξ : Kernel α β} [IsSFiniteKernel ξ] {κ η : Kernel (α × β) γ} [IsFiniteKernel κ] + [IsFiniteKernel η] : + condKL κ η (μ ⊗ₘ ξ) = ∫⁻ x, condKL (κ.sectR x) (η.sectR x) (ξ x) ∂μ := by + simp_rw [condKL_eq_condFDiv, condFDiv_measure_compProd] + +lemma klDiv_compProd_eq_condKL [CountableOrCountablyGenerated α β] + [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] : + klDiv (μ ⊗ₘ κ) (μ ⊗ₘ η) = condKL κ η μ := by + rw [klDiv_eq_fDiv, condKL_eq_condFDiv] + exact fDiv_compProd_right μ κ η + +section ChainRule + +/-- The **chain rule** for the KL divergence. -/ +lemma klDiv_compProd_eq_add_condKL [CountableOrCountablyGenerated α β] + [IsMarkovKernel κ] [IsMarkovKernel η] [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + klDiv (μ ⊗ₘ κ) (ν ⊗ₘ η) = klDiv μ ν + condKL κ η μ := by + rw [klDiv_compProd_eq_add, klDiv_compProd_eq_condKL] + +/-- The **chain rule** for the KL divergence. -/ +lemma klDiv_fst_add_condKL [StandardBorelSpace β] [Nonempty β] {μ ν : Measure (α × β)} + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + klDiv μ.fst ν.fst + condKL μ.condKernel ν.condKernel μ.fst = klDiv μ ν := by + rw [← klDiv_compProd_eq_add_condKL, μ.disintegrate, ν.disintegrate] + +/-- The **chain rule** for the conditional KL divergence. -/ +lemma condKL_compProd_kernel [CountableOrCountablyGenerated α β] + [CountableOrCountablyGenerated (α × β) γ] {κ₁ η₁ : Kernel α β} + {κ₂ η₂ : Kernel (α × β) γ} [IsFiniteKernel κ₁] [IsFiniteKernel η₁] [IsMarkovKernel κ₂] + [IsMarkovKernel η₂] [SFinite μ] : + condKL (κ₁ ⊗ₖ κ₂) (η₁ ⊗ₖ η₂) μ = condKL κ₁ η₁ μ + condKL κ₂ η₂ (μ ⊗ₘ κ₁) := by + rcases isEmpty_or_nonempty α with hα | hα + · simp + have := countableOrCountablyGenerated_right_of_prod_left_of_nonempty (α := α) (β := β) (γ := γ) + rw [condKL_measure_compProd, condKL, condKL, ← lintegral_add_left (measurable_klDiv _ _)] + refine lintegral_congr fun a ↦ ?_ + rw [Kernel.compProd_apply_eq_compProd_sectR, Kernel.compProd_apply_eq_compProd_sectR, + klDiv_compProd_eq_add_condKL] + +end ChainRule + +end CompProd + +end Conditional + +section DataProcessingInequality + +variable {β : Type*} {mβ : MeasurableSpace β} {κ η : Kernel α β} + +lemma klDiv_comp_left_le [CountableOrCountablyGenerated α β] + (μ : Measure α) [IsFiniteMeasure μ] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + klDiv (κ ∘ₘ μ) (η ∘ₘ μ) ≤ condKL κ η μ := by + rw [klDiv_eq_fDiv, condKL_eq_condFDiv] + exact fDiv_comp_left_le μ κ η + +end DataProcessingInequality + +section Tensorization + +variable {β : Type*} {mβ : MeasurableSpace β} + +/-- The Kullback-Leibler divergence between two products with the same first factor. -/ +lemma klDiv_prod_right [IsFiniteMeasure μ] {ξ ψ : Measure β} [IsFiniteMeasure ξ] + [IsFiniteMeasure ψ] : + klDiv (μ.prod ξ) (μ.prod ψ) = μ .univ * klDiv ξ ψ := by + rcases eq_zero_or_neZero μ with rfl | hμ + · simp + have hμ0 : μ .univ ≠ 0 := by simp [NeZero.ne μ] + have h_prod (ρ : Measure β) [SFinite ρ] : μ.prod ρ = μ .univ • ((μ .univ)⁻¹ • μ).prod ρ := by + rw [← Measure.prod_smul_left, smul_smul, ENNReal.mul_inv_cancel hμ0 (measure_ne_top _ _), + one_smul] + have h_emb : MeasurableEmbedding (Prod.swap : β × α → α × β) := + MeasurableEquiv.prodComm.measurableEmbedding + rw [h_prod ξ, h_prod ψ, klDiv_smul_same' (measure_ne_top μ .univ), ← Measure.prod_swap (μ := ξ), + ← Measure.prod_swap (μ := ψ), klDiv_eq_fDiv, klDiv_eq_fDiv, + fDiv_map_measurableEmbedding h_emb, fDiv_prod_left] + +lemma klDiv_prod_two' {ξ ψ : Measure β} [IsProbabilityMeasure ξ] [IsProbabilityMeasure ψ] + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + klDiv (μ.prod ξ) (ν.prod ψ) = klDiv μ ν + klDiv ξ ψ * (μ .univ) := by + rw [← Measure.compProd_const, ← Measure.compProd_const, klDiv_compProd_eq_add, + Measure.compProd_const, Measure.compProd_const, klDiv_prod_right, mul_comm] + +/-- Tensorization property for KL divergence -/ +lemma klDiv_prod_two {ξ ψ : Measure β} [IsProbabilityMeasure ξ] [IsProbabilityMeasure ψ] + [IsProbabilityMeasure μ] [IsFiniteMeasure ν] : + klDiv (μ.prod ξ) (ν.prod ψ) = klDiv μ ν + klDiv ξ ψ := by + simp only [klDiv_prod_two', measure_univ, mul_one] + +lemma klDiv_pi {ι : Type*} [hι : Fintype ι] {β : ι → Type*} [∀ i, MeasurableSpace (β i)] + {μ ν : (i : ι) → Measure (β i)} + [∀ i, IsProbabilityMeasure (μ i)] [∀ i, IsProbabilityMeasure (ν i)] : + klDiv (Measure.pi μ) (Measure.pi ν) = ∑ i, klDiv (μ i) (ν i) := by + refine Fintype.induction_empty_option (P := fun ι ↦ ∀ {β : ι → Type u_4} + [(i : ι) → MeasurableSpace (β i)] + {μ ν : (i : ι) → Measure (β i)} [∀ (i : ι), IsProbabilityMeasure (μ i)] + [∀ (i : ι), IsProbabilityMeasure (ν i)], + klDiv (Measure.pi μ) (Measure.pi ν) = ∑ i : ι, klDiv (μ i) (ν i) ) ?_ ?_ ?_ ι + · intro ι ι' hι' e h β _ μ ν _ _ + let hι : Fintype ι := Fintype.ofEquiv _ e.symm + specialize h (β := fun i ↦ β (e i)) (μ := fun i ↦ μ (e i)) (ν := fun i ↦ ν (e i)) + rw [Fintype.sum_equiv e.symm _ (fun i ↦ klDiv (μ (e i)) (ν (e i))) + (fun i ↦ by rw [Equiv.apply_symm_apply]), ← h, klDiv_eq_fDiv, klDiv_eq_fDiv] + let e_meas : ((b : ι) → β (e b)) ≃ᵐ ((a : ι') → β a) := + MeasurableEquiv.piCongrLeft (fun i ↦ β i) e + have me := MeasurableEquiv.measurableEmbedding e_meas.symm + convert (fDiv_map_measurableEmbedding me).symm + <;> try {rw [← Measure.pi_map_piCongrLeft e, MeasurableEquiv.map_symm_map]} + <;> infer_instance + · intro β _ μ ν _ _ + rw [Measure.pi_of_empty, Measure.pi_of_empty, klDiv_self, Finset.univ_eq_empty, + Finset.sum_empty] + · intro ι hι ind_h β _ μ ν _ _ + specialize ind_h (β := fun i ↦ β i) (μ := fun i ↦ μ i) (ν := fun i ↦ ν i) + have h : klDiv (Measure.pi μ) (Measure.pi ν) = klDiv ((Measure.pi (fun (i : ι) ↦ μ i)).prod + (μ none)) ((Measure.pi (fun (i : ι) ↦ ν i)).prod (ν none)) := by + rw [klDiv_eq_fDiv, klDiv_eq_fDiv] + let e_meas : ((i : ι) → β (some i)) × β none ≃ᵐ ((i : Option ι) → β i) := + MeasurableEquiv.piOptionEquivProd β |>.symm + have me := MeasurableEquiv.measurableEmbedding e_meas + convert fDiv_map_measurableEmbedding me + <;> try {exact Measure.pi_map_piOptionEquivProd _ |>.symm} <;> infer_instance + rw [Fintype.sum_option, h, add_comm, ← ind_h] + convert klDiv_prod_two <;> infer_instance + +lemma klDiv_pi_const {ι : Type*} [hι : Fintype ι] + [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + klDiv (Measure.pi (fun (_ : ι) ↦ μ)) (Measure.pi (fun (_ : ι) ↦ ν)) = hι.card * klDiv μ ν := by + rw [klDiv_pi, Finset.sum_const, (Finset.card_eq_iff_eq_univ _).mpr rfl, nsmul_eq_mul] + +end Tensorization + +end ProbabilityTheory diff --git a/Statlib/Divergence/KullbackLeibler/KLDivFun.lean b/Statlib/Divergence/KullbackLeibler/KLDivFun.lean new file mode 100644 index 0000000..40974f5 --- /dev/null +++ b/Statlib/Divergence/KullbackLeibler/KLDivFun.lean @@ -0,0 +1,99 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.InformationTheory.KullbackLeibler.Basic +public import Statlib.Divergence.FDiv.DivFunction.Conj +public import Statlib.Divergence.FDiv.DivFunction.OfReal + +/-! +# The divergence function of the Kullback-Leibler divergence + +`klDivFun` is the `DivFunction` obtained from Mathlib's `InformationTheory.klFun`, +`x ↦ x * log x + 1 - x`. + +## Main definitions + +* `klDivFun`: the `DivFunction` of the Kullback-Leibler divergence. + +## Main statements + +* `klDivFun_apply`: `klDivFun x = ENNReal.ofReal (x * log x + 1 - x)` for `x ≠ ∞`. +* `derivAtTop_klDivFun`: the derivative at infinity of `klDivFun` is `∞`. +* `strictConvexOn_klDivFun`: the real function of `klDivFun` is strictly convex on `[0, ∞)`. +* `conj_klDivFun_ofReal`: the conjugate of `klDivFun` is `s ↦ s - 1 - log s` on `(0, ∞)`. +* `lintegral_klDivFun_rnDeriv`: `∫⁻ x, klDivFun (∂μ/∂ν x) ∂ν = ∫⁻ x, ofReal (klFun (∂μ/∂ν x)) ∂ν`, + which is used to identify `fDiv klDivFun` with Mathlib's `klDiv`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Real MeasureTheory Filter MeasurableSpace Set InformationTheory + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} + +section KLDivFun + +/-- The `DivFunction` of the Kullback-Leibler divergence, `x ↦ x * log x + 1 - x` on `[0, ∞)`. -/ +noncomputable +def klDivFun : DivFunction := DivFunction.ofReal klFun convexOn_Ioi_klFun klFun_one + +@[simp] lemma klDivFun_apply_top : klDivFun ∞ = ∞ := by + rw [klDivFun, DivFunction.ofReal_apply_top_of_tendsto_atTop] + exact tendsto_klFun_atTop + +lemma klDivFun_apply {x : ℝ≥0∞} (hx : x ≠ ∞) : + klDivFun x = ENNReal.ofReal (x.toReal * log x.toReal + 1 - x.toReal) := by + by_cases hx0 : x = 0 + · rw [klDivFun, hx0, DivFunction.ofReal_apply_zero_of_continuousWithinAt] + · simp [klFun_zero] + · exact continuous_klFun.continuousWithinAt + · rw [klDivFun, DivFunction.ofReal_apply hx0 hx, klFun_apply] + +@[simp] +lemma klDivFun_zero : klDivFun 0 = 1 := by simp [klDivFun_apply ENNReal.zero_ne_top] + +@[simp] +lemma klDivFun_realFun_apply {x : ℝ} (hx : 0 ≤ x) : klDivFun.realFun x = x * log x + 1 - x := by + rw [DivFunction.realFun, klDivFun_apply ENNReal.ofReal_ne_top, ENNReal.toReal_ofReal hx, + ENNReal.toReal_ofReal] + exact klFun_nonneg hx + +@[simp] lemma derivAtTop_klDivFun : klDivFun.derivAtTop = ∞ := + DivFunction.derivAtTop_ofReal_of_tendsto_atTop tendsto_rightDeriv_klFun_atTop + +lemma eqOn_klDivFun_realFun : EqOn klDivFun.realFun (fun x ↦ x * log x + 1 - x) (Ici 0) := + fun _ hx ↦ klDivFun_realFun_apply hx + +lemma strictConvexOn_klDivFun : StrictConvexOn ℝ (Ici 0) klDivFun.realFun := + StrictConvexOn.congr strictConvexOn_klFun eqOn_klDivFun_realFun.symm + +lemma lintegral_klDivFun_rnDeriv [SigmaFinite μ] : + ∫⁻ x, klDivFun (μ.rnDeriv ν x) ∂ν = ∫⁻ x, ENNReal.ofReal (klFun (μ.rnDeriv ν x).toReal) ∂ν := by + refine lintegral_congr_ae ?_ + filter_upwards [μ.rnDeriv_ne_top ν] with x hx + rw [klDivFun_apply hx, klFun_apply] + +/-- The conjugate of `klDivFun` is `s ↦ s - 1 - log s` on `(0, ∞)`. -/ +lemma conj_klDivFun_ofReal {s : ℝ} (hs : 0 < s) : + klDivFun.conj (ENNReal.ofReal s) = ENNReal.ofReal (s - 1 - log s) := by + rw [DivFunction.conj_of_ne_zero (ENNReal.ofReal_pos.2 hs).ne', ← ENNReal.ofReal_inv_of_pos hs, + klDivFun_apply ENNReal.ofReal_ne_top, ENNReal.toReal_ofReal (inv_nonneg.2 hs.le), + ← ENNReal.ofReal_mul hs.le, log_inv] + congr 1 + field_simp + ring + +end KLDivFun + +end ProbabilityTheory diff --git a/Statlib/Divergence/Renyi/Basic.lean b/Statlib/Divergence/Renyi/Basic.lean new file mode 100644 index 0000000..0214fcd --- /dev/null +++ b/Statlib/Divergence/Renyi/Basic.lean @@ -0,0 +1,804 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Statlib.Divergence.Hellinger.Basic +public import Statlib.ForMathlib.InformationTheory.KullbackLeibler.Basic +public import Mathlib.Probability.Moments.Basic +public import Mathlib.Basic.Real.Sign +public import Mathlib.Analysis.SpecialFunctions.Log.ENNRealLog + +/-! +# Rényi divergence + +## Main definitions + +* `renyiDiv a μ ν`: the Rényi divergence of order `a` between finite measures. It is the Rényi + divergence of the normalized measures `(μ univ)⁻¹ • μ` and `(ν univ)⁻¹ • ν`, defined from the + Hellinger divergence for `a ∉ {0, 1}` and separately for `a = 0` and `a = 1` (where it is the + Kullback-Leibler divergence of the normalized measures). + +## Main statements + +* `renyiDiv_zero`, `renyiDiv_one`: the special cases. +* `renyiDiv_smul_left`, `renyiDiv_smul_right`: invariance under scaling of the measures. +* `renyiDiv_eq_top_iff_mutuallySingular_of_lt_one`: for `a < 1`, the divergence is infinite iff the + measures are mutually singular. +* `renyiDiv_comp_le_compProd`, `renyiDiv_comp_right_le`: data-processing inequalities. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Real MeasureTheory Filter MeasurableSpace InformationTheory + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} {μ ν : Measure α} {a : ℝ} + +/-- Weighted average `(1 - a) * ν univ + a * μ univ` of the masses of `μ` and `ν`, as a real +number. -/ +noncomputable +abbrev avgMass (a : ℝ) (μ ν : Measure α) : ℝ := (1 - a) * (ν .univ).toReal + a * (μ .univ).toReal + +lemma avgMass_nonneg_of_lt_one (ha_nonneg : 0 ≤ a) (ha_le : a ≤ 1) : + 0 ≤ avgMass a μ ν := + add_nonneg (mul_nonneg (sub_nonneg_of_le ha_le) ENNReal.toReal_nonneg) + (mul_nonneg ha_nonneg ENNReal.toReal_nonneg) + +open Classical in +/-- Rényi divergence of order `a` between finite measures. It is the Rényi divergence of the +normalized measures `(μ univ)⁻¹ • μ` and `(ν univ)⁻¹ • ν` (see `renyiDiv_smul_left` and +`renyiDiv_smul_right`): for `a ∉ {0, 1}`, +`Rₐ(μ, ν) = (a - 1)⁻¹ * (log (∫ x, ((∂μ/∂ν) x) ^ a ∂ν) - log (μ(univ) ^ a * ν(univ) ^ (1 - a)))`, +which is the usual `(a - 1)⁻¹ * log (∫ x, ((∂μ/∂ν) x) ^ a ∂ν)` for probability measures. +The integral is written as `(1 - a) * ν(univ) + a * μ(univ) + (a - 1) * Hₐ(μ, ν)` in terms of the +Hellinger divergence, which makes the Rényi divergence a monotone function of the Hellinger +divergence for fixed masses. For `a = 1` it is the Kullback-Leibler divergence of the normalized +measures and for `a = 0` it is `- log (ν {∂μ/∂ν > 0} / ν(univ))`. +We use ENNReal.log instead of Real.log, because it is monotone on `ℝ≥0∞`, while the real log is +monotone only on `(0, ∞)` (`Real.log 0 = 0`). This allows us to transfer inequalities from the +Hellinger divergence to the Rényi divergence. -/ +noncomputable def renyiDiv (a : ℝ) (μ ν : Measure α) : ℝ≥0∞ := + if a = 0 then (- ENNReal.log (ν {x | 0 < (∂μ/∂ν) x} / ν .univ)).toENNReal + else if a = 1 then klDiv ((μ .univ)⁻¹ • μ) ((ν .univ)⁻¹ • ν) + else ((a - 1)⁻¹ * ENNReal.log + (((avgMass a μ ν : EReal) + (a - 1) * (hellingerDiv a μ ν)).toENNReal) + - (a - 1)⁻¹ * (a * Real.log (μ .univ).toReal + + (1 - a) * Real.log (ν .univ).toReal)).toENNReal + +lemma avgMass_add_mul_hellingerDiv_eq_ofReal (h : hellingerDiv a μ ν ≠ ∞) : + (avgMass a μ ν : EReal) + (a - 1) * (hellingerDiv a μ ν) + = (avgMass a μ ν + (a - 1) * (hellingerDiv a μ ν).toReal : ℝ) := by + rw [← EReal.coe_ennreal_toReal h] + norm_cast + +lemma avgMass_add_mul_hellingerDiv_eq_top [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_one : a ≠ 1) (h : hellingerDiv a μ ν = ∞) : + (avgMass a μ ν : EReal) + (a - 1) * (hellingerDiv a μ ν) = ⊤ := by + have ha_lt : 1 < a := by + by_contra ha + exact hellingerDiv_ne_top_of_lt_one (lt_of_le_of_ne (not_lt.mp ha) ha_one) _ _ h + rw [h] + norm_cast + have : (((a - 1) : ℝ) : EReal) * ⊤ = ⊤ := by + simp only [EReal.coe_sub, EReal.coe_one, EReal.mul_eq_top, not_top_lt, and_false, top_ne_bot, + EReal.zero_lt_top, and_true, false_or] + right + exact mod_cast sub_pos_of_lt ha_lt + rw [this, EReal.add_top_of_ne_bot] + exact EReal.coe_ne_bot _ + +lemma avgMass_add_mul_hellingerDiv_nonneg (ha_pos : 0 < a) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + 0 ≤ (avgMass a μ ν : EReal) + (a - 1) * (hellingerDiv a μ ν) := by + by_cases ha_one : a = 1 + · simp only [ha_one, EReal.coe_add, sub_self, zero_mul, EReal.coe_zero, one_mul, ne_eq, + measure_ne_top, not_false_eq_true, EReal.coe_ennreal_toReal, zero_add, EReal.coe_one, + hellingerDiv_one] + rw [EReal.sub_self] + · simp only [zero_mul, add_zero] + exact EReal.coe_ennreal_nonneg _ + · exact EReal.coe_ne_top _ + · exact EReal.coe_ne_bot _ + by_cases h_top : hellingerDiv a μ ν = ∞ + · rw [avgMass_add_mul_hellingerDiv_eq_top ha_one h_top] + simp + · rw [avgMass_add_mul_hellingerDiv_eq_ofReal h_top] + norm_cast + rw [mul_hellingerDiv_add_meas_eq_integral ha_pos ha_one h_top] + exact integral_rpow_rnDeriv_nonneg + +lemma avgMass_add_mul_hellingerDiv_nonneg' [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (h_top : hellingerDiv a μ ν ≠ ∞) : + 0 ≤ avgMass a μ ν + (a - 1) * (hellingerDiv a μ ν).toReal := by + have h := avgMass_add_mul_hellingerDiv_nonneg ha_pos (μ := μ) (ν := ν) + rw [← EReal.coe_ennreal_toReal h_top] at h + norm_cast at h + +lemma avgMass_add_mul_hellingerDiv_nonneg'_of_lt_one (ha_pos : 0 < a) (ha_lt : a < 1) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + 0 ≤ avgMass a μ ν + (a - 1) * (hellingerDiv a μ ν).toReal := by + by_cases h_top : hellingerDiv a μ ν = ∞ + · simp only [h_top, ENNReal.toReal_top, mul_zero, add_zero] + exact avgMass_nonneg_of_lt_one ha_pos.le ha_lt.le + · exact avgMass_add_mul_hellingerDiv_nonneg' ha_pos h_top + +lemma avgMass_add_mul_hellingerDiv_eq_zero_iff_mutuallySingular' + [IsFiniteMeasure μ] [IsFiniteMeasure ν] (ha_pos : 0 < a) (ha_lt : a < 1) : + avgMass a μ ν + (a - 1) * (hellingerDiv a μ ν).toReal = 0 ↔ μ ⟂ₘ ν := by + rw [← toReal_hellingerDiv_eq_add_measure_univ_iff_of_lt_one ha_pos ha_lt] + have ha : 1 - a ≠ 0 := sub_ne_zero_of_ne ha_lt.ne' + rw [add_eq_zero_iff_eq_neg, ← neg_mul, neg_sub, avgMass, ← inv_mul_eq_iff_eq_mul₀ ha, mul_add, + ← mul_assoc, ← mul_assoc, inv_mul_cancel₀ ha, one_mul, mul_comm _ a, eq_comm] + +lemma avgMass_add_mul_hellingerDiv_eq_zero_iff_mutuallySingular + [IsFiniteMeasure μ] [IsFiniteMeasure ν] (ha_pos : 0 < a) (ha_lt : a < 1) : + (avgMass a μ ν : EReal) + (a - 1) * (hellingerDiv a μ ν) = 0 ↔ μ ⟂ₘ ν := by + rw [avgMass_add_mul_hellingerDiv_eq_ofReal] + swap; · exact hellingerDiv_ne_top_of_lt_one ha_lt _ _ + norm_cast + exact avgMass_add_mul_hellingerDiv_eq_zero_iff_mutuallySingular' ha_pos ha_lt + +lemma avgMass_add_mul_hellingerDiv_ne_zero_of_one_lt + [NeZero μ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_lt : 1 < a) (h : hellingerDiv a μ ν ≠ ∞) : + avgMass a μ ν + (a - 1) * (hellingerDiv a μ ν).toReal ≠ 0 := by + have h' := toReal_hellingerDiv_ne_add_measure_univ_of_one_lt ha_lt h + have ha : 1 - a ≠ 0 := sub_ne_zero_of_ne ha_lt.ne + rwa [ne_eq, add_eq_zero_iff_eq_neg, ← neg_mul, neg_sub, avgMass, ← inv_mul_eq_iff_eq_mul₀ ha, + mul_add, ← mul_assoc, ← mul_assoc, inv_mul_cancel₀ ha, one_mul, mul_comm _ a, eq_comm] + +open Classical in +@[simp] +lemma renyiDiv_zero (μ ν : Measure α) : + renyiDiv 0 μ ν = (- ENNReal.log (ν {x | 0 < (∂μ/∂ν) x} / ν .univ)).toENNReal := + ite_eq_left rfl + +@[simp] +lemma renyiDiv_one (μ ν : Measure α) : + renyiDiv 1 μ ν = klDiv ((μ .univ)⁻¹ • μ) ((ν .univ)⁻¹ • ν) := by + rw [renyiDiv, ite_eq_right one_ne_zero, ite_eq_left rfl] + +lemma renyiDiv_one_of_isProbabilityMeasure (μ ν : Measure α) + [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + renyiDiv 1 μ ν = klDiv μ ν := by + simp [renyiDiv_one] + +lemma renyiDiv_one_eq_top_iff [NeZero μ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + renyiDiv 1 μ ν = ∞ ↔ klDiv μ ν = ∞ := by + rw [renyiDiv_one] + rcases eq_or_ne ν 0 with rfl | hν + · simp only [Measure.coe_zero, Pi.zero_apply, ENNReal.inv_zero, smul_zero, klDiv_zero_right] + have : NeZero ν := ⟨hν⟩ + rw [klDiv_smul_right_eq_top_iff (ENNReal.inv_ne_zero.mpr (measure_ne_top _ _)) + (ENNReal.inv_ne_top.mpr (NeZero.ne _)), + klDiv_smul_left_eq_top_iff (ENNReal.inv_ne_zero.mpr (measure_ne_top _ _)) + (ENNReal.inv_ne_top.mpr (NeZero.ne _))] + +lemma renyiDiv_of_ne_one (ha_zero : a ≠ 0) (ha_ne_one : a ≠ 1) (μ ν : Measure α) : + renyiDiv a μ ν = ((a - 1)⁻¹ * ENNReal.log + (((avgMass a μ ν : EReal) + (a - 1) * (hellingerDiv a μ ν)).toENNReal) + - (a - 1)⁻¹ * (a * Real.log (μ .univ).toReal + + (1 - a) * Real.log (ν .univ).toReal)).toENNReal := by + rw [renyiDiv, ite_eq_right ha_zero, ite_eq_right ha_ne_one] + +lemma renyiDiv_eq_top_of_hellingerDiv_eq_top [NeZero μ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (h : hellingerDiv a μ ν = ∞) : + renyiDiv a μ ν = ∞ := by + by_cases ha_one : a = 1 + · rw [ha_one, hellingerDiv_one] at h + rw [ha_one, renyiDiv_one_eq_top_iff] + exact h + have ha_lt : 1 < a := by + by_contra ha + exact hellingerDiv_ne_top_of_lt_one (lt_of_le_of_ne (not_lt.mp ha) ha_one) _ _ h + have ha_pos : 0 < a := zero_lt_one.trans ha_lt + rw [renyiDiv_of_ne_one ha_pos.ne' ha_lt.ne'] + rw [avgMass_add_mul_hellingerDiv_eq_top ha_lt.ne' h] + simp only [EReal.toENNReal_top, ENNReal.log_top, EReal.toENNReal_eq_top_iff] + have : (((a - 1)⁻¹ : ℝ) : EReal) * ⊤ = ⊤ := by simp [EReal.mul_eq_top, ha_lt] + rw [this, sub_eq_add_neg, EReal.top_add_of_ne_bot] + simp only [ne_eq, EReal.neg_eq_bot_iff] + norm_cast + exact EReal.coe_ne_top _ + +section IntegralForm + +open Classical in +lemma renyiDiv_of_lt_one [IsFiniteMeasure μ] [IsFiniteMeasure ν] (ha_pos : 0 < a) (ha_lt : a < 1) : + renyiDiv a μ ν = + if μ ⟂ₘ ν then ∞ + else ENNReal.ofReal ((a - 1)⁻¹ + * (Real.log (∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν) + - (a * Real.log (μ .univ).toReal + (1 - a) * Real.log (ν .univ).toReal))) := by + rw [renyiDiv_of_ne_one ha_pos.ne' ha_lt.ne] + split_ifs with h + · rw [(avgMass_add_mul_hellingerDiv_eq_zero_iff_mutuallySingular ha_pos ha_lt).mpr h] + simp only [ne_eq, EReal.zero_ne_top, not_false_eq_true, EReal.toENNReal_of_ne_top, + EReal.toReal_zero, ENNReal.ofReal_zero, ENNReal.log_zero, EReal.toENNReal_eq_top_iff] + have : (((a - 1)⁻¹ : ℝ) : EReal) * ⊥ = ⊤ := by simp [EReal.mul_eq_top, ha_lt] + rw [this, sub_eq_add_neg, EReal.top_add_of_ne_bot] + simp only [ne_eq, EReal.neg_eq_bot_iff] + norm_cast + exact EReal.coe_ne_top _ + · rw [← mul_hellingerDiv_add_meas_eq_integral_of_lt_one ha_pos ha_lt, + avgMass_add_mul_hellingerDiv_eq_ofReal (hellingerDiv_ne_top_of_lt_one ha_lt _ _), + EReal.real_coe_toENNReal, ENNReal.log_ofReal, ite_eq_right] + · norm_cast + rw [EReal.real_coe_toENNReal, mul_sub] + · rw [not_le] + refine lt_of_le_of_ne ?_ ?_ + · exact avgMass_add_mul_hellingerDiv_nonneg'_of_lt_one ha_pos ha_lt + · rw [← avgMass_add_mul_hellingerDiv_eq_zero_iff_mutuallySingular' ha_pos ha_lt] at h + exact Ne.symm h + +lemma renyiDiv_of_one_lt [NeZero μ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] (ha_lt : 1 < a) : + renyiDiv a μ ν = + if hellingerDiv a μ ν = ∞ then ∞ + else ENNReal.ofReal ((a - 1)⁻¹ + * (Real.log (∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν) + - (a * Real.log (μ .univ).toReal + (1 - a) * Real.log (ν .univ).toReal))) := by + have ha_pos : 0 < a := zero_lt_one.trans ha_lt + split_ifs with h + · exact renyiDiv_eq_top_of_hellingerDiv_eq_top h + rw [renyiDiv_of_ne_one ha_pos.ne' ha_lt.ne', avgMass_add_mul_hellingerDiv_eq_ofReal h, + EReal.real_coe_toENNReal, ENNReal.log_ofReal, ite_eq_right] + · norm_cast + rw [EReal.real_coe_toENNReal, mul_sub, + ← mul_hellingerDiv_add_meas_eq_integral ha_pos ha_lt.ne' h] + · rw [not_le] + refine lt_of_le_of_ne ?_ ?_ + · exact avgMass_add_mul_hellingerDiv_nonneg' ha_pos h + · symm + exact avgMass_add_mul_hellingerDiv_ne_zero_of_one_lt ha_lt h + + +/-- The Rényi divergence `renyiDiv a μ ν` can be written as the log of an integral +with respect to `ν`. Version for `a < 1`. -/ +lemma renyiDiv_eq_log_integral_of_lt_one [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_lt : a < 1) (h_ms : ¬ μ ⟂ₘ ν) : + renyiDiv a μ ν = ENNReal.ofReal ((a - 1)⁻¹ + * (Real.log (∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν) + - (a * Real.log (μ .univ).toReal + (1 - a) * Real.log (ν .univ).toReal))) := by + rw [renyiDiv_of_lt_one ha_pos ha_lt, ite_eq_right h_ms] + +/-- The Rényi divergence `renyiDiv a μ ν` can be written as the log of an integral +with respect to `ν`. Version for `1 < a`. -/ +lemma renyiDiv_eq_log_integral_of_one_lt [NeZero μ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_lt : 1 < a) (h_int : Integrable (fun x ↦ ((∂μ/∂ν) x).toReal ^ a) ν) (h_ac : μ ≪ ν) : + renyiDiv a μ ν = ENNReal.ofReal ((a - 1)⁻¹ + * (Real.log (∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν) + - (a * Real.log (μ .univ).toReal + (1 - a) * Real.log (ν .univ).toReal))) := by + rw [renyiDiv_of_one_lt ha_lt, ite_eq_right] + exact (hellingerDiv_ne_top_iff_of_one_lt ha_lt _ _).mpr ⟨h_int, h_ac⟩ + +/-- If `μ ≪ ν`, the Rényi divergence `renyiDiv a μ ν` can be written as the log of an integral +with respect to `μ`. Version for `a < 1`. -/ +lemma renyiDiv_eq_log_integral_of_lt_one' [NeZero μ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_lt : a < 1) (h_ac : μ ≪ ν) : + renyiDiv a μ ν = ENNReal.ofReal ((a - 1)⁻¹ + * (Real.log (∫ x, (μ.rnDeriv ν x).toReal ^ (a - 1) ∂μ) + - (a * Real.log (μ .univ).toReal + (1 - a) * Real.log (ν .univ).toReal))) := by + rw [renyiDiv_eq_log_integral_of_lt_one ha_pos ha_lt, + integral_rpow_rnDeriv_eq_integral_rpow_sub_one ha_pos ha_lt.ne h_ac] + exact fun h ↦ NeZero.ne μ (Measure.eq_zero_of_absolutelyContinuous_of_mutuallySingular h_ac h) + +/-- If `μ ≪ ν`, the Rényi divergence `renyiDiv a μ ν` can be written as the log of an integral +with respect to `μ`. Version for `1 < a`. -/ +lemma renyiDiv_eq_log_integral_of_one_lt' [NeZero μ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_lt : 1 < a) (h_int : Integrable (fun x ↦ ((∂μ/∂ν) x).toReal ^ a) ν) (h_ac : μ ≪ ν) : + renyiDiv a μ ν = ENNReal.ofReal ((a - 1)⁻¹ + * (Real.log (∫ x, (μ.rnDeriv ν x).toReal ^ (a - 1) ∂μ) + - (a * Real.log (μ .univ).toReal + (1 - a) * Real.log (ν .univ).toReal))) := by + rw [renyiDiv_eq_log_integral_of_one_lt ha_lt h_int h_ac, + integral_rpow_rnDeriv_eq_integral_rpow_sub_one (zero_lt_one.trans ha_lt) ha_lt.ne' h_ac] + +lemma toReal_renyiDiv_of_lt_one [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_pos : 0 < a) (ha_lt : a < 1) (h_ms : ¬ μ ⟂ₘ ν) : + (renyiDiv a μ ν).toReal + = (a - 1)⁻¹ * (Real.log (∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν) + - (a * Real.log (μ .univ).toReal + (1 - a) * Real.log (ν .univ).toReal)) := by + rw [renyiDiv_eq_log_integral_of_lt_one ha_pos ha_lt h_ms, ENNReal.toReal_ofReal] + exact mul_nonneg_of_nonpos_of_nonpos (inv_nonpos.mpr (by linarith)) + (sub_nonpos.mpr (log_integral_rpow_rnDeriv_le_of_lt_one ha_pos ha_lt h_ms)) + +lemma toReal_renyiDiv_of_one_lt [NeZero μ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha_lt : 1 < a) (h_int : Integrable (fun x ↦ ((∂μ/∂ν) x).toReal ^ a) ν) (h_ac : μ ≪ ν) : + (renyiDiv a μ ν).toReal + = (a - 1)⁻¹ * (Real.log (∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν) + - (a * Real.log (μ .univ).toReal + (1 - a) * Real.log (ν .univ).toReal)) := by + rw [renyiDiv_eq_log_integral_of_one_lt ha_lt h_int h_ac, ENNReal.toReal_ofReal] + exact mul_nonneg (inv_nonneg.mpr (by linarith)) (sub_nonneg.mpr + (le_log_integral_rpow_rnDeriv_of_one_lt ha_lt + ((hellingerDiv_ne_top_iff_of_one_lt ha_lt _ _).mpr ⟨h_int, h_ac⟩))) + +end IntegralForm + +@[simp] +lemma renyiDiv_zero_measure_left (ha_nonneg : 0 ≤ a) (ha : a ≠ 1) (ν : Measure α) + [IsFiniteMeasure ν] : + renyiDiv a 0 ν = if a < 1 then ∞ else 0 := by + by_cases ha_zero : a = 0 + · subst ha_zero + rw [renyiDiv_zero, ite_eq_left zero_lt_one] + have h_set : ν {x | 0 < (∂(0 : Measure α)/∂ν) x} = 0 := by + have : {x | 0 < (∂(0 : Measure α)/∂ν) x} = {x | ¬ (∂(0 : Measure α)/∂ν) x = 0} := + Set.ext fun x ↦ show 0 < (∂(0 : Measure α)/∂ν) x ↔ ¬ (∂(0 : Measure α)/∂ν) x = 0 from + pos_iff_ne_zero + rw [this, ← ae_iff] + filter_upwards [ν.rnDeriv_zero] with x hx + simp [hx] + rw [h_set, ENNReal.zero_div, ENNReal.log_zero, EReal.neg_bot, EReal.toENNReal_top] + rw [renyiDiv_of_ne_one ha_zero ha] + simp only [EReal.coe_add, EReal.coe_mul, EReal.coe_sub, EReal.coe_one, ne_eq, measure_ne_top, + not_false_eq_true, EReal.coe_ennreal_toReal, Measure.coe_zero, Pi.zero_apply, + ENNReal.toReal_zero, mul_zero, EReal.coe_zero, add_zero, log_zero, zero_add, + hellingerDiv_zero_measure_left (ha_nonneg.lt_of_ne' ha_zero)] + have : (1 - (a : EReal)) * (ν Set.univ) + (a - 1) * (ν Set.univ) = 0 := by + rw [← EReal.coe_ennreal_toReal (measure_ne_top _ _)] + norm_cast + ring + simp only [this, ne_eq, EReal.zero_ne_top, not_false_eq_true, EReal.toENNReal_of_ne_top, + EReal.toReal_zero, ENNReal.ofReal_zero, ENNReal.log_zero] + rcases lt_or_gt_of_ne ha with ha_lt | ha_lt + · simp only [ha_lt, ↓reduceIte, EReal.toENNReal_eq_top_iff] + have : (((a - 1)⁻¹ : ℝ) : EReal) * ⊥ = ⊤ := by simp [EReal.mul_eq_top, ha_lt] + rw [this, sub_eq_add_neg, EReal.top_add_of_ne_bot] + simp only [ne_eq, EReal.neg_eq_bot_iff] + norm_cast + exact EReal.coe_ne_top _ + · have : (((a - 1)⁻¹ : ℝ) : EReal) * ⊥ = ⊥ := by simp [EReal.mul_eq_bot, ha_lt] + simp [this, not_lt.mpr ha_lt.le] + +@[simp] +lemma renyiDiv_zero_measure_right (ha_nonneg : 0 ≤ a) + (μ : Measure α) [IsFiniteMeasure μ] [NeZero μ] : + renyiDiv a μ 0 = ∞ := by + by_cases ha_zero : a = 0 + · simp [ha_zero] + have ha_pos : 0 < a := ha_nonneg.lt_of_ne' ha_zero + rcases lt_trichotomy a 1 with (ha | rfl | ha) + · rw [renyiDiv_of_ne_one ha_zero ha.ne, hellingerDiv_zero_measure_right_of_lt_one ha_pos ha] + simp only [EReal.coe_add, Measure.coe_zero, Pi.zero_apply, ENNReal.toReal_zero, mul_zero, + EReal.coe_zero, EReal.coe_mul, zero_add, EReal.coe_ennreal_mul, EReal.coe_ennreal_ofReal, + EReal.toENNReal_eq_top_iff, log_zero, add_zero] + have : (a : EReal) * (μ Set.univ).toReal + (a - 1) * ((max (a * (1 - a)⁻¹) 0) * (μ Set.univ)) + = 0 := by + rw [← EReal.coe_ennreal_toReal (measure_ne_top _ _)] + norm_cast + rw [max_eq_left, mul_comm a (1 - a)⁻¹, ← mul_assoc, ← mul_assoc, ← neg_sub 1 a, neg_mul, + mul_inv_cancel₀] + · ring + · exact sub_ne_zero_of_ne ha.ne' + · refine mul_nonneg ha_pos.le ?_ + simp [ha.le] + simp only [this, ne_eq, EReal.zero_ne_top, not_false_eq_true, EReal.toENNReal_of_ne_top, + EReal.toReal_zero, ENNReal.ofReal_zero, ENNReal.log_zero] + simp only [EReal.coe_neg', inv_neg'', sub_neg.mpr ha, EReal.mul_bot_of_neg] + rw [sub_eq_add_neg, EReal.top_add_of_ne_bot] + simp only [ne_eq, EReal.neg_eq_bot_iff] + norm_cast + exact EReal.coe_ne_top _ + · rw [renyiDiv_one] + simp only [Measure.coe_zero, Pi.zero_apply, ENNReal.inv_zero, smul_zero] + exact klDiv_zero_right + · rw [renyiDiv_of_ne_one ha_zero ha.ne', hellingerDiv_zero_measure_right_of_one_le ha.le] + simp only [EReal.coe_add, Measure.coe_zero, Pi.zero_apply, ENNReal.toReal_zero, mul_zero, + EReal.coe_zero, EReal.coe_mul, zero_add, EReal.coe_ennreal_top, EReal.toENNReal_eq_top_iff, + log_zero, add_zero] + have : ((a : EReal) - 1) * ⊤ = ⊤ := by + norm_cast + simp only [EReal.coe_sub, EReal.coe_one, EReal.mul_eq_top, not_top_lt, and_false, top_ne_bot, + EReal.zero_lt_top, and_true, false_or] + right + exact mod_cast (sub_pos_of_lt ha) + rw [this, EReal.add_top_of_ne_bot] + swap; · norm_cast; exact EReal.coe_ne_bot _ + simp only [EReal.toENNReal_top, ENNReal.log_top] + have : (((a - 1)⁻¹ : ℝ) : EReal) * ⊤ = ⊤ := by simp [EReal.mul_eq_top, ha] + rw [this, sub_eq_add_neg, EReal.top_add_of_ne_bot] + simp only [ne_eq, EReal.neg_eq_bot_iff] + norm_cast + exact EReal.coe_ne_top _ + +section RenyiEq + +lemma renyiDiv_eq_top_iff_hellingerDiv_eq_top_of_one_lt + [NeZero μ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] (ha : 1 < a) : + renyiDiv a μ ν = ∞ ↔ hellingerDiv a μ ν = ∞ := by + refine ⟨fun h ↦ ?_, fun h ↦ renyiDiv_eq_top_of_hellingerDiv_eq_top h⟩ + contrapose! h + rw [renyiDiv_of_one_lt ha] + simp [h] + +lemma renyiDiv_eq_top_iff_hellingerDiv_eq_top_of_one_le (ha : 1 ≤ a) + [NeZero μ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + renyiDiv a μ ν = ∞ ↔ hellingerDiv a μ ν = ∞ := by + by_cases ha_one : a = 1 + · rw [ha_one, hellingerDiv_one] + exact renyiDiv_one_eq_top_iff + · exact renyiDiv_eq_top_iff_hellingerDiv_eq_top_of_one_lt + (lt_of_le_of_ne ha fun h ↦ ha_one h.symm) + +lemma renyiDiv_eq_top_iff_of_one_lt (ha : 1 < a) [NeZero μ] + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + renyiDiv a μ ν = ∞ ↔ ¬ Integrable (fun x ↦ ((∂μ/∂ν) x).toReal ^ a) ν ∨ ¬ μ ≪ ν := by + simp_rw [renyiDiv_eq_top_iff_hellingerDiv_eq_top_of_one_le ha.le, + hellingerDiv_eq_top_iff_of_one_lt ha] + +lemma renyiDiv_ne_top_iff_of_one_lt (ha : 1 < a) [NeZero μ] + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + renyiDiv a μ ν ≠ ∞ ↔ Integrable (fun x ↦ ((∂μ/∂ν) x).toReal ^ a) ν ∧ μ ≪ ν := by + rw [ne_eq, renyiDiv_eq_top_iff_of_one_lt ha] + simp + +lemma renyiDiv_eq_top_iff_mutuallySingular_of_lt_one (ha_nonneg : 0 ≤ a) (ha : a < 1) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + renyiDiv a μ ν = ∞ ↔ μ ⟂ₘ ν := by + by_cases ha_zero : a = 0 + · subst ha_zero + rw [renyiDiv_zero, EReal.toENNReal_eq_top_iff, EReal.neg_eq_top_iff, ENNReal.log_eq_bot_iff, + ENNReal.div_eq_zero_iff, or_iff_left (measure_ne_top _ _)] + have : {x | 0 < (∂μ/∂ν) x} = {x | ¬ (∂μ/∂ν) x = 0} := + Set.ext fun x ↦ show 0 < (∂μ/∂ν) x ↔ ¬ (∂μ/∂ν) x = 0 from pos_iff_ne_zero + rw [this, ← ae_iff] + exact Measure.rnDeriv_eq_zero μ ν + rw [renyiDiv_of_lt_one (ha_nonneg.lt_of_ne' ha_zero) ha] + simp + +lemma renyiDiv_of_mutuallySingular (ha_nonneg : 0 ≤ a) [NeZero μ] + [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hμν : μ ⟂ₘ ν) : + renyiDiv a μ ν = ∞ := by + by_cases ha : a < 1 + · rw [renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha_nonneg ha] + exact hμν + · rw [renyiDiv_eq_top_iff_hellingerDiv_eq_top_of_one_le (le_of_not_gt ha)] + exact hellingerDiv_of_mutuallySingular_of_one_le (le_of_not_gt ha) hμν + +lemma renyiDiv_of_one_le_of_not_ac (ha : 1 ≤ a) (h_ac : ¬ μ ≪ ν) + [NeZero μ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + renyiDiv a μ ν = ∞ := by + by_cases ha_one : a = 1 + · rw [ha_one, renyiDiv_one_eq_top_iff] + exact klDiv_of_not_ac h_ac + replace ha : 1 < a := lt_of_le_of_ne ha fun h ↦ ha_one h.symm + rw [renyiDiv_eq_top_iff_of_one_lt ha] + exact Or.inr h_ac + +lemma absolutelyContinuous_of_renyiDiv_ne_top (ha : 1 ≤ a) (h : renyiDiv a μ ν ≠ ∞) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + μ ≪ ν := by + rcases eq_or_ne μ 0 with rfl | hμ + · exact Measure.AbsolutelyContinuous.zero ν + have : NeZero μ := ⟨hμ⟩ + by_contra h_ac + exact h (renyiDiv_of_one_le_of_not_ac ha h_ac) + +end RenyiEq + +lemma toReal_renyiDiv_symm (ha_pos : 0 < a) (ha_lt : a < 1) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + (1 - a) * (renyiDiv a μ ν).toReal = a * (renyiDiv (1 - a) ν μ).toReal := by + rw [renyiDiv_of_lt_one ha_pos ha_lt, renyiDiv_of_lt_one] + rotate_left + · linarith + · linarith + rw [show ν ⟂ₘ μ ↔ μ ⟂ₘ ν from ⟨.symm, .symm⟩] + split_ifs with h + · simp + have h1 : 1 - a = (ENNReal.ofReal (1 - a)).toReal := + (ENNReal.toReal_ofReal (sub_nonneg_of_le ha_lt.le)).symm + have h2 : a = (ENNReal.ofReal a).toReal := (ENNReal.toReal_ofReal ha_pos.le).symm + rw [h1, h2, ← ENNReal.toReal_mul, ← ENNReal.toReal_mul] + congr 1 + simp_rw [← h2, ← h1] + rw [← ENNReal.ofReal_mul ha_pos.le, ← ENNReal.ofReal_mul (sub_nonneg_of_le ha_lt.le)] + congr 1 + rw [integral_rpow_rnDeriv_symm ha_pos ha_lt.ne] + simp only [sub_sub_cancel_left, sub_sub_cancel] + have h_eq : (1 - a) * (a - 1)⁻¹ = a * (-a)⁻¹ := by + rw [← neg_sub a 1, neg_mul, mul_inv_cancel₀ (sub_ne_zero_of_ne ha_lt.ne), inv_neg, mul_neg, + mul_inv_cancel₀ ha_pos.ne'] + rw [← mul_assoc, ← mul_assoc, h_eq, add_comm ((1 - a) * Real.log (ν .univ).toReal)] + +lemma renyiDiv_symm (ha_pos : 0 < a) (ha : a < 1) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + ENNReal.ofReal (1 - a) * renyiDiv a μ ν = ENNReal.ofReal a * renyiDiv (1 - a) ν μ := by + by_cases h_ms : μ ⟂ₘ ν + · rw [(renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha_pos.le ha).mpr h_ms, + (renyiDiv_eq_top_iff_mutuallySingular_of_lt_one (by linarith) (by linarith)).mpr h_ms.symm, + ENNReal.mul_top (by simp [ha]), ENNReal.mul_top (by simp [ha_pos])] + · have h1 : renyiDiv a μ ν ≠ ∞ := by + rwa [ne_eq, renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha_pos.le ha] + have h2 : renyiDiv (1 - a) ν μ ≠ ∞ := by + rw [ne_eq, renyiDiv_eq_top_iff_mutuallySingular_of_lt_one (by linarith) (by linarith)] + exact fun h ↦ h_ms h.symm + rw [← ENNReal.ofReal_toReal h1, ← ENNReal.ofReal_toReal h2, ← ENNReal.ofReal_mul (by linarith), + ← ENNReal.ofReal_mul ha_pos.le, toReal_renyiDiv_symm ha_pos ha] + +section Scaling + +/-! ### Invariance under scaling of the measures -/ + +lemma renyiDiv_smul_left (ha_nonneg : 0 ≤ a) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (c : ℝ≥0) (hc : c ≠ 0) : + renyiDiv a (c • μ) ν = renyiDiv a μ ν := by + have hc' : (c : ℝ≥0∞) ≠ 0 := by simpa using hc + have hc_pos : (0 : ℝ) < c := NNReal.coe_pos.mpr (pos_iff_ne_zero.mpr hc) + rcases eq_or_ne μ 0 with rfl | hμ + · simp + have hm : 0 < (μ .univ).toReal := + ENNReal.toReal_pos (Measure.measure_univ_ne_zero.mpr hμ) (measure_ne_top _ _) + have h_mass : ((c • μ) .univ).toReal = c * (μ .univ).toReal := by + rw [Measure.coe_nnreal_smul_apply, ENNReal.toReal_mul, ENNReal.coe_toReal] + -- `a = 0`: the sets where `∂(c • μ)/∂ν` and `∂μ/∂ν` are positive agree `ν`-a.e. + by_cases ha_zero : a = 0 + · subst ha_zero + have h_set : ν {x | 0 < (∂(c • μ)/∂ν) x} = ν {x | 0 < (∂μ/∂ν) x} := by + refine measure_congr ?_ + filter_upwards [Measure.rnDeriv_smul_left' μ ν c] with x hx + show (0 < (∂(c • μ)/∂ν) x) = (0 < (∂μ/∂ν) x) + rw [hx, Pi.smul_apply, ENNReal.smul_def, smul_eq_mul, eq_iff_iff, ENNReal.mul_pos_iff, + ENNReal.coe_pos] + exact ⟨fun h ↦ h.2, fun h ↦ ⟨pos_iff_ne_zero.mpr hc, h⟩⟩ + rw [renyiDiv_zero, renyiDiv_zero, h_set] + -- `a = 1`: the KL divergence of the normalized measures does not see `c` + by_cases ha_one : a = 1 + · subst ha_one + rw [renyiDiv_one, renyiDiv_one, Measure.coe_nnreal_smul_apply, ENNReal.smul_def, smul_smul, + ENNReal.mul_inv (Or.inl hc') (Or.inl ENNReal.coe_ne_top), mul_right_comm, + ENNReal.inv_mul_cancel hc' ENNReal.coe_ne_top, one_mul] + -- Otherwise, scaling `μ` by `c` multiplies the integral `∫ (∂μ/∂ν) ^ a ∂ν` by `c ^ a` and the + -- mass of `μ` by `c`. These factors cancel in the formula for `renyiDiv`. + have ha_pos : 0 < a := ha_nonneg.lt_of_ne' ha_zero + have h_log (I : ℝ) (hI : 0 < I) : + (a - 1)⁻¹ * (Real.log (c ^ a * I) + - (a * Real.log (c * (μ .univ).toReal) + (1 - a) * Real.log (ν .univ).toReal)) + = (a - 1)⁻¹ * (Real.log I + - (a * Real.log (μ .univ).toReal + (1 - a) * Real.log (ν .univ).toReal)) := by + rw [Real.log_mul (rpow_pos_of_pos hc_pos a).ne' hI.ne', Real.log_rpow hc_pos, + Real.log_mul hc_pos.ne' hm.ne'] + ring + rcases lt_or_gt_of_ne ha_one with ha_lt | ha_lt + -- `a < 1`: the divergence is `∞` iff the measures are mutually singular, which `c` does not + -- change. Otherwise the integral is positive and we apply `h_log`. + · have h_ms : c • μ ⟂ₘ ν ↔ μ ⟂ₘ ν := + ⟨fun h ↦ h.mono_ac (Measure.absolutelyContinuous_smul hc') .rfl, fun h ↦ h.smul_nnreal c⟩ + rw [renyiDiv_of_lt_one ha_pos ha_lt, renyiDiv_of_lt_one ha_pos ha_lt] + split_ifs with h1 h h + · rfl + · exact absurd (h_ms.mp h1) h + · exact absurd (h_ms.mpr h) h1 + rw [integral_rpow_rnDeriv_smul_left, h_mass, h_log] + exact (integral_rpow_rnDeriv_pos_iff_not_mutuallySingular ha_pos.ne' + (integrable_rpow_rnDeriv_of_lt_one ha_pos.le ha_lt)).mpr h + -- `1 < a`: the divergence is `∞` iff the Hellinger divergence is, which `c` does not change. + -- Otherwise `μ ≪ ν` and `μ ≠ 0`, so the integral is positive and we apply `h_log`. + · have : NeZero μ := ⟨hμ⟩ + have : NeZero (c • μ) := ⟨fun h ↦ hμ (by simpa [hc] using h)⟩ + rw [renyiDiv_of_one_lt ha_lt, renyiDiv_of_one_lt ha_lt] + simp only [hellingerDiv_smul_left_eq_top_iff ha_one c hc] + split_ifs with h + · rfl + have h' := (hellingerDiv_ne_top_iff_of_one_lt ha_lt _ _).mp h + rw [integral_rpow_rnDeriv_smul_left, h_mass, h_log] + exact (integral_rpow_rnDeriv_pos_iff_not_mutuallySingular ha_pos.ne' h'.1).mpr + fun h_ms ↦ hμ (Measure.eq_zero_of_absolutelyContinuous_of_mutuallySingular h'.2 h_ms) + +lemma renyiDiv_smul_right (ha_nonneg : 0 ≤ a) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (c : ℝ≥0) (hc : c ≠ 0) : + renyiDiv a μ (c • ν) = renyiDiv a μ ν := by + have hc' : (c : ℝ≥0∞) ≠ 0 := by simpa using hc + have hc_pos : (0 : ℝ) < c := NNReal.coe_pos.mpr (pos_iff_ne_zero.mpr hc) + have h_mass : ((c • ν) .univ).toReal = c * (ν .univ).toReal := by + rw [Measure.coe_nnreal_smul_apply, ENNReal.toReal_mul, ENNReal.coe_toReal] + -- `a = 0`: the sets where `∂μ/∂(c • ν)` and `∂μ/∂ν` are positive agree `ν`-a.e., and the + -- factor `c` in their `c • ν` measure cancels with the one in `(c • ν) univ`. + by_cases ha_zero : a = 0 + · subst ha_zero + have h_set : (c • ν) {x | 0 < (∂μ/∂(c • ν)) x} = c * ν {x | 0 < (∂μ/∂ν) x} := by + rw [Measure.coe_nnreal_smul_apply] + congr 1 + refine measure_congr ?_ + filter_upwards [Measure.rnDeriv_smul_right' μ ν hc] with x hx + show (0 < (∂μ/∂(c • ν)) x) = (0 < (∂μ/∂ν) x) + rw [hx, Pi.smul_apply, ENNReal.smul_def, smul_eq_mul, eq_iff_iff, ENNReal.mul_pos_iff, + ENNReal.coe_pos] + exact ⟨fun h ↦ h.2, fun h ↦ ⟨pos_iff_ne_zero.mpr (inv_ne_zero hc), h⟩⟩ + rw [renyiDiv_zero, renyiDiv_zero, h_set, Measure.coe_nnreal_smul_apply, + ENNReal.mul_div_mul_left _ _ hc' ENNReal.coe_ne_top] + rcases eq_or_ne ν 0 with rfl | hν + · simp + have hn : 0 < (ν .univ).toReal := + ENNReal.toReal_pos (Measure.measure_univ_ne_zero.mpr hν) (measure_ne_top _ _) + -- `a = 1`: the KL divergence of the normalized measures does not see `c` + by_cases ha_one : a = 1 + · subst ha_one + rw [renyiDiv_one, renyiDiv_one, Measure.coe_nnreal_smul_apply, ENNReal.smul_def, smul_smul, + ENNReal.mul_inv (Or.inl hc') (Or.inl ENNReal.coe_ne_top), mul_right_comm, + ENNReal.inv_mul_cancel hc' ENNReal.coe_ne_top, one_mul] + -- Otherwise, scaling `ν` by `c` multiplies the integral `∫ (∂μ/∂ν) ^ a ∂ν` by `c ^ (1 - a)` and + -- the mass of `ν` by `c`. These factors cancel in the formula for `renyiDiv`. + have ha_pos : 0 < a := ha_nonneg.lt_of_ne' ha_zero + have h_log (I : ℝ) (hI : 0 < I) : + (a - 1)⁻¹ * (Real.log (c ^ (1 - a) * I) + - (a * Real.log (μ .univ).toReal + (1 - a) * Real.log (c * (ν .univ).toReal))) + = (a - 1)⁻¹ * (Real.log I + - (a * Real.log (μ .univ).toReal + (1 - a) * Real.log (ν .univ).toReal)) := by + rw [Real.log_mul (rpow_pos_of_pos hc_pos _).ne' hI.ne', Real.log_rpow hc_pos, + Real.log_mul hc_pos.ne' hn.ne'] + ring + rcases lt_or_gt_of_ne ha_one with ha_lt | ha_lt + -- `a < 1`: the divergence is `∞` iff the measures are mutually singular, which `c` does not + -- change. Otherwise the integral is positive and we apply `h_log`. + · have h_ms : μ ⟂ₘ c • ν ↔ μ ⟂ₘ ν := + ⟨fun h ↦ h.mono_ac .rfl (Measure.absolutelyContinuous_smul hc'), + fun h ↦ (h.symm.smul_nnreal c).symm⟩ + rw [renyiDiv_of_lt_one ha_pos ha_lt, renyiDiv_of_lt_one ha_pos ha_lt] + split_ifs with h1 h h + · rfl + · exact absurd (h_ms.mp h1) h + · exact absurd (h_ms.mpr h) h1 + rw [integral_rpow_rnDeriv_smul_right c (fun h ↦ absurd h hc), h_mass, h_log] + exact (integral_rpow_rnDeriv_pos_iff_not_mutuallySingular ha_pos.ne' + (integrable_rpow_rnDeriv_of_lt_one ha_pos.le ha_lt)).mpr h + -- `1 < a`: the divergence is `∞` iff the Hellinger divergence is, which `c` does not change. + -- Otherwise `μ ≪ ν` and `μ ≠ 0`, so the integral is positive and we apply `h_log`. + · rcases eq_or_ne μ 0 with rfl | hμ + · rw [renyiDiv_zero_measure_left ha_nonneg ha_one, renyiDiv_zero_measure_left ha_nonneg ha_one] + have : NeZero μ := ⟨hμ⟩ + rw [renyiDiv_of_one_lt ha_lt, renyiDiv_of_one_lt ha_lt] + simp only [hellingerDiv_smul_right_eq_top_iff ha_one c hc] + split_ifs with h + · rfl + have h' := (hellingerDiv_ne_top_iff_of_one_lt ha_lt _ _).mp h + rw [integral_rpow_rnDeriv_smul_right c (fun h ↦ absurd h hc), h_mass, h_log] + exact (integral_rpow_rnDeriv_pos_iff_not_mutuallySingular ha_pos.ne' h'.1).mpr + fun h_ms ↦ hμ (Measure.eq_zero_of_absolutelyContinuous_of_mutuallySingular h'.2 h_ms) + +lemma renyiDiv_smul_left' (ha_nonneg : 0 ≤ a) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + {c : ℝ≥0∞} (hc : c ≠ 0) (hc_top : c ≠ ∞) : + renyiDiv a (c • μ) ν = renyiDiv a μ ν := by + lift c to ℝ≥0 using hc_top + rw [← ENNReal.smul_def] + exact renyiDiv_smul_left ha_nonneg c (by simpa using hc) + +lemma renyiDiv_smul_right' (ha_nonneg : 0 ≤ a) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + {c : ℝ≥0∞} (hc : c ≠ 0) (hc_top : c ≠ ∞) : + renyiDiv a μ (c • ν) = renyiDiv a μ ν := by + lift c to ℝ≥0 using hc_top + rw [← ENNReal.smul_def] + exact renyiDiv_smul_right ha_nonneg c (by simpa using hc) + +lemma renyiDiv_smul_smul (ha_nonneg : 0 ≤ a) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + {c c' : ℝ≥0∞} (hc : c ≠ 0) (hc_top : c ≠ ∞) (hc' : c' ≠ 0) (hc'_top : c' ≠ ∞) : + renyiDiv a (c • μ) (c' • ν) = renyiDiv a μ ν := by + lift c to ℝ≥0 using hc_top + rw [← ENNReal.smul_def, renyiDiv_smul_right' ha_nonneg hc' hc'_top, + renyiDiv_smul_left ha_nonneg c (by simpa using hc)] + +/-- The Rényi divergence between finite measures is the Rényi divergence between the normalized +measures. -/ +lemma renyiDiv_eq_renyiDiv_inv_smul (ha_nonneg : 0 ≤ a) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + [NeZero μ] [NeZero ν] : + renyiDiv a μ ν = renyiDiv a ((μ .univ)⁻¹ • μ) ((ν .univ)⁻¹ • ν) := + (renyiDiv_smul_smul ha_nonneg (ENNReal.inv_ne_zero.mpr (measure_ne_top _ _)) + (ENNReal.inv_ne_top.mpr (NeZero.ne _)) (ENNReal.inv_ne_zero.mpr (measure_ne_top _ _)) + (ENNReal.inv_ne_top.mpr (NeZero.ne _))).symm + +end Scaling + +section CGF + +/-- The cumulant generating function of the log-likelihood ratio under `ν` is given by the Rényi +divergence, for `a < 1`. The hypothesis `ν ≪ μ` is needed because `llr μ ν x = 0` when +`(∂μ/∂ν) x = 0`, and then `exp (llr μ ν x) = 1 ≠ 0 = (∂μ/∂ν) x`. -/ +lemma cgf_llr_of_lt_one [IsFiniteMeasure μ] [IsFiniteMeasure ν] (ha_pos : 0 < a) (ha_lt : a < 1) + (hνμ : ν ≪ μ) (h_ms : ¬ μ ⟂ₘ ν) : + cgf (llr μ ν) ν a = (a - 1) * (renyiDiv a μ ν).toReal + + (a * Real.log (μ .univ).toReal + (1 - a) * Real.log (ν .univ).toReal) := by + rw [toReal_renyiDiv_of_lt_one ha_pos ha_lt h_ms, ← mul_assoc, + mul_inv_cancel₀ (sub_ne_zero.mpr ha_lt.ne), one_mul, sub_add_cancel, cgf, mgf, + integral_congr_ae (exp_mul_llr_of_ac' hνμ)] + +/-- The cumulant generating function of the log-likelihood ratio under `μ` is given by the Rényi +divergence of order `1 + a`, for probability measures. -/ +lemma cgf_llr' [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] (ha_pos : 0 < a) + (h_int : Integrable (fun x ↦ ((∂μ/∂ν) x).toReal ^ (1 + a)) ν) (hμν : μ ≪ ν) : + cgf (llr μ ν) μ a = a * (renyiDiv (1 + a) μ ν).toReal := by + have h1a : 1 < 1 + a := by linarith + have h_avg : (1 + a) * Real.log (μ .univ).toReal + (1 - (1 + a)) * Real.log (ν .univ).toReal + = 0 := by + simp + have h_eq : ∫ x, ((∂μ/∂ν) x).toReal ^ a ∂μ = ∫ x, ((∂μ/∂ν) x).toReal ^ (1 + a) ∂ν := by + rw [← integral_rnDeriv_smul hμν] + refine integral_congr_ae (ae_of_all _ fun x ↦ ?_) + simp only [smul_eq_mul] + rw [add_comm, rpow_add_one' ENNReal.toReal_nonneg (by linarith), mul_comm] + have h_one_le : 1 ≤ ∫ x, ((∂μ/∂ν) x).toReal ^ (1 + a) ∂ν := by + rw [← mul_hellingerDiv_add_meas_eq_integral (by linarith) h1a.ne' + ((hellingerDiv_ne_top_iff_of_one_lt h1a _ _).mpr ⟨h_int, hμν⟩)] + simp only [measure_univ, ENNReal.toReal_one, mul_one] + have : 0 ≤ (1 + a - 1) * (hellingerDiv (1 + a) μ ν).toReal := + mul_nonneg (by linarith) ENNReal.toReal_nonneg + linarith + rw [renyiDiv_eq_log_integral_of_one_lt h1a h_int hμν, h_avg, sub_zero, + ENNReal.toReal_ofReal, ← mul_assoc, add_sub_cancel_left, mul_inv_cancel₀ ha_pos.ne', one_mul, + cgf, mgf, integral_congr_ae (exp_mul_llr_of_ac hμν), h_eq] + exact mul_nonneg (inv_nonneg.mpr (by linarith)) (Real.log_nonneg h_one_le) + +end CGF + +section DataProcessingInequality + +variable {β : Type*} {mβ : MeasurableSpace β} {κ η : Kernel α β} + +lemma le_renyiDiv_of_le_hellingerDiv {a : ℝ} {μ₁ ν₁ : Measure α} {μ₂ ν₂ : Measure β} + [IsFiniteMeasure μ₁] [IsFiniteMeasure ν₁] [IsFiniteMeasure μ₂] [IsFiniteMeasure ν₂] + (ha_pos : 0 < a) (h_eq_μ : μ₁ .univ = μ₂ .univ) + (h_eq_ν : ν₁ .univ = ν₂ .univ) (h_le : hellingerDiv a μ₁ ν₁ ≤ hellingerDiv a μ₂ ν₂) : + renyiDiv a μ₁ ν₁ ≤ renyiDiv a μ₂ ν₂ := by + have h_avg_eq : avgMass a μ₁ ν₁ = avgMass a μ₂ ν₂ := by simp [avgMass, h_eq_ν, h_eq_μ] + rcases lt_trichotomy a 1 with (ha | rfl | ha) + · simp_rw [renyiDiv_of_ne_one ha_pos.ne' ha.ne, h_avg_eq, h_eq_μ, h_eq_ν] + refine EReal.toENNReal_le_toENNReal ?_ + refine EReal.sub_le_sub ?_ le_rfl + apply EReal.neg_le_neg_iff.mp + simp_rw [← neg_mul, ← EReal.coe_neg, neg_inv, neg_sub] + gcongr _ * ENNReal.log (EReal.toENNReal ?_) + gcongr _ + ?_ + apply EReal.neg_le_neg_iff.mp + norm_cast + simp_rw [← neg_mul, ← EReal.coe_neg, neg_sub] + gcongr + · simp only [renyiDiv_one, hellingerDiv_one] at h_le ⊢ + exact klDiv_inv_smul_le_of_le h_eq_μ h_eq_ν h_le + · simp_rw [renyiDiv_of_ne_one ha_pos.ne' ha.ne', h_avg_eq, h_eq_μ, h_eq_ν] + refine EReal.toENNReal_le_toENNReal ?_ + refine EReal.sub_le_sub ?_ le_rfl + gcongr + norm_cast + linarith + +lemma le_renyiDiv_compProd (ha_pos : 0 < a) + (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ η : Kernel α β) [IsMarkovKernel κ] [IsMarkovKernel η] : + renyiDiv a μ ν ≤ renyiDiv a (μ ⊗ₘ κ) (ν ⊗ₘ η) := + le_renyiDiv_of_le_hellingerDiv ha_pos Measure.compProd_apply_univ.symm + Measure.compProd_apply_univ.symm (le_hellingerDiv_compProd μ ν κ η) + +lemma renyiDiv_fst_le (ha_pos : 0 < a) + (μ ν : Measure (α × β)) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + renyiDiv a μ.fst ν.fst ≤ renyiDiv a μ ν := + le_renyiDiv_of_le_hellingerDiv ha_pos Measure.fst_univ Measure.fst_univ (hellingerDiv_fst_le μ ν) + +lemma renyiDiv_snd_le (ha_pos : 0 < a) + (μ ν : Measure (α × β)) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + renyiDiv a μ.snd ν.snd ≤ renyiDiv a μ ν := + le_renyiDiv_of_le_hellingerDiv ha_pos Measure.snd_univ Measure.snd_univ (hellingerDiv_snd_le μ ν) + +lemma renyiDiv_comp_le_compProd (ha_pos : 0 < a) + (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + renyiDiv a (κ ∘ₘ μ) (η ∘ₘ ν) ≤ renyiDiv a (μ ⊗ₘ κ) (ν ⊗ₘ η) := + le_renyiDiv_of_le_hellingerDiv ha_pos (Measure.snd_compProd μ κ ▸ Measure.snd_univ) + (Measure.snd_compProd ν η ▸ Measure.snd_univ) (hellingerDiv_comp_le_compProd μ ν κ η) + +/-- The Data Processing Inequality for the Renyi divergence. -/ +lemma renyiDiv_comp_right_le (ha_pos : 0 < a) + (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ : Kernel α β) [IsMarkovKernel κ] : + renyiDiv a (κ ∘ₘ μ) (κ ∘ₘ ν) ≤ renyiDiv a μ ν := + le_renyiDiv_of_le_hellingerDiv ha_pos Measure.comp_apply_univ Measure.comp_apply_univ + (hellingerDiv_comp_right_le μ ν κ) + +end DataProcessingInequality + +end ProbabilityTheory diff --git a/Statlib/Divergence/Renyi/Bernoulli.lean b/Statlib/Divergence/Renyi/Bernoulli.lean new file mode 100644 index 0000000..d572c82 --- /dev/null +++ b/Statlib/Divergence/Renyi/Bernoulli.lean @@ -0,0 +1,87 @@ +/- +Copyright (c) 2026 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne +-/ +module + +public import Statlib.Divergence.Renyi.Basic +public import Statlib.ForMathlib.Probability.Distributions.Bernoulli + +/-! +# Rényi divergence between Bernoulli distributions + +For `x ≠ y`, `q ∈ (0, 1)` and `a ∈ (0, 1)`, the Rényi divergence of order `a` between the +Bernoulli distributions `Ber(x, y, p)` and `Ber(x, y, q)` is +`(a - 1)⁻¹ * log (p ^ a * q ^ (1 - a) + (1 - p) ^ a * (1 - q) ^ (1 - a))`. + +## Main statements + +* `renyiDiv_bernoulliMeasure`: the Rényi divergence of order `a ∈ (0, 1)` between Bernoulli + distributions. +* `renyiDiv_zero_bernoulliMeasure`: for `p, q ∈ (0, 1)`, the Rényi divergence of order `0` between + `Ber(x, y, p)` and `Ber(x, y, q)` is `0`. +-/ + +@[expose] public section + +open Real MeasureTheory unitInterval + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {𝓧 : Type*} [MeasurableSpace 𝓧] [MeasurableSingletonClass 𝓧] {x y : 𝓧} {p q : I} + {a : ℝ} + +/-- The Rényi divergence of order `a ∈ (0, 1)` between the Bernoulli distributions `Ber(x, y, p)` +and `Ber(x, y, q)`, for `x ≠ y` and `q ∉ {0, 1}`. -/ +theorem renyiDiv_bernoulliMeasure (ha0 : 0 < a) (ha1 : a < 1) (hxy : x ≠ y) (p : I) (hq : q ≠ 0) + (hq1 : q ≠ 1) : + renyiDiv a Ber(x, y, p) Ber(x, y, q) = ENNReal.ofReal ((a - 1)⁻¹ + * log ((p : ℝ) ^ a * (q : ℝ) ^ (1 - a) + (1 - (p : ℝ)) ^ a * (1 - (q : ℝ)) ^ (1 - a))) := by + classical + have hq0 : (0 : ℝ) < q := coe_pos.2 (unitInterval.pos_iff_ne_zero.2 hq) + have hq1' : (0 : ℝ) < 1 - q := sub_pos.2 (coe_lt_one.2 (unitInterval.lt_one_iff_ne_one.2 hq1)) + have hp0 : (0 : ℝ) ≤ p := p.2.1 + have hp1 : (0 : ℝ) ≤ 1 - p := sub_nonneg.2 p.2.2 + have h_ms : ¬ Ber(x, y, p) ⟂ₘ Ber(x, y, q) := fun h ↦ IsProbabilityMeasure.ne_zero Ber(x, y, p) + (Measure.eq_zero_of_absolutelyContinuous_of_mutuallySingular + (bernoulliMeasure_absolutelyContinuous hxy p hq hq1) h) + rw [renyiDiv_eq_log_integral_of_lt_one ha0 ha1 h_ms, + integral_congr_ae ((rnDeriv_bernoulliMeasure hxy p hq hq1).mono fun z hz ↦ by rw [hz]), + integral_bernoulliMeasure] + simp only [ite_true, ite_eq_right hxy.symm, ENNReal.toReal_ofReal (div_nonneg hp0 hq0.le), + ENNReal.toReal_ofReal (div_nonneg hp1 hq1'.le), measure_univ, ENNReal.toReal_one, log_one, + mul_zero, add_zero, sub_zero, smul_eq_mul] + have h1 : (q : ℝ) * ((p : ℝ) / q) ^ a = (p : ℝ) ^ a * (q : ℝ) ^ (1 - a) := by + rw [div_rpow hp0 hq0.le, rpow_sub hq0, rpow_one] + ring + have h2 : (1 - (q : ℝ)) * ((1 - (p : ℝ)) / (1 - q)) ^ a + = (1 - (p : ℝ)) ^ a * (1 - (q : ℝ)) ^ (1 - a) := by + rw [div_rpow hp1 hq1'.le, rpow_sub hq1', rpow_one] + ring + rw [h1, h2] + +/-- For `x ≠ y` and `p, q ∉ {0, 1}`, the Rényi divergence of order `0` between the Bernoulli +distributions `Ber(x, y, p)` and `Ber(x, y, q)` is `0`: the Radon-Nikodym derivative is positive +everywhere. -/ +lemma renyiDiv_zero_bernoulliMeasure (hxy : x ≠ y) (hp : p ≠ 0) (hp1 : p ≠ 1) (hq : q ≠ 0) + (hq1 : q ≠ 1) : + renyiDiv 0 Ber(x, y, p) Ber(x, y, q) = 0 := by + classical + have hp0 : (0 : ℝ) < p := coe_pos.2 (unitInterval.pos_iff_ne_zero.2 hp) + have hp1' : (0 : ℝ) < 1 - p := sub_pos.2 (coe_lt_one.2 (unitInterval.lt_one_iff_ne_one.2 hp1)) + have hq0 : (0 : ℝ) < q := coe_pos.2 (unitInterval.pos_iff_ne_zero.2 hq) + have hq1' : (0 : ℝ) < 1 - q := sub_pos.2 (coe_lt_one.2 (unitInterval.lt_one_iff_ne_one.2 hq1)) + have h_pos : ∀ᵐ z ∂Ber(x, y, q), 0 < Ber(x, y, p).rnDeriv Ber(x, y, q) z := by + filter_upwards [rnDeriv_bernoulliMeasure hxy p hq hq1] with z hz + rw [hz] + split_ifs + · exact ENNReal.ofReal_pos.mpr (div_pos hp0 hq0) + · exact ENNReal.ofReal_pos.mpr (div_pos hp1' hq1') + rw [renyiDiv_zero, (mem_ae_iff_prob_eq_one + (measurableSet_lt measurable_const (Measure.measurable_rnDeriv _ _))).mp h_pos, measure_univ, + div_one, ENNReal.log_one, neg_zero, EReal.toENNReal_zero] + +end ProbabilityTheory diff --git a/Statlib/Divergence/Renyi/CondRenyi.lean b/Statlib/Divergence/Renyi/CondRenyi.lean new file mode 100644 index 0000000..da741a2 --- /dev/null +++ b/Statlib/Divergence/Renyi/CondRenyi.lean @@ -0,0 +1,132 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Statlib.Divergence.Hellinger.CondHellinger +public import Statlib.Divergence.Renyi.Basic + +/-! +# Conditional Rényi divergence + +## Main definitions + +* `condRenyiDiv a κ η μ`: the conditional Rényi divergence of order `a` between the kernels `κ` + and `η` with respect to `μ`, defined as `renyiDiv a (μ ⊗ₘ κ) (μ ⊗ₘ η)`. + +## Main statements + +* `condRenyiDiv_zero`, `condRenyiDiv_one`: the special cases. +* `renyiDiv_comp_left_le`: `renyiDiv a (κ ∘ₘ μ) (η ∘ₘ μ) ≤ condRenyiDiv a κ η μ`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Real MeasureTheory Filter MeasurableSpace InformationTheory + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {α β γ : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} {mγ : MeasurableSpace γ} + {μ ν : Measure α} {κ η : Kernel α β} {a : ℝ} + +/-- Rényi divergence between two kernels κ and η conditional to a measure μ. +It is defined as `Rₐ(κ, η | μ) := Rₐ(μ ⊗ₘ κ, μ ⊗ₘ η)`. -/ +noncomputable +def condRenyiDiv (a : ℝ) (κ η : Kernel α β) (μ : Measure α) : ℝ≥0∞ := + renyiDiv a (μ ⊗ₘ κ) (μ ⊗ₘ η) + +lemma condRenyiDiv_zero (κ η : Kernel α β) (μ : Measure α) [IsMarkovKernel η] [IsFiniteMeasure μ] : + condRenyiDiv 0 κ η μ + = (- ENNReal.log ((μ ⊗ₘ η) {x | 0 < (∂μ ⊗ₘ κ/∂μ ⊗ₘ η) x} / μ .univ)).toENNReal := by + rw [condRenyiDiv, renyiDiv_zero, Measure.compProd_apply_univ] + +@[simp] +lemma condRenyiDiv_one [CountableOrCountablyGenerated α β] (κ η : Kernel α β) (μ : Measure α) + [IsMarkovKernel κ] [IsMarkovKernel η] [IsFiniteMeasure μ] [NeZero μ] : + condRenyiDiv 1 κ η μ = (μ .univ)⁻¹ * condKL κ η μ := by + rw [condRenyiDiv, renyiDiv_one, Measure.compProd_apply_univ, Measure.compProd_apply_univ, + klDiv_smul_same' (ENNReal.inv_ne_top.mpr (NeZero.ne _)), klDiv_compProd_eq_condKL] + +lemma integrable_rpow_rnDeriv_compProd_right_iff [CountableOrCountablyGenerated α β] + (ha_pos : 0 < a) (ha_ne : a ≠ 1) (κ η : Kernel α β) (μ : Measure α) + [IsFiniteKernel κ] [IsFiniteKernel η] [IsFiniteMeasure μ] (h_ac : ∀ᵐ x ∂μ, κ x ≪ η x) : + Integrable (fun x ↦ ((μ ⊗ₘ κ).rnDeriv (μ ⊗ₘ η) x).toReal ^ a) (μ ⊗ₘ η) + ↔ (∀ᵐ x ∂μ, Integrable (fun b ↦ ((∂κ x/∂η x) b).toReal ^ a) (η x)) + ∧ Integrable (fun x ↦ ∫ b, ((∂κ x/∂η x) b).toReal ^ a ∂(η x)) μ := by + rw [← integrable_hellingerFun_iff_integrable_rpow ha_ne, + integrable_f_rnDeriv_compProd_right_iff (convexOn_hellingerFun ha_pos.le)] + simp_rw [integrable_hellingerFun_iff_integrable_rpow ha_ne] + refine and_congr_right fun h_int ↦ ?_ + have h : (fun x ↦ ∫ b, hellingerFun a ((∂κ x/∂η x) b).toReal ∂η x) + =ᵐ[μ] fun x ↦ (a - 1)⁻¹ * ∫ b, ((∂κ x/∂η x) b).toReal ^ a ∂η x + + ((η x) .univ).toReal + (1 - a)⁻¹ * a * ((κ x) .univ).toReal := by + filter_upwards [h_int, h_ac] with x hx_int hx_ac + exact integral_hellingerFun_of_pos_of_ne_one_of_integrable_of_ac ha_pos ha_ne hx_int hx_ac + have hκ : Integrable (fun x ↦ ((κ x) .univ).toReal) μ := + Kernel.IsFiniteKernel.integrable _ _ .univ + have hη : Integrable (fun x ↦ ((η x) .univ).toReal) μ := + Kernel.IsFiniteKernel.integrable _ _ .univ + rw [integrable_congr h, integrable_add_iff_integrable_left' (hκ.const_mul _), + integrable_add_iff_integrable_left' hη, + integrable_const_mul_iff (isUnit_iff_ne_zero.mpr (inv_ne_zero (sub_ne_zero.mpr ha_ne)))] + +section TopAndBounds + +lemma condRenyiDiv_eq_top_iff_of_one_lt [CountableOrCountablyGenerated α β] (ha : 1 < a) + (κ η : Kernel α β) (μ : Measure α) [IsMarkovKernel κ] [IsFiniteKernel η] [IsFiniteMeasure μ] + [NeZero μ] : + condRenyiDiv a κ η μ = ∞ + ↔ ¬ (∀ᵐ x ∂μ, Integrable (fun b ↦ ((∂κ x/∂η x) b).toReal ^ a) (η x)) + ∨ ¬ Integrable (fun x ↦ ∫ b, ((∂κ x/∂η x) b).toReal ^ a ∂η x) μ + ∨ ¬ ∀ᵐ x ∂μ, κ x ≪ η x := by + have : NeZero (μ ⊗ₘ κ) := by + refine ⟨fun h ↦ NeZero.ne μ ?_⟩ + rw [← Measure.measure_univ_eq_zero, ← Measure.compProd_apply_univ (κ := κ), h, + Measure.coe_zero, Pi.zero_apply] + rw [condRenyiDiv, renyiDiv_eq_top_iff_of_one_lt ha, + Measure.absolutelyContinuous_compProd_right_iff] + by_cases h_ac : ∀ᵐ x ∂μ, κ x ≪ η x + · rw [integrable_rpow_rnDeriv_compProd_right_iff (zero_lt_one.trans ha) ha.ne' κ η μ h_ac] + tauto + · tauto + +lemma condRenyiDiv_ne_top_iff_of_one_lt [CountableOrCountablyGenerated α β] (ha : 1 < a) + (κ η : Kernel α β) (μ : Measure α) [IsMarkovKernel κ] [IsFiniteKernel η] [IsFiniteMeasure μ] + [NeZero μ] : + condRenyiDiv a κ η μ ≠ ∞ + ↔ (∀ᵐ x ∂μ, Integrable (fun b ↦ ((∂κ x/∂η x) b).toReal ^ a) (η x)) + ∧ Integrable (fun x ↦ ∫ b, ((∂κ x/∂η x) b).toReal ^ a ∂η x) μ + ∧ ∀ᵐ x ∂μ, κ x ≪ η x := by + rw [ne_eq, condRenyiDiv_eq_top_iff_of_one_lt ha] + push Not + rfl + +lemma condRenyiDiv_eq_top_iff_of_lt_one [CountableOrCountablyGenerated α β] + (ha_nonneg : 0 ≤ a) (ha : a < 1) + (κ η : Kernel α β) (μ : Measure α) [IsFiniteKernel κ] [IsFiniteKernel η] [IsFiniteMeasure μ] : + condRenyiDiv a κ η μ = ∞ ↔ ∀ᵐ x ∂μ, κ x ⟂ₘ η x := by + rw [condRenyiDiv, renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha_nonneg ha, + Measure.mutuallySingular_compProd_right_iff] + +end TopAndBounds + +section DataProcessingInequality + +variable {β : Type*} {mβ : MeasurableSpace β} {κ η : Kernel α β} + +lemma renyiDiv_comp_left_le (ha_pos : 0 < a) (μ : Measure α) [IsFiniteMeasure μ] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + renyiDiv a (κ ∘ₘ μ) (η ∘ₘ μ) ≤ condRenyiDiv a κ η μ := + le_renyiDiv_of_le_hellingerDiv ha_pos (Measure.snd_compProd μ κ ▸ Measure.snd_univ) + (Measure.snd_compProd μ η ▸ Measure.snd_univ) (hellingerDiv_comp_le_compProd μ μ κ η) + +end DataProcessingInequality + +end ProbabilityTheory diff --git a/Statlib/Divergence/Renyi/Variational.lean b/Statlib/Divergence/Renyi/Variational.lean new file mode 100644 index 0000000..7f85dec --- /dev/null +++ b/Statlib/Divergence/Renyi/Variational.lean @@ -0,0 +1,297 @@ +/- +Copyright (c) 2026 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Statlib.Divergence.Renyi.Basic +public import Statlib.ForMathlib.InformationTheory.KullbackLeibler.EIntegral + +/-! +# Variational formula for the Rényi divergence + +For probability measures `μ`, `ν` and `a ∈ (0, 1)`, the Rényi divergence of order `a` is given by +the variational formula `(1 - a) * Rₐ(μ, ν) = ⨅ ξ, (a * KL(ξ, μ) + (1 - a) * KL(ξ, ν))`, where the +infimum is over probability measures `ξ`. + +The infimum is attained at the tilted measure `renyiMeasure a μ ν`, whose density with respect to +`μ + ν` is proportional to `(∂μ/∂(μ + ν)) ^ a * (∂ν/∂(μ + ν)) ^ (1 - a)`: for `ξ ≪ μ` and `ξ ≪ ν`, +the log-likelihood ratios satisfy +`a * llr ξ μ + (1 - a) * llr ξ ν = llr ξ (renyiMeasure a μ ν) + (1 - a) * Rₐ(μ, ν)` almost +everywhere, hence +`a * KL(ξ, μ) + (1 - a) * KL(ξ, ν) = KL(ξ, renyiMeasure a μ ν) + (1 - a) * Rₐ(μ, ν)`. + +## Main definitions + +* `renyiMeasure a μ ν`: the tilted measure with density + `(∂μ/∂(μ + ν)) ^ a * (∂ν/∂(μ + ν)) ^ (1 - a) * exp ((1 - a) * Rₐ(μ, ν))` with respect to + `μ + ν`. + +## Main statements + +* `isProbabilityMeasure_renyiMeasure`: for probability measures that are not mutually singular and + `a ∈ (0, 1)`, `renyiMeasure a μ ν` is a probability measure. +* `mul_klDiv_add_mul_klDiv`: for `ξ ≪ μ` and `ξ ≪ ν`, + `a * KL(ξ, μ) + (1 - a) * KL(ξ, ν) = KL(ξ, renyiMeasure a μ ν) + (1 - a) * Rₐ(μ, ν)`. +* `mul_renyiDiv_eq_iInf_klDiv`: the variational formula + `(1 - a) * Rₐ(μ, ν) = ⨅ ξ, (a * KL(ξ, μ) + (1 - a) * KL(ξ, ν))`. + +## References + +* T. van Erven, P. Harremoës, *Rényi divergence and Kullback-Leibler divergence*, IEEE + Transactions on Information Theory 60(7) (2014), Theorem 30. + +The definition of `renyiMeasure` is adapted from the testing-lower-bounds project of Rémy Degenne +and Lorenzo Luccioli (https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Real MeasureTheory Filter InformationTheory + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν ξ : Measure α} {a : ℝ} + +section RenyiMeasure + +/-- Density of the Rényi measure `renyiMeasure a μ ν` with respect to `μ + ν`. -/ +noncomputable +def renyiDensity (a : ℝ) (μ ν : Measure α) (x : α) : ℝ≥0∞ := + ((∂μ/∂(μ + ν)) x) ^ a * ((∂ν/∂(μ + ν)) x) ^ (1 - a) + * ENNReal.ofReal (exp (- (a - 1) * (renyiDiv a μ ν).toReal)) + +/-- Tilted measure of `μ` with respect to `ν` parametrized by `a`. For probability measures `μ` +and `ν` and `a ∈ (0, 1)` with `μ` and `ν` not mutually singular, its density with respect to +`μ + ν` is `(∂μ/∂(μ + ν)) ^ a * (∂ν/∂(μ + ν)) ^ (1 - a)` divided by the total mass of that +function. -/ +noncomputable +def renyiMeasure (a : ℝ) (μ ν : Measure α) : Measure α := + (μ + ν).withDensity (renyiDensity a μ ν) + +@[fun_prop] +lemma measurable_renyiDensity (a : ℝ) (μ ν : Measure α) : Measurable (renyiDensity a μ ν) := by + unfold renyiDensity + fun_prop + +lemma renyiMeasure_absolutelyContinuous_add (a : ℝ) (μ ν : Measure α) : + renyiMeasure a μ ν ≪ μ + ν := + withDensity_absolutelyContinuous _ _ + +lemma rnDeriv_renyiMeasure (a : ℝ) (μ ν : Measure α) [SigmaFinite μ] [SigmaFinite ν] : + (renyiMeasure a μ ν).rnDeriv (μ + ν) =ᵐ[μ + ν] renyiDensity a μ ν := + Measure.rnDeriv_withDensity _ (measurable_renyiDensity a μ ν) + +lemma sigmaFinite_renyiMeasure [SigmaFinite μ] [SigmaFinite ν] (ha0 : 0 ≤ a) (ha1 : a ≤ 1) : + SigmaFinite (renyiMeasure a μ ν) := by + refine SigmaFinite.withDensity_of_ne_top ?_ + filter_upwards [Measure.rnDeriv_lt_top μ (μ + ν), Measure.rnDeriv_lt_top ν (μ + ν)] + with x hp hq + exact ENNReal.mul_ne_top (ENNReal.mul_ne_top (ENNReal.rpow_ne_top_of_nonneg ha0 hp.ne) + (ENNReal.rpow_ne_top_of_nonneg (sub_nonneg.mpr ha1) hq.ne)) ENNReal.ofReal_ne_top + +/-- For `0 < a`, `renyiMeasure a μ ν ≪ μ`. -/ +lemma renyiMeasure_absolutelyContinuous_left (ν : Measure α) [SigmaFinite μ] [SigmaFinite ν] + (ha0 : 0 < a) : + renyiMeasure a μ ν ≪ μ := by + refine Measure.AbsolutelyContinuous.mk fun s hs hμs ↦ ?_ + rw [← Measure.setLIntegral_rnDeriv' (Measure.AbsolutelyContinuous.rfl.add_right ν) hs, + lintegral_eq_zero_iff (Measure.measurable_rnDeriv _ _), EventuallyEq, + ae_restrict_iff' hs] at hμs + rw [renyiMeasure, withDensity_apply _ hs, lintegral_eq_zero_iff (measurable_renyiDensity a μ ν), + EventuallyEq, ae_restrict_iff' hs] + filter_upwards [hμs] with x hx hxs + simp [renyiDensity, hx hxs, ENNReal.zero_rpow_of_pos ha0] + +/-- For `a < 1`, `renyiMeasure a μ ν ≪ ν`. -/ +lemma renyiMeasure_absolutelyContinuous_right (μ : Measure α) [SigmaFinite μ] [SigmaFinite ν] + (ha1 : a < 1) : + renyiMeasure a μ ν ≪ ν := by + refine Measure.AbsolutelyContinuous.mk fun s hs hνs ↦ ?_ + rw [← Measure.setLIntegral_rnDeriv' (Measure.AbsolutelyContinuous.rfl.add_right' μ) hs, + lintegral_eq_zero_iff (Measure.measurable_rnDeriv _ _), EventuallyEq, + ae_restrict_iff' hs] at hνs + rw [renyiMeasure, withDensity_apply _ hs, lintegral_eq_zero_iff (measurable_renyiDensity a μ ν), + EventuallyEq, ae_restrict_iff' hs] + filter_upwards [hνs] with x hx hxs + simp [renyiDensity, hx hxs, ENNReal.zero_rpow_of_pos (sub_pos.mpr ha1)] + +/-- A measure absolutely continuous with respect to both `μ` and `ν` is absolutely continuous with +respect to `renyiMeasure a μ ν`. -/ +lemma absolutelyContinuous_renyiMeasure (a : ℝ) [SigmaFinite μ] [SigmaFinite ν] (hξμ : ξ ≪ μ) + (hξν : ξ ≪ ν) : + ξ ≪ renyiMeasure a μ ν := by + have hξ : ξ ≪ μ + ν := hξμ.add_right ν + have h_ne_zero : ∀ᵐ x ∂ξ, renyiDensity a μ ν x ≠ 0 := by + filter_upwards [hξμ (Measure.rnDeriv_pos (Measure.AbsolutelyContinuous.rfl.add_right ν)), + hξν (Measure.rnDeriv_pos (Measure.AbsolutelyContinuous.rfl.add_right' μ)), + hξ (Measure.rnDeriv_lt_top μ (μ + ν)), hξ (Measure.rnDeriv_lt_top ν (μ + ν))] + with x hp hq hp_top hq_top + exact mul_ne_zero (mul_ne_zero (ENNReal.rpow_pos hp hp_top.ne).ne' + (ENNReal.rpow_pos hq hq_top.ne).ne') (ENNReal.ofReal_pos.mpr (exp_pos _)).ne' + refine Measure.AbsolutelyContinuous.mk fun s hs h0 ↦ ?_ + rw [renyiMeasure, withDensity_apply _ hs, lintegral_eq_zero_iff (measurable_renyiDensity a μ ν), + EventuallyEq, ae_restrict_iff' hs] at h0 + rw [measure_eq_zero_iff_ae_notMem] + filter_upwards [hξ h0, h_ne_zero] with x hx h_ne hxs + exact h_ne (hx hxs) + +/-- For probability measures that are not mutually singular and `a ∈ (0, 1)`, the tilted measure +`renyiMeasure a μ ν` is a probability measure. -/ +lemma isProbabilityMeasure_renyiMeasure [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (ha0 : 0 < a) (ha1 : a < 1) (h_ms : ¬ μ ⟂ₘ ν) : + IsProbabilityMeasure (renyiMeasure a μ ν) := by + constructor + set Z := ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν with hZ + have hZ_pos : 0 < Z := (integral_rpow_rnDeriv_pos_iff_not_mutuallySingular ha0.ne' + (integrable_rpow_rnDeriv_of_lt_one ha0.le ha1)).mpr h_ms + have h_exp : exp (-(a - 1) * (renyiDiv a μ ν).toReal) = Z⁻¹ := by + rw [toReal_renyiDiv_of_lt_one ha0 ha1 h_ms] + simp only [measure_univ, ENNReal.toReal_one, log_one, mul_zero, add_zero, sub_zero, ← hZ] + rw [← mul_assoc, neg_mul, mul_inv_cancel₀ (sub_ne_zero.mpr ha1.ne), neg_one_mul, exp_neg, + exp_log hZ_pos] + have h_int : ∫⁻ x, (μ.rnDeriv ν x) ^ a ∂ν = ENNReal.ofReal Z := by + rw [hZ, ofReal_integral_eq_lintegral_ofReal (integrable_rpow_rnDeriv_of_lt_one ha0.le ha1) + (ae_of_all _ fun _ ↦ by positivity)] + refine lintegral_congr_ae ?_ + filter_upwards [Measure.rnDeriv_lt_top μ ν] with x hx_top + rw [ENNReal.toReal_rpow, + ENNReal.ofReal_toReal (ENNReal.rpow_ne_top_of_nonneg ha0.le hx_top.ne)] + rw [renyiMeasure, withDensity_apply _ MeasurableSet.univ, Measure.restrict_univ] + simp_rw [renyiDensity] + rw [lintegral_mul_const _ (by fun_prop), + lintegral_rpow_rnDeriv_add_mul_rpow_rnDeriv_add ha0.le ha1, h_int, h_exp, + ← ENNReal.ofReal_mul hZ_pos.le, mul_inv_cancel₀ hZ_pos.ne', ENNReal.ofReal_one] + +end RenyiMeasure + +section Variational + +/-- For `ξ ≪ μ` and `ξ ≪ ν`, the log-likelihood ratios satisfy +`a * llr ξ μ + (1 - a) * llr ξ ν = llr ξ (renyiMeasure a μ ν) + (1 - a) * Rₐ(μ, ν)`, +`ξ`-almost everywhere. -/ +lemma mul_llr_add_mul_llr_ae_eq [SigmaFinite μ] [SigmaFinite ν] [SigmaFinite ξ] (ha0 : 0 ≤ a) + (ha1 : a ≤ 1) (hξμ : ξ ≪ μ) (hξν : ξ ≪ ν) : + ∀ᵐ x ∂ξ, a * llr ξ μ x + (1 - a) * llr ξ ν x + = llr ξ (renyiMeasure a μ ν) x + (1 - a) * (renyiDiv a μ ν).toReal := by + have := sigmaFinite_renyiMeasure (μ := μ) (ν := ν) ha0 ha1 + have hμ : μ ≪ μ + ν := Measure.AbsolutelyContinuous.rfl.add_right ν + have hν : ν ≪ μ + ν := Measure.AbsolutelyContinuous.rfl.add_right' μ + have hξ : ξ ≪ μ + ν := hξμ.add_right ν + have hξR : ξ ≪ renyiMeasure a μ ν := absolutelyContinuous_renyiMeasure a hξμ hξν + filter_upwards [hξμ.ae_le (Measure.rnDeriv_eq_div hξ hμ), + hξν.ae_le (Measure.rnDeriv_eq_div hξ hν), + hξR.ae_le (Measure.rnDeriv_eq_div hξ (renyiMeasure_absolutelyContinuous_add a μ ν)), + hξ.ae_le (rnDeriv_renyiMeasure a μ ν), Measure.rnDeriv_pos hξ, + hξ.ae_le (Measure.rnDeriv_lt_top ξ (μ + ν)), hξμ.ae_le (Measure.rnDeriv_pos hμ), + hξ.ae_le (Measure.rnDeriv_lt_top μ (μ + ν)), hξν.ae_le (Measure.rnDeriv_pos hν), + hξ.ae_le (Measure.rnDeriv_lt_top ν (μ + ν))] + with x h1 h2 h3 h4 hr hr_top hp hp_top hq hq_top + have hr' : 0 < (ξ.rnDeriv (μ + ν) x).toReal := ENNReal.toReal_pos hr.ne' hr_top.ne + have hp' : 0 < (μ.rnDeriv (μ + ν) x).toReal := ENNReal.toReal_pos hp.ne' hp_top.ne + have hq' : 0 < (ν.rnDeriv (μ + ν) x).toReal := ENNReal.toReal_pos hq.ne' hq_top.ne + have hpa : 0 < (μ.rnDeriv (μ + ν) x).toReal ^ a := rpow_pos_of_pos hp' a + have hqa : 0 < (ν.rnDeriv (μ + ν) x).toReal ^ (1 - a) := rpow_pos_of_pos hq' (1 - a) + simp only [llr, h1, h2, h3, h4, renyiDensity, ENNReal.toReal_div, ENNReal.toReal_mul, + ← ENNReal.toReal_rpow, ENNReal.toReal_ofReal (exp_pos _).le] + rw [log_div hr'.ne' hp'.ne', log_div hr'.ne' hq'.ne', + log_div hr'.ne' (mul_pos (mul_pos hpa hqa) (exp_pos _)).ne', + log_mul (mul_pos hpa hqa).ne' (exp_pos _).ne', log_mul hpa.ne' hqa.ne', log_rpow hp', + log_rpow hq', log_exp] + ring + +/-- For `ξ ≪ μ` and `ξ ≪ ν` with `ξ` a probability measure, the extended integrals of the +log-likelihood ratios satisfy +`a * ∫ llr ξ μ + (1 - a) * ∫ llr ξ ν = ∫ llr ξ (renyiMeasure a μ ν) + (1 - a) * Rₐ(μ, ν)`. -/ +lemma mul_eintegral_llr_add_mul_eintegral_llr [IsFiniteMeasure μ] [IsFiniteMeasure ν] + [IsProbabilityMeasure ξ] (ha0 : 0 ≤ a) (ha1 : a ≤ 1) (hξμ : ξ ≪ μ) (hξν : ξ ≪ ν) : + (a : EReal) * ∫ᵉ x, llr ξ μ x ∂ξ + ((1 - a : ℝ) : EReal) * ∫ᵉ x, llr ξ ν x ∂ξ + = ∫ᵉ x, llr ξ (renyiMeasure a μ ν) x ∂ξ + ((1 - a) * (renyiDiv a μ ν).toReal : ℝ) := by + have ha1' : 0 ≤ 1 - a := sub_nonneg.mpr ha1 + have coe_mul_ne_bot {c : ℝ} (hc : 0 ≤ c) {x : EReal} (hx : x ≠ ⊥) : (c : EReal) * x ≠ ⊥ := + (EReal.mul_ne_bot _ _).mpr ⟨.inl (EReal.coe_ne_bot c), .inr hx, .inl (EReal.coe_ne_top c), + .inl (EReal.coe_nonneg.mpr hc)⟩ + have h_bot_μ : ∫ᵉ x, (a : EReal) * llr ξ μ x ∂ξ ≠ ⊥ := by + rw [eintegral_real_const_mul_of_nonneg ha0] + exact coe_mul_ne_bot ha0 (eintegral_llr_ne_bot hξμ) + have h_bot_ν : ∫ᵉ x, ((1 - a : ℝ) : EReal) * llr ξ ν x ∂ξ ≠ ⊥ := by + rw [eintegral_real_const_mul_of_nonneg ha1'] + exact coe_mul_ne_bot ha1' (eintegral_llr_ne_bot hξν) + calc (a : EReal) * ∫ᵉ x, llr ξ μ x ∂ξ + ((1 - a : ℝ) : EReal) * ∫ᵉ x, llr ξ ν x ∂ξ + _ = ∫ᵉ x, (a : EReal) * llr ξ μ x + ((1 - a : ℝ) : EReal) * llr ξ ν x ∂ξ := by + rw [eintegral_add (by fun_prop) (by fun_prop) (eintegrable_of_eintegral_ne_bot h_bot_ν) + (.inl h_bot_μ) (.inr h_bot_ν), eintegral_real_const_mul_of_nonneg ha0, + eintegral_real_const_mul_of_nonneg ha1'] + _ = ∫ᵉ x, llr ξ (renyiMeasure a μ ν) x + ((1 - a) * (renyiDiv a μ ν).toReal : ℝ) ∂ξ := by + refine eintegral_congr_ae ?_ + filter_upwards [mul_llr_add_mul_llr_ae_eq ha0 ha1 hξμ hξν] with x hx + exact_mod_cast hx + _ = ∫ᵉ x, llr ξ (renyiMeasure a μ ν) x ∂ξ + ((1 - a) * (renyiDiv a μ ν).toReal : ℝ) := by + have h_const : ∫ᵉ _, (((1 - a) * (renyiDiv a μ ν).toReal : ℝ) : EReal) ∂ξ + = ((1 - a) * (renyiDiv a μ ν).toReal : ℝ) := by + rw [eintegral_const, measure_univ, EReal.coe_ennreal_one, mul_one] + rw [eintegral_add' (by fun_prop) (by fun_prop) (by rw [h_const]; exact EReal.coe_ne_top _) + (by rw [h_const]; exact EReal.coe_ne_bot _), h_const] + +/-- For probability measures `ξ ≪ μ` and `ξ ≪ ν` and `a ∈ (0, 1)`, +`a * KL(ξ, μ) + (1 - a) * KL(ξ, ν) = KL(ξ, renyiMeasure a μ ν) + (1 - a) * Rₐ(μ, ν)`. -/ +theorem mul_klDiv_add_mul_klDiv [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + [IsProbabilityMeasure ξ] (ha0 : 0 < a) (ha1 : a < 1) (hξμ : ξ ≪ μ) (hξν : ξ ≪ ν) : + ENNReal.ofReal a * klDiv ξ μ + ENNReal.ofReal (1 - a) * klDiv ξ ν + = klDiv ξ (renyiMeasure a μ ν) + ENNReal.ofReal (1 - a) * renyiDiv a μ ν := by + have h_ms : ¬ μ ⟂ₘ ν := fun h ↦ IsProbabilityMeasure.ne_zero ξ + (Measure.eq_zero_of_absolutelyContinuous_of_mutuallySingular hξν + (h.mono_ac hξμ Measure.AbsolutelyContinuous.rfl)) + have := isProbabilityMeasure_renyiMeasure ha0 ha1 h_ms + have h_top : renyiDiv a μ ν ≠ ∞ := + (renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha0.le ha1).not.mpr h_ms + rw [← EReal.coe_ennreal_eq_coe_ennreal_iff] + simp only [EReal.coe_ennreal_add, EReal.coe_ennreal_mul, EReal.coe_ennreal_ofReal, + max_eq_left ha0.le, max_eq_left (sub_nonneg.mpr ha1.le)] + rw [coe_klDiv_eq_eintegral_llr_of_measure_eq hξμ (by simp), + coe_klDiv_eq_eintegral_llr_of_measure_eq hξν (by simp), + coe_klDiv_eq_eintegral_llr_of_measure_eq (absolutelyContinuous_renyiMeasure a hξμ hξν) + (by simp), + mul_eintegral_llr_add_mul_eintegral_llr ha0.le ha1.le hξμ hξν, ← EReal.coe_ennreal_toReal h_top, + EReal.coe_mul] + +/-- **Variational formula** for the Rényi divergence: for probability measures `μ`, `ν` and +`a ∈ (0, 1)`, `(1 - a) * Rₐ(μ, ν) = ⨅ ξ, (a * KL(ξ, μ) + (1 - a) * KL(ξ, ν))` over probability +measures `ξ`. The infimum is attained at `renyiMeasure a μ ν` if `μ` and `ν` are not mutually +singular. -/ +theorem mul_renyiDiv_eq_iInf_klDiv [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] (ha0 : 0 < a) + (ha1 : a < 1) : + ENNReal.ofReal (1 - a) * renyiDiv a μ ν + = ⨅ (ξ : Measure α) (_ : IsProbabilityMeasure ξ), + ENNReal.ofReal a * klDiv ξ μ + ENNReal.ofReal (1 - a) * klDiv ξ ν := by + have ha : ENNReal.ofReal a ≠ 0 := by simp [ha0] + have ha' : ENNReal.ofReal (1 - a) ≠ 0 := by simp [ha1] + -- if `ξ` is not absolutely continuous with respect to both measures, the right-hand side is `∞` + have h_top (ξ : Measure α) (h : ¬ (ξ ≪ μ ∧ ξ ≪ ν)) : + ENNReal.ofReal a * klDiv ξ μ + ENNReal.ofReal (1 - a) * klDiv ξ ν = ∞ := by + rw [not_and_or] at h + rcases h with h | h + · simp [klDiv_of_not_ac h, ENNReal.mul_top ha] + · simp [klDiv_of_not_ac h, ENNReal.mul_top ha'] + by_cases h_ms : μ ⟂ₘ ν + · rw [(renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha0.le ha1).mpr h_ms, ENNReal.mul_top ha', + eq_comm, iInf₂_eq_top] + refine fun ξ hξ ↦ h_top ξ fun h ↦ IsProbabilityMeasure.ne_zero ξ ?_ + exact Measure.eq_zero_of_absolutelyContinuous_of_mutuallySingular h.2 + (h_ms.mono_ac h.1 Measure.AbsolutelyContinuous.rfl) + have := isProbabilityMeasure_renyiMeasure ha0 ha1 h_ms + refine le_antisymm (le_iInf₂ fun ξ hξ ↦ ?_) (iInf₂_le_of_le (renyiMeasure a μ ν) this ?_) + · by_cases h : ξ ≪ μ ∧ ξ ≪ ν + · rw [mul_klDiv_add_mul_klDiv ha0 ha1 h.1 h.2] + exact le_add_self + · rw [h_top ξ h] + exact le_top + · rw [mul_klDiv_add_mul_klDiv ha0 ha1 (renyiMeasure_absolutelyContinuous_left ν ha0) + (renyiMeasure_absolutelyContinuous_right μ ha1), klDiv_self, zero_add] + +end Variational + +end ProbabilityTheory diff --git a/Statlib/Divergence/StatInfo/Basic.lean b/Statlib/Divergence/StatInfo/Basic.lean new file mode 100644 index 0000000..1ddc7be --- /dev/null +++ b/Statlib/Divergence/StatInfo/Basic.lean @@ -0,0 +1,294 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.Probability.Decision.Risk.RiskIncrease +public import Statlib.ForMathlib.ENNReal +public import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.RadonNikodym +public import Statlib.Testing.Binary + +/-! +# Statistical information + +The statistical information of two measures `μ` and `ν` with respect to a prior `π` on `Bool` is +the decrease of the Bayes risk of the simple binary hypothesis testing problem between `μ` and `ν` +obtained by observing the data. It is a divergence between `μ` and `ν` which satisfies the +data-processing inequality. The total variation distance is a statistical information (see +`Statlib.Divergence.TotalVariation`), and every f-divergence is an integral of statistical +informations (Liese and Vajda). + +## Main definitions + +* `statInfo μ ν π`: the statistical information of the measures `μ` and `ν` with respect to the + prior `π` on `Bool`, the difference between the Bayes risks of the testing problem without and + with observations. + +## Main statements + +* `statInfo_comp_le`: **data-processing inequality** for the statistical information. +* `statInfo_eq_lintegral_add_of_le`, `statInfo_eq_lintegral_of_ge`: the statistical information as + an integral with respect to `ν`, plus a contribution of the singular part of `μ`. +* `toReal_statInfo_eq_integral_max_of_le`, `toReal_statInfo_eq_integral_max_of_ge`, + `toReal_statInfo_eq_integral_abs`: integral forms of the statistical information. + +## References + +* M. H. DeGroot, *Uncertainty, information, and sequential experiments*, Ann. Math. Statist. 33 + (1962). +* F. Liese, I. Vajda, *On divergences and informations in statistics and information theory*, + IEEE Trans. Inform. Theory 52 (2006). + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open MeasureTheory Set + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +variable {𝒳 𝒳' : Type*} {m𝒳 : MeasurableSpace 𝒳} {m𝒳' : MeasurableSpace 𝒳'} + {μ ν : Measure 𝒳} {π : Measure Bool} + +/-- The statistical information of the measures `μ` and `ν` with respect to the prior `π` on +`Bool`: the increase of the Bayes risk of the binary testing problem between `μ` and `ν` when the +observation is discarded. -/ +noncomputable +def statInfo (μ ν : Measure 𝒳) (π : Measure Bool) : ℝ≥0∞ := + riskIncrease simpleBinaryLoss (Kernel.boolKernel μ ν) π + +lemma statInfo_eq_riskIncrease (μ ν : Measure 𝒳) (π : Measure Bool) : + statInfo μ ν π = riskIncrease simpleBinaryLoss (Kernel.boolKernel μ ν) π := rfl + +lemma statInfo_eq_min_sub (μ ν : Measure 𝒳) (π : Measure Bool) : + statInfo μ ν π = min (π {false} * μ univ) (π {true} * ν univ) - bayesBinaryRisk μ ν π := by + rw [statInfo, riskIncrease_eq_iInf_sub' measurable_simpleBinaryLoss, iInf_bool_eq] + simp [lintegral_bool, bayesBinaryRisk, mul_comm] + +@[simp] lemma statInfo_zero_left : statInfo 0 ν π = 0 := by simp [statInfo_eq_min_sub] + +@[simp] lemma statInfo_zero_right : statInfo μ 0 π = 0 := by simp [statInfo_eq_min_sub] + +@[simp] lemma statInfo_zero_prior : statInfo μ ν 0 = 0 := by simp [statInfo_eq_min_sub] + +@[simp] lemma statInfo_self : statInfo μ μ π = 0 := by + simp [statInfo_eq_min_sub, min_mul_mul_right] + +lemma statInfo_le_min (μ ν : Measure 𝒳) (π : Measure Bool) : + statInfo μ ν π ≤ min (π {false} * μ univ) (π {true} * ν univ) := + statInfo_eq_min_sub μ ν π ▸ tsub_le_self + +lemma statInfo_ne_top (μ ν : Measure 𝒳) [IsFiniteMeasure μ] (π : Measure Bool) + [IsFiniteMeasure π] : + statInfo μ ν π ≠ ∞ := + ((statInfo_le_min μ ν π).trans_lt <| min_lt_iff.mpr <| Or.inl + <| ENNReal.mul_lt_top (measure_lt_top π _) (measure_lt_top μ _)).ne + +lemma statInfo_symm : statInfo μ ν π = statInfo ν μ (π.map Bool.not) := by + have h_false : π.map Bool.not {false} = π {true} := by + rw [Measure.map_apply (measurable_of_countable _) (measurableSet_singleton _)] + simp [Set.preimage] + have h_true : π.map Bool.not {true} = π {false} := by + rw [Measure.map_apply (measurable_of_countable _) (measurableSet_singleton _)] + simp [Set.preimage] + rw [statInfo_eq_min_sub, statInfo_eq_min_sub, bayesBinaryRisk_symm μ ν π, h_false, h_true, + min_comm] + +lemma statInfo_of_measure_true_eq_zero (μ ν : Measure 𝒳) (hπ : π {true} = 0) : + statInfo μ ν π = 0 := + le_antisymm ((statInfo_le_min μ ν π).trans (by simp [hπ])) zero_le + +lemma statInfo_of_measure_false_eq_zero (μ ν : Measure 𝒳) (hπ : π {false} = 0) : + statInfo μ ν π = 0 := + le_antisymm ((statInfo_le_min μ ν π).trans (by simp [hπ])) zero_le + +/-- **Data processing inequality** for the statistical information. -/ +lemma statInfo_comp_le (μ ν : Measure 𝒳) (π : Measure Bool) (η : Kernel 𝒳 𝒳') [IsMarkovKernel η] : + statInfo (η ∘ₘ μ) (η ∘ₘ ν) π ≤ statInfo μ ν π := by + simpa [statInfo, Kernel.comp_boolKernel] + using riskIncrease_comp_le simpleBinaryLoss (Kernel.boolKernel μ ν) π η + +/-- **Data processing inequality** for the statistical information, applied to the indicator of an +event `E`. -/ +lemma statInfo_boolMeasure_le (μ ν : Measure 𝒳) (π : Measure Bool) {E : Set 𝒳} + (hE : MeasurableSet E) : + statInfo (Measure.boolMeasure (μ Eᶜ) (μ E)) (Measure.boolMeasure (ν Eᶜ) (ν E)) π + ≤ statInfo μ ν π := by + classical + have h := statInfo_comp_le μ ν π (Kernel.deterministic _ (measurable_decide_mem hE)) + rwa [Measure.deterministic_comp_eq_map, Measure.deterministic_comp_eq_map, + Measure.map_decide_mem_eq_boolMeasure μ hE, Measure.map_decide_mem_eq_boolMeasure ν hE] at h + +lemma statInfo_eq_min_sub_lintegral (μ ν : Measure 𝒳) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (π : Measure Bool) [IsFiniteMeasure π] : + statInfo μ ν π = min (π {false} * μ univ) (π {true} * ν univ) + - ∫⁻ x, min (π {false} * μ.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x) + (π {true} * ν.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x) ∂(Kernel.boolKernel μ ν ∘ₘ π) := by + rw [statInfo_eq_min_sub, bayesBinaryRisk_eq_lintegral_min] + +lemma statInfo_eq_min_sub_lintegral' {ζ : Measure 𝒳} [IsFiniteMeasure μ] [IsFiniteMeasure ν] + [SigmaFinite ζ] (π : Measure Bool) [IsFiniteMeasure π] (hμζ : μ ≪ ζ) (hνζ : ν ≪ ζ) : + statInfo μ ν π = min (π {false} * μ univ) (π {true} * ν univ) + - ∫⁻ x, min (π {false} * (∂μ/∂ζ) x) (π {true} * (∂ν/∂ζ) x) ∂ζ := by + by_cases h_false : π {false} = 0 + · simp [statInfo_eq_min_sub, h_false, bayesBinaryRisk_of_measure_false_eq_zero] + by_cases h_true : π {true} = 0 + · simp [statInfo_eq_min_sub, h_true, bayesBinaryRisk_of_measure_true_eq_zero] + have hμac : μ ≪ (Kernel.boolKernel μ ν ∘ₘ π) := + absolutelyContinuous_boolKernel_comp_left μ ν h_false + have hνac : ν ≪ (Kernel.boolKernel μ ν ∘ₘ π) := + absolutelyContinuous_boolKernel_comp_right μ ν h_true + have hacζ : (Kernel.boolKernel μ ν ∘ₘ π) ≪ ζ := + boolKernel_comp_measure _ _ _ ▸ (hνζ.smul_left _).add_left (hμζ.smul_left _) + rw [statInfo_eq_min_sub_lintegral, ← lintegral_rnDeriv_mul hacζ (by fun_prop)] + congr 1 + apply lintegral_congr_ae + filter_upwards [Measure.rnDeriv_mul_rnDeriv hμac, Measure.rnDeriv_mul_rnDeriv hνac] with x hxμ hxν + rw [mul_min, mul_comm, mul_comm _ (π _ * _), mul_assoc, mul_assoc] + congr + +lemma toReal_statInfo_eq_min_sub_integral (μ ν : Measure 𝒳) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (π : Measure Bool) [IsFiniteMeasure π] : + (statInfo μ ν π).toReal = min (π {false} * μ univ).toReal (π {true} * ν univ).toReal + - ∫ x, min (π {false} * μ.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x).toReal + (π {true} * ν.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x).toReal + ∂(Kernel.boolKernel μ ν ∘ₘ π) := by + have hμ : π {false} * μ univ ≠ ⊤ := ENNReal.mul_ne_top (measure_ne_top π _) (measure_ne_top μ _) + have hν : π {true} * ν univ ≠ ⊤ := ENNReal.mul_ne_top (measure_ne_top π _) (measure_ne_top ν _) + rw [statInfo_eq_min_sub, ENNReal.toReal_sub_of_le (bayesBinaryRisk_le_min μ ν π)] + swap; · simp only [ne_eq, min_eq_top, hμ, hν, and_self, not_false_eq_true] + rw [toReal_bayesBinaryRisk_eq_integral_min, + MonotoneOn.map_min (s := {x : ℝ≥0∞ | x ≠ ∞}) + (fun _ _ _ hb hab ↦ ENNReal.toReal_mono hb hab) hμ hν] + +/-- The statistical information as an integral with respect to `ν`, when +`π {false} * μ univ ≤ π {true} * ν univ`. -/ +lemma statInfo_eq_lintegral_add_of_le [IsFiniteMeasure μ] [IsFiniteMeasure ν] [IsFiniteMeasure π] + (h : π {false} * μ univ ≤ π {true} * ν univ) : + statInfo μ ν π = ∫⁻ x, π {false} * (∂μ/∂ν) x - π {true} ∂ν + + π {false} * μ.singularPart ν univ := by + have h_le : ∫⁻ x, min (π {false} * (∂μ/∂ν) x) (π {true}) ∂ν + ≤ ∫⁻ x, π {false} * (∂μ/∂ν) x ∂ν := lintegral_mono fun _ ↦ min_le_left _ _ + have h_fin : ∫⁻ x, min (π {false} * (∂μ/∂ν) x) (π {true}) ∂ν ≠ ∞ := by + refine ne_top_of_le_ne_top ?_ h_le + rw [lintegral_const_mul _ (μ.measurable_rnDeriv ν)] + exact ENNReal.mul_ne_top (measure_ne_top _ _) (Measure.lintegral_rnDeriv_lt_top μ ν).ne + rw [statInfo_eq_min_sub, min_eq_left h, bayesBinaryRisk_eq_lintegral_min_rnDeriv, + ← Measure.singularPart_add_lintegral_rnDeriv μ ν, mul_add, + ← lintegral_const_mul _ (μ.measurable_rnDeriv ν), + (ENNReal.cancel_of_ne h_fin).add_tsub_assoc_of_le h_le, + ← lintegral_sub (by fun_prop) h_fin (ae_of_all _ fun _ ↦ min_le_left _ _), add_comm] + simp_rw [tsub_min] + +/-- The statistical information as an integral with respect to `ν`, when +`π {true} * ν univ ≤ π {false} * μ univ`. -/ +lemma statInfo_eq_lintegral_of_ge [IsFiniteMeasure μ] [IsFiniteMeasure ν] [IsFiniteMeasure π] + (h : π {true} * ν univ ≤ π {false} * μ univ) : + statInfo μ ν π = ∫⁻ x, π {true} - π {false} * (∂μ/∂ν) x ∂ν := by + have h_fin : ∫⁻ x, min (π {false} * (∂μ/∂ν) x) (π {true}) ∂ν ≠ ∞ := by + refine ne_top_of_le_ne_top ?_ (lintegral_mono fun _ ↦ min_le_right _ _) + rw [lintegral_const] + exact ENNReal.mul_ne_top (measure_ne_top _ _) (measure_ne_top _ _) + rw [statInfo_eq_min_sub, min_eq_right h, bayesBinaryRisk_eq_lintegral_min_rnDeriv, + ← lintegral_const, ← lintegral_sub (by fun_prop) h_fin (ae_of_all _ fun _ ↦ min_le_right _ _)] + simp_rw [min_comm _ (π {true}), tsub_min] + +/-- Integral form of the statistical information, when `π {false} * μ univ ≤ π {true} * ν univ`. -/ +lemma toReal_statInfo_eq_integral_max_of_le [IsFiniteMeasure μ] [IsFiniteMeasure ν] + [IsFiniteMeasure π] (h : π {false} * μ univ ≤ π {true} * ν univ) : + (statInfo μ ν π).toReal + = ∫ x, max 0 ((π {false} * (∂μ/∂ν) x).toReal - (π {true}).toReal) ∂ν + + (π {false} * μ.singularPart ν univ).toReal := by + have h_fin : ∫⁻ x, π {false} * (∂μ/∂ν) x - π {true} ∂ν ≠ ∞ := by + refine ne_top_of_le_ne_top ?_ (lintegral_mono fun _ ↦ tsub_le_self) + rw [lintegral_const_mul _ (μ.measurable_rnDeriv ν)] + exact ENNReal.mul_ne_top (measure_ne_top _ _) (Measure.lintegral_rnDeriv_lt_top μ ν).ne + have h_int : ∫ x, max 0 ((π {false} * (∂μ/∂ν) x).toReal - (π {true}).toReal) ∂ν + = (∫⁻ x, π {false} * (∂μ/∂ν) x - π {true} ∂ν).toReal := by + rw [← integral_toReal (by fun_prop)] + · refine integral_congr_ae ?_ + filter_upwards [μ.rnDeriv_ne_top ν] with x hx + rw [ENNReal.toReal_sub_eq_max_zero (by finiteness) (measure_ne_top _ _)] + · filter_upwards [μ.rnDeriv_ne_top ν] with x hx + exact tsub_le_self.trans_lt (by finiteness) + rw [statInfo_eq_lintegral_add_of_le h, ENNReal.toReal_add h_fin (by finiteness), h_int] + +/-- Integral form of the statistical information, when `π {true} * ν univ ≤ π {false} * μ univ`. -/ +lemma toReal_statInfo_eq_integral_max_of_ge [IsFiniteMeasure μ] [IsFiniteMeasure ν] + [IsFiniteMeasure π] (h : π {true} * ν univ ≤ π {false} * μ univ) : + (statInfo μ ν π).toReal + = ∫ x, max 0 ((π {true}).toReal - (π {false} * (∂μ/∂ν) x).toReal) ∂ν := by + rw [statInfo_eq_lintegral_of_ge h, ← integral_toReal (by fun_prop)] + · refine integral_congr_ae ?_ + filter_upwards [μ.rnDeriv_ne_top ν] with x hx + rw [ENNReal.toReal_sub_eq_max_zero (measure_ne_top _ _) (by finiteness)] + · exact ae_of_all _ fun _ ↦ tsub_le_self.trans_lt (measure_lt_top _ _) + +lemma toReal_statInfo_eq_integral_abs (μ ν : Measure 𝒳) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + {π : Measure Bool} [IsFiniteMeasure π] : + (statInfo μ ν π).toReal + = 2⁻¹ * (-|(π {false} * μ univ).toReal - (π {true} * ν univ).toReal| + + ∫ x, |(π {false} * (∂μ/∂ν) x).toReal - (π {true}).toReal| ∂ν + + (π {false} * (μ.singularPart ν) univ).toReal) := by + rcases le_total (π {false} * μ univ) (π {true} * ν univ) with (h | h) + · rw [abs_of_nonpos] + swap + · refine sub_nonpos.mpr <| (ENNReal.toReal_le_toReal ?_ ?_).mpr h + <;> try simp only [ne_eq, measure_ne_top _ _, not_false_eq_true, ENNReal.mul_ne_top] + simp_rw [toReal_statInfo_eq_integral_max_of_le h, sup_eq_half_smul_add_add_abs_sub' ℝ, + smul_eq_mul, zero_add, sub_zero, integral_const_mul] + calc + _ = 2⁻¹ * (∫ x, (π {false} * (∂μ/∂ν) x).toReal ∂ν - ∫ _, (π {true}).toReal ∂ν + + ∫ x, |(π {false} * (∂μ/∂ν) x).toReal - (π {true}).toReal| ∂ν) + + (π {false} * (μ.singularPart ν) univ).toReal := by + simp_rw [ENNReal.toReal_mul] + have : Integrable (fun x ↦ (π {false}).toReal * ((∂μ/∂ν) x).toReal - (π {true}).toReal) ν := + (Measure.integrable_toReal_rnDeriv.const_mul _).sub (integrable_const _) + rw [integral_add this this.abs, integral_sub + (Measure.integrable_toReal_rnDeriv.const_mul _) (integrable_const _)] + _ = 2⁻¹ * ((π {false} * μ univ).toReal - (π {false} * (μ.singularPart ν) univ).toReal + - (π {true} * ν univ).toReal + + ∫ x, |(π {false} * (∂μ/∂ν) x).toReal - (π {true}).toReal| ∂ν) + + (π {false} * (μ.singularPart ν) univ).toReal := by + congr + · simp_rw [ENNReal.toReal_mul, integral_const_mul, Measure.integral_toReal_rnDeriv', + measureReal_def, mul_sub] + · rw [integral_const, smul_eq_mul, measureReal_def, ENNReal.toReal_mul, mul_comm] + _ = _ := by ring + · rw [abs_of_nonneg] + swap + · refine sub_nonneg.mpr <| (ENNReal.toReal_le_toReal ?_ ?_).mpr h + <;> try simp only [ne_eq, measure_ne_top _ _, not_false_eq_true, ENNReal.mul_ne_top] + simp_rw [toReal_statInfo_eq_integral_max_of_ge h, sup_eq_half_smul_add_add_abs_sub' ℝ, + smul_eq_mul, zero_add, sub_zero, integral_const_mul] + calc + _ = 2⁻¹ * (∫ _, (π {true}).toReal ∂ν - ∫ x, (π {false} * (∂μ/∂ν) x).toReal ∂ν + + ∫ x, |(π {true}).toReal - (π {false} * (∂μ/∂ν) x).toReal| ∂ν) := by + simp_rw [ENNReal.toReal_mul] + have : Integrable (fun x ↦ (π {true}).toReal - (π {false}).toReal * ((∂μ/∂ν) x).toReal) ν := + (integrable_const _).sub (Measure.integrable_toReal_rnDeriv.const_mul _) + rw [integral_add this this.abs, integral_sub (integrable_const _) + (Measure.integrable_toReal_rnDeriv.const_mul _)] + _ = 2⁻¹ * ((π {true} * ν univ).toReal - (π {false} * μ univ).toReal + + (π {false} * (μ.singularPart ν) univ).toReal + + ∫ x, |(π {true}).toReal - (π {false} * (∂μ/∂ν) x).toReal| ∂ν) := by + simp_rw [ENNReal.toReal_mul, integral_const_mul, Measure.integral_toReal_rnDeriv', + measureReal_def, mul_sub] + rw [integral_const, smul_eq_mul, measureReal_def, ← sub_add, mul_comm (ν univ).toReal] + _ = _ := by + simp_rw [abs_sub_comm] + ring + +lemma statInfo_eq_min_sub_iInf_measurableSet (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] : + statInfo μ ν π = min (π {false} * μ univ) (π {true} * ν univ) + - ⨅ E, ⨅ (_ : MeasurableSet E), π {false} * μ E + π {true} * ν Eᶜ := by + rw [statInfo_eq_min_sub, bayesBinaryRisk_eq_iInf_measurableSet] + +end ProbabilityTheory diff --git a/Statlib/Divergence/StatInfo/FDiv.lean b/Statlib/Divergence/StatInfo/FDiv.lean new file mode 100644 index 0000000..978ce95 --- /dev/null +++ b/Statlib/Divergence/StatInfo/FDiv.lean @@ -0,0 +1,333 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Statlib.Divergence.FDiv.Basic +public import Statlib.Divergence.StatInfo.Basic +public import Statlib.Divergence.StatInfo.StatInfoDivFun + +/-! +# The statistical information as an f-divergence + +The f-divergence for the function `statInfoDivFun β γ` is, up to an explicit correction term, the +statistical information for the prior `boolMeasure β γ`. On probability measures, the correction +term vanishes and the statistical information is an f-divergence. + +## Main statements + +* `toReal_fDiv_statInfoDivFun_eq_integral_add`: `fDiv (statInfoDivFun β γ) μ ν` as a Bochner + integral, plus the singular part. +* `toReal_fDiv_statInfoDivFun_eq_statInfo_of_nonneg`: for `0 ≤ β, γ`, the f-divergence for + `statInfoDivFun β γ` is the statistical information for the prior `boolMeasure β γ`, up to a + correction term which vanishes when `β * μ univ = γ * ν univ`. +* `statInfo_eq_fDiv`: for finite measures with the same total mass, the statistical information + with prior `π` is the f-divergence for `statInfoDivFun (π {false}) (π {true})`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open MeasureTheory Set + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +variable {𝒳 : Type*} {m𝒳 : MeasurableSpace 𝒳} {μ ν : Measure 𝒳} {β γ : ℝ} + +section StatInfoFun + +open Set Filter ConvexOn + +lemma integrable_statInfoFun_rnDeriv (β γ : ℝ) (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] : + Integrable (fun x ↦ statInfoFun β γ ((∂μ/∂ν) x).toReal) ν := + integrable_f_rnDeriv_of_derivAtTop_ne_top _ _ + ((convexOn_statInfoFun β γ).subset (subset_univ _) (convex_Ici 0)) + (derivAtTop_statInfoFun_ne_top β γ) + +lemma measurable_fDiv_statInfoDivFun (μ ν : Measure 𝒳) [SigmaFinite μ] [SFinite ν] : + Measurable (Function.uncurry fun β γ ↦ fDiv (statInfoDivFun β γ) μ ν) := by + simp_rw [fDiv] + · refine Measurable.add ?_ ?_ + · exact measurable_lintegral_statInfoDivFun + simp_rw [derivAtTop_statInfoDivFun_eq] + refine Measurable.mul_const ?_ _ + apply Measurable.ite (measurableSet_le measurable_const measurable_fst) + <;> refine Measurable.ite (measurableSet_le measurable_snd measurable_fst) ?_ ?_ <;> fun_prop + +section FDivStatInfo + +lemma fDiv_statInfoDivFun_eq_integral_add [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + fDiv (statInfoDivFun β γ) μ ν + = ENNReal.ofReal (∫ x, statInfoFun β γ ((∂μ/∂ν) x).toReal ∂ν) + + (statInfoDivFun β γ).derivAtTop * μ.singularPart ν univ := by + unfold statInfoDivFun + rw [fDiv_ofReal_eq_integral_add] + · exact fun _ _ ↦ statInfoFun_nonneg _ _ _ + · exact continuousWithinAt_statInfoFun_zero + · exact integrable_statInfoFun_rnDeriv _ _ _ _ + +lemma fDiv_statInfoDivFun_eq_lintegral_of_ac [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hμν : μ ≪ ν) : + fDiv (statInfoDivFun β γ) μ ν + = ∫⁻ x, ENNReal.ofReal (statInfoFun β γ ((∂μ/∂ν) x).toReal) ∂ν := by + unfold statInfoDivFun + rw [fDiv_ofReal_eq_lintegral_of_ac _ _ _ hμν] + · exact fun _ _ ↦ statInfoFun_nonneg _ _ _ + · exact continuousWithinAt_statInfoFun_zero + · exact integrable_statInfoFun_rnDeriv _ _ _ _ + +lemma toReal_fDiv_statInfoDivFun_eq_integral_add [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + (fDiv (statInfoDivFun β γ) μ ν).toReal + = ∫ x, statInfoFun β γ ((∂μ/∂ν) x).toReal ∂ν + + (statInfoDivFun β γ).derivAtTop.toReal * (μ.singularPart ν univ).toReal := by + unfold statInfoDivFun + rw [toReal_fDiv_ofReal_eq_integral_add] + · exact fun _ _ ↦ statInfoFun_nonneg _ _ _ + · exact continuousWithinAt_statInfoFun_zero + · exact integrable_statInfoFun_rnDeriv _ _ _ _ + · exact derivAtTop_statInfoDivFun_ne_top _ _ + +lemma fDiv_statInfoDivFun_ne_top [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + fDiv (statInfoDivFun β γ) μ ν ≠ ∞ := by + refine fDiv_ne_top_of_derivAtTop_ne_top ?_ (derivAtTop_statInfoDivFun_ne_top _ _) + unfold statInfoDivFun + simp [DivFunction.ofReal_apply_zero_of_continuousWithinAt continuousWithinAt_statInfoFun_zero] + +lemma toReal_fDiv_statInfoDivFun_eq_integral_max_of_nonneg_of_le + [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hβ : 0 ≤ β) (hγ : γ ≤ β) : + (fDiv (statInfoDivFun β γ) μ ν).toReal + = ∫ x, max 0 (γ - β * ((∂μ/∂ν) x).toReal) ∂ν := by + simp_rw [toReal_fDiv_statInfoDivFun_eq_integral_add, + derivAtTop_statInfoDivFun_of_nonneg_of_le hβ hγ, + ENNReal.toReal_zero, zero_mul, add_zero, statInfoFun_of_le hγ] + +lemma toReal_fDiv_statInfoDivFun_eq_integral_max_of_nonneg_of_gt + [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hβ : 0 ≤ β) (hγ : β < γ) : + (fDiv (statInfoDivFun β γ) μ ν).toReal + = ∫ x, max 0 (β * ((∂μ/∂ν) x).toReal - γ) ∂ν + β * (μ.singularPart ν univ).toReal := by + simp_rw [toReal_fDiv_statInfoDivFun_eq_integral_add, + derivAtTop_statInfoDivFun_of_nonneg_of_gt hβ hγ, + statInfoFun_of_gt hγ, ENNReal.toReal_ofReal hβ] + +lemma toReal_fDiv_statInfoDivFun_eq_integral_max_of_nonpos_of_le + [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hβ : β ≤ 0) (hγ : γ ≤ β) : + (fDiv (statInfoDivFun β γ) μ ν).toReal + = ∫ x, max 0 (γ - β * ((∂μ/∂ν) x).toReal) ∂ν + - β * (μ.singularPart ν univ).toReal := by + simp_rw [toReal_fDiv_statInfoDivFun_eq_integral_add, + derivAtTop_statInfoDivFun_of_nonpos_of_le hβ hγ, statInfoFun_of_le hγ] + rw [ENNReal.toReal_ofReal, sub_eq_add_neg, neg_mul] + simp [hβ] + +lemma toReal_fDiv_statInfoDivFun_eq_integral_max_of_nonpos_of_gt + [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hβ : β ≤ 0) (hγ : β < γ) : + (fDiv (statInfoDivFun β γ) μ ν).toReal + = ∫ x, max 0 (β * ((∂μ/∂ν) x).toReal - γ) ∂ν := by + simp_rw [toReal_fDiv_statInfoDivFun_eq_integral_add, + derivAtTop_statInfoDivFun_of_nonpos_of_gt hβ hγ, statInfoFun_of_gt hγ, ENNReal.toReal_zero, + zero_mul, add_zero] + +lemma fDiv_statInfoDivFun_eq_zero_of_nonneg_of_nonpos [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (hβ : 0 ≤ β) (hγ : γ ≤ 0) : + fDiv (statInfoDivFun β γ) μ ν = 0 := by + refine (ENNReal.toReal_eq_zero_iff _).mp ?_ |>.resolve_right fDiv_statInfoDivFun_ne_top + rw [toReal_fDiv_statInfoDivFun_eq_integral_max_of_nonneg_of_le hβ (hγ.trans hβ)] + convert integral_zero 𝒳 ℝ with x + exact max_eq_left <| tsub_nonpos.mpr <| hγ.trans <| mul_nonneg hβ ENNReal.toReal_nonneg + +lemma fDiv_statInfoDivFun_eq_zero_of_nonpos_of_pos [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (hβ : β ≤ 0) (hγ : 0 < γ) : + fDiv (statInfoDivFun β γ) μ ν = 0 := by + refine (ENNReal.toReal_eq_zero_iff _).mp ?_ |>.resolve_right fDiv_statInfoDivFun_ne_top + rw [toReal_fDiv_statInfoDivFun_eq_integral_max_of_nonpos_of_gt hβ (hβ.trans_lt hγ)] + convert integral_zero 𝒳 ℝ with x + exact max_eq_left <| tsub_nonpos.mpr <| + (mul_nonpos_iff.mpr <| Or.inr ⟨hβ, ENNReal.toReal_nonneg⟩).trans hγ.le + +/-- `max 0 a` in terms of the absolute value, in the form used below. -/ +private lemma max_zero_eq_half (a : ℝ) : max 0 a = 2⁻¹ * (0 + a + |0 - a|) := by + rw [zero_sub, abs_neg, zero_add] + rcases le_total 0 a with h | h + · rw [max_eq_right h, abs_of_nonneg h] + ring + · rw [max_eq_left h, abs_of_nonpos h] + ring + +/-- Auxiliary lemma for `toReal_fDiv_statInfoDivFun_eq_integral_abs_of_nonneg_of_le` and +`toReal_fDiv_statInfoDivFun_eq_integral_abs_of_nonpos_of_le`. -/ +private lemma integral_max_eq_integral_abs [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + ∫ x, max 0 (γ - β * ((∂μ/∂ν) x).toReal) ∂ν + = 2⁻¹ * (∫ x, |β * ((∂μ/∂ν) x).toReal - γ| ∂ν + γ * (ν univ).toReal - β * (μ univ).toReal + + β * ((μ.singularPart ν) univ).toReal) := by + simp_rw [max_zero_eq_half, zero_add, zero_sub, neg_sub, integral_const_mul] + congr + have h_int : Integrable (fun x ↦ β * ((∂μ/∂ν) x).toReal) ν := + Measure.integrable_toReal_rnDeriv.const_mul _ + have h_int' : Integrable (fun x ↦ γ - β * ((∂μ/∂ν) x).toReal) ν := (integrable_const γ).sub h_int + rw [integral_add h_int', integral_sub (integrable_const γ) h_int, integral_const, smul_eq_mul, + mul_comm, integral_const_mul, add_comm, add_sub_assoc, add_assoc, sub_eq_add_neg, + sub_eq_add_neg, add_assoc, ← mul_neg, ← mul_neg, ← mul_add] + swap; · exact (integrable_add_const_iff.mpr h_int).abs + congr + nth_rw 2 [μ.haveLebesgueDecomposition_add ν] + simp only [Measure.coe_add, Pi.add_apply, MeasurableSet.univ, withDensity_apply, + Measure.restrict_univ] + rw [ENNReal.toReal_add (measure_ne_top _ _)] + swap; · exact lt_top_iff_ne_top.mp <| (setLIntegral_univ _ ▸ + Measure.setLIntegral_rnDeriv_le univ).trans_lt IsFiniteMeasure.measure_univ_lt_top + ring_nf + rw [integral_toReal (μ.measurable_rnDeriv ν).aemeasurable (μ.rnDeriv_lt_top ν)] + +/-- Auxiliary lemma for `toReal_fDiv_statInfoDivFun_eq_integral_abs_of_nonneg_of_gt` and +`toReal_fDiv_statInfoDivFun_eq_integral_abs_of_nonpos_of_gt`. -/ +private lemma integral_max_eq_integral_abs' [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + ∫ x, max 0 (β * ((∂μ/∂ν) x).toReal - γ) ∂ν + = 2⁻¹ * (∫ x, |β * ((∂μ/∂ν) x).toReal - γ| ∂ν - γ * (ν univ).toReal + β * (μ univ).toReal + - β * ((μ.singularPart ν) univ).toReal) := by + simp_rw [max_zero_eq_half, zero_add, zero_sub, abs_neg, integral_const_mul] + congr + have h_int : Integrable (fun x ↦ β * ((∂μ/∂ν) x).toReal) ν := + Measure.integrable_toReal_rnDeriv.const_mul _ + have h_int' : Integrable (fun x ↦ β * ((∂μ/∂ν) x).toReal - γ) ν := h_int.sub (integrable_const γ) + rw [integral_add h_int', integral_sub h_int (integrable_const γ), integral_const, smul_eq_mul, + mul_comm, integral_const_mul, add_comm, add_sub_assoc, sub_eq_add_neg, add_comm (β * _), + ← add_assoc, ← sub_eq_add_neg] + swap; · exact (h_int.sub (integrable_const _)).abs + congr + nth_rw 2 [μ.haveLebesgueDecomposition_add ν] + simp only [Measure.coe_add, Pi.add_apply, MeasurableSet.univ, withDensity_apply, + Measure.restrict_univ] + rw [ENNReal.toReal_add (measure_ne_top _ _)] + swap; · exact lt_top_iff_ne_top.mp <| (setLIntegral_univ _ ▸ + Measure.setLIntegral_rnDeriv_le univ).trans_lt IsFiniteMeasure.measure_univ_lt_top + ring_nf + rw [integral_toReal (μ.measurable_rnDeriv ν).aemeasurable (μ.rnDeriv_lt_top ν)] + +lemma toReal_fDiv_statInfoDivFun_eq_integral_abs_of_nonneg_of_le + [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hβ : 0 ≤ β) (hγ : γ ≤ β) : + (fDiv (statInfoDivFun β γ) μ ν).toReal = (2 : ℝ)⁻¹ * (∫ x, |β * ((∂μ/∂ν) x).toReal - γ| ∂ν + + β * (μ.singularPart ν univ).toReal + γ * (ν univ).toReal - β * (μ univ).toReal) := by + rw [toReal_fDiv_statInfoDivFun_eq_integral_max_of_nonneg_of_le hβ hγ, + integral_max_eq_integral_abs, + sub_eq_add_neg, add_assoc, add_comm (- _), ← add_assoc, ← sub_eq_add_neg, add_assoc, + add_comm (_ * _), add_assoc] + +lemma toReal_fDiv_statInfoDivFun_eq_integral_abs_of_nonneg_of_gt + [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hβ : 0 ≤ β) (hγ : β < γ) : + (fDiv (statInfoDivFun β γ) μ ν).toReal = (2 : ℝ)⁻¹ * (∫ x, |β * ((∂μ/∂ν) x).toReal - γ| ∂ν + + β * (μ.singularPart ν univ).toReal + β * (μ univ).toReal - γ * (ν univ).toReal) := by + have h_eq : β * (μ.singularPart ν univ).toReal + = 2⁻¹ * (2 * β * (μ.singularPart ν univ).toReal) := by simp [mul_assoc] + rw [toReal_fDiv_statInfoDivFun_eq_integral_max_of_nonneg_of_gt hβ hγ, + integral_max_eq_integral_abs', h_eq, + ← mul_add] + simp_rw [sub_eq_add_neg, add_assoc] + congr 2 + ring + +lemma toReal_fDiv_statInfoDivFun_eq_integral_abs_of_nonpos_of_le + [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hβ : β ≤ 0) (hγ : γ ≤ β) : + (fDiv (statInfoDivFun β γ) μ ν).toReal = (2 : ℝ)⁻¹ * (∫ x, |β * ((∂μ/∂ν) x).toReal - γ| ∂ν + - β * (μ.singularPart ν univ).toReal + γ * (ν univ).toReal - β * (μ univ).toReal) := by + have h_eq : β * (μ.singularPart ν univ).toReal + = 2⁻¹ * (2 * β * ((μ.singularPart ν) univ).toReal) := by simp [mul_assoc] + rw [toReal_fDiv_statInfoDivFun_eq_integral_max_of_nonpos_of_le hβ hγ, + integral_max_eq_integral_abs, h_eq, + sub_eq_add_neg, ← mul_neg, ← mul_add] + simp_rw [sub_eq_add_neg, add_assoc] + congr 2 + ring + +lemma toReal_fDiv_statInfoDivFun_eq_integral_abs_of_nonpos_of_gt + [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hβ : β ≤ 0) (hγ : β < γ) : + (fDiv (statInfoDivFun β γ) μ ν).toReal = (2 : ℝ)⁻¹ * (∫ x, |β * ((∂μ/∂ν) x).toReal - γ| ∂ν + - β * (μ.singularPart ν univ).toReal + β * (μ univ).toReal - γ * (ν univ).toReal) := by + rw [toReal_fDiv_statInfoDivFun_eq_integral_max_of_nonpos_of_gt hβ hγ, + integral_max_eq_integral_abs'] + simp_rw [sub_eq_add_neg] + ring_nf + +end FDivStatInfo + +section FDivStatInfoEqStatInfo + +lemma toReal_fDiv_statInfoDivFun_eq_statInfo_of_nonneg_of_le [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (hβ : 0 ≤ β) (hγ : 0 ≤ γ) (hγβ : γ ≤ β) : + (fDiv (statInfoDivFun β γ) μ ν).toReal + = (statInfo μ ν (Measure.boolMeasure (.ofReal β) (.ofReal γ))).toReal + + 2⁻¹ * (|β * (μ univ).toReal - γ * (ν univ).toReal| + + γ * (ν univ).toReal - β * (μ univ).toReal) := by + have : IsFiniteMeasure (Measure.boolMeasure (.ofReal β) (.ofReal γ)) := + Measure.isFiniteMeasure_boolMeasure ENNReal.ofReal_ne_top ENNReal.ofReal_ne_top + rw [toReal_statInfo_eq_integral_abs] + simp only [Measure.boolMeasure_apply_false, ENNReal.toReal_mul, hβ, ENNReal.toReal_ofReal, + Measure.boolMeasure_apply_true, hγ] + rw [toReal_fDiv_statInfoDivFun_eq_integral_abs_of_nonneg_of_le hβ hγβ, ← mul_add] + simp_rw [sub_eq_add_neg, ← add_assoc] + rw [add_comm (-_ + _ + _)] + simp_rw [← add_assoc, ← sub_eq_add_neg, sub_self, zero_add] + +lemma toReal_fDiv_statInfoDivFun_eq_statInfo_of_nonneg_of_gt [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (hβ : 0 ≤ β) (hγ : 0 ≤ γ) (hγβ : β < γ) : + (fDiv (statInfoDivFun β γ) μ ν).toReal + = (statInfo μ ν (Measure.boolMeasure (.ofReal β) (.ofReal γ))).toReal + + 2⁻¹ * (|β * (μ univ).toReal - γ * (ν univ).toReal| + + β * (μ univ).toReal - γ * (ν univ).toReal) := by + have : IsFiniteMeasure (Measure.boolMeasure (.ofReal β) (.ofReal γ)) := + Measure.isFiniteMeasure_boolMeasure ENNReal.ofReal_ne_top ENNReal.ofReal_ne_top + rw [toReal_statInfo_eq_integral_abs] + simp only [Measure.boolMeasure_apply_false, ENNReal.toReal_mul, hβ, ENNReal.toReal_ofReal, + Measure.boolMeasure_apply_true, hγ] + rw [toReal_fDiv_statInfoDivFun_eq_integral_abs_of_nonneg_of_gt hβ hγβ, ← mul_add] + simp_rw [sub_eq_add_neg, ← add_assoc] + rw [add_comm (-_ + _ + _)] + simp_rw [← add_assoc, ← sub_eq_add_neg, sub_self, zero_add] + +-- N.B. we cannot use the Real.sign function here because it is 0 at 0, but we need it to be -1. +lemma toReal_fDiv_statInfoDivFun_eq_statInfo_of_nonneg [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (hβ : 0 ≤ β) (hγ : 0 ≤ γ) : + (fDiv (statInfoDivFun β γ) μ ν).toReal + = (statInfo μ ν (Measure.boolMeasure (.ofReal β) (.ofReal γ))).toReal + + 2⁻¹ * (|β * (μ univ).toReal - γ * (ν univ).toReal| + + (if γ ≤ β then -1 else 1) * (β * (μ univ).toReal - γ * (ν univ).toReal)) := by + rcases le_or_gt γ β with (hβγ | hβγ) + · rw [toReal_fDiv_statInfoDivFun_eq_statInfo_of_nonneg_of_le hβ hγ hβγ, ite_eq_left hβγ, + neg_one_mul, + neg_sub, sub_eq_add_neg, add_assoc, ← sub_eq_add_neg] + · rw [toReal_fDiv_statInfoDivFun_eq_statInfo_of_nonneg_of_gt hβ hγ hβγ, ite_eq_right hβγ.not_ge, + one_mul, add_sub_assoc] + +/-- For finite measures with the same total mass (for example probability measures), the +statistical information with prior `π` is the f-divergence for the function +`statInfoDivFun (π {false}) (π {true})`. -/ +lemma statInfo_eq_fDiv (μ ν : Measure 𝒳) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (h_univ : μ univ = ν univ) (π : Measure Bool) [IsFiniteMeasure π] : + statInfo μ ν π = fDiv (statInfoDivFun (π {false}).toReal (π {true}).toReal) μ ν := by + set β := (π {false}).toReal + set γ := (π {true}).toReal + have h := toReal_fDiv_statInfoDivFun_eq_statInfo_of_nonneg (μ := μ) (ν := ν) (β := β) (γ := γ) + ENNReal.toReal_nonneg ENNReal.toReal_nonneg + have h_corr : |β * (μ univ).toReal - γ * (ν univ).toReal| + + (if γ ≤ β then -1 else 1) * (β * (μ univ).toReal - γ * (ν univ).toReal) = 0 := by + rw [h_univ, ← sub_mul, abs_mul, abs_of_nonneg ENNReal.toReal_nonneg] + split_ifs with hβγ + · rw [abs_of_nonneg (sub_nonneg.mpr hβγ)] + ring + · rw [abs_of_neg (sub_neg.mpr (not_le.mp hβγ))] + ring + rw [h_corr, mul_zero, add_zero] at h + simp only [β, γ, ENNReal.ofReal_toReal (measure_ne_top π _), ← Measure.eq_boolMeasure] at h + exact ((ENNReal.toReal_eq_toReal_iff' fDiv_statInfoDivFun_ne_top + (statInfo_ne_top _ _ _)).mp h).symm + +end FDivStatInfoEqStatInfo + +end StatInfoFun + +end ProbabilityTheory diff --git a/Statlib/Divergence/StatInfo/StatInfoDivFun.lean b/Statlib/Divergence/StatInfo/StatInfoDivFun.lean new file mode 100644 index 0000000..11a61d4 --- /dev/null +++ b/Statlib/Divergence/StatInfo/StatInfoDivFun.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.MeasureTheory.Integral.Prod +public import Mathlib.Probability.Notation +public import Statlib.Divergence.FDiv.DivFunction.OfReal +public import Statlib.Divergence.StatInfo.StatInfoFun + +/-! +# The divergence functions of the statistical information + +## Main definitions + +* `statInfoDivFun β γ`: the `DivFunction` obtained from the hockey-stick function + `statInfoFun β γ`. + +## Main statements + +* `derivAtTop_statInfoDivFun_eq`: the derivative at infinity of `statInfoDivFun β γ`. +* `measurable_lintegral_statInfoDivFun`: measurability in the parameters `(β, γ)`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open MeasureTheory Set ProbabilityTheory.DivFunction + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {β γ : ℝ} + +/-- The `DivFunction` associated with the convex function `statInfoFun β γ`. -/ +noncomputable +def statInfoDivFun (β γ : ℝ) : DivFunction := + DivFunction.ofReal + (statInfoFun β γ) ((convexOn_statInfoFun β γ).subset (subset_univ _) (convex_Ioi 0)) + statInfoFun_apply_one + +lemma statInfoDivFun_apply_of_ne_top {x : ℝ≥0∞} (hx : x ≠ ∞) : + statInfoDivFun β γ x = ENNReal.ofReal (statInfoFun β γ x.toReal) := + DivFunction.ofReal_apply_of_continuousWithinAt continuous_statInfoFun.continuousWithinAt hx + +/-- The integral of `statInfoDivFun β γ` against `ν` of the Radon-Nikodym derivative is a +measurable function of the parameters `(β, γ)`. -/ +lemma measurable_lintegral_statInfoDivFun [SigmaFinite μ] [SFinite ν] : + Measurable fun p : ℝ × ℝ ↦ ∫⁻ x, statInfoDivFun p.1 p.2 ((∂μ/∂ν) x) ∂ν := by + have h_meas : Measurable fun q : (ℝ × ℝ) × α ↦ + ENNReal.ofReal (statInfoFun q.1.1 q.1.2 ((∂μ/∂ν) q.2).toReal) := + ENNReal.measurable_ofReal.comp (measurable_statInfoFun.comp + (measurable_fst.prodMk ((Measure.measurable_rnDeriv _ _).ennreal_toReal.comp measurable_snd))) + have h_eq (p : ℝ × ℝ) : ∫⁻ x, statInfoDivFun p.1 p.2 ((∂μ/∂ν) x) ∂ν + = ∫⁻ x, ENNReal.ofReal (statInfoFun p.1 p.2 ((∂μ/∂ν) x).toReal) ∂ν := by + refine lintegral_congr_ae ?_ + filter_upwards [μ.rnDeriv_ne_top ν] with x hx + exact statInfoDivFun_apply_of_ne_top hx + simp_rw [h_eq] + exact h_meas.lintegral_prod_right' + +section derivAtTop + +lemma derivAtTop_statInfoDivFun : + (statInfoDivFun β γ).derivAtTop = (derivAtTop (statInfoFun β γ)).toENNReal := + DivFunction.derivAtTop_ofReal + +lemma derivAtTop_statInfoDivFun_of_nonneg_of_le (hβ : 0 ≤ β) (hγ : γ ≤ β) : + (statInfoDivFun β γ).derivAtTop = 0 := by + rw [derivAtTop_statInfoDivFun, derivAtTop_statInfoFun_of_nonneg_of_le hβ hγ, + EReal.toENNReal_zero] + +lemma derivAtTop_statInfoDivFun_of_nonneg_of_gt (hβ : 0 ≤ β) (hγ : γ > β) : + (statInfoDivFun β γ).derivAtTop = ENNReal.ofReal β := by + rw [derivAtTop_statInfoDivFun, derivAtTop_statInfoFun_of_nonneg_of_gt hβ hγ, + EReal.toENNReal_of_ne_top (EReal.coe_ne_top _), EReal.toReal_coe] + +lemma derivAtTop_statInfoDivFun_of_nonpos_of_le (hβ : β ≤ 0) (hγ : γ ≤ β) : + (statInfoDivFun β γ).derivAtTop = ENNReal.ofReal (-β) := by + rw [derivAtTop_statInfoDivFun, derivAtTop_statInfoFun_of_nonpos_of_le hβ hγ, ← EReal.coe_neg, + EReal.toENNReal_of_ne_top (EReal.coe_ne_top _), EReal.toReal_coe] + +lemma derivAtTop_statInfoDivFun_of_nonpos_of_gt (hβ : β ≤ 0) (hγ : γ > β) : + (statInfoDivFun β γ).derivAtTop = 0 := by + rw [derivAtTop_statInfoDivFun, derivAtTop_statInfoFun_of_nonpos_of_gt hβ hγ, + EReal.toENNReal_zero] + +lemma derivAtTop_statInfoDivFun_eq : + (statInfoDivFun β γ).derivAtTop + = if 0 ≤ β then (if γ ≤ β then 0 else ENNReal.ofReal β) + else if γ ≤ β then ENNReal.ofReal (-β) else 0 := by + by_cases hβ : 0 ≤ β <;> by_cases hγ : γ ≤ β <;> simp [derivAtTop_statInfoDivFun_of_nonneg_of_le, + derivAtTop_statInfoDivFun_of_nonneg_of_gt, derivAtTop_statInfoDivFun_of_nonpos_of_le, + derivAtTop_statInfoDivFun_of_nonpos_of_gt, hβ, hγ, lt_of_not_ge, le_of_lt (lt_of_not_ge _)] + +lemma derivAtTop_statInfoDivFun_ne_top (β γ : ℝ) : + (statInfoDivFun β γ).derivAtTop ≠ ∞ := by + rcases le_total 0 β with (hβ | hβ) <;> rcases le_or_gt γ β with (hγ | hγ) <;> + simp [derivAtTop_statInfoDivFun_of_nonneg_of_le, derivAtTop_statInfoDivFun_of_nonneg_of_gt, + derivAtTop_statInfoDivFun_of_nonpos_of_le, derivAtTop_statInfoDivFun_of_nonpos_of_gt, hβ, hγ] + +end derivAtTop + +end ProbabilityTheory diff --git a/Statlib/Divergence/StatInfo/StatInfoFun.lean b/Statlib/Divergence/StatInfo/StatInfoFun.lean new file mode 100644 index 0000000..f9402d9 --- /dev/null +++ b/Statlib/Divergence/StatInfo/StatInfoFun.lean @@ -0,0 +1,200 @@ +/- +Copyright (c) 2024 Lorenzo Luccioli. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.MeasureTheory.Integral.IntegrableOn +public import Mathlib.MeasureTheory.Measure.Regular +public import Statlib.ForMathlib.Analysis.Convex.DerivAtTop + +/-! # The functions `statInfoFun β γ` + +The hockey-stick functions `statInfoFun β γ : ℝ → ℝ` are the building blocks of the integral +representation of f-divergences in terms of statistical informations: the f-divergence for +`statInfoFun β γ` is a statistical information (`Statlib.Divergence.StatInfo.FDiv`), and every +f-divergence is an integral of such f-divergences +(`Statlib.Divergence.FDiv.IntegralRepresentation`). + +## Main definitions + +* `statInfoFun β γ x`: `max 0 (γ - β * x)` if `γ ≤ β`, and `max 0 (β * x - γ)` otherwise. + +## Main statements + +* `convexOn_statInfoFun`, `continuous_statInfoFun`, `measurable_statInfoFun`: regularity. +* `derivAtTop_statInfoFun_of_nonneg_of_le` and its variants: the slope at infinity of + `statInfoFun β γ`, which is always finite (`derivAtTop_statInfoFun_ne_top`). +* `statInfoFun_of_one_of_one_le_right`, `statInfoFun_of_one_of_right_le_one`: `statInfoFun 1 γ x` + as an indicator function of `γ`, used in the integral representation of f-divergences. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open MeasureTheory Set Filter Topology + +open scoped ENNReal NNReal Interval + +namespace ProbabilityTheory + +variable {𝒳 : Type*} {m𝒳 : MeasurableSpace 𝒳} {μ ν : Measure 𝒳} {f : ℝ → ℝ} {β γ x t : ℝ} + +/- To play with this function go to https://www.geogebra.org/calculator/jaymzqtm, +there the notation is: b for β, c for γ, X for x. +h is statInfoFun seen as a function of x, f is statInfoFun seen as a function of γ. +-/ +/-- The hockey-stick function, it is related to the statistical information divergence. -/ +noncomputable +def statInfoFun (β γ x : ℝ) : ℝ := if γ ≤ β then max 0 (γ - β * x) else max 0 (β * x - γ) + +lemma statInfoFun_nonneg (β γ x : ℝ) : 0 ≤ statInfoFun β γ x := by + simp_rw [statInfoFun] + split_ifs <;> simp + +@[simp] +lemma statInfoFun_zero : statInfoFun 0 γ x = 0 := by simp_all [statInfoFun, le_of_lt] + +@[simp] +lemma statInfoFun_zero' : statInfoFun 0 γ = 0 := by ext; simp_all [statInfoFun, le_of_lt] + +section Measurability + +lemma measurable_statInfoFun : Measurable statInfoFun.uncurry.uncurry := by + apply Measurable.ite + · exact measurableSet_le (by fun_prop) (by fun_prop) + · fun_prop + · fun_prop + +end Measurability + +section statInfoFun_x +-- Lemmas useful when we want to consider `statInfoFun` as a function of `x` + +lemma statInfoFun_of_le (h : γ ≤ β) : statInfoFun β γ x = max 0 (γ - β * x) := ite_eq_left h + +lemma statInfoFun_of_le' (h : γ ≤ β) : statInfoFun β γ = fun x ↦ max 0 (γ - β * x) := by + ext; exact statInfoFun_of_le h + +lemma statInfoFun_of_gt (h : γ > β) : statInfoFun β γ x = max 0 (β * x - γ) := ite_eq_right h.not_ge + +lemma statInfoFun_of_gt' (h : γ > β) : statInfoFun β γ = fun x ↦ max 0 (β * x - γ) := by + ext; exact statInfoFun_of_gt h + +lemma statInfoFun_of_pos_of_gt_of_ge (hβ : 0 < β) (hγ : γ > β) (hx : x ≥ γ / β) : + statInfoFun β γ x = β * x - γ := + statInfoFun_of_gt hγ ▸ max_eq_right_iff.mpr <| sub_nonneg.mpr <| (div_le_iff₀' hβ).mp hx + +lemma statInfoFun_of_neg_of_le_of_ge (hβ : β < 0) (hγ : γ ≤ β) (hx : x ≥ γ / β) : + statInfoFun β γ x = γ - β * x := + statInfoFun_of_le hγ ▸ max_eq_right_iff.mpr <| sub_nonneg.mpr <| (div_le_iff_of_neg' hβ).mp hx + +@[simp] +lemma statInfoFun_apply_one : statInfoFun β γ 1 = 0 := by + unfold statInfoFun + split_ifs with h + · simp [h] + · simp [(not_le.mp h).le] + +lemma convexOn_statInfoFun (β γ : ℝ) : ConvexOn ℝ univ (statInfoFun β γ) := by + unfold statInfoFun + by_cases h : γ ≤ β <;> + · simp only [h, ↓reduceIte] + refine (convexOn_const 0 convex_univ).sup ⟨convex_univ, fun x _ y _ a b _ _ hab ↦ le_of_eq ?_⟩ + dsimp + have hγ : γ = a * γ + b * γ := by rw [← add_mul, hab, one_mul] + linarith + +lemma continuous_statInfoFun : Continuous (statInfoFun β γ) := by + rcases le_or_gt γ β with hγ | hγ + · rw [statInfoFun_of_le' hγ] + exact continuous_const.max (continuous_const.sub (continuous_const.mul continuous_id)) + · rw [statInfoFun_of_gt' hγ] + exact continuous_const.max ((continuous_const.mul continuous_id).sub continuous_const) + +lemma continuousWithinAt_statInfoFun_zero : + ContinuousWithinAt (statInfoFun β γ) (Ioi 0) 0 := + continuous_statInfoFun.continuousWithinAt + +section derivAtTop + +lemma derivAtTop_statInfoFun_of_nonneg_of_le (hβ : 0 ≤ β) (hγ : γ ≤ β) : + derivAtTop (statInfoFun β γ) = 0 := by + rw [← derivAtTop_zero] + refine derivAtTop_congr ?_ + filter_upwards [eventually_ge_atTop 1] with x hx + rw [statInfoFun_of_le hγ, Pi.zero_apply, max_eq_left_iff, sub_nonpos] + exact hγ.trans (le_mul_of_one_le_right hβ hx) + +lemma derivAtTop_statInfoFun_of_nonneg_of_gt (hβ : 0 ≤ β) (hγ : γ > β) : + derivAtTop (statInfoFun β γ) = β := by + rcases eq_or_lt_of_le hβ with (rfl | hβ) + · simp + rw [← derivAtTop_mul_add β (-γ)] + refine derivAtTop_congr ?_ + filter_upwards [eventually_ge_atTop (γ / β)] with x hx + rw [statInfoFun_of_pos_of_gt_of_ge hβ hγ hx, sub_eq_add_neg] + +lemma derivAtTop_statInfoFun_of_nonpos_of_le (hβ : β ≤ 0) (hγ : γ ≤ β) : + derivAtTop (statInfoFun β γ) = -β := by + rcases eq_or_lt_of_le hβ with (rfl | hβ) + · simp + rw [← EReal.coe_neg, ← derivAtTop_mul_add (-β) γ] + refine derivAtTop_congr ?_ + filter_upwards [eventually_ge_atTop (γ / β)] with x hx + rw [statInfoFun_of_neg_of_le_of_ge hβ hγ hx] + ring + +lemma derivAtTop_statInfoFun_of_nonpos_of_gt (hβ : β ≤ 0) (hγ : γ > β) : + derivAtTop (statInfoFun β γ) = 0 := by + rcases eq_or_lt_of_le hβ with (rfl | hβ) + · simp + rw [← derivAtTop_zero] + refine derivAtTop_congr ?_ + filter_upwards [eventually_ge_atTop (γ / β)] with x hx + rw [statInfoFun_of_gt hγ, Pi.zero_apply, max_eq_left_iff, sub_nonpos] + rwa [div_le_iff_of_neg hβ, mul_comm] at hx + +lemma derivAtTop_statInfoFun_ne_top (β γ : ℝ) : derivAtTop (statInfoFun β γ) ≠ ⊤ := by + rcases le_total 0 β with (hβ | hβ) <;> rcases le_or_gt γ β with (hγ | hγ) <;> + simp [derivAtTop_statInfoFun_of_nonneg_of_le, derivAtTop_statInfoFun_of_nonneg_of_gt, + derivAtTop_statInfoFun_of_nonpos_of_le, derivAtTop_statInfoFun_of_nonpos_of_gt, hβ, hγ] + +end derivAtTop + +end statInfoFun_x + +section statInfoFun_γ + +lemma statInfoFun_of_nonneg_of_right_le_one (hβ : 0 ≤ β) (hx : x ≤ 1) : + statInfoFun β γ x = (Ioc (β * x) β).indicator (fun y ↦ y - β * x) γ := by + by_cases hγβ : γ ≤ β + · by_cases hβxγ : β * x < γ + · simp [statInfoFun, indicator, hβxγ, hβxγ.le] + · simp [statInfoFun, hγβ, hβxγ, (le_of_not_gt hβxγ)] + · simp only [statInfoFun, hγβ, ↓reduceIte, indicator, mem_Ioc, and_false, max_eq_left_iff, + tsub_le_iff_right, zero_add] + exact (mul_le_of_le_one_right hβ hx).trans (le_of_not_ge hγβ) + +lemma statInfoFun_of_nonneg_of_one_le_right (hβ : 0 ≤ β) (hx : 1 ≤ x) : + statInfoFun β γ x = (Ioc β (β * x)).indicator (fun y ↦ β * x - y) γ := by + by_cases hγβ : γ ≤ β + · simp [statInfoFun, hγβ, indicator, hγβ.trans (le_mul_of_one_le_right hβ hx), hγβ.not_gt] + · by_cases hγβx : γ ≤ β * x + · simp [statInfoFun, hγβ, hγβx, lt_of_not_ge hγβ] + · simp [statInfoFun, hγβ, hγβx, le_of_not_ge hγβx] + +lemma statInfoFun_of_one_of_one_le_right (h : 1 ≤ x) : + statInfoFun 1 γ x = (Ioc 1 x).indicator (fun y ↦ x - y) γ := by + convert statInfoFun_of_nonneg_of_one_le_right _ h <;> simp + +lemma statInfoFun_of_one_of_right_le_one (h : x ≤ 1) : + statInfoFun 1 γ x = (Ioc x 1).indicator (fun y ↦ y - x) γ := by + convert statInfoFun_of_nonneg_of_right_le_one _ h <;> simp + +end statInfoFun_γ + +end ProbabilityTheory diff --git a/Statlib/Divergence/TotalVariation.lean b/Statlib/Divergence/TotalVariation.lean new file mode 100644 index 0000000..c1de26b --- /dev/null +++ b/Statlib/Divergence/TotalVariation.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne +-/ +module + +public import Mathlib.MeasureTheory.Measure.TotalVariation.Basic +public import Statlib.Divergence.FDiv.Basic +public import Statlib.Divergence.StatInfo.Basic + +/-! +# Total variation distance, statistical information and f-divergences + +Mathlib's total variation distance `MeasureTheory.tvDist μ ν` (and its `ℝ≥0∞`-valued version +`MeasureTheory.etvDist μ ν`) is, up to a factor `2` and a correction for the difference of the +masses of `μ` and `ν`, the statistical information `statInfo μ ν (boolMeasure 1 1)` for the uniform +prior. We use this to transfer results about the statistical information to the total variation +distance. + +## Main definitions + +* `tvDivFun`: the `DivFunction` `x ↦ |1 - x|`. + +## Main statements + +* `tvDist_eq_two_mul_toReal_statInfo_add_abs`: for finite measures, + `tvDist μ ν = 2 * (statInfo μ ν (boolMeasure 1 1)).toReal + |μ.real univ - ν.real univ|`. +* `etvDist_eq_two_mul_statInfo`, `tvDist_eq_two_mul_toReal_statInfo`: for finite measures with the + same mass, in particular for probability measures, the total variation distance is twice the + statistical information for the uniform prior. +* `tvDist_comp_le`, `etvDist_comp_le`: **data-processing inequality** for the total variation + distance. +* `lintegral_one_sub_rnDeriv_eq_etvDist_div_two`: for finite measures with the same mass, + `∫⁻ x, 1 - (∂μ/∂ν) x ∂ν = etvDist μ ν / 2`. +* `fDiv_tvDivFun`: for finite measures, `etvDist μ ν` is the f-divergence for the function + `tvDivFun = x ↦ |1 - x|`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds), where the total variation distance was +defined as the statistical information for the uniform prior. +-/ + +@[expose] public section + +open MeasureTheory Filter Set + +open scoped ENNReal Topology + +namespace ProbabilityTheory + +variable {𝒳 𝒳' : Type*} {m𝒳 : MeasurableSpace 𝒳} {m𝒳' : MeasurableSpace 𝒳'} + {μ ν : Measure 𝒳} + +/-- The total variation distance in terms of the statistical information for the uniform prior. -/ +lemma tvDist_eq_two_mul_toReal_statInfo_add_abs (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] : + tvDist μ ν + = 2 * (statInfo μ ν (Measure.boolMeasure 1 1)).toReal + |μ.real .univ - ν.real .univ| := by + rw [toReal_statInfo_eq_integral_abs, tvDist_eq_integral_abs_rnDeriv_add_singularPart] + simp only [Measure.boolMeasure_apply_false, Measure.boolMeasure_apply_true, one_mul, + ENNReal.toReal_one, Measure.real, abs_sub_comm _ (1 : ℝ)] + ring + +/-- For finite measures with the same mass, in particular probability measures, the total variation +distance is twice the statistical information for the uniform prior. -/ +lemma tvDist_eq_two_mul_toReal_statInfo [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (h : μ .univ = ν .univ) : + tvDist μ ν = 2 * (statInfo μ ν (Measure.boolMeasure 1 1)).toReal := by + rw [tvDist_eq_two_mul_toReal_statInfo_add_abs, measureReal_def, h, ← measureReal_def, sub_self, + abs_zero, add_zero] + +/-- For finite measures with the same mass, in particular probability measures, the total variation +distance is twice the statistical information for the uniform prior. -/ +lemma etvDist_eq_two_mul_statInfo [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (h : μ .univ = ν .univ) : + etvDist μ ν = 2 * statInfo μ ν (Measure.boolMeasure 1 1) := by + rw [← ofReal_tvDist, tvDist_eq_two_mul_toReal_statInfo h, ENNReal.ofReal_mul zero_le_two, + ENNReal.ofReal_ofNat, ENNReal.ofReal_toReal (statInfo_ne_top _ _ _)] + +/-- **Data processing inequality** for the total variation distance. -/ +lemma tvDist_comp_le (μ ν : Measure 𝒳) (κ : Kernel 𝒳 𝒳') [IsMarkovKernel κ] : + tvDist (κ ∘ₘ μ) (κ ∘ₘ ν) ≤ tvDist μ ν := by + by_cases h : IsFiniteMeasure μ ∧ IsFiniteMeasure ν + · obtain ⟨_, _⟩ := h + rw [tvDist_eq_two_mul_toReal_statInfo_add_abs, tvDist_eq_two_mul_toReal_statInfo_add_abs] + simp only [measureReal_def, Measure.comp_apply_univ] + gcongr + · exact statInfo_ne_top _ _ _ + · exact statInfo_comp_le μ ν _ κ + · have h_comp : ¬ (IsFiniteMeasure (κ ∘ₘ μ) ∧ IsFiniteMeasure (κ ∘ₘ ν)) := by + rwa [isFiniteMeasure_iff (μ := κ ∘ₘ μ), isFiniteMeasure_iff (μ := κ ∘ₘ ν), + Measure.comp_apply_univ, Measure.comp_apply_univ, ← isFiniteMeasure_iff, + ← isFiniteMeasure_iff] + rw [tvDist_of_not_isFiniteMeasure h_comp] + exact tvDist_nonneg + +/-- **Data processing inequality** for the total variation distance. -/ +lemma etvDist_comp_le (μ ν : Measure 𝒳) (κ : Kernel 𝒳 𝒳') [IsMarkovKernel κ] : + etvDist (κ ∘ₘ μ) (κ ∘ₘ ν) ≤ etvDist μ ν := by + by_cases h : IsFiniteMeasure μ ∧ IsFiniteMeasure ν + · obtain ⟨_, _⟩ := h + rw [← ofReal_tvDist, ← ofReal_tvDist] + exact ENNReal.ofReal_le_ofReal (tvDist_comp_le μ ν κ) + · rw [etvDist_of_not_isFiniteMeasure h] + exact le_top + +/-- For the uniform prior, the statistical information is `∫⁻ x, 1 - (∂μ/∂ν) x ∂ν`, provided that +`ν` has at most the mass of `μ`. -/ +lemma lintegral_one_sub_rnDeriv_eq_statInfo [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (h : ν .univ ≤ μ .univ) : + ∫⁻ x, 1 - (∂μ/∂ν) x ∂ν = statInfo μ ν (Measure.boolMeasure 1 1) := by + simp [statInfo_eq_lintegral_of_ge (π := Measure.boolMeasure 1 1) (by simpa using h)] + +/-- For finite measures with the same mass, in particular probability measures, +`∫⁻ x, 1 - (∂μ/∂ν) x ∂ν` is half the total variation distance. -/ +lemma lintegral_one_sub_rnDeriv_eq_etvDist_div_two [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (h : μ .univ = ν .univ) : + ∫⁻ x, 1 - (∂μ/∂ν) x ∂ν = etvDist μ ν / 2 := by + rw [lintegral_one_sub_rnDeriv_eq_statInfo h.ge, etvDist_eq_two_mul_statInfo h, mul_comm, + ENNReal.mul_div_cancel_right two_ne_zero ENNReal.ofNat_ne_top] + +section FDiv + +/-! ### The total variation distance as an f-divergence -/ + +/-- The `DivFunction` `x ↦ |1 - x|`. Its f-divergence is the total variation distance +(`fDiv_tvDivFun`). -/ +noncomputable def tvDivFun : DivFunction := + DivFunction.ofReal (fun x ↦ |1 - x|) + ((convexOn_dist (1 : ℝ) (convex_Ioi 0)).congr fun x _ ↦ abs_sub_comm x 1) + (by simp) + +lemma tvDivFun_apply {x : ℝ≥0∞} (hx : x ≠ ∞) : tvDivFun x = ENNReal.ofReal |1 - x.toReal| := + DivFunction.ofReal_apply_of_continuousWithinAt + (continuous_abs.comp (continuous_sub_left 1)).continuousWithinAt hx + +@[simp] lemma derivAtTop_tvDivFun : tvDivFun.derivAtTop = 1 := by + -- for `x > 1`, the derivative of `y ↦ |1 - y|` at `x` is `1` + have h : Tendsto (fun x ↦ derivWithin (fun y : ℝ ↦ |1 - y|) (Ioi x) x) atTop (𝓝 1) := by + refine tendsto_const_nhds.congr' ?_ + filter_upwards [eventually_gt_atTop 1] with x hx + have h_eq : (fun y : ℝ ↦ |1 - y|) =ᶠ[𝓝 x] fun y ↦ y - 1 := by + filter_upwards [eventually_gt_nhds hx] with y hy + rw [abs_of_neg (sub_neg.mpr hy), neg_sub] + exact ((((hasDerivAt_id' x).sub_const 1).congr_of_eventuallyEq h_eq).hasDerivWithinAt + |>.derivWithin (uniqueDiffWithinAt_Ioi x)).symm + rw [tvDivFun, DivFunction.derivAtTop_ofReal_of_tendsto_nhds h, ENNReal.ofReal_one] + +/-- The total variation distance between finite measures is the f-divergence for the function +`x ↦ |1 - x|`. -/ +lemma fDiv_tvDivFun (μ ν : Measure 𝒳) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + fDiv tvDivFun μ ν = etvDist μ ν := by + rw [fDiv, derivAtTop_tvDivFun, one_mul, etvDist_eq_lintegral_enorm_rnDeriv_add_singularPart] + congr 1 + refine lintegral_congr_ae ?_ + filter_upwards [μ.rnDeriv_ne_top ν] with x hx + rw [tvDivFun_apply hx, ← Real.norm_eq_abs, ofReal_norm] + +end FDiv + +end ProbabilityTheory diff --git a/Statlib/EValues/Bernoulli.lean b/Statlib/EValues/Bernoulli.lean index 53706d6..4724994 100644 --- a/Statlib/EValues/Bernoulli.lean +++ b/Statlib/EValues/Bernoulli.lean @@ -6,6 +6,7 @@ Authors: Rémy Degenne, Gaëtan Serré module public import Statlib.EValues.Divergence +public import Statlib.Divergence.Renyi.Bernoulli public import Statlib.ForMathlib.InformationTheory.KullbackLeibler.Bernoulli public import Statlib.ForMathlib.Probability.Distributions.Bernoulli @@ -28,7 +29,9 @@ between `Ber(true, false, δ)` and `Ber(true, false, η)`, and for `δ < η` the is the Chernoff information. Both are computed with a saddle point: a Bernoulli distribution `Ber(true, false, r)` with `δ ≤ r ≤ η` whose likelihood ratios with respect to `Ber(true, false, δ)` and `Ber(true, false, η)` certify both the lower bound (they are e-variables) and the upper bound -(they are the numeraires at `Ber(true, false, r)`). +(they are the numeraires at `Ber(true, false, r)`). The same saddle point computes the e-Chernoff +divergence between the singletons `{Ber(true, false, δ)}` and `{Ber(true, false, η)}`, which is the +Chernoff information `chernoffDiv 1` (`echernoffDiv_singleton`). ## Main statements @@ -38,11 +41,18 @@ and `Ber(true, false, η)` certify both the lower bound (they are e-variables) a * `maxUtility_bernoulli`, `maxUtility_bernoulli_ge`: the maximal logarithmic utility is the Kullback-Leibler divergence. For `p ≤ δ`, `Ber(true, false, p)` belongs to the set and its maximal logarithmic utility is zero (`maxUtility_eq_zero_of_mem`). +* `maxUtility_bernoulli_singleton`: for the singleton `{Ber(true, false, δ)}`, the maximal + logarithmic utility of `Ber(true, false, s)` is the Kullback-Leibler divergence `klBerReal s δ` + for every `s`. * `erenyiDiv_bernoulli`: the e-Rényi divergence of order `α` between the Bernoulli distributions with parameter at most `δ` and those with parameter at least `η` is the Rényi divergence - `(α - 1)⁻¹ * log (δ ^ α * η ^ (1 - α) + (1 - δ) ^ α * (1 - η) ^ (1 - α))`. -* `echernoffDiv_bernoulli`: their e-Chernoff divergence is `klBerReal r δ = klBerReal r η` for an - explicit `r ∈ [δ, η]`. + `renyiDiv α Ber(true, false, δ) Ber(true, false, η)`, which is + `(α - 1)⁻¹ * log (δ ^ α * η ^ (1 - α) + (1 - δ) ^ α * (1 - η) ^ (1 - α))` + (`renyiDiv_bernoulliMeasure`). +* `echernoffDiv_bernoulli`: their e-Chernoff divergence is the Chernoff information + `chernoffDiv 1 Ber(true, false, δ) Ber(true, false, η)`. +* `chernoffDiv_one_bernoulliMeasure`: the Chernoff information between `Ber(true, false, δ)` and + `Ber(true, false, η)` is `klBerReal r δ = klBerReal r η` for an explicit `r ∈ [δ, η]`. * `erenyiDiv_inv_two_bernoulli_one_sub`, `echernoffDiv_bernoulli_one_sub`: for `η = 1 - δ`, the divergences are `log (1 / (4 * δ * (1 - δ)))` (order `1/2`) and half of it. -/ @@ -72,12 +82,12 @@ lemma eintegral_bernoulliMeasure' {𝓧 : Type*} {m𝓧 : MeasurableSpace 𝓧} /-! ### E-variables and numeraire -/ -variable {δ η : ℝ} {X : Bool → ℝ≥0∞} +variable {δ η : I} {X : Bool → ℝ≥0∞} /-- A function is an e-variable for the Bernoulli distributions with parameter at most `δ` iff its expectations under the parameters `0` and `δ` are at most one: the expectation is affine in the parameter. -/ -lemma isEVar_bernoulli_iff (hδ_nonneg : 0 ≤ δ) (hδ_le : δ ≤ 1) : +lemma isEVar_bernoulli_iff : IsEVar X {Ber(true, false, q) | (q : I) (_ : (q : ℝ) ≤ δ)} ↔ X false ≤ 1 ∧ ENNReal.ofReal δ * X true + ENNReal.ofReal (1 - δ) * X false ≤ 1 := by have h_iff : IsEVar X {Ber(true, false, q) | (q : I) (_ : (q : ℝ) ≤ δ)} ↔ ∀ q : I, (q : ℝ) ≤ δ → @@ -89,11 +99,12 @@ lemma isEVar_bernoulli_iff (hδ_nonneg : 0 ≤ δ) (hδ_le : δ ≤ 1) : · rintro _ ⟨q, hq, rfl⟩ simpa [lintegral_bernoulliMeasure] using h q hq rw [h_iff] - refine ⟨fun h ↦ ⟨by simpa using h 0 hδ_nonneg, h ⟨δ, hδ_nonneg, hδ_le⟩ le_rfl⟩, - fun ⟨h0, hδ⟩ q hq ↦ ?_⟩ - rcases hδ_nonneg.eq_or_lt with rfl | hδ_pos + refine ⟨fun h ↦ ⟨by simpa using h 0 δ.2.1, h δ le_rfl⟩, fun ⟨h0, hδ⟩ q hq ↦ ?_⟩ + rcases eq_or_ne δ 0 with rfl | hδ0 · obtain rfl : q = 0 := Subtype.ext (le_antisymm hq q.2.1) simpa using h0 + have hδ_pos : (0 : ℝ) < δ := coe_pos.mpr (unitInterval.pos_iff_ne_zero.mpr hδ0) + have hδ_le : (δ : ℝ) ≤ 1 := δ.2.2 -- the distribution with parameter `q` is a mixture of those with parameters `δ` and `0` set t := (q : ℝ) / δ have ht_nonneg : 0 ≤ t := div_nonneg q.2.1 hδ_pos.le @@ -102,7 +113,7 @@ lemma isEVar_bernoulli_iff (hδ_nonneg : 0 ≤ δ) (hδ_le : δ ≤ 1) : _ = ENNReal.ofReal t * (ENNReal.ofReal δ * X true + ENNReal.ofReal (1 - δ) * X false) + ENNReal.ofReal (1 - t) * X false := by rw [show (q : ℝ) = t * δ from (div_mul_cancel₀ _ hδ_pos.ne').symm, - show 1 - t * δ = t * (1 - δ) + (1 - t) by ring, + show 1 - t * (δ : ℝ) = t * (1 - δ) + (1 - t) by ring, ENNReal.ofReal_mul ht_nonneg, ENNReal.ofReal_add (by nlinarith) (by linarith), ENNReal.ofReal_mul ht_nonneg] ring @@ -127,10 +138,13 @@ theorem isNumeraire_bernoulli {p : I} (hδ_pos : 0 < δ) (hδ_lt : δ < 1) (hδp {Ber(true, false, q) | (q : I) (_ : (q : ℝ) ≤ δ)} Ber(true, false, p) := by set X : Bool → ℝ≥0∞ := fun b ↦ if b then ENNReal.ofReal (p / δ) else ENNReal.ofReal ((1 - p) / (1 - δ)) + replace hδ_pos : (0 : ℝ) < δ := coe_pos.mpr hδ_pos + replace hδ_lt : (δ : ℝ) < 1 := coe_lt_one.mpr hδ_lt + replace hδp : (δ : ℝ) ≤ p := hδp have hp_pos : 0 < (p : ℝ) := hδ_pos.trans_le hδp - have hδ_one : 0 < 1 - δ := by linarith + have hδ_one : 0 < 1 - (δ : ℝ) := by linarith have hX : IsEVar X {Ber(true, false, q) | (q : I) (_ : (q : ℝ) ≤ δ)} := by - rw [isEVar_bernoulli_iff hδ_pos.le hδ_lt.le] + rw [isEVar_bernoulli_iff] simp only [X, ↓reduceIte, Bool.false_eq_true] refine ⟨?_, ?_⟩ · rw [ENNReal.ofReal_le_one, div_le_one hδ_one] @@ -154,8 +168,7 @@ theorem isNumeraire_bernoulli {p : I} (hδ_pos : 0 < δ) (hδ_lt : δ < 1) (hδp refine isNumeraire_of_lintegral_div_le hX (by simp [h_fsupport]) fun Y hY ↦ ?_ -- the expectation of `Y / X` under `Ber(true, false, p)` is at most that of `Y` under -- `Ber(true, false, δ)` - have hYδ := hY.lintegral_le_measure_univ Ber(true, false, ⟨δ, hδ_pos.le, hδ_lt.le⟩) - ⟨⟨δ, hδ_pos.le, hδ_lt.le⟩, le_rfl, rfl⟩ + have hYδ := hY.lintegral_le_measure_univ Ber(true, false, δ) ⟨δ, le_rfl, rfl⟩ rw [lintegral_bernoulliMeasure, measure_univ] at hYδ rw [h_fsupport, lintegral_bernoulliMeasure] refine le_trans ?_ hYδ @@ -173,10 +186,12 @@ distributions with parameter at most `δ` is the Kullback-Leibler divergence bet theorem maxUtility_bernoulli {p : I} (hδ_pos : 0 < δ) (hδ_lt : δ < 1) (hδp : δ ≤ p) : maxUtility Ber(true, false, p) {Ber(true, false, q) | (q : I) (_ : (q : ℝ) ≤ δ)} logUtility = klBerReal p δ := by - have hp_pos : 0 < (p : ℝ) := hδ_pos.trans_le hδp - have hδ_one : 0 < 1 - δ := by linarith rw [(isNumeraire_bernoulli hδ_pos hδ_lt hδp).maxUtility_eq_eintegral, eintegral_bernoulliMeasure, klBerReal_apply] + replace hδ_pos : (0 : ℝ) < δ := coe_pos.mpr hδ_pos + replace hδ_lt : (δ : ℝ) < 1 := coe_lt_one.mpr hδ_lt + have hp_pos : 0 < (p : ℝ) := hδ_pos.trans_le hδp + have hδ_one : 0 < 1 - (δ : ℝ) := by linarith simp only [↓reduceIte, Bool.false_eq_true] rw [ENNReal.log_ofReal_of_pos (div_pos hp_pos hδ_pos), EReal.coe_ennreal_ofReal, max_eq_left hp_pos.le] @@ -186,19 +201,32 @@ theorem maxUtility_bernoulli {p : I} (hδ_pos : 0 < δ) (hδ_lt : δ < 1) (hδp max_eq_left (sub_pos.mpr hp1).le] norm_cast +/-- For `δ ∈ (0, 1)`, the maximal logarithmic utility of `Ber(true, false, s)` for the singleton +`{Ber(true, false, δ)}` is the Kullback-Leibler divergence `klBerReal s δ`, for every `s`. For the +Bernoulli distributions with parameter at most `δ`, see `maxUtility_bernoulli`. -/ +theorem maxUtility_bernoulli_singleton (hδ_pos : 0 < δ) (hδ_lt : δ < 1) (s : I) : + maxUtility Ber(true, false, s) {Ber(true, false, δ)} logUtility = klBerReal s δ := by + rw [maxUtility_singleton_eq_klDiv, + klDiv_bernoulliMeasure_eq_klBerReal (by decide) s hδ_pos.ne' hδ_lt.ne, + EReal.coe_ennreal_ofReal, max_eq_left (klBerReal_nonneg s.2.1 s.2.2 (coe_pos.mpr hδ_pos) + (coe_lt_one.mpr hδ_lt))] + /-- The likelihood ratio of `Ber(true, false, p)` with respect to `Ber(true, false, δ)` is an e-variable for the Bernoulli distributions with parameter at most `δ`: its expected logarithm under `Ber(true, false, s)`, an affine function of `s`, bounds the maximal logarithmic utility of `Ber(true, false, s)`. It is equal to it at `s = p`. -/ private lemma le_maxUtility_bernoulli {p : I} (hδ_pos : 0 < δ) (hδ_lt : δ < 1) (hδp : δ ≤ p) - (hp : (p : ℝ) < 1) (s : I) : + (hp : p < 1) (s : I) : ((s * Real.log (p / δ) + (1 - s) * Real.log ((1 - p) / (1 - δ)) : ℝ) : EReal) ≤ maxUtility Ber(true, false, s) {Ber(true, false, q) | (q : I) (_ : (q : ℝ) ≤ δ)} logUtility := by - have hp_pos : 0 < (p : ℝ) := hδ_pos.trans_le hδp - have hδ_one : 0 < 1 - δ := by linarith refine le_of_eq_of_le ?_ ((isNumeraire_bernoulli hδ_pos hδ_lt hδp).isEVar.eintegral_le_maxUtility _ logUtility) + replace hδ_pos : (0 : ℝ) < δ := coe_pos.mpr hδ_pos + replace hδ_lt : (δ : ℝ) < 1 := coe_lt_one.mpr hδ_lt + replace hp : (p : ℝ) < 1 := coe_lt_one.mpr hp + have hp_pos : 0 < (p : ℝ) := hδ_pos.trans_le hδp + have hδ_one : 0 < 1 - (δ : ℝ) := by linarith rw [eintegral_bernoulliMeasure] simp only [Function.comp_apply, ↓reduceIte, Bool.false_eq_true, logUtility_apply] rw [ENNReal.log_ofReal_of_pos (div_pos hp_pos hδ_pos), @@ -214,44 +242,46 @@ at least `η`, which reduces the maximal logarithmic utility for the latter to t lemma map_not_bernoulliMeasure (q : I) : Ber(true, false, q).map not = Ber(true, false, σ q) := by rw [map_bernoulliMeasure, Bool.not_true, Bool.not_false, ← bernoulliMeasure_swap] -lemma image_map_not_bernoulli (δ : ℝ) : +lemma image_map_not_bernoulli (δ : I) : {μ.map not | μ ∈ {Ber(true, false, q) | (q : I) (_ : (q : ℝ) ≤ δ)}} - = {Ber(true, false, q) | (q : I) (_ : 1 - δ ≤ (q : ℝ))} := by + = {Ber(true, false, q) | (q : I) (_ : (σ δ : ℝ) ≤ q)} := by ext μ constructor · rintro ⟨_, ⟨q, hq, rfl⟩, rfl⟩ - exact ⟨σ q, by rw [coe_symm_eq]; linarith, (map_not_bernoulliMeasure q).symm⟩ + exact ⟨σ q, by rw [coe_symm_eq, coe_symm_eq]; linarith, (map_not_bernoulliMeasure q).symm⟩ · rintro ⟨q, hq, rfl⟩ - refine ⟨Ber(true, false, σ q), ⟨σ q, by rw [coe_symm_eq]; linarith, rfl⟩, ?_⟩ + refine ⟨Ber(true, false, σ q), ⟨σ q, by rw [coe_symm_eq] at hq ⊢; linarith, rfl⟩, ?_⟩ rw [map_not_bernoulliMeasure, symm_symm] -private lemma maxUtility_bernoulli_ge_eq (η : ℝ) (p : I) : - maxUtility Ber(true, false, p) {Ber(true, false, q) | (q : I) (_ : η ≤ (q : ℝ))} logUtility - = maxUtility Ber(true, false, σ p) {Ber(true, false, q) | (q : I) (_ : (q : ℝ) ≤ 1 - η)} +private lemma maxUtility_bernoulli_ge_eq (η p : I) : + maxUtility Ber(true, false, p) {Ber(true, false, q) | (q : I) (_ : (η : ℝ) ≤ q)} logUtility + = maxUtility Ber(true, false, σ p) {Ber(true, false, q) | (q : I) (_ : (q : ℝ) ≤ σ η)} logUtility := by - have h := image_map_not_bernoulli (1 - η) - rw [sub_sub_cancel] at h + have h := image_map_not_bernoulli (σ η) + rw [symm_symm] at h rw [← h, maxUtility_involutive _ _ .of_discrete Bool.not_not, map_not_bernoulliMeasure] /-- For `p ≤ η`, the maximal logarithmic utility of `Ber(true, false, p)` for the Bernoulli distributions with parameter at least `η` is the Kullback-Leibler divergence between `Ber(true, false, p)` and `Ber(true, false, η)`. -/ -theorem maxUtility_bernoulli_ge {p : I} (hη_pos : 0 < η) (hη_lt : η < 1) (hpη : (p : ℝ) ≤ η) : - maxUtility Ber(true, false, p) {Ber(true, false, q) | (q : I) (_ : η ≤ (q : ℝ))} logUtility +theorem maxUtility_bernoulli_ge {p : I} (hη_pos : 0 < η) (hη_lt : η < 1) (hpη : p ≤ η) : + maxUtility Ber(true, false, p) {Ber(true, false, q) | (q : I) (_ : (η : ℝ) ≤ q)} logUtility = klBerReal p η := by - rw [maxUtility_bernoulli_ge_eq, maxUtility_bernoulli (by linarith) (by linarith) - (by rw [coe_symm_eq]; linarith), coe_symm_eq, klBerReal_one_sub] + rw [maxUtility_bernoulli_ge_eq, maxUtility_bernoulli (by rwa [← symm_one, symm_lt_symm]) + (by rwa [← symm_zero, symm_lt_symm]) (symm_le_symm.mpr hpη), coe_symm_eq, coe_symm_eq, + klBerReal_one_sub] /-- Version of `le_maxUtility_bernoulli` for the Bernoulli distributions with parameter at least `η`, with the likelihood ratio of `Ber(true, false, p)` with respect to `Ber(true, false, η)`. -/ private lemma le_maxUtility_bernoulli_ge {p : I} (hη_pos : 0 < η) (hη_lt : η < 1) - (hpη : (p : ℝ) ≤ η) (hp : 0 < (p : ℝ)) (s : I) : + (hpη : p ≤ η) (hp : 0 < p) (s : I) : ((s * Real.log (p / η) + (1 - s) * Real.log ((1 - p) / (1 - η)) : ℝ) : EReal) - ≤ maxUtility Ber(true, false, s) {Ber(true, false, q) | (q : I) (_ : η ≤ (q : ℝ))} + ≤ maxUtility Ber(true, false, s) {Ber(true, false, q) | (q : I) (_ : (η : ℝ) ≤ q)} logUtility := by rw [maxUtility_bernoulli_ge_eq] - refine le_of_eq_of_le ?_ (le_maxUtility_bernoulli (p := σ p) (δ := 1 - η) (by linarith) - (by linarith) (by rw [coe_symm_eq]; linarith) (by rw [coe_symm_eq]; linarith) (σ s)) + refine le_of_eq_of_le ?_ (le_maxUtility_bernoulli (p := σ p) (δ := σ η) + (by rwa [← symm_one, symm_lt_symm]) (by rwa [← symm_zero, symm_lt_symm]) + (symm_le_symm.mpr hpη) (by rwa [← symm_zero, symm_lt_symm]) (σ s)) simp only [coe_symm_eq, sub_sub_cancel] norm_cast ring @@ -260,7 +290,7 @@ private lemma le_maxUtility_bernoulli_ge {p : I} (hη_pos : 0 < η) (hη_lt : η /-- The parameter `δ ^ a * η ^ (1 - a) / Z` of the normalized geometric mixture of `Ber(true, false, δ)` and `Ber(true, false, η)` is at least `δ`. -/ -private lemma le_geomMix {a : ℝ} (ha1 : a ≤ 1) (hδ_pos : 0 < δ) (hδη : δ ≤ η) (hη : η < 1) : +private lemma le_geomMix {δ η a : ℝ} (ha1 : a ≤ 1) (hδ_pos : 0 < δ) (hδη : δ ≤ η) (hη : η < 1) : δ * ((1 - δ) ^ a * (1 - η) ^ (1 - a)) ≤ (1 - δ) * (δ ^ a * η ^ (1 - a)) := by have hη_pos : 0 < η := hδ_pos.trans_le hδη have hδ1 : 0 < 1 - δ := by linarith @@ -280,7 +310,7 @@ private lemma le_geomMix {a : ℝ} (ha1 : a ≤ 1) (hδ_pos : 0 < δ) (hδη : /-- The parameter `δ ^ a * η ^ (1 - a) / Z` of the normalized geometric mixture of `Ber(true, false, δ)` and `Ber(true, false, η)` is at most `η`. -/ -private lemma geomMix_le {a : ℝ} (ha0 : 0 ≤ a) (hδ_pos : 0 < δ) (hδη : δ ≤ η) (hη : η < 1) : +private lemma geomMix_le {δ η a : ℝ} (ha0 : 0 ≤ a) (hδ_pos : 0 < δ) (hδη : δ ≤ η) (hη : η < 1) : (1 - η) * (δ ^ a * η ^ (1 - a)) ≤ η * ((1 - δ) ^ a * (1 - η) ^ (1 - a)) := by have hη_pos : 0 < η := hδ_pos.trans_le hδη have hδ1 : 0 < 1 - δ := by linarith @@ -299,8 +329,7 @@ private lemma geomMix_le {a : ℝ} (ha0 : 0 ≤ a) (hδ_pos : 0 < δ) (hδη : ← Real.rpow_add hη_pos, add_sub_cancel, Real.rpow_one] /-- For `δ ≤ η`, the e-Rényi divergence of order `α < 1` between the Bernoulli distributions with -parameter at most `δ` and those with parameter at least `η` is the Rényi divergence of order `α` -between `Ber(true, false, δ)` and `Ber(true, false, η)`, +parameter at most `δ` and those with parameter at least `η` is `(α - 1)⁻¹ * log (δ ^ α * η ^ (1 - α) + (1 - δ) ^ α * (1 - η) ^ (1 - α))`. The normalized geometric mixture `Ber(true, false, r)` of `Ber(true, false, δ)` and @@ -308,24 +337,27 @@ The normalized geometric mixture `Ber(true, false, r)` of `Ber(true, false, δ)` ratios of `Ber(true, false, r)` with respect to `Ber(true, false, δ)` and `Ber(true, false, η)` are e-variables for the two sets and their numeraires at `Ber(true, false, r)`, and the mixture of their logarithms with weights `α` and `1 - α` is constant. -/ -theorem erenyiDiv_bernoulli {α : ℝ≥0∞} (hα : α < 1) (hδ_pos : 0 < δ) (hδη : δ ≤ η) - (hη : η < 1) : +private theorem erenyiDiv_bernoulli_eq_ofReal {α : ℝ≥0∞} (hα : α < 1) (hδ_pos : 0 < δ) + (hδη : δ ≤ η) (hη : η < 1) : erenyiDiv α {Ber(true, false, q) | (q : I) (_ : (q : ℝ) ≤ δ)} - {Ber(true, false, q) | (q : I) (_ : η ≤ (q : ℝ))} - = ENNReal.ofReal ((α.toReal - 1)⁻¹ * Real.log (δ ^ α.toReal * η ^ (1 - α.toReal) - + (1 - δ) ^ α.toReal * (1 - η) ^ (1 - α.toReal))) := by + {Ber(true, false, q) | (q : I) (_ : (η : ℝ) ≤ q)} + = ENNReal.ofReal ((α.toReal - 1)⁻¹ * Real.log ((δ : ℝ) ^ α.toReal * (η : ℝ) ^ (1 - α.toReal) + + (1 - (δ : ℝ)) ^ α.toReal * (1 - (η : ℝ)) ^ (1 - α.toReal))) := by obtain ⟨a, ha0, rfl⟩ : ∃ a : ℝ, 0 ≤ a ∧ α = ENNReal.ofReal a := ⟨α.toReal, ENNReal.toReal_nonneg, (ENNReal.ofReal_toReal hα.ne_top).symm⟩ have ha1 : a < 1 := ENNReal.ofReal_lt_one.mp hα have h1α : 1 - ENNReal.ofReal a = ENNReal.ofReal (1 - a) := by rw [ENNReal.ofReal_sub _ ha0, ENNReal.ofReal_one] rw [ENNReal.toReal_ofReal ha0] - have hη_pos : 0 < η := hδ_pos.trans_le hδη - have hδ1 : 0 < 1 - δ := by linarith - have hη1 : 0 < 1 - η := by linarith + have hδ' : (0 : ℝ) < δ := coe_pos.mpr hδ_pos + have hδη' : (δ : ℝ) ≤ η := hδη + have hη' : (η : ℝ) < 1 := coe_lt_one.mpr hη + have hη_pos : (0 : ℝ) < η := hδ'.trans_le hδη' + have hδ1 : 0 < 1 - (δ : ℝ) := by linarith + have hη1 : 0 < 1 - (η : ℝ) := by linarith -- the normalized geometric mixture `Ber(true, false, r)` - set u := δ ^ a * η ^ (1 - a) with hu_def - set v := (1 - δ) ^ a * (1 - η) ^ (1 - a) with hv_def + set u := (δ : ℝ) ^ a * (η : ℝ) ^ (1 - a) with hu_def + set v := (1 - (δ : ℝ)) ^ a * (1 - (η : ℝ)) ^ (1 - a) with hv_def have hu : 0 < u := by positivity have hv : 0 < v := mul_pos (Real.rpow_pos_of_pos hδ1 _) (Real.rpow_pos_of_pos hη1 _) have hZ : 0 < u + v := add_pos hu hv @@ -333,17 +365,17 @@ theorem erenyiDiv_bernoulli {α : ℝ≥0∞} (hα : α < 1) (hδ_pos : 0 < δ) have h1r : 1 - r = v / (u + v) := by rw [hr]; field_simp; ring have hr0 : 0 < r := hr ▸ div_pos hu hZ have hr1 : 0 < 1 - r := h1r ▸ div_pos hv hZ - have hδr : δ ≤ r := by + have hδr : (δ : ℝ) ≤ r := by rw [hr, le_div_iff₀ hZ] - linarith [le_geomMix ha1.le hδ_pos hδη hη] - have hrη : r ≤ η := by + linarith [le_geomMix ha1.le hδ' hδη' hη'] + have hrη : r ≤ (η : ℝ) := by rw [hr, div_le_iff₀ hZ] - linarith [geomMix_le ha0 hδ_pos hδη hη] + linarith [geomMix_le ha0 hδ' hδη' hη'] -- the mixture of the logarithms of the likelihood ratios is constant have h_true : a * Real.log (r / δ) + (1 - a) * Real.log (r / η) = -Real.log (u + v) := by - rw [Real.log_div hr0.ne' hδ_pos.ne', Real.log_div hr0.ne' hη_pos.ne', hr, + rw [Real.log_div hr0.ne' hδ'.ne', Real.log_div hr0.ne' hη_pos.ne', hr, Real.log_div hu.ne' hZ.ne', hu_def, Real.log_mul (by positivity) (by positivity), - Real.log_rpow hδ_pos, Real.log_rpow hη_pos] + Real.log_rpow hδ', Real.log_rpow hη_pos] ring have h_false : a * Real.log ((1 - r) / (1 - δ)) + (1 - a) * Real.log ((1 - r) / (1 - η)) = -Real.log (u + v) := by @@ -357,20 +389,25 @@ theorem erenyiDiv_bernoulli {α : ℝ≥0∞} (hα : α < 1) (hδ_pos : 0 < δ) = -Real.log (u + v) := by linear_combination s * h_true + (1 - s) * h_false set r' : I := ⟨r, hr0.le, by linarith⟩ + have hδr' : δ ≤ r' := hδr + have hr'η : r' ≤ η := hrη + have hr'0 : 0 < r' := coe_pos.mp hr0 + have hr'1 : r' < 1 := coe_lt_one.mp (by simp only [r']; linarith) have h_inf : ⨅ (R : Measure Bool) (_ : IsProbabilityMeasure R), ENNReal.ofReal a * (maxUtility R {Ber(true, false, q) | (q : I) (_ : (q : ℝ) ≤ δ)} logUtility).toENNReal + (1 - ENNReal.ofReal a) - * (maxUtility R {Ber(true, false, q) | (q : I) (_ : η ≤ (q : ℝ))} logUtility).toENNReal + * (maxUtility R {Ber(true, false, q) | (q : I) (_ : (η : ℝ) ≤ q)} logUtility).toENNReal = ENNReal.ofReal (-Real.log (u + v)) := by refine le_antisymm (iInf₂_le_of_le Ber(true, false, r') inferInstance (le_of_eq ?_)) (le_iInf₂ fun R _ ↦ ?_) · -- the geometric mixture attains the bound - rw [maxUtility_bernoulli hδ_pos (by linarith) hδr, maxUtility_bernoulli_ge hη_pos hη hrη, + rw [maxUtility_bernoulli hδ_pos (hδη.trans_lt hη) hδr', + maxUtility_bernoulli_ge (hδ_pos.trans_le hδη) hη hr'η, EReal.real_coe_toENNReal, EReal.real_coe_toENNReal, h1α, ← ENNReal.ofReal_mul ha0, ← ENNReal.ofReal_mul (by linarith), ← ENNReal.ofReal_add - (mul_nonneg ha0 (klBerReal_nonneg hr0.le (by linarith) hδ_pos (by linarith))) - (mul_nonneg (by linarith) (klBerReal_nonneg hr0.le (by linarith) hη_pos hη))] + (mul_nonneg ha0 (klBerReal_nonneg hr0.le (by linarith) hδ' (by linarith))) + (mul_nonneg (by linarith) (klBerReal_nonneg hr0.le (by linarith) hη_pos hη'))] exact congrArg ENNReal.ofReal (h_comb r) · -- every probability measure on `Bool` is a Bernoulli distribution obtain ⟨s, rfl⟩ : ∃ s : I, Ber(true, false, s) = R := @@ -379,57 +416,67 @@ theorem erenyiDiv_bernoulli {α : ℝ≥0∞} (hα : α < 1) (hδ_pos : 0 < δ) refine ENNReal.ofReal_add_le.trans ?_ rw [ENNReal.ofReal_mul ha0, ENNReal.ofReal_mul (by linarith)] gcongr <;> rw [← EReal.real_coe_toENNReal] <;> refine EReal.toENNReal_le_toENNReal ?_ - · exact le_maxUtility_bernoulli (p := r') hδ_pos (by linarith) hδr (by linarith) s - · exact le_maxUtility_bernoulli_ge (p := r') hη_pos hη hrη hr0 s + · exact le_maxUtility_bernoulli hδ_pos (hδη.trans_lt hη) hδr' hr'1 s + · exact le_maxUtility_bernoulli_ge (hδ_pos.trans_le hδη) hη hr'η hr'0 s rw [erenyiDiv, h_inf, h1α, ← ENNReal.ofReal_inv_of_pos (by linarith), ← ENNReal.ofReal_mul (by simp [ha1.le])] congr 1 rw [show a - 1 = -(1 - a) by ring, inv_neg] ring -/-- For `δ < η`, the e-Chernoff divergence between the Bernoulli distributions with parameter at -most `δ` and those with parameter at least `η` is the Chernoff information between -`Ber(true, false, δ)` and `Ber(true, false, η)`: `klBerReal r δ = klBerReal r η`, where `r` is the -parameter at which the two Kullback-Leibler divergences are equal. +/-- For `δ < η`, the e-Chernoff divergence between sets `S` and `T` of Bernoulli distributions +with parameters at most `δ`, respectively at least `η`, is `klBerReal r δ = klBerReal r η`, where +`r` is the parameter at which the two Kullback-Leibler divergences are equal, provided that the +maximal logarithmic utilities of `Ber(true, false, s)` for `S` and `T` are at most the +Kullback-Leibler divergences to `Ber(true, false, δ)` and `Ber(true, false, η)`. This holds for the +sets of all such Bernoulli distributions and for the singletons `{Ber(true, false, δ)}` and +`{Ber(true, false, η)}`. The lower bounds given by the likelihood ratios of `Ber(true, false, r)` with respect to `Ber(true, false, δ)` and `Ber(true, false, η)` are affine in the parameter, one nondecreasing and one nonincreasing, and they are equal at `r`. -/ -theorem echernoffDiv_bernoulli (hδ_pos : 0 < δ) (hδη : δ < η) (hη : η < 1) {r : ℝ} - (hr : r = Real.log ((1 - δ) / (1 - η)) / (Real.log (η / δ) + Real.log ((1 - δ) / (1 - η)))) : - echernoffDiv {Ber(true, false, q) | (q : I) (_ : (q : ℝ) ≤ δ)} - {Ber(true, false, q) | (q : I) (_ : η ≤ (q : ℝ))} - = ENNReal.ofReal (klBerReal r δ) := by - have hη_pos : 0 < η := hδ_pos.trans hδη - have hδ1 : 0 < 1 - δ := by linarith - have hη1 : 0 < 1 - η := by linarith +private theorem echernoffDiv_bernoulli_eq_ofReal (hδ_pos : 0 < δ) (hδη : δ < η) (hη : η < 1) + {r : ℝ} + (hr : r = Real.log ((1 - δ) / (1 - η)) / (Real.log (η / δ) + Real.log ((1 - δ) / (1 - η)))) + {S T : Set (Measure Bool)} (hS : S ⊆ {Ber(true, false, q) | (q : I) (_ : (q : ℝ) ≤ δ)}) + (hT : T ⊆ {Ber(true, false, q) | (q : I) (_ : (η : ℝ) ≤ q)}) + (hS_le : ∀ s : I, δ ≤ s → maxUtility Ber(true, false, s) S logUtility ≤ klBerReal s δ) + (hT_le : ∀ s : I, s ≤ η → maxUtility Ber(true, false, s) T logUtility ≤ klBerReal s η) : + echernoffDiv S T = ENNReal.ofReal (klBerReal r δ) := by + have hδ' : (0 : ℝ) < δ := coe_pos.mpr hδ_pos + have hδη' : (δ : ℝ) < η := hδη + have hη' : (η : ℝ) < 1 := coe_lt_one.mpr hη + have hη_pos : (0 : ℝ) < η := hδ'.trans hδη' + have hδ1 : 0 < 1 - (δ : ℝ) := by linarith + have hη1 : 0 < 1 - (η : ℝ) := by linarith set A := Real.log ((1 - δ) / (1 - η)) with hA_def set B := Real.log (η / δ) with hB_def have hA : 0 < A := Real.log_pos ((one_lt_div hη1).mpr (by linarith)) - have hB : 0 < B := Real.log_pos ((one_lt_div hδ_pos).mpr hδη) + have hB : 0 < B := Real.log_pos ((one_lt_div hδ').mpr hδη') have hr0 : 0 < r := hr ▸ div_pos hA (add_pos hB hA) have hr1 : 0 < 1 - r := by rw [hr, sub_pos, div_lt_one (add_pos hB hA)] linarith -- Gibbs' inequality locates `r` between `δ` and `η` - have h_gibbs₁ := klBerReal_nonneg hδ_pos.le (by linarith) hη_pos hη - have h_gibbs₂ := klBerReal_nonneg hη_pos.le hη.le hδ_pos (by linarith) - rw [klBerReal_apply, ← inv_div η δ, Real.log_inv, ← hB_def, ← hA_def] at h_gibbs₁ - rw [klBerReal_apply, ← hB_def, ← inv_div (1 - δ) (1 - η), Real.log_inv, ← hA_def] at h_gibbs₂ - have hδr : δ ≤ r := by + have h_gibbs₁ := klBerReal_nonneg hδ'.le (by linarith) hη_pos hη' + have h_gibbs₂ := klBerReal_nonneg hη_pos.le hη'.le hδ' (by linarith) + rw [klBerReal_apply, ← inv_div (η : ℝ) δ, Real.log_inv, ← hB_def, ← hA_def] at h_gibbs₁ + rw [klBerReal_apply, ← hB_def, ← inv_div (1 - (δ : ℝ)) (1 - η), Real.log_inv, + ← hA_def] at h_gibbs₂ + have hδr : (δ : ℝ) ≤ r := by rw [hr, le_div_iff₀ (add_pos hB hA)] linarith - have hrη : r ≤ η := by + have hrη : r ≤ (η : ℝ) := by rw [hr, div_le_iff₀ (add_pos hB hA)] linarith -- at `r`, the divergences to `δ` and to `η` are equal have h_eq : klBerReal r δ = klBerReal r η := by - rw [klBerReal_eq_of_ne hδ_pos.ne' (by linarith), klBerReal_eq_of_ne hη_pos.ne' (by linarith)] + rw [klBerReal_eq_of_ne hδ'.ne' (by linarith), klBerReal_eq_of_ne hη_pos.ne' (by linarith)] have hA' : A = Real.log (1 - δ) - Real.log (1 - η) := Real.log_div hδ1.ne' hη1.ne' - have hB' : B = Real.log η - Real.log δ := Real.log_div hη_pos.ne' hδ_pos.ne' + have hB' : B = Real.log η - Real.log δ := Real.log_div hη_pos.ne' hδ'.ne' have hrBA : r * (B + A) = A := by rw [hr]; field_simp linear_combination (-r) * hB' + (1 - r) * hA' + hrBA - have hlogδ : 0 ≤ Real.log (r / δ) := Real.log_nonneg ((one_le_div hδ_pos).mpr hδr) + have hlogδ : 0 ≤ Real.log (r / δ) := Real.log_nonneg ((one_le_div hδ').mpr hδr) have hlogδ' : Real.log ((1 - r) / (1 - δ)) ≤ 0 := Real.log_nonpos (div_nonneg hr1.le hδ1.le) ((div_le_one hδ1).mpr (by linarith)) have hlogη : Real.log (r / η) ≤ 0 := @@ -437,43 +484,101 @@ theorem echernoffDiv_bernoulli (hδ_pos : 0 < δ) (hδη : δ < η) (hη : η < have hlogη' : 0 ≤ Real.log ((1 - r) / (1 - η)) := Real.log_nonneg ((one_le_div hη1).mpr (by linarith)) set r' : I := ⟨r, hr0.le, by linarith⟩ - refine le_antisymm (iInf₂_le_of_le Ber(true, false, r') inferInstance (le_of_eq ?_)) + have hδr' : δ ≤ r' := hδr + have hr'η : r' ≤ η := hrη + have hr'0 : 0 < r' := coe_pos.mp hr0 + have hr'1 : r' < 1 := coe_lt_one.mp (by simp only [r']; linarith) + refine le_antisymm (iInf₂_le_of_le Ber(true, false, r') inferInstance ?_) (le_iInf₂ fun R _ ↦ ?_) · -- `Ber(true, false, r)` attains the bound - rw [maxUtility_bernoulli hδ_pos (by linarith) hδr, maxUtility_bernoulli_ge hη_pos hη hrη, - EReal.real_coe_toENNReal, EReal.real_coe_toENNReal, ← h_eq, max_self] + calc max (maxUtility Ber(true, false, r') S logUtility).toENNReal + (maxUtility Ber(true, false, r') T logUtility).toENNReal + _ ≤ max (klBerReal r δ : EReal).toENNReal (klBerReal r η : EReal).toENNReal := + max_le_max (EReal.toENNReal_le_toENNReal (hS_le r' hδr')) + (EReal.toENNReal_le_toENNReal (hT_le r' hr'η)) + _ = ENNReal.ofReal (klBerReal r δ) := by + rw [EReal.real_coe_toENNReal, EReal.real_coe_toENNReal, ← h_eq, max_self] -- every probability measure on `Bool` is a Bernoulli distribution obtain ⟨s, rfl⟩ : ∃ s : I, Ber(true, false, s) = R := ⟨_, (eq_bernoulliMeasure_real_true R).symm⟩ - rcases le_total r s with hrs | hsr + rcases le_total r (s : ℝ) with hrs | hsr · refine le_max_of_le_left ?_ rw [← EReal.real_coe_toENNReal] refine EReal.toENNReal_le_toENNReal ((EReal.coe_le_coe_iff.mpr ?_).trans - (le_maxUtility_bernoulli (p := r') hδ_pos (by linarith) hδr (by linarith) s)) + ((le_maxUtility_bernoulli hδ_pos (hδη.trans hη) hδr' hr'1 s).trans + (maxUtility_anti hS))) rw [klBerReal_apply] nlinarith [mul_nonneg (sub_nonneg.mpr hrs) (sub_nonneg.mpr (hlogδ'.trans hlogδ))] · refine le_max_of_le_right ?_ rw [h_eq, ← EReal.real_coe_toENNReal] refine EReal.toENNReal_le_toENNReal ((EReal.coe_le_coe_iff.mpr ?_).trans - (le_maxUtility_bernoulli_ge (p := r') hη_pos hη hrη hr0 s)) + ((le_maxUtility_bernoulli_ge (hδ_pos.trans hδη) hη hr'η hr'0 s).trans + (maxUtility_anti hT))) rw [klBerReal_apply] nlinarith [mul_nonneg (sub_nonneg.mpr hsr) (sub_nonneg.mpr (hlogη.trans hlogη'))] +/-! ### Identification with the classical divergences -/ + +/-- For `0 < δ ≤ η < 1`, the e-Rényi divergence of order `α < 1` between the Bernoulli +distributions with parameter at most `δ` and those with parameter at least `η` is the Rényi +divergence of order `α` between `Ber(true, false, δ)` and `Ber(true, false, η)`, whose value is +given by `renyiDiv_bernoulliMeasure`. -/ +theorem erenyiDiv_bernoulli {α : ℝ≥0∞} (hα : α < 1) (hδ_pos : 0 < δ) (hδη : δ ≤ η) + (hη : η < 1) : + erenyiDiv α {Ber(true, false, q) | (q : I) (_ : (q : ℝ) ≤ δ)} + {Ber(true, false, q) | (q : I) (_ : (η : ℝ) ≤ q)} + = renyiDiv α.toReal Ber(true, false, δ) Ber(true, false, η) := by + rw [erenyiDiv_bernoulli_eq_ofReal hα hδ_pos hδη hη] + rcases eq_or_ne α 0 with rfl | hα0 + · rw [ENNReal.toReal_zero, renyiDiv_zero_bernoulliMeasure (by decide) hδ_pos.ne' + (hδη.trans_lt hη).ne (hδ_pos.trans_le hδη).ne' hη.ne] + simp + · rw [renyiDiv_bernoulliMeasure (ENNReal.toReal_pos hα0 hα.ne_top) + (by simpa using (ENNReal.toReal_lt_toReal hα.ne_top ENNReal.one_ne_top).mpr hα) (by decide) + _ (hδ_pos.trans_le hδη).ne' hη.ne] + +/-- For `0 < δ < η < 1`, the Chernoff information between `Ber(true, false, δ)` and +`Ber(true, false, η)` is `klBerReal r δ = klBerReal r η`, where `r` is the parameter at which the +two Kullback-Leibler divergences are equal. -/ +theorem chernoffDiv_one_bernoulliMeasure (hδ_pos : 0 < δ) (hδη : δ < η) (hη : η < 1) {r : ℝ} + (hr : r = Real.log ((1 - δ) / (1 - η)) / (Real.log (η / δ) + Real.log ((1 - δ) / (1 - η)))) : + chernoffDiv 1 Ber(true, false, δ) Ber(true, false, η) = ENNReal.ofReal (klBerReal r δ) := by + rw [← echernoffDiv_singleton, echernoffDiv_bernoulli_eq_ofReal hδ_pos hδη hη hr + (Set.singleton_subset_iff.mpr ⟨δ, le_rfl, rfl⟩) (Set.singleton_subset_iff.mpr ⟨η, le_rfl, rfl⟩)] + · exact fun s _ ↦ (maxUtility_bernoulli_singleton hδ_pos (hδη.trans hη) s).le + · exact fun s _ ↦ (maxUtility_bernoulli_singleton (hδ_pos.trans hδη) hη s).le + +/-- For `0 < δ < η < 1`, the e-Chernoff divergence between the Bernoulli distributions with +parameter at most `δ` and those with parameter at least `η` is the Chernoff information between +`Ber(true, false, δ)` and `Ber(true, false, η)`, whose value is given by +`chernoffDiv_one_bernoulliMeasure`. -/ +theorem echernoffDiv_bernoulli (hδ_pos : 0 < δ) (hδη : δ < η) (hη : η < 1) : + echernoffDiv {Ber(true, false, q) | (q : I) (_ : (q : ℝ) ≤ δ)} + {Ber(true, false, q) | (q : I) (_ : (η : ℝ) ≤ q)} + = chernoffDiv 1 Ber(true, false, δ) Ber(true, false, η) := by + rw [chernoffDiv_one_bernoulliMeasure hδ_pos hδη hη rfl, + echernoffDiv_bernoulli_eq_ofReal hδ_pos hδη hη rfl subset_rfl subset_rfl] + · exact fun s hs ↦ (maxUtility_bernoulli hδ_pos (hδη.trans hη) hs).le + · exact fun s hs ↦ (maxUtility_bernoulli_ge (hδ_pos.trans hδη) hη hs).le + /-- The e-Rényi divergence of order `1/2` between the Bernoulli distributions with parameter at most `δ` and those with parameter at least `1 - δ` is `log (1 / (4 * δ * (1 - δ)))`. -/ -theorem erenyiDiv_inv_two_bernoulli_one_sub (hδ_pos : 0 < δ) (hδ : δ ≤ 2⁻¹) : +theorem erenyiDiv_inv_two_bernoulli_one_sub (hδ_pos : 0 < δ) (hδ : (δ : ℝ) ≤ 2⁻¹) : erenyiDiv 2⁻¹ {Ber(true, false, q) | (q : I) (_ : (q : ℝ) ≤ δ)} - {Ber(true, false, q) | (q : I) (_ : 1 - δ ≤ (q : ℝ))} + {Ber(true, false, q) | (q : I) (_ : (σ δ : ℝ) ≤ q)} = ENNReal.ofReal (Real.log (1 / (4 * δ * (1 - δ)))) := by - have hδ1 : 0 < 1 - δ := by linarith - rw [erenyiDiv_bernoulli (by norm_num) hδ_pos (by linarith) (by linarith), sub_sub_cancel] + have hδ' : (0 : ℝ) < δ := coe_pos.mpr hδ_pos + have hδ1 : 0 < 1 - (δ : ℝ) := by linarith + have hδσ : δ ≤ σ δ := show (δ : ℝ) ≤ σ δ by rw [coe_symm_eq]; linarith + rw [erenyiDiv_bernoulli_eq_ofReal (by norm_num) hδ_pos hδσ (by rwa [← symm_zero, symm_lt_symm]), + coe_symm_eq, sub_sub_cancel] congr 1 rw [show (2⁻¹ : ℝ≥0∞).toReal = 2⁻¹ by norm_num, show (1 : ℝ) - 2⁻¹ = 2⁻¹ by norm_num, - mul_comm ((1 - δ) ^ (2⁻¹ : ℝ)), ← two_mul, - Real.log_mul two_ne_zero (mul_pos (Real.rpow_pos_of_pos hδ_pos _) + mul_comm ((1 - (δ : ℝ)) ^ (2⁻¹ : ℝ)), ← two_mul, + Real.log_mul two_ne_zero (mul_pos (Real.rpow_pos_of_pos hδ' _) (Real.rpow_pos_of_pos hδ1 _)).ne', - Real.log_mul (Real.rpow_pos_of_pos hδ_pos _).ne' (Real.rpow_pos_of_pos hδ1 _).ne', - Real.log_rpow hδ_pos, Real.log_rpow hδ1, one_div, Real.log_inv, - Real.log_mul (by positivity) hδ1.ne', Real.log_mul (by norm_num) hδ_pos.ne', + Real.log_mul (Real.rpow_pos_of_pos hδ' _).ne' (Real.rpow_pos_of_pos hδ1 _).ne', + Real.log_rpow hδ', Real.log_rpow hδ1, one_div, Real.log_inv, + Real.log_mul (by positivity) hδ1.ne', Real.log_mul (by norm_num) hδ'.ne', show (4 : ℝ) = 2 ^ 2 by norm_num, Real.log_pow, show ((2⁻¹ : ℝ) - 1)⁻¹ = -2 by norm_num] push_cast ring @@ -481,9 +586,9 @@ theorem erenyiDiv_inv_two_bernoulli_one_sub (hδ_pos : 0 < δ) (hδ : δ ≤ 2 /-- The e-Chernoff divergence between the Bernoulli distributions with parameter at most `δ` and those with parameter at least `1 - δ` is `2⁻¹ * log (1 / (4 * δ * (1 - δ)))`. Negation exchanges the two sets, so this is half their e-Rényi divergence of order `1/2`. -/ -theorem echernoffDiv_bernoulli_one_sub (hδ_pos : 0 < δ) (hδ : δ ≤ 2⁻¹) : +theorem echernoffDiv_bernoulli_one_sub (hδ_pos : 0 < δ) (hδ : (δ : ℝ) ≤ 2⁻¹) : echernoffDiv {Ber(true, false, q) | (q : I) (_ : (q : ℝ) ≤ δ)} - {Ber(true, false, q) | (q : I) (_ : 1 - δ ≤ (q : ℝ))} + {Ber(true, false, q) | (q : I) (_ : (σ δ : ℝ) ≤ q)} = 2⁻¹ * ENNReal.ofReal (Real.log (1 / (4 * δ * (1 - δ)))) := by rw [← erenyiDiv_inv_two_bernoulli_one_sub hδ_pos hδ, erenyiDiv_eq_two_mul_echernoffDiv_of_involutive (φ := not) .of_discrete Bool.not_not diff --git a/Statlib/EValues/Divergence.lean b/Statlib/EValues/Divergence.lean index 73d3b96..3390601 100644 --- a/Statlib/EValues/Divergence.lean +++ b/Statlib/EValues/Divergence.lean @@ -6,6 +6,9 @@ Authors: Rémy Degenne, Gaëtan Serré module public import Statlib.EValues.Product +public import Statlib.EValues.RIPr +public import Statlib.Divergence.Chernoff +public import Statlib.Divergence.Renyi.Variational /-! # E-variable divergences @@ -16,9 +19,9 @@ the e-Rényi divergence of order `α` between `S` and `T` is `(1 - α)⁻¹ * ⨅ R, (α * maxUtility R S logUtility + (1 - α) * maxUtility R T logUtility)`, and the e-Chernoff divergence is `⨅ R, max (maxUtility R S logUtility) (maxUtility R T logUtility)`, where the infima are over probability measures `R`. For a probability measure `P`, -`maxUtility R {P} logUtility` is the Kullback-Leibler divergence of `R` from `P`, and for singletons -these formulas are the variational characterizations of the Rényi divergence and of the Chernoff -information. +`maxUtility R {P} logUtility` is the Kullback-Leibler divergence of `R` from `P` +(`maxUtility_singleton_eq_klDiv`), and for singletons these formulas are the variational +characterizations of the Rényi divergence and of the Chernoff information. They share the properties of the classical divergences: they satisfy a data processing inequality, the e-Rényi divergence is additive on products, and the e-Chernoff divergence is subadditive. @@ -36,6 +39,9 @@ the e-Rényi divergence is additive on products, and the e-Chernoff divergence i * `echernoffDiv_prod_le`: the e-Chernoff divergence between sets of product measures is at most the sum of the e-Chernoff divergences. * `one_sub_mul_erenyiDiv_le_echernoffDiv`: `(1 - α) * erenyiDiv α S T ≤ echernoffDiv S T`. +* `erenyiDiv_singleton`, `echernoffDiv_singleton`: for probability measures `P` and `Q`, + `erenyiDiv α {P} {Q} = renyiDiv α P Q` for `α ∈ (0, 1)` and + `echernoffDiv {P} {Q} = chernoffDiv 1 P Q`. * `erenyiDiv_eq_two_mul_echernoffDiv_of_involutive`: if `T` is the image of `S` by a measurable involution, the e-Rényi divergence of order `1/2` is twice the e-Chernoff divergence. @@ -141,6 +147,45 @@ lemma one_sub_mul_erenyiDiv_le_echernoffDiv : (1 - α) * erenyiDiv α S T ≤ ec exacts [le_max_left _ _, le_max_right _ _] _ = max a b := by rw [← add_mul, add_tsub_cancel_of_le hα.le, one_mul] +/-! ### Singletons + +For probability measures, `maxUtility R {P} logUtility = klDiv R P` +(`maxUtility_singleton_eq_klDiv`), so the e-divergences between singletons are the classical +divergences. -/ + +/-- For probability measures `P`, `Q` and `α ∈ (0, 1)`, the e-Rényi divergence between `{P}` and +`{Q}` is the Rényi divergence of order `α`. This is the variational formula +`(1 - α) * Rα(P, Q) = ⨅ R, (α * KL(R, P) + (1 - α) * KL(R, Q))` (`mul_renyiDiv_eq_iInf_klDiv`). -/ +theorem erenyiDiv_singleton (P Q : Measure 𝓧) [IsProbabilityMeasure P] [IsProbabilityMeasure Q] + (hα0 : 0 < α) (hα1 : α < 1) : + erenyiDiv α {P} {Q} = renyiDiv α.toReal P Q := by + obtain ⟨a, ha0, rfl⟩ : ∃ a : ℝ, 0 ≤ a ∧ α = ENNReal.ofReal a := + ⟨α.toReal, ENNReal.toReal_nonneg, (ENNReal.ofReal_toReal hα1.ne_top).symm⟩ + have ha1 : a < 1 := ENNReal.ofReal_lt_one.mp hα1 + have h1α : 1 - ENNReal.ofReal a = ENNReal.ofReal (1 - a) := by + rw [ENNReal.ofReal_sub _ ha0, ENNReal.ofReal_one] + have h_inf : ⨅ (R : Measure 𝓧) (_ : IsProbabilityMeasure R), + ENNReal.ofReal a * (maxUtility R {P} logUtility).toENNReal + + ENNReal.ofReal (1 - a) * (maxUtility R {Q} logUtility).toENNReal + = ENNReal.ofReal (1 - a) * renyiDiv a P Q := by + rw [mul_renyiDiv_eq_iInf_klDiv (ENNReal.ofReal_pos.mp hα0) ha1] + refine iInf_congr fun R ↦ iInf_congr fun _ ↦ ?_ + rw [maxUtility_singleton_eq_klDiv, maxUtility_singleton_eq_klDiv, EReal.toENNReal_coe, + EReal.toENNReal_coe] + rw [erenyiDiv, ENNReal.toReal_ofReal ha0, h1α, h_inf, + ENNReal.inv_mul_cancel_left (ENNReal.ofReal_pos.mpr (sub_pos.mpr ha1)).ne' + ENNReal.ofReal_ne_top] + +/-- For probability measures `P` and `Q`, the e-Chernoff divergence between `{P}` and `{Q}` is the +Chernoff information `chernoffDiv 1 P Q = ⨅ R, max (KL(R, P)) (KL(R, Q))`. -/ +theorem echernoffDiv_singleton (P Q : Measure 𝓧) [IsProbabilityMeasure P] + [IsProbabilityMeasure Q] : + echernoffDiv {P} {Q} = chernoffDiv 1 P Q := by + rw [echernoffDiv, chernoffDiv_one] + refine iInf_congr fun R ↦ iInf_congr fun _ ↦ ?_ + rw [maxUtility_singleton_eq_klDiv, maxUtility_singleton_eq_klDiv, EReal.toENNReal_coe, + EReal.toENNReal_coe] + /-! ### Data processing inequalities -/ /-- Data processing inequality for the e-Rényi divergence with a Markov kernel. -/ diff --git a/Statlib/EValues/LowerBound.lean b/Statlib/EValues/LowerBound.lean index ca3418a..aca5c7a 100644 --- a/Statlib/EValues/LowerBound.lean +++ b/Statlib/EValues/LowerBound.lean @@ -33,11 +33,12 @@ and neither map can increase the divergences (data processing inequality). and the e-Chernoff divergence between the probability measures on the unit interval with mean at most `δ` and those with mean at least `η` are the Rényi divergence of order `α` and the Chernoff information between the Bernoulli distributions with parameters `δ` and `η`. -* `le_erenyiDiv_of_separated`, `le_echernoffDiv_of_separated`: the corresponding explicit lower - bounds on the divergences between sets of probability measures for which the mean of a function - with values in the unit interval is at most `δ` and at least `η`. For `η = 1 - δ` and order - `1/2`, the values are given by `erenyiDiv_inv_two_bernoulli_one_sub` and - `echernoffDiv_bernoulli_one_sub`. +* `le_erenyiDiv_of_separated`, `le_echernoffDiv_of_separated`: the corresponding lower bounds on + the divergences between sets of probability measures for which the mean of a function with values + in the unit interval is at most `δ` and at least `η`. The values of the Rényi divergence and of + the Chernoff information between Bernoulli distributions are given by + `renyiDiv_bernoulliMeasure` and `chernoffDiv_one_bernoulliMeasure`; for `η = 1 - δ` and order + `1/2`, by `erenyiDiv_inv_two_bernoulli_one_sub` and `echernoffDiv_bernoulli_one_sub`. -/ @[expose] public section @@ -144,28 +145,27 @@ theorem echernoffDiv_bernoulli_le_of_integral_mem {f : 𝓧 → I} (hf : Measura /-! ### Closed forms and lower bounds -/ -/-- For `δ ≤ η`, the e-Rényi divergence of order `α < 1` between the probability measures on the -unit interval with mean at most `δ` and those with mean at least `η` is the Rényi divergence of -order `α` between the Bernoulli distributions with parameters `δ` and `η`. -/ -theorem erenyiDiv_bounded (hα : α < 1) {δ η : ℝ} (hδ_pos : 0 < δ) (hδη : δ ≤ η) (hη : η < 1) : +/-- For `0 < δ ≤ η < 1`, the e-Rényi divergence of order `α < 1` between the probability measures +on the unit interval with mean at most `δ` and those with mean at least `η` is the Rényi divergence +of order `α` between the Bernoulli distributions with parameters `δ` and `η`, whose value is given +by `renyiDiv_bernoulliMeasure`. -/ +theorem erenyiDiv_bounded (hα : α < 1) {δ η : I} (hδ_pos : 0 < δ) (hδη : δ ≤ η) (hη : η < 1) : erenyiDiv α {μ : Measure I | IsProbabilityMeasure μ ∧ ∫ x, (x : ℝ) ∂μ ≤ δ} - {μ : Measure I | IsProbabilityMeasure μ ∧ η ≤ ∫ x, (x : ℝ) ∂μ} - = ENNReal.ofReal ((α.toReal - 1)⁻¹ * Real.log (δ ^ α.toReal * η ^ (1 - α.toReal) - + (1 - δ) ^ α.toReal * (1 - η) ^ (1 - α.toReal))) := + {μ : Measure I | IsProbabilityMeasure μ ∧ (η : ℝ) ≤ ∫ x, (x : ℝ) ∂μ} + = renyiDiv α.toReal Ber(true, false, δ) Ber(true, false, η) := (erenyiDiv_integral_mem_eq_erenyiDiv_bernoulli (Set.Iic δ) (Set.Ici η)).trans (erenyiDiv_bernoulli hα hδ_pos hδη hη) -/-- For `δ < η`, the e-Chernoff divergence between the probability measures on the unit interval -with mean at most `δ` and those with mean at least `η` is the Chernoff information between the -Bernoulli distributions with parameters `δ` and `η`, `klBerReal r δ` for the `r` given by -`echernoffDiv_bernoulli`. -/ -theorem echernoffDiv_bounded {δ η : ℝ} (hδ_pos : 0 < δ) (hδη : δ < η) (hη : η < 1) {r : ℝ} - (hr : r = Real.log ((1 - δ) / (1 - η)) / (Real.log (η / δ) + Real.log ((1 - δ) / (1 - η)))) : +/-- For `0 < δ < η < 1`, the e-Chernoff divergence between the probability measures on the unit +interval with mean at most `δ` and those with mean at least `η` is the Chernoff information between +the Bernoulli distributions with parameters `δ` and `η`, whose value is given by +`chernoffDiv_one_bernoulliMeasure`. -/ +theorem echernoffDiv_bounded {δ η : I} (hδ_pos : 0 < δ) (hδη : δ < η) (hη : η < 1) : echernoffDiv {μ : Measure I | IsProbabilityMeasure μ ∧ ∫ x, (x : ℝ) ∂μ ≤ δ} - {μ : Measure I | IsProbabilityMeasure μ ∧ η ≤ ∫ x, (x : ℝ) ∂μ} - = ENNReal.ofReal (klBerReal r δ) := + {μ : Measure I | IsProbabilityMeasure μ ∧ (η : ℝ) ≤ ∫ x, (x : ℝ) ∂μ} + = chernoffDiv 1 Ber(true, false, δ) Ber(true, false, η) := (echernoffDiv_integral_mem_eq_echernoffDiv_bernoulli (Set.Iic δ) (Set.Ici η)).trans - (echernoffDiv_bernoulli hδ_pos hδη hη hr) + (echernoffDiv_bernoulli hδ_pos hδη hη) /-- If the mean of a measurable `f : 𝓧 → I` is at most `δ` under the probability measures of `S` and at least `η ≥ δ` under those of `T`, the e-Rényi divergence of order `α < 1` between `S` and @@ -173,25 +173,21 @@ and at least `η ≥ δ` under those of `T`, the e-Rényi divergence of order ` parameters `δ` and `η`. -/ theorem le_erenyiDiv_of_separated {f : 𝓧 → I} (hf : Measurable f) (hS : ∀ μ ∈ S, IsProbabilityMeasure μ) (hT : ∀ μ ∈ T, IsProbabilityMeasure μ) (hα : α < 1) - {δ η : ℝ} (hδ_pos : 0 < δ) (hδη : δ ≤ η) (hη : η < 1) - (hSf : ∀ μ ∈ S, ∫ ω, (f ω : ℝ) ∂μ ≤ δ) (hTf : ∀ ν ∈ T, η ≤ ∫ ω, (f ω : ℝ) ∂ν) : - ENNReal.ofReal ((α.toReal - 1)⁻¹ * Real.log (δ ^ α.toReal * η ^ (1 - α.toReal) - + (1 - δ) ^ α.toReal * (1 - η) ^ (1 - α.toReal))) - ≤ erenyiDiv α S T := + {δ η : I} (hδ_pos : 0 < δ) (hδη : δ ≤ η) (hη : η < 1) + (hSf : ∀ μ ∈ S, ∫ ω, (f ω : ℝ) ∂μ ≤ δ) (hTf : ∀ ν ∈ T, (η : ℝ) ≤ ∫ ω, (f ω : ℝ) ∂ν) : + renyiDiv α.toReal Ber(true, false, δ) Ber(true, false, η) ≤ erenyiDiv α S T := (erenyiDiv_bernoulli hα hδ_pos hδη hη).symm.le.trans (erenyiDiv_bernoulli_le_of_integral_mem hf hS hT (C₁ := Set.Iic δ) (C₂ := Set.Ici η) hSf hTf) /-- If the mean of a measurable `f : 𝓧 → I` is at most `δ` under the probability measures of `S` and at least `η > δ` under those of `T`, the e-Chernoff divergence between `S` and `T` is at least -the Chernoff information between the Bernoulli distributions with parameters `δ` and `η`, -`klBerReal r δ` for the `r` given by `echernoffDiv_bernoulli`. -/ +the Chernoff information between the Bernoulli distributions with parameters `δ` and `η`. -/ theorem le_echernoffDiv_of_separated {f : 𝓧 → I} (hf : Measurable f) (hS : ∀ μ ∈ S, IsProbabilityMeasure μ) (hT : ∀ μ ∈ T, IsProbabilityMeasure μ) - {δ η : ℝ} (hδ_pos : 0 < δ) (hδη : δ < η) (hη : η < 1) {r : ℝ} - (hr : r = Real.log ((1 - δ) / (1 - η)) / (Real.log (η / δ) + Real.log ((1 - δ) / (1 - η)))) - (hSf : ∀ μ ∈ S, ∫ ω, (f ω : ℝ) ∂μ ≤ δ) (hTf : ∀ ν ∈ T, η ≤ ∫ ω, (f ω : ℝ) ∂ν) : - ENNReal.ofReal (klBerReal r δ) ≤ echernoffDiv S T := - (echernoffDiv_bernoulli hδ_pos hδη hη hr).symm.le.trans + {δ η : I} (hδ_pos : 0 < δ) (hδη : δ < η) (hη : η < 1) + (hSf : ∀ μ ∈ S, ∫ ω, (f ω : ℝ) ∂μ ≤ δ) (hTf : ∀ ν ∈ T, (η : ℝ) ≤ ∫ ω, (f ω : ℝ) ∂ν) : + chernoffDiv 1 Ber(true, false, δ) Ber(true, false, η) ≤ echernoffDiv S T := + (echernoffDiv_bernoulli hδ_pos hδη hη).symm.le.trans (echernoffDiv_bernoulli_le_of_integral_mem hf hS hT (C₁ := Set.Iic δ) (C₂ := Set.Ici η) hSf hTf) diff --git a/Statlib/EValues/RIPr.lean b/Statlib/EValues/RIPr.lean index 2673b36..1179ea0 100644 --- a/Statlib/EValues/RIPr.lean +++ b/Statlib/EValues/RIPr.lean @@ -12,6 +12,7 @@ public import Mathlib.Probability.Notation public import Statlib.EValues.NumeraireExistence public import Statlib.ForMathlib.MeasureTheory.Integral.EReal.Bochner public import Statlib.ForMathlib.MeasureTheory.Measure.LogLikelihoodRatio +public import Statlib.ForMathlib.InformationTheory.KullbackLeibler.EIntegral /-! # Reverse information projection and duality @@ -40,6 +41,8 @@ over the effective set. * `maxUtility_eq_iInf_klIntegral_effectiveSet`: `maxUtility P S logUtility = ⨅ μ ∈ effectiveSet S, klIntegral P μ`. This is the duality between maximal logarithmic utility and minimal Kullback-Leibler divergence. +* `maxUtility_singleton_eq_klDiv`: for probability measures, + `maxUtility P {Q} logUtility = klDiv P Q`. ## References @@ -325,4 +328,51 @@ lemma maxUtility_eq_iInf_klIntegral_effectiveSet [IsProbabilityMeasure P] ((iInf₂_le (ripr P S) (ripr_mem_effectiveSet P hS)).trans_eq (maxUtility_eq_klIntegral_ripr hS).symm) +/-- For probability measures, the maximal logarithmic utility of the e-variables for `{Q}` under +`P` is the Kullback-Leibler divergence `klDiv P Q`. `Q` belongs to the effective set of `{Q}`, which +gives the upper bound by duality. If `P ≪ Q`, the likelihood ratio `∂P/∂Q` is an e-variable +attaining it; otherwise an e-variable equal to `∞` on a `Q`-null set charged by `P` has infinite +expected logarithm. -/ +theorem maxUtility_singleton_eq_klDiv (P Q : Measure 𝓧) [IsProbabilityMeasure P] + [IsProbabilityMeasure Q] : + maxUtility P {Q} logUtility = klDiv P Q := by + have hQ : ∀ μ ∈ ({Q} : Set (Measure 𝓧)), IsProbabilityMeasure μ := by + rintro μ rfl + infer_instance + refine le_antisymm ?_ ?_ + · rw [← klIntegral_eq_klDiv (by simp)] + refine maxUtility_le_klIntegral_of_mem_effectiveSet + (fun μ hμ ↦ have := hQ μ hμ; inferInstance) fun X hX ↦ ?_ + simpa using hX.lintegral_le_measure_univ Q rfl + by_cases h_ac : P ≪ Q + · -- the likelihood ratio `∂P/∂Q` is an e-variable for `{Q}` + have hX : IsEVar (P.rnDeriv Q) {Q} := .of_lintegral_le_one hQ (by fun_prop) fun μ hμ ↦ by + obtain rfl : μ = Q := hμ + exact Measure.lintegral_rnDeriv_le.trans_eq measure_univ + refine le_of_eq_of_le ?_ (hX.eintegral_le_maxUtility P logUtility) + rw [coe_klDiv_eq_eintegral_llr_of_measure_eq h_ac (by simp)] + refine eintegral_congr_ae ?_ + filter_upwards [Measure.rnDeriv_pos h_ac, h_ac.ae_le (Measure.rnDeriv_lt_top P Q)] + with x h_pos h_lt_top + rw [Function.comp_apply, logUtility_apply, ENNReal.log_pos_real h_pos.ne' h_lt_top.ne, llr] + -- an e-variable equal to `∞` on a `Q`-null set charged by `P`, and to `1` elsewhere + obtain ⟨s, hs, hQs, hPs⟩ : ∃ s, MeasurableSet s ∧ Q s = 0 ∧ P s ≠ 0 := by + by_contra! h + exact h_ac (Measure.AbsolutelyContinuous.mk fun s hs hQs ↦ h s hs hQs) + classical + have hX : IsEVar (fun x ↦ if x ∈ s then ∞ else 1) {Q} := + .of_lintegral_le_one hQ (Measurable.ite hs measurable_const measurable_const) fun μ hμ ↦ by + obtain rfl : μ = Q := hμ + rw [lintegral_congr_ae (g := fun _ ↦ 1)] + · simp + filter_upwards [measure_eq_zero_iff_ae_notMem.mp hQs] with x hx + simp [hx] + rw [klDiv_of_not_ac h_ac, EReal.coe_ennreal_top] + refine le_of_eq_of_le ?_ (hX.eintegral_le_maxUtility P logUtility) + rw [eintegral_eq_lintegral_of_nonneg fun x ↦ by + by_cases hx : x ∈ s <;> simp [hx, logUtility_apply]] + rw [lintegral_congr (g := s.indicator fun _ ↦ ∞) fun x ↦ by + by_cases hx : x ∈ s <;> simp [hx, logUtility_apply], lintegral_indicator_const hs, + ENNReal.top_mul hPs, EReal.coe_ennreal_top] + end ProbabilityTheory diff --git a/Statlib/ForMathlib/Analysis/Calculus/LocalExtr/Basic.lean b/Statlib/ForMathlib/Analysis/Calculus/LocalExtr/Basic.lean new file mode 100644 index 0000000..5380b66 --- /dev/null +++ b/Statlib/ForMathlib/Analysis/Calculus/LocalExtr/Basic.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.Analysis.Calculus.Deriv.Slope +public import Mathlib.Topology.Order.LocalExtr + +/-! +# One-sided derivatives at a local minimum + +At a local minimum `x` of `f : ℝ → ℝ`, the right derivative `derivWithin f (Ioi x) x` is +nonnegative and the left derivative `derivWithin f (Iio x) x` is nonpositive. No differentiability +is assumed: if `f` is not differentiable on the corresponding side, the derivative is `0`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds), where these results were stated for convex +functions. +-/ + +@[expose] public section + +open Filter Set Topology + +variable {f : ℝ → ℝ} {x : ℝ} + +/-- At a local minimum, the right derivative is nonnegative. -/ +lemma IsLocalMin.rightDeriv_nonneg (h : IsLocalMin f x) : 0 ≤ derivWithin f (Ioi x) x := by + by_cases hd : DifferentiableWithinAt ℝ f (Ioi x) x + · refine ge_of_tendsto ((hasDerivWithinAt_iff_tendsto_slope' self_notMem_Ioi).mp + hd.hasDerivWithinAt) ?_ + filter_upwards [self_mem_nhdsWithin, nhdsWithin_le_nhds h] with y (hy : x < y) hfy + rw [slope_def_field] + exact div_nonneg (sub_nonneg.mpr hfy) (sub_pos.mpr hy).le + · rw [derivWithin_zero_of_not_differentiableWithinAt hd] + +/-- At a local minimum, the left derivative is nonpositive. -/ +lemma IsLocalMin.leftDeriv_nonpos (h : IsLocalMin f x) : derivWithin f (Iio x) x ≤ 0 := by + by_cases hd : DifferentiableWithinAt ℝ f (Iio x) x + · refine le_of_tendsto ((hasDerivWithinAt_iff_tendsto_slope' self_notMem_Iio).mp + hd.hasDerivWithinAt) ?_ + filter_upwards [self_mem_nhdsWithin, nhdsWithin_le_nhds h] with y (hy : y < x) hfy + rw [slope_def_field] + exact div_nonpos_of_nonneg_of_nonpos (sub_nonneg.mpr hfy) (sub_neg.mpr hy).le + · rw [derivWithin_zero_of_not_differentiableWithinAt hd] diff --git a/Statlib/ForMathlib/Analysis/Convex/DerivAtTop.lean b/Statlib/ForMathlib/Analysis/Convex/DerivAtTop.lean new file mode 100644 index 0000000..cadf7d0 --- /dev/null +++ b/Statlib/ForMathlib/Analysis/Convex/DerivAtTop.lean @@ -0,0 +1,186 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.Topology.Instances.EReal.Lemmas +public import Statlib.ForMathlib.Convex +public import Statlib.ForMathlib.Topology.Order.MonotoneConvergence + +/-! +# Slope at infinity of a real function + +## Main definitions + +* `derivAtTop f`: the limit at `+∞` of `f x / x`, for `f : ℝ → ℝ`, as an `EReal`. It is defined as a + `limsup`, so that it is always defined. + +## Main statements + +* `ConvexOn.tendsto_derivAtTop`: for a function convex on `(a, ∞)`, `f x / x` tends to + `derivAtTop f`. +* `ConvexOn.tendsto_rightDeriv_derivAtTop`: for such a function, the right derivative + `derivWithin f (Ioi x) x` also tends to `derivAtTop f`. This is how `derivAtTop` is computed in + practice (`ConvexOn.derivAtTop_eq_of_tendsto_rightDeriv`, + `ConvexOn.derivAtTop_eq_top_of_tendsto_rightDeriv`). +* `ConvexOn.le_add_derivAtTop`: for a function convex on `[0, ∞)` and `0 ≤ y ≤ x`, + `f x ≤ f y + derivAtTop f * (x - y)`. +* `derivAtTop_add`: additivity on convex functions. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds), where `derivAtTop f` was defined as the limit +of the right derivative. +-/ + +@[expose] public section + +open Filter Set Topology + +variable {f g : ℝ → ℝ} {x y : ℝ} + +/-- The slope at infinity of `f : ℝ → ℝ`: the limit of `f x / x` at `+∞`, as an `EReal`. It is +defined as a `limsup`, so that it is always defined. For a function convex on `(0, ∞)` the limit +exists (`ConvexOn.tendsto_derivAtTop`), and it is also the limit of the right derivative of `f` +(`ConvexOn.tendsto_rightDeriv_derivAtTop`). -/ +noncomputable +def derivAtTop (f : ℝ → ℝ) : EReal := limsup (fun x ↦ ((f x / x : ℝ) : EReal)) atTop + +lemma derivAtTop_congr (h : f =ᶠ[atTop] g) : derivAtTop f = derivAtTop g := + limsup_congr (h.mono fun x hx ↦ by rw [hx]) + +lemma derivAtTop_of_tendsto {y : EReal} + (h : Tendsto (fun x ↦ ((f x / x : ℝ) : EReal)) atTop (𝓝 y)) : + derivAtTop f = y := + h.limsup_eq + +@[simp] +lemma derivAtTop_const (c : ℝ) : derivAtTop (fun _ ↦ c) = 0 := by + refine derivAtTop_of_tendsto ?_ + rw [← EReal.coe_zero] + exact (continuous_coe_real_ereal.tendsto 0).comp (tendsto_const_nhds.div_atTop tendsto_id) + +@[simp] +lemma derivAtTop_zero : derivAtTop 0 = 0 := derivAtTop_const 0 + +/-- The slope at infinity of the affine function `x ↦ a * x + b` is `a`. -/ +@[simp] +lemma derivAtTop_mul_add (a b : ℝ) : derivAtTop (fun x ↦ a * x + b) = a := by + refine derivAtTop_of_tendsto (EReal.tendsto_coe.mpr ?_) + have h : Tendsto (fun x : ℝ ↦ a + b / x) atTop (𝓝 (a + 0)) := + tendsto_const_nhds.add (tendsto_const_nhds.div_atTop tendsto_id) + rw [add_zero] at h + refine h.congr' ?_ + filter_upwards [eventually_ne_atTop 0] with x hx + rw [add_div, mul_div_cancel_right₀ _ hx] + +namespace ConvexOn + +variable {a : ℝ} + +/-- For a function convex on `(a, ∞)`, `f x / x` and the right derivative of `f` tend to the same +limit at infinity. -/ +private lemma exists_tendsto_div_and_rightDeriv (hf : ConvexOn ℝ (Ioi a) f) : + ∃ D : EReal, Tendsto (fun x ↦ ((f x / x : ℝ) : EReal)) atTop (𝓝 D) + ∧ Tendsto (fun x ↦ ((derivWithin f (Ioi x) x : ℝ) : EReal)) atTop (𝓝 D) := by + have h_mem {x : ℝ} (hx : a < x) : x ∈ interior (Ioi a) := by simpa using hx + have h_mono : MonotoneOn (fun x ↦ ((derivWithin f (Ioi x) x : ℝ) : EReal)) (Ioi a) := + EReal.coe_strictMono.monotone.comp_monotoneOn (by simpa using hf.monotoneOn_rightDeriv) + -- a base point `b > max a 0` + set b := max a 0 + 1 with hb_def + have hab : a < b := by rw [hb_def]; linarith [le_max_left a 0] + have hb0 : 0 < b := by rw [hb_def]; linarith [le_max_right a 0] + obtain ⟨D, hD⟩ := (h_mono.mono (Ici_subset_Ioi.mpr hab)).exists_tendsto_atTop + have h_le {x : ℝ} (hx : a < x) : ((derivWithin f (Ioi x) x : ℝ) : EReal) ≤ D := + ge_of_tendsto hD ((eventually_ge_atTop x).mono fun y hy ↦ h_mono hx (hx.trans_le hy) hy) + refine ⟨D, tendsto_order.2 ⟨fun c hc ↦ ?_, fun c hc ↦ ?_⟩, hD⟩ + · -- lower bound, from the tangent line at a point `x₀` where the right derivative exceeds `c` + obtain ⟨x₀, hx₀, hcx₀⟩ := ((eventually_gt_atTop b).and ((tendsto_order.1 hD).1 c hc)).exists + set d := derivWithin f (Ioi x₀) x₀ + have h_lim : Tendsto (fun y ↦ (((f x₀ - d * x₀) / y + d : ℝ) : EReal)) atTop (𝓝 d) := + (continuous_coe_real_ereal.tendsto d).comp (by + simpa using (tendsto_const_nhds.div_atTop tendsto_id).add_const d) + filter_upwards [(tendsto_order.1 h_lim).1 c hcx₀, eventually_gt_atTop x₀] with y hy hyx₀ + refine hy.trans_le (EReal.coe_le_coe_iff.mpr ?_) + have hy0 : 0 < y := hb0.trans (hx₀.trans hyx₀) + have h_tangent := hf.add_rightDeriv_mul_le (mem_Ioi.mpr ((hab.trans hx₀).trans hyx₀)) + (h_mem (hab.trans hx₀)) + rw [div_add' _ _ _ hy0.ne', div_le_div_iff_of_pos_right hy0] + linarith + · -- upper bound: for `y > b`, `f y ≤ f b + D * (y - b)` since the slope from `b` is at most `D` + have hD_bot : D ≠ ⊥ := ne_bot_of_le_ne_bot (EReal.coe_ne_bot _) (h_le hab) + lift D to ℝ using ⟨hc.ne_top, hD_bot⟩ + have h_lim : Tendsto (fun y ↦ (((f b - D * b) / y + D : ℝ) : EReal)) atTop (𝓝 D) := + (continuous_coe_real_ereal.tendsto D).comp (by + simpa using (tendsto_const_nhds.div_atTop tendsto_id).add_const D) + filter_upwards [(tendsto_order.1 h_lim).2 c hc, eventually_gt_atTop b] with y hy hyb + refine lt_of_le_of_lt (EReal.coe_le_coe_iff.mpr ?_) hy + have hy0 : 0 < y := hb0.trans hyb + have hay : a < y := hab.trans hyb + have h_slope : slope f b y ≤ D := by + refine (hf.slope_le_leftDeriv_of_mem_interior (mem_Ioi.mpr hab) (h_mem hay) hyb).trans ?_ + refine (hf.leftDeriv_le_rightDeriv_of_mem_interior (h_mem hay)).trans ?_ + exact EReal.coe_le_coe_iff.mp (h_le hay) + rw [slope_def_field, div_le_iff₀ (sub_pos.mpr hyb)] at h_slope + rw [div_add' _ _ _ hy0.ne', div_le_div_iff_of_pos_right hy0] + linarith + +/-- For a function convex on `(a, ∞)`, `f x / x` tends to `derivAtTop f`. -/ +lemma tendsto_derivAtTop (hf : ConvexOn ℝ (Ioi a) f) : + Tendsto (fun x ↦ ((f x / x : ℝ) : EReal)) atTop (𝓝 (derivAtTop f)) := by + obtain ⟨D, hD, -⟩ := hf.exists_tendsto_div_and_rightDeriv + rwa [derivAtTop_of_tendsto hD] + +/-- For a function convex on `(a, ∞)`, the right derivative tends to `derivAtTop f`. -/ +lemma tendsto_rightDeriv_derivAtTop (hf : ConvexOn ℝ (Ioi a) f) : + Tendsto (fun x ↦ ((derivWithin f (Ioi x) x : ℝ) : EReal)) atTop (𝓝 (derivAtTop f)) := by + obtain ⟨D, hD, hD'⟩ := hf.exists_tendsto_div_and_rightDeriv + rwa [derivAtTop_of_tendsto hD] + +lemma rightDeriv_le_derivAtTop (hf : ConvexOn ℝ (Ioi a) f) (hx : a < x) : + ((derivWithin f (Ioi x) x : ℝ) : EReal) ≤ derivAtTop f := by + have h_mono : MonotoneOn (fun x ↦ derivWithin f (Ioi x) x) (Ioi a) := by + simpa using hf.monotoneOn_rightDeriv + exact ge_of_tendsto hf.tendsto_rightDeriv_derivAtTop ((eventually_ge_atTop x).mono fun y hy ↦ + EReal.coe_le_coe_iff.mpr (h_mono hx (hx.trans_le hy) hy)) + +lemma derivAtTop_ne_bot (hf : ConvexOn ℝ (Ioi a) f) : derivAtTop f ≠ ⊥ := + ne_bot_of_le_ne_bot (EReal.coe_ne_bot _) (hf.rightDeriv_le_derivAtTop (lt_add_one a)) + +lemma derivAtTop_eq_of_tendsto_rightDeriv (hf : ConvexOn ℝ (Ioi a) f) {y : ℝ} + (h : Tendsto (fun x ↦ derivWithin f (Ioi x) x) atTop (𝓝 y)) : + derivAtTop f = y := + tendsto_nhds_unique hf.tendsto_rightDeriv_derivAtTop + ((continuous_coe_real_ereal.tendsto y).comp h) + +lemma derivAtTop_eq_top_of_tendsto_rightDeriv (hf : ConvexOn ℝ (Ioi a) f) + (h : Tendsto (fun x ↦ derivWithin f (Ioi x) x) atTop atTop) : + derivAtTop f = ⊤ := + tendsto_nhds_unique hf.tendsto_rightDeriv_derivAtTop (EReal.tendsto_coe_atTop.comp h) + +/-- A function convex on `[0, ∞)` grows at most linearly, with slope `derivAtTop f`. -/ +lemma le_add_derivAtTop (hf : ConvexOn ℝ (Ici 0) f) (h : derivAtTop f ≠ ⊤) (hy : 0 ≤ y) + (hyx : y ≤ x) : + f x ≤ f y + (derivAtTop f).toReal * (x - y) := by + rcases hyx.eq_or_lt with rfl | hyx + · simp + have hf' : ConvexOn ℝ (Ioi 0) f := hf.subset Ioi_subset_Ici_self (convex_Ioi 0) + have hx : x ∈ interior (Ici (0 : ℝ)) := by simpa using hy.trans_lt hyx + have h_slope : slope f y x ≤ (derivAtTop f).toReal := by + refine (hf.slope_le_leftDeriv_of_mem_interior hy hx hyx).trans ?_ + refine (hf.leftDeriv_le_rightDeriv_of_mem_interior hx).trans ?_ + rw [← EReal.coe_le_coe_iff, EReal.coe_toReal h hf'.derivAtTop_ne_bot] + exact hf'.rightDeriv_le_derivAtTop (hy.trans_lt hyx) + rw [slope_def_field, div_le_iff₀ (sub_pos.mpr hyx)] at h_slope + linarith + +end ConvexOn + +lemma derivAtTop_add (hf : ConvexOn ℝ (Ioi 0) f) (hg : ConvexOn ℝ (Ioi 0) g) : + derivAtTop (fun x ↦ f x + g x) = derivAtTop f + derivAtTop g := by + refine derivAtTop_of_tendsto ?_ + have h_cont : ContinuousAt (fun p : EReal × EReal ↦ p.1 + p.2) (derivAtTop f, derivAtTop g) := + EReal.continuousAt_add (Or.inr hg.derivAtTop_ne_bot) (Or.inl hf.derivAtTop_ne_bot) + exact (h_cont.tendsto.comp (hf.tendsto_derivAtTop.prodMk_nhds hg.tendsto_derivAtTop)).congr + fun x ↦ by simp [add_div] diff --git a/Statlib/ForMathlib/Convex.lean b/Statlib/ForMathlib/Convex.lean index 057ce7c..869df2f 100644 --- a/Statlib/ForMathlib/Convex.lean +++ b/Statlib/ForMathlib/Convex.lean @@ -50,6 +50,120 @@ lemma ConvexOn.add_deriv_mul_le {S : Set ℝ} {f : ℝ → ℝ} {x y : ℝ} field_simp at h_cvx linarith +/-- If `f` is convex on `(0, ∞)` with `f 1 = 0`, then `max f 0` is nonincreasing on `(0, 1]`. -/ +lemma ConvexOn.antitoneOn_ofReal_comp {f : ℝ → ℝ} (hf : ConvexOn ℝ (Ioi 0) f) (hf_one : f 1 = 0) : + AntitoneOn (fun x ↦ ENNReal.ofReal (f x)) (Ioc 0 1) := by + intro x hx y hy hxy + rcases eq_or_lt_of_le hy.2 with rfl | hy1 + · simp [hf_one] + by_cases hfy : f y ≤ 0 + · simp [ENNReal.ofReal_of_nonpos hfy] + refine ENNReal.ofReal_le_ofReal ?_ + refine hf.le_left_of_right_le'' hx.1 (mem_Ioi.mpr one_pos) hxy hy1 ?_ + rw [hf_one] + exact (not_le.mp hfy).le + +/-- If `f` is convex on `(0, ∞)` with `f 1 = 0`, then `max f 0` is nondecreasing on `[1, ∞)`. -/ +lemma ConvexOn.monotoneOn_ofReal_comp {f : ℝ → ℝ} (hf : ConvexOn ℝ (Ioi 0) f) (hf_one : f 1 = 0) : + MonotoneOn (fun x ↦ ENNReal.ofReal (f x)) (Ici 1) := by + intro x hx y _ hxy + rcases eq_or_lt_of_le (mem_Ici.mp hx) with rfl | hx1 + · simp [hf_one] + by_cases hfx : f x ≤ 0 + · simp [ENNReal.ofReal_of_nonpos hfx] + refine ENNReal.ofReal_le_ofReal ?_ + refine hf.le_right_of_left_le'' (mem_Ioi.mpr one_pos) + (mem_Ioi.mpr (zero_lt_one.trans (hx1.trans_le hxy))) hx1 hxy ?_ + rw [hf_one] + exact (not_le.mp hfx).le + +/-- A convex function lies above its tangent line with slope the right derivative, at any interior +point of its domain. -/ +lemma ConvexOn.add_rightDeriv_mul_le {S : Set ℝ} {f : ℝ → ℝ} {x y : ℝ} + (hfc : ConvexOn ℝ S f) (hx : x ∈ S) (hy : y ∈ interior S) : + f y + derivWithin f (Ioi y) y * (x - y) ≤ f x := by + rcases lt_trichotomy x y with hxy | rfl | hyx + · have h := (hfc.slope_le_leftDeriv_of_mem_interior hx hy hxy).trans + (hfc.leftDeriv_le_rightDeriv_of_mem_interior hy) + rw [slope_def_field, div_le_iff₀ (sub_pos.mpr hxy)] at h + linarith + · simp + · have h := hfc.rightDeriv_le_slope_of_mem_interior hy hx hyx + rw [slope_def_field, le_div_iff₀ (sub_pos.mpr hyx)] at h + linarith + +/-- The right derivative of a convex function is right-continuous at the interior points of its +domain. This is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). -/ +lemma ConvexOn.continuousWithinAt_rightDeriv_of_mem_interior {S : Set ℝ} {f : ℝ → ℝ} {w : ℝ} + (hfc : ConvexOn ℝ S f) (hw : w ∈ interior S) : + ContinuousWithinAt (fun x ↦ derivWithin f (Ioi x) x) (Ici w) w := by + set r := fun x ↦ derivWithin f (Ioi x) x with hr + have h_mono : MonotoneOn r (interior S) := hfc.monotoneOn_rightDeriv + rw [← continuousWithinAt_Ioi_iff_Ici, ContinuousWithinAt] + obtain ⟨a, b, hwab, habs⟩ := + mem_nhds_iff_exists_Ioo_subset.mp (mem_interior_iff_mem_nhds.mp hw) + have h_int : Ioo a b ⊆ interior S := isOpen_Ioo.subset_interior_iff.mpr habs + have h_mem : ∀ z ∈ Ioo w b, z ∈ interior S := fun z hz ↦ h_int ⟨hwab.1.trans hz.1, hz.2⟩ + have h_bdd : BddBelow (r '' Ioo w b) := by + refine ⟨r w, ?_⟩ + rintro _ ⟨z, hz, rfl⟩ + exact h_mono hw (h_mem z hz) hz.1.le + -- `r` is monotone, so it tends to the infimum of its values on `(w, b)`, which is `r w` + have h_lim := (h_mono.mono h_mem).tendsto_nhdsWithin_Ioo_right (nonempty_Ioo.mpr hwab.2) h_bdd + convert h_lim + refine le_antisymm (le_csInf ((nonempty_Ioo.mpr hwab.2).image _) ?_) ?_ + · rintro _ ⟨z, hz, rfl⟩ + exact h_mono hw (h_mem z hz) hz.1.le + · -- the infimum is below every slope `slope f w y`, hence below `r w` + rw [hr] + beta_reduce + rw [hfc.rightDeriv_eq_sInf_slope_of_mem_interior hw] + refine le_csInf ?_ ?_ + · obtain ⟨z, hwz, hzb⟩ := exists_between hwab.2 + exact ⟨_, z, ⟨habs ⟨hwab.1.trans hwz, hzb⟩, hwz⟩, rfl⟩ + rintro _ ⟨y, ⟨hys, hwy⟩, rfl⟩ + have h_cont : ContinuousWithinAt f (Ioi w) w := + (hfc.differentiableWithinAt_Ioi_of_mem_interior hw).continuousWithinAt + have slope_lim : Filter.Tendsto (slope f y) (nhdsWithin w (Ioi w)) (nhds (slope f y w)) := + ((continuousWithinAt_id.sub continuousWithinAt_const).inv₀ (sub_ne_zero.2 hwy.ne)).smul + (h_cont.sub continuousWithinAt_const) |>.tendsto + rw [slope_comm] at slope_lim + refine le_of_tendsto_of_tendsto tendsto_const_nhds slope_lim ?_ + filter_upwards [Ioo_mem_nhdsGT (lt_min hwy hwab.2)] with z hz + have hz' : z ∈ Ioo w b := ⟨hz.1, hz.2.trans_le (min_le_right _ _)⟩ + calc sInf (r '' Ioo w b) ≤ r z := csInf_le h_bdd ⟨z, hz', rfl⟩ + _ ≤ slope f z y := hfc.rightDeriv_le_slope_of_mem_interior (h_mem z hz') hys + (hz.2.trans_le (min_le_left _ _)) + _ = slope f y z := slope_comm _ _ _ + +/-- A convex subset of `ℝ` with empty interior has at most one point. -/ +lemma Convex.subsingleton_of_interior_eq_empty {S : Set ℝ} (hS : Convex ℝ S) + (h : interior S = ∅) : + S.Subsingleton := by + intro x hx y hy + by_contra h_ne + wlog h_lt : x < y generalizing x y + · exact this hy hx (Ne.symm h_ne) ((not_lt.mp h_lt).lt_of_ne (Ne.symm h_ne)) + have h_sub : Ioo x y ⊆ interior S := by + rw [← interior_Icc] + exact interior_mono (hS.ordConnected.out hx hy) + rw [h, subset_empty_iff, Ioo_eq_empty_iff] at h_sub + exact h_sub h_lt + +/-- A convex function on a subset of `ℝ` is bounded below on it by an affine function. -/ +lemma ConvexOn.exists_affine_le {S : Set ℝ} {f : ℝ → ℝ} (hf : ConvexOn ℝ S f) : + ∃ c c', ∀ x ∈ S, c * x + c' ≤ f x := by + rcases (interior S).eq_empty_or_nonempty with h | ⟨y, hy⟩ + · rcases S.eq_empty_or_nonempty with rfl | ⟨y, hy⟩ + · simp + refine ⟨0, f y, fun x hx ↦ ?_⟩ + simp [hf.1.subsingleton_of_interior_eq_empty h hx hy] + · refine ⟨derivWithin f (Ioi y) y, f y - derivWithin f (Ioi y) y * y, fun x hx ↦ ?_⟩ + calc derivWithin f (Ioi y) y * x + (f y - derivWithin f (Ioi y) y * y) + _ = f y + derivWithin f (Ioi y) y * (x - y) := by ring + _ ≤ f x := hf.add_rightDeriv_mul_le hx hy + lemma StrictConvexOn.add_deriv_mul_lt {S : Set ℝ} {f : ℝ → ℝ} {x y : ℝ} (hfc : StrictConvexOn ℝ S f) (hx : x ∈ S) (hy : y ∈ S) (hxy : x ≠ y) (hfd : DifferentiableAt ℝ f y) : diff --git a/Statlib/ForMathlib/ENNReal.lean b/Statlib/ForMathlib/ENNReal.lean index 95f747a..20cb17d 100644 --- a/Statlib/ForMathlib/ENNReal.lean +++ b/Statlib/ForMathlib/ENNReal.lean @@ -74,6 +74,78 @@ lemma inv_div_fsupport {α : Type*} (f g : α → ℝ≥0∞) : lemma log_div (a b : ℝ≥0∞) : ENNReal.log (a / b) = ENNReal.log a - ENNReal.log b := by simp_rw [div_eq_mul_inv, ENNReal.log_mul_add, ENNReal.log_inv, sub_eq_add_neg] +section Ioo + +open Set +open scoped NNReal + +lemma toReal_image_Ioo {x y : ℝ≥0∞} (hx : x ≠ ∞) (hy : y ≠ ∞) : + ENNReal.toReal '' (Ioo x y) = Ioo x.toReal y.toReal := by + ext a + refine + ⟨fun ⟨a', ⟨hxa, hay⟩, ha⟩ ↦ ha ▸ ⟨toReal_strict_mono hay.ne_top hxa, toReal_strict_mono hy hay⟩, + fun ⟨hxa, hay⟩ ↦ ⟨.ofReal a, ⟨?_, ?_⟩, toReal_ofReal (toReal_nonneg.trans_lt hxa).le⟩⟩ + · rw [← ofReal_toReal hx, ofReal_lt_ofReal_iff'] + exact ⟨hxa, toReal_nonneg.trans_lt hxa⟩ + · rw [← ofReal_toReal hy, ofReal_lt_ofReal_iff'] + exact ⟨hay, (toReal_nonneg.trans_lt hxa).trans hay⟩ + +@[simp] +lemma toReal_image_Ioo_top {x : ℝ≥0∞} (hx : x ≠ ∞) : + ENNReal.toReal '' (Ioo x ∞) = Ioi x.toReal := by + ext a + refine ⟨fun ⟨a', ⟨hxa, hay⟩, ha⟩ ↦ ha ▸ toReal_strict_mono hay.ne_top hxa, + fun hxa ↦ ⟨.ofReal a, ⟨?_, ofReal_lt_top⟩, toReal_ofReal (toReal_nonneg.trans_lt hxa).le⟩⟩ + rw [← ofReal_toReal hx, ofReal_lt_ofReal_iff'] + exact ⟨hxa, toReal_nonneg.trans_lt hxa⟩ + +/-- A point of `[x, y]` (with `y ≠ ∞`) is a convex combination of `x` and `y` with `ℝ≥0` weights. -/ +lemma exists_nnreal_smul_add_eq {x y z : ℝ≥0∞} (hy : y ≠ ∞) (hxz : x ≤ z) (hzy : z ≤ y) : + ∃ u v : ℝ≥0, u + v = 1 ∧ u • x + v • y = z := by + have hz : z ≠ ∞ := ne_top_of_le_ne_top hy hzy + have hx : x ≠ ∞ := ne_top_of_le_ne_top hz hxz + rcases eq_or_lt_of_le (hxz.trans hzy) with rfl | hxy + · obtain rfl := le_antisymm hxz hzy + exact ⟨1, 0, by simp, by simp⟩ + have hxy' : x.toReal < y.toReal := toReal_strict_mono hy hxy + have hxy_ne : y.toReal - x.toReal ≠ 0 := (sub_pos.mpr hxy').ne' + set v : ℝ := (z.toReal - x.toReal) / (y.toReal - x.toReal) with hv + have hv0 : 0 ≤ v := div_nonneg (sub_nonneg.mpr (toReal_mono hz hxz)) (sub_nonneg.mpr hxy'.le) + have hv1 : v ≤ 1 := + (div_le_one (sub_pos.mpr hxy')).mpr (sub_le_sub_right (toReal_mono hy hzy) _) + refine ⟨(1 - v).toNNReal, v.toNNReal, ?_, ?_⟩ + · rw [← Real.toNNReal_add (sub_nonneg.mpr hv1) hv0, sub_add_cancel, Real.toNNReal_one] + · rw [← toReal_eq_toReal_iff' (by simp [smul_def, mul_ne_top, hx, hy]) hz] + simp only [smul_def, smul_eq_mul, toReal_add (mul_ne_top coe_ne_top hx) + (mul_ne_top coe_ne_top hy), toReal_mul, coe_toReal, + Real.coe_toNNReal _ (sub_nonneg.mpr hv1), Real.coe_toNNReal _ hv0] + rw [hv] + field_simp + ring + +lemma preimage_toReal_Ioc {a b : ℝ} (h : 0 ≤ a) : + ENNReal.toReal ⁻¹' Ioc a b = Ioc (ENNReal.ofReal a) (ENNReal.ofReal b) := by + ext x + rcases lt_or_ge b a with hb | hb + · rw [Ioc_eq_empty (not_lt.mpr hb.le), Ioc_eq_empty] + · simp + · rw [not_lt, ENNReal.ofReal_le_ofReal_iff h] + exact hb.le + simp only [mem_preimage, mem_Ioc] + by_cases hx_top : x = ∞ + · simp [hx_top, not_lt.mpr h] + rw [ENNReal.le_ofReal_iff_toReal_le hx_top (h.trans hb), + ENNReal.ofReal_lt_iff_lt_toReal h hx_top] + +end Ioo + +/-- The truncated subtraction of finite extended nonnegative reals, as a real number. -/ +lemma toReal_sub_eq_max_zero {a b : ℝ≥0∞} (ha : a ≠ ∞) (hb : b ≠ ∞) : + (a - b).toReal = max 0 (a.toReal - b.toReal) := by + rcases le_total a b with h | h + · rw [tsub_eq_zero_of_le h, toReal_zero, max_eq_left (sub_nonpos.2 (toReal_mono hb h))] + · rw [toReal_sub_of_le h ha, max_eq_right (sub_nonneg.2 (toReal_mono ha h))] + section Topology open Filter Topology diff --git a/Statlib/ForMathlib/EReal.lean b/Statlib/ForMathlib/EReal.lean index 4b1b295..4f04ee1 100644 --- a/Statlib/ForMathlib/EReal.lean +++ b/Statlib/ForMathlib/EReal.lean @@ -469,3 +469,103 @@ lemma coe_ennreal_sub_eq_of_add_eq' {a b c d : ℝ≥0∞} (h : a + d = c + b) ( exact_mod_cast (by linarith : (a : ℝ) - c = b - d) end EReal + +namespace EReal + +/-! ### Subtraction, `toENNReal` and continuity + +These lemmas are adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). -/ + +open Filter Set + +lemma sub_add_sub_cancel (b a : EReal) (c : ℝ) : + b - c + (c - a) = b - a := by + induction a <;> induction b + · simp + · simp only [coe_sub_bot] + rw [← coe_sub, coe_add_top] + · simp + · simp + · norm_cast + ring + · simp only [top_sub_coe] + rw [← coe_sub, top_add_coe] + · simp + · simp + · simp + +lemma toENNReal_sub_le_add (b a c : EReal) : + (b - a).toENNReal ≤ (b - c).toENNReal + (c - a).toENNReal := by + by_cases hc_top : c = ⊤ + · simp only [hc_top, sub_top, ne_eq, bot_ne_top, not_false_eq_true, + toENNReal_of_ne_top, toReal_bot, ENNReal.ofReal_zero, zero_add] + by_cases ha : a = ⊤ + · simp [ha] + · simp [top_sub ha] + by_cases hc_bot : c = ⊥ + · simp [hc_bot, sub_eq_add_neg] + by_cases hb_bot : b = ⊥ + · simp [hb_bot] + · simp [add_top_of_ne_bot hb_bot] + refine (toENNReal_le_toENNReal ?_).trans toENNReal_add_le + lift c to ℝ using ⟨hc_top, hc_bot⟩ with c + rw [sub_add_sub_cancel] + +lemma toENNReal_sub_add_cancel {b a c : EReal} (hac : a ≤ c) (hcb : c ≤ b) : + (b - c).toENNReal + (c - a).toENNReal = (b - a).toENNReal := by + induction c + · have ha : a = ⊥ := eq_bot_iff.mpr hac + simp [ha] + · rw [← toENNReal_add, sub_add_sub_cancel] + · rwa [sub_nonneg (.inr <| coe_ne_top _) (.inr <| coe_ne_bot _)] + · by_cases ha : a = ⊥ + · simp [ha] + rwa [sub_nonneg _ (.inr ha)] + exact .inr (hac.trans_lt (coe_lt_top _)).ne + · have hb : b = ⊤ := eq_top_iff.mpr hcb + simp [hb] + +lemma continuousAt_sub {p : EReal × EReal} (h : p.1 ≠ ⊤ ∨ p.2 ≠ ⊤) (h' : p.1 ≠ ⊥ ∨ p.2 ≠ ⊥) : + ContinuousAt (fun p : EReal × EReal ↦ p.1 - p.2) p := by + simp_rw [sub_eq_add_neg] + refine ContinuousAt.comp (g := fun p : EReal × EReal ↦ p.1 + p.2) + (f := fun p : EReal × EReal ↦ (p.1, -p.2)) ?_ ?_ + · refine EReal.continuousAt_add ?_ ?_ + · simp [h] + · simp [h'] + · fun_prop + +lemma continuousAt_const_sub {c x : EReal} (h' : x ≠ ⊤ ∨ c ≠ ⊤) : + ContinuousAt (fun x : EReal ↦ c - x) x := by + by_cases hc_top : c = ⊥ + · simp only [hc_top, bot_sub] + exact continuous_const.continuousAt + exact (EReal.continuousAt_sub h'.symm (Or.inl hc_top)).comp (f := fun x ↦ (c, x)) + (by fun_prop) + +lemma continuousAt_sub_const {c x : EReal} (h' : x ≠ ⊥ ∨ c ≠ ⊥) : + ContinuousAt (fun x : EReal ↦ x - c) x := by + by_cases hc_top : c = ⊤ + · simp only [hc_top, sub_top] + exact continuous_const.continuousAt + exact (EReal.continuousAt_sub (Or.inr hc_top) h').comp (f := fun x ↦ (x, c)) (by fun_prop) + +lemma continuous_coe_mul (c : ℝ) : Continuous (fun x : EReal ↦ c * x) := by + by_cases hc0 : c = 0 + · simp only [hc0, EReal.coe_zero, zero_mul] + exact continuous_const + rw [continuous_iff_continuousAt] + intro x + have h_cont : ContinuousAt (fun p : EReal × EReal ↦ p.1 * p.2) (c, x) := by + refine EReal.continuousAt_mul ?_ ?_ ?_ ?_ <;> exact Or.inl (by simp [hc0]) + refine h_cont.comp ?_ + fun_prop + +lemma toENNReal_coe_mul_sub {c : ℝ≥0∞} (hc : c ≠ ∞) (x y : EReal) : + ((c : EReal) * x - c * y).toENNReal = c * (x - y).toENNReal := by + rw [sub_eq_add_neg, sub_eq_add_neg, ← mul_neg, ← left_distrib_of_nonneg_of_ne_top + (coe_ennreal_nonneg c) fun h ↦ hc (coe_ennreal_eq_top_iff.mp h), + toENNReal_mul (coe_ennreal_nonneg c), toENNReal_coe] + +end EReal diff --git a/Statlib/ForMathlib/InformationTheory/KullbackLeibler/Basic.lean b/Statlib/ForMathlib/InformationTheory/KullbackLeibler/Basic.lean new file mode 100644 index 0000000..ef23dd0 --- /dev/null +++ b/Statlib/ForMathlib/InformationTheory/KullbackLeibler/Basic.lean @@ -0,0 +1,143 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.InformationTheory.KullbackLeibler.Basic + +/-! +# Kullback-Leibler divergence of rescaled measures + +## Main statements + +* `klDiv_smul_left_eq_top_iff`, `klDiv_smul_right_eq_top_iff`: for `c ∉ {0, ∞}`, rescaling one of + the measures by `c` does not change whether the divergence is infinite. +* `klDiv_smul_left_eq_ofReal`: formula for `klDiv (c • μ) ν` in terms of `klDiv μ ν`. +* `klDiv_smul_right_eq_smul_left'`, `klDiv_smul_same'`: versions of Mathlib's + `klDiv_smul_right_eq_smul_left` and `klDiv_smul_same` for `c : ℝ≥0∞`. +* `klDiv_inv_smul_le_of_le`: an inequality between Kullback-Leibler divergences of measures with + the same masses also holds for the normalized measures. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Real MeasureTheory + +open scoped ENNReal NNReal + +namespace InformationTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} + +lemma klDiv_smul_left_eq_top_iff [IsFiniteMeasure μ] [IsFiniteMeasure ν] {c : ℝ≥0∞} + (hc : c ≠ 0) (hc_top : c ≠ ∞) : + klDiv (c • μ) ν = ∞ ↔ klDiv μ ν = ∞ := by + rw [klDiv_eq_top_iff, klDiv_eq_top_iff] + have h_ac : c • μ ≪ ν ↔ μ ≪ ν := + ⟨fun h ↦ (Measure.absolutelyContinuous_smul hc).trans h, fun h ↦ h.smul_left c⟩ + rw [h_ac] + refine imp_congr_right fun hμν ↦ not_congr ?_ + rw [integrable_smul_measure hc hc_top, integrable_congr (llr_smul_left hμν c hc hc_top), + integrable_add_iff_integrable_left' (integrable_const _)] + +lemma klDiv_smul_left_eq_ofReal [IsFiniteMeasure μ] [IsFiniteMeasure ν] (h : klDiv μ ν ≠ ∞) + {c : ℝ≥0∞} (hc_top : c ≠ ∞) : + klDiv (c • μ) ν = ENNReal.ofReal (c.toReal * (klDiv μ ν).toReal + + (1 - c.toReal) * (ν .univ).toReal + c.toReal * log c.toReal * (μ .univ).toReal) := by + by_cases hc : c = 0 + · simp [hc, klDiv_zero_left] + have h' : klDiv (c • μ) ν ≠ ∞ := by rwa [ne_eq, klDiv_smul_left_eq_top_iff hc hc_top] + rw [klDiv_ne_top_iff] at h + lift c to ℝ≥0 using hc_top + rw [← ENNReal.smul_def] at h' ⊢ + rw [← ENNReal.ofReal_toReal h', toReal_klDiv_smul_left h.1 h.2 c, ENNReal.coe_toReal, + measureReal_def, measureReal_def] + +lemma klDiv_smul_right_eq_smul_left' [IsFiniteMeasure μ] [IsFiniteMeasure ν] {c : ℝ≥0∞} + (hc : c ≠ 0) (hc_top : c ≠ ∞) : + klDiv μ (c • ν) = c * klDiv (c⁻¹ • μ) ν := by + lift c to ℝ≥0 using hc_top + have hc' : c ≠ 0 := by simpa using hc + rw [← ENNReal.smul_def, ← ENNReal.coe_inv hc', ← ENNReal.smul_def] + exact klDiv_smul_right_eq_smul_left hc' + +lemma klDiv_smul_right_eq_top_iff [IsFiniteMeasure μ] [IsFiniteMeasure ν] {c : ℝ≥0∞} + (hc : c ≠ 0) (hc_top : c ≠ ∞) : + klDiv μ (c • ν) = ∞ ↔ klDiv μ ν = ∞ := by + rw [klDiv_smul_right_eq_smul_left' hc hc_top, ENNReal.mul_eq_top, + klDiv_smul_left_eq_top_iff (ENNReal.inv_ne_zero.mpr hc_top) (ENNReal.inv_ne_top.mpr hc)] + simp [hc, hc_top] + +lemma klDiv_smul_same' [IsFiniteMeasure μ] [IsFiniteMeasure ν] {c : ℝ≥0∞} (hc_top : c ≠ ∞) : + klDiv (c • μ) (c • ν) = c * klDiv μ ν := by + lift c to ℝ≥0 using hc_top + rw [← ENNReal.smul_def, ← ENNReal.smul_def] + exact klDiv_smul_same c + +lemma klDiv_smul_left_le_of_le {β : Type*} {mβ : MeasurableSpace β} {μ₁ ν₁ : Measure α} + {μ₂ ν₂ : Measure β} [IsFiniteMeasure μ₁] [IsFiniteMeasure ν₁] [IsFiniteMeasure μ₂] + [IsFiniteMeasure ν₂] (h_eq_μ : μ₁ .univ = μ₂ .univ) (h_eq_ν : ν₁ .univ = ν₂ .univ) + (h_le : klDiv μ₁ ν₁ ≤ klDiv μ₂ ν₂) {c : ℝ≥0∞} (hc_top : c ≠ ∞) : + klDiv (c • μ₁) ν₁ ≤ klDiv (c • μ₂) ν₂ := by + by_cases h2 : klDiv μ₂ ν₂ = ∞ + · by_cases hc : c = 0 + · simp [hc, klDiv_zero_left, h_eq_ν] + · rw [(klDiv_smul_left_eq_top_iff hc hc_top).mpr h2] + exact le_top + have h1 : klDiv μ₁ ν₁ ≠ ∞ := ne_top_of_le_ne_top h2 h_le + rw [klDiv_smul_left_eq_ofReal h1 hc_top, klDiv_smul_left_eq_ofReal h2 hc_top, h_eq_μ, h_eq_ν] + gcongr + +lemma klDiv_smul_smul_le_of_le {β : Type*} {mβ : MeasurableSpace β} {μ₁ ν₁ : Measure α} + {μ₂ ν₂ : Measure β} [IsFiniteMeasure μ₁] [IsFiniteMeasure ν₁] [IsFiniteMeasure μ₂] + [IsFiniteMeasure ν₂] (h_eq_μ : μ₁ .univ = μ₂ .univ) (h_eq_ν : ν₁ .univ = ν₂ .univ) + (h_le : klDiv μ₁ ν₁ ≤ klDiv μ₂ ν₂) {c c' : ℝ≥0∞} (hc_top : c ≠ ∞) (hc' : c' ≠ 0) + (hc'_top : c' ≠ ∞) : + klDiv (c • μ₁) (c' • ν₁) ≤ klDiv (c • μ₂) (c' • ν₂) := by + lift c to ℝ≥0 using hc_top + lift c' to ℝ≥0 using hc'_top + have hc'0 : c' ≠ 0 := by simpa using hc' + have h := klDiv_smul_left_le_of_le h_eq_μ h_eq_ν h_le (c := ((c'⁻¹ * c : ℝ≥0) : ℝ≥0∞)) + ENNReal.coe_ne_top + rw [← ENNReal.smul_def, ← ENNReal.smul_def] at h + rw [← ENNReal.smul_def, ← ENNReal.smul_def, ← ENNReal.smul_def, ← ENNReal.smul_def, + klDiv_smul_right_eq_smul_left hc'0, klDiv_smul_right_eq_smul_left hc'0, smul_smul, smul_smul] + gcongr + +/-- Monotonicity of the Kullback-Leibler divergence of the normalized measures, for fixed +masses. -/ +lemma klDiv_inv_smul_le_of_le {β : Type*} {mβ : MeasurableSpace β} {μ₁ ν₁ : Measure α} + {μ₂ ν₂ : Measure β} [IsFiniteMeasure μ₁] [IsFiniteMeasure ν₁] [IsFiniteMeasure μ₂] + [IsFiniteMeasure ν₂] (h_eq_μ : μ₁ .univ = μ₂ .univ) (h_eq_ν : ν₁ .univ = ν₂ .univ) + (h_le : klDiv μ₁ ν₁ ≤ klDiv μ₂ ν₂) : + klDiv ((μ₁ .univ)⁻¹ • μ₁) ((ν₁ .univ)⁻¹ • ν₁) + ≤ klDiv ((μ₂ .univ)⁻¹ • μ₂) ((ν₂ .univ)⁻¹ • ν₂) := by + by_cases hν : ν₂ .univ = 0 + · have hν₁ : ν₁ .univ = 0 := h_eq_ν.trans hν + obtain rfl := Measure.measure_univ_eq_zero.mp hν + obtain rfl := Measure.measure_univ_eq_zero.mp hν₁ + simp only [Measure.coe_zero, Pi.zero_apply, ENNReal.inv_zero, smul_zero] + by_cases hμ : μ₂ = 0 + · subst hμ + obtain rfl : μ₁ = 0 := Measure.measure_univ_eq_zero.mp (h_eq_μ.trans (by simp)) + simp + · have : NeZero μ₂ := ⟨hμ⟩ + rw [klDiv_zero_right (μ := (μ₂ .univ)⁻¹ • μ₂)] + exact le_top + have : NeZero ν₂ := ⟨fun h ↦ hν (by simp [h])⟩ + have : NeZero ν₁ := ⟨fun h ↦ hν (h_eq_ν.symm.trans (by simp [h]))⟩ + by_cases hμ : μ₂ .univ = 0 + · have hμ₁ : μ₁ .univ = 0 := h_eq_μ.trans hμ + obtain rfl := Measure.measure_univ_eq_zero.mp hμ + obtain rfl := Measure.measure_univ_eq_zero.mp hμ₁ + simp only [smul_zero, klDiv_zero_left, measure_univ, le_refl] + rw [h_eq_μ, h_eq_ν] + exact klDiv_smul_smul_le_of_le h_eq_μ h_eq_ν h_le (ENNReal.inv_ne_top.mpr hμ) + (ENNReal.inv_ne_zero.mpr (measure_ne_top _ _)) (ENNReal.inv_ne_top.mpr hν) + +end InformationTheory diff --git a/Statlib/ForMathlib/InformationTheory/KullbackLeibler/Bernoulli.lean b/Statlib/ForMathlib/InformationTheory/KullbackLeibler/Bernoulli.lean index 3f0aa1c..3f1ec94 100644 --- a/Statlib/ForMathlib/InformationTheory/KullbackLeibler/Bernoulli.lean +++ b/Statlib/ForMathlib/InformationTheory/KullbackLeibler/Bernoulli.lean @@ -7,6 +7,8 @@ module public import Mathlib.Analysis.SpecialFunctions.BinaryEntropy public import Statlib.ForMathlib.Analysis.SpecialFunctions.Log.Basic +public import Mathlib.InformationTheory.KullbackLeibler.Basic +public import Statlib.ForMathlib.Probability.Distributions.Bernoulli /-! # The Kullback-Leibler divergence between Bernoulli distributions @@ -15,9 +17,9 @@ The Kullback-Leibler divergence between two Bernoulli distributions with paramet is `p * log (p / q) + (1 - p) * log ((1 - p) / (1 - q))` for `q ∈ (0, 1)`. We define it as the real-valued function `klBerReal` given by that formula. -The definition and its basic API are copied from LMLPapers -(`LeanMachineLearning/ForMathlib/InformationTheory/KullbackLeibler/Bernoulli.lean`), which also -defines the `ℝ≥0∞`-valued version and identifies it with `klDiv` between Bernoulli measures. +The definition, its basic API and its identification with `klDiv` between Bernoulli measures are +copied from LMLPapers (`LeanMachineLearning/ForMathlib/InformationTheory/KullbackLeibler/ +Bernoulli.lean`), which also defines an `ℝ≥0∞`-valued version. ## Main definitions @@ -28,6 +30,8 @@ defines the `ℝ≥0∞`-valued version and identifies it with `klDiv` between B * `klBerReal_one_sub`: `klBerReal (1 - p) (1 - q) = klBerReal p q`. * `klBerReal_nonneg`: Gibbs' inequality, `0 ≤ klBerReal p q` for `p ∈ [0, 1]` and `q ∈ (0, 1)`. +* `klDiv_bernoulliMeasure_eq_klBerReal`: for `x ≠ y` and `q ∉ {0, 1}`, + `klDiv Ber(x, y, p) Ber(x, y, q) = ENNReal.ofReal (klBerReal p q)`. -/ @[expose] public section @@ -87,4 +91,35 @@ lemma klBerReal_nonneg (hp0 : 0 ≤ p) (hp1 : p ≤ 1) (hq0 : 0 < q) (hq1 : q < rw [klBerReal] linarith +section BernoulliMeasure + +open MeasureTheory ProbabilityTheory unitInterval + +variable {𝓧 : Type*} [MeasurableSpace 𝓧] [MeasurableSingletonClass 𝓧] {x y : 𝓧} + +/-- The Kullback-Leibler divergence between the Bernoulli measures `Ber(x, y, p)` and +`Ber(x, y, q)`, for `x ≠ y` and `q ∉ {0, 1}`, is `klBerReal p q`. -/ +lemma klDiv_bernoulliMeasure_eq_klBerReal (hxy : x ≠ y) (p : I) {q : I} (hq : q ≠ 0) + (hq1 : q ≠ 1) : + klDiv Ber(x, y, p) Ber(x, y, q) = ENNReal.ofReal (klBerReal p q) := by + classical + have hq0 : (0 : ℝ) < q := coe_pos.2 (unitInterval.pos_iff_ne_zero.2 hq) + have hq1' : (0 : ℝ) < 1 - q := sub_pos.2 (coe_lt_one.2 (unitInterval.lt_one_iff_ne_one.2 hq1)) + have hp0 : (0 : ℝ) ≤ p := p.2.1 + have hp1 : (0 : ℝ) ≤ 1 - p := sub_nonneg.2 p.2.2 + rw [klDiv_eq_lintegral_klFun_of_ac (bernoulliMeasure_absolutelyContinuous hxy p hq hq1), + lintegral_congr_ae ((rnDeriv_bernoulliMeasure hxy p hq hq1).mono fun z hz ↦ by rw [hz]), + lintegral_bernoulliMeasure] + simp only [ite_true, ite_eq_right hxy.symm, ENNReal.toReal_ofReal (div_nonneg hp0 hq0.le), + ENNReal.toReal_ofReal (div_nonneg hp1 hq1'.le)] + rw [← ENNReal.ofReal_mul hq0.le, ← ENNReal.ofReal_mul hq1'.le, ← ENNReal.ofReal_add + (mul_nonneg hq0.le (klFun_nonneg (div_nonneg hp0 hq0.le))) + (mul_nonneg hq1'.le (klFun_nonneg (div_nonneg hp1 hq1'.le)))] + congr 1 + simp only [klFun, klBerReal] + field_simp + ring + +end BernoulliMeasure + end InformationTheory diff --git a/Statlib/ForMathlib/InformationTheory/KullbackLeibler/DataProcessing.lean b/Statlib/ForMathlib/InformationTheory/KullbackLeibler/DataProcessing.lean new file mode 100644 index 0000000..d870a84 --- /dev/null +++ b/Statlib/ForMathlib/InformationTheory/KullbackLeibler/DataProcessing.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.InformationTheory.KullbackLeibler.DataProcessing + +/-! +# Data-processing inequalities for the Kullback-Leibler divergence + +Consequences of Mathlib's data-processing inequality for measurable maps, `klDiv_map_le`. + +## Main statements + +* `klDiv_fst_le`, `klDiv_snd_le`: the divergence between marginals is at most the divergence + between the joint measures. +* `le_klDiv_compProd`: `klDiv μ ν ≤ klDiv (μ ⊗ₘ κ) (ν ⊗ₘ η)` for Markov kernels `κ, η`. +* `klDiv_comp_le_compProd`: `klDiv (κ ∘ₘ μ) (η ∘ₘ ν) ≤ klDiv (μ ⊗ₘ κ) (ν ⊗ₘ η)`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open MeasureTheory ProbabilityTheory + +namespace InformationTheory + +variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} + +lemma klDiv_fst_le (μ ν : Measure (α × β)) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + klDiv μ.fst ν.fst ≤ klDiv μ ν := + klDiv_map_le μ ν measurable_fst + +lemma klDiv_snd_le (μ ν : Measure (α × β)) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + klDiv μ.snd ν.snd ≤ klDiv μ ν := + klDiv_map_le μ ν measurable_snd + +lemma le_klDiv_compProd (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ η : Kernel α β) [IsMarkovKernel κ] [IsMarkovKernel η] : + klDiv μ ν ≤ klDiv (μ ⊗ₘ κ) (ν ⊗ₘ η) := by + simpa using klDiv_fst_le (μ ⊗ₘ κ) (ν ⊗ₘ η) + +lemma klDiv_comp_le_compProd (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + klDiv (κ ∘ₘ μ) (η ∘ₘ ν) ≤ klDiv (μ ⊗ₘ κ) (ν ⊗ₘ η) := by + simpa using klDiv_snd_le (μ ⊗ₘ κ) (ν ⊗ₘ η) + +end InformationTheory diff --git a/Statlib/ForMathlib/InformationTheory/KullbackLeibler/EIntegral.lean b/Statlib/ForMathlib/InformationTheory/KullbackLeibler/EIntegral.lean new file mode 100644 index 0000000..44fbbfd --- /dev/null +++ b/Statlib/ForMathlib/InformationTheory/KullbackLeibler/EIntegral.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne +-/ +module + +public import Mathlib.InformationTheory.KullbackLeibler.Basic +public import Statlib.ForMathlib.MeasureTheory.Integral.EReal.Bochner +public import Statlib.ForMathlib.MeasureTheory.Measure.LogLikelihoodRatio + +/-! +# The Kullback-Leibler divergence as an extended integral + +For `μ ≪ ν` finite measures, the Kullback-Leibler divergence `klDiv μ ν` is +`∫ᵉ x, llr μ ν x ∂μ + ν univ - μ univ`, including when the log-likelihood ratio is not integrable: +its negative part always has finite integral (`eintegral_llr_ne_bot`), so the extended integral is +then `⊤`. + +## Main statements + +* `coe_klDiv_eq_eintegral_llr`: `(klDiv μ ν : EReal) = ∫ᵉ x, llr μ ν x ∂μ + ν univ - μ univ` for + `μ ≪ ν`. +* `coe_klDiv_eq_eintegral_llr_of_measure_eq`: `(klDiv μ ν : EReal) = ∫ᵉ x, llr μ ν x ∂μ` for + `μ ≪ ν` with `μ univ = ν univ`. +-/ + +@[expose] public section + +open MeasureTheory + +namespace InformationTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} + +/-- For `μ ≪ ν` finite measures, the Kullback-Leibler divergence is the extended integral of the +log-likelihood ratio, plus `ν univ - μ univ`. -/ +lemma coe_klDiv_eq_eintegral_llr [IsFiniteMeasure μ] [IsFiniteMeasure ν] (h_ac : μ ≪ ν) : + (klDiv μ ν : EReal) = ∫ᵉ x, llr μ ν x ∂μ + ν.real .univ - μ.real .univ := by + by_cases h_int : Integrable (llr μ ν) μ + · rw [klDiv_of_ac_of_integrable h_ac h_int, EReal.coe_ennreal_ofReal, + max_eq_left (integral_llr_add_sub_measure_univ_nonneg h_ac h_int), + eintegral_eq_integral h_int] + norm_cast + -- the negative part of `llr μ ν` is integrable, hence its positive part is not + have h_top : ∫ᵉ x, llr μ ν x ∂μ = ⊤ := by + by_contra h_ne_top + refine h_int ?_ + simpa using (integrable_toReal_iff_eintegral_ne_bot_and_ne_top + (f := fun x ↦ (llr μ ν x : EReal)) (by fun_prop) (ae_of_all _ fun _ ↦ EReal.coe_ne_bot _) + (ae_of_all _ fun _ ↦ EReal.coe_ne_top _)).mpr ⟨eintegral_llr_ne_bot h_ac, h_ne_top⟩ + rw [klDiv_of_not_integrable h_int, EReal.coe_ennreal_top, h_top, EReal.top_add_coe, + EReal.top_sub_coe] + +/-- For `μ ≪ ν` finite measures with the same total mass, the Kullback-Leibler divergence is the +extended integral of the log-likelihood ratio. -/ +lemma coe_klDiv_eq_eintegral_llr_of_measure_eq [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (h_ac : μ ≪ ν) (h_univ : μ .univ = ν .univ) : + (klDiv μ ν : EReal) = ∫ᵉ x, llr μ ν x ∂μ := by + rw [coe_klDiv_eq_eintegral_llr h_ac, measureReal_def, measureReal_def, h_univ, + EReal.add_sub_cancel_right] + +end InformationTheory diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/Bool.lean b/Statlib/ForMathlib/MeasureTheory/Measure/Bool.lean new file mode 100644 index 0000000..42c90fd --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Measure/Bool.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2024 Lorenzo Luccioli. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Lorenzo Luccioli +-/ +module + +public import Mathlib.MeasureTheory.Measure.WithDensity + +/-! +# Measures on `Bool` + +A measure on `Bool` is determined by its values on `{false}` and `{true}`. + +## Main definitions + +* `MeasureTheory.Measure.boolMeasure a b`: the measure on `Bool` with mass `a` at `false` and `b` + at `true`. + +## Main statements + +* `MeasureTheory.Measure.ext_bool`: two measures on `Bool` which agree on `{false}` and `{true}` + are equal. +* `MeasureTheory.Measure.eq_boolMeasure`: every measure `π` on `Bool` is + `boolMeasure (π {false}) (π {true})`. +* `MeasureTheory.Measure.map_decide_mem_eq_boolMeasure`: the law of the indicator of a measurable + set `s` under `μ` is `boolMeasure (μ sᶜ) (μ s)`. +* `MeasureTheory.lintegral_bool`: `∫⁻ x, f x ∂π = f false * π {false} + f true * π {true}`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open scoped ENNReal + +namespace MeasureTheory + +lemma _root_.measurable_decide_mem {α : Type*} {mα : MeasurableSpace α} {s : Set α} + [DecidablePred (· ∈ s)] (hs : MeasurableSet s) : + Measurable fun x ↦ decide (x ∈ s) := + measurable_to_bool (by simpa [Set.preimage] using hs) + +namespace Measure + +@[ext] +lemma ext_bool {π₁ π₂ : Measure Bool} (h_false : π₁ {false} = π₂ {false}) + (h_true : π₁ {true} = π₂ {true}) : + π₁ = π₂ := + ext_iff_singleton.mpr (Bool.forall_bool.mpr ⟨h_false, h_true⟩) + +/-- The measure on `Bool` with mass `a` at `false` and `b` at `true`. -/ +noncomputable +def boolMeasure (a b : ℝ≥0∞) : Measure Bool := a • dirac false + b • dirac true + +@[simp] +lemma boolMeasure_apply_false (a b : ℝ≥0∞) : boolMeasure a b {false} = a := by simp [boolMeasure] + +@[simp] +lemma boolMeasure_apply_true (a b : ℝ≥0∞) : boolMeasure a b {true} = b := by simp [boolMeasure] + +/-- The total mass of `boolMeasure a b`. The set `{false, true}` is the simp normal form of +`Set.univ : Set Bool` (`Bool.univ_eq`). -/ +@[simp] +lemma boolMeasure_apply_univ (a b : ℝ≥0∞) : boolMeasure a b {false, true} = a + b := by + simp [boolMeasure] + +lemma isFiniteMeasure_boolMeasure {a b : ℝ≥0∞} (ha : a ≠ ∞) (hb : b ≠ ∞) : + IsFiniteMeasure (boolMeasure a b) := + ⟨by simp [lt_top_iff_ne_top, ha, hb]⟩ + +/-- The uniform measure `boolMeasure 1 1` is finite. -/ +instance isFiniteMeasure_boolMeasure_one_one : IsFiniteMeasure (boolMeasure 1 1) := + isFiniteMeasure_boolMeasure ENNReal.one_ne_top ENNReal.one_ne_top + +lemma eq_boolMeasure (π : Measure Bool) : π = boolMeasure (π {false}) (π {true}) := by + ext <;> simp + +lemma withDensity_eq_boolMeasure (π : Measure Bool) (f : Bool → ℝ≥0∞) : + π.withDensity f = boolMeasure (f false * π {false}) (f true * π {true}) := by + ext <;> simp [mul_comm] + +/-- The law under `μ` of the indicator `x ↦ decide (x ∈ s)` of a measurable set `s`. -/ +lemma map_decide_mem_eq_boolMeasure {α : Type*} {mα : MeasurableSpace α} (μ : Measure α) + {s : Set α} [DecidablePred (· ∈ s)] (hs : MeasurableSet s) : + μ.map (fun x ↦ decide (x ∈ s)) = boolMeasure (μ sᶜ) (μ s) := by + have hg := measurable_decide_mem hs + ext + · rw [map_apply hg (measurableSet_singleton _), boolMeasure_apply_false] + congr with x + simp + · rw [map_apply hg (measurableSet_singleton _), boolMeasure_apply_true] + congr with x + simp + +end Measure + +lemma lintegral_bool {f : Bool → ℝ≥0∞} (π : Measure Bool) : + ∫⁻ x, f x ∂π = f false * π {false} + f true * π {true} := by + simp [add_comm, lintegral_fintype] + +end MeasureTheory diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/IntegralRNDeriv.lean b/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/IntegralRNDeriv.lean new file mode 100644 index 0000000..51f7818 --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/IntegralRNDeriv.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.Analysis.Convex.Continuous +public import Mathlib.MeasureTheory.Measure.Decomposition.IntegralRNDeriv +public import Statlib.ForMathlib.Analysis.Convex.DerivAtTop + +/-! +# Integrability of `f ∘ ∂μ/∂ν` + +## Main statements + +* `ConvexOn.measurable_comp_of_nonneg`: a function convex on `(0, ∞)`, composed with a nonnegative + measurable function, is measurable. No measurability of `f` is needed, since `f` is continuous + on `(0, ∞)`. +* `MeasureTheory.integrable_f_rnDeriv_of_derivAtTop_ne_top`: for finite measures `μ, ν` and a + function `f` convex on `[0, ∞)` with `derivAtTop f ≠ ⊤`, the function `x ↦ f (∂μ/∂ν x).toReal` + is `ν`-integrable: it lies between an affine function of `∂μ/∂ν` and + `f 0 + (derivAtTop f).toReal * ∂μ/∂ν`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Filter Set Topology + +/-- A function convex on `(0, ∞)`, composed with a nonnegative measurable function, is measurable. +-/ +lemma ConvexOn.measurable_comp_of_nonneg {α : Type*} {mα : MeasurableSpace α} {f : ℝ → ℝ} + (hf : ConvexOn ℝ (Ioi 0) f) {g : α → ℝ} (hg : Measurable g) (hg_nonneg : ∀ x, 0 ≤ g x) : + Measurable fun x ↦ f (g x) := by + -- `f ∘ max · 0` is continuous outside of `0`: constant on `(-∞, 0)`, convex on `(0, ∞)` + have h_cont : ContinuousOn (fun y ↦ f (max y 0)) {0}ᶜ := by + intro y hy + rcases lt_or_gt_of_ne hy with hy | hy + · refine ((continuousAt_const (y := f 0)).congr ?_).continuousWithinAt + filter_upwards [eventually_lt_nhds hy] with z hz + rw [max_eq_right hz.le] + · have h_int : interior (Ioi (0 : ℝ)) ∈ 𝓝 y := isOpen_interior.mem_nhds (by simpa using hy) + refine ((hf.continuousOn_interior.continuousAt h_int).congr ?_).continuousWithinAt + filter_upwards [eventually_gt_nhds hy] with z hz + rw [max_eq_left hz.le] + convert (measurable_of_continuousOn_compl_singleton 0 h_cont).comp hg using 2 with x + simp [max_eq_left (hg_nonneg x)] + +namespace MeasureTheory + +lemma integrable_f_rnDeriv_of_derivAtTop_ne_top {α : Type*} {mα : MeasurableSpace α} + {f : ℝ → ℝ} (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (hf_cvx : ConvexOn ℝ (Ici 0) f) (hf_deriv : derivAtTop f ≠ ⊤) : + Integrable (fun x ↦ f (μ.rnDeriv ν x).toReal) ν := by + obtain ⟨c, c', h⟩ := hf_cvx.exists_affine_le + refine integrable_of_le_of_le (g₁ := fun x ↦ c * (μ.rnDeriv ν x).toReal + c') + (g₂ := fun x ↦ (derivAtTop f).toReal * (μ.rnDeriv ν x).toReal + f 0) ?_ ?_ ?_ ?_ ?_ + · exact ((hf_cvx.subset Ioi_subset_Ici_self (convex_Ioi 0)).measurable_comp_of_nonneg + (μ.measurable_rnDeriv ν).ennreal_toReal + fun _ ↦ ENNReal.toReal_nonneg).aestronglyMeasurable + · exact ae_of_all _ fun x ↦ h _ ENNReal.toReal_nonneg + · refine ae_of_all _ fun x ↦ ?_ + have h_le := hf_cvx.le_add_derivAtTop hf_deriv le_rfl + (ENNReal.toReal_nonneg : 0 ≤ (μ.rnDeriv ν x).toReal) + rw [sub_zero] at h_le + linarith + · exact (Measure.integrable_toReal_rnDeriv.const_mul _).add (integrable_const _) + · exact (Measure.integrable_toReal_rnDeriv.const_mul _).add (integrable_const _) + +end MeasureTheory diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/IntegralRPowRNDeriv.lean b/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/IntegralRPowRNDeriv.lean new file mode 100644 index 0000000..c9f4671 --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/IntegralRPowRNDeriv.lean @@ -0,0 +1,373 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.Analysis.Convex.SpecificFunctions.Pow +public import Mathlib.Analysis.SpecialFunctions.Pow.Deriv +public import Mathlib.Analysis.SpecialFunctions.Log.Deriv +public import Mathlib.MeasureTheory.Integral.DominatedConvergence +public import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.IntegralRNDeriv +public import Statlib.ForMathlib.MeasureTheory.Measure.LogLikelihoodRatio + +/-! +# Integrals of powers of Radon-Nikodym derivatives + +We study the integral `∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν`, which appears in the Hellinger and Rényi +divergences. + +## Main statements + +* `integral_rpow_rnDeriv_symm`: `∫ (∂μ/∂ν) ^ a ∂ν = ∫ (∂ν/∂μ) ^ (1 - a) ∂μ`. +* `lintegral_rpow_rnDeriv_add_mul_rpow_rnDeriv_add`: for `a ∈ [0, 1)`, the integral of + `(∂μ/∂(μ + ν)) ^ a * (∂ν/∂(μ + ν)) ^ (1 - a)` with respect to `μ + ν` is `∫⁻ (∂μ/∂ν) ^ a ∂ν`. +* `integrable_rpow_rnDeriv_of_lt_one`: for finite measures and `a ∈ [0, 1)`, `(∂μ/∂ν) ^ a` is + `ν`-integrable. +* `integral_rpow_rnDeriv_eq_zero_iff_mutuallySingular`: for `a ≠ 0`, the integral vanishes iff + `μ ⟂ₘ ν`. +* `integral_rpow_rnDeriv_smul_left`, `integral_rpow_rnDeriv_smul_right`: behaviour under scaling of + the measures. +* `tendsto_mul_log_integral_rpow_rnDeriv`: for probability measures with `μ ≪ ν` and `llr μ ν` + integrable, `(a - 1)⁻¹ * log (∫ (∂μ/∂ν) ^ a ∂ν)` tends to `∫ llr μ ν ∂μ` as `a → 1⁻`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Real Filter Set + +open scoped ENNReal NNReal Topology + +namespace MeasureTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {a : ℝ} + +/-- Symmetry of the Hellinger integral: `∫ (∂μ/∂ν)^a ∂ν = ∫ (∂ν/∂μ)^(1 - a) ∂μ`. -/ +lemma integral_rpow_rnDeriv_symm (ha_pos : 0 < a) (ha : a ≠ 1) [SigmaFinite μ] [SigmaFinite ν] : + ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν = ∫ x, (ν.rnDeriv μ x).toReal ^ (1 - a) ∂μ := by + let p := μ.rnDeriv (μ + ν) + let q := ν.rnDeriv (μ + ν) + calc ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν + = ∫ x, ((p/q) x).toReal ^ a ∂ν := by + refine integral_congr_ae ?_ + filter_upwards [Measure.rnDeriv_eq_div (ξ := μ + ν) + (Measure.AbsolutelyContinuous.rfl.add_right ν) + (Measure.AbsolutelyContinuous.rfl.add_right' μ)] with x hx + simp only [hx, Pi.div_apply, p, q] + _ = ∫ x, (q x).toReal * ((p/q) x).toReal ^ a ∂(μ + ν) := by + rw [← integral_rnDeriv_smul (_ : ν ≪ μ + ν)] + · simp [q] + · rw [add_comm] + exact Measure.AbsolutelyContinuous.rfl.add_right μ + _ = ∫ x, (p x).toReal * ((q/p) x).toReal ^ (1 - a) ∂(μ + ν) := by + refine integral_congr_ae ?_ + filter_upwards [μ.rnDeriv_lt_top (μ + ν), ν.rnDeriv_lt_top (μ + ν)] + with x hp_top hq_top + by_cases hp : p x = 0 + · simp [hp, ha_pos.ne'] + by_cases hq : q x = 0 + · simp only [hq, ENNReal.toReal_zero, Pi.div_apply, zero_mul, ENNReal.zero_div, + zero_eq_mul] + refine Or.inr ?_ + rw [zero_rpow] + rwa [ne_eq, sub_eq_zero, Eq.comm] + simp only [Pi.div_apply, div_eq_mul_inv, ENNReal.toReal_mul, + mul_rpow ENNReal.toReal_nonneg (inv_nonneg.mpr ENNReal.toReal_nonneg), ENNReal.toReal_inv, + inv_rpow ENNReal.toReal_nonneg, ← rpow_neg ENNReal.toReal_nonneg, neg_sub] + rw [mul_comm, mul_assoc, mul_comm _ ((p x).toReal ^ (a - 1)), ← mul_assoc (p x).toReal] + congr + · have : a = 1 + (a - 1) := by abel + conv_lhs => rw [this] + rw [rpow_add, rpow_one] + rw [ENNReal.toReal_pos_iff] + exact ⟨zero_le.lt_of_ne' hp, hp_top⟩ + · rw [mul_comm, rpow_sub, rpow_one, rpow_neg ENNReal.toReal_nonneg, div_eq_mul_inv] + rw [ENNReal.toReal_pos_iff] + exact ⟨zero_le.lt_of_ne' hq, hq_top⟩ + _ = ∫ x, ((q/p) x).toReal ^ (1 - a) ∂μ := by + rw [← integral_rnDeriv_smul (_ : μ ≪ μ + ν)] + · simp [p] + · exact Measure.AbsolutelyContinuous.rfl.add_right ν + _ = ∫ x, (ν.rnDeriv μ x).toReal ^ (1 - a) ∂μ := by + refine integral_congr_ae ?_ + filter_upwards [Measure.rnDeriv_eq_div (ξ := μ + ν) + (Measure.AbsolutelyContinuous.rfl.add_right' μ) + (Measure.AbsolutelyContinuous.rfl.add_right ν)] with x hx + simp only [hx, Pi.div_apply, p, q] + +/-- For `a ∈ [0, 1)`, the integral of `(∂μ/∂(μ + ν)) ^ a * (∂ν/∂(μ + ν)) ^ (1 - a)` with respect to +the dominating measure `μ + ν` is `∫⁻ (∂μ/∂ν) ^ a ∂ν`. -/ +lemma lintegral_rpow_rnDeriv_add_mul_rpow_rnDeriv_add [SigmaFinite μ] [SigmaFinite ν] + (ha0 : 0 ≤ a) (ha1 : a < 1) : + ∫⁻ x, (μ.rnDeriv (μ + ν) x) ^ a * (ν.rnDeriv (μ + ν) x) ^ (1 - a) ∂(μ + ν) + = ∫⁻ x, (μ.rnDeriv ν x) ^ a ∂ν := by + have hμ : μ ≪ μ + ν := Measure.AbsolutelyContinuous.rfl.add_right ν + have hν : ν ≪ μ + ν := Measure.AbsolutelyContinuous.rfl.add_right' μ + calc ∫⁻ x, (μ.rnDeriv (μ + ν) x) ^ a * (ν.rnDeriv (μ + ν) x) ^ (1 - a) ∂(μ + ν) + _ = ∫⁻ x, ν.rnDeriv (μ + ν) x * (μ.rnDeriv (μ + ν) x / ν.rnDeriv (μ + ν) x) ^ a ∂(μ + ν) := by + refine lintegral_congr_ae ?_ + filter_upwards [Measure.rnDeriv_lt_top ν (μ + ν)] with x hq_top + rcases eq_or_ne (ν.rnDeriv (μ + ν) x) 0 with hq | hq + · simp [hq, ENNReal.zero_rpow_of_pos (sub_pos.mpr ha1)] + rw [ENNReal.div_rpow_of_nonneg _ _ ha0, ENNReal.rpow_sub _ _ hq hq_top.ne, + ENNReal.rpow_one, ← mul_div_assoc, mul_comm, mul_div_assoc] + _ = ∫⁻ x, (μ.rnDeriv (μ + ν) x / ν.rnDeriv (μ + ν) x) ^ a ∂ν := + lintegral_rnDeriv_mul hν (by fun_prop) + _ = ∫⁻ x, (μ.rnDeriv ν x) ^ a ∂ν := by + refine lintegral_congr_ae ?_ + filter_upwards [Measure.rnDeriv_eq_div hμ hν] with x hx + rw [← hx] + +lemma integrable_rpow_rnDeriv_iff [SigmaFinite ν] [SigmaFinite μ] (hμν : μ ≪ ν) (ha : 0 < a) : + Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ a) μ + ↔ Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ (1 + a)) ν := by + rw [← integrable_rnDeriv_smul_iff hμν] + refine integrable_congr ?_ + filter_upwards [μ.rnDeriv_ne_top ν] with x hx + simp only [smul_eq_mul] + by_cases h_zero : μ.rnDeriv ν x = 0 + · simp only [h_zero, ENNReal.toReal_zero, zero_mul] + rw [zero_rpow] + linarith + · rw [rpow_add (ENNReal.toReal_pos h_zero hx), rpow_one] + +lemma integrable_rpow_rnDeriv_of_lt_one (ha_nonneg : 0 ≤ a) (ha : a < 1) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] : + Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ a) ν := by + rw [← integrable_neg_iff] + have h_cvx : ConvexOn ℝ (Ici 0) (fun y : ℝ ↦ -y ^ a) := (concaveOn_rpow ha_nonneg ha.le).neg + refine integrable_f_rnDeriv_of_derivAtTop_ne_top (f := fun y ↦ -y ^ a) μ ν h_cvx ?_ + -- the right derivative `-a * x ^ (a - 1)` tends to `0` + have h_eq : (fun x ↦ derivWithin (fun y : ℝ ↦ -y ^ a) (Ioi x) x) + =ᶠ[atTop] fun x ↦ -(a * x ^ (a - 1)) := by + filter_upwards [eventually_ne_atTop 0] with x hx + exact (Real.hasDerivAt_rpow_const (Or.inl hx)).neg.hasDerivWithinAt.derivWithin + (uniqueDiffWithinAt_Ioi x) + have h_lim : Tendsto (fun x : ℝ ↦ -(a * x ^ (a - 1))) atTop (𝓝 0) := by + have : (fun (x : ℝ) ↦ x ^ (a - 1)) = (fun x ↦ x ^ (-(1 - a))) := by ext x; simp + simpa [this] using ((tendsto_rpow_neg_atTop (by linarith : 0 < 1 - a)).const_mul a).neg + rw [(h_cvx.subset Ioi_subset_Ici_self (convex_Ioi 0)).derivAtTop_eq_of_tendsto_rightDeriv + ((tendsto_congr' h_eq).mpr h_lim)] + simp + +lemma integral_rpow_rnDeriv_nonneg : 0 ≤ ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν := by + apply integral_nonneg + intro x + simp only [Pi.zero_apply, ENNReal.toReal_nonneg, rpow_nonneg] + +lemma integral_fun_rnDeriv_eq_zero_iff_mutuallySingular [SigmaFinite μ] [SigmaFinite ν] + {f : ℝ≥0∞ → ℝ} (hf_nonneg : ∀ x, 0 ≤ f x) (hf_zero : ∀ x, f x = 0 ↔ x = 0 ∨ x = ⊤) + (h_int : Integrable (f ∘ μ.rnDeriv ν) ν) : + ∫ x, f (μ.rnDeriv ν x) ∂ν = 0 ↔ μ ⟂ₘ ν := by + rw [← Measure.rnDeriv_eq_zero, integral_eq_zero_iff_of_nonneg (fun _ ↦ hf_nonneg _) h_int] + apply Filter.eventually_congr + filter_upwards [μ.rnDeriv_ne_top ν] with x hx + simp only [Pi.zero_apply, hf_zero, hx, or_false] + +lemma integral_rpow_rnDeriv_eq_zero_iff_mutuallySingular [SigmaFinite μ] [SigmaFinite ν] + (ha_zero : a ≠ 0) (h_int : Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ a) ν) : + ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν = 0 ↔ μ ⟂ₘ ν := by + have h_nonneg : ∀ (x : ℝ≥0∞), 0 ≤ x.toReal ^ a := by + intro x + simp only [ENNReal.toReal_nonneg, rpow_nonneg] + refine integral_fun_rnDeriv_eq_zero_iff_mutuallySingular h_nonneg (fun x ↦ ?_) h_int + rw [rpow_eq_zero ENNReal.toReal_nonneg ha_zero, ENNReal.toReal_eq_zero_iff] + +lemma integral_rpow_rnDeriv_pos_iff_not_mutuallySingular [SigmaFinite μ] [SigmaFinite ν] + (ha_zero : a ≠ 0) (h_int : Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ a) ν) : + 0 < ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν ↔ ¬ μ ⟂ₘ ν := by + rw [← integral_rpow_rnDeriv_eq_zero_iff_mutuallySingular ha_zero h_int] + push Not + exact ⟨fun h ↦ h.ne', fun h ↦ integral_rpow_rnDeriv_nonneg.lt_of_ne' h⟩ + +lemma integral_rpow_rnDeriv_smul_left [SigmaFinite μ] [SigmaFinite ν] (c : ℝ≥0) : + ∫ x, ((c • μ).rnDeriv ν x).toReal ^ a ∂ν = c ^ a * ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν := by + rw [← integral_const_mul] + refine integral_congr_ae ?_ + filter_upwards [Measure.rnDeriv_smul_left' μ ν c] with x hx + rw [← mul_rpow NNReal.zero_le_coe ENNReal.toReal_nonneg, hx, Pi.smul_apply, ENNReal.toReal_smul] + rfl + +lemma integral_rpow_rnDeriv_smul_right [SigmaFinite μ] [SigmaFinite ν] (c : ℝ≥0) + (ha : c = 0 → a ≠ 1) : + ∫ x, (μ.rnDeriv (c • ν) x).toReal ^ a ∂(c • ν) + = c ^ (1 - a) * ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν := by + by_cases hc : c = 0 + · simp [hc, zero_rpow <| sub_ne_zero_of_ne (ha hc).symm] + rw [integral_smul_nnreal_measure, ← integral_const_mul, NNReal.smul_def, ← integral_smul] + refine integral_congr_ae ?_ + filter_upwards [Measure.rnDeriv_smul_right' μ ν hc] with x hx + rw [hx, Pi.smul_apply, ENNReal.toReal_smul, smul_eq_mul, NNReal.smul_def, smul_eq_mul, + mul_rpow NNReal.zero_le_coe ENNReal.toReal_nonneg, NNReal.coe_inv, inv_rpow NNReal.zero_le_coe, + ← mul_assoc, mul_eq_mul_right_iff] + left + rw [rpow_sub, rpow_one, div_eq_mul_inv] + exact NNReal.coe_pos.mpr <| pos_iff_ne_zero.mpr hc + +lemma integral_rpow_rnDeriv_eq_integral_rpow_sub_one (ha_pos : 0 < a) (ha_ne : a ≠ 1) + [SigmaFinite μ] [SigmaFinite ν] (h_ac : μ ≪ ν) : + ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν = ∫ x, (μ.rnDeriv ν x).toReal ^ (a - 1) ∂μ := by + rw [integral_rpow_rnDeriv_symm ha_pos ha_ne] + refine integral_congr_ae ?_ + filter_upwards [Measure.inv_rnDeriv h_ac] with x hx + rw [← hx, Pi.inv_apply, ENNReal.toReal_inv, inv_rpow ENNReal.toReal_nonneg, + ← rpow_neg ENNReal.toReal_nonneg, neg_sub] + +lemma integral_rpow_rnDeriv_smul_left' [SigmaFinite μ] [SigmaFinite ν] {c : ℝ≥0∞} (hc : c ≠ ∞) : + ∫ x, ((c • μ).rnDeriv ν x).toReal ^ a ∂ν + = c.toReal ^ a * ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν := by + lift c to ℝ≥0 using hc + rw [← ENNReal.smul_def, ENNReal.coe_toReal] + exact integral_rpow_rnDeriv_smul_left c + +lemma integral_rpow_rnDeriv_smul_right' [SigmaFinite μ] [SigmaFinite ν] {c : ℝ≥0∞} (hc : c ≠ ∞) + (ha : c = 0 → a ≠ 1) : + ∫ x, (μ.rnDeriv (c • ν) x).toReal ^ a ∂(c • ν) + = c.toReal ^ (1 - a) * ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν := by + lift c to ℝ≥0 using hc + rw [← ENNReal.smul_def, ENNReal.coe_toReal] + exact integral_rpow_rnDeriv_smul_right c fun h ↦ ha (by simp [h]) + +/-- `∫ (∂μ/∂ν)^a ∂ν` is `μ(univ)^a * ν(univ)^(1 - a)` times its value for the normalized +measures. -/ +lemma integral_rpow_rnDeriv_eq_mul_integral_rpow_rnDeriv_inv_smul (ha_ne : a ≠ 1) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] [NeZero μ] [NeZero ν] : + ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν + = (μ .univ).toReal ^ a * (ν .univ).toReal ^ (1 - a) + * ∫ x, (((μ .univ)⁻¹ • μ).rnDeriv ((ν .univ)⁻¹ • ν) x).toReal ^ a ∂((ν .univ)⁻¹ • ν) := by + have hm : 0 < (μ .univ).toReal := ENNReal.toReal_pos (NeZero.ne _) (measure_ne_top _ _) + have hn : 0 < (ν .univ).toReal := ENNReal.toReal_pos (NeZero.ne _) (measure_ne_top _ _) + rw [integral_rpow_rnDeriv_smul_right' (ENNReal.inv_ne_top.mpr (NeZero.ne _)) (fun _ ↦ ha_ne), + integral_rpow_rnDeriv_smul_left' (ENNReal.inv_ne_top.mpr (NeZero.ne _)), + ENNReal.toReal_inv, ENNReal.toReal_inv, inv_rpow hn.le, inv_rpow hm.le] + have h1 : (μ .univ).toReal ^ a ≠ 0 := (rpow_pos_of_pos hm a).ne' + have h2 : (ν .univ).toReal ^ (1 - a) ≠ 0 := (rpow_pos_of_pos hn _).ne' + field_simp + +/-- Slope of `a ↦ x ^ a` between `a` and `1` is bounded by `2 + x * |log x|`, for `a ∈ [1/2, 1)`. -/ +lemma abs_mul_rpow_sub_le {x : ℝ} (hx : 0 ≤ x) (ha : 2⁻¹ ≤ a) (ha1 : a < 1) : + |(a - 1)⁻¹ * (x ^ a - x)| ≤ 2 + x * |log x| := by + rcases hx.eq_or_lt with rfl | hx_pos + · rw [zero_rpow (by linarith), sub_zero, mul_zero, abs_zero, zero_mul, add_zero] + norm_num + obtain ⟨c, hc, hc_eq⟩ := exists_hasDerivAt_eq_slope (fun t ↦ x ^ t) (fun t ↦ x ^ t * log x) ha1 + (continuous_iff_continuousAt.2 fun t ↦ Real.continuousAt_const_rpow hx_pos.ne').continuousOn + (fun t _ ↦ (Real.hasStrictDerivAt_const_rpow hx_pos t).hasDerivAt) + have h_eq : (a - 1)⁻¹ * (x ^ a - x) = x ^ c * log x := by + rw [hc_eq, rpow_one] + have : a - 1 ≠ 0 := sub_ne_zero.mpr ha1.ne + have : 1 - a ≠ 0 := sub_ne_zero.mpr ha1.ne' + field_simp + ring + rw [h_eq, abs_mul, abs_of_nonneg (rpow_nonneg hx c)] + have h0 : 0 ≤ x * |log x| := by positivity + rcases le_or_gt 1 x with hx1 | hx1 + · calc x ^ c * |log x| ≤ x * |log x| := by + gcongr + calc x ^ c ≤ x ^ (1 : ℝ) := rpow_le_rpow_of_exponent_le hx1 hc.2.le + _ = x := rpow_one x + _ ≤ 2 + x * |log x| := by linarith + · have h1 : x ^ c ≤ x ^ (2⁻¹ : ℝ) := + rpow_le_rpow_of_exponent_ge hx_pos hx1.le (by linarith [hc.1]) + have h2 : x ^ (2⁻¹ : ℝ) * |log x| < 2 := by + have := abs_log_mul_self_lt (x ^ (2⁻¹ : ℝ)) (rpow_pos_of_pos hx_pos _) + (rpow_le_one hx hx1.le (by norm_num)) + rw [log_rpow hx_pos, abs_mul, abs_mul, abs_of_pos (by norm_num : (0:ℝ) < 2⁻¹), + abs_of_nonneg (rpow_nonneg hx _)] at this + calc x ^ (2⁻¹ : ℝ) * |log x| = 2 * (2⁻¹ * |log x| * x ^ (2⁻¹ : ℝ)) := by ring + _ < 2 * 1 := by gcongr + _ = 2 := by ring + calc x ^ c * |log x| ≤ x ^ (2⁻¹ : ℝ) * |log x| := by gcongr + _ ≤ 2 := h2.le + _ ≤ 2 + x * |log x| := by linarith + +lemma tendsto_integral_rpow_rnDeriv_sub_div [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hμν : μ ≪ ν) + (h_int : Integrable (llr μ ν) μ) : + Tendsto (fun a ↦ (a - 1)⁻¹ * (∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν - (μ .univ).toReal)) (𝓝[<] 1) + (𝓝 (∫ x, llr μ ν x ∂μ)) := by + have h_int' : Integrable (fun x ↦ (μ.rnDeriv ν x).toReal * |log (μ.rnDeriv ν x).toReal|) ν := by + have := (integrable_rnDeriv_smul_iff hμν).mpr h_int.abs + simpa [llr_def, smul_eq_mul] using this + have hL : ∫ x, llr μ ν x ∂μ = ∫ x, (μ.rnDeriv ν x).toReal * log (μ.rnDeriv ν x).toReal ∂ν := by + rw [← integral_rnDeriv_smul hμν] + simp [llr_def] + rw [hL] + have h_ev : ∀ᶠ a in 𝓝[<] (1:ℝ), a ∈ Set.Ico 2⁻¹ 1 := Ico_mem_nhdsLT (by norm_num) + have h_eq : (fun a ↦ (a - 1)⁻¹ * (∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν - (μ .univ).toReal)) + =ᶠ[𝓝[<] (1:ℝ)] + fun a ↦ ∫ x, (a - 1)⁻¹ * ((μ.rnDeriv ν x).toReal ^ a - (μ.rnDeriv ν x).toReal) ∂ν := by + filter_upwards [h_ev] with a ha + rw [integral_const_mul, + integral_sub (integrable_rpow_rnDeriv_of_lt_one (by linarith [ha.1]) ha.2) + Measure.integrable_toReal_rnDeriv, Measure.integral_toReal_rnDeriv hμν, measureReal_def] + refine Tendsto.congr' h_eq.symm ?_ + refine tendsto_integral_filter_of_dominated_convergence + (fun x ↦ 2 + (μ.rnDeriv ν x).toReal * |log (μ.rnDeriv ν x).toReal|) ?_ ?_ ?_ ?_ + · exact Eventually.of_forall fun a ↦ (by fun_prop : Measurable _).aestronglyMeasurable + · filter_upwards [h_ev] with a ha + exact Eventually.of_forall fun x ↦ by + rw [Real.norm_eq_abs] + exact abs_mul_rpow_sub_le ENNReal.toReal_nonneg ha.1 ha.2 + · exact (integrable_const _).add h_int' + · refine Eventually.of_forall fun x ↦ ?_ + rcases (ENNReal.toReal_nonneg (a := μ.rnDeriv ν x)).eq_or_lt with h0 | h_pos + · rw [← h0] + simp only [Real.log_zero, mul_zero] + refine tendsto_const_nhds.congr' ?_ + filter_upwards [h_ev] with a ha + rw [zero_rpow (by linarith [ha.1]), sub_zero, mul_zero] + · have h := (Real.hasStrictDerivAt_const_rpow h_pos 1).hasDerivAt + rw [hasDerivAt_iff_tendsto_slope] at h + have h' := tendsto_nhdsWithin_mono_left + (fun a (ha : a ∈ Set.Iio (1:ℝ)) ↦ Set.mem_compl_singleton_iff.2 (ne_of_lt ha)) h + simp only [rpow_one] at h' + refine h'.congr fun a ↦ ?_ + rw [slope_def_field, rpow_one, div_eq_inv_mul] + +lemma tendsto_mul_log_integral_rpow_rnDeriv' [IsFiniteMeasure μ] [IsFiniteMeasure ν] [NeZero μ] + (hμν : μ ≪ ν) (h_int : Integrable (llr μ ν) μ) : + Tendsto (fun a ↦ (a - 1)⁻¹ * log (∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν) + - (a - 1)⁻¹ * (a * log (μ .univ).toReal + (1 - a) * log (ν .univ).toReal)) + (𝓝[<] 1) + (𝓝 ((μ .univ).toReal⁻¹ * ∫ x, llr μ ν x ∂μ + - log ((μ .univ).toReal / (ν .univ).toReal))) := by + have hm : (μ .univ).toReal ≠ 0 := by + rw [ENNReal.toReal_ne_zero] + exact ⟨NeZero.ne _, measure_ne_top _ _⟩ + have hn : (ν .univ).toReal ≠ 0 := by + rw [ENNReal.toReal_ne_zero] + refine ⟨fun h ↦ ?_, measure_ne_top _ _⟩ + have hν : ν = 0 := Measure.measure_univ_eq_zero.mp h + rw [hν, Measure.absolutelyContinuous_zero_iff] at hμν + exact NeZero.ne μ hμν + set φ : ℝ → ℝ := fun a ↦ ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν with hφ + have hφ1 : φ 1 = (μ .univ).toReal := by + simp [φ, Measure.integral_toReal_rnDeriv hμν, measureReal_def] + have hφ' : HasDerivWithinAt φ (∫ x, llr μ ν x ∂μ) (Set.Iio 1) 1 := by + rw [hasDerivWithinAt_iff_tendsto_slope' (s := Set.Iio (1 : ℝ)) (x := 1) (by simp)] + refine (tendsto_integral_rpow_rnDeriv_sub_div hμν h_int).congr fun a ↦ ?_ + rw [slope_def_field, div_eq_inv_mul, hφ1] + have hlog : HasDerivWithinAt (fun a ↦ log (φ a)) + ((μ .univ).toReal⁻¹ * ∫ x, llr μ ν x ∂μ) (Set.Iio 1) 1 := by + have := (Real.hasDerivAt_log (by rw [hφ1]; exact hm)).comp_hasDerivWithinAt 1 hφ' + rwa [hφ1] at this + rw [hasDerivWithinAt_iff_tendsto_slope' (s := Set.Iio (1 : ℝ)) (x := 1) (by simp)] at hlog + rw [Real.log_div hm hn] + refine (hlog.sub_const (log (μ .univ).toReal - log (ν .univ).toReal)).congr' ?_ + filter_upwards [self_mem_nhdsWithin] with a (ha : a < 1) + rw [slope_def_field, hφ1] + have : a - 1 ≠ 0 := sub_ne_zero.mpr ha.ne + field_simp + ring + +lemma tendsto_mul_log_integral_rpow_rnDeriv [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (hμν : μ ≪ ν) (h_int : Integrable (llr μ ν) μ) : + Tendsto (fun a ↦ (a - 1)⁻¹ * log (∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν)) (𝓝[<] 1) + (𝓝 (∫ x, llr μ ν x ∂μ)) := by + simpa using tendsto_mul_log_integral_rpow_rnDeriv' hμν h_int + +end MeasureTheory diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/RadonNikodym.lean b/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/RadonNikodym.lean new file mode 100644 index 0000000..e09ffab --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/RadonNikodym.lean @@ -0,0 +1,89 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.MeasureTheory.Measure.Decomposition.RadonNikodym + +/-! +# Radon-Nikodym derivatives and Lebesgue decomposition + +## Main statements + +* `MeasureTheory.Measure.singularPart_add_setLIntegral_rnDeriv`: + `μ.singularPart ν s + ∫⁻ x in s, ∂μ/∂ν x ∂ν = μ s` for a measurable set `s`. +* `MeasureTheory.Measure.rnDeriv_restrict_restrict`, + `MeasureTheory.Measure.singularPart_restrict_restrict`: Radon-Nikodym derivative and singular + part of `μ.restrict s` with respect to `ν.restrict s`. +* `MeasureTheory.Measure.rnDeriv_eq_inv_rnDeriv_of_ne_zero`: `∂ν/∂μ = (∂μ/∂ν)⁻¹`, `ν`-almost + everywhere on the set where `∂μ/∂ν ≠ 0`. +* `MeasureTheory.lintegral_eq_add_singularPart_withDensity`: decomposition of `∫⁻ x, g x ∂ν` along + the Lebesgue decomposition of `ν` with respect to `μ`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open scoped ENNReal + +namespace MeasureTheory.Measure + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} + +/-- The mass of a measurable set `s` under `μ` splits into the mass of the singular part of `μ` +with respect to `ν` and the integral of `∂μ/∂ν` over `s`. -/ +lemma singularPart_add_setLIntegral_rnDeriv (μ ν : Measure α) [μ.HaveLebesgueDecomposition ν] + {s : Set α} (hs : MeasurableSet s) : + μ.singularPart ν s + ∫⁻ x in s, μ.rnDeriv ν x ∂ν = μ s := by + conv_rhs => rw [μ.haveLebesgueDecomposition_add ν] + rw [add_apply, withDensity_apply _ hs] + +lemma singularPart_add_lintegral_rnDeriv (μ ν : Measure α) [μ.HaveLebesgueDecomposition ν] : + μ.singularPart ν Set.univ + ∫⁻ x, μ.rnDeriv ν x ∂ν = μ Set.univ := by + simpa using singularPart_add_setLIntegral_rnDeriv μ ν MeasurableSet.univ + +lemma rnDeriv_restrict_restrict (μ ν : Measure α) [SigmaFinite μ] [SigmaFinite ν] + {s : Set α} (hs : MeasurableSet s) : + (μ.restrict s).rnDeriv (ν.restrict s) =ᵐ[ν.restrict s] μ.rnDeriv ν := by + refine (eq_rnDeriv (s := (μ.singularPart ν).restrict s) (measurable_rnDeriv μ ν) + (((mutuallySingular_singularPart μ ν).restrict s).symm.restrict s).symm ?_).symm + conv_lhs => rw [μ.haveLebesgueDecomposition_add ν] + rw [restrict_add, restrict_withDensity hs] + +lemma singularPart_restrict_restrict (μ ν : Measure α) [SigmaFinite μ] [SigmaFinite ν] + {s : Set α} (hs : MeasurableSet s) : + (μ.restrict s).singularPart (ν.restrict s) = (μ.singularPart ν).restrict s := by + refine (eq_singularPart (measurable_rnDeriv μ ν) + (((mutuallySingular_singularPart μ ν).restrict s).symm.restrict s).symm ?_).symm + conv_lhs => rw [μ.haveLebesgueDecomposition_add ν] + rw [restrict_add, restrict_withDensity hs] + +/-- On the set where `∂μ/∂ν` does not vanish, `∂ν/∂μ` is its inverse, `ν`-almost everywhere. -/ +lemma rnDeriv_eq_inv_rnDeriv_of_ne_zero (μ ν : Measure α) [SigmaFinite μ] [SigmaFinite ν] : + ∀ᵐ x ∂ν, μ.rnDeriv ν x ≠ 0 → ν.rnDeriv μ x = (μ.rnDeriv ν x)⁻¹ := by + have h1 : ((ν.withDensity (μ.rnDeriv ν)).rnDeriv ν)⁻¹ + =ᵐ[ν.withDensity (μ.rnDeriv ν)] ν.rnDeriv (ν.withDensity (μ.rnDeriv ν)) := + inv_rnDeriv (withDensity_absolutelyContinuous ν (μ.rnDeriv ν)) + have h2 := rnDeriv_withDensity ν (measurable_rnDeriv μ ν) + have h3 : ν.rnDeriv μ + =ᵐ[ν.withDensity (μ.rnDeriv ν)] ν.rnDeriv (ν.withDensity (μ.rnDeriv ν)) := by + have := rnDeriv_add_right_of_mutuallySingular (μ := ν) (ν := ν.withDensity (μ.rnDeriv ν)) + (mutuallySingular_singularPart μ ν).symm.withDensity + rwa [add_comm, ← μ.haveLebesgueDecomposition_add ν] at this + rw [Filter.EventuallyEq, ae_withDensity_iff (measurable_rnDeriv _ _)] at h1 h3 + filter_upwards [h1, h2, h3] with x hx1 hx2 hx3 hx0 + rw [hx3 hx0, ← hx1 hx0, Pi.inv_apply, hx2] + +/-- Decomposition of `∫⁻ x, g x ∂ν` along the Lebesgue decomposition of `ν` with respect to `μ`. -/ +lemma _root_.MeasureTheory.lintegral_eq_add_singularPart_withDensity (μ ν : Measure α) + [ν.HaveLebesgueDecomposition μ] {g : α → ℝ≥0∞} (hg : Measurable g) : + ∫⁻ x, g x ∂ν = ∫⁻ x, g x ∂(ν.singularPart μ) + ∫⁻ x, ν.rnDeriv μ x * g x ∂μ := by + conv_lhs => rw [ν.haveLebesgueDecomposition_add μ] + rw [lintegral_add_measure, lintegral_withDensity_eq_lintegral_mul _ (measurable_rnDeriv _ _) hg] + rfl + +end MeasureTheory.Measure diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/ERealStieltjes.lean b/Statlib/ForMathlib/MeasureTheory/Measure/ERealStieltjes.lean new file mode 100644 index 0000000..5cfc39b --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Measure/ERealStieltjes.lean @@ -0,0 +1,1529 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne +-/ +module + +public import Mathlib.Topology.Order.LeftRightLim +public import Statlib.ForMathlib.EReal +public import Mathlib.MeasureTheory.Measure.Typeclasses.Probability +public import Mathlib.MeasureTheory.Measure.Dirac.Basic +public import Mathlib.MeasureTheory.Measure.WithDensity + +/-! +# Stieltjes measures on the real line + +Consider a function `f : ℝ → EReal` which is monotone and right-continuous. Then one can define a +corresponding measure, giving mass `f b - f a` to the interval `(a, b]`. + +## Main definitions + +* `ERealStieltjes` is a structure containing a function from `ℝ → EReal`, together with the +assertions that it is monotone and right-continuous. To `f : ERealStieltjes`, one associates +a Borel measure `f.measure`. +* `f.measure_Ioc` asserts that `f.measure (Ioc a b) = (f b - f a).toENNReal` +* `f.measure_Ioo` asserts that `f.measure (Ioo a b) = (leftLim f b - f a).toENNReal`. +* `f.measure_Icc` and `f.measure_Ico` are analogous. +* `measure_add`: `(f + g).measure` is `f.measure + g.measure` restricted to the region where + `f + g` is finite, together with the point where `f + g` jumps to `⊤`. +* `measure_smul`: `(c • f).measure = c • f.measure`. + +The construction follows Mathlib's `StieltjesFunction` (file +`Mathlib/MeasureTheory/Measure/Stieltjes.lean`, by Johannes Hölzl, Yury Kudryashov and Sébastien +Gouëzel), adapted to functions taking values in `EReal`. This file is adapted from the +testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +noncomputable section + +open Set Filter Function ENNReal NNReal Topology MeasureTheory + +/-! ### Basic properties of Stieltjes functions -/ + +/-- Bundled monotone right-continuous real functions, used to construct Stieltjes measures. -/ +structure ERealStieltjes where + /-- Bundled monotone right-continuous real functions, used to construct Stieltjes measures. -/ + toFun : ℝ → EReal + mono' : Monotone toFun + right_continuous' : ∀ x, ContinuousWithinAt toFun (Ici x) x + +namespace ERealStieltjes + +attribute [coe] toFun + +instance instCoeFun : CoeFun ERealStieltjes fun _ ↦ ℝ → EReal where + coe := toFun + +initialize_simps_projections ERealStieltjes (toFun → apply) + +@[ext] lemma ext {f g : ERealStieltjes} (h : ∀ x, f x = g x) : f = g := + (ERealStieltjes.mk.injEq ..).mpr (funext h) + +variable (f : ERealStieltjes) + +theorem mono : Monotone f := f.mono' + +theorem right_continuous (x : ℝ) : ContinuousWithinAt f (Ici x) x := f.right_continuous' x + +/-- If a function `f : ℝ → EReal` is monotone, then the function mapping `x` to the right limit of +`f` at `x` is an `ERealStieltjes` function, i.e., it is monotone and right-continuous. +This is the `EReal` analogue of `Monotone.stieltjesFunction`. -/ +noncomputable def _root_.Monotone.erealStieltjes {g : ℝ → EReal} (hg : Monotone g) : + ERealStieltjes where + toFun := Function.rightLim g + mono' := hg.rightLim + right_continuous' x := continuousWithinAt_rightLim_Ici (hg.tendsto_rightLim x) + +theorem _root_.Monotone.erealStieltjes_eq {g : ℝ → EReal} (hg : Monotone g) (x : ℝ) : + hg.erealStieltjes x = Function.rightLim g x := rfl + +theorem rightLim_eq (f : ERealStieltjes) (x : ℝ) : Function.rightLim f x = f x := by + rw [← f.mono.continuousWithinAt_Ioi_iff_rightLim_eq, continuousWithinAt_Ioi_iff_Ici] + exact f.right_continuous' x + +theorem iInf_Ioi_eq (f : ERealStieltjes) (x : ℝ) : ⨅ r : Ioi x, f r = f x := by + suffices Function.rightLim f x = ⨅ r : Ioi x, f r by rw [← this, f.rightLim_eq] + rw [f.mono.rightLim_eq_sInf, sInf_image'] + +/-- Constant functions are Stieltjes function. -/ +protected def const (c : EReal) : ERealStieltjes where + toFun := fun _ ↦ c + mono' _ _ := by simp + right_continuous' _ := continuousWithinAt_const + +@[simp] lemma const_apply (c : EReal) (x : ℝ) : ERealStieltjes.const c x = c := rfl + +instance : Zero ERealStieltjes where + zero := ERealStieltjes.const 0 + +@[simp] lemma zero_apply (x : ℝ) : (0 : ERealStieltjes) x = 0 := rfl + +instance : Inhabited ERealStieltjes where + default := 0 + +/-- The sum of two Stieltjes functions is a Stieltjes function. -/ +protected def add (f g : ERealStieltjes) : ERealStieltjes where + toFun := fun x => -(- f x - g x) -- to ensure right continuity + mono' x y hxy := by + rw [EReal.neg_le_neg_iff] + refine EReal.sub_le_sub ?_ (g.mono hxy) + rw [EReal.neg_le_neg_iff] + exact f.mono hxy + right_continuous' x := by + have hf := (f.right_continuous x).neg + have hg := (g.right_continuous x).neg + refine ContinuousWithinAt.neg ?_ + rw [ContinuousWithinAt] at hf hg ⊢ + simp_rw [sub_eq_add_neg] + by_cases hf_top : f x = ⊤ + · simp only [hf_top, EReal.neg_top, EReal.bot_add] + refine (tendsto_congr' ?_).mpr tendsto_const_nhds + refine eventually_nhdsWithin_of_forall fun y hy ↦ ?_ + have hfy : f y = ⊤ := eq_top_mono (f.mono hy) hf_top + simp [hfy] + by_cases hg_top : g x = ⊤ + · simp only [hg_top, EReal.neg_top, EReal.add_bot] + refine (tendsto_congr' ?_).mpr tendsto_const_nhds + refine eventually_nhdsWithin_of_forall fun y hy ↦ ?_ + have hgy : g y = ⊤ := eq_top_mono (g.mono hy) hg_top + simp [hgy] + have hf_bot : - f x ≠ ⊥ := by simp [hf_top] + have hg_bot : - g x ≠ ⊥ := by simp [hg_top] + have h_tendsto : ContinuousAt (fun (p : EReal × EReal) ↦ p.1 + p.2) (-f x, -g x) := + EReal.continuousAt_add (Or.inr hg_bot) (Or.inl hf_bot) + exact h_tendsto.tendsto.comp <| Tendsto.prodMk_nhds hf hg + +instance : Add ERealStieltjes where + add := ERealStieltjes.add + +lemma add_apply (f g : ERealStieltjes) (x : ℝ) : (f + g) x = - (-f x - g x) := rfl + +lemma add_apply_of_ne_top {f g : ERealStieltjes} {x : ℝ} (hfx : f x ≠ ⊤) (hgx : g x ≠ ⊤) : + (f + g) x = f x + g x := by + rw [add_apply, EReal.neg_sub (Or.inl _) (Or.inr hgx), neg_neg] + simp [hfx] + +lemma add_apply_of_eq_top_left {f g : ERealStieltjes} {x : ℝ} (hfx : f x = ⊤) : + (f + g) x = ⊤ := by + simp [add_apply, hfx] + +lemma add_apply_of_eq_top_right {f g : ERealStieltjes} {x : ℝ} (hgx : g x = ⊤) : + (f + g) x = ⊤ := by + simp [add_apply, hgx] + +lemma add_apply_eq_top_iff {f g : ERealStieltjes} {x : ℝ} : + (f + g) x = ⊤ ↔ f x = ⊤ ∨ g x = ⊤ := by + refine ⟨fun h ↦ ?_, fun h ↦ h.elim add_apply_of_eq_top_left add_apply_of_eq_top_right⟩ + by_contra! h' + rw [add_apply_of_ne_top h'.1 h'.2, EReal.add_eq_top_iff] at h + tauto + +lemma add_apply_ne_top_iff {f g : ERealStieltjes} {x : ℝ} : + (f + g) x ≠ ⊤ ↔ f x ≠ ⊤ ∧ g x ≠ ⊤ := by + rw [ne_eq, add_apply_eq_top_iff, not_or] + +lemma add_apply_ne_bot_iff {f g : ERealStieltjes} {x : ℝ} (h_top : (f + g) x ≠ ⊤) : + (f + g) x ≠ ⊥ ↔ f x ≠ ⊥ ∧ g x ≠ ⊥ := by + obtain ⟨hf, hg⟩ := add_apply_ne_top_iff.mp h_top + rw [add_apply_of_ne_top hf hg, ne_eq, EReal.add_eq_bot_iff, not_or] + +instance : AddZeroClass ERealStieltjes where + zero_add _ := by ext; simp [add_apply] + add_zero _ := by ext; simp [add_apply] + +instance : AddCommMonoid ERealStieltjes where + nsmul n f := nsmulRec n f + add_assoc f g h := ext fun x ↦ by + by_cases hfx : f x = ⊤ + · rw [add_apply_of_eq_top_left, add_apply_of_eq_top_left hfx] + rw [add_apply_of_eq_top_left hfx] + by_cases hgx : g x = ⊤ + · rw [add_apply_of_eq_top_left, add_apply_of_eq_top_right] + · rw [add_apply_of_eq_top_left hgx] + · rw [add_apply_of_eq_top_right hgx] + by_cases hhx : h x = ⊤ + · rw [add_apply_of_eq_top_right hhx, add_apply_of_eq_top_right] + rw [add_apply_of_eq_top_right hhx] + rw [add_apply_of_ne_top _ hhx, add_apply_of_ne_top hfx hgx, add_apply_of_ne_top hfx, + add_apply_of_ne_top hgx hhx, add_assoc] + · rw [add_apply_of_ne_top hgx hhx, ne_eq, EReal.add_eq_top_iff] + simp [hgx, hhx] + · rw [add_apply_of_ne_top hfx hgx, ne_eq, EReal.add_eq_top_iff] + simp [hfx, hgx] + add_comm f g := ext fun x ↦ by + by_cases hfx : f x = ⊤ + · rw [add_apply_of_eq_top_left hfx, add_apply_of_eq_top_right hfx] + by_cases hgx : g x = ⊤ + · rw [add_apply_of_eq_top_left hgx, add_apply_of_eq_top_right hgx] + rw [add_apply_of_ne_top hfx hgx, add_apply_of_ne_top hgx hfx, add_comm] + __ := ERealStieltjes.instAddZeroClass + +instance : SMul ℝ≥0 ERealStieltjes where + smul c f := { + toFun := fun x ↦ c * f x + mono' := by + refine f.mono.const_mul ?_ + norm_cast + exact zero_le + right_continuous' := fun x ↦ + (EReal.continuous_coe_mul _).continuousAt.comp_continuousWithinAt (f.right_continuous x)} + +@[simp] +lemma smul_apply (c : ℝ≥0) (f : ERealStieltjes) {x : ℝ} : (c • f) x = c * f x := rfl + +instance : Module ℝ≥0 ERealStieltjes where + smul c f := c • f + one_smul _ := ext fun _ ↦ one_mul _ + mul_smul a b f := ext fun x ↦ by + simp only [smul_apply, coe_mul, EReal.coe_ennreal_mul] + rw [mul_assoc] + smul_zero _ := ext fun _ ↦ mul_zero _ + smul_add c f g := ext fun x ↦ by + simp only [smul_apply, add_apply, mul_neg, neg_inj] + have : (c : EReal) = ((c : ℝ) : EReal) := rfl + simp_rw [this] + rw [sub_eq_add_neg, EReal.left_distrib_of_nonneg_of_ne_top (x := ((c : ℝ) : EReal))] + rotate_left + · exact EReal.coe_nonneg.mpr c.2 + · exact EReal.coe_ne_top _ + rw [mul_comm _ (f x), ← EReal.neg_mul, mul_comm] + congr 1 + rw [mul_comm _ (g x), ← EReal.neg_mul, mul_comm] + add_smul a b f := ext fun x ↦ by + by_cases ha0 : a = 0 + · simp [ha0, add_apply] + by_cases hfx : f x = ⊤ + · rw [smul_apply, hfx, add_apply_of_eq_top_left] + · have : ((a + b : ℝ≥0) : EReal) = ((a + b : ℝ) : EReal) := rfl + rw [this, EReal.coe_mul_top_of_pos] + positivity + · have : (a : EReal) = ((a : ℝ) : EReal) := rfl + rw [smul_apply, hfx, this, EReal.coe_mul_top_of_pos] + positivity + rw [add_apply_of_ne_top] + · simp only [smul_apply, coe_add, EReal.coe_ennreal_add] + have h_eq (a : ℝ≥0) : (a : EReal) = ((a : ℝ) : EReal) := rfl + rw [h_eq, h_eq, EReal.right_distrib_of_nonneg] + · exact EReal.coe_nonneg.mpr a.2 + · exact EReal.coe_nonneg.mpr b.2 + · have : (a : EReal) = ((a : ℝ) : EReal) := rfl + rw [smul_apply, this, EReal.mul_ne_top] + simp [hfx] + · have : (b : EReal) = ((b : ℝ) : EReal) := rfl + rw [smul_apply, this, EReal.mul_ne_top] + simp [hfx] + zero_smul _ := ext fun _ ↦ zero_mul _ + +theorem countable_leftLim_ne (f : ERealStieltjes) : Set.Countable { x | leftLim f x ≠ f x } := by + refine Countable.mono ?_ f.mono.countable_not_continuousAt + intro x hx h'x + apply hx + exact tendsto_nhds_unique (f.mono.tendsto_leftLim x) (h'x.tendsto.mono_left nhdsWithin_le_nhds) + +/-! ### The outer measure associated to a Stieltjes function -/ + +/-- Length of an interval. This is the largest monotone function which correctly measures all +intervals. -/ +def length (s : Set ℝ) : ℝ≥0∞ := + ⨅ (a) (b) (_ : s ⊆ Ioc a b), (f b - f a).toENNReal + +@[simp] +theorem length_empty : f.length ∅ = 0 := + nonpos_iff_eq_zero.1 <| iInf_le_of_le 0 <| iInf_le_of_le 0 <| by + simp only [lt_self_iff_false, not_false_eq_true, Ioc_eq_empty, subset_refl, iInf_pos, + nonpos_iff_eq_zero] + rw [EReal.toENNReal_eq_zero_iff] + exact EReal.sub_self_le_zero + +@[simp] +theorem length_Ioc (a b : ℝ) : f.length (Ioc a b) = (f b - f a).toENNReal := by + refine le_antisymm (iInf_le_of_le a <| iInf₂_le b Subset.rfl) + (le_iInf fun a' ↦ le_iInf fun b' ↦ le_iInf fun h ↦ ?_) + rcases le_or_gt b a with ab | ab + · rw [EReal.toENNReal_of_nonpos (EReal.sub_nonpos.mpr (f.mono ab))] + exact zero_le + refine EReal.toENNReal_le_toENNReal ?_ + obtain ⟨h₁, h₂⟩ := (Ioc_subset_Ioc_iff ab).1 h + exact EReal.sub_le_sub (f.mono h₁) (f.mono h₂) + +theorem length_mono {s₁ s₂ : Set ℝ} (h : s₁ ⊆ s₂) : f.length s₁ ≤ f.length s₂ := + iInf_mono fun _ ↦ biInf_mono fun _ ↦ h.trans + +lemma length_smul {c : ℝ≥0} (hc : c ≠ 0) (s : Set ℝ) : (c • f).length s = c * f.length s := by + simp_rw [length, ENNReal.mul_iInf_of_ne (ENNReal.coe_ne_zero.mpr hc) ENNReal.coe_ne_top, + smul_apply, EReal.toENNReal_coe_mul_sub ENNReal.coe_ne_top] + +open MeasureTheory + +open Classical in +/-- The Stieltjes outer measure associated to a Stieltjes function. -/ +protected def outer : OuterMeasure ℝ := + OuterMeasure.ofFunction f.length f.length_empty + +lemma outer_def : f.outer = OuterMeasure.ofFunction f.length f.length_empty := rfl + +theorem outer_le_length (s : Set ℝ) : f.outer s ≤ f.length s := + OuterMeasure.ofFunction_le _ + +lemma outer_mono {s t : Set ℝ} (hst : s ⊆ t) : f.outer s ≤ f.outer t := measure_mono hst + +/-- If a compact interval `[a, b]` is covered by a union of open interval `(c i, d i)`, then +`f b - f a ≤ ∑ f (d i) - f (c i)`. This is an auxiliary technical statement to prove the same +statement for half-open intervals, the point of the current statement being that one can use +compactness to reduce it to a finite sum, and argue by induction on the size of the covering set. -/ +theorem length_subadditive_Icc_Ioo {a b : ℝ} {c d : ℕ → ℝ} (ss : Icc a b ⊆ ⋃ i, Ioo (c i) (d i)) : + (f b - f a).toENNReal ≤ ∑' i, (f (d i) - f (c i)).toENNReal := by + suffices + ∀ (s : Finset ℕ) (b), Icc a b ⊆ (⋃ i ∈ (s : Set ℕ), Ioo (c i) (d i)) → + (f b - f a).toENNReal ≤ ∑ i ∈ s, (f (d i) - f (c i)).toENNReal by + rcases isCompact_Icc.elim_finite_subcover_image + (fun (i : ℕ) (_ : i ∈ univ) => @isOpen_Ioo _ _ _ _ (c i) (d i)) (by simpa using ss) with + ⟨s, _, hf, hs⟩ + have e : ⋃ i ∈ (hf.toFinset : Set ℕ), Ioo (c i) (d i) = ⋃ i ∈ s, Ioo (c i) (d i) := by + simp only [Finset.set_biUnion_coe, Finite.mem_toFinset] + rw [ENNReal.tsum_eq_iSup_sum] + refine le_trans ?_ (le_iSup _ hf.toFinset) + exact this hf.toFinset _ (by simpa only [e] ) + clear ss b + refine fun s => Finset.strongInductionOn s fun s IH b cv => ?_ + rcases le_total b a with ab | ab + · rw [EReal.toENNReal_of_nonpos (EReal.sub_nonpos.2 (f.mono ab))] + exact zero_le + have := cv ⟨ab, le_rfl⟩ + simp only [Finset.mem_coe, mem_iUnion, mem_Ioo, exists_and_left, exists_prop] at this + rcases this with ⟨i, cb, is, bd⟩ + rw [← Finset.insert_erase is] at cv ⊢ + rw [Finset.coe_insert, biUnion_insert] at cv + rw [Finset.sum_insert (Finset.notMem_erase _ _)] + refine le_trans ?_ (add_le_add_right (IH _ (Finset.erase_ssubset is) (c i) ?_) _) + · refine (EReal.toENNReal_sub_le_add _ _ (f (c i))).trans ?_ + gcongr + exact EReal.toENNReal_le_toENNReal (EReal.sub_le_sub (f.mono bd.le) le_rfl) + · rintro x ⟨h₁, h₂⟩ + exact (cv ⟨h₁, le_trans h₂ (le_of_lt cb)⟩).resolve_left (mt And.left (not_lt_of_ge h₂)) + +lemma continuousWithinAt_sub_const_Ici {c : EReal} {a : ℝ} (h_bot : f a ≠ ⊥ ∨ c ≠ ⊥) : + ContinuousWithinAt (fun x ↦ f x - c) (Ici a) a := + (EReal.continuousAt_sub_const h_bot).comp_continuousWithinAt (f.right_continuous a) + +lemma continuousWithinAt_const_sub_Ici {c : EReal} {a : ℝ} (h_bot : f a ≠ ⊤ ∨ c ≠ ⊤) : + ContinuousWithinAt (fun x ↦ c - f x) (Ici a) a := + (EReal.continuousAt_const_sub h_bot).comp_continuousWithinAt (f.right_continuous a) + +lemma continuousWithinAt_sub_const_Ioi {c : EReal} {a : ℝ} (h_bot : f a ≠ ⊥ ∨ c ≠ ⊥) : + ContinuousWithinAt (fun x ↦ f x - c) (Ioi a) a := + (f.continuousWithinAt_sub_const_Ici h_bot).mono Ioi_subset_Ici_self + +theorem outer_Ioc_of_ne_bot (a b : ℝ) (ha : f a ≠ ⊥) : + f.outer (Ioc a b) = (f b - f a).toENNReal := by + /- It suffices to show that, if `(a, b]` is covered by sets `s i`, then `f b - f a` is bounded + by `∑ f.length (s i) + ε`. The difficulty is that `f.length` is expressed in terms of half-open + intervals, while we would like to have a compact interval covered by open intervals to use + compactness and finite sums, as provided by `length_subadditive_Icc_Ioo`. The trick is to use + the right-continuity of `f`. If `a'` is close enough to `a` on its right, then `[a', b]` is + still covered by the sets `s i` and moreover `f b - f a'` is very close to `f b - f a` + (up to `ε/2`). + Also, by definition one can cover `s i` by a half-closed interval `(p i, q i]` with `f`-length + very close to that of `s i` (within a suitably small `ε' i`, say). If one moves `q i` very + slightly to the right, then the `f`-length will change very little by right continuity, and we + will get an open interval `(p i, q' i)` covering `s i` with `f (q' i) - f (p i)` within `ε' i` + of the `f`-length of `s i`. -/ + refine le_antisymm ((f.length_Ioc _ _).symm ▸ outer_le_length _ _) ?_ + refine le_iInf₂ fun s' hs' ↦ ENNReal.le_of_forall_pos_le_add fun ε εpos h' ↦ ?_ + -- We ensure that `f x ≥ f a > ⊥` for all points in the sets `s i` + let s : ℕ → Set ℝ := fun i ↦ s' i ∩ Ioc a b + have hsab i : s i ⊆ Ioc a b := inter_subset_right + have hs : Ioc a b = ⋃ i, s i := by + rw [← iUnion_inter] + simp [hs'] + have h : ∑' i, f.length (s i) < ⊤ := by + refine (ENNReal.tsum_le_tsum fun n ↦ ?_).trans_lt h' + exact f.length_mono inter_subset_left + suffices (f b - f a).toENNReal ≤ ∑' i, f.length (s i) + ε by + refine this.trans ?_ + gcongr with i + exact f.length_mono inter_subset_left + -- we can w.l.o.g. assume that `f a ≠ ⊤` + by_cases ha_top : f a = ⊤ + · simp [sub_eq_add_neg, ha_top] + -- main case + let δ := ε / 2 + have δpos : 0 < (δ : ℝ≥0∞) := by simpa [δ] using εpos.ne' + rcases ENNReal.exists_pos_sum_of_countable δpos.ne' ℕ with ⟨ε', ε'0, hε⟩ + obtain ⟨a', ha', aa'⟩ : ∃ a', f a' - f a < δ ∧ a < a' := by + have A : ContinuousWithinAt (fun r ↦ f r - f a) (Ioi a) a := by + refine f.continuousWithinAt_sub_const_Ioi (.inl ha) + have B : f a - f a < δ := by + rw [EReal.sub_self ha_top ha] + exact mod_cast δpos + exact (((tendsto_order.1 A).2 _ B).and self_mem_nhdsWithin).exists + have : ∀ i, ∃ p : ℝ × ℝ, s i ⊆ Ioo p.1 p.2 + ∧ (f p.2 - f p.1).toENNReal < f.length (s i) + ε' i := by + intro i + have hl := + ENNReal.lt_add_right ((ENNReal.le_tsum i).trans_lt h).ne (ENNReal.coe_ne_zero.2 (ε'0 i).ne') + conv at hl => + lhs + rw [length] + simp only [iInf_lt_iff, exists_prop] at hl + rcases hl with ⟨p, q', spq, hq'⟩ + have hqa (h : q' ≤ a) : s i = ∅ := by + have : s i ⊆ Ioc p q' ∩ Ioc a b := by simp [spq, hsab] + rw [← subset_empty_iff] + refine this.trans (subset_empty_iff.mpr ?_) + rw [Ioc_inter_Ioc, Ioc_eq_empty] + simp [h] + classical + let p'' := if s i = ∅ then a else p + let q'' := if s i = ∅ then a else q' + have hq''a : a ≤ q'' := by + unfold q'' + split_ifs with h_empty + · simp + · have h : ¬q' ≤ a := hqa.mt h_empty + exact (not_le.mp h).le + have spq'' : s i ⊆ Ioc p'' q'' := by + unfold q'' p'' + split_ifs with h_empty <;> simp [h_empty, spq] + have hq'' : (f q'' - f p'').toENNReal < f.length (s i) + ↑(ε' i) := by + unfold p'' q'' + split_ifs with h_empty + · rw [EReal.sub_self ha_top ha] + simp only [ne_eq, EReal.zero_ne_top, not_false_eq_true, EReal.toENNReal_of_ne_top, + EReal.toReal_zero, ofReal_zero, add_pos_iff, ENNReal.coe_pos] + exact .inr (ε'0 i) + · exact hq' + have : ContinuousWithinAt (fun r => (f r - f p'').toENNReal) (Ioi q'') q'' := by + refine EReal.continuous_toENNReal.continuousAt.comp_continuousWithinAt ?_ + refine f.continuousWithinAt_sub_const_Ioi ?_ + exact .inl <| ne_of_gt (ha.bot_lt.trans_le (f.mono hq''a)) + rcases (((tendsto_order.1 this).2 _ hq'').and self_mem_nhdsWithin).exists with ⟨q, hq, q'q⟩ + exact ⟨⟨p'', q⟩, spq''.trans (Ioc_subset_Ioo_right q'q), hq⟩ + choose g hg using this + have I_subset : Icc a' b ⊆ ⋃ i, Ioo (g i).1 (g i).2 := + calc + Icc a' b ⊆ Ioc a b := fun x hx => ⟨aa'.trans_le hx.1, hx.2⟩ + _ = ⋃ i, s i := hs + _ ⊆ ⋃ i, Ioo (g i).1 (g i).2 := iUnion_mono fun i => (hg i).1 + calc + (f b - f a).toENNReal ≤ (f b - f a').toENNReal + (f a' - f a).toENNReal := + EReal.toENNReal_sub_le_add _ _ _ + _ ≤ ∑' i, (f (g i).2 - f (g i).1).toENNReal + ENNReal.ofReal δ := by + refine (add_le_add (f.length_subadditive_Icc_Ioo I_subset) ?_) + exact EReal.toENNReal_le_toENNReal ha'.le + _ ≤ ∑' i, (f.length (s i) + ε' i) + δ := + (add_le_add (ENNReal.tsum_le_tsum fun i => (hg i).2.le) + (by simp only [ENNReal.ofReal_coe_nnreal, le_rfl])) + _ = ∑' i, f.length (s i) + ∑' i, (ε' i : ℝ≥0∞) + δ := by rw [ENNReal.tsum_add] + _ ≤ ∑' i, f.length (s i) + δ + δ := add_le_add (add_le_add le_rfl hε.le) le_rfl + _ = ∑' i : ℕ, f.length (s i) + ε := by simp [δ, add_assoc, ENNReal.add_halves] + +theorem outer_Ioc_of_eq_bot (a b : ℝ) (hb : f b = ⊥) : f.outer (Ioc a b) = 0 := by + refine le_antisymm ?_ zero_le + suffices f.outer (Ioc a b) ≤ (f b - f a).toENNReal by simpa [hb] using this + exact (f.length_Ioc _ _).symm ▸ outer_le_length _ _ + +lemma iSup_le_outer_Ioc (a b : ℝ) : + ⨆ c, ⨆ (_ : a < c), f.outer (Ioc c b) ≤ f.outer (Ioc a b) := + iSup₂_le fun _ hc ↦ f.outer_mono (Ioc_subset_Ioc hc.le le_rfl) + +private lemma outer_Ioc_eq_top_aux1 {a b : ℝ} (ha : f a = ⊥) (ha' : ∀ x, a < x → f x ≠ ⊥) + (hab : a < b) : + f.outer (Ioc a b) = ∞ := by + refine eq_top_iff.mpr (le_trans ?_ (iSup_le_outer_Ioc _ _ _)) + have h_outer {b c} (hac : a < c) : f.outer (Ioc c b) = (f b - f c).toENNReal := by + rw [outer_Ioc_of_ne_bot _ _ _ (ha' c hac)] + have : ⨆ (c : ℝ) (_ : a < c), f.outer (Ioc c b) + = ⨆ (c : ℝ) (_ : a < c), (f b - f c).toENNReal := by + congr with c + congr with hc + rw [h_outer hc] + rw [this] + obtain ⟨c, _, hc_gt, hc_tendsto⟩ := exists_seq_strictAnti_tendsto' hab + have h_tendsto : Tendsto (fun n ↦ (f b - f (c n)).toENNReal) atTop (𝓝 ⊤) := by + have hc_tendsto' : Tendsto c atTop (𝓝[≥] a) := by + rw [tendsto_nhdsWithin_iff] + exact ⟨hc_tendsto, .of_forall fun n ↦ (hc_gt n).1.le⟩ + have h'' := continuousWithinAt_const_sub_Ici f (c := f b) (a := a) ?_ + swap; · simp [ha] + have h := h''.tendsto.comp hc_tendsto' + have h_eq_top : f b - f a = ⊤ := by + rw [ha, sub_eq_add_neg, EReal.neg_bot, EReal.add_top_of_ne_bot (ha' b hab)] + rw [h_eq_top] at h + refine (EReal.continuous_toENNReal.tendsto _).comp h + simp only [top_le_iff] + refine eq_top_of_forall_nnreal_le fun r ↦ ?_ + simp_rw [ENNReal.tendsto_nhds_top_iff_nnreal, eventually_atTop] at h_tendsto + obtain ⟨n, hn⟩ := h_tendsto r + refine (hn n le_rfl).le.trans ?_ + exact le_iSup₂ (f := fun c _ ↦ (f b - f c).toENNReal) (c n) (hc_gt n).1 + +lemma outer_singleton_eq_top' {b : ℝ} (hb : ∀ a < b, f b - f a = ∞) : + f.outer {b} = ∞ := by + rw [outer_def, OuterMeasure.ofFunction_apply] + simp only [iInf_eq_top] + intro s hs + refine ENNReal.tsum_eq_top_of_eq_top ?_ + simp_rw [length] + simp only [iInf_eq_top, EReal.toENNReal_eq_top_iff] + obtain ⟨n, hn⟩ : ∃ n, b ∈ s n := by + rw [← mem_iUnion] + exact hs (mem_singleton _) + refine ⟨n, fun i j h_subset ↦ ?_⟩ + have hbij : b ∈ Ioc i j := h_subset hn + refine eq_top_mono ?_ (hb i hbij.1) + refine EReal.sub_le_sub (f.mono hbij.2) le_rfl + +lemma outer_singleton_eq_top {b : ℝ} (hb : f b - leftLim f b = ∞) : + f.outer {b} = ∞ := by + refine outer_singleton_eq_top' f fun a ha ↦ ?_ + exact eq_top_mono (EReal.sub_le_sub le_rfl (f.mono.le_leftLim ha)) hb + +private lemma outer_singleton_aux {b : ℝ} (ha' : ∀ x < b, f x = ⊥) (hb : f b ≠ ⊥) : + f.outer {b} = ∞ := by + refine outer_singleton_eq_top f ?_ + have : leftLim f b = ⊥ := by + refine leftLim_eq_of_tendsto ?_ + refine (tendsto_congr' ?_).mpr tendsto_const_nhds + rw [EventuallyEq, eventually_nhdsWithin_iff] + exact .of_forall ha' + rw [this, sub_eq_add_neg, EReal.neg_bot, EReal.add_top_of_ne_bot hb] + simp + +private lemma outer_Ioc_eq_top_aux2 {a b : ℝ} (ha' : ∀ x < b, f x = ⊥) (hb : f b ≠ ⊥) + (hab : a < b) : + f.outer (Ioc a b) = ∞ := + eq_top_mono (f.outer_mono (singleton_subset_iff.mpr ⟨hab, le_rfl⟩)) (outer_singleton_aux f ha' hb) + +@[simp] +theorem outer_Ioc (a b : ℝ) : f.outer (Ioc a b) = (f b - f a).toENNReal := by + by_cases ha_bot : f a = ⊥ + swap; · exact outer_Ioc_of_ne_bot f a b ha_bot + simp only [ha_bot, sub_eq_add_neg, EReal.neg_bot] + by_cases hb : f b = ⊥ + · simp [hb, outer_Ioc_of_eq_bot] + rw [EReal.add_top_of_ne_bot hb, EReal.toENNReal_top] + let a' := sSup {x | f x = ⊥} + have hb_gt x (hx : f x = ⊥) : x < b := by + have hxb : f x < f b := by + rw [hx, bot_lt_iff_ne_bot] + exact hb + by_contra h_not + exact not_le.mpr hxb (f.mono (not_lt.mp h_not)) + have ha'_lt x (hx : x < a') : f x = ⊥ := by + obtain ⟨x', hx'_eq : f x' = ⊥, hxx'⟩ := exists_lt_of_lt_csSup ⟨a, ha_bot⟩ hx + exact eq_bot_mono (f.mono hxx'.le) hx'_eq + have ha'_gt x (hx : a' < x) : f x ≠ ⊥ := by + intro h_bot + refine not_le.mpr hx ?_ + exact le_csSup ⟨b, fun x hx ↦ (hb_gt x hx).le⟩ h_bot + have haa' : a ≤ a' := le_csSup ⟨b, fun x hx ↦ (hb_gt x hx).le⟩ ha_bot + by_cases hfa' : f a' = ⊥ + · suffices f.outer (Ioc a' b) = ∞ from + eq_top_mono (f.outer_mono (Ioc_subset_Ioc haa' le_rfl)) this + exact outer_Ioc_eq_top_aux1 f hfa' ha'_gt (hb_gt a' hfa') + · suffices f.outer (Ioc a a') = ∞ by + refine eq_top_mono ?_ this + refine f.outer_mono (Ioc_subset_Ioc le_rfl ?_) + refine csSup_le ⟨a, ha_bot⟩ fun x hx ↦ (hb_gt x hx).le + refine outer_Ioc_eq_top_aux2 f ha'_lt hfa' ?_ + exact lt_of_le_of_ne haa' fun h_eq ↦ (h_eq ▸ hfa') ha_bot + +theorem measurableSet_Ioi (c : ℝ) : MeasurableSet[f.outer.caratheodory] (Ioi c) := by + refine OuterMeasure.ofFunction_caratheodory fun t => ?_ + refine le_iInf fun a => le_iInf fun b => le_iInf fun h => ?_ + refine + le_trans + (add_le_add (f.length_mono <| inter_subset_inter_left _ h) + (f.length_mono <| sdiff_subset_sdiff_left h)) ?_ + rcases le_total a c with hac | hac <;> rcases le_total b c with hbc | hbc + · simp only [Ioc_inter_Ioi, f.length_Ioc, hac, hbc, le_refl, Ioc_eq_empty, + max_eq_right, min_eq_left, Ioc_sdiff_Ioi, f.length_empty, zero_add, not_lt] + · simp only [Ioc_inter_Ioi, hac, sup_of_le_right, length_Ioc, Ioc_sdiff_Ioi, hbc, min_eq_right] + rw [EReal.toENNReal_sub_add_cancel (f.mono hac) (f.mono hbc)] + · simp only [hbc, le_refl, Ioc_eq_empty, Ioc_inter_Ioi, min_eq_left, Ioc_sdiff_Ioi, + f.length_empty, zero_add, or_true, le_sup_iff, f.length_Ioc, not_lt] + · simp only [hac, hbc, Ioc_inter_Ioi, Ioc_sdiff_Ioi, f.length_Ioc, min_eq_right, + le_refl, Ioc_eq_empty, add_zero, max_eq_left, f.length_empty, not_lt] + +theorem outer_trim : f.outer.trim = f.outer := by + refine le_antisymm (fun s => ?_) (OuterMeasure.le_trim _) + rw [OuterMeasure.trim_eq_iInf] + refine le_iInf fun t => le_iInf fun ht => ENNReal.le_of_forall_pos_le_add fun ε ε0 h => ?_ + rcases ENNReal.exists_pos_sum_of_countable (ENNReal.coe_pos.2 ε0).ne' ℕ with ⟨ε', ε'0, hε⟩ + refine le_trans ?_ (add_le_add_right (le_of_lt hε) _) + rw [← ENNReal.tsum_add] + choose g hg using + show ∀ i, ∃ s, t i ⊆ s ∧ MeasurableSet s + ∧ f.outer s ≤ f.length (t i) + ENNReal.ofReal (ε' i) by + intro i + have hl := + ENNReal.lt_add_right ((ENNReal.le_tsum i).trans_lt h).ne (ENNReal.coe_pos.2 (ε'0 i)).ne' + conv at hl => + lhs + rw [length] + simp only [iInf_lt_iff] at hl + rcases hl with ⟨a, b, h₁, h₂⟩ + rw [← f.outer_Ioc] at h₂ + exact ⟨_, h₁, measurableSet_Ioc, le_of_lt <| by simpa using h₂⟩ + simp only [ofReal_coe_nnreal] at hg + apply iInf_le_of_le (iUnion g) _ + apply iInf_le_of_le (ht.trans <| iUnion_mono fun i => (hg i).1) _ + apply iInf_le_of_le (MeasurableSet.iUnion fun i => (hg i).2.1) _ + exact le_trans (measure_iUnion_le _) (ENNReal.tsum_le_tsum fun i => (hg i).2.2) + +theorem borel_le_measurable : borel ℝ ≤ f.outer.caratheodory := by + rw [borel_eq_generateFrom_Ioi] + refine MeasurableSpace.generateFrom_le ?_ + rintro _ ⟨c, rfl⟩ + exact f.measurableSet_Ioi c + +/-! ### The measure associated to a Stieltjes function -/ + +/-- The measure associated to a Stieltjes function, giving mass `f b - f a` to the +interval `(a, b]`. -/ +protected irreducible_def measure : Measure ℝ where + toOuterMeasure := f.outer + m_iUnion _s hs := f.outer.iUnion_eq_of_caratheodory fun i ↦ f.borel_le_measurable _ (hs i) + trim_le := f.outer_trim.le + +lemma toOuterMeasure_measure : f.measure.toOuterMeasure = f.outer := by + rw [ERealStieltjes.measure] + +@[simp] +theorem measure_Ioc (a b : ℝ) : f.measure (Ioc a b) = (f b - f a).toENNReal := by + rw [ERealStieltjes.measure] + exact f.outer_Ioc a b + +lemma measure_Ioc_ne_top {a b : ℝ} (ha : f a ≠ ⊥) (hb : f b ≠ ⊤) : f.measure (Ioc a b) ≠ ∞ := by + simp [measure_Ioc, sub_eq_add_neg, EReal.add_eq_top_iff, ha, hb] + +lemma antitone_toENNReal_const_sub (a : ℝ) : + Antitone (fun x ↦ (f a - f x).toENNReal) := + fun _ _ hxy ↦ EReal.toENNReal_le_toENNReal (EReal.sub_le_sub le_rfl (f.mono hxy)) + +lemma leftLim_toENNReal_sub_left (a b : ℝ) : + leftLim (fun x ↦ (f x - f a).toENNReal) b = (leftLim f b - f a).toENNReal := by + rcases le_or_gt a b with (_ | hab) + swap + · refine leftLim_eq_of_tendsto ?_ + refine (tendsto_congr' ?_).mpr tendsto_const_nhds + have : ∀ᶠ x in 𝓝[<] b, x < a := by + refine eventually_nhdsWithin_iff.mpr ?_ + filter_upwards [eventually_lt_nhds hab] with x hx _ using hx + filter_upwards [this] with x hx + rw [EReal.toENNReal_of_nonpos, EReal.toENNReal_of_nonpos] + · rw [EReal.sub_nonpos] + exact f.mono.leftLim_le hab.le + · rw [EReal.sub_nonpos] + exact f.mono hx.le + by_cases hfa : f a = ⊥ + · simp only [hfa, sub_eq_add_neg, EReal.neg_bot] + by_cases h_lim : leftLim f b = ⊥ + · simp only [h_lim, EReal.bot_add, ne_eq, bot_ne_top, not_false_eq_true, + EReal.toENNReal_of_ne_top, EReal.toReal_bot, ofReal_zero] + have h_lt x (hxb : x < b) : f x = ⊥ := eq_bot_mono (f.mono.le_leftLim hxb) h_lim + refine leftLim_eq_of_tendsto ?_ + refine (tendsto_congr' ?_).mpr tendsto_const_nhds + refine eventually_nhdsWithin_of_forall fun x hx ↦ ?_ + simp [h_lt x hx] + · rw [EReal.add_top_of_ne_bot h_lim, EReal.toENNReal_top] + refine leftLim_eq_of_tendsto ?_ + refine (tendsto_congr' ?_).mpr tendsto_const_nhds + obtain ⟨x, hxb, hx⟩ : ∃ x < b, f x ≠ ⊥ := by + by_contra! h_bot + refine h_lim ?_ + refine leftLim_eq_of_tendsto ?_ + refine (tendsto_congr' ?_).mpr tendsto_const_nhds + exact eventually_nhdsWithin_of_forall h_bot + have : ∀ᶠ y in 𝓝[<] b, x < y := by + refine eventually_nhdsWithin_iff.mpr ?_ + filter_upwards [eventually_gt_nhds hxb] with y hy _ using hy + filter_upwards [this] with y hy + rw [EReal.toENNReal_eq_top_iff, EReal.add_top_of_ne_bot] + exact fun h_bot ↦ hx (eq_bot_mono (f.mono hy.le) h_bot) + refine leftLim_eq_of_tendsto ?_ + have h1 := EReal.continuous_toENNReal.tendsto (leftLim f b - f a) + have h2 := EReal.continuousAt_sub_const (c := f a) (x := leftLim f b) (Or.inr hfa) + exact h1.comp <| h2.tendsto.comp <| f.mono.tendsto_leftLim _ + +lemma leftLim_toENNReal_sub_right (a : ℝ) (c : EReal) + (h : c = ⊤ → leftLim f a = ⊤ → ∃ x < a, f x = ⊤) : + leftLim (fun x ↦ (c - f x).toENNReal) a = (c - leftLim f a).toENNReal := by + rcases le_or_gt (leftLim f a) c with (hab | hab) + swap + · refine leftLim_eq_of_tendsto ?_ + refine (tendsto_congr' ?_).mpr tendsto_const_nhds + have : ∀ᶠ x in 𝓝[<] a, c < f x := + Filter.Tendsto.eventually_const_lt hab (f.mono.tendsto_leftLim _) + filter_upwards [this] with x hx + rw [EReal.toENNReal_of_nonpos, EReal.toENNReal_of_nonpos] + · rw [EReal.sub_nonpos] + exact hab.le + · rw [EReal.sub_nonpos] + exact hx.le + have h1 := EReal.continuous_toENNReal.tendsto (c - leftLim f a) + have h2 := EReal.continuousAt_const_sub (c := c) (x := leftLim f a) + by_cases hfb : c = ⊤ + swap + · refine leftLim_eq_of_tendsto ?_ + refine h1.comp ?_ + refine (h2 (Or.inr hfb)).tendsto.comp ?_ + exact f.mono.tendsto_leftLim _ + specialize h hfb + by_cases h_lim : leftLim f a = ⊤ + swap + · refine leftLim_eq_of_tendsto ?_ + refine h1.comp ?_ + refine (h2 (Or.inl h_lim)).tendsto.comp ?_ + exact f.mono.tendsto_leftLim _ + specialize h h_lim + obtain ⟨x, hx⟩ := h + have hfa_lim : leftLim f a = ⊤ := eq_top_mono (f.mono.le_leftLim hx.1) hx.2 + have hfb : c = ⊤ := eq_top_mono hab hfa_lim + simp only [hfb, hfa_lim, EReal.sub_top, ne_eq, bot_ne_top, not_false_eq_true, + EReal.toENNReal_of_ne_top, EReal.toReal_bot, ofReal_zero] + refine leftLim_eq_of_tendsto ?_ + refine (tendsto_congr' ?_).mpr tendsto_const_nhds + have : ∀ᶠ y in 𝓝[<] a, x < y := by + refine eventually_nhdsWithin_iff.mpr ?_ + filter_upwards [eventually_gt_nhds hx.1] with x hx _ using hx + filter_upwards [this] with y hy + rw [EReal.toENNReal_eq_zero_iff, EReal.sub_nonpos, ← eq_top_iff] + refine eq_top_mono (f.mono hy.le) hx.2 + +-- This is different from `(f a - leftLim f a).toENNReal` iff `f a = ⊤`, `leftLim f a = ⊤` but +-- `∀ x < a, f x < ⊤`. +@[simp] +theorem measure_singleton (a : ℝ) : + f.measure {a} = leftLim (fun x ↦ (f a - f x).toENNReal) a := by + by_cases h_top : ∀ x < a, f a - f x = ⊤ + · rw [← Measure.coe_toOuterMeasure, toOuterMeasure_measure] + rw [outer_singleton_eq_top'] + · symm + refine leftLim_eq_of_tendsto ?_ + refine (tendsto_congr' ?_).mpr tendsto_const_nhds + refine eventually_nhdsWithin_of_forall fun x hx ↦ ?_ + simp [h_top x hx] + · convert h_top + simp + obtain ⟨u, u_mono, u_lt_a, u_lim⟩ : + ∃ u : ℕ → ℝ, StrictMono u ∧ (∀ n : ℕ, u n < a) ∧ Tendsto u atTop (𝓝 a) := + exists_seq_strictMono_tendsto a + have h_anti : Antitone (fun x ↦ (f a - f x).toENNReal) := antitone_toENNReal_const_sub f a + have hu_tendsto_sub : Tendsto (fun n ↦ (f a - f (u n)).toENNReal) atTop + (𝓝 (leftLim (fun x ↦ (f a - f x).toENNReal) a)) := by + have h_ll := h_anti.tendsto_leftLim a + have u_lim' : Tendsto u atTop (𝓝[<] a) := by + rw [tendsto_nhdsWithin_iff] + exact ⟨u_lim, .of_forall u_lt_a⟩ + exact h_ll.comp u_lim' + have A : {a} = ⋂ n, Ioc (u n) a := by + refine Subset.antisymm (fun x hx ↦ by simp [mem_singleton_iff.1 hx, u_lt_a]) fun x hx ↦ ?_ + simp? at hx says simp only [mem_iInter, mem_Ioc] at hx + have : a ≤ x := le_of_tendsto' u_lim fun n ↦ (hx n).1.le + simp [le_antisymm this (hx 0).2] + have L1 : Tendsto (fun n ↦ f.measure (Ioc (u n) a)) atTop (𝓝 (f.measure {a})) := by + rw [A] + refine tendsto_measure_iInter_atTop (fun n ↦ nullMeasurableSet_Ioc) (fun m n hmn ↦ ?_) ?_ + · exact Ioc_subset_Ioc_left (u_mono.monotone hmn) + · simp_rw [measure_Ioc, ne_eq, EReal.toENNReal_eq_top_iff] + by_contra! h + simp only [h, EReal.toENNReal_top, tendsto_const_nhds_iff] at hu_tendsto_sub + refine h_top fun x hx ↦ ?_ + suffices (f a - f x).toENNReal = ⊤ by rwa [EReal.toENNReal_eq_top_iff] at this + refine eq_top_mono ?_ hu_tendsto_sub.symm + exact h_anti.leftLim_le hx + have L2 : Tendsto (fun n ↦ f.measure (Ioc (u n) a)) atTop + (𝓝 (leftLim (fun x ↦ (f a - f x).toENNReal) a)) := by + simp only [measure_Ioc] + exact hu_tendsto_sub + exact tendsto_nhds_unique L1 L2 + +lemma measure_singleton_eq_top {x : ℝ} (h : ∀ y < x, f x - f y = ⊤) : f.measure {x} = ∞ := by + rw [measure_singleton] + refine leftLim_eq_of_tendsto ((tendsto_congr' ?_).mpr tendsto_const_nhds) + exact eventually_nhdsWithin_of_forall fun y hy ↦ by simp [h y hy] + +-- This is different from `(f b - leftLim f a).toENNReal` iff `f b = ⊤`, `leftLim f a = ⊤` but +-- `∀ x < a, f x < ⊤`. +@[simp] +theorem measure_Icc (a b : ℝ) : + f.measure (Icc a b) = leftLim (fun x ↦ (f b - f x).toENNReal) a := by + rcases le_or_gt a b with (hab | hab) + · have A : Disjoint {a} (Ioc a b) := by simp + simp only [← Icc_union_Ioc_eq_Icc le_rfl hab, Icc_self, measure_union A measurableSet_Ioc, + measure_singleton, measure_Ioc] + rw [add_comm] + calc (f b - f a).toENNReal + leftLim (fun x ↦ (f a - f x).toENNReal) a + _ = leftLim (fun x ↦ (f b - f a).toENNReal + (f a - f x).toENNReal) a := by + symm + refine leftLim_eq_of_tendsto ?_ + refine Tendsto.const_add _ ?_ + exact (antitone_toENNReal_const_sub f a).tendsto_leftLim _ + _ = leftLim (fun x ↦ (f b - f x).toENNReal) a := by + refine leftLim_eq_of_tendsto ?_ + have h := (antitone_toENNReal_const_sub f b).tendsto_leftLim a + refine (tendsto_congr' ?_).mpr h + refine eventually_nhdsWithin_of_forall fun x hx ↦ ?_ + simp only + rw [EReal.toENNReal_sub_add_cancel] + · exact f.mono hx.le + · exact f.mono hab + · simp only [hab, measure_empty, Icc_eq_empty, not_le] + symm + refine leftLim_eq_of_tendsto ?_ + refine (tendsto_congr' ?_).mpr tendsto_const_nhds + have : ∀ᶠ x in 𝓝[<] a, b < x := by + refine eventually_nhdsWithin_iff.mpr ?_ + filter_upwards [eventually_gt_nhds hab] with x hx _ using hx + filter_upwards [this] with x hx + rw [EReal.toENNReal_eq_zero_iff, EReal.sub_nonpos] + exact f.mono hx.le + +@[simp] +theorem measure_Ioo {a b : ℝ} : + f.measure (Ioo a b) = (leftLim f b - f a).toENNReal := by + rw [← leftLim_toENNReal_sub_left] + rcases le_or_gt b a with (hab | hab) + · simp only [not_lt, hab, Ioo_eq_empty, measure_empty] + symm + refine leftLim_eq_of_tendsto ?_ + refine (tendsto_congr' ?_).mpr tendsto_const_nhds + refine eventually_nhdsWithin_of_forall fun x hx ↦ ?_ + simp only + rw [EReal.toENNReal_eq_zero_iff, EReal.sub_nonpos] + exact f.mono (hx.le.trans hab) + · obtain ⟨c, hc_mono, hc_mem, hc_tendsto⟩ := exists_seq_strictMono_tendsto' hab + have h_iUnion : Ioo a b = ⋃ i, Ioc a (c i) := by + ext x + simp only [mem_Ioo, mem_iUnion, mem_Ioc, exists_and_left, and_congr_right_iff] + refine fun _ ↦ ⟨fun h ↦ ?_, fun h ↦ ?_⟩ + · exact (Filter.Tendsto.eventually_const_le h hc_tendsto).exists + · obtain ⟨n, hn⟩ := h + exact hn.trans_lt (hc_mem _).2 + have h_mono : Monotone fun x ↦ (f x - f a).toENNReal := + fun _ _ hxy ↦ EReal.toENNReal_le_toENNReal (EReal.sub_le_sub (f.mono hxy) le_rfl) + rw [h_iUnion, Monotone.measure_iUnion] + · simp only [measure_Ioc] + rw [Monotone.leftLim_eq_sSup h_mono] + apply le_antisymm + · refine iSup_le fun n ↦ ?_ + refine le_sSup ?_ + simp only [mem_image, mem_Iio] + exact ⟨c n, (hc_mem _).2, rfl⟩ + · refine sSup_le fun y hy ↦ ?_ + simp only [mem_image, mem_Iio] at hy + obtain ⟨x, hx_lt, rfl⟩ := hy + have : ∀ᶠ i in atTop, x < c i := Filter.Tendsto.eventually_const_lt hx_lt hc_tendsto + obtain ⟨n, hn⟩ := this.exists + exact le_iSup_of_le n (h_mono hn.le) + · intro i j hij x + simp only [mem_Ioc, and_imp] + intro hax hxc + exact ⟨hax, hxc.trans (hc_mono.monotone hij)⟩ + +theorem measure_Ico_of_lt {a b : ℝ} (hab : a < b) : + f.measure (Ico a b) + = leftLim (fun x ↦ (f a - f x).toENNReal) a + (leftLim f b - f a).toENNReal := by + have A : Disjoint {a} (Ioo a b) := by simp + simp only [← Icc_union_Ioo_eq_Ico le_rfl hab, Icc_self, measure_union A measurableSet_Ioo, + measure_singleton, measure_Ioo] + +lemma measure_Ico_of_lt_of_eq_top {a b : ℝ} (hab : a < b) + (h : f a = ⊤ → leftLim f a = ⊤ → ∃ x < a, f x = ⊤) : + f.measure (Ico a b) = (leftLim f b - leftLim f a).toENNReal := by + rw [measure_Ico_of_lt _ hab, leftLim_toENNReal_sub_right f _ _ h, add_comm, + EReal.toENNReal_sub_add_cancel (f.mono.leftLim_le le_rfl) (f.mono.le_leftLim hab)] + +lemma measure_Ico_of_ge {a b : ℝ} (hab : b ≤ a) : f.measure (Ico a b) = 0 := by simp [hab] + +lemma measure_Ico_of_eq_top {a : ℝ} + (h : f a = ⊤ → leftLim f a = ⊤ → ∃ x < a, f x = ⊤) (b : ℝ) : + f.measure (Ico a b) = (leftLim f b - leftLim f a).toENNReal := by + rcases le_or_gt b a with (hab | hab) + · symm + rw [measure_Ico_of_ge f hab, EReal.toENNReal_eq_zero_iff, EReal.sub_nonpos] + exact f.mono.leftLim hab + · rw [measure_Ico_of_lt_of_eq_top _ hab h] + +theorem measure_Iic {l : EReal} (hf : Tendsto f atBot (𝓝 l)) (x : ℝ) : + f.measure (Iic x) = (f x - l).toENNReal := by + refine tendsto_nhds_unique (tendsto_measure_Ioc_atBot _ _) ?_ + simp_rw [measure_Ioc] + by_cases h_top : l = ⊤ + · have : f = ERealStieltjes.const ⊤ := by + ext x + simp only [const_apply] + have h := f.mono.le_of_tendsto hf + simp only [h_top, top_le_iff] at h + exact h x + simp [this, h_top] + · have h1 := EReal.continuous_toENNReal.tendsto (f x - l) + have h2 := EReal.continuousAt_const_sub (c := f x) (x := l) (Or.inl h_top) + exact h1.comp (h2.tendsto.comp hf) + +theorem measure_Ici {l : EReal} (hf : Tendsto f atTop (𝓝 l)) (x : ℝ) : + f.measure (Ici x) = leftLim (fun z ↦ (f x - f z).toENNReal) x + (l - f x).toENNReal := by + refine tendsto_nhds_unique (tendsto_measure_Ico_atTop _ _) ?_ + have h_Ico : ∀ᶠ y in atTop, f.measure (Ico x y) + = leftLim (fun z ↦ (f x - f z).toENNReal) x + (leftLim f y - f x).toENNReal := by + filter_upwards [eventually_gt_atTop x] with y hy + rw [measure_Ico_of_lt _ hy] + rw [tendsto_congr' h_Ico] + refine Tendsto.add tendsto_const_nhds ?_ + by_cases h_bot : l = ⊥ + · have : f = ERealStieltjes.const ⊥ := by + ext x + simp only [const_apply] + have h := f.mono.ge_of_tendsto hf + simp only [h_bot, le_bot_iff] at h + exact h x + have h_lim x : leftLim (ERealStieltjes.const ⊥) x = ⊥ := by + refine eq_bot_mono ?_ (rfl : ERealStieltjes.const ⊥ x = ⊥) + exact (ERealStieltjes.const ⊥).mono.leftLim_le le_rfl + simp [this, h_bot, h_lim] + · have h1 := EReal.continuous_toENNReal.tendsto (l - f x) + refine h1.comp ?_ + have h2 := EReal.continuousAt_sub_const (c := f x) (x := l) (Or.inl h_bot) + refine h2.tendsto.comp ?_ + refine tendsto_of_tendsto_of_tendsto_of_le_of_le (g := fun x ↦ f (x - 1)) ?_ hf ?_ ?_ + · refine hf.comp ?_ + exact tendsto_atTop_add_const_right atTop (-1) fun _ a ↦ a + · refine fun x ↦ f.mono.le_leftLim ?_ + linarith + · exact fun x ↦ f.mono.leftLim_le le_rfl + +lemma measure_Ici_of_eq_top {l : EReal} (hf : Tendsto f atTop (𝓝 l)) {x : ℝ} + (h : f x = ⊤ → leftLim f x = ⊤ → ∃ y < x, f y = ⊤) : + f.measure (Ici x) = (l - leftLim f x).toENNReal := by + rw [measure_Ici f hf, leftLim_toENNReal_sub_right f _ _ h, add_comm, + EReal.toENNReal_sub_add_cancel (f.mono.leftLim_le le_rfl) (f.mono.ge_of_tendsto hf x)] + +lemma measure_Iio {l : EReal} (hf : Tendsto f atBot (𝓝 l)) (x : ℝ) : + f.measure (Iio x) = leftLim (fun y ↦ (f y - l).toENNReal) x := by + obtain ⟨c, hc_mono, hc_mem, hc_tendsto⟩ := exists_seq_strictMono_tendsto x + have h_iUnion : Iio x = ⋃ i, Iic (c i) := by + ext x + simp only [mem_Iio, mem_iUnion, mem_Iic] + refine ⟨fun h ↦ ?_, fun h ↦ ?_⟩ + · exact (Filter.Tendsto.eventually_const_le h hc_tendsto).exists + · obtain ⟨n, hn⟩ := h + exact hn.trans_lt (hc_mem _) + have h_mono : Monotone fun x ↦ (f x - l).toENNReal := + fun _ _ hxy ↦ EReal.toENNReal_le_toENNReal (EReal.sub_le_sub (f.mono hxy) le_rfl) + rw [h_iUnion, Monotone.measure_iUnion] + swap; · exact monotone_Iic.comp hc_mono.monotone + simp only [measure_Iic f hf] + rw [Monotone.leftLim_eq_sSup h_mono] + apply le_antisymm + · refine iSup_le fun n ↦ ?_ + refine le_sSup ?_ + simp only [mem_image, mem_Iio] + exact ⟨c n, hc_mem _, rfl⟩ + · refine sSup_le fun y hy ↦ ?_ + simp only [mem_image, mem_Iio] at hy + obtain ⟨x, hx_lt, rfl⟩ := hy + have : ∀ᶠ i in atTop, x < c i := Filter.Tendsto.eventually_const_lt hx_lt hc_tendsto + obtain ⟨n, hn⟩ := this.exists + exact le_iSup_of_le n (h_mono hn.le) + +theorem measure_univ {l u : EReal} (hfl : Tendsto f atBot (𝓝 l)) (hfu : Tendsto f atTop (𝓝 u)) : + f.measure univ = (u - l).toENNReal := by + refine tendsto_nhds_unique (tendsto_measure_Iic_atTop _) ?_ + simp_rw [measure_Iic f hfl] + by_cases h_top : l = ⊤ + · have : f = ERealStieltjes.const ⊤ := by + ext x + simp only [const_apply] + have h := f.mono.le_of_tendsto hfl + simp only [h_top, top_le_iff] at h + exact h x + simp [this, h_top] + by_cases h_bot : u = ⊥ + · have : f = ERealStieltjes.const ⊥ := by + ext x + simp only [const_apply] + have h := f.mono.ge_of_tendsto hfu + simp only [h_bot, le_bot_iff] at h + exact h x + simp [this, h_bot] + · have h1 := EReal.continuous_toENNReal.tendsto (u - l) + have h2 := EReal.continuousAt_sub_const (c := l) (x := u) (Or.inl h_bot) + refine h1.comp <| h2.tendsto.comp hfu + +@[simp] +lemma measure_const (c : EReal) : (ERealStieltjes.const c).measure = 0 := by + rw [← Measure.measure_univ_eq_zero, measure_univ (l := c) (u := c)] + · induction c <;> simp + · exact tendsto_const_nhds + · exact tendsto_const_nhds + +lemma measure_Ioi {l : EReal} (hf : Tendsto f atTop (𝓝 l)) (x : ℝ) : + f.measure (Ioi x) = (l - f x).toENNReal := by + by_cases h_bot : l = ⊥ + · have : f = ERealStieltjes.const ⊥ := by + ext x + simp only [const_apply] + have h := f.mono.ge_of_tendsto hf + simp only [h_bot, le_bot_iff] at h + exact h x + simp [this, h_bot] + obtain ⟨c, hc_mono, hc_tendsto⟩ := exists_seq_monotone_tendsto_atTop_atTop ℝ + have h_iUnion : Ioi x = ⋃ i, Ioo x (c i) := by + ext y + simp only [mem_Ioi, mem_iUnion, mem_Ioo, exists_and_left, iff_self_and] + refine fun h ↦ ?_ + rw [tendsto_atTop_atTop] at hc_tendsto + obtain ⟨n, hn⟩ := hc_tendsto (y+1) + exact ⟨n, (lt_add_one y).trans_le (hn n le_rfl)⟩ + rw [h_iUnion, Monotone.measure_iUnion] + swap + · intro i j hij y + simp only [mem_Ioo, and_imp] + exact fun hxy hxi ↦ ⟨hxy, hxi.trans_le (hc_mono hij)⟩ + simp only [measure_Ioo f] + have h_tendsto : Tendsto (fun y ↦ (leftLim f y - f x).toENNReal) atTop + (𝓝 (l - f x).toENNReal) := by + have h1 := EReal.continuous_toENNReal.tendsto (l - f x) + refine h1.comp ?_ + have h2 := EReal.continuousAt_sub_const (c := f x) (x := l) (Or.inl h_bot) + refine h2.tendsto.comp ?_ + refine tendsto_of_tendsto_of_tendsto_of_le_of_le (g := fun x ↦ f (x - 1)) ?_ hf ?_ ?_ + · refine hf.comp ?_ + exact tendsto_atTop_add_const_right atTop (-1) fun _ a ↦ a + · refine fun x ↦ f.mono.le_leftLim ?_ + linarith + · exact fun x ↦ f.mono.leftLim_le le_rfl + rw [iSup_eq_of_tendsto] + · exact fun _ _ hxy ↦ EReal.toENNReal_le_toENNReal + (EReal.sub_le_sub (f.mono.leftLim (hc_mono hxy)) le_rfl) + · exact h_tendsto.comp hc_tendsto + +lemma measure_Ioi_of_tendsto_atTop_atTop (hf : Tendsto f atTop atTop) (x : ℝ) : + f.measure (Ioi x) = (⊤ - f x).toENNReal := by + have hf' : Tendsto f atTop (𝓝 ⊤) := by + simp_rw [EReal.tendsto_nhds_top_iff_real, eventually_atTop] + rw [tendsto_atTop_atTop] at hf + intro x + obtain ⟨y, hy⟩ := hf (x + 1) + refine ⟨y, fun z hz ↦ lt_of_lt_of_le ?_ (hy z hz)⟩ + exact mod_cast (lt_add_one x) + rw [measure_Ioi f hf'] + +@[simp] +lemma measure_zero : (0 : ERealStieltjes).measure = 0 := measure_const 0 + +lemma measure_smul (c : ℝ≥0) : (c • f).measure = c • f.measure := by + rcases eq_or_ne c 0 with rfl | hc + · rw [zero_smul, zero_smul, measure_zero] + refine Measure.toOuterMeasure_injective ?_ + rw [Measure.smul_toOuterMeasure, toOuterMeasure_measure, toOuterMeasure_measure, + ENNReal.smul_def] + rw [outer_def, outer_def, OuterMeasure.smul_ofFunction ENNReal.coe_ne_top] + congr 1 + ext s + exact length_smul f hc s + +section SFinite + +lemma measure_Ioc_eq_zero_of_eq_bot {a b : ℝ} (ha : f a = ⊥) (hb : f b = ⊥) : + f.measure (Ioc a b) = 0 := by + rw [measure_Ioc, hb, ha, EReal.bot_sub, EReal.toENNReal_bot] + +lemma measure_Ioc_eq_zero_of_eq_top {a b : ℝ} (ha : f a = ⊤) (hb : f b = ⊤) : + f.measure (Ioc a b) = 0 := by + rw [measure_Ioc, hb, ha, EReal.sub_top, EReal.toENNReal_bot] + +lemma iUnion_Ioc_neg_nat_nat : ⋃ n : ℕ, Ioc (-(n : ℝ)) n = univ := by + refine eq_univ_of_forall fun x ↦ mem_iUnion.mpr ?_ + obtain ⟨n, hn⟩ := exists_nat_gt |x| + exact ⟨n, by linarith [neg_abs_le x], by linarith [le_abs_self x]⟩ + +lemma measure_eq_zero_of_forall_eq_bot (h : ∀ x, f x = ⊥) : f.measure = 0 := by + refine Measure.measure_univ_eq_zero.mp ?_ + rw [← iUnion_Ioc_neg_nat_nat] + exact measure_iUnion_null fun n ↦ f.measure_Ioc_eq_zero_of_eq_bot (h _) (h _) + +lemma measure_eq_zero_of_forall_eq_top (h : ∀ x, f x = ⊤) : f.measure = 0 := by + refine Measure.measure_univ_eq_zero.mp ?_ + rw [← iUnion_Ioc_neg_nat_nat] + exact measure_iUnion_null fun n ↦ f.measure_Ioc_eq_zero_of_eq_top (h _) (h _) + +lemma measure_Iio_eq_zero_of_forall_lt_eq_bot {c : ℝ} (h : ∀ x, x < c → f x = ⊥) : + f.measure (Iio c) = 0 := by + have : Iio c = ⋃ n : ℕ, Ioc (c - (n + 1)) (c - 1 / (n + 1)) := by + ext y + simp only [mem_Iio, mem_iUnion, mem_Ioc] + constructor + · intro hy + obtain ⟨n, hn⟩ := exists_nat_one_div_lt (sub_pos.mpr hy) + obtain ⟨m, hm⟩ := exists_nat_gt (c - y) + refine ⟨max n m, ?_, ?_⟩ + · have : (m : ℝ) ≤ max n m := by exact_mod_cast le_max_right n m + linarith + · have : (1 : ℝ) / (max n m + 1) ≤ 1 / (n + 1) := + one_div_le_one_div_of_le (by positivity) + (by exact_mod_cast Nat.add_le_add_right (le_max_left n m) 1) + linarith + · rintro ⟨n, _, hy⟩ + have : (0 : ℝ) < 1 / (n + 1) := by positivity + linarith + rw [this] + refine measure_iUnion_null fun n ↦ f.measure_Ioc_eq_zero_of_eq_bot (h _ ?_) (h _ ?_) + · have : (0 : ℝ) ≤ n + 1 := by positivity + linarith + · have : (0 : ℝ) < 1 / (n + 1) := by positivity + linarith + +lemma measure_Ioi_eq_zero_of_forall_gt_eq_top {d : ℝ} (h : ∀ x, d < x → f x = ⊤) : + f.measure (Ioi d) = 0 := by + have : Ioi d = ⋃ n : ℕ, Ioc (d + 1 / (n + 1)) (d + (n + 1)) := by + ext y + simp only [mem_Ioi, mem_iUnion, mem_Ioc] + constructor + · intro hy + obtain ⟨n, hn⟩ := exists_nat_one_div_lt (sub_pos.mpr hy) + obtain ⟨m, hm⟩ := exists_nat_gt (y - d) + refine ⟨max n m, ?_, ?_⟩ + · have : (1 : ℝ) / (max n m + 1) ≤ 1 / (n + 1) := + one_div_le_one_div_of_le (by positivity) + (by exact_mod_cast Nat.add_le_add_right (le_max_left n m) 1) + linarith + · have : (m : ℝ) ≤ max n m := by exact_mod_cast le_max_right n m + linarith + · rintro ⟨n, hy, _⟩ + have : (0 : ℝ) < 1 / (n + 1) := by positivity + linarith + rw [this] + refine measure_iUnion_null fun n ↦ f.measure_Ioc_eq_zero_of_eq_top (h _ ?_) (h _ ?_) + · have : (0 : ℝ) < 1 / (n + 1) := by positivity + linarith + · have : (0 : ℝ) ≤ n + 1 := by positivity + linarith + +/-- The region where `f = ⊥` is `f.measure`-null. -/ +lemma measure_setOf_eq_bot : f.measure {x | f x = ⊥} = 0 := by + have h_Iic {x : ℝ} (hx : f x = ⊥) : f.measure (Iic x) = 0 := by + have h_tendsto : Tendsto f atBot (𝓝 ⊥) := tendsto_const_nhds.congr' + ((eventually_le_atBot x).mono fun y hy ↦ (eq_bot_mono (f.mono hy) hx).symm) + rw [f.measure_Iic h_tendsto, hx, EReal.bot_sub, EReal.toENNReal_bot] + -- the points where `f = ⊥` that are not below a rational where `f = ⊥` + have h_sub : {x | f x = ⊥ ∧ ∀ y, x < y → f y ≠ ⊥}.Subsingleton := by + intro x hx y hy + by_contra hxy + rcases lt_or_gt_of_ne hxy with h | h + · exact hx.2 y h hy.1 + · exact hy.2 x h hx.1 + refine measure_mono_null (t := (⋃ (q : ℚ) (_ : f q = ⊥), Iic (q : ℝ)) + ∪ {x | f x = ⊥ ∧ ∀ y, x < y → f y ≠ ⊥}) (fun x hx ↦ ?_) (measure_union_null + (measure_iUnion_null fun q ↦ measure_iUnion_null fun hq ↦ h_Iic hq) ?_) + · by_cases h : ∀ y, x < y → f y ≠ ⊥ + · exact Or.inr ⟨hx, h⟩ + push Not at h + obtain ⟨y, hxy, hy⟩ := h + obtain ⟨q, hxq, hqy⟩ := exists_rat_btwn hxy + exact Or.inl (mem_iUnion₂.mpr ⟨q, eq_bot_mono (f.mono hqy.le) hy, hxq.le⟩) + · rcases h_sub.eq_empty_or_singleton with h | ⟨m, hm⟩ + · simp [h] + · have hm' : f m = ⊥ := (hm.symm ▸ mem_singleton m : m ∈ {x | f x = ⊥ ∧ _}).1 + rw [hm] + exact measure_mono_null (singleton_subset_iff.mpr (mem_Iic.mpr le_rfl)) (h_Iic hm') + +/-- The region strictly above the first point where `f = ⊤` is `f.measure`-null. -/ +lemma measure_setOf_exists_lt_eq_top : f.measure {x | ∃ y < x, f y = ⊤} = 0 := by + refine measure_mono_null (t := ⋃ (q : ℚ) (_ : f q = ⊤), Ioi (q : ℝ)) ?_ + (measure_iUnion_null fun q ↦ measure_iUnion_null fun hq ↦ + f.measure_Ioi_eq_zero_of_forall_gt_eq_top fun x hx ↦ eq_top_mono (f.mono hx.le) hq) + rintro x ⟨y, hyx, hy⟩ + obtain ⟨q, hyq, hqx⟩ := exists_rat_btwn hyx + exact mem_iUnion₂.mpr ⟨q, eq_top_mono (f.mono hyq.le) hy, hqx⟩ + +/-- The restriction of `f.measure` to the region where `f` is `⊥`, together with its right +endpoint, is s-finite: that region is null except possibly for an infinite atom at its endpoint. -/ +lemma sfinite_restrict_of_forall_lt_eq_bot (c : EReal) (h : ∀ x : ℝ, (x : EReal) < c → f x = ⊥) : + SFinite (f.measure.restrict {x : ℝ | (x : EReal) ≤ c}) := by + induction c with + | bot => + have : {x : ℝ | (x : EReal) ≤ ⊥} = ∅ := by + ext x + simp + rw [this, Measure.restrict_empty] + infer_instance + | coe c => + have : {x : ℝ | (x : EReal) ≤ c} = Iio c ∪ {c} := by + ext x + simp only [mem_ofPred_eq, EReal.coe_le_coe_iff, union_singleton, mem_insert_iff, mem_Iio] + exact le_iff_eq_or_lt + rw [this, Measure.restrict_union ((Set.disjoint_singleton_right (s := Iio c)).mpr (lt_irrefl c)) + (measurableSet_singleton _), + Measure.restrict_eq_zero.mpr + (f.measure_Iio_eq_zero_of_forall_lt_eq_bot fun x hx ↦ h x (EReal.coe_lt_coe_iff.mpr hx)), + zero_add, Measure.restrict_singleton] + infer_instance + | top => + rw [f.measure_eq_zero_of_forall_eq_bot fun x ↦ h x (EReal.coe_lt_top x)] + infer_instance + +/-- The restriction of `f.measure` to the region where `f` is `⊤`, together with its left +endpoint, is s-finite: that region is null except possibly for an infinite atom at its endpoint. -/ +lemma sfinite_restrict_of_forall_gt_eq_top (d : EReal) (h : ∀ x : ℝ, d < (x : EReal) → f x = ⊤) : + SFinite (f.measure.restrict {x : ℝ | d ≤ (x : EReal)}) := by + induction d with + | bot => + rw [f.measure_eq_zero_of_forall_eq_top fun x ↦ h x (EReal.bot_lt_coe x)] + infer_instance + | coe d => + have : {x : ℝ | (d : EReal) ≤ x} = {d} ∪ Ioi d := by + ext x + simp only [mem_ofPred_eq, EReal.coe_le_coe_iff, singleton_union, mem_insert_iff, mem_Ioi] + exact le_iff_eq_or_lt.trans (or_congr_left eq_comm) + rw [this, Measure.restrict_union ((Set.disjoint_singleton_left (s := Ioi d)).mpr (lt_irrefl d)) + _root_.measurableSet_Ioi, + Measure.restrict_eq_zero.mpr + (f.measure_Ioi_eq_zero_of_forall_gt_eq_top fun x hx ↦ h x (EReal.coe_lt_coe_iff.mpr hx)), + add_zero, Measure.restrict_singleton] + infer_instance + | top => + have : {x : ℝ | (⊤ : EReal) ≤ x} = ∅ := by + ext x + simp + rw [this, Measure.restrict_empty] + infer_instance + +/-- The measure associated to an `ERealStieltjes` function is s-finite: it is σ-finite on the +(open) region where `f` is finite, vanishes where `f` is `⊥` or `⊤`, and has at most two +(possibly infinite) atoms at the boundary of that region. -/ +instance : SFinite f.measure := by + -- `c` bounds the region where `f = ⊥`, `d` the region where `f = ⊤` + set c : EReal := sSup (Real.toEReal '' {x | f x = ⊥}) with hc + set d : EReal := sInf (Real.toEReal '' {x | f x = ⊤}) with hd + have hc_lt : ∀ x : ℝ, (x : EReal) < c → f x = ⊥ := by + intro x hx + obtain ⟨_, ⟨y, hy, rfl⟩, hxy⟩ := lt_sSup_iff.mp hx + exact eq_bot_mono (f.mono (EReal.coe_lt_coe_iff.mp hxy).le) hy + have hc_gt : ∀ x : ℝ, c < x → f x ≠ ⊥ := fun x hx h ↦ + (not_le.mpr hx) (le_sSup ⟨x, h, rfl⟩) + have hd_gt : ∀ x : ℝ, d < x → f x = ⊤ := by + intro x hx + obtain ⟨_, ⟨y, hy, rfl⟩, hxy⟩ := sInf_lt_iff.mp hx + exact eq_top_mono (f.mono (EReal.coe_lt_coe_iff.mp hxy).le) hy + have hd_lt : ∀ x : ℝ, (x : EReal) < d → f x ≠ ⊤ := fun x hx h ↦ + (not_le.mpr hx) (sInf_le ⟨x, h, rfl⟩) + -- the region where `f` is finite + set M : Set ℝ := {x | c < x ∧ (x : EReal) < d} with hM + have hM_open : IsOpen M := + (isOpen_lt continuous_const continuous_coe_real_ereal).inter + (isOpen_lt continuous_coe_real_ereal continuous_const) + have h_fin : ∀ x ∈ M, ∀ y ∈ M, f.measure (Ioc x y) ≠ ∞ := by + intro x hx y hy + have h3 : f y - f x ≠ ⊤ := by + rw [sub_eq_add_neg] + exact (EReal.add_ne_top_iff_ne_top₂ (hc_gt y hy.1) (by simpa using hd_lt x hx.2)).mpr + ⟨hd_lt y hy.2, by simpa using hc_gt x hx.1⟩ + rw [measure_Ioc] + exact fun h ↦ h3 (EReal.toENNReal_eq_top_iff.mp h) + have h_sigma : SigmaFinite (f.measure.restrict M) := by + refine Measure.sigmaFinite_of_countable + (S := (fun p : ℚ × ℚ ↦ Ioc (p.1 : ℝ) p.2) '' {p | (p.1 : ℝ) ∈ M ∧ (p.2 : ℝ) ∈ M} ∪ {Mᶜ}) + (((Set.to_countable _).image _).union (countable_singleton _)) ?_ ?_ + · rintro s (⟨p, hp, rfl⟩ | rfl) + · rw [Measure.restrict_apply measurableSet_Ioc] + exact (measure_mono inter_subset_left).trans_lt (h_fin _ hp.1 _ hp.2).lt_top + · rw [Measure.restrict_apply hM_open.measurableSet.compl] + simp + · refine eq_univ_of_forall fun x ↦ mem_sUnion.mpr ?_ + by_cases hx : x ∈ M + · obtain ⟨a, b, hxab, habM⟩ := mem_nhds_iff_exists_Ioo_subset.mp (hM_open.mem_nhds hx) + obtain ⟨q, haq, hqx⟩ := exists_rat_btwn hxab.1 + obtain ⟨r, hxr, hrb⟩ := exists_rat_btwn hxab.2 + exact ⟨Ioc (q : ℝ) r, Or.inl ⟨(q, r), ⟨habM ⟨haq, hqx.trans hxab.2⟩, + habM ⟨hxab.1.trans hxr, hrb⟩⟩, rfl⟩, hqx, hxr.le⟩ + · exact ⟨Mᶜ, Or.inr rfl, hx⟩ + -- assemble the pieces + have hA := f.sfinite_restrict_of_forall_lt_eq_bot c hc_lt + have hB := f.sfinite_restrict_of_forall_gt_eq_top d hd_gt + have hA_meas : MeasurableSet {x : ℝ | (x : EReal) ≤ c} := + (isClosed_le continuous_coe_real_ereal continuous_const).measurableSet + have hB_meas : MeasurableSet {x : ℝ | d ≤ (x : EReal)} := + (isClosed_le continuous_const continuous_coe_real_ereal).measurableSet + have h1 : f.measure = f.measure.restrict {x : ℝ | (x : EReal) ≤ c} + + f.measure.restrict {x : ℝ | (x : EReal) ≤ c}ᶜ := + (Measure.restrict_add_restrict_compl hA_meas).symm + have h2 : f.measure.restrict {x : ℝ | (x : EReal) ≤ c}ᶜ + = (f.measure.restrict {x : ℝ | (x : EReal) ≤ c}ᶜ).restrict {x : ℝ | d ≤ (x : EReal)} + + (f.measure.restrict {x : ℝ | (x : EReal) ≤ c}ᶜ).restrict {x : ℝ | d ≤ (x : EReal)}ᶜ := + (Measure.restrict_add_restrict_compl hB_meas).symm + have h3 : (f.measure.restrict {x : ℝ | (x : EReal) ≤ c}ᶜ).restrict {x : ℝ | d ≤ (x : EReal)} + = (f.measure.restrict {x : ℝ | d ≤ (x : EReal)}).restrict {x : ℝ | (x : EReal) ≤ c}ᶜ := by + rw [Measure.restrict_restrict hB_meas, Measure.restrict_restrict hA_meas.compl, inter_comm] + have h4 : (f.measure.restrict {x : ℝ | (x : EReal) ≤ c}ᶜ).restrict {x : ℝ | d ≤ (x : EReal)}ᶜ + = f.measure.restrict M := by + rw [Measure.restrict_restrict hB_meas.compl] + congr 1 + ext x + simp [M, not_le, and_comm] + have : SFinite (f.measure.restrict {x : ℝ | (x : EReal) ≤ c}ᶜ) := by + rw [h2, h3, h4] + infer_instance + rw [h1] + infer_instance + +end SFinite + +lemma isFiniteMeasure {l u : ℝ} (hfl : Tendsto f atBot (𝓝 l)) (hfu : Tendsto f atTop (𝓝 u)) : + IsFiniteMeasure f.measure := by + constructor + simp only [f.measure_univ hfl hfu] + rw [lt_top_iff_ne_top, ne_eq, EReal.toENNReal_eq_top_iff, ← EReal.coe_sub] + exact EReal.coe_ne_top _ + +lemma isProbabilityMeasure (hf_bot : Tendsto f atBot (𝓝 0)) (hf_top : Tendsto f atTop (𝓝 1)) : + IsProbabilityMeasure f.measure := ⟨by simp [f.measure_univ hf_bot hf_top]⟩ + +lemma isLocallyFiniteMeasure (hf_bot : ∀ x, f x ≠ ⊥) (hf_top : ∀ x, f x ≠ ⊤) : + IsLocallyFiniteMeasure f.measure := by + refine ⟨fun x ↦ ⟨Ioo (x - 1) (x + 1), Ioo_mem_nhds (by linarith) (lt_add_one x), ?_⟩⟩ + rw [measure_Ioo, lt_top_iff_ne_top, EReal.toENNReal_ne_top_iff] + simp only [sub_eq_add_neg, ne_eq, EReal.add_eq_top_iff, EReal.neg_eq_bot_iff, + EReal.neg_eq_top_iff, not_or, not_and, Decidable.not_not] + constructor + · exact fun h ↦ absurd h <| ne_top_of_le_ne_top (hf_top _) (f.mono.leftLim_le le_rfl) + · exact fun _ ↦ hf_bot _ + +lemma eq_of_measure_of_tendsto_atBot (g : ERealStieltjes) {l : ℝ} + (hfg : f.measure = g.measure) (hfl : Tendsto f atBot (𝓝 l)) (hgl : Tendsto g atBot (𝓝 l)) : + f = g := by + ext x + have hf := measure_Iic f hfl x + rw [hfg, measure_Iic g hgl x, EReal.toENNReal_eq_toENNReal, eq_comm] at hf + · calc f x = (f x - l) + l := by rw [sub_eq_add_neg, add_assoc, add_comm _ (l : EReal), + ← sub_eq_add_neg, EReal.sub_self] <;> simp + _ = (g x - l) + l := by rw [hf] + _ = g x := by rw [sub_eq_add_neg, add_assoc, add_comm _ (l : EReal), + ← sub_eq_add_neg, EReal.sub_self] <;> simp + · rw [EReal.sub_nonneg (.inr (EReal.coe_ne_top _)) (.inr (EReal.coe_ne_bot _))] + exact Monotone.le_of_tendsto g.mono hgl x + · rw [EReal.sub_nonneg (.inr (EReal.coe_ne_top _)) (.inr (EReal.coe_ne_bot _))] + exact Monotone.le_of_tendsto f.mono hfl x + +section Add + +lemma measure_Ioc_add {f g : ERealStieltjes} {a b : ℝ} (hab : a ≤ b) + (hfa : f a ≠ ⊥) (hfb : f b ≠ ⊤) (hga : g a ≠ ⊥) (hgb : g b ≠ ⊤) : + (f + g).measure (Ioc a b) = f.measure (Ioc a b) + g.measure (Ioc a b) := by + have hfab : f a ≤ f b := f.mono hab + have hgab : g a ≤ g b := g.mono hab + simp only [measure_Ioc] + rw [add_apply_of_ne_top hfb hgb, add_apply_of_ne_top (ne_top_of_le_ne_top hfb hfab) + (ne_top_of_le_ne_top hgb hgab)] + lift f a to ℝ using ⟨ne_top_of_le_ne_top hfb hfab, hfa⟩ with fa + lift f b to ℝ using ⟨hfb, ne_bot_of_le_ne_bot hfa hfab⟩ with fb + lift g a to ℝ using ⟨ne_top_of_le_ne_top hgb hgab, hga⟩ with ga + lift g b to ℝ using ⟨hgb, ne_bot_of_le_ne_bot hga hgab⟩ with gb + norm_cast at hfab hgab ⊢ + simp only [EReal.toENNReal_of_ne_top (EReal.coe_ne_top _), EReal.toReal_coe] + rw [← ENNReal.ofReal_add (sub_nonneg_of_le hfab) (sub_nonneg_of_le hgab)] + congr 1 + ring + +/-- The measure of a sum of `ERealStieltjes` functions. `(f + g) x` is `⊤` as soon as `f x` or +`g x` is `⊤`, and `⊥` if one of them is `⊥` and none is `⊤`. The measure `(f + g).measure` sees only +the region where `f + g` is finite, together with the point at which it jumps to `⊤`, and it agrees +with `f.measure + g.measure` there. -/ +lemma measure_add (f g : ERealStieltjes) : + (f + g).measure + = (f.measure + g.measure).restrict {x | (f + g) x ≠ ⊥ ∧ ∀ y < x, (f + g) y ≠ ⊤} := by + set φ := f + g with hφ + set S := {x | φ x ≠ ⊥ ∧ ∀ y < x, φ y ≠ ⊤} with hS + -- `φ.measure` is concentrated on `S` + have h_ae : ∀ᵐ x ∂φ.measure, x ∈ S := by + rw [ae_iff] + refine measure_mono_null (fun x hx ↦ ?_) + (measure_union_null φ.measure_setOf_eq_bot φ.measure_setOf_exists_lt_eq_top) + simp only [hS, mem_ofPred_eq, not_and_or, ne_eq, not_not, not_forall, exists_prop] at hx + exact hx + rw [← Measure.restrict_eq_self_of_ae_mem h_ae] + -- decompose `S` into intervals `Ioc p q` on which `φ` is finite, the point where `φ` jumps from + -- `⊥` to a finite value, and the point where `φ` jumps to `⊤` + set F := {x | φ x ≠ ⊥ ∧ φ x ≠ ⊤} + set I := {p : ℚ × ℚ | (p.1 : ℝ) ∈ F ∧ (p.2 : ℝ) ∈ F} + set L := {x | x ∈ F ∧ ∀ y < x, φ y = ⊥} + set D := {x | φ x = ⊤ ∧ ∀ y < x, φ y ≠ ⊤} + have hS_eq : S = (⋃ p ∈ I, Ioc (p.1 : ℝ) p.2) ∪ (L ∪ D) := by + ext x + refine ⟨fun ⟨hx_bot, hx_lt⟩ ↦ ?_, fun hx ↦ ?_⟩ + · by_cases hx_top : φ x = ⊤ + · exact Or.inr (Or.inr ⟨hx_top, hx_lt⟩) + by_cases hx_L : ∀ y < x, φ y = ⊥ + · exact Or.inr (Or.inl ⟨⟨hx_bot, hx_top⟩, hx_L⟩) + push Not at hx_L + obtain ⟨y, hyx, hy⟩ := hx_L + obtain ⟨p, hyp, hpx⟩ := exists_rat_btwn hyx + obtain ⟨z, hxz, hz⟩ : ∃ z, x < z ∧ φ z < ⊤ := + (((φ.right_continuous x).eventually (eventually_lt_nhds (lt_top_iff_ne_top.mpr hx_top)) + ).filter_mono (nhdsWithin_mono _ Ioi_subset_Ici_self)).and self_mem_nhdsWithin + |>.exists.imp fun _ h ↦ ⟨h.2, h.1⟩ + obtain ⟨q, hxq, hqz⟩ := exists_rat_btwn hxz + refine Or.inl (mem_iUnion₂.mpr ⟨(p, q), ⟨?_, ?_⟩, hpx, hxq.le⟩) + · exact ⟨ne_bot_of_le_ne_bot hy (φ.mono hyp.le), hx_lt p hpx⟩ + · exact ⟨ne_bot_of_le_ne_bot hx_bot (φ.mono hxq.le), + (lt_of_le_of_lt (φ.mono hqz.le) hz).ne⟩ + · rcases hx with hx | hx | hx + · obtain ⟨p, hp, hxp⟩ := mem_iUnion₂.mp hx + exact ⟨ne_bot_of_le_ne_bot hp.1.1 (φ.mono hxp.1.le), + fun y hy ↦ ne_top_of_le_ne_top hp.2.2 (φ.mono (hy.le.trans hxp.2))⟩ + · exact ⟨hx.1.1, fun y hy ↦ ne_top_of_le_ne_top hx.1.2 (φ.mono hy.le)⟩ + · exact ⟨by simp [hx.1], hx.2⟩ + have hL_sub : L.Subsingleton := by + intro x hx y hy + by_contra hxy + rcases lt_or_gt_of_ne hxy with h | h + · exact hx.1.1 (hy.2 x h) + · exact hy.1.1 (hx.2 y h) + have hD_sub : D.Subsingleton := by + intro x hx y hy + by_contra hxy + rcases lt_or_gt_of_ne hxy with h | h + · exact hy.2 x h hx.1 + · exact hx.2 y h hy.1 + rw [hS_eq, Measure.restrict_union_congr, Measure.restrict_biUnion_congr I.to_countable, + ← biUnion_of_singleton (L ∪ D), + Measure.restrict_biUnion_congr (hL_sub.finite.union hD_sub.finite).countable] + refine ⟨fun p ⟨hp, hq⟩ ↦ ?_, fun x hx ↦ ?_⟩ + · -- on `Ioc p q`, all functions are finite and the measures are finite + obtain ⟨hfp, hgp⟩ := (add_apply_ne_bot_iff hp.2).mp hp.1 + obtain ⟨hfq, hgq⟩ := add_apply_ne_top_iff.mp hq.2 + set a : ℝ := (p.1 : ℝ) + set b : ℝ := (p.2 : ℝ) + rcases le_or_gt b a with hba | hab + · simp [Ioc_eq_empty_of_le hba] + have : IsFiniteMeasure (φ.measure.restrict (Ioc a b)) := by + refine isFiniteMeasure_restrict.mpr ?_ + rw [measure_Ioc_add hab.le hfp hfq hgp hgq] + exact ENNReal.add_ne_top.mpr ⟨f.measure_Ioc_ne_top hfp hfq, g.measure_Ioc_ne_top hgp hgq⟩ + refine Measure.ext_of_Ioc_finite _ _ ?_ fun x y hxy ↦ ?_ + · simp only [Measure.restrict_apply_univ, Measure.coe_add, Pi.add_apply] + exact measure_Ioc_add hab.le hfp hfq hgp hgq + · simp only [Measure.restrict_apply measurableSet_Ioc, Measure.coe_add, Pi.add_apply, + Ioc_inter_Ioc] + rcases le_or_gt (min y b) (max x a) with h | h + · simp [Ioc_eq_empty_of_le h] + exact measure_Ioc_add h.le (ne_bot_of_le_ne_bot hfp (f.mono (le_max_right _ _))) + (ne_top_of_le_ne_top hfq (f.mono (min_le_right _ _))) + (ne_bot_of_le_ne_bot hgp (g.mono (le_max_right _ _))) + (ne_top_of_le_ne_top hgq (g.mono (min_le_right _ _))) + · -- at the two jump points, both measures have an infinite atom + rw [Measure.restrict_singleton, Measure.restrict_singleton] + congr 1 + rw [Measure.coe_add, Pi.add_apply] + rcases hx with hx | hx + · rw [φ.measure_singleton_eq_top fun y hy ↦ by rw [hx.2 y hy, EReal.sub_bot hx.1.1], + eq_comm, ENNReal.add_eq_top] + obtain ⟨hfx_bot, hgx_bot⟩ := (add_apply_ne_bot_iff hx.1.2).mp hx.1.1 + obtain ⟨hfx_top, hgx_top⟩ := add_apply_ne_top_iff.mp hx.1.2 + by_contra! h + obtain ⟨y₁, hy₁, hfy₁⟩ : ∃ y < x, f y ≠ ⊥ := by + by_contra! h' + exact h.1 (f.measure_singleton_eq_top fun y hy ↦ by rw [h' y hy, EReal.sub_bot hfx_bot]) + obtain ⟨y₂, hy₂, hgy₂⟩ : ∃ y < x, g y ≠ ⊥ := by + by_contra! h' + exact h.2 (g.measure_singleton_eq_top fun y hy ↦ by rw [h' y hy, EReal.sub_bot hgx_bot]) + have hy : max y₁ y₂ < x := max_lt hy₁ hy₂ + have hfy : f (max y₁ y₂) ≠ ⊤ := ne_top_of_le_ne_top hfx_top (f.mono hy.le) + have hgy : g (max y₁ y₂) ≠ ⊤ := ne_top_of_le_ne_top hgx_top (g.mono hy.le) + have h_bot := hx.2 _ hy + rw [hφ, add_apply_of_ne_top hfy hgy, EReal.add_eq_bot_iff] at h_bot + rcases h_bot with h_bot | h_bot + · exact hfy₁ (eq_bot_mono (f.mono (le_max_left _ _)) h_bot) + · exact hgy₂ (eq_bot_mono (g.mono (le_max_right _ _)) h_bot) + · rw [φ.measure_singleton_eq_top fun y hy ↦ by rw [hx.1, EReal.top_sub (hx.2 y hy)], + eq_comm, ENNReal.add_eq_top] + have hfg : f x = ⊤ ∨ g x = ⊤ := by + by_contra! h + have h_top := hx.1 + rw [hφ, add_apply_of_ne_top h.1 h.2, EReal.add_eq_top_iff] at h_top + tauto + rcases hfg with hfx | hgx + · refine Or.inl (f.measure_singleton_eq_top fun y hy ↦ ?_) + rw [hfx, EReal.top_sub fun hfy ↦ hx.2 y hy (add_apply_of_eq_top_left hfy)] + · refine Or.inr (g.measure_singleton_eq_top fun y hy ↦ ?_) + rw [hgx, EReal.top_sub fun hgy ↦ hx.2 y hy (add_apply_of_eq_top_right hgy)] + +/-- If `f` and `g` are `⊥` at the same points and `⊤` at the same points, then +`(f + g).measure = f.measure + g.measure`. -/ +lemma measure_add_of_eq_bot_iff_of_eq_top_iff (f g : ERealStieltjes) + (h_bot : ∀ x, f x = ⊥ ↔ g x = ⊥) (h_top : ∀ x, f x = ⊤ ↔ g x = ⊤) : + (f + g).measure = f.measure + g.measure := by + -- outside of the set in `measure_add`, `f` and `g` are both `⊥`, or both `⊤` at a point below + have h x (hx : ¬ ((f + g) x ≠ ⊥ ∧ ∀ y < x, (f + g) y ≠ ⊤)) : + (f x = ⊥ ∧ g x = ⊥) ∨ ∃ y < x, f y = ⊤ ∧ g y = ⊤ := by + simp only [not_and_or, ne_eq, not_not, not_forall, exists_prop] at hx + rcases hx with hx | ⟨y, hyx, hy⟩ + · obtain ⟨hf, hg⟩ : f x ≠ ⊤ ∧ g x ≠ ⊤ := by + rw [← not_or, ← add_apply_eq_top_iff, hx] + exact bot_ne_top + rw [add_apply_of_ne_top hf hg, EReal.add_eq_bot_iff] at hx + exact Or.inl (hx.elim (fun h ↦ ⟨h, (h_bot x).mp h⟩) fun h ↦ ⟨(h_bot x).mpr h, h⟩) + · refine Or.inr ⟨y, hyx, ?_⟩ + rcases add_apply_eq_top_iff.mp hy with h | h + exacts [⟨h, (h_top y).mp h⟩, ⟨(h_top y).mpr h, h⟩] + rw [measure_add, Measure.restrict_eq_self_of_ae_mem] + rw [ae_iff, Measure.coe_add, Pi.add_apply, add_eq_zero] + constructor + · refine measure_mono_null (fun x hx ↦ ?_) + (measure_union_null f.measure_setOf_eq_bot f.measure_setOf_exists_lt_eq_top) + rcases h x hx with h | ⟨y, hyx, hy⟩ + exacts [Or.inl h.1, Or.inr ⟨y, hyx, hy.1⟩] + · refine measure_mono_null (fun x hx ↦ ?_) + (measure_union_null g.measure_setOf_eq_bot g.measure_setOf_exists_lt_eq_top) + rcases h x hx with h | ⟨y, hyx, hy⟩ + exacts [Or.inl h.2, Or.inr ⟨y, hyx, hy.2⟩] + +end Add + +end ERealStieltjes diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/Lebesgue/Basic.lean b/Statlib/ForMathlib/MeasureTheory/Measure/Lebesgue/Basic.lean new file mode 100644 index 0000000..6d20117 --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Measure/Lebesgue/Basic.lean @@ -0,0 +1,99 @@ +/- +Copyright (c) 2024 Lorenzo Luccioli. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.MeasureTheory.Measure.Lebesgue.Basic + +/-! +# Integrals of affine functions on intervals + +For an s-finite measure `μ` on `ℝ`, Tonelli's theorem gives +`∫⁻ x in Ioc a t, (t - x) ∂μ = ∫⁻ s in Ioc a t, μ (Ioc a s)` and +`∫⁻ x in Ioc t b, (x - t) ∂μ = ∫⁻ s in Ioc t b, μ (Ioc s b)`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +public section + +open Set + +open scoped ENNReal + +namespace MeasureTheory + +/-- Tonelli: `∫⁻ x in Ioc a t, (t - x) ∂μ = ∫⁻ s in Ioc a t, μ (Ioc a s)`. -/ +lemma setLIntegral_Ioc_ofReal_const_sub (μ : Measure ℝ) [SFinite μ] (a t : ℝ) : + ∫⁻ x in Ioc a t, ENNReal.ofReal (t - x) ∂μ = ∫⁻ s in Ioc a t, μ (Ioc a s) := by + let g : ℝ → ℝ → ℝ≥0∞ := fun x s ↦ if x ≤ s then 1 else 0 + have hg : Measurable (Function.uncurry g) := + Measurable.ite (measurableSet_le measurable_fst measurable_snd) measurable_const + measurable_const + have h1 : ∀ x ∈ Ioc a t, ∫⁻ s in Ioc a t, g x s = ENNReal.ofReal (t - x) := by + intro x hx + have : (fun s ↦ g x s) = (Ici x).indicator 1 := by + ext s + simp [g, indicator_apply] + rw [this, lintegral_indicator_one measurableSet_Ici, Measure.restrict_apply measurableSet_Ici] + have : Ici x ∩ Ioc a t = Icc x t := by + ext s + simp only [mem_inter_iff, mem_Ici, mem_Ioc, mem_Icc] + exact ⟨fun h ↦ ⟨h.1, h.2.2⟩, fun h ↦ ⟨h.1, hx.1.trans_le h.1, h.2⟩⟩ + rw [this, Real.volume_Icc] + have h2 : ∀ s ∈ Ioc a t, ∫⁻ x in Ioc a t, g x s ∂μ = μ (Ioc a s) := by + intro s hs + have : (fun x ↦ g x s) = (Iic s).indicator 1 := by + ext x + simp [g, indicator_apply] + rw [this, lintegral_indicator_one measurableSet_Iic, Measure.restrict_apply measurableSet_Iic] + congr 1 + ext x + simp only [mem_inter_iff, mem_Iic, mem_Ioc] + exact ⟨fun h ↦ ⟨h.2.1, h.1⟩, fun h ↦ ⟨h.2, h.1, h.2.trans hs.2⟩⟩ + calc ∫⁻ x in Ioc a t, ENNReal.ofReal (t - x) ∂μ + = ∫⁻ x in Ioc a t, (∫⁻ s in Ioc a t, g x s ∂volume) ∂μ := + setLIntegral_congr_fun measurableSet_Ioc fun x hx ↦ (h1 x hx).symm + _ = ∫⁻ s in Ioc a t, (∫⁻ x in Ioc a t, g x s ∂μ) ∂volume := + lintegral_lintegral_swap hg.aemeasurable + _ = ∫⁻ s in Ioc a t, μ (Ioc a s) := setLIntegral_congr_fun measurableSet_Ioc h2 + +/-- Tonelli: `∫⁻ x in Ioc t b, (x - t) ∂μ = ∫⁻ s in Ioc t b, μ (Ioc s b)`. -/ +lemma setLIntegral_Ioc_ofReal_sub_const (μ : Measure ℝ) [SFinite μ] (t b : ℝ) : + ∫⁻ x in Ioc t b, ENNReal.ofReal (x - t) ∂μ = ∫⁻ s in Ioc t b, μ (Ioc s b) := by + let g : ℝ → ℝ → ℝ≥0∞ := fun x s ↦ if s < x then 1 else 0 + have hg : Measurable (Function.uncurry g) := + Measurable.ite (measurableSet_lt measurable_snd measurable_fst) measurable_const + measurable_const + have h1 : ∀ x ∈ Ioc t b, ∫⁻ s in Ioc t b, g x s = ENNReal.ofReal (x - t) := by + intro x hx + have : (fun s ↦ g x s) = (Iio x).indicator 1 := by + ext s + simp [g, indicator_apply] + rw [this, lintegral_indicator_one measurableSet_Iio, Measure.restrict_apply measurableSet_Iio] + have : Iio x ∩ Ioc t b = Ioo t x := by + ext s + simp only [mem_inter_iff, mem_Iio, mem_Ioc, mem_Ioo] + exact ⟨fun h ↦ ⟨h.2.1, h.1⟩, fun h ↦ ⟨h.2, h.1, h.2.le.trans hx.2⟩⟩ + rw [this, Real.volume_Ioo] + have h2 : ∀ s ∈ Ioc t b, ∫⁻ x in Ioc t b, g x s ∂μ = μ (Ioc s b) := by + intro s hs + have : (fun x ↦ g x s) = (Ioi s).indicator 1 := by + ext x + simp [g, indicator_apply] + rw [this, lintegral_indicator_one measurableSet_Ioi, Measure.restrict_apply measurableSet_Ioi] + congr 1 + ext x + simp only [mem_inter_iff, mem_Ioi, mem_Ioc] + exact ⟨fun h ↦ ⟨h.1, h.2.2⟩, fun h ↦ ⟨h.1, hs.1.trans h.1, h.2⟩⟩ + calc ∫⁻ x in Ioc t b, ENNReal.ofReal (x - t) ∂μ + = ∫⁻ x in Ioc t b, (∫⁻ s in Ioc t b, g x s ∂volume) ∂μ := + setLIntegral_congr_fun measurableSet_Ioc fun x hx ↦ (h1 x hx).symm + _ = ∫⁻ s in Ioc t b, (∫⁻ x in Ioc t b, g x s ∂μ) ∂volume := + lintegral_lintegral_swap hg.aemeasurable + _ = ∫⁻ s in Ioc t b, μ (Ioc s b) := setLIntegral_congr_fun measurableSet_Ioc h2 + +end MeasureTheory diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/LogLikelihoodRatio.lean b/Statlib/ForMathlib/MeasureTheory/Measure/LogLikelihoodRatio.lean index 82b7f97..10dc8e8 100644 --- a/Statlib/ForMathlib/MeasureTheory/Measure/LogLikelihoodRatio.lean +++ b/Statlib/ForMathlib/MeasureTheory/Measure/LogLikelihoodRatio.lean @@ -6,7 +6,6 @@ Authors: Rémy Degenne module -public import Mathlib.InformationTheory.KullbackLeibler.KLFun public import Mathlib.MeasureTheory.Measure.LogLikelihoodRatio public import Mathlib.Probability.Notation public import Statlib.ForMathlib.MeasureTheory.Integral.EReal.EIntegral @@ -19,18 +18,15 @@ Radon-Nikodym derivatives and log-likelihood ratios. ## Main statements -* `MeasureTheory.eintegrable_rnDeriv_mul_iff`: for `μ ≪ ν`, `f` is `EIntegrable` with respect to - `μ` iff `(∂μ/∂ν) * f` is `EIntegrable` with respect to `ν`. -* `MeasureTheory.eintegrable_llr`: if `μ ≪ ν` are finite measures, the log-likelihood ratio - `llr μ ν` is `EIntegrable` with respect to `μ`. +* `MeasureTheory.eintegral_llr_ne_bot`: if `μ ≪ ν` with `ν` finite, the negative part of the + log-likelihood ratio `llr μ ν` has finite integral with respect to `μ`, hence `llr μ ν` is + `EIntegrable` with respect to `μ` (`MeasureTheory.eintegrable_llr`). -/ @[expose] public section open scoped ENNReal ProbabilityTheory -open InformationTheory - variable {𝓧 : Type*} {m𝓧 : MeasurableSpace 𝓧} {P : MeasureTheory.Measure 𝓧} namespace MeasureTheory @@ -42,59 +38,35 @@ lemma lintegral_rnDeriv_mul_le (μ ν : Measure 𝓧) {X : 𝓧 → ℝ≥0∞} rw [lintegral_withDensity_eq_lintegral_mul _ (by fun_prop) hX]; simp _ ≤ ∫⁻ ω, X ω ∂μ := lintegral_mono' (μ.withDensity_rnDeriv_le ν) le_rfl -/-- For `μ ≪ ν`, a function `f` is `EIntegrable` with respect to `μ` iff `(∂μ/∂ν) * f` is -`EIntegrable` with respect to `ν`. -/ -lemma eintegrable_rnDeriv_mul_iff {μ ν : Measure 𝓧} [IsFiniteMeasure μ] [IsFiniteMeasure ν] - {f : 𝓧 → EReal} (hμν : μ ≪ ν) (hf : Measurable f) : - EIntegrable (fun a ↦ (μ.rnDeriv ν a).toReal * f a) ν ↔ EIntegrable f μ := by - have h_eq {g : 𝓧 → EReal} (hg : Measurable g) : - ∫⁻ a, (((μ.rnDeriv ν a).toReal : EReal) * g a).toENNReal ∂ν = ∫⁻ a, (g a).toENNReal ∂μ := by - nth_rw 2 [← Measure.withDensity_rnDeriv_eq μ ν hμν] - rw [lintegral_withDensity_eq_lintegral_mul _ (by fun_prop) (by fun_prop)] - refine lintegral_congr_ae ?_ - filter_upwards [Measure.rnDeriv_ne_top μ ν] with x hx - rw [Pi.mul_apply, EReal.toENNReal_mul (by simp)] - simp [ENNReal.ofReal_toReal hx] - rw [EIntegrable, EIntegrable, h_eq hf] - simp_rw [← mul_neg] - rw [h_eq (g := fun x ↦ -f x) hf.neg] - lemma llr_ae_eq_log_inv_rnDeriv [IsFiniteMeasure P] {μ : Measure 𝓧} [IsFiniteMeasure μ] (h_ac : P ≪ μ) : llr P μ =ᵐ[P] fun x ↦ Real.log ((μ.rnDeriv P)⁻¹ x).toReal := by filter_upwards [Measure.inv_rnDeriv' h_ac] with a ha using by rw [llr, ha] -lemma eintegrable_klFun_rnDeriv (P μ : Measure 𝓧) : - EIntegrable (fun ω ↦ klFun (μ.rnDeriv P ω).toReal) P := by - refine eintegrable_of_nonneg ?_ - simp only [EReal.coe_nonneg] - exact fun _ ↦ klFun_nonneg ENNReal.toReal_nonneg - -lemma eintegrable_rnDeriv_mul_log_iff {μ ν : Measure 𝓧} [IsFiniteMeasure μ] [IsFiniteMeasure ν] - (hμν : μ ≪ ν) : - EIntegrable (fun a ↦ (μ.rnDeriv ν a).toReal * Real.log (μ.rnDeriv ν a).toReal) ν - ↔ EIntegrable (fun a ↦ llr μ ν a) μ := eintegrable_rnDeriv_mul_iff hμν (by fun_prop) - -lemma eintegrable_llr [IsFiniteMeasure P] {μ : Measure 𝓧} [IsFiniteMeasure μ] - (h_ac : P ≪ μ) : - EIntegrable (fun ω ↦ llr P μ ω) P := by - rw [← eintegrable_rnDeriv_mul_log_iff h_ac] - have h_eq a : (((∂P/∂μ) a).toReal * Real.log ((∂P/∂μ) a).toReal : EReal) = - ((klFun (P.rnDeriv μ a).toReal + (P.rnDeriv μ a).toReal - 1 : ℝ) : EReal) := by - simp [klFun] - rw [eintegrable_congr (ae_of_all _ h_eq)] - have h_int := eintegrable_klFun_rnDeriv μ P - simp only [EReal.coe_sub, EReal.coe_add, EReal.coe_one] - simp_rw [sub_eq_add_neg] - refine eintegrable_add_of_ne_bot (by fun_prop) (by fun_prop) ?_ (by simp) - refine eintegral_add_ne_bot (by fun_prop) (by fun_prop) ?_ ?_ - · rw [eintegral_eq_lintegral_of_nonneg] - · simp - · simp only [EReal.coe_nonneg] - exact fun _ ↦ klFun_nonneg ENNReal.toReal_nonneg - · rw [eintegral_eq_lintegral_of_nonneg] - · simp - · simp +/-- If `μ ≪ ν` with `ν` finite, the negative part of the log-likelihood ratio `llr μ ν` has finite +integral with respect to `μ`: it is at most `(∂μ/∂ν)⁻¹ = ∂ν/∂μ`. -/ +lemma eintegral_llr_ne_bot {μ ν : Measure 𝓧} [SigmaFinite μ] [IsFiniteMeasure ν] (h_ac : μ ≪ ν) : + ∫ᵉ x, llr μ ν x ∂μ ≠ ⊥ := by + rw [eintegral_ne_bot_iff_lintegral_ne_top] + refine ne_top_of_le_ne_top (measure_ne_top ν .univ) ?_ + calc ∫⁻ x, (-(llr μ ν x : EReal)).toENNReal ∂μ + _ ≤ ∫⁻ x, ν.rnDeriv μ x ∂μ := by + refine lintegral_mono_ae ?_ + filter_upwards [Measure.inv_rnDeriv h_ac, Measure.rnDeriv_pos h_ac, + h_ac.ae_le (Measure.rnDeriv_lt_top μ ν)] with x hx h_pos h_lt_top + have hy : 0 < (μ.rnDeriv ν x).toReal := ENNReal.toReal_pos h_pos.ne' h_lt_top.ne + rw [← hx, Pi.inv_apply, ← ENNReal.ofReal_toReal (ENNReal.inv_ne_top.mpr h_pos.ne'), + ENNReal.toReal_inv, ← EReal.coe_neg, EReal.toENNReal_of_ne_top (EReal.coe_ne_top _), + EReal.toReal_coe, llr_def, ← Real.log_inv] + refine ENNReal.ofReal_le_ofReal ?_ + exact (Real.log_le_sub_one_of_pos (inv_pos.mpr hy)).trans (by linarith) + _ ≤ ν .univ := Measure.lintegral_rnDeriv_le + +/-- If `μ ≪ ν` with `ν` finite, the log-likelihood ratio `llr μ ν` is `EIntegrable` with respect +to `μ`. -/ +lemma eintegrable_llr {μ ν : Measure 𝓧} [SigmaFinite μ] [IsFiniteMeasure ν] (h_ac : μ ≪ ν) : + EIntegrable (fun x ↦ llr μ ν x) μ := + eintegrable_of_eintegral_ne_bot (eintegral_llr_ne_bot h_ac) lemma eintegrable_ennreal_log_rnDeriv [IsFiniteMeasure P] {μ : Measure 𝓧} [IsFiniteMeasure μ] (h_ac : P ≪ μ) : @@ -110,4 +82,27 @@ lemma eintegrable_ennreal_log_rnDeriv [IsFiniteMeasure P] {μ : Measure 𝓧} [I rw [eintegrable_congr h_ae'.symm] exact eintegrable_llr h_ac +section ExpLLR + +open Real Measure + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} + +/-- If `μ ≪ ν`, then `exp (a * llr μ ν) = (∂μ/∂ν) ^ a`, `μ`-almost everywhere. -/ +lemma exp_mul_llr_of_ac [SigmaFinite μ] [SigmaFinite ν] (hμν : μ ≪ ν) {a : ℝ} : + (fun x ↦ exp (a * llr μ ν x)) =ᵐ[μ] fun x ↦ (μ.rnDeriv ν x).toReal ^ a := by + filter_upwards [hμν <| rnDeriv_lt_top μ ν, rnDeriv_pos hμν] with x hx_lt_top hx_pos + have h_pos : 0 < (μ.rnDeriv ν x).toReal := ENNReal.toReal_pos hx_pos.ne' hx_lt_top.ne + rw [llr_def, ← log_rpow h_pos, exp_log (rpow_pos_of_pos h_pos _)] + +/-- If `ν ≪ μ`, then `exp (a * llr μ ν) = (∂μ/∂ν) ^ a`, `ν`-almost everywhere. -/ +lemma exp_mul_llr_of_ac' [SigmaFinite μ] [SigmaFinite ν] (hνμ : ν ≪ μ) + {a : ℝ} : + (fun x ↦ exp (a * llr μ ν x)) =ᵐ[ν] fun x ↦ (μ.rnDeriv ν x).toReal ^ a := by + filter_upwards [rnDeriv_lt_top μ ν, rnDeriv_pos' hνμ] with x hx_lt_top hx_pos + have h_pos : 0 < (μ.rnDeriv ν x).toReal := ENNReal.toReal_pos hx_pos.ne' hx_lt_top.ne + rw [llr_def, ← log_rpow h_pos, exp_log (rpow_pos_of_pos h_pos _)] + +end ExpLLR + end MeasureTheory diff --git a/Statlib/ForMathlib/Probability/Decision/BayesEstimator.lean b/Statlib/ForMathlib/Probability/Decision/BayesEstimator.lean new file mode 100644 index 0000000..b9e867c --- /dev/null +++ b/Statlib/ForMathlib/Probability/Decision/BayesEstimator.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.Probability.Decision.BayesEstimator +public import Mathlib.Probability.Kernel.Posterior +public import Statlib.ForMathlib.MeasureTheory.Measure.Bool + +/-! +# Bayes risk of estimation problems with parameter space `Bool` + +* `ProbabilityTheory.bayesRisk_boolKernel_eq_lintegral_iInf`: when it admits an argmin estimator, + the Bayes risk of an estimation problem with parameter space `Bool` and data generating kernel + `Kernel.boolKernel μ ν` is an integral of an infimum over the actions. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open MeasureTheory + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {𝒳 : Type*} {m𝒳 : MeasurableSpace 𝒳} + +/-- The Bayes risk for a prior `π` of an estimation problem with parameter space `Bool` and +data generating kernel `boolKernel μ ν`, when it admits an argmin estimator. -/ +lemma bayesRisk_boolKernel_eq_lintegral_iInf {𝒴 : Type*} [MeasurableSpace 𝒴] + {ℓ : Bool → 𝒴 → ℝ≥0∞} (hℓ : Measurable (Function.uncurry ℓ)) + (μ ν : Measure 𝒳) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (π : Measure Bool) [IsFiniteMeasure π] (h : HasArgminEstimator ℓ (Kernel.boolKernel μ ν) π) : + bayesRisk ℓ (Kernel.boolKernel μ ν) π + = ∫⁻ x, ⨅ y, π {true} * ν.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x * ℓ true y + + π {false} * μ.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x * ℓ false y + ∂(Kernel.boolKernel μ ν ∘ₘ π) := by + rw [h.bayesRisk_eq hℓ] + refine lintegral_congr_ae ?_ + filter_upwards [posterior_boolKernel_apply_false μ ν π, posterior_boolKernel_apply_true μ ν π] + with x h_false h_true + congr with y + rw [lintegral_bool, h_false, h_true] + ring + +end ProbabilityTheory diff --git a/Statlib/ForMathlib/Probability/Distributions/Bernoulli.lean b/Statlib/ForMathlib/Probability/Distributions/Bernoulli.lean index b831b4c..088d243 100644 --- a/Statlib/ForMathlib/Probability/Distributions/Bernoulli.lean +++ b/Statlib/ForMathlib/Probability/Distributions/Bernoulli.lean @@ -7,6 +7,7 @@ module public import Mathlib.Probability.Distributions.Bernoulli public import Mathlib.Probability.Kernel.Composition.CompNotation +public import Mathlib.MeasureTheory.Measure.Decomposition.Lebesgue /-! # Bernoulli distribution: integrals, symmetry and the Bernoulli kernel @@ -24,6 +25,10 @@ kernel from the unit interval which maps `p` to `Ber(x, y, p)`. * `lintegral_bernoulliMeasure`: the Lebesgue integral against `Ber(x, y, p)`. * `bernoulliMeasure_swap`: `Ber(y, x, σ p) = Ber(x, y, p)`. * `eq_bernoulliMeasure_real_true`: every probability measure on `Bool` is a Bernoulli distribution. +* `bernoulliMeasure_eq_withDensity`: for `x ≠ y` and `q ∉ {0, 1}`, `Ber(x, y, p)` has density + `p / q` at `x` and `(1 - p) / (1 - q)` at `y` with respect to `Ber(x, y, q)`; hence + `Ber(x, y, p) ≪ Ber(x, y, q)` (`bernoulliMeasure_absolutelyContinuous`) and the Radon-Nikodym + derivative is that density (`rnDeriv_bernoulliMeasure`). * `bernoulliKernel_comp_apply_singleton_left`: for `x ≠ y`, the composition of `bernoulliKernel x y` with a measure `μ` on the unit interval gives mass `∫⁻ p, p ∂μ` to `x`. -/ @@ -97,6 +102,55 @@ lemma eq_bernoulliMeasure_real_true (R : Measure Bool) [IsProbabilityMeasure R] · rw [bernoulliMeasure_apply_singleton_left (by decide)] exact (ENNReal.ofReal_toReal (measure_ne_top _ _)).symm +/-! ### Densities of Bernoulli distributions + +The following lemmas are copied from LMLPapers +(`LeanMachineLearning/ForMathlib/Probability/Distributions/Bernoulli.lean`). -/ + +section Density + +variable [MeasurableSingletonClass 𝓧] {x y : 𝓧} {q : I} + +/-- For `x ≠ y` and `q ∉ {0, 1}`, the Bernoulli measure `Ber(x, y, p)` has density `p / q` at `x` +and `(1 - p) / (1 - q)` at `y` with respect to `Ber(x, y, q)`. -/ +lemma bernoulliMeasure_eq_withDensity [DecidableEq 𝓧] (hxy : x ≠ y) (p : I) (hq : q ≠ 0) + (hq1 : q ≠ 1) : + Ber(x, y, p) = Ber(x, y, q).withDensity + (fun z ↦ if z = x then ENNReal.ofReal (p / q) else ENNReal.ofReal ((1 - p) / (1 - q))) := by + have hq0 : (q : ℝ) ≠ 0 := coe_ne_zero.2 hq + have hq1' : (1 : ℝ) - q ≠ 0 := sub_ne_zero.2 (coe_ne_one.2 hq1).symm + rw [bernoulliMeasure_def, bernoulliMeasure_def, withDensity_add_measure] + simp_rw [ENNReal.smul_def] + rw [withDensity_smul_measure, withDensity_smul_measure, dirac_withDensity, dirac_withDensity, + ite_eq_left rfl, ite_eq_right hxy.symm, smul_smul, smul_smul] + simp only [coe_toNNReal_eq_ofReal, coe_symm_eq] + congr 1 <;> congr 1 + · rw [← ENNReal.ofReal_mul q.2.1] + congr 1 + field_simp + · rw [← ENNReal.ofReal_mul (sub_nonneg.2 q.2.2)] + congr 1 + field_simp + +/-- For `x ≠ y` and `q ∉ {0, 1}`, `Ber(x, y, p) ≪ Ber(x, y, q)`. -/ +lemma bernoulliMeasure_absolutelyContinuous (hxy : x ≠ y) (p : I) (hq : q ≠ 0) (hq1 : q ≠ 1) : + Ber(x, y, p) ≪ Ber(x, y, q) := by + classical + rw [bernoulliMeasure_eq_withDensity hxy p hq hq1] + exact withDensity_absolutelyContinuous _ _ + +/-- The Radon-Nikodym derivative of `Ber(x, y, p)` with respect to `Ber(x, y, q)`, for `x ≠ y` and +`q ∉ {0, 1}`. -/ +lemma rnDeriv_bernoulliMeasure [DecidableEq 𝓧] (hxy : x ≠ y) (p : I) (hq : q ≠ 0) + (hq1 : q ≠ 1) : + Ber(x, y, p).rnDeriv Ber(x, y, q) =ᵐ[Ber(x, y, q)] + fun z ↦ if z = x then ENNReal.ofReal (p / q) else ENNReal.ofReal ((1 - p) / (1 - q)) := by + rw [bernoulliMeasure_eq_withDensity hxy p hq hq1] + exact Measure.rnDeriv_withDensity _ + (Measurable.ite (measurableSet_singleton x) measurable_const measurable_const) + +end Density + /-- The Markov kernel from the unit interval to `𝓧` which maps `p` to the Bernoulli distribution `Ber(x, y, p)`. -/ noncomputable def bernoulliKernel (x y : 𝓧) : Kernel I 𝓧 where diff --git a/Statlib/ForMathlib/Probability/Kernel/Composition/MeasureCompProd.lean b/Statlib/ForMathlib/Probability/Kernel/Composition/MeasureCompProd.lean new file mode 100644 index 0000000..e95c3ab --- /dev/null +++ b/Statlib/ForMathlib/Probability/Kernel/Composition/MeasureCompProd.lean @@ -0,0 +1,307 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.MeasureTheory.Measure.Decomposition.IntegralRNDeriv +public import Mathlib.Probability.Kernel.Composition.AbsolutelyContinuous +public import Mathlib.Probability.Kernel.Composition.IntegralCompProd +public import Statlib.ForMathlib.Convex +public import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.IntegralRNDeriv +public import Statlib.ForMathlib.Probability.Kernel.Composition.RadonNikodym + +/-! +# Composition-products of measures and kernels: singular parts and integrability + +## Main statements + +* `ProbabilityTheory.singularPart_compProd_left`, `ProbabilityTheory.singularPart_compProd`, + `ProbabilityTheory.singularPart_compProd_right`: singular part of `μ ⊗ₘ κ` with respect to + `ν ⊗ₘ η`. +* `ProbabilityTheory.lintegral_singularPart`: integral of the singular parts of kernels, written as + a singular part of composition-products. +* `ProbabilityTheory.integrable_f_rnDeriv_compProd_iff`: integrability of + `f ((∂μ ⊗ₘ κ/∂ν ⊗ₘ η) x)` in terms of the integrability of its sections, for convex `f`. +* `ProbabilityTheory.Measure.compProd_univ_toReal`: `((μ ⊗ₘ κ) univ).toReal` as a Bochner + integral. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open MeasureTheory + +namespace ProbabilityTheory + +variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} + +lemma singularPart_compProd_left (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ : Kernel α β) [IsFiniteKernel κ] : + (μ ⊗ₘ κ).singularPart (ν ⊗ₘ κ) = μ.singularPart ν ⊗ₘ κ := by + conv_lhs => rw [μ.haveLebesgueDecomposition_add ν, Measure.compProd_add_left, + Measure.singularPart_add] + have : (ν.withDensity (∂μ/∂ν) ⊗ₘ κ).singularPart (ν ⊗ₘ κ) = 0 := by + refine Measure.singularPart_eq_zero_of_ac (Measure.AbsolutelyContinuous.compProd ?_ ?_) + · exact withDensity_absolutelyContinuous _ _ + · exact ae_of_all _ fun _ ↦ by rfl + rw [this, add_zero, Measure.singularPart_eq_self] + exact Measure.MutuallySingular.compProd_of_left (Measure.mutuallySingular_singularPart _ _) κ κ + +section CompProd + +open Real Filter MeasurableSpace + +open scoped ENNReal NNReal Topology + +variable {α β γ : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} {mγ : MeasurableSpace γ} + {μ ν : Measure α} {κ η : Kernel α β} {f g : ℝ → ℝ} + +section SingularPart + +private lemma lintegral_apply_prodMk_preimage {f : α → Set β → ℝ≥0∞} (hf : ∀ a, f a ∅ = 0) + {s : Set α} (hs : MeasurableSet s) (t : Set β) : + ∫⁻ a, f a (Prod.mk a ⁻¹' s ×ˢ t) ∂μ = ∫⁻ a in s, f a t ∂μ := by + rw [← lintegral_indicator hs _] + congr with a + classical + rw [Set.indicator_apply] + split_ifs with ha <;> simp [ha, hf] + +variable [CountableOrCountablyGenerated α β] + +private lemma singularPart_compProd'' (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + (μ ⊗ₘ κ).singularPart (ν ⊗ₘ η) + = μ.singularPart ν ⊗ₘ η.withDensity (κ.rnDeriv η) + μ.singularPart ν ⊗ₘ κ.singularPart η + + ν.withDensity (∂μ/∂ν) ⊗ₘ κ.singularPart η := by + conv_lhs => rw [← κ.rnDeriv_add_singularPart η, Measure.compProd_add_right, + μ.haveLebesgueDecomposition_add ν] + simp_rw [Measure.compProd_add_left, Measure.singularPart_add] + have : (ν.withDensity (∂μ/∂ν) ⊗ₘ η.withDensity (κ.rnDeriv η)).singularPart (ν ⊗ₘ η) = 0 := by + refine Measure.singularPart_eq_zero_of_ac (Measure.AbsolutelyContinuous.compProd ?_ ?_) + · exact withDensity_absolutelyContinuous _ _ + · exact ae_of_all _ (Kernel.withDensity_absolutelyContinuous _) + rw [this, add_zero, ← add_assoc] + congr + · rw [Measure.singularPart_eq_self] + exact Measure.MutuallySingular.compProd_of_left (μ.mutuallySingular_singularPart ν) + (η.withDensity (κ.rnDeriv η)) η + · rw [Measure.singularPart_eq_self] + exact Measure.MutuallySingular.compProd_of_left (μ.mutuallySingular_singularPart ν) + (κ.singularPart η) η + · rw [Measure.singularPart_eq_self] + exact Measure.MutuallySingular.compProd_of_right (ν.withDensity (∂μ/∂ν)) ν + (.of_forall <| κ.mutuallySingular_singularPart _) + +lemma singularPart_compProd (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + (μ ⊗ₘ κ).singularPart (ν ⊗ₘ η) + = μ.singularPart ν ⊗ₘ η.withDensity (κ.rnDeriv η) + μ ⊗ₘ κ.singularPart η := by + rw [singularPart_compProd''] + have : (μ ⊗ₘ κ.singularPart η) = (μ.singularPart ν ⊗ₘ κ.singularPart η) + + (ν.withDensity (∂μ/∂ν) ⊗ₘ κ.singularPart η) := by + rw [← Measure.compProd_add_left, ← μ.haveLebesgueDecomposition_add ν] + rw [this] + abel + +lemma singularPart_compProd_right (μ : Measure α) [IsFiniteMeasure μ] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + (μ ⊗ₘ κ).singularPart (μ ⊗ₘ η) = μ ⊗ₘ κ.singularPart η := by + rw [singularPart_compProd, Measure.singularPart_self, Measure.compProd_zero_left, zero_add] + +lemma setLIntegral_singularPart (μ : Measure α) [IsFiniteMeasure μ] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] + {s : Set α} (hs : MeasurableSet s) {t : Set β} (ht : MeasurableSet t) : + ∫⁻ a in s, (κ a).singularPart (η a) t ∂μ = (μ ⊗ₘ κ).singularPart (μ ⊗ₘ η) (s ×ˢ t) := by + rw [singularPart_compProd_right, Measure.compProd_apply (hs.prod ht)] + simp only [Kernel.singularPart_eq_singularPart_measure] + rw [lintegral_apply_prodMk_preimage (fun _ ↦ by simp) hs] + +lemma lintegral_singularPart (μ : Measure α) [IsFiniteMeasure μ] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] + {s : Set β} (hs : MeasurableSet s) : + ∫⁻ a, (κ a).singularPart (η a) s ∂μ = (μ ⊗ₘ κ).singularPart (μ ⊗ₘ η) (.univ ×ˢ s) := by + rw [← setLIntegral_univ, setLIntegral_singularPart _ _ _ .univ hs] + +end SingularPart + +section Integrable + +variable {E : Type*} + +theorem _root_.MeasureTheory.Integrable.integral_compProd' [NormedAddCommGroup E] + [SFinite μ] [IsSFiniteKernel κ] ⦃f : α × β → E⦄ [NormedSpace ℝ E] + (hf : Integrable f (μ ⊗ₘ κ)) : + Integrable (fun x ↦ ∫ y, f (x, y) ∂(κ x)) μ := by + rw [Measure.compProd] at hf + simpa using hf.integral_compProd + +lemma integrable_f_rnDeriv_compProd_iff_of_nonneg [IsFiniteMeasure ν] [IsFiniteKernel η] + (h_ae : AEStronglyMeasurable (fun x ↦ f ((∂μ ⊗ₘ κ/∂ν ⊗ₘ η) x).toReal) (ν ⊗ₘ η)) + (h_nonneg : ∀ x, 0 ≤ x → 0 ≤ f x) : + Integrable (fun x ↦ f ((μ ⊗ₘ κ).rnDeriv (ν ⊗ₘ η) x).toReal) (ν ⊗ₘ η) + ↔ (∀ᵐ a ∂ν, Integrable (fun x ↦ f (((μ ⊗ₘ κ).rnDeriv (ν ⊗ₘ η)) (a, x)).toReal) (η a)) + ∧ Integrable (fun a ↦ ∫ b, f (((μ ⊗ₘ κ).rnDeriv (ν ⊗ₘ η)) (a, b)).toReal ∂(η a)) ν := by + refine ⟨fun h ↦ ?_, fun ⟨h1, h2⟩ ↦ ?_⟩ + · have h_int := h.integral_compProd' + rw [Measure.integrable_compProd_iff h_ae] at h + exact ⟨h.1, h_int⟩ + · rw [Measure.integrable_compProd_iff h_ae] + refine ⟨h1, ?_⟩ + convert h2 using 4 with a b + rw [norm_of_nonneg] + exact h_nonneg _ ENNReal.toReal_nonneg + +lemma integrable_add_affine_iff [IsFiniteMeasure μ] [IsFiniteMeasure ν] (f : ℝ → ℝ) (a b : ℝ) : + Integrable (fun x ↦ f (μ.rnDeriv ν x).toReal + a * (μ.rnDeriv ν x).toReal + b) ν + ↔ Integrable (fun x ↦ f (μ.rnDeriv ν x).toReal) ν := by + have h_int : Integrable (fun x ↦ a * (μ.rnDeriv ν x).toReal + b) ν := + (Measure.integrable_toReal_rnDeriv.const_mul _).add (integrable_const _) + simp_rw [add_assoc] + exact integrable_add_iff_integrable_left' h_int + +lemma integrable_sub_affine_iff [IsFiniteMeasure μ] [IsFiniteMeasure ν] (f : ℝ → ℝ) (a b : ℝ) : + Integrable (fun x ↦ f (μ.rnDeriv ν x).toReal - (a * (μ.rnDeriv ν x).toReal + b)) ν + ↔ Integrable (fun x ↦ f (μ.rnDeriv ν x).toReal) ν := by + simp_rw [sub_eq_add_neg, neg_add, ← neg_mul, ← add_assoc] + rw [integrable_add_affine_iff f] + +lemma integrable_f_rnDeriv_compProd_iff' [IsFiniteMeasure μ] [IsFiniteMeasure ν] + [IsFiniteKernel κ] [IsFiniteKernel η] (h_cvx : ConvexOn ℝ (Set.Ici 0) f) : + Integrable (fun x ↦ f ((μ ⊗ₘ κ).rnDeriv (ν ⊗ₘ η) x).toReal) (ν ⊗ₘ η) + ↔ (∀ᵐ a ∂ν, Integrable (fun x ↦ f (((μ ⊗ₘ κ).rnDeriv (ν ⊗ₘ η)) (a, x)).toReal) (η a)) + ∧ Integrable (fun a ↦ ∫ b, f (((μ ⊗ₘ κ).rnDeriv (ν ⊗ₘ η)) (a, b)).toReal ∂(η a)) ν := by + have h_meas_rnDeriv : Measurable fun x ↦ ((∂μ ⊗ₘ κ/∂ν ⊗ₘ η) x).toReal := + (Measure.measurable_rnDeriv _ _).ennreal_toReal + have h_meas : Measurable fun x ↦ f ((∂μ ⊗ₘ κ/∂ν ⊗ₘ η) x).toReal := + (h_cvx.subset Set.Ioi_subset_Ici_self (convex_Ioi 0)).measurable_comp_of_nonneg + h_meas_rnDeriv fun _ ↦ ENNReal.toReal_nonneg + obtain ⟨c, c', h⟩ : ∃ c c', ∀ x, _ → c * x + c' ≤ f x := h_cvx.exists_affine_le + simp only [Set.mem_Ici] at h + rw [← integrable_sub_affine_iff f c c'] + -- the function `f y - (c * y + c')` is nonnegative on `[0, ∞)` + rw [integrable_f_rnDeriv_compProd_iff_of_nonneg (f := fun y ↦ f y - (c * y + c'))] + rotate_left + · exact (h_meas.sub ((h_meas_rnDeriv.const_mul c).add_const c')).aestronglyMeasurable + · simpa using h + have h_int' : Integrable (fun p ↦ ((∂(μ ⊗ₘ κ)/∂(ν ⊗ₘ η)) p).toReal) (ν ⊗ₘ η) := + Measure.integrable_toReal_rnDeriv + rw [Measure.integrable_compProd_iff] at h_int' + swap; · exact (Measure.measurable_rnDeriv _ _).ennreal_toReal.aestronglyMeasurable + have h_int''' : ∀ᵐ a ∂ν, + Integrable (fun x ↦ c * ((∂μ ⊗ₘ κ/∂ν ⊗ₘ η) (a, x)).toReal + c') (η a) := by + filter_upwards [h_int'.1] with a h_int'' + exact ((h_int''.const_mul _).add (integrable_const _)) + -- The goal has shape `(P₁ ∧ Q₁) ↔ (P₂ ↔ Q₂)`. We prove first `P₁ ↔ P₂`. + have h_left : (∀ᵐ a ∂ν, Integrable (fun x ↦ f (((μ ⊗ₘ κ).rnDeriv (ν ⊗ₘ η)) (a, x)).toReal + - (c * (((μ ⊗ₘ κ).rnDeriv (ν ⊗ₘ η)) (a, x)).toReal + c')) (η a)) + ↔ ∀ᵐ a ∂ν, Integrable (fun x ↦ f (((μ ⊗ₘ κ).rnDeriv (ν ⊗ₘ η)) (a, x)).toReal) (η a) := by + refine Filter.eventually_congr ?_ + filter_upwards [h_int'''] with a h_int''' + simp_rw [sub_eq_add_neg] + exact integrable_add_iff_integrable_left' h_int'''.fun_neg + rw [h_left, and_congr_right_iff] + -- Now we have proved `P₁ ↔ P₂` and it remains to prove `P₂ → (Q₁ ↔ Q₂)`. + intro h_int + have : ∀ᵐ a ∂ν, ∫ b, f (((μ ⊗ₘ κ).rnDeriv (ν ⊗ₘ η)) (a, b)).toReal + - (c * (((μ ⊗ₘ κ).rnDeriv (ν ⊗ₘ η)) (a, b)).toReal + c') ∂η a + = ∫ b, f ((∂(μ ⊗ₘ κ)/∂(ν ⊗ₘ η)) (a, b)).toReal ∂η a + - ∫ b, c * ((∂(μ ⊗ₘ κ)/∂(ν ⊗ₘ η)) (a, b)).toReal + c' ∂η a := by + filter_upwards [h_int, h_int'''] with a h_int h_int''' + rw [← integral_sub h_int h_int'''] + rw [integrable_congr this] + simp_rw [sub_eq_add_neg] + rw [integrable_add_iff_integrable_left'] + -- `⊢ Integrable (fun x ↦ -∫ (b : β), c * ((∂(μ ⊗ₘ κ)/∂(ν ⊗ₘ η)) (x, b)).toReal + c' ∂η x) ν` + have h_int_compProd : + Integrable (fun x ↦ ∫ b, ((∂(μ ⊗ₘ κ)/∂(ν ⊗ₘ η)) (x, b)).toReal ∂η x) ν := by + convert h_int'.2 with a b + rw [norm_of_nonneg ENNReal.toReal_nonneg] + have : ∀ᵐ x ∂ν, -∫ b, c * ((∂(μ ⊗ₘ κ)/∂(ν ⊗ₘ η)) (x, b)).toReal + c' ∂η x + = -c * ∫ b, ((∂(μ ⊗ₘ κ)/∂(ν ⊗ₘ η)) (x, b)).toReal ∂η x + - c' * (η x .univ).toReal := by + filter_upwards [h_int'.1] with x h_int' + rw [integral_add _ (integrable_const _)] + swap; · exact h_int'.const_mul _ + simp only [integral_const, smul_eq_mul, neg_add_rev, neg_mul] + rw [add_comm, mul_comm] + congr 1 + rw [mul_comm c, ← smul_eq_mul, ← integral_smul_const] + simp_rw [smul_eq_mul, mul_comm _ c] + rw [integrable_congr this] + refine Integrable.sub (h_int_compProd.const_mul _) (Integrable.const_mul ?_ _) + simp_rw [← measureReal_def, ← integral_indicator_one MeasurableSet.univ] + simp only [Set.mem_univ, Set.indicator_of_mem, Pi.one_apply] + exact Integrable.integral_compProd' (f := fun _ ↦ 1) (integrable_const _) + +variable [CountableOrCountablyGenerated α β] + +lemma f_compProd_congr (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + ∀ᵐ a ∂ν, (fun b ↦ f ((∂μ ⊗ₘ κ/∂ν ⊗ₘ η) (a, b)).toReal) + =ᵐ[η a] fun b ↦ f ((∂μ/∂ν) a * (∂κ a/∂η a) b).toReal := by + have h_eq_compProd := Kernel.rnDeriv_measure_compProd' μ ν κ η + filter_upwards [h_eq_compProd] with a ha + filter_upwards [ha] with b hb + rw [hb] + +lemma integrable_f_rnDeriv_compProd_iff [IsFiniteMeasure μ] [IsFiniteMeasure ν] + [IsFiniteKernel κ] [IsFiniteKernel η] (h_cvx : ConvexOn ℝ (Set.Ici 0) f) : + Integrable (fun x ↦ f ((μ ⊗ₘ κ).rnDeriv (ν ⊗ₘ η) x).toReal) (ν ⊗ₘ η) + ↔ (∀ᵐ a ∂ν, Integrable (fun x ↦ f ((∂μ/∂ν) a * (∂κ a/∂η a) x).toReal) (η a)) + ∧ Integrable (fun a ↦ ∫ b, f ((∂μ/∂ν) a * (∂κ a/∂η a) b).toReal ∂(η a)) ν := by + have h_ae_eq : ∀ᵐ a ∂ν, (fun y ↦ f ((∂μ ⊗ₘ κ/∂ν ⊗ₘ η) (a, y)).toReal) + =ᵐ[η a] fun x ↦ f ((∂μ/∂ν) a * (∂κ a/∂η a) x).toReal := f_compProd_congr μ ν κ η + rw [integrable_f_rnDeriv_compProd_iff' h_cvx] + congr! 1 + · refine ⟨fun h ↦ ?_, fun h ↦ ?_⟩ + · filter_upwards [h_ae_eq, h] with a ha h + rwa [integrable_congr ha.symm] + · filter_upwards [h_ae_eq, h] with a ha h + rwa [integrable_congr ha] + · refine integrable_congr ?_ + filter_upwards [h_ae_eq] with a ha + exact integral_congr_ae ha + +lemma integrable_f_rnDeriv_compProd_right_iff [IsFiniteMeasure μ] + [IsFiniteKernel κ] [IsFiniteKernel η] (h_cvx : ConvexOn ℝ (Set.Ici 0) f) : + Integrable (fun x ↦ f ((μ ⊗ₘ κ).rnDeriv (μ ⊗ₘ η) x).toReal) (μ ⊗ₘ η) + ↔ (∀ᵐ a ∂μ, Integrable (fun x ↦ f ((∂κ a/∂η a) x).toReal) (η a)) + ∧ Integrable (fun a ↦ ∫ b, f ((∂κ a/∂η a) b).toReal ∂(η a)) μ := by + rw [integrable_f_rnDeriv_compProd_iff h_cvx] + have h_one := μ.rnDeriv_self + refine ⟨fun ⟨h1, h2⟩ ↦ ⟨?_, ?_⟩, fun ⟨h1, h2⟩ ↦ ⟨?_, ?_⟩⟩ + · filter_upwards [h1, h_one] with a ha1 ha2 + simpa [ha2] using ha1 + · refine (integrable_congr ?_).mpr h2 + filter_upwards [h_one] with a ha + simp [ha] + · filter_upwards [h1, h_one] with a ha1 ha2 + simpa [ha2] using ha1 + · refine (integrable_congr ?_).mpr h2 + filter_upwards [h_one] with a ha + simp [ha] + +end Integrable + +lemma Measure.compProd_apply_toReal [SFinite μ] [IsFiniteKernel κ] + {s : Set (α × β)} (hs : MeasurableSet s) : + ((μ ⊗ₘ κ) s).toReal = ∫ x, (κ x (Prod.mk x ⁻¹' s)).toReal ∂μ := by + rw [Measure.compProd_apply hs, integral_eq_lintegral_of_nonneg_ae] + rotate_left + · exact ae_of_all _ (fun x ↦ by positivity) + · exact (Kernel.measurable_kernel_prodMk_left hs).ennreal_toReal.aestronglyMeasurable + congr with x + rw [ENNReal.ofReal_toReal (measure_ne_top _ _)] + +lemma Measure.compProd_univ_toReal [SFinite μ] [IsFiniteKernel κ] : + ((μ ⊗ₘ κ) .univ).toReal = ∫ x, (κ x .univ).toReal ∂μ := + compProd_apply_toReal .univ + +end CompProd + +end ProbabilityTheory diff --git a/Statlib/ForMathlib/Probability/Kernel/Composition/RadonNikodym.lean b/Statlib/ForMathlib/Probability/Kernel/Composition/RadonNikodym.lean new file mode 100644 index 0000000..5738914 --- /dev/null +++ b/Statlib/ForMathlib/Probability/Kernel/Composition/RadonNikodym.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.Probability.Kernel.Composition.RadonNikodym + +/-! +# Radon-Nikodym derivatives of composition-products, in "a.e. a, a.e. b" form + +* `ProbabilityTheory.Kernel.rnDeriv_measure_compProd_right'`, + `ProbabilityTheory.Kernel.rnDeriv_measure_compProd'`: corollaries of the Mathlib results + `rnDeriv_measure_compProd_right` and `rnDeriv_measure_compProd`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open MeasureTheory MeasurableSpace Set + +open scoped ENNReal + +namespace ProbabilityTheory.Kernel + +variable {α γ : Type*} {mα : MeasurableSpace α} {mγ : MeasurableSpace γ} + {μ ν : Measure α} {κ η : Kernel α γ} + +variable [CountableOrCountablyGenerated α γ] + +lemma rnDeriv_measure_compProd_right' (μ : Measure α) (κ η : Kernel α γ) + [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] : + ∀ᵐ a ∂μ, (fun x ↦ (∂(μ ⊗ₘ κ)/∂(μ ⊗ₘ η)) (a, x)) + =ᵐ[η a] fun x ↦ (∂κ a/∂η a) x := by + have h a := κ.rnDeriv_eq_rnDeriv_measure (η := η) (a := a) + have h' := Measure.ae_ae_of_ae_compProd <| rnDeriv_measure_compProd_right μ κ η + filter_upwards [h'] with a ha + filter_upwards [ha, h a] with b hb1 hb2 + rw [hb1, hb2] + +lemma rnDeriv_measure_compProd' (μ ν : Measure α) (κ η : Kernel α γ) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] [IsFiniteKernel κ] [IsFiniteKernel η] : + ∀ᵐ a ∂ν, (fun b ↦ (∂(μ ⊗ₘ κ)/∂(ν ⊗ₘ η)) (a, b)) + =ᵐ[η a] fun b ↦ (∂μ/∂ν) a * (∂κ a/∂η a) b := by + have h a := κ.rnDeriv_eq_rnDeriv_measure (η := η) (a := a) + have h' := Measure.ae_ae_of_ae_compProd <| rnDeriv_measure_compProd μ ν κ η + filter_upwards [h'] with a ha + filter_upwards [ha, h a] with b hb1 hb2 + rw [hb1, hb2] + +end ProbabilityTheory.Kernel diff --git a/Statlib/ForMathlib/Topology/Order/MonotoneConvergence.lean b/Statlib/ForMathlib/Topology/Order/MonotoneConvergence.lean new file mode 100644 index 0000000..c62483d --- /dev/null +++ b/Statlib/ForMathlib/Topology/Order/MonotoneConvergence.lean @@ -0,0 +1,26 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne +-/ +module + +public import Mathlib.Topology.Order.MonotoneConvergence + +/-! +# Limits at infinity of functions monotone on a final segment + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open Filter Set Topology + +/-- A function to a complete linear order which is monotone on `[x, ∞)` has a limit at `atTop`. -/ +lemma MonotoneOn.exists_tendsto_atTop {ι α : Type*} [SemilatticeSup ι] [CompleteLinearOrder α] + [TopologicalSpace α] [OrderTopology α] {x : ι} {f : ι → α} (hf : MonotoneOn f (Ici x)) : + ∃ y, Tendsto f atTop (𝓝 y) := + ⟨_, (tendsto_atTop_iSup fun _ _ hyz ↦ hf le_sup_left le_sup_left (sup_le_sup_left hyz x)).congr' + ((eventually_ge_atTop x).mono fun _ hz ↦ by simp [sup_of_le_right hz])⟩ diff --git a/Statlib/Testing/Binary.lean b/Statlib/Testing/Binary.lean new file mode 100644 index 0000000..dcdcde8 --- /dev/null +++ b/Statlib/Testing/Binary.lean @@ -0,0 +1,432 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne, Lorenzo Luccioli +-/ +module + +public import Mathlib.Algebra.Order.Module.Basic +public import Mathlib.MeasureTheory.Measure.Decomposition.IntegralRNDeriv +public import Mathlib.Probability.Decision.BayesEstimator +public import Mathlib.Probability.Decision.Risk.Basic +public import Statlib.ForMathlib.Probability.Decision.BayesEstimator + +/-! +# Simple Bayesian binary hypothesis testing + +We test between two measures `μ` and `ν`, with a prior `π` on `Bool` (`false` stands for `μ` and +`true` for `ν`) and the 0-1 loss. This is the estimation problem with parameter space `Bool`, +data generating kernel `Kernel.boolKernel μ ν` and loss `simpleBinaryLoss`. + +## Main definitions + +* `simpleBinaryLoss`: the 0-1 loss on `Bool`, `ℓ(y, z) = 𝕀{y ≠ z}`. +* `bayesBinaryRisk μ ν π`: the Bayes risk of the simple binary hypothesis testing problem between + `μ` and `ν` with respect to the prior `π`. + +## Main statements + +* `bayesBinaryRisk_le_bayesBinaryRisk_comp`: data-processing inequality. +* `bayesBinaryRisk_eq_iInf_measurableSet`: the Bayes binary risk is the infimum over the measurable + sets `E` of the risk `π {false} * μ E + π {true} * ν Eᶜ` of the test with rejection region `E`. +* `bayesBinaryRisk_eq_lintegral_min_rnDeriv`: the Bayes binary risk is + `∫⁻ x, min (π {false} * (∂μ/∂ν) x) (π {true}) ∂ν`. +* `bayesBinaryRisk_eq_lintegral_min`, `toReal_bayesBinaryRisk_eq_integral_abs`: integral formulas + for the Bayes binary risk with respect to the joint law `Kernel.boolKernel μ ν ∘ₘ π`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open MeasureTheory + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +variable {𝒳 𝒳' : Type*} {m𝒳 : MeasurableSpace 𝒳} {m𝒳' : MeasurableSpace 𝒳'} + {μ ν : Measure 𝒳} + +section SimpleBinaryHypTest + +/-- The loss of the simple binary hypothesis testing problem: `ℓ(y, z) = 𝕀{y ≠ z}`. -/ +noncomputable +def simpleBinaryLoss (y z : Bool) : ℝ≥0∞ := if y = z then 0 else 1 + +@[simp] lemma simpleBinaryLoss_self (y : Bool) : simpleBinaryLoss y y = 0 := by + simp [simpleBinaryLoss] + +@[simp] lemma simpleBinaryLoss_true_false : simpleBinaryLoss true false = 1 := by + simp [simpleBinaryLoss] + +@[simp] lemma simpleBinaryLoss_false_true : simpleBinaryLoss false true = 1 := by + simp [simpleBinaryLoss] + +lemma measurable_simpleBinaryLoss : Measurable (Function.uncurry simpleBinaryLoss) := + .of_discrete + +@[simp] +lemma lintegral_simpleBinaryLoss_true (ξ : Measure Bool) : + ∫⁻ z, simpleBinaryLoss true z ∂ξ = ξ {false} := by + simp [lintegral_fintype, simpleBinaryLoss] + +@[simp] +lemma lintegral_simpleBinaryLoss_false (ξ : Measure Bool) : + ∫⁻ z, simpleBinaryLoss false z ∂ξ = ξ {true} := by + simp [lintegral_fintype, simpleBinaryLoss] + +/-- The function `x ↦ 𝕀{π₀ * ∂μ/∂(boolKernel μ ν ∘ₘ π) x ≤ π₁ * ∂ν/∂(boolKernel μ ν ∘ₘ π) x}`. +It is an argmin estimator for the simple binary hypothesis testing problem. -/ +noncomputable +def binaryArgminEstimator (μ ν : Measure 𝒳) (π : Measure Bool) : 𝒳 → Bool := + let E : Set 𝒳 := {x | π {false} * μ.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x + ≤ π {true} * ν.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x} + fun x ↦ Bool.ofNat (E.indicator 1 x) + +lemma isArgminEstimator_binaryArgminEstimator (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] : + IsArgminEstimator simpleBinaryLoss (Kernel.boolKernel μ ν) π + (binaryArgminEstimator μ ν π) := by + refine ⟨?_, ?_⟩ + · simp_rw [binaryArgminEstimator] + refine Measurable.of_discrete.fun_comp (measurable_one.indicator (measurableSet_le ?_ ?_)) + <;> fun_prop + · filter_upwards [posterior_boolKernel_apply_true μ ν π, + posterior_boolKernel_apply_false μ ν π] with x h_true h_false + refine le_antisymm (le_iInf fun b ↦ ?_) (iInf_le _ _) + cases b <;> by_cases + π {false} * (∂μ/∂Kernel.boolKernel μ ν ∘ₘ π) x + ≤ π {true} * (∂ν/∂Kernel.boolKernel μ ν ∘ₘ π) x + <;> simp_all [lintegral_bool, binaryArgminEstimator, Bool.ofNat, simpleBinaryLoss, + -not_le, le_of_not_ge] + +lemma hasArgminEstimator_simpleBinaryLoss (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] : + HasArgminEstimator simpleBinaryLoss (Kernel.boolKernel μ ν) π := + ⟨_, isArgminEstimator_binaryArgminEstimator μ ν π⟩ + +end SimpleBinaryHypTest + +/-- The Bayes risk of simple binary hypothesis testing with respect to a prior. -/ +noncomputable +def bayesBinaryRisk (μ ν : Measure 𝒳) (π : Measure Bool) : ℝ≥0∞ := + bayesRisk simpleBinaryLoss (Kernel.boolKernel μ ν) π + +lemma bayesBinaryRisk_eq_iInf_kernel (μ ν : Measure 𝒳) (π : Measure Bool) : + bayesBinaryRisk μ ν π + = ⨅ (κ : Kernel 𝒳 Bool) (_ : IsMarkovKernel κ), + π {true} * (κ ∘ₘ ν) {false} + π {false} * (κ ∘ₘ μ) {true} := by + rw [bayesBinaryRisk, bayesRisk] + congr with κ + congr with _ + simp only [avgRisk, lintegral_bool, Kernel.comp_boolKernel, Kernel.boolKernel_apply, + Bool.false_eq_true, ↓reduceIte, simpleBinaryLoss_self, simpleBinaryLoss_true_false, + simpleBinaryLoss_false_true, zero_mul, one_mul, zero_add, add_zero] + ring + +variable {π : Measure Bool} + +/-- `B (a•μ, b•ν; π) = B (μ, ν; (a*π₀, b*π₁)).` -/ +lemma bayesBinaryRisk_smul_smul (μ ν : Measure 𝒳) (π : Measure Bool) (a b : ℝ≥0∞) : + bayesBinaryRisk (a • μ) (b • ν) π + = bayesBinaryRisk μ ν (π.withDensity (fun x ↦ bif x then b else a)) := by + simp [bayesBinaryRisk_eq_iInf_kernel, lintegral_dirac, mul_assoc] + +lemma bayesBinaryRisk_eq_bayesBinaryRisk_one_one (μ ν : Measure 𝒳) (π : Measure Bool) : + bayesBinaryRisk μ ν π + = bayesBinaryRisk (π {false} • μ) (π {true} • ν) (Measure.boolMeasure 1 1) := by + rw [bayesBinaryRisk_smul_smul, Measure.eq_boolMeasure π, Measure.withDensity_eq_boolMeasure] + simp + +/-- **Data processing inequality** for the Bayes binary risk. -/ +lemma bayesBinaryRisk_le_bayesBinaryRisk_comp (μ ν : Measure 𝒳) (π : Measure Bool) + (η : Kernel 𝒳 𝒳') [IsMarkovKernel η] : + bayesBinaryRisk μ ν π ≤ bayesBinaryRisk (η ∘ₘ μ) (η ∘ₘ ν) π := + (bayesRisk_le_bayesRisk_comp _ _ _ η).trans_eq (by simp [bayesBinaryRisk, Kernel.comp_boolKernel]) + +@[simp] +lemma bayesBinaryRisk_self (μ : Measure 𝒳) (π : Measure Bool) : + bayesBinaryRisk μ μ π = min (π {false}) (π {true}) * μ .univ := by + rw [bayesBinaryRisk_eq_iInf_kernel] + refine le_antisymm ?_ ?_ + · let η : Kernel 𝒳 Bool := + if π {true} ≤ π {false} then (Kernel.const 𝒳 (Measure.dirac false)) + else (Kernel.const 𝒳 (Measure.dirac true)) + refine iInf_le_of_le η ?_ + simp_rw [η] + convert iInf_le _ ?_ using 1 + · split_ifs with h <;> simp [le_of_not_ge, h] + · split_ifs <;> infer_instance + · calc + _ ≥ ⨅ κ, ⨅ (_ : IsMarkovKernel κ), min (π {false}) (π {true}) * (κ ∘ₘ μ) {false} + + min (π {false}) (π {true}) * (κ ∘ₘ μ) {true} := by + gcongr <;> simp + _ = ⨅ κ, ⨅ (_ : IsMarkovKernel κ), min (π {false}) (π {true}) * μ .univ := by + simp_rw [← mul_add, ← measure_union (show Disjoint {false} {true} from by simp) + (by trivial), (set_fintype_card_eq_univ_iff ({false} ∪ {true})).mp rfl, + Measure.comp_apply_univ] + rfl + _ = _ := by + rw [iInf_subtype'] + convert iInf_const + infer_instance + +lemma bayesBinaryRisk_dirac (a b : ℝ≥0∞) (x : 𝒳) (π : Measure Bool) : + bayesBinaryRisk (a • Measure.dirac x) (b • Measure.dirac x) π + = min (π {false} * a) (π {true} * b) := by + rw [bayesBinaryRisk_smul_smul, bayesBinaryRisk_self] + simp [lintegral_dirac] + +lemma bayesBinaryRisk_le_min (μ ν : Measure 𝒳) (π : Measure Bool) : + bayesBinaryRisk μ ν π ≤ min (π {false} * μ .univ) (π {true} * ν .univ) := by + convert bayesBinaryRisk_le_bayesBinaryRisk_comp μ ν π (Kernel.discard 𝒳) + rw [Measure.discard_comp, Measure.discard_comp, bayesBinaryRisk_dirac] + +@[simp] lemma bayesBinaryRisk_zero_left : bayesBinaryRisk 0 ν π = 0 := + le_antisymm ((bayesBinaryRisk_le_min _ _ _).trans (by simp)) zero_le + +@[simp] lemma bayesBinaryRisk_zero_right : bayesBinaryRisk μ 0 π = 0 := + le_antisymm ((bayesBinaryRisk_le_min _ _ _).trans (by simp)) zero_le + +@[simp] lemma bayesBinaryRisk_zero_prior : bayesBinaryRisk μ ν 0 = 0 := + le_antisymm ((bayesBinaryRisk_le_min _ _ _).trans (by simp)) zero_le + +lemma bayesBinaryRisk_ne_top (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + (π : Measure Bool) [IsFiniteMeasure π] : + bayesBinaryRisk μ ν π ≠ ∞ := by + refine lt_top_iff_ne_top.mp ((bayesBinaryRisk_le_min μ ν π).trans_lt ?_) + exact min_lt_iff.mpr <| Or.inl <| ENNReal.mul_lt_top (measure_lt_top π _) (measure_lt_top μ _) + +lemma bayesBinaryRisk_of_measure_true_eq_zero (μ ν : Measure 𝒳) (hπ : π {true} = 0) : + bayesBinaryRisk μ ν π = 0 := + le_antisymm ((bayesBinaryRisk_le_min _ _ _).trans (by simp [hπ])) zero_le + +lemma bayesBinaryRisk_of_measure_false_eq_zero (μ ν : Measure 𝒳) (hπ : π {false} = 0) : + bayesBinaryRisk μ ν π = 0 := + le_antisymm ((bayesBinaryRisk_le_min _ _ _).trans (by simp [hπ])) zero_le + +lemma bayesBinaryRisk_symm (μ ν : Measure 𝒳) (π : Measure Bool) : + bayesBinaryRisk μ ν π = bayesBinaryRisk ν μ (π.map Bool.not) := by + have : (Bool.not ⁻¹' {true}) = {false} := by ext x; simp + have h1 : (π.map Bool.not) {true} = π {false} := by + rw [Measure.map_apply (by exact fun _ a ↦ a) (by trivial), this] + have : (Bool.not ⁻¹' {false}) = {true} := by ext x; simp + have h2 : (π.map Bool.not) {false} = π {true} := by + rw [Measure.map_apply (by exact fun _ a ↦ a) (by trivial), this] + simp_rw [bayesBinaryRisk_eq_iInf_kernel, h1, h2, add_comm, iInf_subtype'] + -- from this point on the proof is basically a change of variable inside the iInf, + -- to do this I define an equivalence between `Subtype IsMarkovKernel` and itself through + -- the `Bool.not` operation, maybe it can be shortened or something can be separated as + -- a different lemma, but I'm not sure how useful this would be + let e : (Kernel 𝒳 Bool) ≃ (Kernel 𝒳 Bool) := by + have h_id : (Kernel.deterministic Bool.not .of_discrete).comap Bool.not .of_discrete + = Kernel.id := by + ext x : 1 + simp_rw [Kernel.comap_apply, Kernel.deterministic_apply, Kernel.id_apply, Bool.not_not] + refine ⟨fun κ ↦ (Kernel.deterministic Bool.not .of_discrete) ∘ₖ κ, + fun κ ↦ (Kernel.deterministic Bool.not .of_discrete) ∘ₖ κ, fun κ ↦ ?_, fun κ ↦ ?_⟩ <;> + · dsimp + ext x : 1 + rw [← Kernel.comp_assoc, Kernel.comp_deterministic_eq_comap, h_id, Kernel.id_comp] + let e' : (Subtype (@IsMarkovKernel 𝒳 Bool _ _)) ≃ (Subtype (@IsMarkovKernel 𝒳 Bool _ _)) := by + refine ⟨fun ⟨κ, _⟩ ↦ ⟨e κ, ?_⟩, fun ⟨κ, _⟩ ↦ ⟨e.symm κ, ?_⟩, fun κ ↦ by simp, fun κ ↦ by simp⟩ + <;> simp only [Equiv.coe_fn_mk, Equiv.coe_fn_symm_mk, e] <;> infer_instance + rw [← Equiv.iInf_comp e'] + congr with κ + simp only [Equiv.coe_fn_mk, Equiv.coe_fn_symm_mk, e', e] + have h3 b : Set.indicator {true} (1 : Bool → ℝ≥0∞) b.not = Set.indicator {false} 1 b := by + cases b <;> simp + have h4 b : Set.indicator {false} (1 : Bool → ℝ≥0∞) b.not = Set.indicator {true} 1 b := by + cases b <;> simp + congr 2 <;> + · rw [Measure.bind_apply (by trivial) (Kernel.measurable _).aemeasurable, + Measure.bind_apply (by trivial) (Kernel.measurable _).aemeasurable] + congr with x + rw [Kernel.comp_apply'] + simp only [Measure.dirac_apply' _ (show MeasurableSet {true} by trivial), + Measure.dirac_apply' _ (show MeasurableSet {false} by trivial), Kernel.deterministic_apply] + swap; trivial + simp [h3, h4, lintegral_bool] + +lemma avgRisk_binary_of_deterministic_indicator (μ ν : Measure 𝒳) (π : Measure Bool) + {E : Set 𝒳} (hE : MeasurableSet E) : + avgRisk simpleBinaryLoss (Kernel.boolKernel μ ν) + (Kernel.deterministic (fun x ↦ Bool.ofNat (E.indicator 1 x)) + (Measurable.of_discrete.fun_comp (measurable_one.indicator hE))) π + = π {false} * μ E + π {true} * ν Eᶜ := by + have h_meas : Measurable fun x ↦ Bool.ofNat (E.indicator 1 x) := + Measurable.of_discrete.fun_comp (measurable_one.indicator hE) + have h1 : (fun x ↦ Bool.ofNat (E.indicator 1 x)) ⁻¹' {false} = Eᶜ := by + ext; simp [Bool.ofNat] + have h2 : (fun x ↦ Bool.ofNat (E.indicator 1 x)) ⁻¹' {true} = E := by + ext; simp [Bool.ofNat] + simp only [avgRisk, lintegral_bool, Kernel.comp_boolKernel, Kernel.boolKernel_apply, + Bool.false_eq_true, ↓reduceIte, simpleBinaryLoss_self, simpleBinaryLoss_true_false, + simpleBinaryLoss_false_true, zero_mul, one_mul, zero_add, add_zero, + Measure.deterministic_comp_eq_map, Measure.map_apply h_meas trivial, h1, h2] + ring + +lemma bayesBinaryRisk_eq_iInf_measurableSet (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] : + bayesBinaryRisk μ ν π = ⨅ E, ⨅ (_ : MeasurableSet E), π {false} * μ E + π {true} * ν Eᶜ := by + apply le_antisymm + · simp_rw [le_iInf_iff, bayesBinaryRisk, bayesRisk] + intro E hE + rw [← avgRisk_binary_of_deterministic_indicator _ _ _ hE] + exact iInf_le_of_le _ (iInf_le _ (Kernel.isMarkovKernel_deterministic _)) + · let E := {x | π {false} * (∂μ/∂Kernel.boolKernel μ ν ∘ₘ π) x + ≤ π {true} * (∂ν/∂Kernel.boolKernel μ ν ∘ₘ π) x} + have hE : MeasurableSet E := measurableSet_le (by fun_prop) (by fun_prop) + rw [bayesBinaryRisk, ← (isArgminEstimator_binaryArgminEstimator μ ν π).isBayesEstimator + measurable_simpleBinaryLoss, IsArgminEstimator.kernel] + simp_rw [binaryArgminEstimator] + rw [avgRisk_binary_of_deterministic_indicator _ _ _ hE] + exact iInf_le_of_le E (iInf_le _ hE) + +lemma bayesBinaryRisk_eq_lintegral_min (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] : + bayesBinaryRisk μ ν π = ∫⁻ x, min (π {false} * μ.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x) + (π {true} * ν.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x) ∂(Kernel.boolKernel μ ν ∘ₘ π) := by + simp_rw [bayesBinaryRisk, bayesRisk_boolKernel_eq_lintegral_iInf measurable_simpleBinaryLoss μ ν π + (hasArgminEstimator_simpleBinaryLoss μ ν π), iInf_bool_eq] + simp + +/-- The Bayes binary risk as an integral with respect to `ν`. The singular part of `μ` with respect +to `ν` does not contribute: the optimal test rejects `μ` on a `ν`-null set carrying it. -/ +lemma bayesBinaryRisk_eq_lintegral_min_rnDeriv (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] : + bayesBinaryRisk μ ν π = ∫⁻ x, min (π {false} * (∂μ/∂ν) x) (π {true}) ∂ν := by + set F := {x | π {false} * (∂μ/∂ν) x ≤ π {true}} + have hF : MeasurableSet F := measurableSet_le (by fun_prop) measurable_const + rw [bayesBinaryRisk_eq_iInf_measurableSet] + refine le_antisymm ?_ (le_iInf₂ fun E hE ↦ ?_) + · -- the risk of the test with rejection region `F ∩ t`, where `t` is a `ν`-full set on which the + -- singular part of `μ` vanishes + obtain ⟨t, ht, hμt, hνt⟩ : ∃ t, MeasurableSet t ∧ μ.singularPart ν t = 0 ∧ ν tᶜ = 0 := + let h := μ.mutuallySingular_singularPart ν + ⟨h.nullSet, h.measurableSet_nullSet, h.measure_nullSet, h.measure_compl_nullSet⟩ + have h_false : μ (F ∩ t) ≤ ∫⁻ x in F, (∂μ/∂ν) x ∂ν := by + conv_lhs => rw [μ.haveLebesgueDecomposition_add ν] + rw [Measure.add_apply, withDensity_apply _ (hF.inter ht), + measure_mono_null Set.inter_subset_right hμt, zero_add] + exact lintegral_mono_set Set.inter_subset_left + have h_true : ν (F ∩ t)ᶜ ≤ ν Fᶜ := by + rw [Set.compl_inter] + refine (measure_union_le _ _).trans ?_ + rw [hνt, add_zero] + refine (iInf₂_le (F ∩ t) (hF.inter ht)).trans ?_ + calc π {false} * μ (F ∩ t) + π {true} * ν (F ∩ t)ᶜ + _ ≤ π {false} * ∫⁻ x in F, (∂μ/∂ν) x ∂ν + π {true} * ν Fᶜ := by grw [h_false, h_true] + _ = ∫⁻ x in F, π {false} * (∂μ/∂ν) x ∂ν + ∫⁻ x in Fᶜ, π {true} ∂ν := by + rw [lintegral_const_mul _ (μ.measurable_rnDeriv ν), setLIntegral_const] + _ = ∫⁻ x, min (π {false} * (∂μ/∂ν) x) (π {true}) ∂ν := by + conv_rhs => rw [← lintegral_add_compl _ hF] + congr 1 + · exact setLIntegral_congr_fun hF fun x hx ↦ (min_eq_left hx).symm + · exact setLIntegral_congr_fun hF.compl fun x hx ↦ (min_eq_right (not_le.mp hx).le).symm + · -- every test has risk at least the integral of the minimum + calc ∫⁻ x, min (π {false} * (∂μ/∂ν) x) (π {true}) ∂ν + _ = ∫⁻ x in E, min (π {false} * (∂μ/∂ν) x) (π {true}) ∂ν + + ∫⁻ x in Eᶜ, min (π {false} * (∂μ/∂ν) x) (π {true}) ∂ν := (lintegral_add_compl _ hE).symm + _ ≤ ∫⁻ x in E, π {false} * (∂μ/∂ν) x ∂ν + ∫⁻ x in Eᶜ, π {true} ∂ν := by + gcongr with x x + · exact min_le_left _ _ + · exact min_le_right _ _ + _ = π {false} * ν.withDensity (∂μ/∂ν) E + π {true} * ν Eᶜ := by + rw [lintegral_const_mul _ (μ.measurable_rnDeriv ν), withDensity_apply _ hE, + setLIntegral_const] + _ ≤ π {false} * μ E + π {true} * ν Eᶜ := by + gcongr + exact μ.withDensity_rnDeriv_le ν + +lemma toReal_bayesBinaryRisk_eq_integral_min (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] : + (bayesBinaryRisk μ ν π).toReal + = ∫ x, min (π {false} * μ.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x).toReal + (π {true} * ν.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x).toReal + ∂(Kernel.boolKernel μ ν ∘ₘ π) := by + rw [bayesBinaryRisk_eq_lintegral_min, integral_eq_lintegral_of_nonneg_ae] + rotate_left + · filter_upwards with x; positivity + · refine Measurable.aestronglyMeasurable <| Measurable.min ?_ ?_ + <;> exact Measure.measurable_rnDeriv _ _ |>.const_mul _ |>.ennreal_toNNReal |>.coe_nnreal_real + congr 1 + apply lintegral_congr_ae + filter_upwards [μ.rnDeriv_ne_top _, ν.rnDeriv_ne_top _] with x hxμ hxν + have : (π {false} * μ.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x) ≠ ⊤ := + (ENNReal.mul_ne_top (measure_ne_top _ _) hxμ) + have : (π {true} * ν.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x) ≠ ⊤ := + (ENNReal.mul_ne_top (measure_ne_top _ _) hxν) + rcases le_total (π {false} * μ.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x) + (π {true} * ν.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x) with h | h + all_goals + · have h' := (ENNReal.toReal_le_toReal (by assumption) (by assumption)).mpr h + simp only [h, h', min_eq_left, min_eq_right] + exact (ENNReal.ofReal_toReal_eq_iff.mpr (by assumption)).symm + +lemma toReal_bayesBinaryRisk_eq_integral_abs (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] : + (bayesBinaryRisk μ ν π).toReal + = 2⁻¹ * (((Kernel.boolKernel μ ν ∘ₘ π) .univ).toReal + - ∫ x, |(π {false} * μ.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x).toReal + - (π {true} * ν.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x).toReal| + ∂(Kernel.boolKernel μ ν ∘ₘ π)) := by + simp_rw [toReal_bayesBinaryRisk_eq_integral_min, inf_eq_half_smul_add_sub_abs_sub' ℝ, smul_eq_mul, + integral_const_mul, abs_sub_comm (π {true} * _).toReal] + congr + have hμ_int : Integrable (fun x ↦ (π {false} * μ.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x).toReal) + (Kernel.boolKernel μ ν ∘ₘ π) := by + simp_rw [ENNReal.toReal_mul] + exact Integrable.const_mul Measure.integrable_toReal_rnDeriv _ + have hν_int : Integrable (fun x ↦ (π {true} * ν.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x).toReal) + (Kernel.boolKernel μ ν ∘ₘ π) := by + simp_rw [ENNReal.toReal_mul] + exact Integrable.const_mul Measure.integrable_toReal_rnDeriv _ + have h_int_abs : Integrable + (fun x ↦ |(π {false} * μ.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x).toReal + - (π {true} * ν.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x).toReal|) + (Kernel.boolKernel μ ν ∘ₘ π) := + hμ_int.sub hν_int |>.abs + rw [integral_sub (by exact hμ_int.add hν_int) h_int_abs, integral_add hμ_int hν_int] + simp only [ENNReal.toReal_mul, sub_left_inj, integral_const_mul] + nth_rw 5 [boolKernel_comp_measure] + calc + _ = (π {false}).toReal * (μ .univ).toReal + (π {true}).toReal + * ∫ (a : 𝒳), ((∂ν/∂Kernel.boolKernel μ ν ∘ₘ π) a).toReal ∂(Kernel.boolKernel μ ν ∘ₘ π) := by + by_cases hπ_false : π {false} = 0 + · simp [hπ_false] + rw [Measure.integral_toReal_rnDeriv + (absolutelyContinuous_boolKernel_comp_left μ ν hπ_false)] + rw [measureReal_def] + _ = (π {false}).toReal * (μ .univ).toReal + (π {true}).toReal * (ν .univ).toReal := by + by_cases hπ_true : π {true} = 0 + · simp [hπ_true] + rw [Measure.integral_toReal_rnDeriv + (absolutelyContinuous_boolKernel_comp_right μ ν hπ_true)] + rw [measureReal_def] + _ = _ := by + simp_rw [add_comm, Measure.coe_add, Measure.coe_smul, Pi.add_apply, Pi.smul_apply, + smul_eq_mul, ENNReal.toReal_add (ENNReal.mul_ne_top (measure_ne_top _ _) + (measure_ne_top _ _)) (ENNReal.mul_ne_top (measure_ne_top _ _) (measure_ne_top _ _)), + ENNReal.toReal_mul] + +lemma bayesBinaryRisk_eq_lintegral_enorm (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] : + bayesBinaryRisk μ ν π = 2⁻¹ * (((Kernel.boolKernel μ ν ∘ₘ π) .univ) + - ∫⁻ x, ‖(π {false} * (∂μ/∂(Kernel.boolKernel μ ν ∘ₘ π)) x).toReal + - (π {true} * (∂ν/∂(Kernel.boolKernel μ ν ∘ₘ π)) x).toReal‖ₑ + ∂(Kernel.boolKernel μ ν ∘ₘ π)) := by + rw [← ENNReal.ofReal_toReal (bayesBinaryRisk_ne_top μ ν π), + toReal_bayesBinaryRisk_eq_integral_abs, ENNReal.ofReal_mul (inv_nonneg.mpr zero_le_two), + ENNReal.ofReal_inv_of_pos zero_lt_two, ENNReal.ofReal_ofNat, + ENNReal.ofReal_sub _ (by positivity), ENNReal.ofReal_toReal (measure_ne_top _ _), + ofReal_integral_eq_lintegral_ofReal _ (.of_forall fun _ ↦ by positivity)] + swap + · simp_rw [ENNReal.toReal_mul] + exact ((Measure.integrable_toReal_rnDeriv.const_mul _).sub + (Measure.integrable_toReal_rnDeriv.const_mul _)).abs + simp_rw [Real.enorm_eq_ofReal_abs] + +end ProbabilityTheory diff --git a/Statlib/Testing/ChangeMeasure.lean b/Statlib/Testing/ChangeMeasure.lean new file mode 100644 index 0000000..ad91236 --- /dev/null +++ b/Statlib/Testing/ChangeMeasure.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne +-/ +module + +public import Mathlib.MeasureTheory.Measure.LogLikelihoodRatio + +/-! +# Change of measure inequalities + +The mass that `μ` puts on a set `s` and on the set where the log-likelihood ratio `llr μ ν` is +at most `c` is at most `exp c` times the mass that `ν` puts on `s`. These inequalities are the +basis of lower bounds for hypothesis testing in terms of the log-likelihood ratio. + +## Main statements + +* `measure_sub_le_measure_mul_exp`, `measureReal_sub_le_measureReal_mul_exp`: + `μ s - μ {x | c < llr μ ν x} ≤ ν s * exp c`, for any set `s` and `c : ℝ`. +* `one_sub_le_add_measureReal_mul_exp`: for a probability measure `μ` and any set `s`, the masses + `ν s` and `ν' sᶜ` cannot both be small unless `μ` puts mass on large values of `llr μ ν` or + `llr μ ν'`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open MeasureTheory Real + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν ν' : Measure α} + +/-- **Change of measure inequality**: `μ s - μ {x | c < llr μ ν x} ≤ ν s * exp c`. -/ +lemma measure_sub_le_measure_mul_exp [SigmaFinite μ] [SigmaFinite ν] (hμν : μ ≪ ν) (s : Set α) + (c : ℝ) : + μ s - μ {x | c < llr μ ν x} ≤ ν s * ENNReal.ofReal (exp c) := by + set t := {x | llr μ ν x ≤ c} + have ht : MeasurableSet t := measurableSet_le (measurable_llr _ _) measurable_const + -- on `t`, `∂ν/∂μ = exp (-llr μ ν) ≥ exp (-c)` + have h_ae : ∀ᵐ x ∂μ.restrict (s ∩ t), 1 ≤ ENNReal.ofReal (exp c) * ν.rnDeriv μ x := by + refine ae_restrict_of_ae_restrict_of_subset Set.inter_subset_right ?_ + rw [ae_restrict_iff' ht] + filter_upwards [exp_neg_llr hμν, ν.rnDeriv_ne_top μ] with x hx hx_top hxt + rw [← ENNReal.ofReal_toReal hx_top, ← hx, ← ENNReal.ofReal_mul (exp_pos _).le, ← exp_add, + ENNReal.one_le_ofReal] + exact one_le_exp (by simp only [t, Set.mem_ofPred_eq] at hxt; linarith) + calc μ s - μ {x | c < llr μ ν x} + _ ≤ μ (s ∩ t) := by + rw [tsub_le_iff_right] + refine (measure_mono fun x hx ↦ ?_).trans (measure_union_le (s ∩ t) _) + by_cases h : llr μ ν x ≤ c + · exact Or.inl ⟨hx, h⟩ + · exact Or.inr (not_le.mp h) + _ = ∫⁻ _ in s ∩ t, 1 ∂μ := (setLIntegral_one _).symm + _ ≤ ∫⁻ x in s ∩ t, ENNReal.ofReal (exp c) * ν.rnDeriv μ x ∂μ := lintegral_mono_ae h_ae + _ = ENNReal.ofReal (exp c) * ∫⁻ x in s ∩ t, ν.rnDeriv μ x ∂μ := + lintegral_const_mul _ (ν.measurable_rnDeriv μ) + _ ≤ ENNReal.ofReal (exp c) * ν (s ∩ t) := by grw [Measure.setLIntegral_rnDeriv_le] + _ ≤ ν s * ENNReal.ofReal (exp c) := by + rw [mul_comm] + grw [Set.inter_subset_left] + +/-- **Change of measure inequality**: `μ s - μ {x | c < llr μ ν x} ≤ ν s * exp c`. -/ +lemma measureReal_sub_le_measureReal_mul_exp [SigmaFinite μ] [IsFiniteMeasure ν] (hμν : μ ≪ ν) + (s : Set α) (c : ℝ) (hμc : μ {x | c < llr μ ν x} ≠ ∞) : + μ.real s - μ.real {x | c < llr μ ν x} ≤ ν.real s * exp c := by + calc μ.real s - μ.real {x | c < llr μ ν x} + _ ≤ (μ s - μ {x | c < llr μ ν x}).toReal := ENNReal.le_toReal_sub hμc + _ ≤ (ν s * ENNReal.ofReal (exp c)).toReal := + ENNReal.toReal_mono (by finiteness) (measure_sub_le_measure_mul_exp hμν s c) + _ = ν.real s * exp c := by + rw [ENNReal.toReal_mul, ENNReal.toReal_ofReal (exp_pos _).le, measureReal_def] + +/-- For a probability measure `μ` and any set `s`, the masses `ν s` and `ν' sᶜ` cannot both be +small unless `μ` puts mass on large values of `llr μ ν` or `llr μ ν'`. -/ +lemma one_sub_le_add_measureReal_mul_exp [IsFiniteMeasure ν] [IsFiniteMeasure ν'] + [IsProbabilityMeasure μ] (hμν : μ ≪ ν) (hμν' : μ ≪ ν') (s : Set α) (c c' : ℝ) : + 1 - μ.real {x | c < llr μ ν x} - μ.real {x | c' < llr μ ν' x} + ≤ ν.real s * exp c + ν'.real sᶜ * exp c' := by + have h := measureReal_sub_le_measureReal_mul_exp hμν s c (measure_ne_top _ _) + have h' := measureReal_sub_le_measureReal_mul_exp hμν' sᶜ c' (measure_ne_top _ _) + calc 1 - μ.real {x | c < llr μ ν x} - μ.real {x | c' < llr μ ν' x} + _ ≤ μ.real s + μ.real sᶜ - μ.real {x | c < llr μ ν x} - μ.real {x | c' < llr μ ν' x} := by + gcongr + calc (1 : ℝ) = (μ .univ).toReal := by simp + _ ≤ (μ s + μ sᶜ).toReal := + ENNReal.toReal_mono (by finiteness) (measure_univ_le_add_compl s) + _ = μ.real s + μ.real sᶜ := ENNReal.toReal_add (measure_ne_top _ _) (measure_ne_top _ _) + _ = (μ.real s - μ.real {x | c < llr μ ν x}) + (μ.real sᶜ - μ.real {x | c' < llr μ ν' x}) := by + abel + _ ≤ ν.real s * exp c + ν'.real sᶜ * exp c' := by gcongr + +/-- For a probability measure `μ` and any set `s`, the masses `ν s` and `ν' sᶜ` cannot both be +small unless `μ` puts mass on large values of `llr μ ν` or `llr μ ν'`. -/ +lemma one_sub_le_add_measureReal_mul_exp_max [IsFiniteMeasure ν] [IsFiniteMeasure ν'] + [IsProbabilityMeasure μ] (hμν : μ ≪ ν) (hμν' : μ ≪ ν') (s : Set α) (c c' : ℝ) : + 1 - μ.real {x | c < llr μ ν x} - μ.real {x | c' < llr μ ν' x} + ≤ (ν.real s + ν'.real sᶜ) * exp (max c c') := by + refine (one_sub_le_add_measureReal_mul_exp hμν hμν' s c c').trans ?_ + rw [add_mul] + gcongr + · exact le_max_left _ _ + · exact le_max_right _ _ + +end ProbabilityTheory diff --git a/Statlib/Testing/RenyiChangeMeasure.lean b/Statlib/Testing/RenyiChangeMeasure.lean new file mode 100644 index 0000000..b4a7cb3 --- /dev/null +++ b/Statlib/Testing/RenyiChangeMeasure.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2024 Rémy Degenne. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémy Degenne +-/ +module + +public import Statlib.Divergence.Renyi.Basic +public import Statlib.Testing.ChangeMeasure + +/-! +# Change of measure inequalities involving Rényi divergences + +The change of measure inequalities of `Statlib.Testing.ChangeMeasure` involve the probability that +the log-likelihood ratio `llr μ ν` exceeds a threshold. We bound that probability using a Rényi +divergence of order `1 + a > 1`, through a Chernoff bound for `llr μ ν`, whose cumulant generating +function under `μ` is `a * renyiDiv (1 + a) μ ν` (`cgf_llr'`). + +## Main statements + +* `measureReal_llr_gt_renyiDiv_le_exp`: for probability measures and `0 < a`, + `μ {x | (renyiDiv (1 + a) μ ν).toReal + c < llr μ ν x} ≤ exp (-a * c)`. +* `measureReal_sub_le_measureReal_mul_exp_renyiDiv`, + `one_sub_two_mul_exp_le_add_measureReal_mul_exp_max_renyiDiv`: change of measure inequalities in + which the log-likelihood ratio is controlled through a Rényi divergence. +* `exp_neg_max_renyiDiv_le_add_measureReal`: a lower bound on `ν s + ν' sᶜ`, the sum of the errors + of a test between `ν` and `ν'`, in terms of Rényi divergences from a third measure `μ`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). +-/ + +@[expose] public section + +open MeasureTheory Real + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν ν' : Measure α} {a : ℝ} + +/-- **Chernoff bound** for the log-likelihood ratio, in terms of a Rényi divergence. -/ +lemma measureReal_llr_gt_renyiDiv_le_exp [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (ha : 0 < a) (c : ℝ) (h : renyiDiv (1 + a) μ ν ≠ ∞) : + μ.real {x | (renyiDiv (1 + a) μ ν).toReal + c < llr μ ν x} ≤ exp (-a * c) := by + have hμν : μ ≪ ν := absolutelyContinuous_of_renyiDiv_ne_top (by linarith) h + rw [renyiDiv_ne_top_iff_of_one_lt (by linarith)] at h + calc μ.real {x | (renyiDiv (1 + a) μ ν).toReal + c < llr μ ν x} + _ ≤ μ.real {x | (renyiDiv (1 + a) μ ν).toReal + c ≤ llr μ ν x} := + measureReal_mono fun _ (hx : _ < _) ↦ hx.le + _ ≤ exp (-a * ((renyiDiv (1 + a) μ ν).toReal + c) + cgf (llr μ ν) μ a) := by + refine measure_ge_le_exp_cgf _ ha.le ?_ + rw [integrable_congr (exp_mul_llr_of_ac hμν), integrable_rpow_rnDeriv_iff hμν ha] + exact h.1 + _ = exp (-a * c) := by + rw [cgf_llr' ha h.1 h.2] + congr 1 + ring + +lemma measureReal_sub_le_measureReal_mul_exp_renyiDiv [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] (s : Set α) (ha : 0 < a) (c : ℝ) (h : renyiDiv (1 + a) μ ν ≠ ∞) : + μ.real s - exp (-a * c) ≤ ν.real s * exp ((renyiDiv (1 + a) μ ν).toReal + c) := by + have hμν : μ ≪ ν := absolutelyContinuous_of_renyiDiv_ne_top (by linarith) h + refine le_trans ?_ (measureReal_sub_le_measureReal_mul_exp hμν s _ (measure_ne_top _ _)) + gcongr + exact measureReal_llr_gt_renyiDiv_le_exp ha c h + +lemma one_sub_two_mul_exp_le_add_measureReal_mul_exp_max_renyiDiv [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] [IsProbabilityMeasure ν'] (s : Set α) (ha : 0 < a) (c : ℝ) + (hν : renyiDiv (1 + a) μ ν ≠ ∞) (hν' : renyiDiv (1 + a) μ ν' ≠ ∞) : + 1 - 2 * exp (-a * c) + ≤ (ν.real s + ν'.real sᶜ) + * exp (max (renyiDiv (1 + a) μ ν).toReal (renyiDiv (1 + a) μ ν').toReal + c) := by + have hμν : μ ≪ ν := absolutelyContinuous_of_renyiDiv_ne_top (by linarith) hν + have hμν' : μ ≪ ν' := absolutelyContinuous_of_renyiDiv_ne_top (by linarith) hν' + calc 1 - 2 * exp (-a * c) + _ = 1 - exp (-a * c) - exp (-a * c) := by ring + _ ≤ 1 - μ.real {x | (renyiDiv (1 + a) μ ν).toReal + c < llr μ ν x} + - μ.real {x | (renyiDiv (1 + a) μ ν').toReal + c < llr μ ν' x} := by + gcongr + · exact measureReal_llr_gt_renyiDiv_le_exp ha c hν + · exact measureReal_llr_gt_renyiDiv_le_exp ha c hν' + _ ≤ (ν.real s + ν'.real sᶜ) + * exp (max ((renyiDiv (1 + a) μ ν).toReal + c) ((renyiDiv (1 + a) μ ν').toReal + c)) := + one_sub_le_add_measureReal_mul_exp_max hμν hμν' s _ _ + _ = (ν.real s + ν'.real sᶜ) + * exp (max (renyiDiv (1 + a) μ ν).toReal (renyiDiv (1 + a) μ ν').toReal + c) := by + rw [max_add_add_right] + +/-- Lower bound on the sum of the errors `ν s + ν' sᶜ` of a test between `ν` and `ν'`, in terms of +Rényi divergences from a third measure `μ`. -/ +lemma exp_neg_max_renyiDiv_le_add_measureReal [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] [IsProbabilityMeasure ν'] (s : Set α) + (ha : 0 < a) (hν : renyiDiv (1 + a) μ ν ≠ ∞) (hν' : renyiDiv (1 + a) μ ν' ≠ ∞) : + 2⁻¹ * exp (-max (renyiDiv (1 + a) μ ν).toReal (renyiDiv (1 + a) μ ν').toReal - log 4 / a) + ≤ ν.real s + ν'.real sᶜ := by + have h := one_sub_two_mul_exp_le_add_measureReal_mul_exp_max_renyiDiv s ha (log 4 / a) hν hν' + -- with `c = log 4 / a`, the left-hand side `1 - 2 * exp (-a * c)` is `1 / 2` + have : 1 - 2 * exp (-a * (log 4 / a)) = 2⁻¹ := by + rw [neg_mul, mul_div_cancel₀ _ ha.ne', exp_neg, exp_log (by positivity)] + norm_num + rw [this] at h + rwa [neg_sub_left, exp_neg, mul_inv_le_iff₀ (exp_pos _), add_comm (log 4 / a)] + +end ProbabilityTheory