From 7b6ee173b6d9e8addf28d4e3559b2ba7b9a621fa Mon Sep 17 00:00:00 2001 From: Remy Degenne Date: Thu, 29 Oct 2026 16:10:07 +0100 Subject: [PATCH] End of the TLB project --- Statlib.lean | 72 +++ Statlib/Divergence/Chernoff.lean | 43 +- Statlib/Divergence/Chernoff/Prod.lean | 77 ++++ Statlib/Divergence/Chernoff/Properties.lean | 335 ++++++++++++++ Statlib/Divergence/FDiv/Basic.lean | 83 ++++ Statlib/Divergence/FDiv/Binary.lean | 307 +++++++++++++ Statlib/Divergence/FDiv/CompProd.lean | 26 ++ Statlib/Divergence/FDiv/CondFDiv.lean | 188 ++++---- .../Divergence/FDiv/DivFunction/Basic.lean | 19 + .../FDiv/DivFunction/CurvatureMeasure.lean | 7 + .../FDiv/DivFunction/DerivAtTop.lean | 68 +++ Statlib/Divergence/FDiv/Estimation.lean | 104 +++++ .../FDiv/IntegralRepresentation.lean | 105 ++++- Statlib/Divergence/FDiv/SupRatio.lean | 190 ++++++++ Statlib/Divergence/FDiv/Trim.lean | 61 ++- Statlib/Divergence/FDiv/TrimApprox.lean | 156 +++++++ Statlib/Divergence/Hellinger/Basic.lean | 159 +++++-- .../Divergence/Hellinger/CondHellinger.lean | 53 ++- .../Divergence/Hellinger/HellingerDivFun.lean | 28 ++ .../Divergence/Hellinger/HellingerFun.lean | 32 +- Statlib/Divergence/Hellinger/Prod.lean | 69 +++ Statlib/Divergence/Hellinger/Renyi.lean | 101 +++++ .../Divergence/Hellinger/TotalVariation.lean | 304 +++++++++++++ Statlib/Divergence/JensenShannon/Basic.lean | 263 +++++++++++ .../Divergence/JensenShannon/Hellinger.lean | 237 ++++++++++ .../Divergence/JensenShannon/Variational.lean | 161 +++++++ Statlib/Divergence/KullbackLeibler/Basic.lean | 38 +- .../Divergence/KullbackLeibler/CondKL.lean | 196 +++++---- .../KullbackLeibler/Estimation.lean | 158 +++++++ Statlib/Divergence/KullbackLeibler/Event.lean | 52 +++ .../Divergence/MutualInformation/Basic.lean | 124 ++++++ .../Divergence/MutualInformation/Bool.lean | 110 +++++ .../MutualInformation/Estimation.lean | 111 +++++ .../MutualInformation/LeftRight.lean | 137 ++++++ Statlib/Divergence/Renyi/Basic.lean | 196 +++++++-- Statlib/Divergence/Renyi/ChainRule.lean | 212 +++++++++ Statlib/Divergence/Renyi/CondRenyi.lean | 30 +- Statlib/Divergence/Renyi/DataProcessing.lean | 135 ++++++ Statlib/Divergence/Renyi/Order.lean | 366 ++++++++++++++++ Statlib/Divergence/Renyi/Order/Limits.lean | 409 ++++++++++++++++++ Statlib/Divergence/Renyi/Prod.lean | 163 +++++++ Statlib/Divergence/Renyi/ProdCountable.lean | 145 +++++++ Statlib/Divergence/Renyi/Variational.lean | 300 ++++++++++++- Statlib/Divergence/StatInfo/Basic.lean | 46 +- .../Divergence/StatInfo/CurvatureMeasure.lean | 163 +++++++ Statlib/Divergence/StatInfo/Event.lean | 93 ++++ Statlib/Divergence/StatInfo/FDiv.lean | 4 - .../Divergence/StatInfo/StatInfoDivFun.lean | 26 ++ Statlib/Divergence/StatInfo/StatInfoFun.lean | 48 ++ Statlib/Divergence/TotalVariation.lean | 111 ++++- Statlib/Divergence/TotalVariation/Event.lean | 84 ++++ .../Divergence/TotalVariation/Integral.lean | 190 ++++++++ Statlib/ForMathlib/Analysis/Convex/Deriv.lean | 55 +++ .../SpecialFunctions/Log/ENNRealLogExp.lean | 40 ++ .../Analysis/SpecialFunctions/Pow/Deriv.lean | 105 +++++ .../Analysis/SpecialFunctions/Pow/NNReal.lean | 88 ++++ .../Analysis/SpecialFunctions/Pow/Real.lean | 54 +++ Statlib/ForMathlib/ENNReal.lean | 4 + Statlib/ForMathlib/EReal.lean | 5 + .../KullbackLeibler/Basic.lean | 103 ++++- .../KullbackLeibler/Bernoulli.lean | 44 ++ .../KullbackLeibler/ChainRule.lean | 138 ++++++ .../KullbackLeibler/DataProcessing.lean | 30 ++ .../MeasureTheory/Constructions/Pi.lean | 57 +++ .../Function/ConditionalLExpectation.lean | 73 ++++ .../MeasureTheory/Integral/Layercake.lean | 87 ++++ .../Integral/MeanInequalities.lean | 42 ++ .../ForMathlib/MeasureTheory/Integral/Pi.lean | 68 +++ .../MeasureTheory/MeasurableSpace/Basic.lean | 34 ++ .../MeasureTheory/Measure/Bool.lean | 74 +++- .../Measure/Decomposition/Hahn.lean | 69 +++ .../Decomposition/IntegralRPowRNDeriv.lean | 360 ++++++++++----- .../Measure/Decomposition/RNDerivProd.lean | 177 ++++++++ .../Measure/Decomposition/RNDerivTrim.lean | 111 +++++ .../Measure/Decomposition/RadonNikodym.lean | 26 ++ .../MeasureTheory/Measure/ERealStieltjes.lean | 18 +- .../MeasureTheory/Measure/Prod.lean | 57 +++ .../MeasureTheory/Measure/Real.lean | 34 ++ .../MeasureTheory/Measure/Trim.lean | 39 ++ .../Measure/Typeclasses/Probability.lean | 34 ++ .../Measure/Typeclasses/SFinite.lean | 44 ++ .../Probability/Decision/BayesEstimator.lean | 58 ++- .../Probability/Decision/Risk/Basic.lean | 150 +++++++ .../Decision/Risk/RiskIncrease.lean | 46 ++ .../Probability/Decision/ZeroOneLoss.lean | 253 +++++++++++ .../Probability/Distributions/Bernoulli.lean | 76 +++- .../ForMathlib/Probability/Kernel/Basic.lean | 33 ++ .../Kernel/Composition/Lemmas.lean | 66 +++ .../Kernel/Composition/MeasureCompProd.lean | 50 ++- .../Kernel/Composition/RadonNikodym.lean | 179 +++++++- .../Probability/Kernel/Posterior.lean | 38 ++ .../Probability/Moments/Variance.lean | 52 +++ .../Probability/Process/Filtration.lean | 46 ++ .../Process/PartitionFiltration.lean | 44 ++ .../Probability/Process/Stopping.lean | 79 ++++ .../Probability/ProductMeasure.lean | 45 ++ Statlib/ForMathlib/Probability/StrongLaw.lean | 122 ++++++ Statlib/Testing/Binary.lean | 127 ++++-- Statlib/Testing/BinaryRenyi.lean | 190 ++++++++ Statlib/Testing/ChangeMeasure.lean | 115 +++-- Statlib/Testing/ChangeMeasureMoments.lean | 177 ++++++++ Statlib/Testing/ChangeMeasureRisk.lean | 94 ++++ Statlib/Testing/Chernoff.lean | 248 +++++++++++ Statlib/Testing/Fano.lean | 241 +++++++++++ Statlib/Testing/Hellinger.lean | 94 ++++ Statlib/Testing/SampleComplexity.lean | 212 +++++++++ Statlib/Testing/SampleComplexityBounds.lean | 233 ++++++++++ Statlib/Testing/Sequential/Basic.lean | 244 +++++++++++ Statlib/Testing/Sequential/KLDiv.lean | 147 +++++++ Statlib/Testing/Sequential/Renyi.lean | 69 +++ Statlib/Testing/Sequential/Wald.lean | 229 ++++++++++ 111 files changed, 12171 insertions(+), 551 deletions(-) create mode 100644 Statlib/Divergence/Chernoff/Prod.lean create mode 100644 Statlib/Divergence/Chernoff/Properties.lean create mode 100644 Statlib/Divergence/FDiv/Binary.lean create mode 100644 Statlib/Divergence/FDiv/Estimation.lean create mode 100644 Statlib/Divergence/FDiv/SupRatio.lean create mode 100644 Statlib/Divergence/FDiv/TrimApprox.lean create mode 100644 Statlib/Divergence/Hellinger/Prod.lean create mode 100644 Statlib/Divergence/Hellinger/Renyi.lean create mode 100644 Statlib/Divergence/Hellinger/TotalVariation.lean create mode 100644 Statlib/Divergence/JensenShannon/Basic.lean create mode 100644 Statlib/Divergence/JensenShannon/Hellinger.lean create mode 100644 Statlib/Divergence/JensenShannon/Variational.lean create mode 100644 Statlib/Divergence/KullbackLeibler/Estimation.lean create mode 100644 Statlib/Divergence/KullbackLeibler/Event.lean create mode 100644 Statlib/Divergence/MutualInformation/Basic.lean create mode 100644 Statlib/Divergence/MutualInformation/Bool.lean create mode 100644 Statlib/Divergence/MutualInformation/Estimation.lean create mode 100644 Statlib/Divergence/MutualInformation/LeftRight.lean create mode 100644 Statlib/Divergence/Renyi/ChainRule.lean create mode 100644 Statlib/Divergence/Renyi/DataProcessing.lean create mode 100644 Statlib/Divergence/Renyi/Order.lean create mode 100644 Statlib/Divergence/Renyi/Order/Limits.lean create mode 100644 Statlib/Divergence/Renyi/Prod.lean create mode 100644 Statlib/Divergence/Renyi/ProdCountable.lean create mode 100644 Statlib/Divergence/StatInfo/CurvatureMeasure.lean create mode 100644 Statlib/Divergence/StatInfo/Event.lean create mode 100644 Statlib/Divergence/TotalVariation/Event.lean create mode 100644 Statlib/Divergence/TotalVariation/Integral.lean create mode 100644 Statlib/ForMathlib/Analysis/Convex/Deriv.lean create mode 100644 Statlib/ForMathlib/Analysis/SpecialFunctions/Log/ENNRealLogExp.lean create mode 100644 Statlib/ForMathlib/Analysis/SpecialFunctions/Pow/Deriv.lean create mode 100644 Statlib/ForMathlib/Analysis/SpecialFunctions/Pow/NNReal.lean create mode 100644 Statlib/ForMathlib/Analysis/SpecialFunctions/Pow/Real.lean create mode 100644 Statlib/ForMathlib/InformationTheory/KullbackLeibler/ChainRule.lean create mode 100644 Statlib/ForMathlib/MeasureTheory/Constructions/Pi.lean create mode 100644 Statlib/ForMathlib/MeasureTheory/Function/ConditionalLExpectation.lean create mode 100644 Statlib/ForMathlib/MeasureTheory/Integral/Layercake.lean create mode 100644 Statlib/ForMathlib/MeasureTheory/Integral/MeanInequalities.lean create mode 100644 Statlib/ForMathlib/MeasureTheory/Integral/Pi.lean create mode 100644 Statlib/ForMathlib/MeasureTheory/MeasurableSpace/Basic.lean create mode 100644 Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/Hahn.lean create mode 100644 Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/RNDerivProd.lean create mode 100644 Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/RNDerivTrim.lean create mode 100644 Statlib/ForMathlib/MeasureTheory/Measure/Prod.lean create mode 100644 Statlib/ForMathlib/MeasureTheory/Measure/Real.lean create mode 100644 Statlib/ForMathlib/MeasureTheory/Measure/Trim.lean create mode 100644 Statlib/ForMathlib/MeasureTheory/Measure/Typeclasses/Probability.lean create mode 100644 Statlib/ForMathlib/MeasureTheory/Measure/Typeclasses/SFinite.lean create mode 100644 Statlib/ForMathlib/Probability/Decision/Risk/Basic.lean create mode 100644 Statlib/ForMathlib/Probability/Decision/Risk/RiskIncrease.lean create mode 100644 Statlib/ForMathlib/Probability/Decision/ZeroOneLoss.lean create mode 100644 Statlib/ForMathlib/Probability/Kernel/Basic.lean create mode 100644 Statlib/ForMathlib/Probability/Kernel/Composition/Lemmas.lean create mode 100644 Statlib/ForMathlib/Probability/Kernel/Posterior.lean create mode 100644 Statlib/ForMathlib/Probability/Moments/Variance.lean create mode 100644 Statlib/ForMathlib/Probability/Process/Filtration.lean create mode 100644 Statlib/ForMathlib/Probability/Process/PartitionFiltration.lean create mode 100644 Statlib/ForMathlib/Probability/Process/Stopping.lean create mode 100644 Statlib/ForMathlib/Probability/ProductMeasure.lean create mode 100644 Statlib/ForMathlib/Probability/StrongLaw.lean create mode 100644 Statlib/Testing/BinaryRenyi.lean create mode 100644 Statlib/Testing/ChangeMeasureMoments.lean create mode 100644 Statlib/Testing/ChangeMeasureRisk.lean create mode 100644 Statlib/Testing/Chernoff.lean create mode 100644 Statlib/Testing/Fano.lean create mode 100644 Statlib/Testing/Hellinger.lean create mode 100644 Statlib/Testing/SampleComplexity.lean create mode 100644 Statlib/Testing/SampleComplexityBounds.lean create mode 100644 Statlib/Testing/Sequential/Basic.lean create mode 100644 Statlib/Testing/Sequential/KLDiv.lean create mode 100644 Statlib/Testing/Sequential/Renyi.lean create mode 100644 Statlib/Testing/Sequential/Wald.lean diff --git a/Statlib.lean b/Statlib.lean index 477e0c0..a5f1af4 100644 --- a/Statlib.lean +++ b/Statlib.lean @@ -2,7 +2,10 @@ import Statlib.Causal.PotentialResponse import Statlib.Contiguity.Def import Statlib.Divergence.BretagnolleHuber import Statlib.Divergence.Chernoff +import Statlib.Divergence.Chernoff.Prod +import Statlib.Divergence.Chernoff.Properties import Statlib.Divergence.FDiv.Basic +import Statlib.Divergence.FDiv.Binary import Statlib.Divergence.FDiv.CompProd import Statlib.Divergence.FDiv.CondFDiv import Statlib.Divergence.FDiv.Conj @@ -14,25 +17,50 @@ 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.Estimation import Statlib.Divergence.FDiv.IntegralRepresentation import Statlib.Divergence.FDiv.Measurable +import Statlib.Divergence.FDiv.SupRatio import Statlib.Divergence.FDiv.Trim +import Statlib.Divergence.FDiv.TrimApprox import Statlib.Divergence.Hellinger.Basic import Statlib.Divergence.Hellinger.CondHellinger import Statlib.Divergence.Hellinger.HellingerDivFun import Statlib.Divergence.Hellinger.HellingerFun +import Statlib.Divergence.Hellinger.Prod +import Statlib.Divergence.Hellinger.Renyi +import Statlib.Divergence.Hellinger.TotalVariation +import Statlib.Divergence.JensenShannon.Basic +import Statlib.Divergence.JensenShannon.Hellinger +import Statlib.Divergence.JensenShannon.Variational import Statlib.Divergence.KullbackLeibler.Basic import Statlib.Divergence.KullbackLeibler.CondKL +import Statlib.Divergence.KullbackLeibler.Estimation +import Statlib.Divergence.KullbackLeibler.Event import Statlib.Divergence.KullbackLeibler.KLDivFun +import Statlib.Divergence.MutualInformation.Basic +import Statlib.Divergence.MutualInformation.Bool +import Statlib.Divergence.MutualInformation.Estimation +import Statlib.Divergence.MutualInformation.LeftRight import Statlib.Divergence.Renyi.Basic import Statlib.Divergence.Renyi.Bernoulli +import Statlib.Divergence.Renyi.ChainRule import Statlib.Divergence.Renyi.CondRenyi +import Statlib.Divergence.Renyi.DataProcessing +import Statlib.Divergence.Renyi.Order +import Statlib.Divergence.Renyi.Order.Limits +import Statlib.Divergence.Renyi.Prod +import Statlib.Divergence.Renyi.ProdCountable import Statlib.Divergence.Renyi.Variational import Statlib.Divergence.StatInfo.Basic +import Statlib.Divergence.StatInfo.CurvatureMeasure +import Statlib.Divergence.StatInfo.Event import Statlib.Divergence.StatInfo.FDiv import Statlib.Divergence.StatInfo.StatInfoDivFun import Statlib.Divergence.StatInfo.StatInfoFun import Statlib.Divergence.TotalVariation +import Statlib.Divergence.TotalVariation.Event +import Statlib.Divergence.TotalVariation.Integral import Statlib.EValues.Bernoulli import Statlib.EValues.DPI import Statlib.EValues.Divergence @@ -46,37 +74,81 @@ 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.Deriv import Statlib.ForMathlib.Analysis.Convex.DerivAtTop import Statlib.ForMathlib.Analysis.SpecialFunctions.Log.Basic +import Statlib.ForMathlib.Analysis.SpecialFunctions.Log.ENNRealLogExp +import Statlib.ForMathlib.Analysis.SpecialFunctions.Pow.Deriv +import Statlib.ForMathlib.Analysis.SpecialFunctions.Pow.NNReal +import Statlib.ForMathlib.Analysis.SpecialFunctions.Pow.Real 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.ChainRule import Statlib.ForMathlib.InformationTheory.KullbackLeibler.DataProcessing import Statlib.ForMathlib.InformationTheory.KullbackLeibler.EIntegral +import Statlib.ForMathlib.MeasureTheory.Constructions.Pi +import Statlib.ForMathlib.MeasureTheory.Function.ConditionalLExpectation 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.Integral.Layercake +import Statlib.ForMathlib.MeasureTheory.Integral.MeanInequalities +import Statlib.ForMathlib.MeasureTheory.Integral.Pi import Statlib.ForMathlib.MeasureTheory.Komlos +import Statlib.ForMathlib.MeasureTheory.MeasurableSpace.Basic import Statlib.ForMathlib.MeasureTheory.Measure.Bool +import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.Hahn import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.IntegralRNDeriv import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.IntegralRPowRNDeriv +import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.RNDerivProd +import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.RNDerivTrim 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.Measure.Prod +import Statlib.ForMathlib.MeasureTheory.Measure.Real +import Statlib.ForMathlib.MeasureTheory.Measure.Trim +import Statlib.ForMathlib.MeasureTheory.Measure.Typeclasses.Probability +import Statlib.ForMathlib.MeasureTheory.Measure.Typeclasses.SFinite import Statlib.ForMathlib.MeasureTheory.Order.Group.Lattice import Statlib.ForMathlib.Probability.Decision.BayesEstimator +import Statlib.ForMathlib.Probability.Decision.Risk.Basic +import Statlib.ForMathlib.Probability.Decision.Risk.RiskIncrease +import Statlib.ForMathlib.Probability.Decision.ZeroOneLoss import Statlib.ForMathlib.Probability.Distributions.Bernoulli +import Statlib.ForMathlib.Probability.Kernel.Basic +import Statlib.ForMathlib.Probability.Kernel.Composition.Lemmas import Statlib.ForMathlib.Probability.Kernel.Composition.MeasureCompProd import Statlib.ForMathlib.Probability.Kernel.Composition.RadonNikodym +import Statlib.ForMathlib.Probability.Kernel.Posterior +import Statlib.ForMathlib.Probability.Moments.Variance +import Statlib.ForMathlib.Probability.Process.Filtration +import Statlib.ForMathlib.Probability.Process.PartitionFiltration +import Statlib.ForMathlib.Probability.Process.Stopping +import Statlib.ForMathlib.Probability.ProductMeasure +import Statlib.ForMathlib.Probability.StrongLaw import Statlib.ForMathlib.Topology.Order.MonotoneConvergence import Statlib.Inference.Inference import Statlib.Inference.QMD import Statlib.Testing.Binary +import Statlib.Testing.BinaryRenyi import Statlib.Testing.ChangeMeasure +import Statlib.Testing.ChangeMeasureMoments +import Statlib.Testing.ChangeMeasureRisk +import Statlib.Testing.Chernoff +import Statlib.Testing.Fano +import Statlib.Testing.Hellinger import Statlib.Testing.RenyiChangeMeasure +import Statlib.Testing.SampleComplexity +import Statlib.Testing.SampleComplexityBounds +import Statlib.Testing.Sequential.Basic +import Statlib.Testing.Sequential.KLDiv +import Statlib.Testing.Sequential.Renyi +import Statlib.Testing.Sequential.Wald diff --git a/Statlib/Divergence/Chernoff.lean b/Statlib/Divergence/Chernoff.lean index ffdd84e..baa7cff 100644 --- a/Statlib/Divergence/Chernoff.lean +++ b/Statlib/Divergence/Chernoff.lean @@ -17,8 +17,13 @@ public import Statlib.Divergence.Renyi.Basic ## Main statements +* `chernoffDiv_comm`: the Chernoff divergence is symmetric. +* `chernoffDiv_zero_measure_left`, `chernoffDiv_zero_measure_right`: the Chernoff divergence + between the zero measure and any measure is infinite. * `chernoffDiv_one`: the Chernoff divergence of order `1` as an infimum of Kullback-Leibler divergences. +* `chernoffDiv_smul_smul`, `chernoffDiv_eq_chernoffDiv_inv_smul`: invariance under scaling of the + 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). @@ -26,7 +31,7 @@ This file is adapted from the testing-lower-bounds project of Rémy Degenne and @[expose] public section -open Real MeasureTheory InformationTheory +open MeasureTheory InformationTheory open scoped ENNReal @@ -40,6 +45,22 @@ of order `a` from `ξ` to `μ` and from `ξ` to `ν`. -/ noncomputable def chernoffDiv (a : ℝ) (μ ν : Measure α) : ℝ≥0∞ := ⨅ (ξ : Measure α) (_hξ : IsProbabilityMeasure ξ), max (renyiDiv a ξ μ) (renyiDiv a ξ ν) +/-- The Chernoff divergence is symmetric. -/ +lemma chernoffDiv_comm (a : ℝ) (μ ν : Measure α) : chernoffDiv a μ ν = chernoffDiv a ν μ := by + simp_rw [chernoffDiv, max_comm] + +/-- The Chernoff divergence between the zero measure and any measure is infinite. -/ +@[simp] +lemma chernoffDiv_zero_measure_left (ha : 0 ≤ a) (ν : Measure α) : chernoffDiv a 0 ν = ∞ := + iInf₂_eq_top.mpr fun ξ _ ↦ by rw [renyiDiv_zero_measure_right ha ξ, max_eq_left le_top] + +/-- The Chernoff divergence between any measure and the zero measure is infinite. -/ +@[simp] +lemma chernoffDiv_zero_measure_right (ha : 0 ≤ a) (μ : Measure α) : chernoffDiv a μ 0 = ∞ := by + rw [chernoffDiv_comm, chernoffDiv_zero_measure_left ha] + +/-- For probability measures, the Chernoff divergence of order `1` is the infimum over probability +measures `ξ` of `max (KL(ξ, μ)) (KL(ξ, ν))`. -/ lemma chernoffDiv_one [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : chernoffDiv 1 μ ν = ⨅ (ξ : Measure α) (_hξ : IsProbabilityMeasure ξ), max (klDiv ξ μ) (klDiv ξ ν) := by @@ -48,4 +69,24 @@ lemma chernoffDiv_one [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : congr with hξ rw [renyiDiv_one_of_isProbabilityMeasure, renyiDiv_one_of_isProbabilityMeasure] +/-- The Chernoff divergence is invariant under scaling of the measures by positive finite +constants. -/ +lemma chernoffDiv_smul_smul (ha : 0 ≤ a) [IsFiniteMeasure μ] [IsFiniteMeasure ν] {c c' : ℝ≥0∞} + (hc : c ≠ 0) (hc_top : c ≠ ∞) (hc' : c' ≠ 0) (hc'_top : c' ≠ ∞) : + chernoffDiv a (c • μ) (c' • ν) = chernoffDiv a μ ν := + iInf_congr fun _ ↦ iInf_congr fun _ ↦ by + rw [renyiDiv_smul_right' ha hc hc_top, renyiDiv_smul_right' ha hc' hc'_top] + +/-- The Chernoff divergence between finite measures is the Chernoff divergence between the +normalized measures. -/ +lemma chernoffDiv_eq_chernoffDiv_inv_smul (ha : 0 ≤ a) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + chernoffDiv a μ ν = chernoffDiv a ((μ .univ)⁻¹ • μ) ((ν .univ)⁻¹ • ν) := by + rcases eq_zero_or_neZero μ with rfl | _ + · simp [ha] + rcases eq_zero_or_neZero ν with rfl | _ + · simp [ha] + exact (chernoffDiv_smul_smul ha (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 ProbabilityTheory diff --git a/Statlib/Divergence/Chernoff/Prod.lean b/Statlib/Divergence/Chernoff/Prod.lean new file mode 100644 index 0000000..9ae3776 --- /dev/null +++ b/Statlib/Divergence/Chernoff/Prod.lean @@ -0,0 +1,77 @@ +/- +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.Chernoff +public import Statlib.Divergence.Renyi.Prod + +/-! +# Chernoff divergence of product measures + +The Chernoff divergence `Cₐ(μ, ν) = ⨅ ξ, max (Rₐ(ξ, μ)) (Rₐ(ξ, ν))` is subadditive on finite +products of finite measures: taking product measures `∏ ξ i` in the infimum and using the +tensorization of the Rényi divergence (`renyiDiv_pi`) gives +`Cₐ(∏ μ i, ∏ ν i) ≤ ∑ i, Cₐ(μ i, ν i)`. + +## Main statements + +* `ProbabilityTheory.chernoffDiv_pi_le`: `Cₐ(∏ μ i, ∏ ν i) ≤ ∑ i, Cₐ(μ i, ν i)` for `0 ≤ a` and + finite measures. +* `ProbabilityTheory.chernoffDiv_pi_const_le`: `Cₐ(μ^⊗ι, ν^⊗ι) ≤ |ι| * Cₐ(μ, ν)`. +-/ + +@[expose] public section + +open MeasureTheory + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {a : ℝ} + +/-- **Subadditivity of the Chernoff divergence on products**: for `0 ≤ a` and finite measures, +`Cₐ(∏ μ i, ∏ ν i) ≤ ∑ i, Cₐ(μ i, ν i)`. -/ +theorem chernoffDiv_pi_le (ha : 0 ≤ a) {ι : Type*} [Fintype ι] {β : ι → Type*} + [∀ i, MeasurableSpace (β i)] {μ ν : (i : ι) → Measure (β i)} [∀ i, IsFiniteMeasure (μ i)] + [∀ i, IsFiniteMeasure (ν i)] : + chernoffDiv a (Measure.pi μ) (Measure.pi ν) ≤ ∑ i, chernoffDiv a (μ i) (ν i) := by + -- for `ε > 0`, choose for each `i` a probability measure `ξ i` which is `ε / |ι|`-optimal in the + -- infimum defining `Cₐ(μ i, ν i)`, and use the product measure `∏ ξ i` + refine ENNReal.le_of_forall_pos_le_add fun ε hε h_lt ↦ ?_ + have h_ex i : ∃ ξ : Measure (β i), ∃ _ : IsProbabilityMeasure ξ, + max (renyiDiv a ξ (μ i)) (renyiDiv a ξ (ν i)) + < chernoffDiv a (μ i) (ν i) + ε / Fintype.card ι := by + have h_ne : chernoffDiv a (μ i) (ν i) ≠ ∞ := + (ENNReal.sum_lt_top.mp h_lt i (Finset.mem_univ i)).ne + simpa only [chernoffDiv, iInf_lt_iff] using ENNReal.lt_add_right h_ne + (ENNReal.div_pos (by simpa using hε.ne') (ENNReal.natCast_ne_top _)).ne' + choose ξ hξ h_lt_ξ using h_ex + calc chernoffDiv a (Measure.pi μ) (Measure.pi ν) + ≤ max (renyiDiv a (Measure.pi ξ) (Measure.pi μ)) (renyiDiv a (Measure.pi ξ) (Measure.pi ν)) := + iInf₂_le (Measure.pi ξ) (by infer_instance) + _ = max (∑ i, renyiDiv a (ξ i) (μ i)) (∑ i, renyiDiv a (ξ i) (ν i)) := by + rw [renyiDiv_pi ha, renyiDiv_pi ha] + _ ≤ ∑ i, max (renyiDiv a (ξ i) (μ i)) (renyiDiv a (ξ i) (ν i)) := + max_le (Finset.sum_le_sum fun _ _ ↦ le_max_left _ _) + (Finset.sum_le_sum fun _ _ ↦ le_max_right _ _) + _ ≤ ∑ i, (chernoffDiv a (μ i) (ν i) + ε / Fintype.card ι) := + Finset.sum_le_sum fun i _ ↦ (h_lt_ξ i).le + _ ≤ ∑ i, chernoffDiv a (μ i) (ν i) + ε := by + rw [Finset.sum_add_distrib, Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + gcongr + exact ENNReal.mul_div_le + +/-- **Subadditivity of the Chernoff divergence on powers**: for `0 ≤ a` and finite measures, +`Cₐ(μ^⊗ι, ν^⊗ι) ≤ |ι| * Cₐ(μ, ν)`. -/ +theorem chernoffDiv_pi_const_le (ha : 0 ≤ a) {ι : Type*} [Fintype ι] [IsFiniteMeasure μ] + [IsFiniteMeasure ν] : + chernoffDiv a (Measure.pi fun _ : ι ↦ μ) (Measure.pi fun _ : ι ↦ ν) + ≤ Fintype.card ι * chernoffDiv a μ ν := by + simpa [Finset.sum_const, nsmul_eq_mul] using + chernoffDiv_pi_le ha (μ := fun _ : ι ↦ μ) (ν := fun _ : ι ↦ ν) + +end ProbabilityTheory diff --git a/Statlib/Divergence/Chernoff/Properties.lean b/Statlib/Divergence/Chernoff/Properties.lean new file mode 100644 index 0000000..5b1e23f --- /dev/null +++ b/Statlib/Divergence/Chernoff/Properties.lean @@ -0,0 +1,335 @@ +/- +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.Chernoff +public import Statlib.Divergence.Renyi.Order + +/-! +# Properties of the Chernoff divergence + +We prove that the Chernoff divergence is monotone in its order and that for finite measures `μ` +and `ν`, `C₁(μ, ν) = ⨆ a ∈ [0, 1], (1 - a) * Rₐ(μ, ν)`. By scale invariance +(`chernoffDiv_eq_chernoffDiv_inv_smul`), it suffices to prove the latter for probability +measures. + +The inequality `≥` follows from the variational formula for the Rényi divergence, +`(1 - a) * Rₐ(μ, ν) = ⨅ ξ, (a * KL(ξ, μ) + (1 - a) * KL(ξ, ν))`. The other inequality is usually +obtained from a minimax theorem. We prove it instead with the tilted measures +`ξₐ = renyiMeasure a μ ν`, for `a ∈ (0, 1)`. By the variational formula, for all `b ∈ (0, 1)`, +`b * KL(ξₐ, μ) + (1 - b) * KL(ξₐ, ν) ≥ (1 - b) * R_b(μ, ν)`, with equality for `b = a`. +That is, the affine function `b ↦ b * KL(ξₐ, μ) + (1 - b) * KL(ξₐ, ν)` is a supporting line at `a` +of the concave function `b ↦ (1 - b) * R_b(μ, ν)`, and its slope `KL(ξₐ, μ) - KL(ξₐ, ν)` is +antitone in `a`. If that slope changes sign, a convex combination of two tilted measures with +close parameters on both sides of the sign change has both Kullback-Leibler divergences close to +the supremum (by convexity of the Kullback-Leibler divergence). Otherwise, a tilted measure with +parameter close to `0` or `1` does the job. + +## Main statements + +* `chernoffDiv_le_chernoffDiv_of_le`, `monotoneOn_chernoffDiv`: for finite measures, + `a ↦ Cₐ(μ, ν)` is monotone on `[0, ∞)`. +* `chernoffDiv_one_eq_iSup_mul_renyiDiv`: for finite measures, + `C₁(μ, ν) = ⨆ a ∈ [0, 1], (1 - a) * Rₐ(μ, ν)`. The supremum is not attained in general. + +## References + +* T. van Erven, P. Harremoës, *Rényi divergence and Kullback-Leibler divergence*, IEEE + Transactions on Information Theory 60(7) (2014). +-/ + +@[expose] public section + +open MeasureTheory Set InformationTheory unitInterval + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {a b : ℝ} + +/-- For finite measures, `a ↦ Cₐ(μ, ν)` is monotone on `[0, ∞)`. -/ +@[gcongr] +lemma chernoffDiv_le_chernoffDiv_of_le [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha : 0 ≤ a) (hab : a ≤ b) : + chernoffDiv a μ ν ≤ chernoffDiv b μ ν := + iInf₂_mono fun _ _ ↦ max_le_max (renyiDiv_le_renyiDiv_of_le ha hab) + (renyiDiv_le_renyiDiv_of_le ha hab) + +/-- For finite measures, `a ↦ Cₐ(μ, ν)` is monotone on `[0, ∞)`. -/ +lemma monotoneOn_chernoffDiv [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + MonotoneOn (fun a ↦ chernoffDiv a μ ν) (Ici 0) := + fun _ ha _ _ hab ↦ chernoffDiv_le_chernoffDiv_of_le ha hab + +/-! ### The Chernoff divergence as a supremum of Rényi divergences -/ + +/-- For probability measures, `⨆ a ∈ [0, 1], (1 - a) * Rₐ(μ, ν) ≤ C₁(μ, ν)`, by the variational +formula for the Rényi divergence. -/ +private lemma iSup_mul_renyiDiv_le_chernoffDiv_one_of_isProbabilityMeasure [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] : + ⨆ a ∈ Icc (0 : ℝ) 1, ENNReal.ofReal (1 - a) * renyiDiv a μ ν ≤ chernoffDiv 1 μ ν := by + rw [← iSup_Ioo_mul_renyiDiv_eq_iSup_Icc, chernoffDiv_one] + refine iSup₂_le fun a ha ↦ le_iInf₂ fun ξ _ ↦ + (mul_renyiDiv_le_mul_klDiv_add_mul_klDiv μ ν ξ ha.1 ha.2).trans ?_ + calc ENNReal.ofReal a * klDiv ξ μ + ENNReal.ofReal (1 - a) * klDiv ξ ν + ≤ ENNReal.ofReal a * max (klDiv ξ μ) (klDiv ξ ν) + + ENNReal.ofReal (1 - a) * max (klDiv ξ μ) (klDiv ξ ν) := by gcongr <;> simp + _ = max (klDiv ξ μ) (klDiv ξ ν) := by + rw [← add_mul, ← ENNReal.ofReal_add ha.1.le (by linarith [ha.2])] + simp + +/-- Real-valued core of `chernoffDiv_one_le_iSup_mul_renyiDiv_of_isProbabilityMeasure`. Suppose +that for all `a, b ∈ (0, 1)`, `g b ≤ b * A a + (1 - b) * B a`, with equality for `b = a` (the line +`b ↦ b * A a + (1 - b) * B a` supports `g` at `a`), and that `g ≤ S` on `(0, 1)`. Then for all +`ε > 0`, there exist `a₁, a₂ ∈ (0, 1)` and `t ∈ [0, 1]` such that both convex combinations +`t * A a₁ + (1 - t) * A a₂` and `t * B a₁ + (1 - t) * B a₂` are at most `S + ε`. -/ +private lemma exists_convex_combination_le {A B g : ℝ → ℝ} {S ε : ℝ} (hε : 0 < ε) + (hg_le : ∀ a ∈ Ioo (0 : ℝ) 1, g a ≤ S) + (h_supp : ∀ a ∈ Ioo (0 : ℝ) 1, ∀ b ∈ Ioo (0 : ℝ) 1, g b ≤ b * A a + (1 - b) * B a) + (h_eq : ∀ a ∈ Ioo (0 : ℝ) 1, g a = a * A a + (1 - a) * B a) : + ∃ a₁ ∈ Ioo (0 : ℝ) 1, ∃ a₂ ∈ Ioo (0 : ℝ) 1, ∃ t ∈ Icc (0 : ℝ) 1, + t * A a₁ + (1 - t) * A a₂ ≤ S + ε ∧ t * B a₁ + (1 - t) * B a₂ ≤ S + ε := by + -- the slopes `A a - B a` of the supporting lines are antitone + have hφ : ∀ a ∈ Ioo (0 : ℝ) 1, ∀ b ∈ Ioo (0 : ℝ) 1, a ≤ b → A b - B b ≤ A a - B a := by + intro a ha b hb hab + rcases hab.eq_or_lt with rfl | hab + · exact le_rfl + have h1 := h_supp a ha b hb + have h2 := h_supp b hb a ha + rw [h_eq b hb] at h1 + rw [h_eq a ha] at h2 + have key : 0 ≤ (b - a) * ((A a - B a) - (A b - B b)) := by nlinarith + exact sub_nonneg.mp ((mul_nonneg_iff_of_pos_left (sub_pos.mpr hab)).mp key) + -- a single parameter `a` is a convex combination with `t = 1` + have h_single : ∀ a ∈ Ioo (0 : ℝ) 1, A a ≤ S + ε → B a ≤ S + ε → + ∃ a₁ ∈ Ioo (0 : ℝ) 1, ∃ a₂ ∈ Ioo (0 : ℝ) 1, ∃ t ∈ Icc (0 : ℝ) 1, + t * A a₁ + (1 - t) * A a₂ ≤ S + ε ∧ t * B a₁ + (1 - t) * B a₂ ≤ S + ε := + fun a ha hA hB ↦ ⟨a, ha, a, ha, 1, ⟨zero_le_one, le_rfl⟩, by simpa using hA, by simpa using hB⟩ + have h_half : (2⁻¹ : ℝ) ∈ Ioo (0 : ℝ) 1 := ⟨by norm_num, by norm_num⟩ + have hεd : ∀ d : ℝ, 0 ≤ d → ε / (d + 1) * d ≤ ε := by + intro d hd + rw [div_mul_eq_mul_div, div_le_iff₀ (by linarith)] + nlinarith + by_cases h1 : ∀ a ∈ Ioo (0 : ℝ) 1, 0 ≤ A a - B a + · -- all slopes are nonnegative: parameter close to `1` + set d := A 2⁻¹ - B 2⁻¹ with hd_def + have hd : 0 ≤ d := h1 2⁻¹ h_half + set a₀ := max 2⁻¹ (1 - ε / (d + 1)) with ha₀_def + have ha₀_ge : 2⁻¹ ≤ a₀ := le_max_left _ _ + have ha₀ : a₀ ∈ Ioo (0 : ℝ) 1 := + ⟨by linarith, max_lt (by norm_num) (by linarith [div_pos hε (by linarith : 0 < d + 1)])⟩ + have h1a : 1 - a₀ ≤ ε / (d + 1) := by linarith [le_max_right 2⁻¹ (1 - ε / (d + 1))] + have hA_eq : A a₀ = g a₀ + (1 - a₀) * (A a₀ - B a₀) := by rw [h_eq a₀ ha₀]; ring + have hprod : (1 - a₀) * (A a₀ - B a₀) ≤ ε / (d + 1) * d := + mul_le_mul h1a (hφ 2⁻¹ h_half a₀ ha₀ ha₀_ge) (h1 a₀ ha₀) (by positivity) + have hA_le : A a₀ ≤ S + ε := by linarith [hg_le a₀ ha₀, hεd d hd] + exact h_single a₀ ha₀ hA_le (by linarith [h1 a₀ ha₀]) + simp only [not_forall, not_le] at h1 + obtain ⟨a₂, ha₂, hφ₂⟩ := h1 + by_cases h3 : ∃ a₁ ∈ Ioo (0 : ℝ) 1, 0 ≤ A a₁ - B a₁ + swap + · -- all slopes are negative: parameter close to `0` + simp only [not_exists, not_and, not_le] at h3 + set d := B 2⁻¹ - A 2⁻¹ with hd_def + have hd : 0 ≤ d := by linarith [h3 2⁻¹ h_half] + set a₀ := min 2⁻¹ (ε / (d + 1)) with ha₀_def + have ha₀_pos : 0 < a₀ := lt_min (by norm_num) (div_pos hε (by linarith)) + have ha₀_le : a₀ ≤ 2⁻¹ := min_le_left _ _ + have ha₀ : a₀ ∈ Ioo (0 : ℝ) 1 := ⟨ha₀_pos, by linarith⟩ + have hB_eq : B a₀ = g a₀ + a₀ * (B a₀ - A a₀) := by rw [h_eq a₀ ha₀]; ring + have hprod : a₀ * (B a₀ - A a₀) ≤ ε / (d + 1) * d := + mul_le_mul (min_le_right _ _) (by linarith [hφ a₀ ha₀ 2⁻¹ h_half ha₀_le]) + (by linarith [h3 a₀ ha₀]) (by positivity) + have hB_le : B a₀ ≤ S + ε := by linarith [hg_le a₀ ha₀, hεd d hd] + exact h_single a₀ ha₀ (by linarith [h3 a₀ ha₀]) hB_le + -- the slopes change sign at `c`: convex combination of two parameters close to `c` + obtain ⟨a₁, ha₁, hφ₁⟩ := h3 + set T := {a ∈ Ioo (0 : ℝ) 1 | 0 ≤ A a - B a} with hT + have hT_ne : T.Nonempty := ⟨a₁, ha₁, hφ₁⟩ + have hT_bdd : BddAbove T := ⟨1, fun a ha ↦ ha.1.2.le⟩ + set c := sSup T with hc_def + have hT_lt : ∀ a ∈ T, a < a₂ := by + intro a ha + by_contra h + have := hφ a₂ ha₂ a ha.1 (not_lt.mp h) + linarith [ha.2] + have hc_ge : a₁ ≤ c := le_csSup hT_bdd ⟨ha₁, hφ₁⟩ + set D := B a₂ - A a₂ with hD_def + have hD : 0 < D := by linarith + set η := ε / D with hη_def + have hη : 0 < η := div_pos hε hD + obtain ⟨a₁', ha₁'T, ha₁'gt⟩ := exists_lt_of_lt_csSup hT_ne (show c - η / 2 < c by linarith) + have ha₁' : a₁' ∈ Ioo (0 : ℝ) 1 := ha₁'T.1 + set a₂' := min (c + η / 2) a₂ with ha₂'_def + have ha₂'_le : a₂' ≤ a₂ := min_le_right _ _ + have ha₂'_le' : a₂' ≤ c + η / 2 := min_le_left _ _ + have ha₂' : a₂' ∈ Ioo (0 : ℝ) 1 := + ⟨lt_min (by linarith [ha₁.1]) ha₂.1, ha₂'_le.trans_lt ha₂.2⟩ + have hφ₂' : A a₂' - B a₂' < 0 := by + by_contra h + have h_mem : a₂' ∈ T := ⟨ha₂', not_lt.mp h⟩ + have h_lt := hT_lt a₂' h_mem + have h_eq' : a₂' = c + η / 2 := by + rcases min_choice (c + η / 2) a₂ with h' | h' + · exact h' + · exact absurd h' h_lt.ne + linarith [le_csSup hT_bdd h_mem] + have hφ₁' : 0 ≤ A a₁' - B a₁' := ha₁'T.2 + have hgap : a₂' - a₁' ≤ η := by linarith + have hφ₂'_le : B a₂' - A a₂' ≤ D := by linarith [hφ a₂' ha₂' a₂ ha₂ ha₂'_le] + have ha₁₂ : a₁' ≤ a₂' := by + by_contra h + linarith [hφ a₂' ha₂' a₁' ha₁' (not_le.mp h).le] + -- weight of the convex combination, chosen so that the two combinations are equal + set t := (B a₂' - A a₂') / ((A a₁' - B a₁') - (A a₂' - B a₂')) with ht_def + have h_den : 0 < (A a₁' - B a₁') - (A a₂' - B a₂') := by linarith + have ht0 : 0 ≤ t := div_nonneg (by linarith) h_den.le + have ht1 : t ≤ 1 := (div_le_one h_den).mpr (by linarith) + have ht_eq : t * (A a₁' - B a₁') + (1 - t) * (A a₂' - B a₂') = 0 := by + rw [ht_def] + field_simp + ring + have hT_le : t * A a₁' + (1 - t) * A a₂' ≤ S + ε := by + have e1 := h_eq a₁' ha₁' + have e2 := h_eq a₂' ha₂' + have hTA : t * A a₁' + (1 - t) * A a₂' + = t * g a₁' + (1 - t) * g a₂' + (1 - t) * ((a₂' - a₁') * (B a₂' - A a₂')) := by + rw [e1, e2] + linear_combination (1 - a₁') * ht_eq + have hg_comb : t * g a₁' + (1 - t) * g a₂' ≤ S := by + have := hg_le a₁' ha₁' + have := hg_le a₂' ha₂' + nlinarith + have hprod : (a₂' - a₁') * (B a₂' - A a₂') ≤ η * D := + mul_le_mul hgap hφ₂'_le (by linarith) hη.le + have hηD : η * D = ε := div_mul_cancel₀ _ hD.ne' + have hprod' : (1 - t) * ((a₂' - a₁') * (B a₂' - A a₂')) ≤ (a₂' - a₁') * (B a₂' - A a₂') := + mul_le_of_le_one_left (mul_nonneg (by linarith) (by linarith)) (by linarith) + linarith + have hTB : t * B a₁' + (1 - t) * B a₂' = t * A a₁' + (1 - t) * A a₂' := by + linear_combination -ht_eq + exact ⟨a₁', ha₁', a₂', ha₂', t, ⟨ht0, ht1⟩, hT_le, hTB ▸ hT_le⟩ + +/-- For probability measures, `C₁(μ, ν) ≤ ⨆ a ∈ [0, 1], (1 - a) * Rₐ(μ, ν)`, with convex +combinations of tilted measures. -/ +private lemma chernoffDiv_one_le_iSup_mul_renyiDiv_of_isProbabilityMeasure [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] : + chernoffDiv 1 μ ν ≤ ⨆ a ∈ Icc (0 : ℝ) 1, ENNReal.ofReal (1 - a) * renyiDiv a μ ν := by + rw [← iSup_Ioo_mul_renyiDiv_eq_iSup_Icc] + set s := ⨆ a ∈ Ioo (0 : ℝ) 1, ENNReal.ofReal (1 - a) * renyiDiv a μ ν with hs + have h_le_s : ∀ a ∈ Ioo (0 : ℝ) 1, ENNReal.ofReal (1 - a) * renyiDiv a μ ν ≤ s := + fun a ha ↦ le_iSup₂ (f := fun a (_ : a ∈ Ioo (0 : ℝ) 1) ↦ + ENNReal.ofReal (1 - a) * renyiDiv a μ ν) a ha + by_cases hs_top : s = ∞ + · simp [hs_top] + have h_ms : ¬ μ ⟂ₘ ν := by + refine fun h_ms ↦ hs_top (top_le_iff.mp ((h_le_s 2⁻¹ ⟨by norm_num, by norm_num⟩).trans' ?_)) + rw [(renyiDiv_eq_top_iff_mutuallySingular_of_lt_one (by norm_num) (by norm_num)).mpr h_ms, + ENNReal.mul_top (by norm_num)] + -- real-valued notation: `g a = (1 - a) * Rₐ(μ, ν)`, and the Kullback-Leibler divergences + -- `A a = KL(ξₐ, μ)` and `B a = KL(ξₐ, ν)` of the tilted measures + set g : ℝ → ℝ := fun a ↦ (1 - a) * (renyiDiv a μ ν).toReal with hg_def + set A : ℝ → ℝ := fun a ↦ (klDiv (renyiMeasure a μ ν) μ).toReal with hA_def + set B : ℝ → ℝ := fun a ↦ (klDiv (renyiMeasure a μ ν) ν).toReal with hB_def + have hg : ∀ a ∈ Ioo (0 : ℝ) 1, + ENNReal.ofReal (1 - a) * renyiDiv a μ ν = ENNReal.ofReal (g a) := by + intro a ha + rw [hg_def, ENNReal.ofReal_mul (by linarith [ha.2]), ENNReal.ofReal_toReal + (mt (renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha.1.le ha.2).mp h_ms)] + have hAB_nonneg : ∀ a, ∀ b ∈ Icc (0 : ℝ) 1, 0 ≤ b * A a + (1 - b) * B a := fun a b hb ↦ + add_nonneg (mul_nonneg hb.1 ENNReal.toReal_nonneg) + (mul_nonneg (sub_nonneg.mpr hb.2) ENNReal.toReal_nonneg) + have hAB : ∀ a ∈ Ioo (0 : ℝ) 1, ∀ b ∈ Icc (0 : ℝ) 1, + ENNReal.ofReal b * klDiv (renyiMeasure a μ ν) μ + + ENNReal.ofReal (1 - b) * klDiv (renyiMeasure a μ ν) ν + = ENNReal.ofReal (b * A a + (1 - b) * B a) := by + intro a ha b hb + rw [ENNReal.ofReal_add (mul_nonneg hb.1 ENNReal.toReal_nonneg) + (mul_nonneg (sub_nonneg.mpr hb.2) ENNReal.toReal_nonneg), ENNReal.ofReal_mul hb.1, + ENNReal.ofReal_mul (sub_nonneg.mpr hb.2), + ENNReal.ofReal_toReal (klDiv_renyiMeasure_left_ne_top ha.1 ha.2 h_ms), + ENNReal.ofReal_toReal (klDiv_renyiMeasure_right_ne_top ha.1 ha.2 h_ms)] + have hg_le : ∀ a ∈ Ioo (0 : ℝ) 1, g a ≤ s.toReal := fun a ha ↦ + (ENNReal.ofReal_le_iff_le_toReal hs_top).mp (hg a ha ▸ h_le_s a ha) + have h_supp : ∀ a ∈ Ioo (0 : ℝ) 1, ∀ b ∈ Ioo (0 : ℝ) 1, g b ≤ b * A a + (1 - b) * B a := by + intro a ha b hb + have := isProbabilityMeasure_renyiMeasure ha.1 ha.2 h_ms + have h := mul_renyiDiv_le_mul_klDiv_add_mul_klDiv μ ν (renyiMeasure a μ ν) hb.1 hb.2 + rw [hg b hb, hAB a ha b ⟨hb.1.le, hb.2.le⟩] at h + exact (ENNReal.ofReal_le_ofReal_iff (hAB_nonneg a b ⟨hb.1.le, hb.2.le⟩)).mp h + have h_eq : ∀ a ∈ Ioo (0 : ℝ) 1, g a = a * A a + (1 - a) * B a := by + intro a ha + have h := mul_renyiDiv_eq_mul_klDiv_renyiMeasure ha.1 ha.2 h_ms + rw [hg a ha, hAB a ha a ⟨ha.1.le, ha.2.le⟩] at h + exact (ENNReal.ofReal_eq_ofReal_iff (mul_nonneg (by linarith [ha.2]) ENNReal.toReal_nonneg) + (hAB_nonneg a a ⟨ha.1.le, ha.2.le⟩)).mp h + -- it suffices to find, for all `ε > 0`, a probability measure with both divergences + -- at most `s + ε`: a convex combination of two tilted measures + rw [chernoffDiv_one] + refine ENNReal.le_of_forall_pos_le_add fun ε hε _ ↦ ?_ + obtain ⟨a₁, ha₁, a₂, ha₂, t, ht, hA, hB⟩ := + exists_convex_combination_le (NNReal.coe_pos.mpr hε) hg_le h_supp h_eq + have := isProbabilityMeasure_renyiMeasure ha₁.1 ha₁.2 h_ms + have := isProbabilityMeasure_renyiMeasure ha₂.1 ha₂.2 h_ms + obtain ⟨p, rfl⟩ : ∃ p : I, (p : ℝ) = t := ⟨⟨t, ht⟩, rfl⟩ + have h_mix : ∀ (ρ : Measure α) [IsFiniteMeasure ρ], + klDiv (toNNReal p • renyiMeasure a₁ μ ν + toNNReal (σ p) • renyiMeasure a₂ μ ν) ρ + ≤ ENNReal.ofReal p * klDiv (renyiMeasure a₁ μ ν) ρ + + ENNReal.ofReal (1 - p) * klDiv (renyiMeasure a₂ μ ν) ρ := by + intro ρ _ + have h := klDiv_smul_add_smul_le (renyiMeasure a₁ μ ν) (renyiMeasure a₂ μ ν) ρ ρ + (toNNReal p) (toNNReal (σ p)) + rwa [← add_smul, toNNReal_add_toNNReal_symm, one_smul, ← ENNReal.ofReal_coe_nnreal, + ← ENNReal.ofReal_coe_nnreal (p := toNNReal (σ p)), coe_toNNReal, coe_toNNReal, + coe_symm_eq] at h + have h_bound : ∀ x y : ℝ≥0∞, x ≠ ∞ → y ≠ ∞ → p * x.toReal + (1 - p) * y.toReal ≤ s.toReal + ε → + ENNReal.ofReal p * x + ENNReal.ofReal (1 - p) * y ≤ s + ε := by + intro x y hx hy h + rw [← ENNReal.ofReal_toReal hx, ← ENNReal.ofReal_toReal hy, ← ENNReal.ofReal_mul p.2.1, + ← ENNReal.ofReal_mul (sub_nonneg.mpr p.2.2), ← ENNReal.ofReal_add + (mul_nonneg p.2.1 ENNReal.toReal_nonneg) + (mul_nonneg (sub_nonneg.mpr p.2.2) ENNReal.toReal_nonneg), + ← ENNReal.ofReal_toReal hs_top, ← ENNReal.ofReal_coe_nnreal, + ← ENNReal.ofReal_add ENNReal.toReal_nonneg ε.coe_nonneg] + exact ENNReal.ofReal_le_ofReal h + have hζ : IsProbabilityMeasure + (toNNReal p • renyiMeasure a₁ μ ν + toNNReal (σ p) • renyiMeasure a₂ μ ν) := inferInstance + refine (iInf₂_le _ hζ).trans (max_le ((h_mix μ).trans ?_) ((h_mix ν).trans ?_)) + · exact h_bound _ _ (klDiv_renyiMeasure_left_ne_top ha₁.1 ha₁.2 h_ms) + (klDiv_renyiMeasure_left_ne_top ha₂.1 ha₂.2 h_ms) hA + · exact h_bound _ _ (klDiv_renyiMeasure_right_ne_top ha₁.1 ha₁.2 h_ms) + (klDiv_renyiMeasure_right_ne_top ha₂.1 ha₂.2 h_ms) hB + +/-- For finite measures, `C₁(μ, ν) = ⨆ a ∈ [0, 1], (1 - a) * Rₐ(μ, ν)`. The supremum is not +attained in general. -/ +theorem chernoffDiv_one_eq_iSup_mul_renyiDiv [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + chernoffDiv 1 μ ν = ⨆ a ∈ Icc (0 : ℝ) 1, ENNReal.ofReal (1 - a) * renyiDiv a μ ν := by + -- if `μ = 0` or `ν = 0`, both sides are infinite + have h_top : μ ⟂ₘ ν → ⨆ a ∈ Icc (0 : ℝ) 1, ENNReal.ofReal (1 - a) * renyiDiv a μ ν = ∞ := by + refine fun h_ms ↦ top_le_iff.mp (le_iSup₂_of_le (f := fun a (_ : a ∈ Icc (0 : ℝ) 1) ↦ + ENNReal.ofReal (1 - a) * renyiDiv a μ ν) 2⁻¹ ⟨by norm_num, by norm_num⟩ ?_) + rw [(renyiDiv_eq_top_iff_mutuallySingular_of_lt_one (by norm_num) (by norm_num)).mpr h_ms, + ENNReal.mul_top (by norm_num)] + rcases eq_zero_or_neZero μ with rfl | _ + · rw [chernoffDiv_zero_measure_left zero_le_one, h_top Measure.MutuallySingular.zero_left] + rcases eq_zero_or_neZero ν with rfl | _ + · rw [chernoffDiv_zero_measure_right zero_le_one, h_top Measure.MutuallySingular.zero_right] + -- otherwise, both sides are invariant under normalization of the measures + rw [chernoffDiv_eq_chernoffDiv_inv_smul zero_le_one, + le_antisymm chernoffDiv_one_le_iSup_mul_renyiDiv_of_isProbabilityMeasure + iSup_mul_renyiDiv_le_chernoffDiv_one_of_isProbabilityMeasure] + exact iSup_congr fun a ↦ iSup_congr fun ha ↦ by rw [← renyiDiv_eq_renyiDiv_inv_smul ha.1] + +/-- For finite measures and `0 ≤ a`, `(1 - a) * Rₐ(μ, ν) ≤ C₁(μ, ν)`, where `1 - a` is truncated +at `0`. -/ +lemma mul_renyiDiv_le_chernoffDiv_one [IsFiniteMeasure μ] [IsFiniteMeasure ν] (ha : 0 ≤ a) : + ENNReal.ofReal (1 - a) * renyiDiv a μ ν ≤ chernoffDiv 1 μ ν := by + rcases le_or_gt a 1 with ha1 | ha1 + · exact (le_iSup₂ (f := fun a (_ : a ∈ Icc (0 : ℝ) 1) ↦ ENNReal.ofReal (1 - a) * renyiDiv a μ ν) + a ⟨ha, ha1⟩).trans chernoffDiv_one_eq_iSup_mul_renyiDiv.ge + · simp [ENNReal.ofReal_eq_zero.mpr (sub_nonpos.mpr ha1.le)] + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/Basic.lean b/Statlib/Divergence/FDiv/Basic.lean index 2b8672e..e524e28 100644 --- a/Statlib/Divergence/FDiv/Basic.lean +++ b/Statlib/Divergence/FDiv/Basic.lean @@ -10,6 +10,7 @@ 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 +public import Statlib.ForMathlib.Analysis.Convex.Deriv /-! # f-Divergences @@ -25,9 +26,16 @@ public import Mathlib.MeasureTheory.Measure.Decomposition.IntegralRNDeriv 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_lintegral_mixtureFun`: `fDiv f μ ν = ∫⁻ x, f.mixtureFun (∂μ/∂(μ + ν) x) ∂(μ + ν)`, a + representation of `fDiv` as a single integral, without absolute continuity hypothesis. * `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_mono`, `fDiv_le_mul_fDiv_of_le`: monotonicity in the divergence function. It suffices to + compare the divergence functions on `(0, ∞)`. +* `fDiv_ofReal_le_of_deriv2_le`: for divergence functions built from twice differentiable real + functions `φ` and `ψ` with `φ 1 = ψ 1 = 0` and `φ' 1 = c * ψ' 1`, if `φ'' ≤ c * ψ''` on `(0, ∞)` + then `fDiv φ μ ν ≤ c * fDiv ψ μ ν`. * `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. @@ -40,6 +48,11 @@ Lebesgue integral, without integrability conditions, and takes values in `ℝ≥ The results that need derivatives or the convexity lemmas of Mathlib use the real function `f.realFun : ℝ → ℝ` instead. +## References + +* R. Degenne, *An inequality between Jensen-Shannon and Hellinger divergences*, short note + (Lemmas 5 and 6, for `fDiv_ofReal_le_of_deriv2_le`). + -/ @[expose] public section @@ -173,6 +186,49 @@ lemma fDiv_eq_add_withDensity_derivAtTop fDiv_absolutelyContinuous_add_mutuallySingular (withDensity_absolutelyContinuous _ _) (Measure.mutuallySingular_singularPart _ _)] +/-- **The f-divergence as an integral with respect to `μ + ν`**: if `p = ∂μ/∂(μ + ν)`, then +`fDiv f μ ν = ∫⁻ x, f.mixtureFun (p x) ∂(μ + ν)`. The singular part of `μ` with respect to `ν` +corresponds to the set where `p = 1`. -/ +lemma fDiv_eq_lintegral_mixtureFun (μ ν : Measure α) [SigmaFinite μ] [SigmaFinite ν] : + fDiv f μ ν = ∫⁻ x, f.mixtureFun ((∂μ/∂(μ + ν)) x) ∂(μ + ν) := by + have hνρ : ν ≪ μ + ν := Measure.AbsolutelyContinuous.rfl.add_right' μ + -- the singular part of `μ` with respect to `ν` is the restriction of `μ` to the set `N` where + -- `∂ν/∂(μ + ν)` vanishes + set N := {x | (∂ν/∂(μ + ν)) x = 0} with hN_def + have hN : MeasurableSet N := measurableSet_eq_fun (ν.measurable_rnDeriv _) measurable_const + have hpq : ∀ᵐ x ∂(μ + ν), (∂μ/∂(μ + ν)) x + (∂ν/∂(μ + ν)) x = 1 := by + filter_upwards [Measure.rnDeriv_add' μ ν (μ + ν), (μ + ν).rnDeriv_self] with x h1 h2 + rw [← Pi.add_apply, ← h1, h2] + have hνN : ν N = 0 := by + rw [← Measure.setLIntegral_rnDeriv hνρ, setLIntegral_congr_fun hN (g := 0) fun x hx ↦ hx] + simp + -- we write both terms of `fDiv f μ ν` as integrals with respect to `μ + ν`, and compare the + -- integrands on `N` and on its complement + have h1 : ∫⁻ x, f ((∂μ/∂ν) x) ∂ν + = ∫⁻ x, (∂ν/∂(μ + ν)) x * f ((∂μ/∂(μ + ν)) x / (∂ν/∂(μ + ν)) x) ∂(μ + ν) := by + rw [lintegral_rnDeriv_mul hνρ (f := fun x ↦ f ((∂μ/∂(μ + ν)) x / (∂ν/∂(μ + ν)) x)) + (f.continuous.measurable.comp ((μ.measurable_rnDeriv _).div + (ν.measurable_rnDeriv _))).aemeasurable] + refine lintegral_congr_ae ?_ + filter_upwards [Measure.rnDeriv_eq_div_rnDeriv_add μ ν] with x hx + rw [hx] + have h2 : f.derivAtTop * μ N = ∫⁻ x, N.indicator (fun _ ↦ f.derivAtTop) x ∂(μ + ν) := by + rw [lintegral_indicator hN, setLIntegral_const, Measure.add_apply, hνN, add_zero] + rw [fDiv, Measure.singularPart_eq_restrict_rnDeriv_add_eq_zero, Measure.restrict_apply_univ, + h1, h2, ← lintegral_add_right _ (measurable_const.indicator hN)] + refine lintegral_congr_ae ?_ + filter_upwards [hpq] with x hx + by_cases hqx : (∂ν/∂(μ + ν)) x = 0 + · have hpx : (∂μ/∂(μ + ν)) x = 1 := by simpa [hqx] using hx + have hxN : x ∈ N := hqx + simp [hqx, hpx, hxN, DivFunction.mixtureFun_of_one_le] + · have hp_top : (∂μ/∂(μ + ν)) x ≠ ∞ := ne_top_of_le_ne_top ENNReal.one_ne_top (hx ▸ le_self_add) + have hpx : (∂μ/∂(μ + ν)) x < 1 := hx ▸ ENNReal.lt_add_right hp_top hqx + have h1p : 1 - (∂μ/∂(μ + ν)) x = (∂ν/∂(μ + ν)) x := + ENNReal.sub_eq_of_eq_add hp_top (by rw [← hx, add_comm]) + have hxN : x ∉ N := hqx + simp [DivFunction.mixtureFun_of_lt_one hpx, h1p, hxN] + end AbsolutelyContinuousMutuallySingular section AddMeasure @@ -365,6 +421,14 @@ lemma fDiv_mono_ae (hfg : f ≤ᵐ[ν.map (∂μ/∂ν)] g) (hfg' : f.derivAtTop lemma fDiv_mono (hfg : ∀ x, f x ≤ g x) : fDiv f μ ν ≤ fDiv g μ ν := fDiv_mono_ae (.of_forall hfg) (DivFunction.derivAtTop_mono hfg) +/-- If two divergence functions satisfy `f x ≤ c * g x` on `(0, ∞)`, then +`fDiv f μ ν ≤ c * fDiv g μ ν`. -/ +lemma fDiv_le_mul_fDiv_of_le {c : ℝ≥0} (h : ∀ x, x ≠ 0 → x ≠ ∞ → f x ≤ c * g x) + (μ ν : Measure α) : + fDiv f μ ν ≤ c * fDiv g μ ν := by + rw [← fDiv_smul] + exact fDiv_mono (DivFunction.le_of_forall_ne_zero_ne_top (g := c • g) h) + /-- 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) @@ -500,6 +564,25 @@ lemma toReal_fDiv_ofReal_eq_integral_add_of_ac [IsFiniteMeasure μ] 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)] +/-- **Comparison of f-divergences from a comparison of second derivatives.** +Let `φ, ψ : ℝ → ℝ` be convex on `(0, ∞)` and twice differentiable there, with `φ 1 = ψ 1 = 0` and +`φ' 1 = c * ψ' 1` (for example `φ' 1 = ψ' 1 = 0`). If `φ'' ≤ c * ψ''` on `(0, ∞)`, then the +f-divergences satisfy `D_φ(μ, ν) ≤ c * D_ψ(μ, ν)`. +The pointwise inequality `φ ≤ c * ψ` on `(0, ∞)` is `le_mul_of_deriv2_le`. -/ +theorem fDiv_ofReal_le_of_deriv2_le {φ ψ φ' ψ' φ'' ψ'' : ℝ → ℝ} {c : ℝ≥0} + (hφ_cvx : ConvexOn ℝ (Ioi 0) φ) (hψ_cvx : ConvexOn ℝ (Ioi 0) ψ) + (hφ_one : φ 1 = 0) (hψ_one : ψ 1 = 0) + (hφ : ∀ x, 0 < x → HasDerivAt φ (φ' x) x) (hφ' : ∀ x, 0 < x → HasDerivAt φ' (φ'' x) x) + (hψ : ∀ x, 0 < x → HasDerivAt ψ (ψ' x) x) (hψ' : ∀ x, 0 < x → HasDerivAt ψ' (ψ'' x) x) + (h_deriv_one : φ' 1 = c * ψ' 1) (h : ∀ x, 0 < x → φ'' x ≤ c * ψ'' x) (μ ν : Measure α) : + fDiv (DivFunction.ofReal φ hφ_cvx hφ_one) μ ν + ≤ c * fDiv (DivFunction.ofReal ψ hψ_cvx hψ_one) μ ν := by + refine fDiv_le_mul_fDiv_of_le (fun x hx0 hx_top ↦ ?_) μ ν + rw [DivFunction.ofReal_apply hx0 hx_top, DivFunction.ofReal_apply hx0 hx_top, + ← ENNReal.ofReal_coe_nnreal, ← ENNReal.ofReal_mul (NNReal.coe_nonneg c)] + exact ENNReal.ofReal_le_ofReal <| le_mul_of_deriv2_le (convex_Ioi 0) (by simp) hφ hφ' hψ hψ' + (by simp [hφ_one, hψ_one]) h_deriv_one h (ENNReal.toReal_pos hx0 hx_top) + end OfReal end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/Binary.lean b/Statlib/Divergence/FDiv/Binary.lean new file mode 100644 index 0000000..5ce6bb3 --- /dev/null +++ b/Statlib/Divergence/FDiv/Binary.lean @@ -0,0 +1,307 @@ +/- +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 +public import Statlib.Divergence.FDiv.Conj +public import Statlib.Divergence.FDiv.Convex +public import Statlib.ForMathlib.Probability.Distributions.Bernoulli + +/-! +# f-divergences between Bernoulli distributions + +We study the binary f-divergence `d_f(p, q) = fDiv f Ber(x, y, p) Ber(x, y, q)` between two +Bernoulli distributions, as a function of the parameters `p q : I`, and we prove that it is a lower +bound for the f-divergence between two probability measures on the unit interval with means `p` +and `q`. + +## Main statements + +* `fDiv_bernoulliMeasure_le_mul_add_mul`: joint convexity of `(p, q) ↦ d_f(p, q)`. +* `monotoneOn_fDiv_bernoulliMeasure_left`, `antitoneOn_fDiv_bernoulliMeasure_left`: for fixed `q`, + `p ↦ d_f(p, q)` is antitone on `[0, q]` and monotone on `[q, 1]`. Its minimum is + `d_f(q, q) = 0` (`fDiv_self`). `monotoneOn_fDiv_bernoulliMeasure_right` and + `antitoneOn_fDiv_bernoulliMeasure_right` are the analogous statements in the second argument. +* `fDiv_bernoulliMeasure_of_mem_of_notMem`: if a measurable set separates `x` and `y`, then + `d_f(p, q)` is the binary f-divergence between Bernoulli distributions on `Bool`. Otherwise + `dirac x = dirac y` and `d_f(p, q) = 0` (`fDiv_bernoulliMeasure_of_dirac_eq`). +* `fDiv_bernoulliMeasure_of_ne_zero_of_ne_one`, `fDiv_bernoulliMeasure_zero_right`, + `fDiv_bernoulliMeasure_one_right`: explicit formulas. +* `continuous_fDiv_bernoulliMeasure_left`: for `q ∉ {0, 1}`, `p ↦ d_f(p, q)` is continuous. + `continuousAt_fDiv_bernoulliMeasure_left`: for all `q`, it is continuous at every `p ≠ q`. +* `fDiv_bernoulliMeasure_le_of_integral_eq`: for probability measures `μ, ν` on the unit interval + with means `p` and `q`, `d_f(p, q) ≤ D_f(μ, ν)`. +* `fDiv_bernoulliMeasure_le_of_integral_comp_eq`, `fDiv_bernoulliMeasure_le_of_lintegral_eq`, + `fDiv_bernoulliMeasure_le_of_integral_comp_kernel_eq`: the same bound for the means of a + function with values in `[0, 1]`, or of the image of the measures by a Markov kernel to `I`. +-/ + +@[expose] public section + +open MeasureTheory Set Filter Topology unitInterval + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +variable {𝓧 : Type*} {m𝓧 : MeasurableSpace 𝓧} {x y : 𝓧} {f : DivFunction} + +section Convexity + +/-- **Joint convexity** of the f-divergence between Bernoulli distributions. -/ +lemma fDiv_bernoulliMeasure_le_mul_add_mul {p₁ p₂ q₁ q₂ p q : I} {t : ℝ≥0} (ht : t ≤ 1) + (hp : (p : ℝ) = t * p₁ + (1 - t) * p₂) (hq : (q : ℝ) = t * q₁ + (1 - t) * q₂) : + fDiv f Ber(x, y, p) Ber(x, y, q) + ≤ t * fDiv f Ber(x, y, p₁) Ber(x, y, q₁) + + (1 - t : ℝ≥0) * fDiv f Ber(x, y, p₂) Ber(x, y, q₂) := by + rw [bernoulliMeasure_eq_smul_add_smul x y ht hp, bernoulliMeasure_eq_smul_add_smul x y ht hq] + exact fDiv_smul_add_smul_le _ _ _ _ _ _ + +/-- Moving the first parameter towards the second one along a segment decreases the binary +f-divergence: `d_f(t p' + (1 - t) q, q) ≤ t d_f(p', q)`. -/ +lemma fDiv_bernoulliMeasure_le_mul_left {p p' q : I} {t : ℝ≥0} (ht : t ≤ 1) + (hp : (p : ℝ) = t * p' + (1 - t) * q) : + fDiv f Ber(x, y, p) Ber(x, y, q) ≤ t * fDiv f Ber(x, y, p') Ber(x, y, q) := by + refine (fDiv_bernoulliMeasure_le_mul_add_mul (q₁ := q) (q₂ := q) ht hp (by ring)).trans ?_ + simp [fDiv_self] + +/-- If `p` lies between `q` and `p'`, then `d_f(p, q) ≤ d_f(p', q)`. -/ +lemma fDiv_bernoulliMeasure_le_of_mem_uIcc_left {p p' q : I} (hp : (p : ℝ) ∈ uIcc (q : ℝ) p') : + fDiv f Ber(x, y, p) Ber(x, y, q) ≤ fDiv f Ber(x, y, p') Ber(x, y, q) := by + rw [← segment_eq_uIcc] at hp + obtain ⟨a, b, ha, hb, hab, h⟩ := hp + lift b to ℝ≥0 using hb + have hb1 : b ≤ 1 := by exact_mod_cast (by linarith : (b : ℝ) ≤ 1) + refine (fDiv_bernoulliMeasure_le_mul_left (t := b) (p' := p') hb1 ?_).trans + (mul_le_of_le_one_left bot_le (by exact_mod_cast hb1)) + simp only [smul_eq_mul] at h + linear_combination -h + (q : ℝ) * hab + +/-- For fixed `q`, `p ↦ d_f(p, q)` is monotone on `[q, 1]`. -/ +lemma monotoneOn_fDiv_bernoulliMeasure_left (q : I) : + MonotoneOn (fun p ↦ fDiv f Ber(x, y, p) Ber(x, y, q)) (Ici q) := + fun _ hp _ _ hpp' ↦ fDiv_bernoulliMeasure_le_of_mem_uIcc_left + (mem_uIcc.mpr (Or.inl ⟨Subtype.coe_le_coe.mpr hp, Subtype.coe_le_coe.mpr hpp'⟩)) + +/-- For fixed `q`, `p ↦ d_f(p, q)` is antitone on `[0, q]`. -/ +lemma antitoneOn_fDiv_bernoulliMeasure_left (q : I) : + AntitoneOn (fun p ↦ fDiv f Ber(x, y, p) Ber(x, y, q)) (Iic q) := + fun _ _ _ hp' hpp' ↦ fDiv_bernoulliMeasure_le_of_mem_uIcc_left + (mem_uIcc.mpr (Or.inr ⟨Subtype.coe_le_coe.mpr hpp', Subtype.coe_le_coe.mpr hp'⟩)) + +/-- For fixed `p`, `q ↦ d_f(p, q)` is monotone on `[p, 1]`. -/ +lemma monotoneOn_fDiv_bernoulliMeasure_right (p : I) : + MonotoneOn (fun q ↦ fDiv f Ber(x, y, p) Ber(x, y, q)) (Ici p) := by + intro q hq q' hq' hqq' + simp only [← fDiv_conj (f := f)] + exact monotoneOn_fDiv_bernoulliMeasure_left p hq hq' hqq' + +/-- For fixed `p`, `q ↦ d_f(p, q)` is antitone on `[0, p]`. -/ +lemma antitoneOn_fDiv_bernoulliMeasure_right (p : I) : + AntitoneOn (fun q ↦ fDiv f Ber(x, y, p) Ber(x, y, q)) (Iic p) := by + intro q hq q' hq' hqq' + simp only [← fDiv_conj (f := f)] + exact antitoneOn_fDiv_bernoulliMeasure_left p hq hq' hqq' + +end Convexity + +section Bool + +/-- If a measurable set contains `x` but not `y`, the f-divergence between `Ber(x, y, p)` and +`Ber(x, y, q)` is the f-divergence between the Bernoulli distributions with the same parameters +on `Bool`. -/ +lemma fDiv_bernoulliMeasure_of_mem_of_notMem {s : Set 𝓧} (hs : MeasurableSet s) (hx : x ∈ s) + (hy : y ∉ s) (p q : I) : + fDiv f Ber(x, y, p) Ber(x, y, q) = fDiv f Ber(true, false, p) Ber(true, false, q) := by + classical + have he : Measurable fun b : Bool ↦ if b then x else y := measurable_from_top + have h_inv : Function.LeftInverse (fun z ↦ decide (z ∈ s)) fun b : Bool ↦ if b then x else y := by + intro b + cases b <;> simp [hx, hy] + rw [← fDiv_map_eq_of_leftInverse he (measurable_decide_mem hs) h_inv, + map_bernoulliMeasure' _ _ he, map_bernoulliMeasure' _ _ he] + simp + +/-- If no measurable set separates `x` and `y`, that is `dirac x = dirac y`, then +`Ber(x, y, p) = dirac x` for all `p` and the f-divergence between two such distributions is zero. +Otherwise, `fDiv_bernoulliMeasure_of_mem_of_notMem` applies. -/ +lemma fDiv_bernoulliMeasure_of_dirac_eq (hxy : Measure.dirac x = Measure.dirac y) (p q : I) : + fDiv f Ber(x, y, p) Ber(x, y, q) = 0 := by + rw [bernoulliMeasure_eq_dirac_of_dirac_eq hxy, bernoulliMeasure_eq_dirac_of_dirac_eq hxy, + fDiv_self] + +end Bool + +section Formula + +variable [MeasurableSingletonClass 𝓧] + +/-- The f-divergence between Bernoulli distributions, for a second parameter `q ∉ {0, 1}`. -/ +lemma fDiv_bernoulliMeasure_of_ne_zero_of_ne_one (hxy : x ≠ y) (p : I) {q : I} (hq : q ≠ 0) + (hq1 : q ≠ 1) : + fDiv f Ber(x, y, p) Ber(x, y, q) + = ENNReal.ofReal q * f (ENNReal.ofReal (p / q)) + + ENNReal.ofReal (1 - q) * f (ENNReal.ofReal ((1 - p) / (1 - q))) := by + classical + rw [fDiv_of_absolutelyContinuous (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 [hxy.symm] + +/-- The f-divergence between a Bernoulli distribution and the Dirac mass `Ber(x, y, 1)`. -/ +lemma fDiv_bernoulliMeasure_one_right (hxy : x ≠ y) (p : I) : + fDiv f Ber(x, y, p) Ber(x, y, 1) + = f (ENNReal.ofReal p) + f.derivAtTop * ENNReal.ofReal (1 - p) := by + have h_ms : Measure.dirac y ⟂ₘ Measure.dirac x := + ⟨{x}, measurableSet_singleton x, by simp [hxy.symm], by simp⟩ + rw [bernoulliMeasure_one, bernoulliMeasure_def, + fDiv_absolutelyContinuous_add_mutuallySingular + (Measure.AbsolutelyContinuous.rfl.smul_left (toNNReal p)) (h_ms.smul_nnreal _), + fDiv_of_absolutelyContinuous (Measure.AbsolutelyContinuous.rfl.smul_left (toNNReal p))] + have h_rn : (toNNReal p • Measure.dirac x).rnDeriv (Measure.dirac x) + =ᵐ[Measure.dirac x] fun _ ↦ ENNReal.ofReal p := by + filter_upwards [Measure.rnDeriv_smul_left' (Measure.dirac x) (Measure.dirac x) (toNNReal p), + Measure.rnDeriv_self (Measure.dirac x)] with z hz h_self + rw [hz, Pi.smul_apply, h_self, ENNReal.smul_def, smul_eq_mul, mul_one, + coe_toNNReal_eq_ofReal] + rw [lintegral_congr_ae (h_rn.mono fun z hz ↦ by rw [hz])] + simp [coe_toNNReal_symm_eq_ofReal] + +/-- The f-divergence between a Bernoulli distribution and the Dirac mass `Ber(x, y, 0)`. -/ +lemma fDiv_bernoulliMeasure_zero_right (hxy : x ≠ y) (p : I) : + fDiv f Ber(x, y, p) Ber(x, y, 0) + = f (ENNReal.ofReal (1 - p)) + f.derivAtTop * ENNReal.ofReal p := by + rw [← bernoulliMeasure_swap x y p, ← bernoulliMeasure_swap x y 0, symm_zero, + fDiv_bernoulliMeasure_one_right hxy.symm, coe_symm_eq, sub_sub_cancel] + +end Formula + +section Continuity + +/-- For `q ∉ {0, 1}`, the binary f-divergence `p ↦ d_f(p, q)` is continuous. -/ +lemma continuous_fDiv_bernoulliMeasure_left {q : I} (hq0 : q ≠ 0) (hq1 : q ≠ 1) : + Continuous (fun p ↦ fDiv f Ber(x, y, p) Ber(x, y, q)) := by + rcases eq_or_ne (Measure.dirac x) (Measure.dirac y) with hxy | hxy + · simp_rw [fDiv_bernoulliMeasure_of_dirac_eq hxy] + exact continuous_const + obtain ⟨s, hs, hx, hy⟩ := dirac_ne_dirac_iff_exists_measurableSet.mp hxy + simp_rw [fDiv_bernoulliMeasure_of_mem_of_notMem hs hx hy, + fDiv_bernoulliMeasure_of_ne_zero_of_ne_one Bool.false_ne_true.symm _ hq0 hq1] + refine Continuous.add ?_ ?_ + · exact (ENNReal.continuous_const_mul ENNReal.ofReal_ne_top).comp + (f.continuous.comp (ENNReal.continuous_ofReal.comp (continuous_subtype_val.div_const _))) + · exact (ENNReal.continuous_const_mul ENNReal.ofReal_ne_top).comp + (f.continuous.comp (ENNReal.continuous_ofReal.comp + ((continuous_const.sub continuous_subtype_val).div_const _))) + +/-- For `p ≠ q`, the binary f-divergence `p' ↦ d_f(p', q)` is continuous at `p`. For `q ∉ {0, 1}`, +it is continuous everywhere (`continuous_fDiv_bernoulliMeasure_left`), but for `q ∈ {0, 1}` and +`f.derivAtTop = ∞` it is discontinuous at `q`. -/ +lemma continuousAt_fDiv_bernoulliMeasure_left {p q : I} (hpq : p ≠ q) : + ContinuousAt (fun p' ↦ fDiv f Ber(x, y, p') Ber(x, y, q)) p := by + rcases eq_or_ne (Measure.dirac x) (Measure.dirac y) with hxy | hxy + · simp_rw [fDiv_bernoulliMeasure_of_dirac_eq hxy] + exact continuousAt_const + obtain ⟨s, hs, hx, hy⟩ := dirac_ne_dirac_iff_exists_measurableSet.mp hxy + simp_rw [fDiv_bernoulliMeasure_of_mem_of_notMem hs hx hy] + have h_ofReal : Continuous fun p : I ↦ ENNReal.ofReal p := + ENNReal.continuous_ofReal.comp continuous_subtype_val + have h_ofReal_sub : Continuous fun p : I ↦ ENNReal.ofReal (1 - p) := + ENNReal.continuous_ofReal.comp (continuous_const.sub continuous_subtype_val) + rcases eq_or_ne q 0 with rfl | hq0 + · simp_rw [fDiv_bernoulliMeasure_zero_right Bool.false_ne_true.symm] + refine (f.continuous.comp h_ofReal_sub).continuousAt.add + (ENNReal.Tendsto.const_mul (h_ofReal.tendsto p) (Or.inl ?_)) + rw [ENNReal.ofReal_ne_zero_iff] + exact lt_of_le_of_ne p.2.1 (coe_ne_zero.mpr hpq).symm + rcases eq_or_ne q 1 with rfl | hq1 + · simp_rw [fDiv_bernoulliMeasure_one_right Bool.false_ne_true.symm] + refine (f.continuous.comp h_ofReal).continuousAt.add + (ENNReal.Tendsto.const_mul (h_ofReal_sub.tendsto p) (Or.inl ?_)) + rw [ENNReal.ofReal_ne_zero_iff, sub_pos] + exact lt_of_le_of_ne p.2.2 (coe_ne_one.mpr hpq) + exact (continuous_fDiv_bernoulliMeasure_left hq0 hq1).continuousAt + +/-- Let `r₁ ≤ r₂`. If there are pairs `(a, b)` with `a ≥ r₁` arbitrarily close to `r₁`, `b ≥ r₂` +and `d_f(a, b) ≤ D`, then `d_f(r₁, r₂) ≤ D`. -/ +lemma fDiv_bernoulliMeasure_le_of_forall_exists {D : ℝ≥0∞} {r₁ r₂ : I} (h₁₂ : r₁ ≤ r₂) + (h : ∀ ε : ℝ, 0 < ε → ∃ a b : I, r₁ ≤ a ∧ (a : ℝ) ≤ r₁ + ε ∧ r₂ ≤ b + ∧ fDiv f Ber(x, y, a) Ber(x, y, b) ≤ D) : + fDiv f Ber(x, y, r₁) Ber(x, y, r₂) ≤ D := by + rcases eq_or_lt_of_le h₁₂ with h_eq | h_lt + · simp [h_eq, fDiv_self] + by_contra h_lt_D + rw [not_le] at h_lt_D + have h_ev : ∀ᶠ a in 𝓝 r₁, D < fDiv f Ber(x, y, a) Ber(x, y, r₂) := + (continuousAt_fDiv_bernoulliMeasure_left h_lt.ne).eventually (lt_mem_nhds h_lt_D) + obtain ⟨δ, hδ, hball⟩ := Metric.eventually_nhds_iff.mp h_ev + have h_lt' : (0 : ℝ) < r₂ - r₁ := sub_pos.mpr h_lt + obtain ⟨a, b, ha₁, ha₂, hb, hab⟩ := + h (min (δ / 2) ((r₂ - r₁) / 2)) (lt_min (half_pos hδ) (half_pos h_lt')) + have ha₁' : (r₁ : ℝ) ≤ a := Subtype.coe_le_coe.mpr ha₁ + have ha_lt : (a : ℝ) < r₂ := by linarith [min_le_right (δ / 2) (((r₂ : ℝ) - r₁) / 2)] + have h_dist : dist a r₁ < δ := by + rw [Subtype.dist_eq, Real.dist_eq, abs_of_nonneg (by linarith)] + linarith [min_le_left (δ / 2) (((r₂ : ℝ) - r₁) / 2)] + have h_mono : fDiv f Ber(x, y, a) Ber(x, y, r₂) ≤ fDiv f Ber(x, y, a) Ber(x, y, b) := + monotoneOn_fDiv_bernoulliMeasure_right a ha_lt.le + (ha_lt.le.trans (Subtype.coe_le_coe.mpr hb)) hb + exact absurd ((hball h_dist).trans_le (h_mono.trans hab)) (lt_irrefl _) + +end Continuity + +section DataProcessing + +variable {𝓨 : Type*} {m𝓨 : MeasurableSpace 𝓨} + +/-- **Data processing for the mean**: for probability measures `μ, ν` on the unit interval with +means `p` and `q`, the f-divergence between the Bernoulli distributions with parameters `p` and `q` +is at most `fDiv f μ ν`. -/ +theorem fDiv_bernoulliMeasure_le_of_integral_eq (μ ν : Measure I) [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] {p q : I} (hp : (p : ℝ) = ∫ t, (t : ℝ) ∂μ) + (hq : (q : ℝ) = ∫ t, (t : ℝ) ∂ν) : + fDiv f Ber(x, y, p) Ber(x, y, q) ≤ fDiv f μ ν := by + rw [← bernoulliKernel_comp_eq_bernoulliMeasure _ _ μ hp, + ← bernoulliKernel_comp_eq_bernoulliMeasure _ _ ν hq] + exact fDiv_comp_right_le μ ν _ + +/-- **Data processing for the mean of a function**: if `g : 𝓨 → I` has means `p` and `q` under the +probability measures `μ` and `ν`, then `d_f(p, q) ≤ D_f(μ, ν)`. -/ +theorem fDiv_bernoulliMeasure_le_of_integral_comp_eq (μ ν : Measure 𝓨) [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] {g : 𝓨 → I} (hg : Measurable g) {p q : I} + (hp : (p : ℝ) = ∫ z, (g z : ℝ) ∂μ) (hq : (q : ℝ) = ∫ z, (g z : ℝ) ∂ν) : + fDiv f Ber(x, y, p) Ber(x, y, q) ≤ fDiv f μ ν := by + refine (fDiv_bernoulliMeasure_le_of_integral_eq (μ.map g) (ν.map g) ?_ ?_).trans + (fDiv_map_le hg) + · rw [integral_map hg.aemeasurable (by fun_prop), hp] + · rw [integral_map hg.aemeasurable (by fun_prop), hq] + +/-- **Data processing for the mean of a function**, version for a function with values in +`ℝ≥0∞` bounded by `1`: if `g` has integrals `p` and `q` under the probability measures `μ` and `ν`, +then `d_f(p, q) ≤ D_f(μ, ν)`. -/ +theorem fDiv_bernoulliMeasure_le_of_lintegral_eq (μ ν : Measure 𝓨) [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] {g : 𝓨 → ℝ≥0∞} (hg : Measurable g) (hg1 : ∀ z, g z ≤ 1) {p q : I} + (hp : ENNReal.ofReal p = ∫⁻ z, g z ∂μ) (hq : ENNReal.ofReal q = ∫⁻ z, g z ∂ν) : + fDiv f Ber(x, y, p) Ber(x, y, q) ≤ fDiv f μ ν := by + let g' : 𝓨 → I := fun z ↦ ⟨(g z).toReal, ENNReal.toReal_mem_unitInterval (hg1 z)⟩ + have hg' : Measurable g' := hg.ennreal_toReal.subtype_mk + have h_lt (ρ : Measure 𝓨) : ∀ᵐ z ∂ρ, g z < ∞ := + ae_of_all _ fun z ↦ (hg1 z).trans_lt ENNReal.one_lt_top + refine fDiv_bernoulliMeasure_le_of_integral_comp_eq μ ν hg' ?_ ?_ + · rw [integral_toReal hg.aemeasurable (h_lt μ), ← hp, ENNReal.toReal_ofReal p.2.1] + · rw [integral_toReal hg.aemeasurable (h_lt ν), ← hq, ENNReal.toReal_ofReal q.2.1] + +/-- **Data processing for the mean through a kernel**: for a Markov kernel `κ` to the unit +interval such that `κ ∘ₘ μ` and `κ ∘ₘ ν` have means `p` and `q`, `d_f(p, q) ≤ D_f(μ, ν)`. -/ +theorem fDiv_bernoulliMeasure_le_of_integral_comp_kernel_eq (μ ν : Measure 𝓨) + [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] (κ : Kernel 𝓨 I) [IsMarkovKernel κ] + {p q : I} (hp : (p : ℝ) = ∫ t, (t : ℝ) ∂(κ ∘ₘ μ)) (hq : (q : ℝ) = ∫ t, (t : ℝ) ∂(κ ∘ₘ ν)) : + fDiv f Ber(x, y, p) Ber(x, y, q) ≤ fDiv f μ ν := + (fDiv_bernoulliMeasure_le_of_integral_eq _ _ hp hq).trans (fDiv_comp_right_le μ ν κ) + +end DataProcessing + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/CompProd.lean b/Statlib/Divergence/FDiv/CompProd.lean index 3277257..8541ffa 100644 --- a/Statlib/Divergence/FDiv/CompProd.lean +++ b/Statlib/Divergence/FDiv/CompProd.lean @@ -16,6 +16,7 @@ public import Statlib.ForMathlib.Probability.Kernel.Composition.MeasureCompProd * `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_prod_right`: `fDiv f (ξ.prod μ) (ξ.prod ν) = ξ univ * fDiv f μ ν` for a finite 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 @@ -36,6 +37,8 @@ the disintegration of the composition-product, under assumptions on the measurab open MeasureTheory +open scoped ENNReal NNReal + namespace ProbabilityTheory variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} {f : DivFunction} @@ -60,6 +63,29 @@ lemma fDiv_prod_left (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure fDiv f (μ.prod ξ) (ν.prod ξ) = fDiv f μ ν := by simpa [Measure.compProd_const] using fDiv_compProd_left (f := f) μ ν (Kernel.const α ξ) +/-- The f-divergence between two products with the same first factor `ξ` is the f-divergence +between the second factors, multiplied by the mass of `ξ`. -/ +lemma fDiv_prod_right (ξ : Measure β) [IsFiniteMeasure ξ] (μ ν : Measure α) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] : + fDiv f (ξ.prod μ) (ξ.prod ν) = ξ .univ * fDiv f μ ν := by + rcases eq_zero_or_neZero ξ with rfl | hξ + · simp + -- write `ξ = c • ξ'` for a probability measure `ξ'`, then swap the factors + set c : ℝ≥0 := (ξ .univ).toNNReal + have hc : (c : ℝ≥0∞) = ξ .univ := ENNReal.coe_toNNReal (measure_ne_top _ _) + have hc0 : c ≠ 0 := by + rw [← ENNReal.coe_ne_zero, hc] + exact NeZero.ne _ + have : IsProbabilityMeasure (c⁻¹ • ξ) := ⟨by + rw [Measure.smul_apply, ← hc, ENNReal.smul_def, smul_eq_mul, ENNReal.coe_inv hc0, + ENNReal.inv_mul_cancel (by simpa using hc0) ENNReal.coe_ne_top]⟩ + have h_prod (ρ : Measure α) [SFinite ρ] : ξ.prod ρ = c • (c⁻¹ • ξ).prod ρ := by + rw [Measure.prod_smul_left, smul_smul, mul_inv_cancel₀ hc0, one_smul] + have h_emb : MeasurableEmbedding (Prod.swap : α × β → β × α) := + MeasurableEquiv.prodComm.measurableEmbedding + rw [h_prod μ, h_prod ν, fDiv_smul_smul, ← Measure.prod_swap (μ := μ), + ← Measure.prod_swap (μ := ν), fDiv_map_measurableEmbedding h_emb, fDiv_prod_left, hc] + lemma fDiv_fst_le (μ ν : Measure (α × β)) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : fDiv f μ.fst ν.fst ≤ fDiv f μ ν := fDiv_map_le measurable_fst diff --git a/Statlib/Divergence/FDiv/CondFDiv.lean b/Statlib/Divergence/FDiv/CondFDiv.lean index b1f36fb..8d78563 100644 --- a/Statlib/Divergence/FDiv/CondFDiv.lean +++ b/Statlib/Divergence/FDiv/CondFDiv.lean @@ -18,17 +18,26 @@ public import Mathlib.MeasureTheory.MeasurableSpace.CountablyGenerated ## Main definitions -* `condFDiv f κ η μ`: the conditional f-divergence `∫⁻ x, fDiv f (κ x) (η x) ∂μ` between the +* `condFDiv f κ η μ`: the conditional f-divergence `fDiv f (μ ⊗ₘ κ) (μ ⊗ₘ η)` between the kernels `κ` and `η` with respect to the measure `μ`. ## Main statements +* `condFDiv_eq_lintegral`: `condFDiv f κ η μ = ∫⁻ x, fDiv f (κ x) (η x) ∂μ`, if `α` is countable + or `β` is countably generated and `μ` is σ-finite. * `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. +## Implementation details + +The conditional f-divergence is defined with composition-products rather than as the integral +`∫⁻ x, fDiv f (κ x) (η x) ∂μ`. The function `x ↦ fDiv f (κ x) (η x)` is known to be measurable +only under assumptions on the measurable spaces (`CountableOrCountablyGenerated α β`), while +results on composition-products like the data-processing inequality hold without them. Under +those assumptions, the two definitions agree for σ-finite `μ` (`condFDiv_eq_lintegral`). + This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli (https://github.com/RemyDegenne/testing-lower-bounds). -/ @@ -46,10 +55,16 @@ variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} section Conditional -/-- Conditional f-divergence. -/ +/-- The conditional f-divergence between the kernels `κ` and `η` with respect to the measure `μ`, +defined as `fDiv f (μ ⊗ₘ κ) (μ ⊗ₘ η)`. + +If `α` is countable or `β` is countably generated, `μ` is σ-finite and `κ`, `η` are finite, it is +equal to `∫⁻ x, fDiv f (κ x) (η x) ∂μ` (`condFDiv_eq_lintegral`) and to +`∫⁻ a, ∫⁻ b, f ((∂κ a/∂η a) b) ∂η a ∂μ + f.derivAtTop * ∫⁻ a, (κ a).singularPart (η a) univ ∂μ` +(`condFDiv_eq_add`). See also `toReal_condFDiv_eq_integral` for its real-valued version. -/ noncomputable def condFDiv (f : DivFunction) (κ η : Kernel α β) (μ : Measure α) : ℝ≥0∞ := - ∫⁻ x, fDiv f (κ x) (η x) ∂μ + fDiv f (μ ⊗ₘ κ) (μ ⊗ₘ η) /-- Equivalence between two possible versions of the first condition for the finiteness of the conditional f divergence, the second version is the preferred one. -/ @@ -58,10 +73,66 @@ lemma fDiv_ae_ne_top_iff [IsFiniteKernel κ] [IsFiniteKernel η] : ↔ (∀ᵐ a ∂μ, ∫⁻ x, f ((∂κ a/∂η a) x) ∂η a ≠ ∞) ∧ (f.derivAtTop = ∞ → ∀ᵐ a ∂μ, κ a ≪ η a) := by simp_rw [fDiv_ne_top_iff, eventually_and, eventually_all] +@[simp] +lemma condFDiv_self (κ : Kernel α β) (μ : Measure α) [SigmaFinite μ] [IsFiniteKernel κ] : + condFDiv f κ κ μ = 0 := + fDiv_self _ + +@[simp] +lemma condFDiv_zero_left [SFinite μ] [IsSFiniteKernel η] : + condFDiv f 0 η μ = f 0 * ∫⁻ a, η a .univ ∂μ := by + rw [condFDiv, Measure.compProd_zero_right, fDiv_zero_measure_left, + Measure.compProd_apply .univ] + simp + +@[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, Subsingleton.elim (μ ⊗ₘ κ) 0, Subsingleton.elim (μ ⊗ₘ η) 0] + +@[simp] +lemma condFDiv_of_isEmpty_right [IsEmpty β] : condFDiv f κ η μ = 0 := by + simp [condFDiv, Subsingleton.elim (μ ⊗ₘ κ) 0, Subsingleton.elim (μ ⊗ₘ η) 0] + +@[simp] +lemma condFDiv_const {ξ : Measure β} [IsFiniteMeasure ξ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + condFDiv f (Kernel.const β μ) (Kernel.const β ν) ξ = (fDiv f μ ν) * ξ .univ := by + rw [condFDiv, Measure.compProd_const, Measure.compProd_const, fDiv_prod_right, mul_comm] + +/-- **Data-processing inequality**: composing a measure with two kernels decreases their +conditional f-divergence. -/ +lemma fDiv_comp_left_le (μ : Measure α) [IsFiniteMeasure μ] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + fDiv f (κ ∘ₘ μ) (η ∘ₘ μ) ≤ condFDiv f κ η μ := + fDiv_comp_le_compProd μ μ κ η + section CondFDivEq variable [CountableOrCountablyGenerated α β] +/-- The conditional f-divergence as a sum of an integral of `f` and of a singular part term. -/ +lemma condFDiv_eq_add [SigmaFinite μ] [IsFiniteKernel κ] [IsFiniteKernel η] : + condFDiv f κ η μ = ∫⁻ a, ∫⁻ y, f ((∂κ a/∂η a) y) ∂η a ∂μ + + f.derivAtTop * ∫⁻ a, (κ a).singularPart (η a) .univ ∂μ := by + rw [condFDiv, fDiv, Measure.lintegral_compProd DivFunction.measurable_comp_rnDeriv, + lintegral_singularPart _ _ _ .univ, univ_prod_univ] + congr 1 + refine lintegral_congr_ae ?_ + filter_upwards [rnDeriv_measure_compProd_right' μ κ η] with a ha + refine lintegral_congr_ae ?_ + filter_upwards [ha] with b hb + rw [hb] + +/-- The conditional f-divergence is the integral of the f-divergences between the kernels. -/ +lemma condFDiv_eq_lintegral [SigmaFinite μ] [IsFiniteKernel κ] [IsFiniteKernel η] : + condFDiv f κ η μ = ∫⁻ x, fDiv f (κ x) (η x) ∂μ := by + have h_meas : Measurable fun a ↦ (κ a).singularPart (η a) .univ := + (Measure.measurable_coe .univ).comp (κ.measurable_singularPart η) + simp_rw [condFDiv_eq_add, fDiv] + rw [lintegral_add_right _ (h_meas.const_mul _), lintegral_const_mul _ h_meas] + /-- 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 η] @@ -87,16 +158,16 @@ lemma lintegral_fDiv_ne_top_iff [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFini simp @[simp] -lemma condFDiv_of_not_ae_finite [IsFiniteKernel κ] [IsFiniteKernel η] +lemma condFDiv_of_not_ae_finite [SigmaFinite μ] [IsFiniteKernel κ] [IsFiniteKernel η] (h : ¬ ∀ᵐ a ∂μ, fDiv f (κ a) (η a) ≠ ∞) : condFDiv f κ η μ = ∞ := by - rw [condFDiv] + rw [condFDiv_eq_lintegral] 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) : +lemma condFDiv_of_not_ae_ac [SigmaFinite μ] [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] @@ -108,6 +179,7 @@ lemma condFDiv_of_lintegral_eq_top [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsF condFDiv f κ η μ = ∞ := by by_cases h_top : ∀ᵐ a ∂μ, fDiv f (κ a) (η a) ≠ ∞ swap; · exact condFDiv_of_not_ae_finite h_top + rw [condFDiv_eq_lintegral] by_contra h_ne exact (lintegral_fDiv_ne_top_iff (fDiv_ae_ne_top_iff.mp h_top).2).mp h_ne hf @@ -116,9 +188,11 @@ lemma condFDiv_ne_top_iff [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKern ∫⁻ 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 + fun ⟨h1, h2⟩ ↦ ?_⟩ + · by_contra h_not + exact h <| condFDiv_of_not_ae_ac h_eq_top h_not + · rw [condFDiv_eq_lintegral] + exact (lintegral_fDiv_ne_top_iff h2).mpr h1 lemma condFDiv_eq_top_iff [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] : condFDiv f κ η μ = ∞ ↔ @@ -127,22 +201,15 @@ lemma condFDiv_eq_top_iff [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKern have h := condFDiv_ne_top_iff (κ := κ) (η := η) (μ := μ) (f := f) tauto -lemma toReal_condFDiv_eq_integral [IsFiniteKernel κ] [IsFiniteKernel η] +lemma toReal_condFDiv_eq_integral [SigmaFinite μ] [IsFiniteKernel κ] [IsFiniteKernel η] (h : condFDiv f κ η μ ≠ ∞) : (condFDiv f κ η μ).toReal = ∫ x, (fDiv f (κ x) (η x)).toReal ∂μ := by - rw [condFDiv, integral_toReal (measurable_fDiv _ _).aemeasurable] + rw [condFDiv_eq_lintegral] at h ⊢ + rw [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) : +lemma condFDiv_of_ae_ac [SigmaFinite μ] [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] @@ -154,81 +221,22 @@ lemma condFDiv_of_ae_ac [IsFiniteKernel κ] [IsFiniteKernel η] (h_ac : ∀ᵐ a 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 ξ] +lemma condFDiv_measure_compProd [CountableOrCountablyGenerated (α × β) γ] [SigmaFinite μ] + {ξ : Kernel α β} [IsFiniteKernel ξ] {κ η : Kernel (α × β) γ} [IsFiniteKernel κ] [IsFiniteKernel η] : condFDiv f κ η (μ ⊗ₘ ξ) = ∫⁻ x, condFDiv f (κ.sectR x) (η.sectR x) (ξ x) ∂μ := by - rw [condFDiv, Measure.lintegral_compProd (measurable_fDiv _ _)] + rcases isEmpty_or_nonempty α with hα | hα + · simp + have := countableOrCountablyGenerated_right_of_prod_left_of_nonempty (α := α) (β := β) (γ := γ) + rw [condFDiv_eq_lintegral, Measure.lintegral_compProd (measurable_fDiv _ _)] + refine lintegral_congr fun x ↦ ?_ + rw [condFDiv_eq_lintegral] rfl end CompProdMeasure diff --git a/Statlib/Divergence/FDiv/DivFunction/Basic.lean b/Statlib/Divergence/FDiv/DivFunction/Basic.lean index b745f8e..e954f96 100644 --- a/Statlib/Divergence/FDiv/DivFunction/Basic.lean +++ b/Statlib/Divergence/FDiv/DivFunction/Basic.lean @@ -36,6 +36,9 @@ These are the functions used to define f-divergences. 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.le_of_forall_ne_zero_ne_top`, `DivFunction.eq_of_forall_ne_zero_ne_top`: by + continuity, inequalities and equalities between divergence functions extend from `(0, ∞)` to + `[0, ∞]`. * `DivFunction.map_lintegral_le`, `DivFunction.map_laverage_le`: **Jensen's inequality** for a divergence function. @@ -583,6 +586,22 @@ instance : Module ℝ≥0 DivFunction where end Module +section ExtensionByContinuity + +/-- If two divergence functions satisfy `f x ≤ g x` on `(0, ∞)`, then `f ≤ g` everywhere, by +continuity. Applied to `c • g`, it extends `f x ≤ c * g x` from `(0, ∞)` to `[0, ∞]`. -/ +lemma le_of_forall_ne_zero_ne_top (h : ∀ x, x ≠ 0 → x ≠ ∞ → f x ≤ g x) (x : ℝ≥0∞) : + f x ≤ g x := + le_on_closure (s := Ioo 0 ∞) (fun y hy ↦ h y hy.1.ne' hy.2.ne) f.continuous.continuousOn + g.continuous.continuousOn (by simp [closure_Ioo ENNReal.zero_ne_top]) + +/-- Two divergence functions which agree on `(0, ∞)` are equal. -/ +lemma eq_of_forall_ne_zero_ne_top (h : ∀ x, x ≠ 0 → x ≠ ∞ → f x = g x) : f = g := + ext fun x ↦ le_antisymm (le_of_forall_ne_zero_ne_top (fun y hy0 hy ↦ (h y hy0 hy).le) x) + (le_of_forall_ne_zero_ne_top (fun y hy0 hy ↦ (h y hy0 hy).ge) x) + +end ExtensionByContinuity + end DivFunction variable {f : DivFunction} diff --git a/Statlib/Divergence/FDiv/DivFunction/CurvatureMeasure.lean b/Statlib/Divergence/FDiv/DivFunction/CurvatureMeasure.lean index b1a03fc..b3a2bd1 100644 --- a/Statlib/Divergence/FDiv/DivFunction/CurvatureMeasure.lean +++ b/Statlib/Divergence/FDiv/DivFunction/CurvatureMeasure.lean @@ -456,6 +456,13 @@ lemma curvatureMeasureReal_apply (f : DivFunction) {s : Set ℝ} (hs : Measurabl f.curvatureMeasureReal s = f.curvatureMeasure (ENNReal.toReal ⁻¹' s) := by rw [curvatureMeasureReal, Measure.map_apply (by fun_prop) hs] +/-- The measure `f.curvatureMeasureReal` is concentrated on `[0, ∞)`. -/ +lemma ae_nonneg_curvatureMeasureReal (f : DivFunction) : + ∀ᵐ y ∂f.curvatureMeasureReal, 0 ≤ y := by + rw [curvatureMeasureReal] + exact (ae_map_iff (p := fun y : ℝ ↦ 0 ≤ y) (by fun_prop) measurableSet_Ici).mpr + (ae_of_all _ fun x ↦ ENNReal.toReal_nonneg) + instance : SFinite f.curvatureMeasure := by rw [curvatureMeasure] infer_instance diff --git a/Statlib/Divergence/FDiv/DivFunction/DerivAtTop.lean b/Statlib/Divergence/FDiv/DivFunction/DerivAtTop.lean index dadc56a..7547ba2 100644 --- a/Statlib/Divergence/FDiv/DivFunction/DerivAtTop.lean +++ b/Statlib/Divergence/FDiv/DivFunction/DerivAtTop.lean @@ -14,6 +14,9 @@ public import Statlib.Divergence.FDiv.DivFunction.Basic * `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. +* `DivFunction.mixtureFun`: the function `p ↦ (1 - p) * f (p / (1 - p))` on `[0, 1)`, extended by + `f.derivAtTop` on `[1, ∞]`. If `p = ∂μ/∂(μ + ν)`, then + `fDiv f μ ν = ∫⁻ x, f.mixtureFun (p x) ∂(μ + ν)` (`fDiv_eq_lintegral_mixtureFun`). ## Main statements @@ -22,6 +25,7 @@ public import Statlib.Divergence.FDiv.DivFunction.Basic * `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. +* `DivFunction.continuous_mixtureFun`: `f.mixtureFun` is continuous. ## Implementation details @@ -220,4 +224,68 @@ lemma lintegral_comp_rnDeriv_ne_top (μ ν : Measure α) [IsFiniteMeasure μ] ENNReal.mul_ne_top hf_deriv (ne_top_of_le_ne_top (measure_ne_top μ _) Measure.lintegral_rnDeriv_le)⟩ +section MixtureFun + +/-- The function `p ↦ (1 - p) * f (p / (1 - p))` on `[0, 1)`, extended by `f.derivAtTop` on +`[1, ∞]`. If `p = ∂μ/∂(μ + ν)`, then `1 - p = ∂ν/∂(μ + ν)` and +`fDiv f μ ν = ∫⁻ x, f.mixtureFun (p x) ∂(μ + ν)` (see `fDiv_eq_lintegral_mixtureFun`). It is +continuous (`continuous_mixtureFun`). -/ +noncomputable def mixtureFun (f : DivFunction) (p : ℝ≥0∞) : ℝ≥0∞ := + if p < 1 then (1 - p) * f (p / (1 - p)) else f.derivAtTop + +lemma mixtureFun_of_lt_one {p : ℝ≥0∞} (hp : p < 1) : + f.mixtureFun p = (1 - p) * f (p / (1 - p)) := ite_eq_left hp + +lemma mixtureFun_of_one_le {p : ℝ≥0∞} (hp : 1 ≤ p) : f.mixtureFun p = f.derivAtTop := + ite_eq_right hp.not_gt + +/-- `f.mixtureFun` is continuous. At `1`, this is the convergence of `f y / y` to `f.derivAtTop` +as `y → ∞`. -/ +lemma continuous_mixtureFun (f : DivFunction) : Continuous f.mixtureFun := by + have h_sub : Continuous fun q : ℝ≥0∞ ↦ 1 - q := ENNReal.continuous_sub_left ENNReal.one_ne_top + refine continuous_iff_continuousAt.2 fun p ↦ ?_ + rcases lt_trichotomy p 1 with hp | rfl | hp + · -- on `[0, 1)`, `f.mixtureFun` is given by a continuous formula + have h_eq : (fun q ↦ (1 - q) * f (q / (1 - q))) =ᶠ[𝓝 p] f.mixtureFun := + eventuallyEq_of_mem (Iio_mem_nhds hp) fun q hq ↦ (mixtureFun_of_lt_one hq).symm + refine ContinuousAt.congr ?_ h_eq + have h1 : (1 : ℝ≥0∞) - p ≠ 0 := (tsub_pos_of_lt hp).ne' + refine ENNReal.Tendsto.mul (h_sub.tendsto p) (Or.inl h1) ?_ (Or.inr (by simp)) + exact (f.continuous.tendsto _).comp + (ENNReal.Tendsto.div tendsto_id (Or.inr h1) (h_sub.tendsto p) (Or.inl (by simp))) + swap + · -- on `(1, ∞]`, `f.mixtureFun` is constant + exact continuousAt_const.congr + (eventuallyEq_of_mem (Ioi_mem_nhds hp) fun q hq ↦ (mixtureFun_of_one_le hq.le).symm) + -- at `1`, `f.mixtureFun` is constant on the right, and we compute the limit on the left + rw [ContinuousAt, mixtureFun_of_one_le le_rfl, ← nhdsLT_sup_nhdsGE (1 : ℝ≥0∞), tendsto_sup] + refine ⟨?_, tendsto_const_nhds.congr' + (eventuallyEq_of_mem self_mem_nhdsWithin fun q hq ↦ (mixtureFun_of_one_le hq).symm)⟩ + have h_div : Tendsto (fun q : ℝ≥0∞ ↦ q / (1 - q)) (𝓝[<] 1) (𝓝[<] ∞) := by + refine tendsto_nhdsWithin_iff.2 ⟨?_, ?_⟩ + · have h0 : Tendsto (fun q : ℝ≥0∞ ↦ 1 - q) (𝓝[<] 1) (𝓝 0) := by + simpa using (h_sub.tendsto 1).mono_left nhdsWithin_le_nhds + simpa [ENNReal.div_zero] using ENNReal.Tendsto.div + (tendsto_nhdsWithin_of_tendsto_nhds tendsto_id) (Or.inl one_ne_zero) h0 + (Or.inr ENNReal.one_ne_top) + · filter_upwards [self_mem_nhdsWithin] with q hq + exact ENNReal.div_lt_top (hq.trans ENNReal.one_lt_top).ne (tsub_pos_of_lt hq).ne' + have h_lim : Tendsto (fun q : ℝ≥0∞ ↦ q * (f (q / (1 - q)) / (q / (1 - q)))) (𝓝[<] 1) + (𝓝 (1 * f.derivAtTop)) := + ENNReal.Tendsto.mul (tendsto_nhdsWithin_of_tendsto_nhds tendsto_id) (Or.inl one_ne_zero) + (f.tendsto_div_nhdsLT_top.comp h_div) (Or.inr ENNReal.one_ne_top) + rw [one_mul] at h_lim + refine h_lim.congr' ?_ + filter_upwards [Ioo_mem_nhdsLT (zero_lt_one' ℝ≥0∞)] with q hq + have h1q : (1 : ℝ≥0∞) - q ≠ 0 := (tsub_pos_of_lt hq.2).ne' + have h1q_top : (1 : ℝ≥0∞) - q ≠ ∞ := ENNReal.sub_ne_top ENNReal.one_ne_top + rw [mixtureFun_of_lt_one hq.2, div_eq_mul_inv (f _), + ENNReal.inv_div (Or.inl h1q_top) (Or.inl h1q), mul_left_comm, + ENNReal.mul_div_cancel hq.1.ne' (hq.2.trans ENNReal.one_lt_top).ne, mul_comm] + +lemma measurable_mixtureFun (f : DivFunction) : Measurable f.mixtureFun := + f.continuous_mixtureFun.measurable + +end MixtureFun + end ProbabilityTheory.DivFunction diff --git a/Statlib/Divergence/FDiv/Estimation.lean b/Statlib/Divergence/FDiv/Estimation.lean new file mode 100644 index 0000000..9b01a8f --- /dev/null +++ b/Statlib/Divergence/FDiv/Estimation.lean @@ -0,0 +1,104 @@ +/- +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.Binary +public import Statlib.ForMathlib.Probability.Decision.Risk.Basic + +/-! +# Lower bounds on the Bayes risk from f-divergences + +Consider an estimation problem with parameter space `Θ`, data generating kernels `P Q : Θ ⇝ 𝓧`, +priors `π ξ` on `Θ` and a loss `ℓ : Θ → 𝓨 → ℝ≥0∞` with values in `[0, 1]`. We prove that the +f-divergence between the joint laws `π ⊗ₘ Q` and `ξ ⊗ₘ P` is at least the binary f-divergence +`d_f(R_π^Q, R_ξ^P)` between the Bernoulli distributions whose parameters are the two Bayes risks. + +## Main statements + +* `fDiv_bernoulliMeasure_avgRisk_le`: for any estimator `κ`, the binary f-divergence between the + average risks of `κ` in the two problems is at most `fDiv f (π ⊗ₘ Q) (ξ ⊗ₘ P)`. +* `fDiv_bernoulliMeasure_bayesRisk_le`: the binary f-divergence between the Bayes risks is at most + `fDiv f (π ⊗ₘ Q) (ξ ⊗ₘ P)`. + +## Implementation notes + +The parameters of the Bernoulli distributions are elements `p q : I` of the unit interval, related +to the risks by hypotheses of the form `ENNReal.ofReal p = bayesRisk ℓ Q π`. + +The proof of the reference uses a Bayes estimator, which need not exist. We use instead estimators +whose risk is arbitrarily close to the Bayes risk, and the continuity of the binary f-divergence in +its first argument (`fDiv_bernoulliMeasure_le_of_forall_exists`). The case in which the first Bayes +risk is larger than the second one is reduced to the other case by swapping the measures with the +conjugate divergence function `f.conj`. +-/ + +@[expose] public section + +open MeasureTheory Function unitInterval + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +variable {Θ 𝓧 𝓨 : Type*} {mΘ : MeasurableSpace Θ} {m𝓧 : MeasurableSpace 𝓧} + {m𝓨 : MeasurableSpace 𝓨} {ℓ : Θ → 𝓨 → ℝ≥0∞} {f : DivFunction} + +variable {π ξ : Measure Θ} [IsProbabilityMeasure π] [IsProbabilityMeasure ξ] + {P Q : Kernel Θ 𝓧} [IsMarkovKernel P] [IsMarkovKernel Q] + +/-- **Data processing for the risk of an estimator**: for any estimator `κ` (a Markov kernel, or +zero), the binary f-divergence between the average risks of `κ` for `(Q, π)` and for `(P, ξ)` is at +most `fDiv f (π ⊗ₘ Q) (ξ ⊗ₘ P)`. -/ +theorem fDiv_bernoulliMeasure_avgRisk_le (hℓ : Measurable (uncurry ℓ)) (hℓ1 : ∀ θ y, ℓ θ y ≤ 1) + (κ : Kernel 𝓧 𝓨) [IsZeroOrMarkovKernel κ] {p q : I} (hp : ENNReal.ofReal p = avgRisk ℓ Q κ π) + (hq : ENNReal.ofReal q = avgRisk ℓ P κ ξ) : + fDiv f Ber(true, false, p) Ber(true, false, q) ≤ fDiv f (π ⊗ₘ Q) (ξ ⊗ₘ P) := by + refine fDiv_bernoulliMeasure_le_of_lintegral_eq _ _ (measurable_lintegral_loss hℓ κ) + (fun z ↦ ?_) ?_ ?_ + · calc ∫⁻ y, ℓ z.1 y ∂κ z.2 ≤ ∫⁻ _, 1 ∂κ z.2 := lintegral_mono (hℓ1 z.1) + _ ≤ 1 := by simpa using prob_le_one + · rw [hp, avgRisk_eq_lintegral_compProd hℓ] + · rw [hq, avgRisk_eq_lintegral_compProd hℓ] + +/-- Auxiliary lemma for `fDiv_bernoulliMeasure_bayesRisk_le`: the case `p ≤ q`. -/ +private lemma fDiv_bernoulliMeasure_bayesRisk_le_of_le (hℓ : Measurable (uncurry ℓ)) + (hℓ1 : ∀ θ y, ℓ θ y ≤ 1) {p q : I} (hp : ENNReal.ofReal p = bayesRisk ℓ Q π) + (hq : ENNReal.ofReal q = bayesRisk ℓ P ξ) (hpq : p ≤ q) : + fDiv f Ber(true, false, p) Ber(true, false, q) ≤ fDiv f (π ⊗ₘ Q) (ξ ⊗ₘ P) := by + refine fDiv_bernoulliMeasure_le_of_forall_exists hpq fun ε hε ↦ ?_ + -- an estimator with risk at most `p + ε` for the first problem + have h_lt : bayesRisk ℓ Q π < ENNReal.ofReal (p + ε) := by + rw [← hp] + exact (ENNReal.ofReal_lt_ofReal_iff (by linarith [p.2.1])).mpr (by linarith) + obtain ⟨κ, hκ, hκ_lt⟩ : ∃ κ : Kernel 𝓧 𝓨, ∃ _ : IsMarkovKernel κ, + avgRisk ℓ Q κ π < ENNReal.ofReal (p + ε) := by + simpa [bayesRisk, iInf_lt_iff] using h_lt + -- the average risks of `κ` in the two problems, as elements of `I` + have h_mem {r : ℝ≥0∞} (hr : r ≤ 1) : ∃ a : I, ENNReal.ofReal a = r := + ⟨⟨_, ENNReal.toReal_mem_unitInterval hr⟩, + ENNReal.ofReal_toReal (ne_top_of_le_ne_top ENNReal.one_ne_top hr)⟩ + obtain ⟨a, ha⟩ := h_mem (avgRisk_le_one hℓ1 Q κ π) + obtain ⟨b, hb⟩ := h_mem (avgRisk_le_one hℓ1 P κ ξ) + refine ⟨a, b, ?_, ?_, ?_, fDiv_bernoulliMeasure_avgRisk_le hℓ hℓ1 κ ha hb⟩ + · rw [← Subtype.coe_le_coe, ← ENNReal.ofReal_le_ofReal_iff a.2.1, ha, hp] + exact bayesRisk_le_avgRisk ℓ Q κ π + · exact (ENNReal.ofReal_le_ofReal_iff (by linarith [p.2.1])).1 (ha.trans_lt hκ_lt).le + · rw [← Subtype.coe_le_coe, ← ENNReal.ofReal_le_ofReal_iff b.2.1, hb, hq] + exact bayesRisk_le_avgRisk ℓ P κ ξ + +/-- **Lower bound on the f-divergence from the Bayes risks**: for a loss with values in `[0, 1]`, +the binary f-divergence between the Bayes risks `R_π^Q` and `R_ξ^P` is at most +`fDiv f (π ⊗ₘ Q) (ξ ⊗ₘ P)`. -/ +theorem fDiv_bernoulliMeasure_bayesRisk_le (hℓ : Measurable (uncurry ℓ)) + (hℓ1 : ∀ θ y, ℓ θ y ≤ 1) {p q : I} (hp : ENNReal.ofReal p = bayesRisk ℓ Q π) + (hq : ENNReal.ofReal q = bayesRisk ℓ P ξ) : + fDiv f Ber(true, false, p) Ber(true, false, q) ≤ fDiv f (π ⊗ₘ Q) (ξ ⊗ₘ P) := by + rcases le_total p q with hpq | hqp + · exact fDiv_bernoulliMeasure_bayesRisk_le_of_le hℓ hℓ1 hp hq hpq + · rw [← fDiv_conj, ← fDiv_conj (ξ ⊗ₘ P) (π ⊗ₘ Q)] + exact fDiv_bernoulliMeasure_bayesRisk_le_of_le hℓ hℓ1 hq hp hqp + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/IntegralRepresentation.lean b/Statlib/Divergence/FDiv/IntegralRepresentation.lean index 1dc4063..da5e59b 100644 --- a/Statlib/Divergence/FDiv/IntegralRepresentation.lean +++ b/Statlib/Divergence/FDiv/IntegralRepresentation.lean @@ -12,16 +12,31 @@ 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`. +against the curvature measure of `f`. For finite measures with the same mass, those f-divergences +are statistical informations (`statInfo_eq_fDiv`), hence every f-divergence is an integral of +statistical informations (Liese and Vajda). ## Main statements +* `DivFunction.realFun_eq_integral_statInfoFun`: Taylor formula for a divergence function in terms + of the hockey-stick functions, `f t = f'(1) (t - 1) + ∫ y, statInfoFun 1 y t ∂γ_f`. * `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`. +* `fDiv_eq_lintegral_statInfo`: for finite measures with `μ univ = ν univ`, + `D_f(μ, ν) = ∫ y, I_{(1, y)}(μ, ν) ∂γ_f`, where `I_π` is the statistical information with + prior `π` (for probability measures and `1 ≤ y`, `I_{(1, y)}(μ, ν)` is the hockey-stick + divergence `E_y(μ, ν) = sup_E (μ(E) - y ν(E))`). +* `fDiv_eq_lintegral_statInfo_prior`: the representation of Liese and Vajda, + `D_f(μ, ν) = ∫ p, I_{(p, 1 - p)}(μ, ν) ∂Γ_f`, where `I_{(p, 1 - p)}` is the DeGroot statistical + information and `Γ_f` is the image of the measure `(1 + y) γ_f(dy)` by `y ↦ (1 + y)⁻¹`. + +## References + +* F. Liese, I. Vajda, *On divergences and informations in statistics and information theory*, + IEEE Transactions on Information Theory 52(10) (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). @@ -144,6 +159,39 @@ lemma lintegral_statInfoFun_curvatureMeasureReal_add {t : ℝ≥0∞} (ht_ne : t rw [h_int, ← f.taylor_one_left ht, add_assoc, ← mul_add, tsub_add_cancel_of_le ht, mul_one] +/-- **Taylor formula** for a divergence function, in terms of the hockey-stick functions: for +`0 ≤ t` in the effective domain of `f`, +`f t = f'(1) (t - 1) + ∫ y, statInfoFun 1 y t ∂γ_f`, where `γ_f` is the curvature measure of `f`. +See `lintegral_statInfoFun_curvatureMeasureReal_add` for a version in `ℝ≥0∞`. -/ +theorem DivFunction.realFun_eq_integral_statInfoFun (f : DivFunction) {t : ℝ} (ht : 0 ≤ t) + (ht_top : f (ENNReal.ofReal t) ≠ ∞) : + f.realFun t + = f.rightDeriv 1 * (t - 1) + ∫ y, statInfoFun 1 y t ∂f.curvatureMeasureReal := by + have h := lintegral_statInfoFun_curvatureMeasureReal_add (f := f) + (ENNReal.ofReal_ne_top (r := t)) + rw [ENNReal.toReal_ofReal ht] at h + have h_meas : Measurable fun y ↦ ENNReal.ofReal (statInfoFun 1 y t) := + (measurable_statInfoFun.comp + ((measurable_const.prodMk measurable_id).prodMk measurable_const)).ennreal_ofReal + have h_lint_ne_top : + ∫⁻ y, ENNReal.ofReal (statInfoFun 1 y t) ∂f.curvatureMeasureReal ≠ ∞ := by + intro h_top + rw [h_top, top_add] at h + exact ENNReal.add_ne_top.mpr ⟨ht_top, ENNReal.ofReal_ne_top⟩ h.symm + have h_int : Integrable (fun y ↦ statInfoFun 1 y t) f.curvatureMeasureReal := by + have := integrable_toReal_of_lintegral_ne_top h_meas.aemeasurable h_lint_ne_top + simpa only [ENNReal.toReal_ofReal (statInfoFun_nonneg _ _ _)] using this + rw [← ofReal_integral_eq_lintegral_ofReal h_int + (ae_of_all _ fun y ↦ statInfoFun_nonneg _ _ _)] at h + have h' := congrArg ENNReal.toReal h + rw [ENNReal.toReal_add ENNReal.ofReal_ne_top + (ENNReal.mul_ne_top ENNReal.ofReal_ne_top ENNReal.ofReal_ne_top), + ENNReal.toReal_add ht_top ENNReal.ofReal_ne_top, ENNReal.toReal_mul, + ENNReal.toReal_ofReal (integral_nonneg fun y ↦ statInfoFun_nonneg _ _ _), + ENNReal.toReal_ofReal f.rightDeriv_one_nonneg, ENNReal.toReal_ofReal ht] at h' + simp only [DivFunction.realFun] + linarith + 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 @@ -221,4 +269,57 @@ lemma fDiv_eq_lintegral_fDiv_statInfoDivFun [IsFiniteMeasure μ] [IsFiniteMeasur end StatInfoFun +section StatInfo + +/-- **Integral representation of f-divergences** in terms of statistical informations: for finite +measures with the same mass, `D_f(μ, ν) = ∫ y, I_{(1, y)}(μ, ν) ∂γ_f`, where `I_π` is the +statistical information with prior `π` and `γ_f` is the curvature measure of `f`. -/ +theorem fDiv_eq_lintegral_statInfo [IsFiniteMeasure μ] (h_univ : μ univ = ν univ) : + fDiv f μ ν + = ∫⁻ y, statInfo μ ν (Measure.boolMeasure 1 (ENNReal.ofReal y)) ∂f.curvatureMeasureReal := by + have : IsFiniteMeasure ν := ⟨h_univ ▸ measure_lt_top μ univ⟩ + have h := fDiv_add_eq_lintegral_fDiv_statInfoDivFun_add (f := f) (μ := μ) (ν := ν) + rw [h_univ, ENNReal.add_left_inj (ENNReal.mul_ne_top ENNReal.ofReal_ne_top + (measure_ne_top _ _))] at h + rw [h] + refine lintegral_congr_ae ?_ + filter_upwards [f.ae_nonneg_curvatureMeasureReal] with y hy + have : IsFiniteMeasure (Measure.boolMeasure 1 (ENNReal.ofReal y)) := + Measure.isFiniteMeasure_boolMeasure ENNReal.one_ne_top ENNReal.ofReal_ne_top + rw [statInfo_eq_fDiv μ ν h_univ, Measure.boolMeasure_apply_false, + Measure.boolMeasure_apply_true, ENNReal.toReal_one, ENNReal.toReal_ofReal hy] + +/-- **Integral representation of f-divergences** of Liese and Vajda: for finite measures with the +same mass, `D_f(μ, ν) = ∫ p, I_{(p, 1 - p)}(μ, ν) ∂Γ_f`, where `I_{(p, 1 - p)}` is the DeGroot +statistical information (the statistical information with prior `(p, 1 - p)`) and `Γ_f` is the +image of the measure `(1 + y) γ_f(dy)` by `y ↦ (1 + y)⁻¹`, for `γ_f` the curvature measure of +`f`. -/ +theorem fDiv_eq_lintegral_statInfo_prior [IsFiniteMeasure μ] (h_univ : μ univ = ν univ) : + fDiv f μ ν + = ∫⁻ p, statInfo μ ν (Measure.boolMeasure (ENNReal.ofReal p) (ENNReal.ofReal (1 - p))) + ∂((f.curvatureMeasureReal.withDensity fun y ↦ ENNReal.ofReal (1 + y)).map + fun y ↦ (1 + y)⁻¹) := by + have : IsFiniteMeasure ν := ⟨h_univ ▸ measure_lt_top μ univ⟩ + have h_meas : Measurable fun p : ℝ ↦ + statInfo μ ν (Measure.boolMeasure (ENNReal.ofReal p) (ENNReal.ofReal (1 - p))) := + (measurable_statInfo_boolMeasure_ofReal μ ν).comp (f := fun p : ℝ ↦ (p, 1 - p)) (by fun_prop) + have h_meas' : Measurable fun y : ℝ ↦ statInfo μ ν + (Measure.boolMeasure (ENNReal.ofReal (1 + y)⁻¹) (ENNReal.ofReal (1 - (1 + y)⁻¹))) := + h_meas.comp (by fun_prop) + rw [lintegral_map h_meas (by fun_prop), + lintegral_withDensity_eq_lintegral_mul _ (by fun_prop) h_meas', + fDiv_eq_lintegral_statInfo h_univ] + refine lintegral_congr_ae ?_ + filter_upwards [f.ae_nonneg_curvatureMeasureReal] with y hy + have hy1 : 0 < 1 + y := by linarith + simp only [Pi.mul_apply] + rw [← statInfo_smul_prior μ ν _ ENNReal.ofReal_ne_top, Measure.smul_boolMeasure, + ← ENNReal.ofReal_mul hy1.le, ← ENNReal.ofReal_mul hy1.le, mul_inv_cancel₀ hy1.ne', + ENNReal.ofReal_one] + congr 3 + field_simp + ring + +end StatInfo + end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/SupRatio.lean b/Statlib/Divergence/FDiv/SupRatio.lean new file mode 100644 index 0000000..5390356 --- /dev/null +++ b/Statlib/Divergence/FDiv/SupRatio.lean @@ -0,0 +1,190 @@ +/- +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.Binary + +/-! +# Best constant in an inequality between two f-divergences + +Let `f, g` be two divergence functions. For all measures `μ, ν`, the ratio +`D_f(μ, ν) / D_g(μ, ν)` is at most the supremum of `f t / g t` over `t ∈ (0, 1) ∪ (1, ∞)`. If `g` +is differentiable at `1` (where its derivative is then `0`, since `1` is a minimum) and the +measurable space is not trivial, then this is the best constant: the supremum of +`D_f(μ, ν) / D_g(μ, ν)` over probability measures `μ, ν` is the supremum of `f t / g t` over +`t ∈ (0, 1) ∪ (1, ∞)` (Sason and Verdú). + +For the lower bound, we use the Bernoulli distributions `μ = Ber(x, y, t ε)` and +`ν = Ber(x, y, ε)`, for which `D_f(μ, ν) = ε f(t) + (1 - ε) f((1 - t ε) / (1 - ε))`, and let +`ε → 0`: `D_g(μ, ν) / ε` tends to `g t`, while `D_f(μ, ν) / ε ≥ f t`. + +## Main statements + +* `fDiv_div_fDiv_le_iSup_div`: `D_f(μ, ν) / D_g(μ, ν) ≤ ⨆ t ∉ {0, 1, ∞}, f t / g t`. +* `iSup_fDiv_div_fDiv_eq_iSup_div`: the theorem of Sason and Verdú. + +## Implementation notes + +Sason and Verdú assume that both `f` and `g` are differentiable at `1` and that `g > 0` on +`(0, 1) ∪ (1, ∞)`. Differentiability of `f` is not needed: since `f ≥ 0`, `D_f(μ, ν) / ε ≥ f t`. +The positivity of `g` is not needed with the conventions `a / 0 = ∞` for `a ≠ 0` and `0 / 0 = 0` +of `ℝ≥0∞`. Differentiability of `g` cannot be dropped: for `f t = (t - 1)⁺` and `g t = |t - 1|`, +the supremum of `f t / g t` is `1` but `D_f(μ, ν) / D_g(μ, ν) = 1 / 2` for all probability +measures `μ ≠ ν`. + +## References + +* I. Sason, S. Verdú, *f-divergence inequalities*, IEEE Transactions on Information Theory + 62(11) (2016), Theorem 1. +-/ + +@[expose] public section + +open MeasureTheory Set Filter Topology unitInterval + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +variable {𝓧 : Type*} {m𝓧 : MeasurableSpace 𝓧} {f g : DivFunction} + +/-- If `F` vanishes with its derivative at `1`, then `(1 - ε) / ε * F ((1 - r ε) / (1 - ε))` tends +to `0` as `ε → 0+`. -/ +private lemma tendsto_div_mul_apply_div_nhdsGT_zero {F : ℝ → ℝ} (hF : HasDerivAt F 0 1) + (hF1 : F 1 = 0) {r : ℝ} (hr : r ≠ 1) : + Tendsto (fun ε ↦ (1 - ε) / ε * F ((1 - r * ε) / (1 - ε))) (𝓝[>] 0) (𝓝 0) := by + have h_mem : ∀ᶠ ε in 𝓝[>] (0 : ℝ), ε ∈ Ioo (0 : ℝ) 1 := Ioo_mem_nhdsGT zero_lt_one + have h1r : 1 - r ≠ 0 := sub_ne_zero.mpr hr.symm + have hs_sub (ε : ℝ) (hε : ε ∈ Ioo (0 : ℝ) 1) : + (1 - r * ε) / (1 - ε) - 1 = ε * (1 - r) / (1 - ε) := by + have : 1 - ε ≠ 0 := by linarith [hε.2] + field_simp + ring + -- `(1 - r ε) / (1 - ε)` tends to `1` and is not equal to `1` + have h_s : Tendsto (fun ε ↦ (1 - r * ε) / (1 - ε)) (𝓝[>] 0) (𝓝[≠] 1) := by + refine tendsto_nhdsWithin_iff.mpr ⟨?_, ?_⟩ + · have h_cont : ContinuousAt (fun ε : ℝ ↦ (1 - r * ε) / (1 - ε)) 0 := + (continuousAt_const.sub (continuousAt_const.mul continuousAt_id)).div + (continuousAt_const.sub continuousAt_id) (by norm_num) + simpa using h_cont.tendsto.mono_left nhdsWithin_le_nhds + · filter_upwards [h_mem] with ε hε + rw [mem_compl_singleton_iff, ← sub_ne_zero, hs_sub ε hε] + have : 1 - ε ≠ 0 := by linarith [hε.2] + exact div_ne_zero (mul_ne_zero hε.1.ne' h1r) this + -- the slope of `F` at `1` tends to `0` + have h_slope : Tendsto (fun y ↦ F y / (y - 1)) (𝓝[≠] 1) (𝓝 0) := + (hasDerivAt_iff_tendsto_slope.mp hF).congr fun y ↦ by rw [slope_def_field, hF1, sub_zero] + have h := (h_slope.comp h_s).const_mul (1 - r) + rw [mul_zero] at h + refine h.congr' ?_ + filter_upwards [h_mem] with ε hε + have h1ε : 1 - ε ≠ 0 := by linarith [hε.2] + simp only [Function.comp_apply] + rw [hs_sub ε hε] + field_simp + +/-- For all measures `μ, ν`, the ratio `D_f(μ, ν) / D_g(μ, ν)` is at most the supremum of +`f t / g t` over `t ∈ (0, 1) ∪ (1, ∞)`. -/ +lemma fDiv_div_fDiv_le_iSup_div (μ ν : Measure 𝓧) : + fDiv f μ ν / fDiv g μ ν ≤ ⨆ (t : ℝ≥0∞) (_ : t ≠ 0) (_ : t ≠ ∞) (_ : t ≠ 1), f t / g t := by + refine le_of_forall_gt_imp_ge_of_dense fun c hc ↦ ?_ + rcases eq_or_ne c ∞ with rfl | hc_top + · exact le_top + have hc0 : c ≠ 0 := (zero_le.trans_lt hc).ne' + -- `f ≤ c * g`, since `c` is larger than all the ratios `f t / g t` + refine ENNReal.div_le_of_le_mul ?_ + rw [← ENNReal.coe_toNNReal hc_top] + refine fDiv_le_mul_fDiv_of_le (fun x hx0 hx_top ↦ ?_) μ ν + rcases eq_or_ne x 1 with rfl | hx1 + · simp + rw [ENNReal.coe_toNNReal hc_top, ← ENNReal.div_le_iff_le_mul (Or.inr hc_top) (Or.inr hc0)] + exact hc.le.trans' <| le_iSup_of_le x <| le_iSup_of_le hx0 <| le_iSup_of_le hx_top <| + le_iSup_of_le hx1 le_rfl + +/-- **Sason–Verdú**: if `g` is differentiable at `1`, then on a measurable space with a +measurable set `E` such that `E` and `Eᶜ` are nonempty, the supremum of `D_f(μ, ν) / D_g(μ, ν)` +over probability measures `μ, ν` is the supremum of `f t / g t` over `t ∈ (0, 1) ∪ (1, ∞)`. -/ +theorem iSup_fDiv_div_fDiv_eq_iSup_div {E : Set 𝓧} (hE : MeasurableSet E) + (hE_nonempty : E.Nonempty) (hE_compl : Eᶜ.Nonempty) (hg : DifferentiableAt ℝ g.realFun 1) : + ⨆ (μ : Measure 𝓧) (ν : Measure 𝓧) (_ : IsProbabilityMeasure μ) (_ : IsProbabilityMeasure ν), + fDiv f μ ν / fDiv g μ ν + = ⨆ (t : ℝ≥0∞) (_ : t ≠ 0) (_ : t ≠ ∞) (_ : t ≠ 1), f t / g t := by + refine le_antisymm (iSup₂_le fun μ ν ↦ iSup₂_le fun _ _ ↦ fDiv_div_fDiv_le_iSup_div μ ν) ?_ + obtain ⟨x, hx⟩ := hE_nonempty + obtain ⟨y, hy⟩ := hE_compl + set L := ⨆ (μ : Measure 𝓧) (ν : Measure 𝓧) (_ : IsProbabilityMeasure μ) + (_ : IsProbabilityMeasure ν), fDiv f μ ν / fDiv g μ ν + refine iSup_le fun t ↦ iSup_le fun ht0 ↦ iSup_le fun ht_top ↦ iSup_le fun ht1 ↦ ?_ + -- the cases `0 / 0` and `∞ / ∞` are trivial + by_cases h_zero : f t = 0 ∧ g t = 0 + · simp [h_zero.1, h_zero.2] + by_cases h_top : g t = ∞ ∧ f t = ∞ + · simp [h_top.1, h_top.2] + rw [not_and_or] at h_zero h_top + set r := t.toReal + have hr : 0 < r := ENNReal.toReal_pos ht0 ht_top + have ht : t = ENNReal.ofReal r := (ENNReal.ofReal_toReal ht_top).symm + have hr1 : r ≠ 1 := fun h ↦ ht1 (by rw [ht, h, ENNReal.ofReal_one]) + have h_mem : ∀ᶠ ε in 𝓝[>] (0 : ℝ), ε ∈ Ioo (0 : ℝ) (min 1 r⁻¹) := + Ioo_mem_nhdsGT (lt_min zero_lt_one (inv_pos.mpr hr)) + -- for small `ε`, the ratio of the f-divergences between `Ber(x, y, r ε)` and `Ber(x, y, ε)` + -- is at most `L` + have h_le {ε : ℝ} (hε : ε ∈ Ioo (0 : ℝ) (min 1 r⁻¹)) : + (f t + ENNReal.ofReal ((1 - ε) / ε) * f (ENNReal.ofReal ((1 - r * ε) / (1 - ε)))) + / (g t + ENNReal.ofReal ((1 - ε) / ε) * g (ENNReal.ofReal ((1 - r * ε) / (1 - ε)))) + ≤ L := by + have hε0 : 0 < ε := hε.1 + have hε1 : ε < 1 := hε.2.trans_le (min_le_left _ _) + have hrε : r * ε < 1 := + calc r * ε < r * r⁻¹ := by gcongr; exact hε.2.trans_le (min_le_right _ _) + _ = 1 := mul_inv_cancel₀ hr.ne' + set p : I := ⟨r * ε, by positivity, hrε.le⟩ + set q : I := ⟨ε, hε0.le, hε1.le⟩ + have hq0 : q ≠ 0 := coe_ne_zero.mp hε0.ne' + have hq1 : q ≠ 1 := coe_ne_one.mp hε1.ne + have h_eq (φ : DivFunction) : fDiv φ Ber(x, y, p) Ber(x, y, q) + = ENNReal.ofReal ε + * (φ t + ENNReal.ofReal ((1 - ε) / ε) * φ (ENNReal.ofReal ((1 - r * ε) / (1 - ε)))) := by + have h_div : (p : ℝ) / q = r := mul_div_cancel_right₀ r hε0.ne' + have h_mul : ENNReal.ofReal ε * ENNReal.ofReal ((1 - ε) / ε) = ENNReal.ofReal (1 - ε) := by + rw [← ENNReal.ofReal_mul hε0.le] + congr 1 + field_simp + rw [fDiv_bernoulliMeasure_of_mem_of_notMem hE hx hy, + fDiv_bernoulliMeasure_of_ne_zero_of_ne_one (by decide) p hq0 hq1, h_div, mul_add, + ← mul_assoc, h_mul, ← ht] + calc _ = fDiv f Ber(x, y, p) Ber(x, y, q) / fDiv g Ber(x, y, p) Ber(x, y, q) := by + rw [h_eq f, h_eq g, ENNReal.mul_div_mul_left _ _ (ENNReal.ofReal_pos.mpr hε0).ne' + ENNReal.ofReal_ne_top] + _ ≤ L := le_iSup_of_le Ber(x, y, p) <| le_iSup_of_le Ber(x, y, q) <| + le_iSup_of_le inferInstance <| le_iSup_of_le inferInstance le_rfl + -- the g-divergence divided by `ε` tends to `g t` + have h_lim : Tendsto (fun ε ↦ g t + + ENNReal.ofReal ((1 - ε) / ε) * g (ENNReal.ofReal ((1 - r * ε) / (1 - ε)))) + (𝓝[>] 0) (𝓝 (g t)) := by + have h_s : Tendsto (fun ε : ℝ ↦ ENNReal.ofReal ((1 - r * ε) / (1 - ε))) (𝓝[>] 0) (𝓝 1) := by + have h_cont : ContinuousAt (fun ε : ℝ ↦ (1 - r * ε) / (1 - ε)) 0 := + (continuousAt_const.sub (continuousAt_const.mul continuousAt_id)).div + (continuousAt_const.sub continuousAt_id) (by norm_num) + simpa using ENNReal.tendsto_ofReal (h_cont.tendsto.mono_left nhdsWithin_le_nhds) + -- the derivative of `g.realFun` at its minimum `1` is `0` + have hg' : HasDerivAt g.realFun 0 1 := by + simpa [((g.isMinOn_realFun_one univ).isLocalMin univ_mem).deriv_eq_zero] using hg.hasDerivAt + have h := ENNReal.tendsto_ofReal (tendsto_div_mul_apply_div_nhdsGT_zero hg' g.realFun_one hr1) + rw [ENNReal.ofReal_zero] at h + have h' : Tendsto (fun ε ↦ ENNReal.ofReal ((1 - ε) / ε) + * g (ENNReal.ofReal ((1 - r * ε) / (1 - ε)))) (𝓝[>] 0) (𝓝 0) := by + refine h.congr' ?_ + filter_upwards [h_mem, h_s.eventually g.eventually_ne_top_nhds_one] with ε hε hε_fin + have h1ε : 0 ≤ 1 - ε := by linarith [hε.2.trans_le (min_le_left _ _)] + rw [ENNReal.ofReal_mul (div_nonneg h1ε hε.1.le), DivFunction.realFun, + ENNReal.ofReal_toReal hε_fin] + simpa using tendsto_const_nhds.add h' + -- since `f ≥ 0`, the ratio is at least `f t / (g t + ...)`, which tends to `f t / g t` + refine le_of_tendsto (ENNReal.Tendsto.div tendsto_const_nhds h_zero h_lim h_top) ?_ + filter_upwards [h_mem] with ε hε using (ENNReal.div_le_div_right le_self_add _).trans (h_le hε) + +end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/Trim.lean b/Statlib/Divergence/FDiv/Trim.lean index b2756ec..f277302 100644 --- a/Statlib/Divergence/FDiv/Trim.lean +++ b/Statlib/Divergence/FDiv/Trim.lean @@ -21,8 +21,16 @@ public import Mathlib.MeasureTheory.Function.ConditionalExpectation.RadonNikodym `ν⁻[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_map_eq_of_leftInverse`: invariance under a measurable map with a measurable left inverse * `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 +* `fDiv_trim_eq_lintegral_mixtureFun_condLExp`: the f-divergence between the restrictions to a + sub-sigma-algebra `m` is `∫⁻ x, f.mixtureFun ((μ + ν)⁻[∂μ/∂(μ + ν) | m] x) ∂(μ + ν)`, without + absolute continuity hypothesis. +* `fDiv_map_eq_fDiv_trim`: the f-divergence between the pushforwards by a measurable map `g` is the + f-divergence between the restrictions to the sigma-algebra `mβ.comap g`. +* `fDiv_trim_comap_rnDeriv_add`: the restriction to the sigma-algebra generated by `∂μ/∂(μ + ν)` + does not change the 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). @@ -130,6 +138,16 @@ theorem fDiv_map_le [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hg : Measurable g rw [fDiv_of_absolutelyContinuous (hμν.map hg), fDiv_of_absolutelyContinuous hμν] exact lintegral_f_rnDeriv_map_le hμν hg +/-- The f-divergence is invariant under a measurable map with a measurable left inverse. -/ +lemma fDiv_map_eq_of_leftInverse {e : α → β} {φ : β → α} (he : Measurable e) (hφ : Measurable φ) + (h : Function.LeftInverse φ e) (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + fDiv f (μ.map e) (ν.map e) = fDiv f μ ν := by + refine le_antisymm (fDiv_map_le he) ?_ + have h_id (ρ : Measure α) : (ρ.map e).map φ = ρ := by + rw [Measure.map_map hφ he, h.comp_eq_id, Measure.map_id] + conv_lhs => rw [← h_id μ, ← h_id ν] + exact fDiv_map_le hφ + /-- **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 ν] @@ -154,18 +172,42 @@ theorem fDiv_trim_le [IsFiniteMeasure μ] [IsFiniteMeasure ν] (hm : m ≤ mα) 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μν : μ ≪ ν) +/-- The f-divergence between the pushforwards by a measurable map `g` is the integral of +`f.mixtureFun` composed with the conditional expectation of `∂μ/∂(μ + ν)` given `g`. -/ +lemma fDiv_map_eq_lintegral_mixtureFun_condLExp [IsFiniteMeasure μ] [IsFiniteMeasure ν] {g : α → β} (hg : Measurable g) : + fDiv f (μ.map g) (ν.map g) + = ∫⁻ x, f.mixtureFun ((μ + ν)⁻[∂μ/∂(μ + ν) | mβ.comap g] x) ∂(μ + ν) := by + rw [fDiv_eq_lintegral_mixtureFun, ← Measure.map_add _ _ hg, + lintegral_map (f := fun y ↦ f.mixtureFun ((∂μ.map g/∂(μ + ν).map g) y)) + (f.measurable_mixtureFun.comp (Measure.measurable_rnDeriv _ _)) hg] + refine lintegral_congr_ae ?_ + filter_upwards [rnDeriv_map (Measure.AbsolutelyContinuous.rfl.add_right ν) hg] with x hx + rw [hx] + +/-- The f-divergence between the restrictions to a sub-sigma-algebra `m` is the integral of +`f.mixtureFun` composed with the conditional expectation of `∂μ/∂(μ + ν)` given `m`. -/ +lemma fDiv_trim_eq_lintegral_mixtureFun_condLExp [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (hm : m ≤ mα) : + fDiv f (μ.trim hm) (ν.trim hm) + = ∫⁻ x, f.mixtureFun ((μ + ν)⁻[∂μ/∂(μ + ν) | m] x) ∂(μ + ν) := by + simp_rw [trim_eq_map] + rw [fDiv_map_eq_lintegral_mixtureFun_condLExp (measurable_id'' hm), MeasurableSpace.comap_id] + +/-- The f-divergence between the pushforwards by a measurable map `g` is equal to the +f-divergence between the restrictions to the sigma-algebra `mβ.comap g`. -/ +lemma fDiv_map_eq_fDiv_trim [IsFiniteMeasure μ] [IsFiniteMeasure ν] {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μν] + rw [fDiv_map_eq_lintegral_mixtureFun_condLExp hg, fDiv_trim_eq_lintegral_mixtureFun_condLExp] /-- 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 `ν`. -/ +arbitrary, the sigma-algebra it generates may not separate the singular part of `μ` from `ν`. +See `fDiv_trim_comap_rnDeriv_add` for a version without this hypothesis, for the sigma-algebra +generated by `∂μ/∂(μ + ν)`. -/ 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 @@ -173,6 +215,15 @@ lemma fDiv_trim_comap_rnDeriv_of_ac [IsFiniteMeasure μ] [IsFiniteMeasure ν] (h condLExp_eq_self (μ.measurable_rnDeriv ν).comap_le _ (comap_measurable _), fDiv_of_absolutelyContinuous hμν] +/-- The restriction to the σ-algebra generated by `∂μ/∂(μ + ν)` does not change the +f-divergence. -/ +lemma fDiv_trim_comap_rnDeriv_add [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + fDiv f (μ.trim (μ.measurable_rnDeriv (μ + ν)).comap_le) + (ν.trim (μ.measurable_rnDeriv (μ + ν)).comap_le) = fDiv f μ ν := by + have hm := (μ.measurable_rnDeriv (μ + ν)).comap_le + rw [fDiv_trim_eq_lintegral_mixtureFun_condLExp hm, condLExp_eq_self hm _ (comap_measurable _), + fDiv_eq_lintegral_mixtureFun] + end Trim end ProbabilityTheory diff --git a/Statlib/Divergence/FDiv/TrimApprox.lean b/Statlib/Divergence/FDiv/TrimApprox.lean new file mode 100644 index 0000000..f0d9d14 --- /dev/null +++ b/Statlib/Divergence/FDiv/TrimApprox.lean @@ -0,0 +1,156 @@ +/- +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.Trim +public import Mathlib.MeasureTheory.Function.ConditionalExpectation.LebesgueBochner +public import Mathlib.Probability.Martingale.Convergence +public import Statlib.ForMathlib.Probability.Process.PartitionFiltration + +/-! +# Approximation of f-divergences by finite sub-σ-algebras + +The f-divergence between two finite measures is the supremum of the f-divergences between their +restrictions to finite sub-σ-algebras, and it is the limit of the f-divergences between their +restrictions to the σ-algebras of a filtration which generates the σ-algebra. + +## Main statements + +* `tendsto_fDiv_trim_iSup`: along a filtration `ℱ`, the f-divergences between the restrictions to + `ℱ n` converge to the f-divergence between the restrictions to `⨆ n, ℱ n`. +* `tendsto_fDiv_trim_of_iSup_eq`: the same when the filtration generates the σ-algebra, in which + case the limit is `fDiv f μ ν`. +* `tendsto_fDiv_map_of_iSup_comap_eq`: the same for the pushforwards by a sequence of maps. +* `exists_tendsto_fDiv_trim`: there is a filtration by finite sub-σ-algebras, independent of `f`, + along which the f-divergences of the restrictions converge to `fDiv f μ ν`. +* `fDiv_eq_iSup_fDiv_trim`: `fDiv f μ ν` is the supremum over finite sub-σ-algebras `m` of + `fDiv f (μ.trim hm) (ν.trim hm)`. + +## Implementation details + +We write the f-divergences of the restrictions as integrals of `f.mixtureFun` composed with the +conditional expectations of `∂μ/∂(μ + ν)` (`fDiv_trim_eq_lintegral_mixtureFun_condLExp`). This +accounts for the singular part of `μ` with respect to `ν` without any absolute continuity +hypothesis. For the filtration results, the conditional expectations of `∂μ/∂(μ + ν)` converge by +Lévy's upward theorem `MeasureTheory.tendsto_ae_condExp`, the function `f.mixtureFun` is continuous +(`DivFunction.continuous_mixtureFun`), and Fatou's lemma concludes. For the finite +sub-σ-algebras, we use the filtration `countableFiltration` of the countably generated σ-algebra +generated by `∂μ/∂(μ + ν)`. +-/ + +@[expose] public section + +open Real MeasureTheory Filter Set + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {α : Type*} {m mα : MeasurableSpace α} {μ ν : Measure α} {f : DivFunction} + +section Filtration + +/-- **Approximation along a filtration**: the f-divergences between the restrictions of `μ` and +`ν` to the σ-algebras of a filtration `ℱ` converge to the f-divergence between their restrictions to +`⨆ n, ℱ n`. -/ +theorem tendsto_fDiv_trim_iSup [IsFiniteMeasure μ] [IsFiniteMeasure ν] (ℱ : Filtration ℕ mα) : + Tendsto (fun n ↦ fDiv f (μ.trim (ℱ.le n)) (ν.trim (ℱ.le n))) atTop + (𝓝 (fDiv f (μ.trim (iSup_le ℱ.le)) (ν.trim (iSup_le ℱ.le)))) := by + set p := ∂μ/∂(μ + ν) + have h_int : ∫⁻ x, p x ∂(μ + ν) ≠ ∞ := by + rw [Measure.lintegral_rnDeriv (Measure.AbsolutelyContinuous.rfl.add_right ν)] + exact measure_ne_top _ _ + -- Lévy's upward theorem for the conditional expectations of `p` + have h_tendsto : ∀ᵐ x ∂(μ + ν), + Tendsto (fun n ↦ (μ + ν)⁻[p | ℱ n] x) atTop (𝓝 ((μ + ν)⁻[p | ⨆ n, ℱ n] x)) := by + filter_upwards [tendsto_ae_condExp (μ := μ + ν) (ℱ := ℱ) fun x ↦ (p x).toReal, + ae_all_iff.2 fun n ↦ toReal_condLExp (ℱ n) (by fun_prop) h_int, + toReal_condLExp (⨆ n, ℱ n) (by fun_prop) h_int, + ae_all_iff.2 fun n ↦ condLExp_ne_top (mΩ := ℱ n) h_int, + condLExp_ne_top (mΩ := ⨆ n, ℱ n) h_int] with x hx h_eq h_eq' hx_top hx_top' + rw [← ENNReal.tendsto_toReal_iff hx_top hx_top'] + simpa only [h_eq, h_eq'] using hx + -- the lower bound follows from Fatou's lemma, the upper bound from the data processing inequality + have h_dpi (n : ℕ) : fDiv f (μ.trim (ℱ.le n)) (ν.trim (ℱ.le n)) + ≤ fDiv f (μ.trim (iSup_le ℱ.le)) (ν.trim (iSup_le ℱ.le)) := by + have h := fDiv_trim_le (f := f) (μ := μ.trim (iSup_le ℱ.le)) (ν := ν.trim (iSup_le ℱ.le)) + (le_iSup (fun n ↦ ℱ n) n) + rwa [trim_trim, trim_trim] at h + refine tendsto_of_le_liminf_of_limsup_le ?_ + (limsup_le_of_le (by isBoundedDefault) (Eventually.of_forall h_dpi)) + simp_rw [fDiv_trim_eq_lintegral_mixtureFun_condLExp] + calc ∫⁻ x, f.mixtureFun ((μ + ν)⁻[p | ⨆ n, ℱ n] x) ∂(μ + ν) + = ∫⁻ x, liminf (fun n ↦ f.mixtureFun ((μ + ν)⁻[p | ℱ n] x)) atTop ∂(μ + ν) := by + refine lintegral_congr_ae ?_ + filter_upwards [h_tendsto] with x hx + exact ((f.continuous_mixtureFun.tendsto _).comp hx).liminf_eq.symm + _ ≤ liminf (fun n ↦ ∫⁻ x, f.mixtureFun ((μ + ν)⁻[p | ℱ n] x) ∂(μ + ν)) atTop := + lintegral_liminf_le fun n ↦ f.measurable_mixtureFun.comp (measurable_condLExp' _ _ _) + +/-- **Approximation along a filtration**: if a filtration generates the σ-algebra, the +f-divergences between the restrictions of `μ` and `ν` to the σ-algebras of the filtration +converge to `fDiv f μ ν`. -/ +theorem tendsto_fDiv_trim_of_iSup_eq [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ℱ : Filtration ℕ mα) (hℱ : ⨆ n, ℱ n = mα) : + Tendsto (fun n ↦ fDiv f (μ.trim (ℱ.le n)) (ν.trim (ℱ.le n))) atTop (𝓝 (fDiv f μ ν)) := by + have h_eq : ∀ (m : MeasurableSpace α) (hm : m ≤ mα), m = mα → + fDiv f (μ.trim hm) (ν.trim hm) = fDiv f μ ν := by + rintro _ _ rfl + simp_rw [trim_eq_self] + simpa only [h_eq _ _ hℱ] using tendsto_fDiv_trim_iSup (f := f) (μ := μ) (ν := ν) ℱ + +/-- **Approximation along a sequence of maps**: if `g n : α → β n` is a sequence of measurable maps +whose induced sigma-algebras increase and generate the sigma-algebra of `α`, the f-divergences +between the pushforwards of `μ` and `ν` by `g n` converge to `fDiv f μ ν`. -/ +theorem tendsto_fDiv_map_of_iSup_comap_eq [IsFiniteMeasure μ] [IsFiniteMeasure ν] + {β : ℕ → Type*} {mβ : ∀ n, MeasurableSpace (β n)} {g : ∀ n, α → β n} + (hg : ∀ n, Measurable (g n)) (h_mono : Monotone fun n ↦ (mβ n).comap (g n)) + (h_sup : ⨆ n, (mβ n).comap (g n) = mα) : + Tendsto (fun n ↦ fDiv f (μ.map (g n)) (ν.map (g n))) atTop (𝓝 (fDiv f μ ν)) := by + simp_rw [fDiv_map_eq_fDiv_trim (hg _)] + exact tendsto_fDiv_trim_of_iSup_eq ⟨fun n ↦ (mβ n).comap (g n), h_mono, fun n ↦ (hg n).comap_le⟩ + h_sup + +end Filtration + +section Finite + +/-- There is a filtration by finite sub-σ-algebras, which does not depend on the divergence +function `f`, along which the f-divergences of the restrictions of `μ` and `ν` converge to +`fDiv f μ ν`. -/ +theorem exists_tendsto_fDiv_trim (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + ∃ ℱ : Filtration ℕ mα, (∀ n, {s | MeasurableSet[ℱ n] s}.Finite) ∧ ∀ f : DivFunction, + Tendsto (fun n ↦ fDiv f (μ.trim (ℱ.le n)) (ν.trim (ℱ.le n))) atTop (𝓝 (fDiv f μ ν)) := by + -- the σ-algebra `m₀` generated by `∂μ/∂(μ + ν)` is countably generated and does not change the + -- f-divergences: we use the filtration of finite σ-algebras which generates it + have hm₀ := (μ.measurable_rnDeriv (μ + ν)).comap_le + set m₀ : MeasurableSpace α := MeasurableSpace.comap (∂μ/∂(μ + ν)) inferInstance + have : @MeasurableSpace.CountablyGenerated α m₀ := MeasurableSpace.CountablyGenerated.comap _ + let ℱ : Filtration ℕ mα := + ⟨@countableFiltration α m₀ _, (@countableFiltration α m₀ _).mono', + fun n ↦ ((@countableFiltration α m₀ _).le n).trans hm₀⟩ + refine ⟨ℱ, fun n ↦ @finite_setOf_measurableSet_countableFiltration α m₀ _ n, fun f ↦ ?_⟩ + have h_eq : ∀ (m : MeasurableSpace α) (hm : m ≤ mα), m = m₀ → + fDiv f (μ.trim hm) (ν.trim hm) = fDiv f μ ν := by + rintro _ _ rfl + exact fDiv_trim_comap_rnDeriv_add + simpa only [h_eq _ _ (@iSup_countableFiltration α m₀ _)] using + tendsto_fDiv_trim_iSup (f := f) (μ := μ) (ν := ν) ℱ + +/-- **The f-divergence is the supremum over finite sub-σ-algebras**: for finite measures, +`fDiv f μ ν` is the supremum of the f-divergences between the restrictions of `μ` and `ν` to the +finite sub-σ-algebras. -/ +theorem fDiv_eq_iSup_fDiv_trim [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + fDiv f μ ν = ⨆ (m : MeasurableSpace α) (hm : m ≤ mα) + (_ : {s | MeasurableSet[m] s}.Finite), fDiv f (μ.trim hm) (ν.trim hm) := by + refine le_antisymm ?_ (iSup_le fun m ↦ iSup₂_le fun hm _ ↦ fDiv_trim_le hm) + obtain ⟨ℱ, hℱ_fin, h_tendsto⟩ := exists_tendsto_fDiv_trim μ ν + exact le_of_tendsto' (h_tendsto f) fun n ↦ + le_iSup_of_le (ℱ n) (le_iSup_of_le (ℱ.le n) (le_iSup_of_le (hℱ_fin n) le_rfl)) + +end Finite + +end ProbabilityTheory diff --git a/Statlib/Divergence/Hellinger/Basic.lean b/Statlib/Divergence/Hellinger/Basic.lean index 1bd657b..32973fa 100644 --- a/Statlib/Divergence/Hellinger/Basic.lean +++ b/Statlib/Divergence/Hellinger/Basic.lean @@ -5,12 +5,9 @@ Authors: Rémy Degenne, Lorenzo Luccioli -/ module +public import Statlib.Divergence.FDiv.Conj +public import Statlib.Divergence.FDiv.Convex 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 @@ -19,6 +16,7 @@ public import Statlib.Divergence.FDiv.CompProd * `hellingerDiv a μ ν`: the Hellinger divergence of order `a`, the f-divergence for the divergence function `hellingerDivFun a`. +* `sqHellinger`: the squared Hellinger distance, half of the Hellinger divergence of order `2⁻¹`. ## Main statements @@ -26,9 +24,14 @@ public import Statlib.Divergence.FDiv.CompProd * `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. +* `hellingerDiv_smul_add_smul_le`: joint convexity of the Hellinger divergence. * `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⁻¹`. +* `sqHellinger_comm`: the squared Hellinger distance is symmetric. +* `toReal_sqHellinger_eq_integral`: for finite measures, + `H²(μ, ν) = (μ(X) + ν(X)) / 2 - ∫ √(∂μ/∂ν) ∂ν`. +* `sqHellinger_le_one`, `sqHellinger_eq_one_iff`: for probability measures, `H²(μ, ν) ≤ 1`, with + equality iff `μ ⟂ₘ ν`. This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli (https://github.com/RemyDegenne/testing-lower-bounds). @@ -59,6 +62,9 @@ noncomputable def hellingerDiv (a : ℝ) (μ ν : Measure α) : ℝ≥0∞ := fD lemma hellingerDiv_zero : hellingerDiv 0 μ ν = 0 := by simp +@[simp] lemma hellingerDiv_self (μ : Measure α) [SigmaFinite μ] : hellingerDiv a μ μ = 0 := + fDiv_self μ + @[simp] lemma hellingerDiv_one (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : hellingerDiv 1 μ ν = klDiv μ ν := by rw [hellingerDiv, hellingerDivFun_one, klDiv_eq_fDiv] @@ -325,16 +331,43 @@ lemma hellingerDiv_comp_right_le (μ ν : Measure α) [IsFiniteMeasure μ] [IsFi end DataProcessingInequality +section Convexity + +/-- The Hellinger divergence of the sum of two pairs of measures is at most the sum of the +divergences. -/ +theorem hellingerDiv_add_add_le (a : ℝ) (μ₀ μ₁ ν₀ ν₁ : Measure α) [IsFiniteMeasure μ₀] + [IsFiniteMeasure μ₁] [IsFiniteMeasure ν₀] [IsFiniteMeasure ν₁] : + hellingerDiv a (μ₀ + μ₁) (ν₀ + ν₁) ≤ hellingerDiv a μ₀ ν₀ + hellingerDiv a μ₁ ν₁ := + fDiv_add_add_le _ _ _ _ + +/-- **Joint convexity** of the Hellinger divergence. -/ +theorem hellingerDiv_smul_add_smul_le (a : ℝ) (μ₀ μ₁ ν₀ ν₁ : Measure α) [IsFiniteMeasure μ₀] + [IsFiniteMeasure μ₁] [IsFiniteMeasure ν₀] [IsFiniteMeasure ν₁] (c d : ℝ≥0) : + hellingerDiv a (c • μ₀ + d • μ₁) (c • ν₀ + d • ν₁) + ≤ c * hellingerDiv a μ₀ ν₀ + d * hellingerDiv a μ₁ ν₁ := + fDiv_smul_add_smul_le _ _ _ _ c d + +end Convexity + 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 ν] : +lemma hellingerDiv_le_of_lt_one (ha : a < 1) (μ ν : Measure α) : hellingerDiv a μ ν ≤ ν Set.univ + ENNReal.ofReal (a * (1 - a)⁻¹) * μ Set.univ := by by_cases h_zero : a ≤ 0 · simp [h_zero] + -- if one of the measures is infinite, the right-hand side is `∞` + have h_ne : ENNReal.ofReal (a * (1 - a)⁻¹) ≠ 0 := by + simp only [ne_eq, ENNReal.ofReal_eq_zero, not_le] + exact mul_pos (not_le.mp h_zero) (inv_pos.mpr (sub_pos.mpr ha)) + rcases eq_top_or_lt_top (μ .univ) with hμ | hμ + · simp [hμ, ENNReal.mul_top h_ne] + rcases eq_top_or_lt_top (ν .univ) with hν | hν + · simp [hν] + have : IsFiniteMeasure μ := ⟨hμ⟩ + have : IsFiniteMeasure ν := ⟨hν⟩ refine fDiv_le_zero_add_top.trans_eq ?_ simp [h_zero, ha] @@ -483,29 +516,6 @@ lemma hellingerDiv_smul_right_eq_top_iff' [IsFiniteMeasure μ] [IsFiniteMeasure 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 @@ -525,22 +535,6 @@ lemma rpow_mul_rpow_le_integral_rpow_rnDeriv_of_one_lt (ha : 1 < a) 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 @@ -563,6 +557,9 @@ section SqHellinger order `2⁻¹`. -/ noncomputable def sqHellinger (μ ν : Measure α) : ℝ≥0∞ := 2⁻¹ * hellingerDiv 2⁻¹ μ ν +lemma two_mul_sqHellinger (μ ν : Measure α) : 2 * sqHellinger μ ν = hellingerDiv 2⁻¹ μ ν := by + rw [sqHellinger, ← mul_assoc, ENNReal.mul_inv_cancel two_ne_zero ENNReal.ofNat_ne_top, one_mul] + 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 @@ -579,6 +576,74 @@ lemma sqHellinger_eq_ofReal_integral_of_ac [IsFiniteMeasure μ] [IsFiniteMeasure · rw [integrable_hellingerFun_iff_integrable_rpow (by norm_num)] exact integrable_rpow_rnDeriv_of_lt_one (by norm_num) (by norm_num) +@[simp] lemma sqHellinger_self (μ : Measure α) [SigmaFinite μ] : sqHellinger μ μ = 0 := by + simp [sqHellinger] + +/-- The squared Hellinger distance is symmetric. -/ +lemma sqHellinger_comm (μ ν : Measure α) [SigmaFinite μ] [SigmaFinite ν] : + sqHellinger μ ν = sqHellinger ν μ := by + rw [sqHellinger, sqHellinger, hellingerDiv, hellingerDiv, ← fDiv_conj, + conj_hellingerDivFun_inv_two] + +lemma sqHellinger_ne_top (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + sqHellinger μ ν ≠ ∞ := + ENNReal.mul_ne_top (by simp) (hellingerDiv_ne_top_of_lt_one (by norm_num) μ ν) + +/-- The squared Hellinger distance between finite measures, in terms of the integral of the square +root of the Radon-Nikodym derivative. -/ +lemma toReal_sqHellinger_eq_integral [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + (sqHellinger μ ν).toReal + = 2⁻¹ * (μ.real .univ + ν.real .univ) - ∫ x, √((∂μ/∂ν) x).toReal ∂ν := by + rw [sqHellinger, ENNReal.toReal_mul, + toReal_hellingerDiv_eq_integral_of_lt_one (by norm_num) (by norm_num)] + simp_rw [Real.sqrt_eq_rpow, one_div, measureReal_def] + norm_num + ring + +/-- For probability measures, `1 - H²(μ, ν)` is the Bhattacharyya coefficient +`∫ √(∂μ/∂ν) ∂ν`. -/ +lemma one_sub_toReal_sqHellinger [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + 1 - (sqHellinger μ ν).toReal = ∫ x, √((∂μ/∂ν) x).toReal ∂ν := by + rw [toReal_sqHellinger_eq_integral] + simp only [probReal_univ] + ring + +/-- `2 * H²(μ, ν) ≤ μ(X) + ν(X)`. For finite measures, equality holds iff `μ ⟂ₘ ν` +(`hellingerDiv_eq_add_measure_univ_iff_of_lt_one`). -/ +lemma two_mul_sqHellinger_le_add (μ ν : Measure α) : + 2 * sqHellinger μ ν ≤ μ .univ + ν .univ := by + rw [two_mul_sqHellinger, add_comm] + convert hellingerDiv_le_of_lt_one (a := 2⁻¹) (by norm_num) μ ν + norm_num + +lemma sqHellinger_le_one [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + sqHellinger μ ν ≤ 1 := by + have h := two_mul_sqHellinger_le_add μ ν + rw [measure_univ, measure_univ, one_add_one_eq_two] at h + rwa [← ENNReal.mul_le_mul_iff_right two_ne_zero ENNReal.ofNat_ne_top, mul_one] + +lemma toReal_sqHellinger_le_one [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + (sqHellinger μ ν).toReal ≤ 1 := + ENNReal.toReal_le_of_le_ofReal zero_le_one (by simpa using sqHellinger_le_one) + +lemma toReal_sqHellinger_eq_one_iff [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + (sqHellinger μ ν).toReal = 1 ↔ μ ⟂ₘ ν := by + have h := one_sub_toReal_sqHellinger (μ := μ) (ν := ν) + simp_rw [Real.sqrt_eq_rpow, one_div] at h + rw [← integral_rpow_rnDeriv_eq_zero_iff_mutuallySingular (a := 2⁻¹) (by norm_num) + (integrable_rpow_rnDeriv_of_lt_one (by norm_num) (by norm_num)), ← h, sub_eq_zero, eq_comm] + +/-- For probability measures, `H²(μ, ν) = 1` iff the measures are mutually singular. -/ +lemma sqHellinger_eq_one_iff [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + sqHellinger μ ν = 1 ↔ μ ⟂ₘ ν := by + rw [← toReal_sqHellinger_eq_one_iff, ← ENNReal.toReal_eq_toReal_iff' (sqHellinger_ne_top μ ν) + ENNReal.one_ne_top, ENNReal.toReal_one] + +lemma toReal_sqHellinger_lt_one [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (h_ms : ¬ μ ⟂ₘ ν) : + (sqHellinger μ ν).toReal < 1 := + toReal_sqHellinger_le_one.lt_of_ne fun h ↦ h_ms (toReal_sqHellinger_eq_one_iff.mp h) + end SqHellinger end ProbabilityTheory diff --git a/Statlib/Divergence/Hellinger/CondHellinger.lean b/Statlib/Divergence/Hellinger/CondHellinger.lean index 36dc840..f74e276 100644 --- a/Statlib/Divergence/Hellinger/CondHellinger.lean +++ b/Statlib/Divergence/Hellinger/CondHellinger.lean @@ -15,14 +15,16 @@ public import Statlib.Divergence.Hellinger.Basic ## 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`. + kernels `κ` and `η` with respect to `μ`, `hellingerDiv a (μ ⊗ₘ κ) (μ ⊗ₘ η)`. ## Main statements -* `hellingerDiv_compProd_right`: `hellingerDiv a (μ ⊗ₘ κ) (μ ⊗ₘ η) = condHellingerDiv a κ η μ`. +* `condHellingerDiv_eq_lintegral`: + `condHellingerDiv a κ η μ = ∫⁻ x, hellingerDiv a (κ x) (η x) ∂μ`, if `α` is countable or `β` is + countably generated and `μ` is σ-finite. * `hellingerDiv_comp_left_le`: `hellingerDiv a (κ ∘ₘ μ) (η ∘ₘ μ) ≤ condHellingerDiv a κ η μ`. * `condHellingerDiv_one`: the conditional Hellinger divergence of order `1` is `condKL`. +* `condHellingerDiv_ne_top_iff`: finiteness of the conditional Hellinger 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). @@ -40,21 +42,33 @@ variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} {μ ν : Measure α} {κ η : Kernel α β} {a : ℝ} -/-- Conditional Hellinger divergence of order `a`. -/ +/-- The conditional Hellinger divergence of order `a` between the kernels `κ` and `η` with respect +to the measure `μ`, defined as `hellingerDiv a (μ ⊗ₘ κ) (μ ⊗ₘ η)`. It is the conditional +f-divergence for the divergence function `hellingerDivFun a` (`condHellingerDiv_eq_condFDiv`). + +If `α` is countable or `β` is countably generated, `μ` is σ-finite and `κ`, `η` are finite, it is +equal to `∫⁻ x, hellingerDiv a (κ x) (η x) ∂μ` (`condHellingerDiv_eq_lintegral`). See also +`toReal_condHellingerDiv_eq_integral` and `toReal_condHellingerDiv_eq_integral'` for real-valued +integral forms. -/ noncomputable def condHellingerDiv (a : ℝ) (κ η : Kernel α β) (μ : Measure α) : ℝ≥0∞ := - condFDiv (hellingerDivFun a) κ η μ + hellingerDiv a (μ ⊗ₘ κ) (μ ⊗ₘ η) -lemma hellingerDiv_compProd_right [CountableOrCountablyGenerated α β] - (μ : Measure α) [IsFiniteMeasure μ] - (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : - hellingerDiv a (μ ⊗ₘ κ) (μ ⊗ₘ η) = condHellingerDiv a κ η μ := by - rw [hellingerDiv, condHellingerDiv, fDiv_compProd_right _ _ _] +lemma condHellingerDiv_eq_condFDiv : + condHellingerDiv a κ η μ = condFDiv (hellingerDivFun a) κ η μ := rfl + +/-- The conditional Hellinger divergence is the integral of the Hellinger divergences between the +kernels. -/ +lemma condHellingerDiv_eq_lintegral [CountableOrCountablyGenerated α β] [SigmaFinite μ] + [IsFiniteKernel κ] [IsFiniteKernel η] : + condHellingerDiv a κ η μ = ∫⁻ x, hellingerDiv a (κ x) (η x) ∂μ := + condFDiv_eq_lintegral -lemma hellingerDiv_comp_left_le [CountableOrCountablyGenerated α β] (μ : Measure α) - [IsFiniteMeasure μ] +/-- **Data-processing inequality**: composing a measure with two kernels decreases their +conditional Hellinger divergence. -/ +lemma hellingerDiv_comp_left_le (μ : Measure α) [IsFiniteMeasure μ] (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : hellingerDiv a (κ ∘ₘ μ) (η ∘ₘ μ) ≤ condHellingerDiv a κ η μ := - fDiv_comp_left_le μ κ η + hellingerDiv_comp_le_compProd μ μ κ η /-! 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`: @@ -69,9 +83,9 @@ Under these conditions, `toReal_condHellingerDiv_eq_integral'` gives the integra -/ section CondHellingerEq -lemma condHellingerDiv_one [IsFiniteKernel κ] [IsFiniteKernel η] : +lemma condHellingerDiv_one [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] : condHellingerDiv 1 κ η μ = condKL κ η μ := by - rw [condHellingerDiv, hellingerDivFun_one, condKL_eq_condFDiv] + rw [condHellingerDiv_eq_condFDiv, hellingerDivFun_one, condKL_eq_condFDiv] lemma hellingerDiv_ae_ne_top_iff [IsFiniteKernel κ] [IsFiniteKernel η] (ha_pos : 0 < a) (ha_ne : a ≠ 1) : @@ -106,8 +120,7 @@ lemma condHellingerDiv_ne_top_iff [CountableOrCountablyGenerated α β] [IsFinit ∧ (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] + rw [condHellingerDiv_eq_lintegral] constructor · intro h have h_ae : ∀ᵐ x ∂μ, hellingerDiv a (κ x) (η x) ≠ ∞ := @@ -160,12 +173,12 @@ lemma condHellingerDiv_eq_top_iff_of_lt_one [CountableOrCountablyGenerated α β ↔ ¬ 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 α β] +lemma condHellingerDiv_of_not_ae_ac_of_one_le [CountableOrCountablyGenerated α β] [SigmaFinite μ] [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 α β] +lemma toReal_condHellingerDiv_eq_integral [CountableOrCountablyGenerated α β] [SigmaFinite μ] [IsFiniteKernel κ] [IsFiniteKernel η] (h : condHellingerDiv a κ η μ ≠ ∞) : (condHellingerDiv a κ η μ).toReal = ∫ x, (hellingerDiv a (κ x) (η x)).toReal ∂μ := toReal_condFDiv_eq_integral h @@ -179,7 +192,7 @@ lemma toReal_condHellingerDiv_eq_integral' [CountableOrCountablyGenerated α β] + ((μ ⊗ₘ η) .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 + (ae_lt_top h_meas (by rwa [← condHellingerDiv_eq_lintegral])).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 ∂μ diff --git a/Statlib/Divergence/Hellinger/HellingerDivFun.lean b/Statlib/Divergence/Hellinger/HellingerDivFun.lean index a7d51d2..ebd089d 100644 --- a/Statlib/Divergence/Hellinger/HellingerDivFun.lean +++ b/Statlib/Divergence/Hellinger/HellingerDivFun.lean @@ -20,6 +20,9 @@ public import Statlib.Divergence.Hellinger.HellingerFun * `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`. +* `conj_hellingerDivFun_ofReal`: the conjugate of `hellingerDivFun a` is + `u ↦ (u ^ (1 - a) - u - a * (1 - u)) / (a - 1)` on `(0, ∞)`. +* `conj_hellingerDivFun_inv_two`: `hellingerDivFun 2⁻¹` is self-conjugate. This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli (https://github.com/RemyDegenne/testing-lower-bounds). @@ -152,4 +155,29 @@ lemma lintegral_hellingerDivFun_of_pos_of_ne_one_of_integrable_of_ac rw [lintegral_hellingerDivFun_of_pos_of_ne_one_of_integrable ha_pos ha_ne h_int, Measure.integral_toReal_rnDeriv hμν, measureReal_def] +/-- The conjugate `u ↦ u * f (1 / u)` of `f = hellingerDivFun a` is +`u ↦ (u ^ (1 - a) - u - a * (1 - u)) / (a - 1)` on `(0, ∞)`. -/ +lemma conj_hellingerDivFun_ofReal (ha_pos : 0 < a) (ha_ne : a ≠ 1) {u : ℝ} (hu : 0 < u) : + (hellingerDivFun a).conj (ENNReal.ofReal u) + = ENNReal.ofReal ((a - 1)⁻¹ * (u ^ (1 - a) - u - a * (1 - u))) := by + have hu0 : ENNReal.ofReal u ≠ 0 := by simpa using hu + rw [DivFunction.conj_of_ne_zero hu0, hellingerDivFun_apply_of_pos_of_ne_one ha_pos ha_ne + (ENNReal.inv_ne_top.mpr hu0), ENNReal.toReal_inv, ENNReal.toReal_ofReal hu.le, + ← ENNReal.ofReal_mul hu.le] + congr 1 + have h1 : u * u⁻¹ ^ a = u ^ (1 - a) := by + rw [Real.inv_rpow hu.le, Real.rpow_sub hu, Real.rpow_one, div_eq_mul_inv] + have h2 : u * u⁻¹ = 1 := mul_inv_cancel₀ hu.ne' + linear_combination (a - 1)⁻¹ * h1 - a * (a - 1)⁻¹ * h2 + +/-- The divergence function of order `2⁻¹` is self-conjugate. -/ +lemma conj_hellingerDivFun_inv_two : (hellingerDivFun 2⁻¹).conj = hellingerDivFun 2⁻¹ := by + refine DivFunction.eq_of_forall_ne_zero_ne_top fun x hx0 hx_top ↦ ?_ + have hx : 0 < x.toReal := ENNReal.toReal_pos hx0 hx_top + rw [← ENNReal.ofReal_toReal hx_top, conj_hellingerDivFun_ofReal (by norm_num) (by norm_num) hx, + hellingerDivFun_apply_of_pos_of_ne_one (by norm_num) (by norm_num) ENNReal.ofReal_ne_top, + ENNReal.toReal_ofReal hx.le] + norm_num + ring_nf + end ProbabilityTheory diff --git a/Statlib/Divergence/Hellinger/HellingerFun.lean b/Statlib/Divergence/Hellinger/HellingerFun.lean index 648f26a..be680fb 100644 --- a/Statlib/Divergence/Hellinger/HellingerFun.lean +++ b/Statlib/Divergence/Hellinger/HellingerFun.lean @@ -25,6 +25,9 @@ public import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.IntegralRPo ## Main statements * `convexOn_hellingerFun`: `hellingerFun a` is convex on `[0, ∞)` for `0 ≤ a`. +* `hasDerivAt_hellingerFun_of_ne_one`, `hasDerivAt_deriv_hellingerFun`: for `a ≠ 1` and `x ≠ 0`, + the first two derivatives of `hellingerFun a` are `(a - 1)⁻¹ * a * (x ^ (a - 1) - 1)` and + `a * x ^ (a - 2)`. * `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 @@ -57,10 +60,12 @@ 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. -/ +/-- The Hellinger function of order `a`, `x ↦ (a - 1)⁻¹ * (x ^ a - 1 - a * (x - 1))` for `a ≠ 0, 1`. +The affine term `a * (x - 1)` does not change the f-divergence between probability measures and +makes the function nonnegative on `[0, ∞)` for `0 ≤ a` (`hellingerFun_nonneg`). +For `a = 0` it is the indicator function of `{0}`, the pointwise limit as `a → 0`. For `a = 1` it +is `x ↦ x * log x + 1 - x`, the limit as `a → 1`, so that the Hellinger divergence of order `1` +coincides with the Kullback-Leibler divergence. -/ noncomputable def hellingerFun (a : ℝ) : ℝ → ℝ := if a = 0 then fun x ↦ if x = 0 then 1 else 0 @@ -159,6 +164,25 @@ lemma hasDerivAt_hellingerFun (a : ℝ) {x : ℝ} (hx : x ≠ 0) : · exact (Real.hasDerivAt_rpow_const (Or.inl hx)).sub_const _ · exact ((hasDerivAt_id x).sub_const _).const_mul _ +/-- The derivative of `hellingerFun a`, for `a ≠ 1` and `x ≠ 0` (for `a = 0`, `hellingerFun 0` is +locally constant on `x ≠ 0` and the formula gives `0`). -/ +lemma hasDerivAt_hellingerFun_of_ne_one (ha1 : a ≠ 1) {x : ℝ} (hx : x ≠ 0) : + HasDerivAt (hellingerFun a) ((a - 1)⁻¹ * a * (x ^ (a - 1) - 1)) x := by + rcases eq_or_ne a 0 with rfl | ha0 + · simpa using hasDerivAt_hellingerFun 0 hx + · simpa [ha0, ha1] using hasDerivAt_hellingerFun a hx + +/-- The derivative of `x ↦ (a - 1)⁻¹ * a * (x ^ (a - 1) - 1)`, which is the derivative of +`hellingerFun a` for `a ≠ 1` (`hasDerivAt_hellingerFun_of_ne_one`): the second derivative of +`hellingerFun a` is `a * x ^ (a - 2)`, for `a ≠ 1` and `x ≠ 0`. -/ +lemma hasDerivAt_deriv_hellingerFun (ha1 : a ≠ 1) {x : ℝ} (hx : x ≠ 0) : + HasDerivAt (fun x ↦ (a - 1)⁻¹ * a * (x ^ (a - 1) - 1)) (a * x ^ (a - 2)) x := by + have ha1' : a - 1 ≠ 0 := sub_ne_zero.mpr ha1 + refine (((Real.hasDerivAt_rpow_const (p := a - 1) (Or.inl hx)).sub_const 1).const_mul + ((a - 1)⁻¹ * a)).congr_deriv ?_ + rw [show a - 1 - 1 = a - 2 by ring] + field_simp + lemma rightDeriv_hellingerFun (a : ℝ) {x : ℝ} (hx : x ≠ 0) : derivWithin (hellingerFun a) (Ioi x) x = if a = 0 then 0 diff --git a/Statlib/Divergence/Hellinger/Prod.lean b/Statlib/Divergence/Hellinger/Prod.lean new file mode 100644 index 0000000..f61ad71 --- /dev/null +++ b/Statlib/Divergence/Hellinger/Prod.lean @@ -0,0 +1,69 @@ +/- +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.Hellinger.TotalVariation +public import Statlib.Divergence.Renyi.Prod + +/-! +# Total variation distance between product measures and the Rényi divergence of order `1/2` + +For probability measures `μ`, `ν` and a finite index type `ι` with `n` elements, write +`R = R_{1/2}(μ, ν)` and `TV = tvDist / 2`. The Rényi divergence of order `1/2` tensorizes, +`R_{1/2}(μ^⊗ι, ν^⊗ι) = n * R` (`renyiDiv_pi_const`). Together with the comparison between the +total variation distance and the Rényi divergence of order `1/2` (through the squared Hellinger +distance), this gives +`exp (-n R) / 2 ≤ 1 - √(1 - exp (-n R)) ≤ 1 - TV(μ^⊗ι, ν^⊗ι) ≤ exp (-n R / 2)`. + +## Main statements + +* `one_sub_tvDist_pi_div_two_le_exp`: `1 - TV(μ^⊗ι, ν^⊗ι) ≤ exp (-n R / 2)`. +* `one_sub_sqrt_one_sub_exp_le_one_sub_tvDist_pi_div_two`: + `1 - √(1 - exp (-n R)) ≤ 1 - TV(μ^⊗ι, ν^⊗ι)` if `μ` and `ν` are not mutually singular. +* `exp_neg_div_two_le_one_sub_tvDist_pi_div_two`: `exp (-n R) / 2 ≤ 1 - TV(μ^⊗ι, ν^⊗ι)` if `μ` + and `ν` are not mutually singular. +-/ + +@[expose] public section + +open Real MeasureTheory + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {ι : Type*} [Fintype ι] + +/-- For probability measures `μ`, `ν` and a finite index type `ι` with `n` elements, +`1 - TV(μ^⊗ι, ν^⊗ι) ≤ exp (-n R_{1/2}(μ, ν) / 2)`, where `TV = tvDist / 2`. -/ +theorem one_sub_tvDist_pi_div_two_le_exp [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + 1 - tvDist (Measure.pi (fun (_ : ι) ↦ μ)) (Measure.pi (fun (_ : ι) ↦ ν)) / 2 + ≤ exp (-(Fintype.card ι * (renyiDiv 2⁻¹ μ ν).toReal) / 2) := by + rw [← toReal_renyiDiv_pi_const (by norm_num)] + exact one_sub_tvDist_div_two_le_exp + +/-- For probability measures `μ`, `ν` which are not mutually singular and a finite index type +`ι` with `n` elements, `1 - √(1 - exp (-n R_{1/2}(μ, ν))) ≤ 1 - TV(μ^⊗ι, ν^⊗ι)`, where +`TV = tvDist / 2`. -/ +theorem one_sub_sqrt_one_sub_exp_le_one_sub_tvDist_pi_div_two [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] (h_ms : ¬ μ ⟂ₘ ν) : + 1 - √(1 - exp (-(Fintype.card ι * (renyiDiv 2⁻¹ μ ν).toReal))) + ≤ 1 - tvDist (Measure.pi (fun (_ : ι) ↦ μ)) (Measure.pi (fun (_ : ι) ↦ ν)) / 2 := by + rw [← toReal_renyiDiv_pi_const (by norm_num)] + exact one_sub_sqrt_one_sub_exp_le_one_sub_tvDist_div_two + (Measure.not_mutuallySingular_pi fun _ ↦ h_ms) + +/-- For probability measures `μ`, `ν` which are not mutually singular and a finite index type +`ι` with `n` elements, `exp (-n R_{1/2}(μ, ν)) / 2 ≤ 1 - TV(μ^⊗ι, ν^⊗ι)`, where +`TV = tvDist / 2`. -/ +theorem exp_neg_div_two_le_one_sub_tvDist_pi_div_two [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] (h_ms : ¬ μ ⟂ₘ ν) : + exp (-(Fintype.card ι * (renyiDiv 2⁻¹ μ ν).toReal)) / 2 + ≤ 1 - tvDist (Measure.pi (fun (_ : ι) ↦ μ)) (Measure.pi (fun (_ : ι) ↦ ν)) / 2 := by + rw [← toReal_renyiDiv_pi_const (by norm_num)] + exact exp_neg_div_two_le_one_sub_tvDist_div_two (Measure.not_mutuallySingular_pi fun _ ↦ h_ms) + +end ProbabilityTheory diff --git a/Statlib/Divergence/Hellinger/Renyi.lean b/Statlib/Divergence/Hellinger/Renyi.lean new file mode 100644 index 0000000..8f83aae --- /dev/null +++ b/Statlib/Divergence/Hellinger/Renyi.lean @@ -0,0 +1,101 @@ +/- +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 + +/-! +# Squared Hellinger distance and Rényi divergence of order `1/2` + +For probability measures, the squared Hellinger distance `sqHellinger μ ν` is related to the +Bhattacharyya coefficient `∫ √(∂μ/∂ν) ∂ν` by `1 - H²(μ, ν) = ∫ √(∂μ/∂ν) ∂ν` +(`one_sub_toReal_sqHellinger`), and the Rényi divergence of order `1/2` is +`R_{1/2}(μ, ν) = -2 log (1 - H²(μ, ν))`. + +## Main statements + +* `toReal_renyiDiv_inv_two`, `renyiDiv_inv_two_of_not_mutuallySingular`: for probability + measures, `R_{1/2}(μ, ν) = -2 log (1 - H²(μ, ν))`. +* `exp_neg_toReal_renyiDiv_inv_two_div_two`: for probability measures which are not mutually + singular, `exp (-R_{1/2}(μ, ν) / 2) = 1 - H²(μ, ν)`. +* `two_mul_sqHellinger_le_renyiDiv_inv_two`: for probability measures, + `2 * H²(μ, ν) ≤ R_{1/2}(μ, ν)`. + +## References + +* T. van Erven, P. Harremoës, *Rényi divergence and Kullback-Leibler divergence*, IEEE + Transactions on Information Theory 60(7) (2014). +-/ + +@[expose] public section + +open Real MeasureTheory + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} + +/-- For probability measures, `R_{1/2}(μ, ν) = ∞` iff `H²(μ, ν) = 1`, that is iff the measures are +mutually singular. -/ +lemma renyiDiv_inv_two_eq_top_iff [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + renyiDiv 2⁻¹ μ ν = ∞ ↔ sqHellinger μ ν = 1 := by + rw [renyiDiv_eq_top_iff_mutuallySingular_of_lt_one (by norm_num) (by norm_num), + sqHellinger_eq_one_iff] + +/-- The Rényi divergence of order `1/2` between probability measures which are not mutually +singular is `-2 log (1 - H²(μ, ν))`. -/ +lemma renyiDiv_inv_two_of_not_mutuallySingular [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (h_ms : ¬ μ ⟂ₘ ν) : + renyiDiv 2⁻¹ μ ν = ENNReal.ofReal (-2 * Real.log (1 - (sqHellinger μ ν).toReal)) := by + rw [renyiDiv_eq_log_integral_of_lt_one (by norm_num) (by norm_num) h_ms, + one_sub_toReal_sqHellinger] + simp_rw [Real.sqrt_eq_rpow, one_div] + norm_num + +/-- **Rényi divergence of order `1/2` and squared Hellinger distance**: for probability measures, +`R_{1/2}(μ, ν) = -2 log (1 - H²(μ, ν))`. If the measures are mutually singular, both sides are +`0` since `R_{1/2}(μ, ν) = ∞` and `Real.log 0 = 0`. -/ +lemma toReal_renyiDiv_inv_two [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + (renyiDiv 2⁻¹ μ ν).toReal = -2 * Real.log (1 - (sqHellinger μ ν).toReal) := by + by_cases h_ms : μ ⟂ₘ ν + · rw [(renyiDiv_eq_top_iff_mutuallySingular_of_lt_one (by norm_num) (by norm_num)).mpr h_ms, + toReal_sqHellinger_eq_one_iff.mpr h_ms] + simp + rw [renyiDiv_inv_two_of_not_mutuallySingular h_ms, ENNReal.toReal_ofReal] + have h_lt := toReal_sqHellinger_lt_one h_ms + have h_log : Real.log (1 - (sqHellinger μ ν).toReal) ≤ 0 := + Real.log_nonpos (by linarith) (by linarith [ENNReal.toReal_nonneg (a := sqHellinger μ ν)]) + linarith + +/-- For probability measures which are not mutually singular, +`exp (- R_{1/2}(μ, ν) / 2) = 1 - H²(μ, ν)`. -/ +lemma exp_neg_toReal_renyiDiv_inv_two_div_two [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (h_ms : ¬ μ ⟂ₘ ν) : + Real.exp (-(renyiDiv 2⁻¹ μ ν).toReal / 2) = 1 - (sqHellinger μ ν).toReal := by + rw [toReal_renyiDiv_inv_two] + have h_pos : 0 < 1 - (sqHellinger μ ν).toReal := by + linarith [toReal_sqHellinger_lt_one h_ms] + rw [show -(-2 * Real.log (1 - (sqHellinger μ ν).toReal)) / 2 + = Real.log (1 - (sqHellinger μ ν).toReal) by ring, Real.exp_log h_pos] + +/-- For probability measures, `2 * H²(μ, ν) ≤ R_{1/2}(μ, ν)`. -/ +lemma two_mul_sqHellinger_le_renyiDiv_inv_two [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + 2 * sqHellinger μ ν ≤ renyiDiv 2⁻¹ μ ν := by + by_cases h_ms : μ ⟂ₘ ν + · rw [(renyiDiv_eq_top_iff_mutuallySingular_of_lt_one (by norm_num) (by norm_num)).mpr h_ms] + exact le_top + have h_eq : 2 * sqHellinger μ ν = ENNReal.ofReal (2 * (sqHellinger μ ν).toReal) := by + rw [ENNReal.ofReal_mul (by norm_num), ENNReal.ofReal_toReal (sqHellinger_ne_top μ ν), + ENNReal.ofReal_ofNat] + rw [h_eq, renyiDiv_inv_two_of_not_mutuallySingular h_ms] + refine ENNReal.ofReal_le_ofReal ?_ + have h_lt := toReal_sqHellinger_lt_one h_ms + have h_log := Real.log_le_sub_one_of_pos (x := 1 - (sqHellinger μ ν).toReal) (by linarith) + linarith + +end ProbabilityTheory diff --git a/Statlib/Divergence/Hellinger/TotalVariation.lean b/Statlib/Divergence/Hellinger/TotalVariation.lean new file mode 100644 index 0000000..a96aee3 --- /dev/null +++ b/Statlib/Divergence/Hellinger/TotalVariation.lean @@ -0,0 +1,304 @@ +/- +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.BretagnolleHuber +public import Statlib.Divergence.Hellinger.Renyi + +/-! +# Hellinger divergences and total variation distance + +We compare the squared Hellinger distance `H²(μ, ν) = sqHellinger μ ν` with the total variation +distance, deduce bounds on the total variation distance in terms of the Rényi divergence of order +`1/2`, and prove a Bretagnolle-Huber inequality for the Hellinger divergences. Mathlib's +`tvDist μ ν` is the total variation norm of `μ - ν`, which for probability measures is twice the +distance `TV(μ, ν) = sup_E |μ E - ν E|`. + +## Main statements + +* `two_mul_sqHellinger_le_etvDist`, `toReal_sqHellinger_le_tvDist_div_two`: + `2 * H²(μ, ν) ≤ ‖μ - ν‖`, that is `H²(μ, ν) ≤ TV(μ, ν)` for probability measures. +* `tvDist_sq_le_four_mul_sqHellinger_mul`: for finite measures, + `‖μ - ν‖ ^ 2 ≤ 4 * H²(μ, ν) * (μ(X) + ν(X) - H²(μ, ν))`. +* `tvDist_div_two_le_sqrt_sqHellinger_mul`: for probability measures, + `TV(μ, ν) ≤ √(H²(μ, ν) * (2 - H²(μ, ν)))`. +* `one_sub_sqHellinger_sq_le`, `one_sub_sqrt_le_one_sub_tvDist_div_two`: corollaries of the + previous inequality. +* `one_sub_tvDist_div_two_le_exp`, `exp_neg_div_two_le_one_sub_tvDist_div_two`: for probability + measures, `exp (-R_{1/2}(μ, ν)) / 2 ≤ 1 - TV(μ, ν) ≤ exp (-R_{1/2}(μ, ν) / 2)`, the lower bound + if the measures are not mutually singular. +* `ofReal_rpow_one_sub_tvDist_div_two_le_hellingerDiv`: a **Bretagnolle-Huber** type inequality + for the Hellinger divergence of order `1 + a`, `H_{1+a}(μ, ν) ≥ ((1 - TV(μ, ν)) ^ (-a) - 2) / a`. + +## References + +* A. B. Tsybakov, *Introduction to Nonparametric Estimation*, Springer (2009), Section 2.4. +-/ + +@[expose] public section + +open Real MeasureTheory Set Filter + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} + +/-- The divergence function of the Hellinger divergence of order `1/2`, `x ↦ (1 - √x) ^ 2`, is +bounded by the divergence function `x ↦ |1 - x|` of the total variation distance. -/ +lemma hellingerDivFun_inv_two_le_tvDivFun (x : ℝ≥0∞) : + hellingerDivFun 2⁻¹ x ≤ tvDivFun x := by + by_cases hx : x = ∞ + · simp [hx] + rw [hellingerDivFun_apply_of_pos_of_ne_one (by norm_num) (by norm_num) hx, tvDivFun_apply hx] + refine ENNReal.ofReal_le_ofReal ?_ + -- `(1 - √x) ^ 2 ≤ |1 - √x| * (1 + √x) = |1 - x|` + have hy : 0 ≤ x.toReal := ENNReal.toReal_nonneg + rw [show x.toReal ^ (2⁻¹ : ℝ) = √x.toReal by rw [Real.sqrt_eq_rpow, one_div]] + have hs := Real.sq_sqrt hy + have hs_nonneg := Real.sqrt_nonneg x.toReal + rcases le_total x.toReal 1 with h1 | h1 + · have hs1 : √x.toReal ≤ 1 := Real.sqrt_le_one.mpr h1 + rw [abs_of_nonneg (by linarith)] + nlinarith + · have hs1 : 1 ≤ √x.toReal := Real.one_le_sqrt.mpr h1 + rw [abs_of_nonpos (by linarith)] + nlinarith + +/-- The Hellinger divergence of order `1/2` is bounded by the total variation norm. If one of the +measures is not finite, `etvDist μ ν = ∞`. -/ +theorem hellingerDiv_inv_two_le_etvDist (μ ν : Measure α) : + hellingerDiv 2⁻¹ μ ν ≤ etvDist μ ν := by + by_cases h : IsFiniteMeasure μ ∧ IsFiniteMeasure ν + · have := h.1 + have := h.2 + rw [hellingerDiv, ← fDiv_tvDivFun] + exact fDiv_mono hellingerDivFun_inv_two_le_tvDivFun + · simp [etvDist_of_not_isFiniteMeasure h] + +/-- `2 * H²(μ, ν) ≤ ‖μ - ν‖`. For probability measures, this is `H²(μ, ν) ≤ TV(μ, ν)` with +`TV(μ, ν) = tvDist μ ν / 2`. -/ +theorem two_mul_sqHellinger_le_etvDist (μ ν : Measure α) : + 2 * sqHellinger μ ν ≤ etvDist μ ν := by + rw [two_mul_sqHellinger] + exact hellingerDiv_inv_two_le_etvDist μ ν + +/-- For finite measures, `H²(μ, ν) ≤ ‖μ - ν‖ / 2`. For probability measures, this is +`H²(μ, ν) ≤ TV(μ, ν)` with `TV(μ, ν) = tvDist μ ν / 2`. -/ +theorem toReal_sqHellinger_le_tvDist_div_two (μ ν : Measure α) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] : + (sqHellinger μ ν).toReal ≤ tvDist μ ν / 2 := by + have h := two_mul_sqHellinger_le_etvDist μ ν + rw [← ofReal_tvDist, ← ENNReal.ofReal_toReal (sqHellinger_ne_top μ ν), ← ENNReal.ofReal_ofNat 2, + ← ENNReal.ofReal_mul (by norm_num), ENNReal.ofReal_le_ofReal_iff tvDist_nonneg] at h + linarith + +/-- For finite measures, `‖μ - ν‖ ^ 2 ≤ 4 * H²(μ, ν) * (μ(X) + ν(X) - H²(μ, ν))`. +See `tvDist_div_two_sq_le_sqHellinger_mul` for the version for probability measures. -/ +theorem tvDist_sq_le_four_mul_sqHellinger_mul (μ ν : Measure α) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] : + tvDist μ ν ^ 2 ≤ 4 * (sqHellinger μ ν).toReal + * (μ.real univ + ν.real univ - (sqHellinger μ ν).toReal) := by + -- Write `r = ∂μ/∂ν`, `s` for the mass of the singular part, `c = μ(X) + ν(X)` and + -- `I = ∫ √r ∂ν = c / 2 - H²(μ, ν)`. Then `tvDist μ ν = ∫ |1 - √r| (1 + √r) ∂ν + s`, and we apply + -- the Cauchy-Schwarz inequality to the integral, with `∫ (1 ± √r) ^ 2 ∂ν = c ± 2 * I - s`. + set r : α → ℝ := fun x ↦ ((∂μ/∂ν) x).toReal with hr_def + set s := (μ.singularPart ν).real univ + set I := ∫ x, √(r x) ∂ν + have hr_nonneg (x : α) : 0 ≤ r x := ENNReal.toReal_nonneg + have hs_nonneg : 0 ≤ s := measureReal_nonneg + have hr_int : Integrable r ν := Measure.integrable_toReal_rnDeriv + have hsqrt_int : Integrable (fun x ↦ √(r x)) ν := by + simp_rw [hr_def, Real.sqrt_eq_rpow, one_div] + exact integrable_rpow_rnDeriv_of_lt_one (by norm_num) (by norm_num) + have h_tv : tvDist μ ν = ∫ x, |1 - r x| ∂ν + s := + tvDist_eq_integral_abs_rnDeriv_add_singularPart + have h_int_r : ∫ x, r x ∂ν = μ.real univ - s := Measure.integral_toReal_rnDeriv' + have h_hI : (sqHellinger μ ν).toReal = 2⁻¹ * (μ.real univ + ν.real univ) - I := + toReal_sqHellinger_eq_integral + -- integrals of `(1 - √r) ^ 2` and `(1 + √r) ^ 2` + have h_sub_sq : (fun x ↦ (1 - √(r x)) ^ 2) = fun x ↦ 1 - 2 * √(r x) + r x := by + ext x; rw [sub_sq, Real.sq_sqrt (hr_nonneg x)]; ring + have h_add_sq : (fun x ↦ (1 + √(r x)) ^ 2) = fun x ↦ 1 + 2 * √(r x) + r x := by + ext x; rw [add_sq, Real.sq_sqrt (hr_nonneg x)]; ring + have h_int_sub : Integrable (fun x ↦ 1 - 2 * √(r x)) ν := + (integrable_const 1).sub (hsqrt_int.const_mul 2) + have h_int_add : Integrable (fun x ↦ 1 + 2 * √(r x)) ν := + (integrable_const 1).add (hsqrt_int.const_mul 2) + have hA : ∫ x, (1 - √(r x)) ^ 2 ∂ν = μ.real univ + ν.real univ - 2 * I - s := by + rw [h_sub_sq, integral_add h_int_sub hr_int, + integral_sub (integrable_const 1) (hsqrt_int.const_mul 2), integral_const_mul, h_int_r, + integral_const, smul_eq_mul, mul_one] + ring + have hB : ∫ x, (1 + √(r x)) ^ 2 ∂ν = μ.real univ + ν.real univ + 2 * I - s := by + rw [h_add_sq, integral_add h_int_add hr_int, + integral_add (integrable_const 1) (hsqrt_int.const_mul 2), integral_const_mul, h_int_r, + integral_const, smul_eq_mul, mul_one] + ring + -- Cauchy-Schwarz inequality + have h_abs (x : α) : |1 - r x| = |1 - √(r x)| * (1 + √(r x)) := by + have hs := Real.sq_sqrt (hr_nonneg x) + rw [show 1 - r x = (1 - √(r x)) * (1 + √(r x)) by nlinarith, abs_mul, + abs_of_nonneg (by positivity : 0 ≤ 1 + √(r x))] + have h_meas : AEStronglyMeasurable (fun x ↦ √(r x)) ν := hsqrt_int.aestronglyMeasurable + have h_CS : ∫ x, |1 - r x| ∂ν + ≤ √(∫ x, (1 - √(r x)) ^ 2 ∂ν) * √(∫ x, (1 + √(r x)) ^ 2 ∂ν) := by + simp_rw [h_abs] + have h_meas_sub : AEStronglyMeasurable (fun x ↦ |1 - √(r x)|) ν := + continuous_abs.comp_aestronglyMeasurable (aestronglyMeasurable_const.sub h_meas) + have h_meas_add : AEStronglyMeasurable (fun x ↦ 1 + √(r x)) ν := + aestronglyMeasurable_const.add h_meas + have hf : MemLp (fun x ↦ |1 - √(r x)|) (ENNReal.ofReal 2) ν := by + rw [ENNReal.ofReal_ofNat, memLp_two_iff_integrable_sq h_meas_sub] + simp_rw [sq_abs, h_sub_sq] + exact h_int_sub.add hr_int + have hg : MemLp (fun x ↦ 1 + √(r x)) (ENNReal.ofReal 2) ν := by + rw [ENNReal.ofReal_ofNat, memLp_two_iff_integrable_sq h_meas_add, h_add_sq] + exact h_int_add.add hr_int + refine (integral_mul_le_Lp_mul_Lq_of_nonneg Real.HolderConjugate.two_two + (ae_of_all _ fun _ ↦ abs_nonneg _) (ae_of_all _ fun _ ↦ by positivity) hf hg).trans_eq ?_ + simp_rw [Real.rpow_two, sq_abs, ← Real.sqrt_eq_rpow] + -- with `A = c - 2 * I - s` and `B = c + 2 * I - s`, `tvDist μ ν ≤ √A * √B + s` and + -- `(√A * √B + s) ^ 2 ≤ (A + s) * (B + s) = c ^ 2 - 4 * I ^ 2` + rw [hA, hB] at h_CS + set A := μ.real univ + ν.real univ - 2 * I - s + set B := μ.real univ + ν.real univ + 2 * I - s + have hA_nonneg : 0 ≤ A := by + rw [← hA]; exact integral_nonneg fun _ ↦ sq_nonneg _ + have hB_nonneg : 0 ≤ B := by + rw [← hB]; exact integral_nonneg fun _ ↦ sq_nonneg _ + have h_le : tvDist μ ν ≤ √A * √B + s := by linarith + have ha := Real.sq_sqrt hA_nonneg + have hb := Real.sq_sqrt hB_nonneg + have ha' := Real.sqrt_nonneg A + have hb' := Real.sqrt_nonneg B + have h_sq : (√A * √B + s) ^ 2 ≤ (A + s) * (B + s) := by + nlinarith [sq_nonneg (√A - √B), mul_nonneg hs_nonneg (sq_nonneg (√A - √B))] + have key := (pow_le_pow_left₀ tvDist_nonneg h_le 2).trans h_sq + rw [h_hI] + linear_combination key + +/-- For probability measures, `TV(μ, ν) ^ 2 ≤ H²(μ, ν) * (2 - H²(μ, ν))`, where +`TV(μ, ν) = tvDist μ ν / 2`. -/ +theorem tvDist_div_two_sq_le_sqHellinger_mul [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + (tvDist μ ν / 2) ^ 2 ≤ (sqHellinger μ ν).toReal * (2 - (sqHellinger μ ν).toReal) := by + have h := tvDist_sq_le_four_mul_sqHellinger_mul μ ν + simp only [probReal_univ] at h + linear_combination h / 4 + +/-- For probability measures, `TV(μ, ν) ≤ √(H²(μ, ν) * (2 - H²(μ, ν)))`, where +`TV(μ, ν) = tvDist μ ν / 2`. -/ +theorem tvDist_div_two_le_sqrt_sqHellinger_mul [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] : + tvDist μ ν / 2 ≤ √((sqHellinger μ ν).toReal * (2 - (sqHellinger μ ν).toReal)) := + Real.le_sqrt_of_sq_le tvDist_div_two_sq_le_sqHellinger_mul + +/-- For probability measures, `(1 - H²(μ, ν)) ^ 2 / 2 ≤ 1 - TV(μ, ν) - (1 - TV(μ, ν)) ^ 2 / 2`, +where `TV(μ, ν) = tvDist μ ν / 2`. -/ +theorem one_sub_sqHellinger_sq_le [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + 2⁻¹ * (1 - (sqHellinger μ ν).toReal) ^ 2 + ≤ 1 - tvDist μ ν / 2 - 2⁻¹ * (1 - tvDist μ ν / 2) ^ 2 := by + have h := tvDist_div_two_sq_le_sqHellinger_mul (μ := μ) (ν := ν) + nlinarith + +/-- For probability measures, `1 - √(1 - (1 - H²(μ, ν)) ^ 2) ≤ 1 - TV(μ, ν)`, where +`TV(μ, ν) = tvDist μ ν / 2`. -/ +theorem one_sub_sqrt_le_one_sub_tvDist_div_two [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] : + 1 - √(1 - (1 - (sqHellinger μ ν).toReal) ^ 2) ≤ 1 - tvDist μ ν / 2 := by + have h := tvDist_div_two_le_sqrt_sqHellinger_mul (μ := μ) (ν := ν) + rw [show 1 - (1 - (sqHellinger μ ν).toReal) ^ 2 + = (sqHellinger μ ν).toReal * (2 - (sqHellinger μ ν).toReal) by ring] + linarith + +/-! ### Total variation distance and Rényi divergence of order `1/2` -/ + +/-- For probability measures, `1 - TV(μ, ν) ≤ exp (-R_{1/2}(μ, ν) / 2)`, where +`TV(μ, ν) = tvDist μ ν / 2`. If the measures are mutually singular, `R_{1/2}(μ, ν) = ∞` and +the right-hand side is `1` since `ENNReal.toReal ∞ = 0`. -/ +theorem one_sub_tvDist_div_two_le_exp [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + 1 - tvDist μ ν / 2 ≤ exp (-(renyiDiv 2⁻¹ μ ν).toReal / 2) := by + by_cases h_ms : μ ⟂ₘ ν + · rw [(renyiDiv_eq_top_iff_mutuallySingular_of_lt_one (by norm_num) (by norm_num)).mpr h_ms] + simpa using div_nonneg tvDist_nonneg zero_le_two + rw [exp_neg_toReal_renyiDiv_inv_two_div_two h_ms] + exact sub_le_sub_left (toReal_sqHellinger_le_tvDist_div_two _ _) 1 + +/-- For probability measures which are not mutually singular, +`1 - √(1 - exp (-R_{1/2}(μ, ν))) ≤ 1 - TV(μ, ν)`, where `TV(μ, ν) = tvDist μ ν / 2`. -/ +theorem one_sub_sqrt_one_sub_exp_le_one_sub_tvDist_div_two [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] (h_ms : ¬ μ ⟂ₘ ν) : + 1 - √(1 - exp (-(renyiDiv 2⁻¹ μ ν).toReal)) ≤ 1 - tvDist μ ν / 2 := by + have h_sq : exp (-(renyiDiv 2⁻¹ μ ν).toReal) = (1 - (sqHellinger μ ν).toReal) ^ 2 := by + rw [← exp_neg_toReal_renyiDiv_inv_two_div_two h_ms, ← exp_nat_mul] + congr 1 + ring + rw [h_sq] + exact one_sub_sqrt_le_one_sub_tvDist_div_two + +/-- For probability measures which are not mutually singular, +`exp (-R_{1/2}(μ, ν)) / 2 ≤ 1 - TV(μ, ν)`, where `TV(μ, ν) = tvDist μ ν / 2`. -/ +theorem exp_neg_div_two_le_one_sub_tvDist_div_two [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] (h_ms : ¬ μ ⟂ₘ ν) : + exp (-(renyiDiv 2⁻¹ μ ν).toReal) / 2 ≤ 1 - tvDist μ ν / 2 := by + refine le_trans ?_ (one_sub_sqrt_one_sub_exp_le_one_sub_tvDist_div_two h_ms) + -- `√(1 - x) ≤ 1 - x / 2` for `x = exp (-R_{1/2}(μ, ν)) ≤ 1` + set x := exp (-(renyiDiv 2⁻¹ μ ν).toReal) + have hx : x ≤ 1 := by + rw [exp_le_one_iff, neg_nonpos] + positivity + have h_sqrt : √(1 - x) ≤ 1 - x / 2 := by + simpa [← sub_eq_add_neg, neg_div] using sqrt_one_add_le (x := -x) (by linarith) + linarith + +/-! ### A Bretagnolle-Huber inequality for the Hellinger divergence -/ + +/-- **Bretagnolle-Huber inequality for the Hellinger divergence**: for probability measures and +`0 < a`, `H_{1+a}(μ, ν) ≥ ((1 - TV(μ, ν)) ^ (-a) - 2) / a`, where `TV(μ, ν) = tvDist μ ν / 2`. +If `TV(μ, ν) = 1`, the left-hand side is `0` since `0 ^ (-a) = 0` for real powers. -/ +theorem ofReal_rpow_one_sub_tvDist_div_two_le_hellingerDiv [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] {a : ℝ} (ha : 0 < a) : + ENNReal.ofReal (((1 - tvDist μ ν / 2) ^ (-a) - 2) / a) ≤ hellingerDiv (1 + a) μ ν := by + set t := tvDist μ ν / 2 with ht + have ht_nonneg : 0 ≤ t := by positivity [tvDist_nonneg (μ := μ) (ν := ν)] + have ht_le : t ≤ 1 := by + have := tvDist_le_add (μ := μ) (ν := ν) + simp only [probReal_univ] at this + linarith + rcases ht_le.lt_or_eq with ht_lt | ht_eq + swap + · rw [ht_eq, sub_self, Real.zero_rpow (by linarith), zero_sub, + ENNReal.ofReal_of_nonpos (div_nonpos_of_nonpos_of_nonneg (by norm_num) ha.le)] + exact zero_le + have h := conj_one_add_etvDist_div_two_add_conj_one_sub_le_fDiv + (f := hellingerDivFun (1 + a)) μ ν + have hT : etvDist μ ν / 2 = ENNReal.ofReal t := by + rw [ht, ← ofReal_tvDist, ENNReal.ofReal_div_of_pos two_pos, ENNReal.ofReal_ofNat] + rw [hT, ← ENNReal.ofReal_one, ← ENNReal.ofReal_add zero_le_one ht_nonneg, + ← ENNReal.ofReal_sub _ ht_nonneg, + conj_hellingerDivFun_ofReal (by linarith) (by linarith) (by linarith), + conj_hellingerDivFun_ofReal (by linarith) (by linarith) (by linarith), + add_sub_cancel_left, sub_add_cancel_left] at h + refine le_trans ?_ (ENNReal.ofReal_add_le.trans h) + refine ENNReal.ofReal_le_ofReal ?_ + -- the right-hand side is `((1 + t) ^ (-a) + (1 - t) ^ (-a) - 2) / a` + have h_pos : 0 ≤ (1 + t) ^ (-a) := by positivity + rw [div_eq_inv_mul] + have ha_inv : 0 < a⁻¹ := inv_pos.mpr ha + nlinarith + +/-- **Bretagnolle-Huber inequality for the Hellinger divergence**, real version: for probability +measures and `0 < a` with `H_{1+a}(μ, ν) < ∞`, +`(1 - TV(μ, ν)) ^ (-a) ≤ 2 + a * H_{1+a}(μ, ν)`, where `TV(μ, ν) = tvDist μ ν / 2`. -/ +theorem rpow_one_sub_tvDist_div_two_le_two_add_hellingerDiv [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] {a : ℝ} (ha : 0 < a) (h_top : hellingerDiv (1 + a) μ ν ≠ ∞) : + (1 - tvDist μ ν / 2) ^ (-a) ≤ 2 + a * (hellingerDiv (1 + a) μ ν).toReal := by + have h := ofReal_rpow_one_sub_tvDist_div_two_le_hellingerDiv (μ := μ) (ν := ν) ha + rw [ENNReal.ofReal_le_iff_le_toReal h_top, div_le_iff₀ ha] at h + linarith + +end ProbabilityTheory diff --git a/Statlib/Divergence/JensenShannon/Basic.lean b/Statlib/Divergence/JensenShannon/Basic.lean new file mode 100644 index 0000000..3508a62 --- /dev/null +++ b/Statlib/Divergence/JensenShannon/Basic.lean @@ -0,0 +1,263 @@ +/- +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 + +/-! +# The Jensen-Shannon divergence + +For `α ∈ [0, 1]`, the Jensen-Shannon divergence of weight `α` between two finite measures `μ` +and `ν` is +`JS_α(μ, ν) = α * KL(μ, α • μ + (1 - α) • ν) + (1 - α) * KL(ν, α • μ + (1 - α) • ν)`. +It is the f-divergence for the function +`x ↦ α * x * log x - (α * x + 1 - α) * log (α * x + 1 - α)`. + +## Main definitions + +* `jensenShannon α μ ν`: the Jensen-Shannon divergence of weight `α` between `μ` and `ν`. +* `jensenShannonFun α`: the real function + `x ↦ α * (x * log x) - (α * x + (1 - α)) * log (α * x + (1 - α))`. +* `jensenShannonDivFun α`: the divergence function built from `jensenShannonFun α`. + +## Main statements + +* `jensenShannon_eq_fDiv`: the Jensen-Shannon divergence is the f-divergence for + `jensenShannonDivFun α`. +* `jensenShannon_symm`: `JS_α(μ, ν) = JS_{1 - α}(ν, μ)`. +* `jensenShannon_eq_zero_iff`: for `0 < α < 1`, `JS_α(μ, ν) = 0` if and only if `μ = ν`. +* `jensenShannon_comp_right_le`, `jensenShannon_map_le`: data processing inequalities. +* `hasDerivAt_jensenShannonFun`, `hasDerivAt_deriv_jensenShannonFun`: the first two derivatives of + `jensenShannonFun α`, which are `α * log x - α * log (α * x + (1 - α))` and + `α * (1 - α) / (x * (α * x + (1 - α)))`. + +## Implementation notes + +The weight `α` is an element of `ℝ≥0`, as in the lemmas about mixtures of measures +`fDiv_smul_add_smul_right` and `fDiv_smul_add_smul_right_self`. The definition is meant for +`α ≤ 1`; for `α > 1`, the truncated subtraction gives `1 - α = 0`. + +## References + +* J. Lin, *Divergence measures based on the Shannon entropy*, IEEE Transactions on Information + Theory 37(1) (1991). +-/ + +@[expose] public section + +open Real MeasureTheory Filter Set InformationTheory + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {𝓧 𝓨 : Type*} {m𝓧 : MeasurableSpace 𝓧} {m𝓨 : MeasurableSpace 𝓨} {μ ν : Measure 𝓧} + {α : ℝ≥0} + +section JensenShannonFun + +variable {a x : ℝ} + +/-- The function `x ↦ a * (x * log x) - (a * x + (1 - a)) * log (a * x + (1 - a))`, whose +f-divergence is the Jensen-Shannon divergence of weight `a`. -/ +noncomputable def jensenShannonFun (a : ℝ) (x : ℝ) : ℝ := + a * (x * log x) - (a * x + (1 - a)) * log (a * x + (1 - a)) + +@[simp] +lemma jensenShannonFun_one (a : ℝ) : jensenShannonFun a 1 = 0 := by + simp [jensenShannonFun] + +private lemma mul_add_one_sub_pos (ha0 : 0 ≤ a) (ha1 : a ≤ 1) (hx : 0 < x) : + 0 < a * x + (1 - a) := by + rcases ha0.eq_or_lt with rfl | ha0 + · simp + · exact add_pos_of_pos_of_nonneg (mul_pos ha0 hx) (sub_nonneg.mpr ha1) + +lemma hasDerivAt_jensenShannonFun (ha0 : 0 ≤ a) (ha1 : a ≤ 1) (hx : 0 < x) : + HasDerivAt (jensenShannonFun a) (a * log x - a * log (a * x + (1 - a))) x := by + have hm := mul_add_one_sub_pos ha0 ha1 hx + have h_aff : HasDerivAt (fun x ↦ a * x + (1 - a)) a x := by + simpa using ((hasDerivAt_id x).const_mul a).add_const (1 - a) + have h1 : HasDerivAt (fun x ↦ a * (x * log x)) (a * (log x + 1)) x := + (Real.hasDerivAt_mul_log hx.ne').const_mul a + have h2 : HasDerivAt (fun y ↦ (a * y + (1 - a)) * log (a * y + (1 - a))) + (a * log (a * x + (1 - a)) + (a * x + (1 - a)) * (a / (a * x + (1 - a)))) x := + h_aff.mul (h_aff.log hm.ne') + refine (h1.sub h2).congr_deriv ?_ + field_simp + ring + +lemma hasDerivAt_deriv_jensenShannonFun (ha0 : 0 ≤ a) (ha1 : a ≤ 1) (hx : 0 < x) : + HasDerivAt (fun x ↦ a * log x - a * log (a * x + (1 - a))) + (a * (1 - a) / (x * (a * x + (1 - a)))) x := by + have hm := mul_add_one_sub_pos ha0 ha1 hx + have h_aff : HasDerivAt (fun x ↦ a * x + (1 - a)) a x := by + simpa using ((hasDerivAt_id x).const_mul a).add_const (1 - a) + convert ((Real.hasDerivAt_log hx.ne').const_mul a).sub ((h_aff.log hm.ne').const_mul a) using 1 + field_simp + ring + +lemma convexOn_jensenShannonFun (ha0 : 0 ≤ a) (ha1 : a ≤ 1) : + ConvexOn ℝ (Ioi 0) (jensenShannonFun a) := by + refine convexOn_of_hasDerivWithinAt2_nonneg (convex_Ioi 0) + (f' := fun x ↦ a * log x - a * log (a * x + (1 - a))) + (f'' := fun x ↦ a * (1 - a) / (x * (a * x + (1 - a)))) + (fun x hx ↦ (hasDerivAt_jensenShannonFun ha0 ha1 hx).continuousAt.continuousWithinAt) + (fun x hx ↦ ?_) (fun x hx ↦ ?_) (fun x hx ↦ ?_) + · rw [interior_Ioi] at hx + exact (hasDerivAt_jensenShannonFun ha0 ha1 hx).hasDerivWithinAt + · rw [interior_Ioi] at hx + exact (hasDerivAt_deriv_jensenShannonFun ha0 ha1 hx).hasDerivWithinAt + · rw [interior_Ioi] at hx + have hm := mul_add_one_sub_pos ha0 ha1 hx + exact div_nonneg (mul_nonneg ha0 (sub_nonneg.mpr ha1)) (mul_pos hx hm).le + +/-- `jensenShannonFun a` is the weighted sum of the functions of the f-divergence representations +of `KL(μ, a • μ + (1 - a) • ν)` and `KL(ν, a • μ + (1 - a) • ν)`. -/ +lemma jensenShannonFun_eq_add (ha0 : 0 ≤ a) (ha1 : a ≤ 1) (hx : 0 < x) : + jensenShannonFun a x + = a * ((a * x + (1 - a)) * klFun (x / (a * x + (1 - a)))) + + (1 - a) * ((a * x + (1 - a)) * klFun (a * x + (1 - a))⁻¹) := by + have hm := mul_add_one_sub_pos ha0 ha1 hx + simp only [jensenShannonFun, klFun_apply, Real.log_div hx.ne' hm.ne', Real.log_inv] + field_simp + ring + +end JensenShannonFun + +/-- The divergence function of the Jensen-Shannon divergence of weight `α`: for `α ≤ 1`, it is +the `DivFunction` built from `jensenShannonFun α`. It is `0` for `α > 1`. -/ +noncomputable def jensenShannonDivFun (α : ℝ≥0) : DivFunction := + if hα : α ≤ 1 then + DivFunction.ofReal (jensenShannonFun α) + (convexOn_jensenShannonFun α.coe_nonneg (by exact_mod_cast hα)) (jensenShannonFun_one α) + else 0 + +lemma jensenShannonDivFun_of_le_one (hα : α ≤ 1) : + jensenShannonDivFun α = DivFunction.ofReal (jensenShannonFun α) + (convexOn_jensenShannonFun α.coe_nonneg (by exact_mod_cast hα)) (jensenShannonFun_one α) := + dite_eq_left hα + +lemma jensenShannonDivFun_apply (hα : α ≤ 1) {x : ℝ≥0∞} (hx0 : x ≠ 0) (hx_top : x ≠ ∞) : + jensenShannonDivFun α x = ENNReal.ofReal (jensenShannonFun α x.toReal) := by + rw [jensenShannonDivFun_of_le_one hα, DivFunction.ofReal_apply hx0 hx_top] + +/-- The Jensen-Shannon divergence of weight `α` between two measures `μ` and `ν`: +`α * KL(μ, α • μ + (1 - α) • ν) + (1 - α) * KL(ν, α • μ + (1 - α) • ν)`. +It is meant to be used for `α ≤ 1`. -/ +noncomputable def jensenShannon (α : ℝ≥0) (μ ν : Measure 𝓧) : ℝ≥0∞ := + α * klDiv μ (α • μ + (1 - α) • ν) + (1 - α : ℝ≥0) * klDiv ν (α • μ + (1 - α) • ν) + +/-- `JS_α(μ, ν) = JS_{1 - α}(ν, μ)`. -/ +lemma jensenShannon_symm (hα : α ≤ 1) (μ ν : Measure 𝓧) : + jensenShannon α μ ν = jensenShannon (1 - α) ν μ := by + rw [jensenShannon, jensenShannon, tsub_tsub_cancel_of_le hα, add_comm (α • μ), add_comm] + +@[simp] +lemma jensenShannon_zero (μ ν : Measure 𝓧) [SigmaFinite ν] : jensenShannon 0 μ ν = 0 := by + simp [jensenShannon] + +@[simp] +lemma jensenShannon_one (μ ν : Measure 𝓧) [SigmaFinite μ] : jensenShannon 1 μ ν = 0 := by + simp [jensenShannon] + +@[simp] +lemma jensenShannon_self (hα : α ≤ 1) (μ : Measure 𝓧) [SigmaFinite μ] : + jensenShannon α μ μ = 0 := by + rw [jensenShannon, ← add_smul, add_tsub_cancel_of_le hα, one_smul] + simp + +/-- For `0 < α < 1`, the Jensen-Shannon divergence between two finite measures vanishes if and only +if the two measures are equal. -/ +lemma jensenShannon_eq_zero_iff (hα0 : α ≠ 0) (hα1 : α < 1) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] : + jensenShannon α μ ν = 0 ↔ μ = ν := by + refine ⟨fun h ↦ ?_, fun h ↦ h ▸ jensenShannon_self hα1.le μ⟩ + have h1α : (1 - α : ℝ≥0) ≠ 0 := (tsub_pos_of_lt hα1).ne' + simp only [jensenShannon, add_eq_zero, mul_eq_zero, ENNReal.coe_eq_zero, hα0, h1α, false_or, + klDiv_eq_zero_iff] at h + exact h.1.trans h.2.symm + +section FDiv + +/-- The divergence function of the Jensen-Shannon divergence is the weighted sum of the +divergence functions of `KL(μ, α • μ + (1 - α) • ν)` and `KL(ν, α • μ + (1 - α) • ν)`, given by +`fDiv_smul_add_smul_right` and `fDiv_smul_add_smul_right_self`. -/ +lemma jensenShannonDivFun_eq_add (hα : α ≤ 1) : + jensenShannonDivFun α + = α • (klDivFun.conj.compAffine (1 - α) α (tsub_add_cancel_of_le hα)).conj + + (1 - α) • klDivFun.conj.compAffine α (1 - α) (add_tsub_cancel_of_le hα) := by + have hab : α + (1 - α) = 1 := add_tsub_cancel_of_le hα + -- away from `0` and `∞`, both sides are `ENNReal.ofReal` of the two sides of + -- `jensenShannonFun_eq_add` at `r = x.toReal` + refine DivFunction.eq_of_forall_ne_zero_ne_top fun x hx0 hx_top ↦ ?_ + rw [DivFunction.add_apply, DivFunction.smul_apply, DivFunction.smul_apply, + DivFunction.conj_compAffine_conj_apply hab hx0 hx_top, + DivFunction.conj_compAffine_apply hab hx0, jensenShannonDivFun_apply hα hx0 hx_top] + set r := x.toReal with hr_def + have hr : 0 < r := ENNReal.toReal_pos hx0 hx_top + have hα1 : (α : ℝ) ≤ 1 := by exact_mod_cast hα + have h_sub : ((1 - α : ℝ≥0) : ℝ) = 1 - α := NNReal.coe_sub hα + set m := (α : ℝ) * r + (1 - α) with hm_def + have hm : 0 < m := mul_add_one_sub_pos α.coe_nonneg hα1 hr + have h_mix : (α * x + (1 - α : ℝ≥0) : ℝ≥0∞) = ENNReal.ofReal m := by + rw [hm_def, ENNReal.ofReal_add (mul_nonneg α.coe_nonneg hr.le) (sub_nonneg.mpr hα1), + ENNReal.ofReal_mul α.coe_nonneg, ENNReal.ofReal_toReal hx_top, ← h_sub, + ENNReal.ofReal_coe_nnreal, ENNReal.ofReal_coe_nnreal] + have h_div : x / (α * x + (1 - α : ℝ≥0)) = ENNReal.ofReal (r / m) := by + rw [h_mix, ENNReal.ofReal_div_of_pos hm, ENNReal.ofReal_toReal hx_top] + have h_inv : (α * x + (1 - α : ℝ≥0) : ℝ≥0∞)⁻¹ = ENNReal.ofReal m⁻¹ := by + rw [h_mix, ENNReal.ofReal_inv_of_pos hm] + have h_kl : ∀ t : ℝ, 0 ≤ t → klDivFun (ENNReal.ofReal t) = ENNReal.ofReal (klFun t) := by + intro t ht + rw [klDivFun_apply ENNReal.ofReal_ne_top, ENNReal.toReal_ofReal ht, klFun_apply] + have h1 : 0 ≤ klFun (r / m) := klFun_nonneg (div_nonneg hr.le hm.le) + have h2 : 0 ≤ klFun m⁻¹ := klFun_nonneg (inv_nonneg.mpr hm.le) + rw [h_div, h_inv, h_mix, h_kl _ (div_nonneg hr.le hm.le), h_kl _ (inv_nonneg.mpr hm.le), + ← ENNReal.ofReal_mul hm.le, ← ENNReal.ofReal_mul hm.le, ← ENNReal.ofReal_coe_nnreal, + ← ENNReal.ofReal_mul α.coe_nonneg, ← ENNReal.ofReal_coe_nnreal (p := 1 - α), h_sub, + ← ENNReal.ofReal_mul (sub_nonneg.mpr hα1), + ← ENNReal.ofReal_add (mul_nonneg α.coe_nonneg (mul_nonneg hm.le h1)) + (mul_nonneg (sub_nonneg.mpr hα1) (mul_nonneg hm.le h2)), + jensenShannonFun_eq_add α.coe_nonneg hα1 hr] + +/-- The Jensen-Shannon divergence is an f-divergence, for the function +`x ↦ α * x * log x - (α * x + 1 - α) * log (α * x + 1 - α)`. -/ +theorem jensenShannon_eq_fDiv (hα : α ≤ 1) (μ ν : Measure 𝓧) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] : + jensenShannon α μ ν = fDiv (jensenShannonDivFun α) μ ν := by + have hab : α + (1 - α) = 1 := add_tsub_cancel_of_le hα + rw [jensenShannon, klDiv_eq_fDiv, klDiv_eq_fDiv, fDiv_smul_add_smul_right hab, + fDiv_smul_add_smul_right_self hab, jensenShannonDivFun_eq_add hα, fDiv_add, fDiv_smul, + fDiv_smul] + +end FDiv + +section DataProcessing + +/-- **Data processing inequality** for the Jensen-Shannon divergence and a Markov kernel. -/ +theorem jensenShannon_comp_right_le (μ ν : Measure 𝓧) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ : Kernel 𝓧 𝓨) [IsMarkovKernel κ] : + jensenShannon α (κ ∘ₘ μ) (κ ∘ₘ ν) ≤ jensenShannon α μ ν := by + have h_mix : α • (κ ∘ₘ μ) + (1 - α) • (κ ∘ₘ ν) = κ ∘ₘ (α • μ + (1 - α) • ν) := by + simp_rw [Measure.comp_add, ← Measure.coe_nnreal_smul, Measure.comp_smul] + rw [jensenShannon, jensenShannon, h_mix] + gcongr <;> exact klDiv_comp_right_le _ _ κ + +/-- **Data processing inequality** for the Jensen-Shannon divergence and a measurable map. -/ +theorem jensenShannon_map_le (μ ν : Measure 𝓧) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + {g : 𝓧 → 𝓨} (hg : Measurable g) : + jensenShannon α (μ.map g) (ν.map g) ≤ jensenShannon α μ ν := by + have h_mix : α • μ.map g + (1 - α) • ν.map g = (α • μ + (1 - α) • ν).map g := by + rw [Measure.map_add _ _ hg, Measure.map_smul _ hg.aemeasurable, + Measure.map_smul _ hg.aemeasurable] + rw [jensenShannon, jensenShannon, h_mix] + gcongr <;> exact klDiv_map_le _ _ hg + +end DataProcessing + +end ProbabilityTheory diff --git a/Statlib/Divergence/JensenShannon/Hellinger.lean b/Statlib/Divergence/JensenShannon/Hellinger.lean new file mode 100644 index 0000000..5fde19e --- /dev/null +++ b/Statlib/Divergence/JensenShannon/Hellinger.lean @@ -0,0 +1,237 @@ +/- +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.Hellinger.Basic +public import Statlib.Divergence.JensenShannon.Basic + +/-! +# Inequalities between the Jensen-Shannon and the Hellinger divergences + +For finite measures `μ`, `ν`, `α ∈ [0, 1]` and `β ∈ (0, 1)`, +`JS_α(μ, ν) ≤ (1 - α) ^ (1 - β) * α ^ β / (β ^ (1 - β) * (1 - β) ^ β) * (1 - β) * H_β(μ, ν)`. + +Both divergences are f-divergences, for functions `f` and `g` which vanish at `1` together with +their derivatives. The inequality follows from a comparison of the second derivatives +(`fDiv_ofReal_le_of_deriv2_le`): the supremum of `f'' / g''` is bounded by the weighted +arithmetic-geometric mean inequality. + +## Main statements + +* `jensenShannon_le_hellingerDiv`: the inequality above (Theorem 3 of the note cited below). +* `jensenShannon_le_hellingerDiv_self`: the case `β = α`, + `JS_α(μ, ν) ≤ ((1 - α) / α) ^ (1 - 2 * α) * (1 - α) * H_α(μ, ν)`. +* `jensenShannon_le_mul_hellingerDiv_one_sub`: the case `β = 1 - α`, + `JS_α(μ, ν) ≤ α * H_{1 - α}(μ, ν)`. +* `jensenShannon_le_mul_klDiv`: the limiting case `β = 1`, `JS_α(μ, ν) ≤ α * KL(μ, ν)`. +* `jensenShannon_le_rpow_mul_hellingerDiv_one_sub`: for `β ∈ [0, 1/2]`, + `JS_α(μ, ν) ≤ α ^ (1 - β) * H_{1 - β}(μ, ν)` (Corollary 4 of the note). + +## References + +* R. Degenne, *An inequality between Jensen-Shannon and Hellinger divergences*, short note + (Theorem 3 and Corollary 4). +* A. Pensia, V. Jog, P.-L. Loh, *The sample complexity of simple binary hypothesis testing*, + COLT 2024. They prove `JS_α(μ, ν) ≤ 32 α ^ (1 - 2λ) H_{1-λ}(μ, ν)` for `α, λ ∈ (0, 1/2]`, + a bound of the same form as Corollary 4 with a larger constant. +-/ + +@[expose] public section + +open Real MeasureTheory Filter Set InformationTheory + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {𝓧 : Type*} {m𝓧 : MeasurableSpace 𝓧} {α : ℝ≥0} {β : ℝ} + +section Real + +variable {a x : ℝ} + +/-- The constant `C = (1 - a) ^ (1 - β) * a ^ β / (β ^ (1 - β) * (1 - β) ^ β)` of +`jensenShannon_le_hellingerDiv` is nonnegative. -/ +private lemma jensenShannonHellinger_const_nonneg (ha0 : 0 ≤ a) (ha1 : a ≤ 1) (hβ0 : 0 ≤ β) + (hβ1 : β ≤ 1) : + 0 ≤ (1 - a) ^ (1 - β) * a ^ β / (β ^ (1 - β) * (1 - β) ^ β) := by + have h1a : 0 ≤ 1 - a := sub_nonneg.mpr ha1 + have h1β : 0 ≤ 1 - β := sub_nonneg.mpr hβ1 + positivity + +/-- The key inequality between the second derivatives of the functions defining `JS_a` and +`(1 - β) * H_β`: for `x > 0`, +`a * (1 - a) / (x * (a * x + (1 - a))) ≤ C * (1 - β) * (β * x ^ (β - 2))`, where +`C = (1 - a) ^ (1 - β) * a ^ β / (β ^ (1 - β) * (1 - β) ^ β)`. This is the weighted +arithmetic-geometric mean inequality applied to `a * x / (1 - β)` and `(1 - a) / β` with weights +`1 - β` and `β`. -/ +private lemma deriv2_jensenShannonFun_le (ha0 : 0 ≤ a) (ha1 : a ≤ 1) (hβ0 : 0 < β) (hβ1 : β < 1) + (hx : 0 < x) : + a * (1 - a) / (x * (a * x + (1 - a))) + ≤ (1 - a) ^ (1 - β) * a ^ β / (β ^ (1 - β) * (1 - β) ^ β) * (1 - β) * (β * x ^ (β - 2)) := by + have h1β : 0 < 1 - β := sub_pos.mpr hβ1 + have hC := jensenShannonHellinger_const_nonneg ha0 ha1 hβ0.le hβ1.le + have h_rhs_nonneg : 0 ≤ (1 - a) ^ (1 - β) * a ^ β / (β ^ (1 - β) * (1 - β) ^ β) * (1 - β) + * (β * x ^ (β - 2)) := by + positivity + -- the cases `a = 0` and `a = 1` are trivial + rcases ha0.eq_or_lt with rfl | ha0 + · simpa using h_rhs_nonneg + rcases ha1.eq_or_lt with rfl | ha1 + · simpa using h_rhs_nonneg + have h1a : 0 < 1 - a := sub_pos.mpr ha1 + set m := a * x + (1 - a) with hm_def + have hm : 0 < m := by positivity + -- weighted AM-GM inequality + have h_amgm : a ^ (1 - β) * x ^ (1 - β) * (1 - a) ^ β + ≤ m * ((1 - β) ^ (1 - β) * β ^ β) := by + have h := Real.geom_mean_le_arith_mean2_weighted (w₁ := 1 - β) (w₂ := β) + (p₁ := a * x / (1 - β)) (p₂ := (1 - a) / β) h1β.le hβ0.le (by positivity) (by positivity) + (by ring) + have h_sum : (1 - β) * (a * x / (1 - β)) + β * ((1 - a) / β) = m := by + rw [hm_def] + field_simp + rw [h_sum, Real.div_rpow (by positivity) h1β.le, Real.div_rpow h1a.le hβ0.le, + Real.mul_rpow ha0.le hx.le, div_mul_div_comm, div_le_iff₀ (by positivity)] at h + exact h + have hP : 0 < a ^ (1 - β) * x ^ (1 - β) * (1 - a) ^ β := by positivity + have hK : 0 < (1 - β) ^ (1 - β) * β ^ β := by positivity + calc a * (1 - a) / (x * m) + _ ≤ a * (1 - a) * ((1 - β) ^ (1 - β) * β ^ β) / (x * (a ^ (1 - β) * x ^ (1 - β) * (1 - a) ^ β)) + := by + rw [div_le_div_iff₀ (by positivity) (by positivity)] + have : 0 ≤ a * (1 - a) * x := by positivity + calc a * (1 - a) * (x * (a ^ (1 - β) * x ^ (1 - β) * (1 - a) ^ β)) + _ = a * (1 - a) * x * (a ^ (1 - β) * x ^ (1 - β) * (1 - a) ^ β) := by ring + _ ≤ a * (1 - a) * x * (m * ((1 - β) ^ (1 - β) * β ^ β)) := by gcongr + _ = a * (1 - a) * ((1 - β) ^ (1 - β) * β ^ β) * (x * m) := by ring + _ = (1 - a) ^ (1 - β) * a ^ β / (β ^ (1 - β) * (1 - β) ^ β) * (1 - β) * (β * x ^ (β - 2)) := by + rw [Real.rpow_sub ha0 1 β, Real.rpow_sub h1a 1 β, + Real.rpow_sub h1β 1 β, Real.rpow_sub hβ0 1 β, Real.rpow_sub hx 1 β, Real.rpow_sub hx β 2, + Real.rpow_one, Real.rpow_one, Real.rpow_one, Real.rpow_one, Real.rpow_one, Real.rpow_two] + have : 0 < a ^ β := by positivity + have : 0 < (1 - a) ^ β := by positivity + have : 0 < (1 - β) ^ β := by positivity + have : 0 < β ^ β := by positivity + have : 0 < x ^ β := by positivity + field_simp + +end Real + +section JensenShannonHellinger + +/-- **Inequality between the Jensen-Shannon and the Hellinger divergences.** +For `α ∈ [0, 1]` and `β ∈ (0, 1)`, +`JS_α(μ, ν) ≤ (1 - α) ^ (1 - β) * α ^ β / (β ^ (1 - β) * (1 - β) ^ β) * ((1 - β) * H_β(μ, ν))`. -/ +theorem jensenShannon_le_hellingerDiv (hα : α ≤ 1) (hβ0 : 0 < β) (hβ1 : β < 1) + (μ ν : Measure 𝓧) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + jensenShannon α μ ν + ≤ ENNReal.ofReal ((1 - α) ^ (1 - β) * α ^ β / (β ^ (1 - β) * (1 - β) ^ β)) + * (ENNReal.ofReal (1 - β) * hellingerDiv β μ ν) := by + have hα1 : (α : ℝ) ≤ 1 := by exact_mod_cast hα + have hC : 0 ≤ (1 - (α : ℝ)) ^ (1 - β) * (α : ℝ) ^ β / (β ^ (1 - β) * (1 - β) ^ β) := + jensenShannonHellinger_const_nonneg α.coe_nonneg hα1 hβ0.le hβ1.le + rw [← mul_assoc, ← ENNReal.ofReal_mul hC, jensenShannon_eq_fDiv hα, hellingerDiv, + jensenShannonDivFun_of_le_one hα, hellingerDivFun_of_pos hβ0] + refine fDiv_ofReal_le_of_deriv2_le + (c := ((1 - α) ^ (1 - β) * α ^ β / (β ^ (1 - β) * (1 - β) ^ β) * (1 - β)).toNNReal) _ _ _ _ + (fun x hx ↦ hasDerivAt_jensenShannonFun α.coe_nonneg hα1 hx) + (fun x hx ↦ hasDerivAt_deriv_jensenShannonFun α.coe_nonneg hα1 hx) + (fun x hx ↦ hasDerivAt_hellingerFun_of_ne_one hβ1.ne hx.ne') + (fun x hx ↦ hasDerivAt_deriv_hellingerFun hβ1.ne hx.ne') (by simp) (fun x hx ↦ ?_) μ ν + rw [Real.coe_toNNReal _ (mul_nonneg hC (sub_nonneg.mpr hβ1.le))] + exact deriv2_jensenShannonFun_le α.coe_nonneg hα1 hβ0 hβ1 hx + +/-- The case `β = α` of `jensenShannon_le_hellingerDiv`: +`JS_α(μ, ν) ≤ ((1 - α) / α) ^ (1 - 2 * α) * ((1 - α) * H_α(μ, ν))`. -/ +theorem jensenShannon_le_hellingerDiv_self (hα : α ≤ 1) (μ ν : Measure 𝓧) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] : + jensenShannon α μ ν + ≤ ENNReal.ofReal (((1 - α) / α) ^ (1 - 2 * (α : ℝ))) + * (ENNReal.ofReal (1 - α) * hellingerDiv α μ ν) := by + rcases eq_zero_or_pos α with rfl | hα0 + · simp + rcases hα.eq_or_lt with rfl | hα1 + · simp + have hα0' : (0 : ℝ) < α := by exact_mod_cast hα0 + have hα1' : (α : ℝ) < 1 := by exact_mod_cast hα1 + have h1α : (0 : ℝ) < 1 - α := sub_pos.mpr hα1' + convert jensenShannon_le_hellingerDiv hα1.le hα0' hα1' μ ν using 3 + rw [Real.div_rpow h1α.le hα0'.le, show 1 - 2 * (α : ℝ) = (1 - α) - α by ring, + Real.rpow_sub h1α, Real.rpow_sub hα0'] + have : 0 < (1 - (α : ℝ)) ^ (α : ℝ) := by positivity + have : 0 < (α : ℝ) ^ (α : ℝ) := by positivity + have : 0 < (α : ℝ) ^ (1 - (α : ℝ)) := by positivity + field_simp + +/-- The case `β = 1 - α` of `jensenShannon_le_hellingerDiv`: `JS_α(μ, ν) ≤ α * H_{1 - α}(μ, ν)`. +-/ +theorem jensenShannon_le_mul_hellingerDiv_one_sub (hα : α ≤ 1) (μ ν : Measure 𝓧) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + jensenShannon α μ ν ≤ α * hellingerDiv (1 - α) μ ν := by + rcases eq_zero_or_pos α with rfl | hα0 + · simp + rcases hα.eq_or_lt with rfl | hα1 + · simp + have hα0' : (0 : ℝ) < α := by exact_mod_cast hα0 + have hα1' : (α : ℝ) < 1 := by exact_mod_cast hα1 + have h1α : (0 : ℝ) < 1 - α := sub_pos.mpr hα1' + convert jensenShannon_le_hellingerDiv hα1.le h1α (by linarith) μ ν using 1 + rw [sub_sub_cancel, ENNReal.ofReal_coe_nnreal, ← mul_assoc, div_self (by positivity), + ENNReal.ofReal_one, one_mul] + +/-- The limiting case `β = 1` of `jensenShannon_le_hellingerDiv`: `JS_α(μ, ν) ≤ α * KL(μ, ν)`. -/ +theorem jensenShannon_le_mul_klDiv (hα : α ≤ 1) (μ ν : Measure 𝓧) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] : + jensenShannon α μ ν ≤ α * klDiv μ ν := by + have hα1 : (α : ℝ) ≤ 1 := by exact_mod_cast hα + rw [jensenShannon_eq_fDiv hα, klDiv_eq_fDiv, jensenShannonDivFun_of_le_one hα, klDivFun] + refine fDiv_ofReal_le_of_deriv2_le _ _ _ _ + (fun x hx ↦ hasDerivAt_jensenShannonFun α.coe_nonneg hα1 hx) + (fun x hx ↦ hasDerivAt_deriv_jensenShannonFun α.coe_nonneg hα1 hx) + (fun x hx ↦ hasDerivAt_klFun hx.ne') (fun x hx ↦ Real.hasDerivAt_log hx.ne') (by simp) + (fun x hx ↦ ?_) μ ν + -- `α * (1 - α) / (x * (α * x + (1 - α))) ≤ α / x` since `1 - α ≤ α * x + (1 - α)` + have h1α : 0 ≤ 1 - (α : ℝ) := sub_nonneg.mpr hα1 + have h_le : 1 - (α : ℝ) ≤ α * x + (1 - α) := le_add_of_nonneg_left (by positivity) + rw [mul_div_mul_comm, ← div_eq_mul_inv] + exact mul_le_of_le_one_right (by positivity) (div_le_one_of_le₀ h_le (h1α.trans h_le)) + +/-- For `β ∈ [0, 1/2]`, `JS_α(μ, ν) ≤ α ^ (1 - β) * H_{1 - β}(μ, ν)`. This is the form of the +inequality that enters bounds on the sample complexity of simple binary hypothesis testing with +the prior `(α, 1 - α)`, as in the work of Pensia, Jog and Loh cited in the module docstring. -/ +theorem jensenShannon_le_rpow_mul_hellingerDiv_one_sub (hα : α ≤ 1) (hβ0 : 0 ≤ β) + (hβ : β ≤ 1 / 2) (μ ν : Measure 𝓧) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + jensenShannon α μ ν ≤ ENNReal.ofReal ((α : ℝ) ^ (1 - β)) * hellingerDiv (1 - β) μ ν := by + rcases hβ0.eq_or_lt with rfl | hβ0 + · simpa using jensenShannon_le_mul_klDiv hα μ ν + have hα1 : (α : ℝ) ≤ 1 := by exact_mod_cast hα + have h1β : 0 < 1 - β := by linarith + refine (jensenShannon_le_hellingerDiv hα h1β (by linarith) μ ν).trans ?_ + have hC : 0 ≤ (1 - (α : ℝ)) ^ (1 - (1 - β)) * (α : ℝ) ^ (1 - β) + / ((1 - β) ^ (1 - (1 - β)) * (1 - (1 - β)) ^ (1 - β)) := + jensenShannonHellinger_const_nonneg α.coe_nonneg hα1 h1β.le (by linarith) + rw [← mul_assoc, ← ENNReal.ofReal_mul hC] + gcongr + rw [sub_sub_cancel] + -- `C * β = α ^ (1 - β) * (1 - α) ^ β * (β / (1 - β)) ^ β ≤ α ^ (1 - β)` + have h_eq : (1 - (α : ℝ)) ^ β * (α : ℝ) ^ (1 - β) / ((1 - β) ^ β * β ^ (1 - β)) * β + = (α : ℝ) ^ (1 - β) * ((1 - α) ^ β * (β ^ β / (1 - β) ^ β)) := by + rw [Real.rpow_sub hβ0, Real.rpow_one] + have : 0 < β ^ β := by positivity + have : 0 < (1 - β) ^ β := by positivity + field_simp + rw [h_eq] + refine mul_le_of_le_one_right (by positivity) ?_ + have h_ratio : β ^ β / (1 - β) ^ β ≤ 1 := by + rw [div_le_one (by positivity)] + exact Real.rpow_le_rpow hβ0.le (by linarith) hβ0.le + exact (mul_le_of_le_one_left (by positivity) + (Real.rpow_le_one (sub_nonneg.mpr hα1) (by simp) hβ0.le)).trans h_ratio + +end JensenShannonHellinger + +end ProbabilityTheory diff --git a/Statlib/Divergence/JensenShannon/Variational.lean b/Statlib/Divergence/JensenShannon/Variational.lean new file mode 100644 index 0000000..bf8612d --- /dev/null +++ b/Statlib/Divergence/JensenShannon/Variational.lean @@ -0,0 +1,161 @@ +/- +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.JensenShannon.Basic +public import Statlib.Divergence.KullbackLeibler.CondKL +public import Statlib.ForMathlib.InformationTheory.KullbackLeibler.ChainRule +public import Statlib.ForMathlib.MeasureTheory.Measure.Bool +public import Statlib.ForMathlib.MeasureTheory.Measure.Typeclasses.Probability + +/-! +# Variational formulas for the Jensen-Shannon divergence + +Let `πₐ = boolMeasure α (1 - α)` be the prior on `Bool` with mass `α` at `false`, and +`P = boolKernel μ ν` the kernel with `P false = μ` and `P true = ν`, so that +`P ∘ₘ πₐ = α • μ + (1 - α) • ν`. For finite measures `μ`, `ν` and `ξ`, the compensation identity +`α * KL(μ, ξ) + (1 - α) * KL(ν, ξ) = JS_α(μ, ν) + KL(α • μ + (1 - α) • ν, ξ)` +holds. It follows that for probability measures `μ` and `ν`, `JS_α(μ, ν)` is the infimum over +probability measures `ξ` of `α * KL(μ, ξ) + (1 - α) * KL(ν, ξ)`, attained at +`ξ = α • μ + (1 - α) • ν`. + +## Main statements + +* `jensenShannon_eq_klDiv_compProd`: `JS_α(μ, ν) = KL(πₐ ⊗ₘ P, πₐ × (P ∘ₘ πₐ))`, the mutual + information between the parameter and the observation. +* `mul_klDiv_add_mul_klDiv_eq_jensenShannon_add`: the compensation identity. +* `jensenShannon_eq_iInf_klDiv`: `JS_α(μ, ν) = ⨅ ξ, (α * KL(μ, ξ) + (1 - α) * KL(ν, ξ))`. +* `jensenShannon_eq_iInf_klDiv_compProd`: `JS_α(μ, ν) = ⨅ ξ, KL(πₐ ⊗ₘ P, πₐ × ξ)`. +* `jensenShannon_le_mul_klDiv_add_mul_klDiv`: `JS_α(μ, ν) ≤ α * KL(μ, ξ) + (1 - α) * KL(ν, ξ)` + for every finite measure `ξ`. +* `jensenShannon_pi_le`, `jensenShannon_pi_const_le`: subadditivity for product measures, + `JS_α(⊗ᵢ μᵢ, ⊗ᵢ νᵢ) ≤ ∑ᵢ JS_α(μᵢ, νᵢ)` and `JS_α(μ^⊗n, ν^⊗n) ≤ n * JS_α(μ, ν)`. + +## Implementation notes + +The compensation identity follows from two applications of the chain rule for the +Kullback-Leibler divergence to `KL(πₐ ⊗ₘ P, πₐ × ξ)`: one along the parameter, which gives +`α * KL(μ, ξ) + (1 - α) * KL(ν, ξ)`, and one along the observation +(`klDiv_prod_eq_klDiv_snd_add`), which gives `KL(P ∘ₘ πₐ, ξ) + KL(πₐ ⊗ₘ P, πₐ × (P ∘ₘ πₐ))`. +-/ + +@[expose] public section + +open Real MeasureTheory Filter Set InformationTheory + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {𝓧 : Type*} {m𝓧 : MeasurableSpace 𝓧} {α : ℝ≥0} + +section Prior + +/-- The prior `boolMeasure α (1 - α)` on `Bool`. -/ +local notation "πₐ" => Measure.boolMeasure (α : ℝ≥0∞) ((1 - α : ℝ≥0) : ℝ≥0∞) + +private lemma boolKernel_comp_prior (μ ν : Measure 𝓧) : + Kernel.boolKernel μ ν ∘ₘ πₐ = α • μ + (1 - α) • ν := by + rw [boolKernel_comp_measure, Measure.boolMeasure_apply_true, + Measure.boolMeasure_apply_false, add_comm, Measure.coe_nnreal_smul, Measure.coe_nnreal_smul] + +/-- The Kullback-Leibler divergence between `πₐ ⊗ₘ boolKernel μ ν` and `πₐ × ξ` is +`α * KL(μ, ξ) + (1 - α) * KL(ν, ξ)`. -/ +private lemma klDiv_compProd_prior_prod (μ ν ξ : Measure 𝓧) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + [IsFiniteMeasure ξ] : + klDiv (πₐ ⊗ₘ Kernel.boolKernel μ ν) ((πₐ).prod ξ) + = α * klDiv μ ξ + (1 - α : ℝ≥0) * klDiv ν ξ := by + rw [klDiv_compProd_boolKernel_prod, Measure.boolMeasure_apply_false, + Measure.boolMeasure_apply_true] + +/-- The Jensen-Shannon divergence is the mutual information between the parameter and the +observation, for the prior `πₐ = boolMeasure α (1 - α)` and the kernel `P = boolKernel μ ν`: +`JS_α(μ, ν) = KL(πₐ ⊗ₘ P, πₐ × (P ∘ₘ πₐ))`. -/ +theorem jensenShannon_eq_klDiv_compProd (μ ν : Measure 𝓧) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] : + jensenShannon α μ ν = klDiv (πₐ ⊗ₘ Kernel.boolKernel μ ν) + ((πₐ).prod (Kernel.boolKernel μ ν ∘ₘ πₐ)) := by + rw [boolKernel_comp_prior, klDiv_compProd_prior_prod, jensenShannon] + +/-- `KL(πₐ ⊗ₘ P, πₐ × ξ) = KL(P ∘ₘ πₐ, ξ) + JS_α(μ, ν)`, by the chain rule along the +observation. -/ +private lemma klDiv_compProd_prior_prod_eq_add (hα : α ≤ 1) (μ ν ξ : Measure 𝓧) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] [IsFiniteMeasure ξ] : + klDiv (πₐ ⊗ₘ Kernel.boolKernel μ ν) ((πₐ).prod ξ) + = klDiv (α • μ + (1 - α) • ν) ξ + jensenShannon α μ ν := by + have := Measure.isProbabilityMeasure_boolMeasure_coe hα + rw [klDiv_prod_eq_klDiv_snd_add, Measure.snd_compProd, jensenShannon_eq_klDiv_compProd, + boolKernel_comp_prior] + +/-- **Compensation identity** for the Jensen-Shannon divergence: for finite measures `μ`, `ν` +and `ξ`, `α * KL(μ, ξ) + (1 - α) * KL(ν, ξ) = JS_α(μ, ν) + KL(α • μ + (1 - α) • ν, ξ)`. -/ +theorem mul_klDiv_add_mul_klDiv_eq_jensenShannon_add (hα : α ≤ 1) (μ ν ξ : Measure 𝓧) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] [IsFiniteMeasure ξ] : + α * klDiv μ ξ + (1 - α : ℝ≥0) * klDiv ν ξ + = jensenShannon α μ ν + klDiv (α • μ + (1 - α) • ν) ξ := by + rw [← klDiv_compProd_prior_prod, klDiv_compProd_prior_prod_eq_add hα, add_comm] + +/-- **Variational formula** for the Jensen-Shannon divergence: for probability measures `μ` and +`ν`, `JS_α(μ, ν) = ⨅ ξ, (α * KL(μ, ξ) + (1 - α) * KL(ν, ξ))`, where the infimum is over +probability measures `ξ`. It is attained at `ξ = α • μ + (1 - α) • ν`. -/ +theorem jensenShannon_eq_iInf_klDiv (hα : α ≤ 1) (μ ν : Measure 𝓧) [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] : + jensenShannon α μ ν + = ⨅ (ξ : Measure 𝓧) (_ : IsProbabilityMeasure ξ), + α * klDiv μ ξ + (1 - α : ℝ≥0) * klDiv ν ξ := by + refine le_antisymm (le_iInf₂ fun ξ _ ↦ ?_) ?_ + · rw [mul_klDiv_add_mul_klDiv_eq_jensenShannon_add hα] + exact le_self_add + · rw [jensenShannon] + exact iInf₂_le _ (isProbabilityMeasure_smul_add_one_sub_smul hα) + +/-- **Variational formula** for the Jensen-Shannon divergence, as an infimum of Kullback-Leibler +divergences between joint measures: `JS_α(μ, ν) = ⨅ ξ, KL(πₐ ⊗ₘ P, πₐ × ξ)`, where the infimum +is over probability measures `ξ`, `πₐ = boolMeasure α (1 - α)` and `P = boolKernel μ ν`. -/ +theorem jensenShannon_eq_iInf_klDiv_compProd (hα : α ≤ 1) (μ ν : Measure 𝓧) + [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + jensenShannon α μ ν + = ⨅ (ξ : Measure 𝓧) (_ : IsProbabilityMeasure ξ), + klDiv (πₐ ⊗ₘ Kernel.boolKernel μ ν) ((πₐ).prod ξ) := by + simp_rw [klDiv_compProd_prior_prod] + exact jensenShannon_eq_iInf_klDiv hα μ ν + +end Prior + +/-- `JS_α(μ, ν) ≤ α * KL(μ, ξ) + (1 - α) * KL(ν, ξ)` for any finite measure `ξ`. -/ +lemma jensenShannon_le_mul_klDiv_add_mul_klDiv (hα : α ≤ 1) (μ ν ξ : Measure 𝓧) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] [IsFiniteMeasure ξ] : + jensenShannon α μ ν ≤ α * klDiv μ ξ + (1 - α : ℝ≥0) * klDiv ν ξ := by + rw [mul_klDiv_add_mul_klDiv_eq_jensenShannon_add hα] + exact le_self_add + +section Pi + +variable {ι : Type*} [Fintype ι] + +/-- **Subadditivity** of the Jensen-Shannon divergence for product measures: +`JS_α(⊗ᵢ μᵢ, ⊗ᵢ νᵢ) ≤ ∑ᵢ JS_α(μᵢ, νᵢ)`. -/ +theorem jensenShannon_pi_le (hα : α ≤ 1) {𝓨 : ι → Type*} [∀ i, MeasurableSpace (𝓨 i)] + (μ ν : (i : ι) → Measure (𝓨 i)) [∀ i, IsProbabilityMeasure (μ i)] + [∀ i, IsProbabilityMeasure (ν i)] : + jensenShannon α (Measure.pi μ) (Measure.pi ν) ≤ ∑ i, jensenShannon α (μ i) (ν i) := by + have (i : ι) : IsProbabilityMeasure (α • μ i + (1 - α) • ν i) := + isProbabilityMeasure_smul_add_one_sub_smul hα + refine (jensenShannon_le_mul_klDiv_add_mul_klDiv hα _ _ + (Measure.pi fun i ↦ α • μ i + (1 - α) • ν i)).trans_eq ?_ + simp_rw [klDiv_pi, jensenShannon, Finset.mul_sum, ← Finset.sum_add_distrib] + +/-- **Subadditivity** of the Jensen-Shannon divergence for product measures: +`JS_α(μ^⊗ι, ν^⊗ι) ≤ |ι| * JS_α(μ, ν)`. -/ +theorem jensenShannon_pi_const_le (hα : α ≤ 1) (μ ν : Measure 𝓧) [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] : + jensenShannon α (Measure.pi fun _ : ι ↦ μ) (Measure.pi fun _ : ι ↦ ν) + ≤ Fintype.card ι * jensenShannon α μ ν := by + simpa [nsmul_eq_mul] using jensenShannon_pi_le hα (fun _ : ι ↦ μ) (fun _ : ι ↦ ν) + +end Pi + +end ProbabilityTheory diff --git a/Statlib/Divergence/KullbackLeibler/Basic.lean b/Statlib/Divergence/KullbackLeibler/Basic.lean index fb30323..9634b84 100644 --- a/Statlib/Divergence/KullbackLeibler/Basic.lean +++ b/Statlib/Divergence/KullbackLeibler/Basic.lean @@ -6,19 +6,25 @@ Authors: Rémy Degenne, Lorenzo Luccioli module public import Statlib.Divergence.KullbackLeibler.KLDivFun -public import Statlib.Divergence.FDiv.Basic +public import Statlib.Divergence.FDiv.Convex 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`. +This file relates it to the f-divergence for the divergence function `klDivFun`, and deduces +properties of `klDiv` from those of `fDiv`. ## Main statements -* `klDiv_eq_fDiv`: `klDiv μ ν = fDiv klDivFun μ ν` +* `klDiv_eq_fDiv`: `klDiv μ ν = fDiv klDivFun μ ν` for finite measures `μ, ν`. +* `klDiv_eq_klDiv_restrict_add_klDiv_restrict_compl`: `KL(μ, ν)` is the sum of the divergences + between the restrictions to an event and to its complement. * `measurable_klDiv`: measurability of `a ↦ klDiv (κ a) (η a)` for finite kernels `κ, η`. +* `klDiv_add_add_le`: `KL(μ₀ + μ₁, ν₀ + ν₁) ≤ KL(μ₀, ν₀) + KL(μ₁, ν₁)`. +* `klDiv_smul_add_smul_le`: **joint convexity** of the Kullback-Leibler divergence, + `KL(a • μ₀ + b • μ₁, a • ν₀ + b • ν₁) ≤ a * KL(μ₀, ν₀) + b * KL(μ₁, ν₁)`. This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli (https://github.com/RemyDegenne/testing-lower-bounds). @@ -34,16 +40,42 @@ namespace ProbabilityTheory variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} +/-- The Kullback-Leibler divergence between two finite measures is the f-divergence for the +divergence function `klDivFun`. -/ 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] +/-- The Kullback-Leibler divergence between two finite measures is the sum of the +Kullback-Leibler divergences between their restrictions to an event and to its complement. -/ +lemma klDiv_eq_klDiv_restrict_add_klDiv_restrict_compl (μ ν : Measure α) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] {s : Set α} (hs : MeasurableSet s) : + klDiv μ ν = klDiv (μ.restrict s) (ν.restrict s) + klDiv (μ.restrict sᶜ) (ν.restrict sᶜ) := by + rw [klDiv_eq_fDiv, klDiv_eq_fDiv, klDiv_eq_fDiv, + fDiv_eq_fDiv_restrict_add_fDiv_restrict_compl _ _ hs] + +/-- For finite kernels `κ, η`, the function `a ↦ klDiv (κ a) (η a)` is measurable. -/ lemma measurable_klDiv {β : Type*} [MeasurableSpace β] [CountableOrCountablyGenerated α β] (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : Measurable (fun a ↦ klDiv (κ a) (η a)) := by simp_rw [klDiv_eq_fDiv] exact measurable_fDiv _ _ +/-- The Kullback-Leibler divergence of the sum of two pairs of measures is at most the sum of the +divergences. -/ +theorem klDiv_add_add_le (μ₀ μ₁ ν₀ ν₁ : Measure α) [IsFiniteMeasure μ₀] [IsFiniteMeasure μ₁] + [IsFiniteMeasure ν₀] [IsFiniteMeasure ν₁] : + klDiv (μ₀ + μ₁) (ν₀ + ν₁) ≤ klDiv μ₀ ν₀ + klDiv μ₁ ν₁ := by + simp_rw [klDiv_eq_fDiv] + exact fDiv_add_add_le _ _ _ _ + +/-- **Joint convexity** of the Kullback-Leibler divergence. -/ +theorem klDiv_smul_add_smul_le (μ₀ μ₁ ν₀ ν₁ : Measure α) [IsFiniteMeasure μ₀] + [IsFiniteMeasure μ₁] [IsFiniteMeasure ν₀] [IsFiniteMeasure ν₁] (a b : ℝ≥0) : + klDiv (a • μ₀ + b • μ₁) (a • ν₀ + b • ν₁) ≤ a * klDiv μ₀ ν₀ + b * klDiv μ₁ ν₁ := by + simp_rw [klDiv_eq_fDiv] + exact fDiv_smul_add_smul_le _ _ _ _ a b + end ProbabilityTheory diff --git a/Statlib/Divergence/KullbackLeibler/CondKL.lean b/Statlib/Divergence/KullbackLeibler/CondKL.lean index ad69cd3..a268103 100644 --- a/Statlib/Divergence/KullbackLeibler/CondKL.lean +++ b/Statlib/Divergence/KullbackLeibler/CondKL.lean @@ -7,8 +7,10 @@ module public import Mathlib.InformationTheory.KullbackLeibler.ChainRule public import Mathlib.Probability.Kernel.Disintegration.StandardBorel +public import Mathlib.Probability.Kernel.Posterior public import Statlib.Divergence.KullbackLeibler.Basic public import Statlib.ForMathlib.InformationTheory.KullbackLeibler.Basic +public import Statlib.ForMathlib.InformationTheory.KullbackLeibler.DataProcessing public import Statlib.Divergence.FDiv.CondFDiv public import Statlib.Divergence.FDiv.CompProd @@ -18,19 +20,29 @@ public import Statlib.Divergence.FDiv.CompProd ## Main definitions * `condKL κ η μ`: the conditional Kullback-Leibler divergence of the kernels `κ` and `η` with - respect to `μ`, `∫⁻ a, klDiv (κ a) (η a) ∂μ`. + respect to `μ`, `klDiv (μ ⊗ₘ κ) (μ ⊗ₘ η)`. ## Main statements +* `condKL_eq_lintegral`: `condKL κ η μ = ∫⁻ a, klDiv (κ a) (η a) ∂μ`, if `α` is countable or `β` + is countably generated and `μ` is finite. * `condKL_ne_top_iff`: finiteness of the conditional divergence. +* `klDiv_compProd_boolKernel_prod`, `klDiv_prod_compProd_boolKernel`: for a finite measure `ρ` on + `Bool`, `KL(ρ ⊗ₘ boolKernel μ ν, ρ × ξ) = ρ {false} * KL(μ, ξ) + ρ {true} * KL(ν, ξ)`, and the + same with the arguments of `KL` swapped. * `klDiv_compProd_eq_add_condKL`, `klDiv_fst_add_condKL`: chain rules for the Kullback-Leibler divergence. +* `klDiv_compProd_eq_add_condKL_posterior`: chain rule with the posteriors (Bayesian inverses), + `KL(μ ⊗ₘ κ, ν ⊗ₘ η) = KL(κ ∘ₘ μ, η ∘ₘ ν) + KL(κ†μ, η†ν | κ ∘ₘ μ)`. * `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`. +The chain rules follow from Mathlib's chain rule `InformationTheory.klDiv_compProd_eq_add`. Those +stated with composition-products (`klDiv_compProd_eq_add_condKL`, `condKL_compProd_kernel`) hold +without assumptions on the measurable spaces. `klDiv_fst_add_condKL` and +`klDiv_compProd_eq_add_condKL_posterior` need standard Borel spaces, for the disintegration and the +posterior to exist. The results expressing the conditional divergence through the kernels `κ a` +and `η a` need `CountableOrCountablyGenerated` assumptions. This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli (https://github.com/RemyDegenne/testing-lower-bounds). @@ -56,27 +68,71 @@ 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μ. --/ +/-- The Kullback-Leibler divergence between the kernels `κ` and `η` conditional to the measure `μ`, +defined as `klDiv (μ ⊗ₘ κ) (μ ⊗ₘ η)`. + +If `α` is countable or `β` is countably generated, `μ` is finite and `κ`, `η` are finite, it is +equal to `∫⁻ a, klDiv (κ a) (η a) ∂μ` (`condKL_eq_lintegral`). See also +`toReal_condKL_eq_integral` for its real-valued version. -/ noncomputable def condKL (κ η : Kernel α β) (μ : Measure α) : ℝ≥0∞ := - ∫⁻ a, klDiv (κ a) (η a) ∂μ + klDiv (μ ⊗ₘ κ) (μ ⊗ₘ η) + +lemma condKL_eq_condFDiv [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] : + condKL κ η μ = condFDiv klDivFun κ η μ := + klDiv_eq_fDiv + +@[simp] +lemma condKL_self (κ : Kernel α β) (μ : Measure α) [SigmaFinite μ] [IsFiniteKernel κ] : + condKL κ κ μ = 0 := + klDiv_self _ + +@[simp] +lemma condKL_zero_left [IsFiniteMeasure μ] [IsFiniteKernel η] : + condKL 0 η μ = ∫⁻ a, η a Set.univ ∂μ := by + rw [condKL, Measure.compProd_zero_right, klDiv_zero_left, Measure.compProd_apply .univ] + simp + +lemma condKL_zero_right [SFinite μ] [IsSFiniteKernel κ] (h : ∃ᵐ a ∂μ, κ a ≠ 0) : + condKL κ 0 μ = ∞ := by + -- `μ ⊗ₘ κ` is not zero since its mass is `∫⁻ a, κ a univ ∂μ` + have h_ne : μ ⊗ₘ κ ≠ 0 := by + intro h0 + refine h ?_ + have h_univ : ∫⁻ a, κ a .univ ∂μ = 0 := by + have h_univ := congrArg (fun ρ : Measure (α × β) ↦ ρ .univ) h0 + simpa [Measure.compProd_apply MeasurableSet.univ] using h_univ + filter_upwards [(lintegral_eq_zero_iff (κ.measurable_coe .univ)).mp h_univ] with a ha + simpa using ha + have : NeZero (μ ⊗ₘ κ) := ⟨h_ne⟩ + rw [condKL, Measure.compProd_zero_right, klDiv_zero_right] + +@[simp] +lemma condKL_zero_measure : condKL κ η 0 = 0 := by simp [condKL] -lemma condKL_eq_condFDiv [IsFiniteKernel κ] [IsFiniteKernel η] : - condKL κ η μ = condFDiv klDivFun κ η μ := by - simp_rw [condKL, condFDiv, klDiv_eq_fDiv] +@[simp] +lemma condKL_isEmpty_left [IsEmpty α] : condKL κ η μ = 0 := by + simp [condKL, Subsingleton.elim (μ ⊗ₘ κ) 0, Subsingleton.elim (μ ⊗ₘ η) 0] + +@[simp] +lemma condKL_const {ξ : Measure β} [IsFiniteMeasure ξ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + condKL (Kernel.const β μ) (Kernel.const β ν) ξ = (klDiv μ ν) * ξ .univ := by + rw [condKL_eq_condFDiv, klDiv_eq_fDiv] + exact condFDiv_const section CondKLEq -variable [CountableOrCountablyGenerated α β] [IsFiniteKernel κ] [IsFiniteKernel η] +variable [CountableOrCountablyGenerated α β] [IsFiniteMeasure μ] [IsFiniteKernel κ] + [IsFiniteKernel η] + +/-- The conditional KL divergence is the integral of the KL divergences between the kernels. -/ +lemma condKL_eq_lintegral : condKL κ η μ = ∫⁻ a, klDiv (κ a) (η a) ∂μ := by + simp_rw [condKL_eq_condFDiv, condFDiv_eq_lintegral, klDiv_eq_fDiv] @[simp] lemma condKL_of_not_ae_ne_top (h : ¬ ∀ᵐ a ∂μ, klDiv (κ a) (η a) ≠ ∞) : condKL κ η μ = ∞ := by - rw [condKL] + rw [condKL_eq_lintegral] by_contra h' exact h ((ae_lt_top (measurable_klDiv _ _) h').mono fun x hx ↦ hx.ne) @@ -90,7 +146,7 @@ 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] + rw [← and_assoc, ← klDiv_ae_ne_top_iff, condKL_eq_lintegral] 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 @@ -106,60 +162,47 @@ lemma condKL_eq_top_iff : lemma toReal_condKL_eq_integral (h : condKL κ η μ ≠ ∞) : (condKL κ η μ).toReal = ∫ a, (klDiv (κ a) (η a)).toReal ∂μ := by - rw [condKL, integral_toReal (measurable_klDiv _ _).aemeasurable] + rw [condKL_eq_lintegral] at h ⊢ + rw [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 κ] +lemma condKL_measure_compProd [CountableOrCountablyGenerated (α × β) γ] [IsFiniteMeasure μ] + {ξ : Kernel α β} [IsFiniteKernel ξ] {κ η : 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 μ κ η +/-- The Kullback-Leibler divergence between `ρ ⊗ₘ boolKernel μ ν` and `ρ × ξ` is the sum of +`KL(μ, ξ)` and `KL(ν, ξ)` weighted by `ρ {false}` and `ρ {true}`. -/ +lemma klDiv_compProd_boolKernel_prod (ρ : Measure Bool) [IsFiniteMeasure ρ] (μ ν ξ : Measure α) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] [IsFiniteMeasure ξ] : + klDiv (ρ ⊗ₘ Kernel.boolKernel μ ν) (ρ.prod ξ) + = ρ {false} * klDiv μ ξ + ρ {true} * klDiv ν ξ := by + rw [← Measure.compProd_const, ← condKL, condKL_eq_lintegral, lintegral_bool] + simp [mul_comm] + +/-- The Kullback-Leibler divergence between `ρ × ξ` and `ρ ⊗ₘ boolKernel μ ν` is the sum of +`KL(ξ, μ)` and `KL(ξ, ν)` weighted by `ρ {false}` and `ρ {true}`. -/ +lemma klDiv_prod_compProd_boolKernel (ρ : Measure Bool) [IsFiniteMeasure ρ] (μ ν ξ : Measure α) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] [IsFiniteMeasure ξ] : + klDiv (ρ.prod ξ) (ρ ⊗ₘ Kernel.boolKernel μ ν) + = ρ {false} * klDiv ξ μ + ρ {true} * klDiv ξ ν := by + rw [← Measure.compProd_const, ← condKL, condKL_eq_lintegral, lintegral_bool] + simp [mul_comm] 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] +lemma klDiv_compProd_eq_add_condKL [IsMarkovKernel κ] [IsMarkovKernel η] [IsFiniteMeasure μ] + [IsFiniteMeasure ν] : + klDiv (μ ⊗ₘ κ) (ν ⊗ₘ η) = klDiv μ ν + condKL κ η μ := + klDiv_compProd_eq_add μ ν κ η /-- The **chain rule** for the KL divergence. -/ lemma klDiv_fst_add_condKL [StandardBorelSpace β] [Nonempty β] {μ ν : Measure (α × β)} @@ -167,19 +210,25 @@ lemma klDiv_fst_add_condKL [StandardBorelSpace β] [Nonempty β] {μ ν : Measur 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 α β} +/-- **Chain rule** for the KL divergence, with the posteriors (Bayesian inverses) `κ†μ` and `η†ν`: +`KL(μ ⊗ₘ κ, ν ⊗ₘ η) = KL(κ ∘ₘ μ, η ∘ₘ ν) + KL(κ†μ, η†ν | κ ∘ₘ μ)`. -/ +lemma klDiv_compProd_eq_add_condKL_posterior [StandardBorelSpace α] [Nonempty α] + [IsFiniteMeasure μ] [IsFiniteMeasure ν] [IsFiniteKernel κ] [IsFiniteKernel η] : + klDiv (μ ⊗ₘ κ) (ν ⊗ₘ η) = klDiv (κ ∘ₘ μ) (η ∘ₘ ν) + condKL (κ†μ) (η†ν) (κ ∘ₘ μ) := by + rw [← klDiv_map_swap, ← compProd_posterior_eq_map_swap, ← compProd_posterior_eq_map_swap, + klDiv_compProd_eq_add_condKL] + +/-- The **chain rule** for the conditional KL divergence: +`KL(κ₁ ⊗ κ₂, η₁ ⊗ η₂ | μ) = KL(κ₁, η₁ | μ) + KL(κ₂, η₂ | μ ⊗ κ₁)`. That is, +`KL(μ ⊗ (κ₁ ⊗ κ₂), μ ⊗ (η₁ ⊗ η₂)) = KL(μ ⊗ κ₁, μ ⊗ η₁) + KL((μ ⊗ κ₁) ⊗ κ₂, (μ ⊗ κ₁) ⊗ η₂)`. -/ +lemma condKL_compProd_kernel [IsFiniteMeasure μ] {κ₁ η₁ : Kernel α β} {κ₂ η₂ : Kernel (α × β) γ} [IsFiniteKernel κ₁] [IsFiniteKernel η₁] [IsMarkovKernel κ₂] - [IsMarkovKernel η₂] [SFinite μ] : + [IsMarkovKernel η₂] : 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] + simp only [condKL] + rw [← Measure.compProd_assoc', ← Measure.compProd_assoc', + klDiv_map_measurableEmbedding _ _ MeasurableEquiv.prodAssoc.measurableEmbedding, + klDiv_compProd_eq_add] end ChainRule @@ -191,8 +240,9 @@ section DataProcessingInequality variable {β : Type*} {mβ : MeasurableSpace β} {κ η : Kernel α β} -lemma klDiv_comp_left_le [CountableOrCountablyGenerated α β] - (μ : Measure α) [IsFiniteMeasure μ] +/-- **Data-processing inequality**: composing a measure with two kernels decreases their +conditional KL divergence. -/ +lemma klDiv_comp_left_le (μ : Measure α) [IsFiniteMeasure μ] (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : klDiv (κ ∘ₘ μ) (η ∘ₘ μ) ≤ condKL κ η μ := by rw [klDiv_eq_fDiv, condKL_eq_condFDiv] @@ -208,17 +258,7 @@ variable {β : Type*} {mβ : MeasurableSpace β} 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] + rw [klDiv_eq_fDiv, klDiv_eq_fDiv, fDiv_prod_right] lemma klDiv_prod_two' {ξ ψ : Measure β} [IsProbabilityMeasure ξ] [IsProbabilityMeasure ψ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] : diff --git a/Statlib/Divergence/KullbackLeibler/Estimation.lean b/Statlib/Divergence/KullbackLeibler/Estimation.lean new file mode 100644 index 0000000..0164987 --- /dev/null +++ b/Statlib/Divergence/KullbackLeibler/Estimation.lean @@ -0,0 +1,158 @@ +/- +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.ChainRule +public import Statlib.Divergence.FDiv.Estimation +public import Statlib.Divergence.KullbackLeibler.Basic +public import Statlib.ForMathlib.InformationTheory.KullbackLeibler.Bernoulli +public import Statlib.ForMathlib.Probability.Kernel.Basic +public import Statlib.Testing.Binary + +/-! +# Lower bounds on the Bayes risk from the Kullback-Leibler divergence + +We specialize the lower bound of `Statlib.Divergence.FDiv.Estimation` to the Kullback-Leibler +divergence: for a loss with values in `[0, 1]`, priors `π, ξ` and kernels `P, Q`, +`kl(R_π^Q, R_ξ^P) ≤ KL(π ⊗ₘ Q, ξ ⊗ₘ P)`, where `kl` is the binary Kullback-Leibler divergence +`klBerReal`. We then derive the corresponding bounds for simple binary hypothesis testing. + +## Main statements + +* `klDiv_bernoulliMeasure_bayesRisk_le`: the Kullback-Leibler divergence between the Bernoulli + distributions with parameters `R_π^Q` and `R_ξ^P` is at most `KL(π ⊗ₘ Q, ξ ⊗ₘ P)`. +* `ofReal_klBerReal_bayesRisk_le_klDiv`: `kl(R_π^Q, R_ξ^P) ≤ KL(π ⊗ₘ Q, ξ ⊗ₘ P)`. +* `ofReal_klBerReal_bayesRisk_le_klDiv_add_klDiv`: + `kl(R_π^Q, R_ξ^P) ≤ KL(π ⊗ₘ Q, π ⊗ₘ P) + KL(π, ξ)`. +* `ofReal_klBerReal_bayesBinaryRisk_le_klDiv`, + `ofReal_klBerReal_bayesBinaryRisk_le_klDiv_add_klDiv`: the same bounds for simple binary + hypothesis testing. +* `ofReal_klBerReal_bayesBinaryRisk_min_le_klDiv_compProd_prod_add`, + `ofReal_klBerReal_min_bayesBinaryRisk_le_klDiv_prod_compProd_add`: comparison of a binary + hypothesis testing problem with the trivial problem in which both hypotheses have the same law + `ζ`. These are the main tools for the binary Fano inequality (a bound in terms of the + Jensen-Shannon divergence) and for the lower bound on the Bayes binary risk in terms of the Rényi + divergence, in `Statlib.Testing.Fano`. + +## Implementation notes + +The Bayes risks are real numbers in `[0, 1]` obtained with `ENNReal.toReal`. The binary +Kullback-Leibler divergence `klBerReal p q` is the right value only for `q ∈ (0, 1)`, but its +`ENNReal.ofReal` is always a lower bound of the Kullback-Leibler divergence between the Bernoulli +distributions (`ofReal_klBerReal_le_klDiv_bernoulliMeasure`), so no assumption is needed. +-/ + +@[expose] public section + +open MeasureTheory Function InformationTheory unitInterval + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +variable {Θ 𝓧 𝓨 : Type*} {mΘ : MeasurableSpace Θ} {m𝓧 : MeasurableSpace 𝓧} + {m𝓨 : MeasurableSpace 𝓨} {ℓ : Θ → 𝓨 → ℝ≥0∞} + +section Estimation + +variable (π ξ : Measure Θ) [IsProbabilityMeasure π] [IsProbabilityMeasure ξ] + (P Q : Kernel Θ 𝓧) [IsMarkovKernel P] [IsMarkovKernel Q] + +variable {π ξ P Q} in +/-- **Lower bound on the Kullback-Leibler divergence from the Bayes risks**, with Bernoulli +distributions: for a loss with values in `[0, 1]`, the Kullback-Leibler divergence between the +Bernoulli distributions with parameters the Bayes risks `R_π^Q` and `R_ξ^P` is at most +`KL(π ⊗ₘ Q, ξ ⊗ₘ P)`. -/ +theorem klDiv_bernoulliMeasure_bayesRisk_le (hℓ : Measurable (uncurry ℓ)) + (hℓ1 : ∀ θ y, ℓ θ y ≤ 1) {p q : I} (hp : ENNReal.ofReal p = bayesRisk ℓ Q π) + (hq : ENNReal.ofReal q = bayesRisk ℓ P ξ) : + klDiv Ber(true, false, p) Ber(true, false, q) ≤ klDiv (π ⊗ₘ Q) (ξ ⊗ₘ P) := by + rw [klDiv_eq_fDiv, klDiv_eq_fDiv] + exact fDiv_bernoulliMeasure_bayesRisk_le hℓ hℓ1 hp hq + +/-- **Lower bound on the Kullback-Leibler divergence from the Bayes risks**: for a loss with values +in `[0, 1]`, `kl(R_π^Q, R_ξ^P) ≤ KL(π ⊗ₘ Q, ξ ⊗ₘ P)`, in which `kl` is the binary Kullback-Leibler +divergence. -/ +theorem ofReal_klBerReal_bayesRisk_le_klDiv (hℓ : Measurable (uncurry ℓ)) + (hℓ1 : ∀ θ y, ℓ θ y ≤ 1) : + ENNReal.ofReal (klBerReal (bayesRisk ℓ Q π).toReal (bayesRisk ℓ P ξ).toReal) + ≤ klDiv (π ⊗ₘ Q) (ξ ⊗ₘ P) := by + rcases isEmpty_or_nonempty 𝓨 with h𝓨 | h𝓨 + · -- there is no estimator: both risks are `0` or both are `∞` + have h_eq : bayesRisk ℓ Q π = bayesRisk ℓ P ξ := by + rcases isEmpty_or_nonempty 𝓧 with h𝓧 | h𝓧 <;> simp + simp [h_eq] + have hQ : bayesRisk ℓ Q π ≤ 1 := bayesRisk_le_one hℓ1 Q π + have hP : bayesRisk ℓ P ξ ≤ 1 := bayesRisk_le_one hℓ1 P ξ + calc ENNReal.ofReal (klBerReal (bayesRisk ℓ Q π).toReal (bayesRisk ℓ P ξ).toReal) + _ ≤ klDiv Ber(true, false, ⟨_, ENNReal.toReal_mem_unitInterval hQ⟩) + Ber(true, false, ⟨_, ENNReal.toReal_mem_unitInterval hP⟩) := + ofReal_klBerReal_le_klDiv_bernoulliMeasure (by decide) + ⟨_, ENNReal.toReal_mem_unitInterval hQ⟩ ⟨_, ENNReal.toReal_mem_unitInterval hP⟩ + _ ≤ klDiv (π ⊗ₘ Q) (ξ ⊗ₘ P) := + klDiv_bernoulliMeasure_bayesRisk_le hℓ hℓ1 + (ENNReal.ofReal_toReal (ne_top_of_le_ne_top ENNReal.one_ne_top hQ)) + (ENNReal.ofReal_toReal (ne_top_of_le_ne_top ENNReal.one_ne_top hP)) + +/-- **Lower bound on the Kullback-Leibler divergence from the Bayes risks**, with the same prior: +for a loss with values in `[0, 1]`, `kl(R_π^Q, R_ξ^P) ≤ KL(π ⊗ₘ Q, π ⊗ₘ P) + KL(π, ξ)`. -/ +theorem ofReal_klBerReal_bayesRisk_le_klDiv_add_klDiv (hℓ : Measurable (uncurry ℓ)) + (hℓ1 : ∀ θ y, ℓ θ y ≤ 1) : + ENNReal.ofReal (klBerReal (bayesRisk ℓ Q π).toReal (bayesRisk ℓ P ξ).toReal) + ≤ klDiv (π ⊗ₘ Q) (π ⊗ₘ P) + klDiv π ξ := by + refine (ofReal_klBerReal_bayesRisk_le_klDiv π ξ P Q hℓ hℓ1).trans_eq ?_ + rw [klDiv_compProd_eq_add, add_comm] + +end Estimation + +section Binary + +variable (μ ν μ' ν' : Measure 𝓧) [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + [IsProbabilityMeasure μ'] [IsProbabilityMeasure ν'] + (π ξ : Measure Bool) [IsProbabilityMeasure π] [IsProbabilityMeasure ξ] + +/-- **Lower bound on the Kullback-Leibler divergence from the Bayes binary risks**: +`kl(B_π(μ, ν), B_ξ(μ', ν')) ≤ KL(π ⊗ₘ boolKernel μ ν, ξ ⊗ₘ boolKernel μ' ν')`. -/ +theorem ofReal_klBerReal_bayesBinaryRisk_le_klDiv : + ENNReal.ofReal (klBerReal (bayesBinaryRisk μ ν π).toReal (bayesBinaryRisk μ' ν' ξ).toReal) + ≤ klDiv (π ⊗ₘ Kernel.boolKernel μ ν) (ξ ⊗ₘ Kernel.boolKernel μ' ν') := + ofReal_klBerReal_bayesRisk_le_klDiv π ξ _ _ measurable_zeroOneLoss zeroOneLoss_le_one + +/-- **Lower bound on the Kullback-Leibler divergence from the Bayes binary risks**, with the same +prior: `kl(B_π(μ, ν), B_ξ(μ', ν')) ≤ KL(π ⊗ₘ boolKernel μ ν, π ⊗ₘ boolKernel μ' ν') + KL(π, ξ)`. -/ +theorem ofReal_klBerReal_bayesBinaryRisk_le_klDiv_add_klDiv : + ENNReal.ofReal (klBerReal (bayesBinaryRisk μ ν π).toReal (bayesBinaryRisk μ' ν' ξ).toReal) + ≤ klDiv (π ⊗ₘ Kernel.boolKernel μ ν) (π ⊗ₘ Kernel.boolKernel μ' ν') + klDiv π ξ := by + refine (ofReal_klBerReal_bayesBinaryRisk_le_klDiv μ ν μ' ν' π ξ).trans_eq ?_ + rw [klDiv_compProd_eq_add, add_comm] + +/-- Comparison of the binary hypothesis testing problem between `μ` and `ν` with the trivial problem +in which both hypotheses have law `ζ`: +`kl(B_π(μ, ν), min(ξ₀, ξ₁)) ≤ KL(π ⊗ₘ boolKernel μ ν, π × ζ) + KL(π, ξ)`. +This is the main tool in the proof of the binary Fano inequality. -/ +theorem ofReal_klBerReal_bayesBinaryRisk_min_le_klDiv_compProd_prod_add (ζ : Measure 𝓧) + [IsProbabilityMeasure ζ] : + ENNReal.ofReal (klBerReal (bayesBinaryRisk μ ν π).toReal (min (ξ {false}) (ξ {true})).toReal) + ≤ klDiv (π ⊗ₘ Kernel.boolKernel μ ν) (π.prod ζ) + klDiv π ξ := by + have h := ofReal_klBerReal_bayesBinaryRisk_le_klDiv_add_klDiv μ ν ζ ζ π ξ + rwa [bayesBinaryRisk_self, measure_univ, mul_one, Kernel.boolKernel_self, + Measure.compProd_const] at h + +/-- Comparison of the trivial binary hypothesis testing problem in which both hypotheses have law +`ζ` with the problem between `μ` and `ν`: +`kl(min(π₀, π₁), B_ξ(μ, ν)) ≤ KL(π × ζ, π ⊗ₘ boolKernel μ ν) + KL(π, ξ)`. +This is the main tool to bound the Bayes binary risk with the Rényi divergence. -/ +theorem ofReal_klBerReal_min_bayesBinaryRisk_le_klDiv_prod_compProd_add (ζ : Measure 𝓧) + [IsProbabilityMeasure ζ] : + ENNReal.ofReal (klBerReal (min (π {false}) (π {true})).toReal (bayesBinaryRisk μ ν ξ).toReal) + ≤ klDiv (π.prod ζ) (π ⊗ₘ Kernel.boolKernel μ ν) + klDiv π ξ := by + have h := ofReal_klBerReal_bayesBinaryRisk_le_klDiv_add_klDiv ζ ζ μ ν π ξ + rwa [bayesBinaryRisk_self, measure_univ, mul_one, Kernel.boolKernel_self, + Measure.compProd_const] at h + +end Binary + +end ProbabilityTheory diff --git a/Statlib/Divergence/KullbackLeibler/Event.lean b/Statlib/Divergence/KullbackLeibler/Event.lean new file mode 100644 index 0000000..db3d070 --- /dev/null +++ b/Statlib/Divergence/KullbackLeibler/Event.lean @@ -0,0 +1,52 @@ +/- +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.KullbackLeibler.Basic +public import Statlib.ForMathlib.InformationTheory.KullbackLeibler.Basic +public import Statlib.ForMathlib.MeasureTheory.Measure.Bool + +/-! +# The Kullback-Leibler divergence and events + +We decompose the Kullback-Leibler divergence between two finite measures along an event `s` and its +complement, in terms of the measures conditioned on `s` and on `sᶜ`. + +## Main statements + +* `klDiv_eq_klDiv_boolMeasure_add_add`: **chain rule for an event**. For finite measures `μ, ν` + and an event `s`, `KL(μ, ν)` is the Kullback-Leibler divergence between the laws of the indicator + of `s`, plus `μ(s) KL(μ[|s], ν[|s]) + μ(sᶜ) KL(μ[|sᶜ], ν[|sᶜ])`, in which `μ[|s]` is the measure + `μ` conditioned on `s`. +-/ + +@[expose] public section + +open MeasureTheory Set InformationTheory + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {s : Set α} + +/-- **Chain rule for an event**: for finite measures `μ, ν` and an event `s`, `KL(μ, ν)` is the +Kullback-Leibler divergence between the laws of the indicator of `s` under `μ` and `ν`, plus +`μ(s) KL(μ[|s], ν[|s]) + μ(sᶜ) KL(μ[|sᶜ], ν[|sᶜ])`. -/ +theorem klDiv_eq_klDiv_boolMeasure_add_add [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (hs : MeasurableSet s) : + klDiv μ ν = klDiv (Measure.boolMeasure (μ sᶜ) (μ s)) (Measure.boolMeasure (ν sᶜ) (ν s)) + + μ s * klDiv μ[|s] ν[|s] + μ sᶜ * klDiv μ[|sᶜ] ν[|sᶜ] := by + have := Measure.isFiniteMeasure_boolMeasure (measure_ne_top μ sᶜ) (measure_ne_top μ s) + have := Measure.isFiniteMeasure_boolMeasure (measure_ne_top ν sᶜ) (measure_ne_top ν s) + rw [klDiv_eq_klDiv_restrict_add_klDiv_restrict_compl μ ν hs, + klDiv_eq_klDiv_restrict_add_klDiv_restrict_compl _ _ (measurableSet_singleton true), + Measure.restrict_boolMeasure_true, Measure.restrict_boolMeasure_true, + Measure.restrict_boolMeasure_compl_true, Measure.restrict_boolMeasure_compl_true, + klDiv_restrict_eq_add s (Measure.dirac true), klDiv_restrict_eq_add sᶜ (Measure.dirac false)] + ring + +end ProbabilityTheory diff --git a/Statlib/Divergence/MutualInformation/Basic.lean b/Statlib/Divergence/MutualInformation/Basic.lean new file mode 100644 index 0000000..3f62577 --- /dev/null +++ b/Statlib/Divergence/MutualInformation/Basic.lean @@ -0,0 +1,124 @@ +/- +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.KullbackLeibler.CondKL +public import Statlib.ForMathlib.InformationTheory.KullbackLeibler.ChainRule +public import Statlib.ForMathlib.InformationTheory.KullbackLeibler.DataProcessing +public import Statlib.ForMathlib.Probability.Kernel.Composition.Lemmas + +/-! +# Mutual information + +We define the mutual information `mutualInfo ρ = klDiv ρ (ρ.fst.prod ρ.snd)` of a measure `ρ` on a +product space and prove its basic properties. + +## Main definitions + +* `mutualInfo ρ`: the mutual information between the two components of a measure `ρ` on `α × β`, + the Kullback-Leibler divergence between `ρ` and the product of its marginals. +* `condMutualInfo κ ν`: the conditional mutual information + `KL(ν ⊗ κ, ν ⊗ (κ.fst ×ₖ κ.snd))` of a kernel `κ : γ ⇝ α × β` with respect to a measure `ν`. + +## Main statements + +* `mutualInfo_compProd`: `I(μ ⊗ κ) = KL(μ ⊗ κ, μ × (κ ∘ μ))`. +* `condMutualInfo_eq_condKL`: `I(κ | ν) = KL(κ, κ.fst ×ₖ κ.snd | ν)`. +* `condMutualInfo_eq_lintegral`: `I(κ | ν) = ∫⁻ z, I(κ z) ∂ν`, if `γ` is countable or `α × β` is + countably generated and `ν` is finite. +* `mutualInfo_compProd_eq_condKL`: `I(μ ⊗ κ) = KL(κ, κ ∘ μ | μ)`. +* `mutualInfo_map_swap`: the mutual information is symmetric. +* `mutualInfo_parallelComp_comp_le`: **data-processing inequality**, + `I((κ ∥ η) ∘ ρ) ≤ I(ρ)` for Markov kernels `κ, η`. +* `mutualInfo_compProd_comp_le`: for random variables `X → Y → Z`, `I(X, Z) ≤ I(X, Y)`. +* `klDiv_compProd_prod_eq_mutualInfo_add`: **compensation identity**, for a probability measure + `μ` and a finite measure `ξ`, `KL(μ ⊗ κ, μ × ξ) = I(μ ⊗ κ) + KL(κ ∘ μ, ξ)`. +-/ + +@[expose] public section + +open MeasureTheory InformationTheory ProbabilityTheory MeasurableSpace + +open scoped ENNReal + +variable {α β γ δ : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} + {mγ : MeasurableSpace γ} {mδ : MeasurableSpace δ} + +namespace ProbabilityTheory + +/-- The mutual information between the two components of a joint measure. -/ +noncomputable def mutualInfo (μ : Measure (α × β)) : ℝ≥0∞ := + klDiv μ (μ.fst.prod μ.snd) + +/-- The mutual information of `μ ⊗ₘ κ` for a Markov kernel `κ` is the Kullback-Leibler divergence +between `μ ⊗ₘ κ` and the product of `μ` and `κ ∘ₘ μ`. -/ +lemma mutualInfo_compProd {μ : Measure α} [SFinite μ] {κ : Kernel α β} [IsMarkovKernel κ] : + mutualInfo (μ ⊗ₘ κ) = klDiv (μ ⊗ₘ κ) (μ.prod (κ ∘ₘ μ)) := by + rw [mutualInfo, Measure.fst_compProd, Measure.snd_compProd] + +/-- The conditional mutual information of a kernel `κ : γ ⇝ α × β` with respect to a measure `ν` +on `γ`, defined as `klDiv (ν ⊗ₘ κ) (ν ⊗ₘ (κ.fst ×ₖ κ.snd))`. In terms of random variables, +`I(X; Y | Z) = KL(P_{Z,X,Y}, P_Z ⊗ (P_{X|Z} × P_{Y|Z}))`. It is the conditional Kullback-Leibler +divergence between `κ` and the product of its marginals (`condMutualInfo_eq_condKL`). + +If `γ` is countable or `α × β` is countably generated, `ν` is finite and `κ` is finite, it is equal +to `∫⁻ z, mutualInfo (κ z) ∂ν` (`condMutualInfo_eq_lintegral`). -/ +noncomputable +def condMutualInfo (κ : Kernel γ (α × β)) (ν : Measure γ) : ℝ≥0∞ := + klDiv (ν ⊗ₘ κ) (ν ⊗ₘ (κ.fst ×ₖ κ.snd)) + +/-- The conditional mutual information of `κ` is the conditional Kullback-Leibler divergence +between `κ` and the product of its marginals. -/ +lemma condMutualInfo_eq_condKL (κ : Kernel γ (α × β)) (ν : Measure γ) : + condMutualInfo κ ν = condKL κ (κ.fst ×ₖ κ.snd) ν := rfl + +/-- The conditional mutual information is the integral of the mutual information of the measures +`κ z`. -/ +lemma condMutualInfo_eq_lintegral [CountableOrCountablyGenerated γ (α × β)] + (κ : Kernel γ (α × β)) [IsFiniteKernel κ] (ν : Measure γ) [IsFiniteMeasure ν] : + condMutualInfo κ ν = ∫⁻ z, mutualInfo (κ z) ∂ν := by + simp_rw [condMutualInfo_eq_condKL, condKL_eq_lintegral, mutualInfo, Kernel.prod_apply, + Kernel.fst_apply, Kernel.snd_apply, Measure.fst, Measure.snd] + +/-- The mutual information of `μ ⊗ₘ κ` is the conditional Kullback-Leibler divergence between `κ` +and the constant kernel with value `κ ∘ₘ μ`. -/ +lemma mutualInfo_compProd_eq_condKL {μ : Measure α} [SFinite μ] {κ : Kernel α β} + [IsMarkovKernel κ] : + mutualInfo (μ ⊗ₘ κ) = condKL κ (Kernel.const α (κ ∘ₘ μ)) μ := by + rw [mutualInfo_compProd, ← Measure.compProd_const, ← condKL] + +/-- The mutual information is symmetric. -/ +lemma mutualInfo_map_swap (ρ : Measure (α × β)) [IsFiniteMeasure ρ] : + mutualInfo (ρ.map Prod.swap) = mutualInfo ρ := by + rw [mutualInfo, mutualInfo, Measure.fst_map_swap, Measure.snd_map_swap, ← Measure.prod_swap, + klDiv_map_swap] + +/-- **Data-processing inequality** for the mutual information: processing each component of a +pair of random variables by a Markov kernel cannot increase their mutual information. -/ +theorem mutualInfo_parallelComp_comp_le (ρ : Measure (α × β)) [IsFiniteMeasure ρ] + (κ : Kernel α γ) [IsMarkovKernel κ] (η : Kernel β δ) [IsMarkovKernel η] : + mutualInfo ((κ ∥ₖ η) ∘ₘ ρ) ≤ mutualInfo ρ := by + rw [mutualInfo, mutualInfo, Measure.fst_parallelComp_comp, Measure.snd_parallelComp_comp, + Measure.prod_comp_comp] + exact klDiv_comp_right_le _ _ _ + +/-- If three random variables have the dependency structure `X → Y → Z`, with `μ` the law of `X`, +`μ ⊗ₘ κ` the law of `(X, Y)` and `μ ⊗ₘ (η ∘ₖ κ)` the law of `(X, Z)`, then +`I(X, Z) ≤ I(X, Y)`. -/ +lemma mutualInfo_compProd_comp_le (μ : Measure α) [IsFiniteMeasure μ] (κ : Kernel α β) + [IsFiniteKernel κ] (η : Kernel β γ) [IsMarkovKernel η] : + mutualInfo (μ ⊗ₘ (η ∘ₖ κ)) ≤ mutualInfo (μ ⊗ₘ κ) := by + rw [← Measure.parallelComp_comp_compProd] + exact mutualInfo_parallelComp_comp_le _ _ _ + +/-- **Compensation identity**: for a probability measure `μ`, a Markov kernel `κ` and a finite +measure `ξ`, `KL(μ ⊗ κ, μ × ξ) = I(μ ⊗ κ) + KL(κ ∘ μ, ξ)`. -/ +lemma klDiv_compProd_prod_eq_mutualInfo_add (μ : Measure α) [IsProbabilityMeasure μ] + (κ : Kernel α β) [IsMarkovKernel κ] (ξ : Measure β) [IsFiniteMeasure ξ] : + klDiv (μ ⊗ₘ κ) (μ.prod ξ) = mutualInfo (μ ⊗ₘ κ) + klDiv (κ ∘ₘ μ) ξ := by + rw [klDiv_prod_eq_klDiv_snd_add, Measure.snd_compProd, mutualInfo_compProd, add_comm] + +end ProbabilityTheory diff --git a/Statlib/Divergence/MutualInformation/Bool.lean b/Statlib/Divergence/MutualInformation/Bool.lean new file mode 100644 index 0000000..9dff490 --- /dev/null +++ b/Statlib/Divergence/MutualInformation/Bool.lean @@ -0,0 +1,110 @@ +/- +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.JensenShannon.Variational +public import Statlib.Divergence.MutualInformation.LeftRight +public import Statlib.Divergence.Renyi.Variational + +/-! +# Mutual informations for a prior on `Bool` + +Let `π` be a probability measure on `Bool` and `κ : Bool ⇝ 𝓧` be a Markov kernel, and write +`π₀ = π {false}`. The Kullback-Leibler mutual informations of `π` and `κ` are divergences +between `κ false` and `κ true`: +* the mutual information `I(π ⊗ₘ κ)` and the right Kullback-Leibler mutual information + `I^R_KL(π, κ)` are the Jensen-Shannon divergence `JS_{π₀}(κ false, κ true)`; +* if `π₀ ≠ 0`, the left Kullback-Leibler mutual information `I^L_KL(π, κ)` is + `(1 - π₀) * R_{π₀}(κ false, κ true)`, where `R` is the Rényi divergence. + +## Main statements + +* `mutualInfo_compProd_boolKernel`: with `πₐ = boolMeasure α (1 - α)`, + `I(πₐ ⊗ₘ boolKernel μ ν) = JS_α(μ, ν)`. +* `mutualInfo_compProd_bool`: `I(π ⊗ₘ κ) = JS_{π₀}(κ false, κ true)`. +* `mutualInfoRight_klDivFun_bool`: `I^R_KL(π, κ) = JS_{π₀}(κ false, κ true)`. +* `mutualInfoLeft_klDivFun_bool`: for `π₀ ≠ 0`, `I^L_KL(π, κ) = π {true} * R_{π₀}(κ false, κ true)`. + +## Implementation notes + +The same identities for the prior `πₐ = boolMeasure α (1 - α)` and the kernel `boolKernel μ ν`, +with the left and right mutual informations unfolded, are `jensenShannon_eq_iInf_klDiv_compProd` +and `mul_renyiDiv_eq_iInf_klDiv_prod`. +-/ + +@[expose] public section + +open MeasureTheory InformationTheory + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +variable {𝓧 : Type*} {m𝓧 : MeasurableSpace 𝓧} + +section JensenShannon + +variable {α : ℝ≥0} + +/-- The prior on `Bool` with mass `α` at `false` and `1 - α` at `true`. -/ +local notation "πₐ" => Measure.boolMeasure (α : ℝ≥0∞) ((1 - α : ℝ≥0) : ℝ≥0∞) + +/-- The mutual information of `πₐ ⊗ₘ boolKernel μ ν` is the Jensen-Shannon divergence +`JS_α(μ, ν)`. -/ +theorem mutualInfo_compProd_boolKernel (μ ν : Measure 𝓧) [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] : + mutualInfo (πₐ ⊗ₘ Kernel.boolKernel μ ν) = jensenShannon α μ ν := by + rw [mutualInfo_compProd, jensenShannon_eq_klDiv_compProd] + +end JensenShannon + +/-- The mutual information of `π ⊗ₘ κ` for a probability measure `π` on `Bool` and a Markov +kernel `κ : Bool ⇝ 𝓧` is the Jensen-Shannon divergence `JS_{π {false}}(κ false, κ true)`. -/ +theorem mutualInfo_compProd_bool (π : Measure Bool) [IsProbabilityMeasure π] + (κ : Kernel Bool 𝓧) [IsMarkovKernel κ] : + mutualInfo (π ⊗ₘ κ) = jensenShannon (π {false}).toNNReal (κ false) (κ true) := by + conv_lhs => rw [Measure.eq_boolMeasure_toNNReal π, Kernel.eq_boolKernel κ] + exact mutualInfo_compProd_boolKernel _ _ + +/-- The right Kullback-Leibler mutual information of a probability measure `π` on `Bool` and a +Markov kernel `κ : Bool ⇝ 𝓧` is the Jensen-Shannon divergence +`JS_{π {false}}(κ false, κ true)`. -/ +theorem mutualInfoRight_klDivFun_bool (π : Measure Bool) [IsProbabilityMeasure π] + (κ : Kernel Bool 𝓧) [IsMarkovKernel κ] : + mutualInfoRight klDivFun π κ = jensenShannon (π {false}).toNNReal (κ false) (κ true) := by + rw [mutualInfoRight_klDivFun, mutualInfo_compProd_bool] + +/-- The left Kullback-Leibler mutual information of a probability measure `π` on `Bool` with +`π {false} ≠ 0` and a Markov kernel `κ : Bool ⇝ 𝓧` is `(1 - π₀) * R_{π₀}(κ false, κ true)`, +where `π₀ = π {false}` and `R` is the Rényi divergence. -/ +theorem mutualInfoLeft_klDivFun_bool (π : Measure Bool) [IsProbabilityMeasure π] + (h0 : π {false} ≠ 0) (κ : Kernel Bool 𝓧) [IsMarkovKernel κ] : + mutualInfoLeft klDivFun π κ = π {true} * renyiDiv (π {false}).toReal (κ false) (κ true) := by + have h_true : π {true} = 1 - π {false} := Measure.prob_true_eq_one_sub π + rcases eq_or_ne (π {false}) 1 with h1 | h1 + · -- `π` is the Dirac mass at `false`: both sides vanish + have h_true0 : π {true} = 0 := by simp [h_true, h1] + have h := klDiv_prod_compProd_boolKernel π (κ false) (κ true) (κ false) + rw [← Kernel.eq_boolKernel κ] at h + refine le_antisymm ((mutualInfoLeft_le _ π κ (κ false)).trans_eq ?_) (by simp [h_true0]) + simp [← klDiv_eq_fDiv, h, h_true0] + have ha0 : 0 < (π {false}).toReal := ENNReal.toReal_pos h0 (measure_ne_top π _) + have ha1 : (π {false}).toReal < 1 := by + rw [← ENNReal.toReal_one] + exact ENNReal.toReal_strict_mono ENNReal.one_ne_top (lt_of_le_of_ne prob_le_one h1) + have h_one_sub : ENNReal.ofReal (1 - (π {false}).toReal) = π {true} := by + rw [h_true, ENNReal.ofReal_sub _ ENNReal.toReal_nonneg, ENNReal.ofReal_one, + ENNReal.ofReal_toReal (measure_ne_top π _)] + have hπ : π = Measure.boolMeasure (ENNReal.ofReal (π {false}).toReal) + (ENNReal.ofReal (1 - (π {false}).toReal)) := by + rw [ENNReal.ofReal_toReal (measure_ne_top π _), h_one_sub] + exact Measure.eq_boolMeasure π + have h := mul_renyiDiv_eq_iInf_klDiv_prod (μ := κ false) (ν := κ true) ha0 ha1 + rw [← hπ, ← Kernel.eq_boolKernel κ, h_one_sub] at h + rw [mutualInfoLeft_klDivFun_eq_iInf] + exact h.symm + +end ProbabilityTheory diff --git a/Statlib/Divergence/MutualInformation/Estimation.lean b/Statlib/Divergence/MutualInformation/Estimation.lean new file mode 100644 index 0000000..53349ef --- /dev/null +++ b/Statlib/Divergence/MutualInformation/Estimation.lean @@ -0,0 +1,111 @@ +/- +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.KullbackLeibler.Estimation +public import Statlib.Divergence.MutualInformation.LeftRight + +/-! +# Lower bounds on the `f`-mutual informations from the Bayes risk + +Consider an estimation task with prior `π` on `Θ`, data kernel `P : Θ ⇝ 𝓧` and a loss with values +in `[0, 1]`. Let `R_π^P` be its Bayes risk and `R_π^{d_Θ}` the Bayes risk of the same task without +observations, i.e. with the discard kernel `Kernel.discard Θ`. We show that the left and right +`f`-mutual informations of `π` and `P` are lower bounded by the binary `f`-divergences between +those two Bayes risks: +`d_f(R_π^{d_Θ}, R_π^P) ≤ I_{D_f}^L(π, P)` and `d_f(R_π^P, R_π^{d_Θ}) ≤ I_{D_f}^R(π, P)`. + +The proof applies the lower bound `fDiv_bernoulliMeasure_bayesRisk_le` to `π × ξ = π ⊗ const ξ` +for every probability measure `ξ`: the Bayes risk of a constant kernel does not depend on the +constant and equals the Bayes risk without observations. + +For the Kullback-Leibler divergence, the right mutual information is at most the mutual +information `I(π ⊗ P)` (`mutualInfoRight_klDivFun`), which gives the bound +`kl(R_π^P, R_π^{d_Θ}) ≤ I(π ⊗ P)`, a version of Fano's inequality. + +## Main statements + +* `fDiv_bernoulliMeasure_le_mutualInfoLeft`: `d_f(R_π^{d_Θ}, R_π^P) ≤ I_{D_f}^L(π, P)`. +* `fDiv_bernoulliMeasure_le_mutualInfoRight`: `d_f(R_π^P, R_π^{d_Θ}) ≤ I_{D_f}^R(π, P)`. +* `ofReal_klBerReal_bayesRisk_le_mutualInfoLeft`, `ofReal_klBerReal_bayesRisk_le_mutualInfoRight`: + the same bounds for the Kullback-Leibler divergence, with the real binary divergence + `klBerReal`. +* `ofReal_klBerReal_bayesRisk_le_mutualInfo`: `kl(R_π^P, R_π^{d_Θ}) ≤ I(π ⊗ P)`. +-/ + +@[expose] public section + +open MeasureTheory Function InformationTheory unitInterval + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {Θ 𝓧 𝓨 : Type*} {mΘ : MeasurableSpace Θ} {m𝓧 : MeasurableSpace 𝓧} + {m𝓨 : MeasurableSpace 𝓨} {ℓ : Θ → 𝓨 → ℝ≥0∞} {f : DivFunction} + {π : Measure Θ} [IsProbabilityMeasure π] {P : Kernel Θ 𝓧} [IsMarkovKernel P] + +/-- **Lower bound on the left `f`-mutual information from the Bayes risk**: for a loss with values +in `[0, 1]`, `d_f(R_π^{d_Θ}, R_π^P) ≤ I_{D_f}^L(π, P)`, where `d_f` is the binary `f`-divergence, +`R_π^P` the Bayes risk with data kernel `P` and `R_π^{d_Θ}` the Bayes risk without observations. -/ +theorem fDiv_bernoulliMeasure_le_mutualInfoLeft (hℓ : Measurable (uncurry ℓ)) + (hℓ1 : ∀ θ y, ℓ θ y ≤ 1) {p q : I} + (hp : ENNReal.ofReal p = bayesRisk ℓ (Kernel.discard Θ) π) + (hq : ENNReal.ofReal q = bayesRisk ℓ P π) : + fDiv f Ber(true, false, p) Ber(true, false, q) ≤ mutualInfoLeft f π P := by + refine le_mutualInfoLeft fun ξ _ ↦ ?_ + rw [← Measure.compProd_const] + exact fDiv_bernoulliMeasure_bayesRisk_le hℓ hℓ1 + (hp.trans (bayesRisk_const_eq_bayesRisk_discard ℓ ξ π).symm) hq + +/-- **Lower bound on the right `f`-mutual information from the Bayes risk**: for a loss with values +in `[0, 1]`, `d_f(R_π^P, R_π^{d_Θ}) ≤ I_{D_f}^R(π, P)`, where `d_f` is the binary `f`-divergence, +`R_π^P` the Bayes risk with data kernel `P` and `R_π^{d_Θ}` the Bayes risk without observations. -/ +theorem fDiv_bernoulliMeasure_le_mutualInfoRight (hℓ : Measurable (uncurry ℓ)) + (hℓ1 : ∀ θ y, ℓ θ y ≤ 1) {p q : I} + (hp : ENNReal.ofReal p = bayesRisk ℓ (Kernel.discard Θ) π) + (hq : ENNReal.ofReal q = bayesRisk ℓ P π) : + fDiv f Ber(true, false, q) Ber(true, false, p) ≤ mutualInfoRight f π P := by + refine le_mutualInfoRight fun ξ _ ↦ ?_ + rw [← Measure.compProd_const] + exact fDiv_bernoulliMeasure_bayesRisk_le hℓ hℓ1 hq + (hp.trans (bayesRisk_const_eq_bayesRisk_discard ℓ ξ π).symm) + +variable (π P) + +/-- **Lower bound on the left Kullback-Leibler mutual information from the Bayes risk**: for a loss +with values in `[0, 1]`, `kl(R_π^{d_Θ}, R_π^P) ≤ I_{KL}^L(π, P)`. -/ +theorem ofReal_klBerReal_bayesRisk_le_mutualInfoLeft (hℓ : Measurable (uncurry ℓ)) + (hℓ1 : ∀ θ y, ℓ θ y ≤ 1) : + ENNReal.ofReal + (klBerReal (bayesRisk ℓ (Kernel.discard Θ) π).toReal (bayesRisk ℓ P π).toReal) + ≤ mutualInfoLeft klDivFun π P := by + refine le_mutualInfoLeft fun ξ _ ↦ ?_ + rw [← klDiv_eq_fDiv, ← Measure.compProd_const, ← bayesRisk_const_eq_bayesRisk_discard ℓ ξ π] + exact ofReal_klBerReal_bayesRisk_le_klDiv π π P (Kernel.const Θ ξ) hℓ hℓ1 + +/-- **Lower bound on the right Kullback-Leibler mutual information from the Bayes risk**: for a +loss with values in `[0, 1]`, `kl(R_π^P, R_π^{d_Θ}) ≤ I_{KL}^R(π, P)`. -/ +theorem ofReal_klBerReal_bayesRisk_le_mutualInfoRight (hℓ : Measurable (uncurry ℓ)) + (hℓ1 : ∀ θ y, ℓ θ y ≤ 1) : + ENNReal.ofReal + (klBerReal (bayesRisk ℓ P π).toReal (bayesRisk ℓ (Kernel.discard Θ) π).toReal) + ≤ mutualInfoRight klDivFun π P := by + refine le_mutualInfoRight fun ξ _ ↦ ?_ + rw [← klDiv_eq_fDiv, ← Measure.compProd_const, ← bayesRisk_const_eq_bayesRisk_discard ℓ ξ π] + exact ofReal_klBerReal_bayesRisk_le_klDiv π π (Kernel.const Θ ξ) P hℓ hℓ1 + +/-- **Fano-type inequality**: for a loss with values in `[0, 1]`, the binary Kullback-Leibler +divergence between the Bayes risk `R_π^P` and the Bayes risk without observations `R_π^{d_Θ}` is +at most the mutual information `I(π ⊗ P)`. -/ +theorem ofReal_klBerReal_bayesRisk_le_mutualInfo (hℓ : Measurable (uncurry ℓ)) + (hℓ1 : ∀ θ y, ℓ θ y ≤ 1) : + ENNReal.ofReal + (klBerReal (bayesRisk ℓ P π).toReal (bayesRisk ℓ (Kernel.discard Θ) π).toReal) + ≤ mutualInfo (π ⊗ₘ P) := + (ofReal_klBerReal_bayesRisk_le_mutualInfoRight π P hℓ hℓ1).trans_eq (mutualInfoRight_klDivFun π P) + +end ProbabilityTheory diff --git a/Statlib/Divergence/MutualInformation/LeftRight.lean b/Statlib/Divergence/MutualInformation/LeftRight.lean new file mode 100644 index 0000000..40e078b --- /dev/null +++ b/Statlib/Divergence/MutualInformation/LeftRight.lean @@ -0,0 +1,137 @@ +/- +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 +public import Statlib.Divergence.MutualInformation.Basic + +/-! +# Left and right `f`-mutual informations + +For a divergence function `f`, a measure `μ` on `α` and a kernel `κ : α ⇝ β`, we define two +generalizations of the mutual information `I(μ ⊗ κ) = KL(μ ⊗ κ, μ × (κ ∘ μ))`, in which the +Kullback-Leibler divergence is replaced by the f-divergence `D_f` and the second marginal by an +optimized probability measure `ξ`: +* the left `f`-mutual information `⨅ ξ, D_f(μ × ξ, μ ⊗ κ)`, +* the right `f`-mutual information `⨅ ξ, D_f(μ ⊗ κ, μ × ξ)`. + +The Kullback-Leibler mutual informations are the case `f = klDivFun`. + +## Main definitions + +* `mutualInfoLeft f μ κ`: the left `f`-mutual information. +* `mutualInfoRight f μ κ`: the right `f`-mutual information. + +## Main statements + +* `mutualInfoLeft_klDivFun_eq_iInf`, `mutualInfoRight_klDivFun_eq_iInf`: the Kullback-Leibler + mutual informations as infima of Kullback-Leibler divergences. +* `mutualInfoRight_klDivFun`: for a probability measure `μ` and a Markov kernel `κ`, the right + Kullback-Leibler mutual information of `μ` and `κ` is the mutual information `I(μ ⊗ κ)`. +* `mutualInfoLeft_comp_le`, `mutualInfoRight_comp_le`: **data-processing inequalities** for the + left and right `f`-mutual informations. +-/ + +@[expose] public section + +open MeasureTheory InformationTheory + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {α β γ : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} + {mγ : MeasurableSpace γ} {f : DivFunction} {μ : Measure α} {κ : Kernel α β} {c : ℝ≥0∞} + +/-- The left `f`-mutual information of a measure `μ` and a kernel `κ`: the infimum over +probability measures `ξ` of `fDiv f (μ.prod ξ) (μ ⊗ₘ κ)`. -/ +noncomputable +def mutualInfoLeft (f : DivFunction) (μ : Measure α) (κ : Kernel α β) : ℝ≥0∞ := + ⨅ (ξ : Measure β) (_ : IsProbabilityMeasure ξ), fDiv f (μ.prod ξ) (μ ⊗ₘ κ) + +/-- The right `f`-mutual information of a measure `μ` and a kernel `κ`: the infimum over +probability measures `ξ` of `fDiv f (μ ⊗ₘ κ) (μ.prod ξ)`. -/ +noncomputable +def mutualInfoRight (f : DivFunction) (μ : Measure α) (κ : Kernel α β) : ℝ≥0∞ := + ⨅ (ξ : Measure β) (_ : IsProbabilityMeasure ξ), fDiv f (μ ⊗ₘ κ) (μ.prod ξ) + +section Bounds + +variable (f μ κ) in +lemma mutualInfoLeft_le (ξ : Measure β) [IsProbabilityMeasure ξ] : + mutualInfoLeft f μ κ ≤ fDiv f (μ.prod ξ) (μ ⊗ₘ κ) := + iInf₂_le ξ ‹_› + +variable (f μ κ) in +lemma mutualInfoRight_le (ξ : Measure β) [IsProbabilityMeasure ξ] : + mutualInfoRight f μ κ ≤ fDiv f (μ ⊗ₘ κ) (μ.prod ξ) := + iInf₂_le ξ ‹_› + +lemma le_mutualInfoLeft + (h : ∀ (ξ : Measure β) [IsProbabilityMeasure ξ], c ≤ fDiv f (μ.prod ξ) (μ ⊗ₘ κ)) : + c ≤ mutualInfoLeft f μ κ := + le_iInf₂ fun ξ _ ↦ h ξ + +lemma le_mutualInfoRight + (h : ∀ (ξ : Measure β) [IsProbabilityMeasure ξ], c ≤ fDiv f (μ ⊗ₘ κ) (μ.prod ξ)) : + c ≤ mutualInfoRight f μ κ := + le_iInf₂ fun ξ _ ↦ h ξ + +end Bounds + +section KullbackLeibler + +/-- The left Kullback-Leibler mutual information is the infimum over probability measures `ξ` of +`KL(μ × ξ, μ ⊗ₘ κ)`. -/ +lemma mutualInfoLeft_klDivFun_eq_iInf (μ : Measure α) [IsFiniteMeasure μ] (κ : Kernel α β) + [IsFiniteKernel κ] : + mutualInfoLeft klDivFun μ κ + = ⨅ (ξ : Measure β) (_ : IsProbabilityMeasure ξ), klDiv (μ.prod ξ) (μ ⊗ₘ κ) := + iInf_congr fun _ ↦ iInf_congr fun _ ↦ klDiv_eq_fDiv.symm + +/-- The right Kullback-Leibler mutual information is the infimum over probability measures `ξ` of +`KL(μ ⊗ₘ κ, μ × ξ)`. -/ +lemma mutualInfoRight_klDivFun_eq_iInf (μ : Measure α) [IsFiniteMeasure μ] (κ : Kernel α β) + [IsFiniteKernel κ] : + mutualInfoRight klDivFun μ κ + = ⨅ (ξ : Measure β) (_ : IsProbabilityMeasure ξ), klDiv (μ ⊗ₘ κ) (μ.prod ξ) := + iInf_congr fun _ ↦ iInf_congr fun _ ↦ klDiv_eq_fDiv.symm + +/-- The right Kullback-Leibler mutual information is the mutual information: the infimum over +probability measures `ξ` of `KL(μ ⊗ₘ κ, μ × ξ)` is `I(μ ⊗ₘ κ)`, attained at `ξ = κ ∘ₘ μ`. -/ +theorem mutualInfoRight_klDivFun (μ : Measure α) [IsProbabilityMeasure μ] (κ : Kernel α β) + [IsMarkovKernel κ] : + mutualInfoRight klDivFun μ κ = mutualInfo (μ ⊗ₘ κ) := by + refine le_antisymm ((mutualInfoRight_le _ μ κ (κ ∘ₘ μ)).trans_eq ?_) ?_ + · rw [← klDiv_eq_fDiv, mutualInfo_compProd] + · rw [mutualInfoRight_klDivFun_eq_iInf] + refine le_iInf₂ fun ξ _ ↦ ?_ + rw [klDiv_compProd_prod_eq_mutualInfo_add] + exact le_self_add + +end KullbackLeibler + +section DataProcessing + +/-- **Data-processing inequality** for the left `f`-mutual information. -/ +theorem mutualInfoLeft_comp_le (f : DivFunction) (μ : Measure α) [IsFiniteMeasure μ] + (κ : Kernel α β) [IsFiniteKernel κ] (η : Kernel β γ) [IsMarkovKernel η] : + mutualInfoLeft f μ (η ∘ₖ κ) ≤ mutualInfoLeft f μ κ := by + refine le_mutualInfoLeft fun ξ _ ↦ (mutualInfoLeft_le f μ _ (η ∘ₘ ξ)).trans ?_ + rw [Measure.prod_comp_right, ← Measure.parallelComp_comp_compProd] + exact fDiv_comp_right_le _ _ _ + +/-- **Data-processing inequality** for the right `f`-mutual information. -/ +theorem mutualInfoRight_comp_le (f : DivFunction) (μ : Measure α) [IsFiniteMeasure μ] + (κ : Kernel α β) [IsFiniteKernel κ] (η : Kernel β γ) [IsMarkovKernel η] : + mutualInfoRight f μ (η ∘ₖ κ) ≤ mutualInfoRight f μ κ := by + refine le_mutualInfoRight fun ξ _ ↦ (mutualInfoRight_le f μ _ (η ∘ₘ ξ)).trans ?_ + rw [Measure.prod_comp_right, ← Measure.parallelComp_comp_compProd] + exact fDiv_comp_right_le _ _ _ + +end DataProcessing + +end ProbabilityTheory diff --git a/Statlib/Divergence/Renyi/Basic.lean b/Statlib/Divergence/Renyi/Basic.lean index 0214fcd..581fad3 100644 --- a/Statlib/Divergence/Renyi/Basic.lean +++ b/Statlib/Divergence/Renyi/Basic.lean @@ -10,6 +10,8 @@ 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 +public import Mathlib.Analysis.SpecialFunctions.Log.ERealExp +public import Statlib.ForMathlib.MeasureTheory.Measure.Bool /-! # Rényi divergence @@ -24,10 +26,19 @@ public import Mathlib.Analysis.SpecialFunctions.Log.ENNRealLog ## Main statements * `renyiDiv_zero`, `renyiDiv_one`: the special cases. +* `renyiDiv_self`: `Rₐ(μ, μ) = 0` for a nonzero finite measure `μ` and every order `a`. * `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. +* `toReal_renyiDiv_of_ne_top`: for finite measures with `μ ≠ 0`, if `Rₐ(μ, ν) < ∞`, then + `Rₐ(μ, ν) = (a - 1)⁻¹ * (log ∫ (∂μ/∂ν) ^ a ∂ν - (a * log μ(α) + (1 - a) * log ν(α)))`; + `toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure`: for probability measures, + `Rₐ(μ, ν) = (a - 1)⁻¹ * log ∫ (∂μ/∂ν) ^ a ∂ν`. +* `lintegral_rpow_rnDeriv_eq_mul_exp_renyiDiv`: for `a ∈ (0, 1)` and finite measures, + `∫⁻ x, (∂μ/∂ν) x ^ a ∂ν = μ(univ) ^ a * ν(univ) ^ (1 - a) * exp (-(1 - a) * Rₐ(μ, ν))`. +* `le_renyiDiv_of_le_hellingerDiv`: for `a > 0` and measures with the same masses, an inequality + between Hellinger divergences of order `a` gives the same inequality between Rényi divergences. + The data-processing inequalities are deduced from it in `Statlib.Divergence.Renyi.DataProcessing`. This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli (https://github.com/RemyDegenne/testing-lower-bounds). @@ -189,6 +200,15 @@ lemma renyiDiv_of_ne_one (ha_zero : a ≠ 0) (ha_ne_one : a ≠ 1) (μ ν : Meas + (1 - a) * Real.log (ν .univ).toReal)).toENNReal := by rw [renyiDiv, ite_eq_right ha_zero, ite_eq_right ha_ne_one] +/-- The Rényi divergence of order `a ∉ {0, 1}` between probability measures, as a function of the +Hellinger divergence: `Rₐ(μ, ν) = (a - 1)⁻¹ * log (1 + (a - 1) * Hₐ(μ, ν))`. -/ +lemma renyiDiv_of_ne_one_of_isProbabilityMeasure (ha0 : a ≠ 0) (ha1 : a ≠ 1) (μ ν : Measure α) + [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + renyiDiv a μ ν = (((a - 1)⁻¹ : ℝ) * ENNReal.log + ((1 + ((a - 1 : ℝ) : EReal) * hellingerDiv a μ ν).toENNReal) : EReal).toENNReal := by + rw [renyiDiv_of_ne_one ha0 ha1] + simp [avgMass, EReal.coe_sub] + lemma renyiDiv_eq_top_of_hellingerDiv_eq_top [NeZero μ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] (h : hellingerDiv a μ ν = ∞) : renyiDiv a μ ν = ∞ := by @@ -408,6 +428,25 @@ lemma renyiDiv_zero_measure_right (ha_nonneg : 0 ≤ a) norm_cast exact EReal.coe_ne_top _ +/-- The Rényi divergence between a nonzero finite measure and itself is zero. -/ +@[simp] +lemma renyiDiv_self (μ : Measure α) [IsFiniteMeasure μ] [NeZero μ] : renyiDiv a μ μ = 0 := by + rcases eq_or_ne a 0 with rfl | ha0 + · have h : μ {x | 0 < (∂μ/∂μ) x} = μ .univ := + (ae_iff_measure_eq (measurableSet_lt measurable_const + (μ.measurable_rnDeriv μ)).nullMeasurableSet).mp (Measure.rnDeriv_pos .rfl) + simp [renyiDiv_zero, h, ENNReal.div_self (NeZero.ne _) (measure_ne_top _ _)] + rcases eq_or_ne a 1 with rfl | ha1 + · rw [renyiDiv_one, klDiv_self] + -- for `a ∉ {0, 1}`, `Hₐ(μ, μ) = 0` and both terms of the definition are `log μ(univ) / (a - 1)` + have hm : 0 < (μ .univ).toReal := + ENNReal.toReal_pos (Measure.measure_univ_ne_zero.mpr (NeZero.ne μ)) (measure_ne_top _ _) + rw [renyiDiv_of_ne_one ha0 ha1, hellingerDiv_self, EReal.coe_ennreal_zero, mul_zero, add_zero, + show avgMass a μ μ = (μ .univ).toReal by ring, EReal.real_coe_toENNReal, + ENNReal.log_ofReal_of_pos hm] + norm_cast + simp [← add_mul] + section RenyiEq lemma renyiDiv_eq_top_iff_hellingerDiv_eq_top_of_one_lt @@ -483,6 +522,107 @@ lemma absolutelyContinuous_of_renyiDiv_ne_top (ha : 1 ≤ a) (h : renyiDiv a μ end RenyiEq +section HellingerIntegral + +/-! ### The Rényi divergence and the Hellinger integral `∫ (∂μ/∂ν) ^ a ∂ν` -/ + +/-- For finite measures with `μ ≠ 0` and finite Rényi divergence of order +`a ∈ (0, 1) ∪ (1, ∞)`, +`Rₐ(μ, ν) = (a - 1)⁻¹ * (log ∫ (∂μ/∂ν) ^ a ∂ν - (a * log μ(α) + (1 - a) * log ν(α)))`. -/ +lemma toReal_renyiDiv_of_ne_top [NeZero μ] [IsFiniteMeasure μ] [IsFiniteMeasure ν] (ha0 : 0 < a) + (ha1 : a ≠ 1) (h : renyiDiv a μ ν ≠ ∞) : + (renyiDiv a μ ν).toReal + = (a - 1)⁻¹ * (log (∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν) + - (a * log (μ .univ).toReal + (1 - a) * log (ν .univ).toReal)) := by + rcases ha1.lt_or_gt with ha1 | ha1 + · exact toReal_renyiDiv_of_lt_one ha0 ha1 + ((renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha0.le ha1).not.mp h) + · obtain ⟨h_int, h_ac⟩ := (renyiDiv_ne_top_iff_of_one_lt ha1).mp h + exact toReal_renyiDiv_of_one_lt ha1 h_int h_ac + +/-- For probability measures with finite Rényi divergence of order `a ∈ (0, 1) ∪ (1, ∞)`, +`Rₐ(μ, ν) = (a - 1)⁻¹ * log ∫ (∂μ/∂ν) ^ a ∂ν`. -/ +lemma toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] (ha0 : 0 < a) (ha1 : a ≠ 1) (h : renyiDiv a μ ν ≠ ∞) : + (renyiDiv a μ ν).toReal = (a - 1)⁻¹ * log (∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν) := by + simp [toReal_renyiDiv_of_ne_top ha0 ha1 h] + +/-- For finite measures and `a ≥ 0`, if `Rₐ(μ, ν) < ∞`, then `(∂μ/∂ν) ^ a` is `ν`-integrable. -/ +lemma integrable_rpow_rnDeriv_of_renyiDiv_ne_top [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha : 0 ≤ a) (h : renyiDiv a μ ν ≠ ∞) : + Integrable (fun x ↦ ((∂μ/∂ν) x).toReal ^ a) ν := by + rcases lt_or_ge a 1 with ha1 | ha1 + · exact integrable_rpow_rnDeriv_of_lt_one ha ha1 + rcases ha1.eq_or_lt with rfl | ha1 + · simpa using Measure.integrable_toReal_rnDeriv + rcases eq_zero_or_neZero μ with rfl | hμ + · refine (integrable_zero α ℝ ν).congr ?_ + filter_upwards [ν.rnDeriv_zero] with x hx + simp [hx, Real.zero_rpow (by linarith : a ≠ 0)] + exact ((renyiDiv_ne_top_iff_of_one_lt ha1).mp h).1 + +/-- For finite measures with `μ ≠ 0` and finite Rényi divergence of order `a > 0`, the Hellinger +integral `∫ (∂μ/∂ν) ^ a ∂ν` is positive. -/ +lemma integral_rpow_rnDeriv_pos_of_renyiDiv_ne_top [IsFiniteMeasure μ] [NeZero μ] + [IsFiniteMeasure ν] (ha : 0 < a) (h : renyiDiv a μ ν ≠ ∞) : + 0 < ∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν := + (integral_rpow_rnDeriv_pos_iff_not_mutuallySingular ha.ne' + (integrable_rpow_rnDeriv_of_renyiDiv_ne_top ha.le h)).mpr + fun h_ms ↦ h (renyiDiv_of_mutuallySingular ha.le h_ms) + +/-- For `a ∈ (0, 1)` and finite measures, `∫⁻ x, (∂μ/∂ν) x ^ a ∂ν` is +`μ(univ) ^ a * ν(univ) ^ (1 - a) * exp (-(1 - a) * Rₐ(μ, ν))`. Both sides vanish when the +measures are mutually singular. -/ +lemma lintegral_rpow_rnDeriv_eq_mul_exp_renyiDiv [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha0 : 0 < a) (ha1 : a < 1) : + ∫⁻ x, (∂μ/∂ν) x ^ a ∂ν + = μ .univ ^ a * ν .univ ^ (1 - a) + * EReal.exp (-(((1 - a : ℝ) : EReal) * renyiDiv a μ ν)) := by + by_cases h_ms : μ ⟂ₘ ν + · rw [(lintegral_rpow_rnDeriv_eq_zero_iff_mutuallySingular ha0).mpr h_ms, + (renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha0.le ha1).mpr h_ms, EReal.coe_ennreal_top, + EReal.coe_mul_top_of_pos (by simpa using ha1), EReal.neg_top, EReal.exp_bot, mul_zero] + have hμ : μ ≠ 0 := fun h ↦ h_ms (h ▸ Measure.MutuallySingular.zero_left) + have hν : ν ≠ 0 := fun h ↦ h_ms (h ▸ Measure.MutuallySingular.zero_right) + have hμ_pos : 0 < (μ .univ).toReal := + ENNReal.toReal_pos (Measure.measure_univ_ne_zero.mpr hμ) (measure_ne_top _ _) + have hν_pos : 0 < (ν .univ).toReal := + ENNReal.toReal_pos (Measure.measure_univ_ne_zero.mpr hν) (measure_ne_top _ _) + have h_int := integrable_rpow_rnDeriv_of_lt_one ha0.le ha1 (μ := μ) (ν := ν) + have h_pos : 0 < ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν := + (integral_rpow_rnDeriv_pos_iff_not_mutuallySingular ha0.ne' h_int).mpr h_ms + have h_ne_top : renyiDiv a μ ν ≠ ∞ := + fun h ↦ h_ms ((renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha0.le ha1).mp h) + -- the lintegral is the `ofReal` of the integral + have h_lint : ∫⁻ x, (∂μ/∂ν) x ^ a ∂ν = ENNReal.ofReal (∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν) := by + rw [integral_rpow_rnDeriv_eq_toReal_lintegral ha0.le, + ENNReal.ofReal_toReal ((integrable_rpow_rnDeriv_iff_lintegral_ne_top ha0.le).mp h_int)] + -- the integral in terms of the Rényi divergence + have h_renyi := toReal_renyiDiv_of_lt_one ha0 ha1 h_ms + have h_log : Real.log (∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν) + = -(1 - a) * (renyiDiv a μ ν).toReal + a * Real.log (μ .univ).toReal + + (1 - a) * Real.log (ν .univ).toReal := by + rw [h_renyi] + have : a - 1 ≠ 0 := by linarith + field_simp + ring + have h_eq : ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν + = (μ .univ).toReal ^ a * (ν .univ).toReal ^ (1 - a) + * Real.exp (-(1 - a) * (renyiDiv a μ ν).toReal) := by + rw [← Real.exp_log h_pos, h_log, Real.rpow_def_of_pos hμ_pos, Real.rpow_def_of_pos hν_pos, + ← Real.exp_add, ← Real.exp_add] + ring_nf + have h_exp : EReal.exp (-(((1 - a : ℝ) : EReal) * renyiDiv a μ ν)) + = ENNReal.ofReal (Real.exp (-(1 - a) * (renyiDiv a μ ν).toReal)) := by + rw [← EReal.coe_ennreal_toReal h_ne_top, ← EReal.coe_mul, ← EReal.coe_neg, EReal.exp_coe, + neg_mul] + rw [h_lint, h_eq, h_exp, ENNReal.ofReal_mul (by positivity), ENNReal.ofReal_mul (by positivity), + ← ENNReal.ofReal_rpow_of_nonneg ENNReal.toReal_nonneg ha0.le, + ← ENNReal.ofReal_rpow_of_nonneg ENNReal.toReal_nonneg (by linarith), + ENNReal.ofReal_toReal (measure_ne_top _ _), ENNReal.ofReal_toReal (measure_ne_top _ _)] + +end HellingerIntegral + 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 @@ -686,10 +826,20 @@ lemma renyiDiv_smul_smul (ha_nonneg : 0 ≤ a) [IsFiniteMeasure μ] [IsFiniteMea /-- 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 _ _)) +lemma renyiDiv_eq_renyiDiv_inv_smul (ha_nonneg : 0 ≤ a) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + renyiDiv a μ ν = renyiDiv a ((μ .univ)⁻¹ • μ) ((ν .univ)⁻¹ • ν) := by + rcases eq_zero_or_neZero ν with rfl | _ + · rcases eq_zero_or_neZero μ with rfl | _ + · simp + have := μ.smul_finite (ENNReal.inv_ne_top.mpr (NeZero.ne (μ .univ))) + have : NeZero ((μ .univ)⁻¹ • μ) := ⟨by simp [NeZero.ne μ, measure_ne_top]⟩ + simp only [smul_zero, renyiDiv_zero_measure_right ha_nonneg] + rcases eq_zero_or_neZero μ with rfl | _ + · have := ν.smul_finite (ENNReal.inv_ne_top.mpr (NeZero.ne (ν .univ))) + rcases eq_or_ne a 1 with rfl | ha1 + · simp [renyiDiv_one] + · simp only [smul_zero, renyiDiv_zero_measure_left ha_nonneg ha1] + exact (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 @@ -738,8 +888,8 @@ end CGF section DataProcessingInequality -variable {β : Type*} {mβ : MeasurableSpace β} {κ η : Kernel α β} - +/-- For `a > 0` and measures with the same masses, an inequality between Hellinger divergences of +order `a` gives the same inequality between Rényi divergences of order `a`. -/ lemma le_renyiDiv_of_le_hellingerDiv {a : ℝ} {μ₁ ν₁ : Measure α} {μ₂ ν₂ : Measure β} [IsFiniteMeasure μ₁] [IsFiniteMeasure ν₁] [IsFiniteMeasure μ₂] [IsFiniteMeasure ν₂] (ha_pos : 0 < a) (h_eq_μ : μ₁ .univ = μ₂ .univ) @@ -767,38 +917,6 @@ lemma le_renyiDiv_of_le_hellingerDiv {a : ℝ} {μ₁ ν₁ : Measure α} {μ₂ 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/ChainRule.lean b/Statlib/Divergence/Renyi/ChainRule.lean new file mode 100644 index 0000000..805c08f --- /dev/null +++ b/Statlib/Divergence/Renyi/ChainRule.lean @@ -0,0 +1,212 @@ +/- +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.Probability.Kernel.Composition.AbsolutelyContinuous +public import Mathlib.Probability.Kernel.Posterior +public import Statlib.Divergence.Renyi.CondRenyi +public import Statlib.Divergence.Renyi.DataProcessing +public import Statlib.Divergence.Renyi.Variational + +/-! +# Chain rule for the Rényi divergence + +For finite measures `μ`, `ν`, Markov kernels `κ`, `η` and `0 < a`, +`Rₐ(μ ⊗ₘ κ, ν ⊗ₘ η) = Rₐ(μ, ν) + Rₐ(κ, η | μ^(a, ν))`, in which `μ^(a, ν) = renyiMeasure a μ ν` is +the Rényi measure and `Rₐ(κ, η | ρ) = condRenyiDiv a κ η ρ = Rₐ(ρ ⊗ₘ κ, ρ ⊗ₘ η)` is the +conditional Rényi divergence. + +The chain rule holds without assumptions on the measurable spaces. The proof for probability +measures goes through the Hellinger integrals `∫⁻ (∂μ/∂ν) ^ a ∂ν`. Writing `ρ = μ^(a, ν)`, whose +density with respect to `ν` is `(∂μ/∂ν) ^ a` up to a constant, the Hellinger integral of +`ρ ⊗ₘ κ` and `ρ ⊗ₘ η` is proportional to that of `μ ⊗ₘ κ` and `ν ⊗ₘ η`, by the decomposition +`∂(μ ⊗ₘ κ)/∂(ν ⊗ₘ η) = ∂μ/∂ν * ∂(μ ⊗ₘ κ)/∂(μ ⊗ₘ η)` (`rnDeriv_compProd'`) and the equality +`∂(ρ ⊗ₘ κ)/∂(ρ ⊗ₘ η) = ∂(μ ⊗ₘ κ)/∂(μ ⊗ₘ η)` for `ρ ≪ μ` +(`rnDeriv_compProd_of_absolutelyContinuous`). The case of finite measures follows by normalizing +`μ` and `ν`, which does not change the Rényi divergences and multiplies the Rényi measure by a +constant (`renyiMeasure_smul_smul`, `condRenyiDiv_smul_measure`). + +## Main statements + +* `renyiDiv_compProd_eq_add_condRenyiDiv`: the chain rule. +* `renyiDiv_compProd_eq_add_condRenyiDiv_posterior`: the chain rule with the posterior kernels + (Bayesian inverses), + `Rₐ(μ ⊗ₘ κ, ν ⊗ₘ η) = Rₐ(κ ∘ₘ μ, η ∘ₘ ν) + Rₐ(κ†μ, η†ν | (κ ∘ₘ μ)^(a, η ∘ₘ ν))`. +-/ + +@[expose] public section + +open Real MeasureTheory Filter MeasurableSpace InformationTheory + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} {μ ν : Measure α} + {κ η : Kernel α β} {a : ℝ} + +/-- `renyiDiv_compProd_eq_add_condRenyiDiv` for probability measures with `Rₐ(μ, ν) < ∞`. -/ +private lemma renyiDiv_compProd_eq_add_condRenyiDiv_of_isProbabilityMeasure + [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + [IsMarkovKernel κ] [IsMarkovKernel η] (ha0 : 0 < a) (hR : renyiDiv a μ ν ≠ ∞) : + renyiDiv a (μ ⊗ₘ κ) (ν ⊗ₘ η) = renyiDiv a μ ν + condRenyiDiv a κ η (renyiMeasure a μ ν) := by + rcases eq_or_ne a 1 with rfl | ha1 + · rw [renyiMeasure_one, condRenyiDiv, renyiDiv_one_of_isProbabilityMeasure, + renyiDiv_one_of_isProbabilityMeasure, renyiDiv_one_of_isProbabilityMeasure, + klDiv_compProd_eq_add] + set ρ := renyiMeasure a μ ν + set c := exp (-(a - 1) * (renyiDiv a μ ν).toReal) + have h_prob : IsProbabilityMeasure ρ := + isProbabilityMeasure_renyiMeasure_of_renyiDiv_ne_top ha0 hR + -- the Hellinger integrals of the joint measures are proportional + have h_key : ∫⁻ p, ((∂ρ ⊗ₘ κ/∂ρ ⊗ₘ η) p) ^ a ∂(ρ ⊗ₘ η) + = ENNReal.ofReal c * ∫⁻ p, ((∂μ ⊗ₘ κ/∂ν ⊗ₘ η) p) ^ a ∂(ν ⊗ₘ η) := by + have h_or : a < 1 ∨ μ ≪ ν := ha1.lt_or_gt.imp_right fun ha1 ↦ + absolutelyContinuous_of_renyiDiv_ne_top ha1.le hR + -- `ρ ⊗ₘ η` is `ν ⊗ₘ η` tilted by `(∂μ/∂ν) ^ a` + have hρη : ρ ⊗ₘ η + = (ν ⊗ₘ η).withDensity (fun p ↦ ((∂μ/∂ν) p.1) ^ a * ENNReal.ofReal c) := by + have hρ : ρ = _ := renyiMeasure_eq_withDensity ha0.le h_or + rw [hρ] + exact Measure.withDensity_compProd (by fun_prop) + calc ∫⁻ p, ((∂ρ ⊗ₘ κ/∂ρ ⊗ₘ η) p) ^ a ∂(ρ ⊗ₘ η) + _ = ∫⁻ p, ((∂μ ⊗ₘ κ/∂μ ⊗ₘ η) p) ^ a ∂(ρ ⊗ₘ η) := by + refine lintegral_congr_ae ?_ + filter_upwards [rnDeriv_compProd_of_absolutelyContinuous (κ := κ) (η := η) + (renyiMeasure_absolutelyContinuous_left ν ha0)] with p hp + rw [hp] + _ = ∫⁻ p, ENNReal.ofReal c * (((∂μ/∂ν) p.1) ^ a * ((∂μ ⊗ₘ κ/∂μ ⊗ₘ η) p) ^ a) + ∂(ν ⊗ₘ η) := by + rw [hρη, lintegral_withDensity_eq_lintegral_mul _ (by fun_prop) (by fun_prop)] + refine lintegral_congr fun p ↦ ?_ + simp only [Pi.mul_apply] + ring + _ = ENNReal.ofReal c * ∫⁻ p, ((∂μ ⊗ₘ κ/∂ν ⊗ₘ η) p) ^ a ∂(ν ⊗ₘ η) := by + rw [lintegral_const_mul' _ _ ENNReal.ofReal_ne_top] + congr 1 + refine lintegral_congr_ae ?_ + filter_upwards [rnDeriv_compProd' μ ν κ η] with p hp + rw [hp, ENNReal.mul_rpow_of_nonneg _ _ ha0.le] + have hc0 : ENNReal.ofReal c ≠ 0 := (ENNReal.ofReal_pos.mpr (exp_pos _)).ne' + -- the divergence between the joint measures is finite iff the conditional divergence is finite + have h_fin : renyiDiv a (μ ⊗ₘ κ) (ν ⊗ₘ η) ≠ ∞ ↔ renyiDiv a (ρ ⊗ₘ κ) (ρ ⊗ₘ η) ≠ ∞ := by + rcases ha1.lt_or_gt with ha1 | ha1 + · rw [ne_eq, ne_eq, renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha0.le ha1, + renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha0.le ha1, + ← lintegral_rpow_rnDeriv_eq_zero_iff_mutuallySingular ha0, + ← lintegral_rpow_rnDeriv_eq_zero_iff_mutuallySingular ha0, h_key, mul_eq_zero, + or_iff_right hc0] + · have hμν : μ ≪ ν := ((renyiDiv_ne_top_iff_of_one_lt ha1).mp hR).2 + -- `ρ` and `μ` have the same null sets + have hρμ : ρ ≪ μ := renyiMeasure_absolutelyContinuous_left ν ha0 + have hμρ : μ ≪ ρ := absolutelyContinuous_renyiMeasure a .rfl hμν + have h_ac : μ ⊗ₘ κ ≪ ν ⊗ₘ η ↔ ρ ⊗ₘ κ ≪ ρ ⊗ₘ η := by + rw [Measure.absolutelyContinuous_compProd_iff, and_iff_right hμν] + exact ⟨fun h ↦ (hρμ.compProd_left κ).trans (h.trans (hμρ.compProd_left η)), + fun h ↦ (hμρ.compProd_left κ).trans (h.trans (hρμ.compProd_left η))⟩ + rw [renyiDiv_ne_top_iff_of_one_lt ha1, renyiDiv_ne_top_iff_of_one_lt ha1, + integrable_rpow_rnDeriv_iff_lintegral_ne_top ha0.le, + integrable_rpow_rnDeriv_iff_lintegral_ne_top ha0.le, h_key, h_ac] + simp [ENNReal.mul_eq_top, hc0] + by_cases hP : renyiDiv a (μ ⊗ₘ κ) (ν ⊗ₘ η) = ∞ + · have hP' : renyiDiv a (ρ ⊗ₘ κ) (ρ ⊗ₘ η) = ∞ := by + by_contra h + exact h_fin.mpr h hP + rw [hP, condRenyiDiv, hP', add_top] + have hP' : renyiDiv a (ρ ⊗ₘ κ) (ρ ⊗ₘ η) ≠ ∞ := h_fin.mp hP + have hH_pos := integral_rpow_rnDeriv_pos_of_renyiDiv_ne_top ha0 hP + have h_real : ∫ p, ((∂ρ ⊗ₘ κ/∂ρ ⊗ₘ η) p).toReal ^ a ∂(ρ ⊗ₘ η) + = c * ∫ p, ((∂μ ⊗ₘ κ/∂ν ⊗ₘ η) p).toReal ^ a ∂(ν ⊗ₘ η) := by + rw [integral_rpow_rnDeriv_eq_toReal_lintegral ha0.le, + integral_rpow_rnDeriv_eq_toReal_lintegral ha0.le, h_key, ENNReal.toReal_mul, + ENNReal.toReal_ofReal (exp_pos _).le] + have h_toReal : (renyiDiv a (μ ⊗ₘ κ) (ν ⊗ₘ η)).toReal + = (renyiDiv a μ ν).toReal + (renyiDiv a (ρ ⊗ₘ κ) (ρ ⊗ₘ η)).toReal := by + rw [toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure ha0 ha1 hP, + toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure ha0 ha1 hP', h_real, + log_mul (exp_pos _).ne' hH_pos.ne', log_exp] + have : a - 1 ≠ 0 := sub_ne_zero.mpr ha1 + field_simp + ring + rw [condRenyiDiv, ← ENNReal.ofReal_toReal hP, h_toReal, + ENNReal.ofReal_add ENNReal.toReal_nonneg ENNReal.toReal_nonneg, ENNReal.ofReal_toReal hR, + ENNReal.ofReal_toReal hP'] + +/-- **Chain rule** for the Rényi divergence: for finite measures `μ`, `ν`, Markov kernels `κ`, `η` +and `0 < a`, `Rₐ(μ ⊗ₘ κ, ν ⊗ₘ η) = Rₐ(μ, ν) + Rₐ(κ, η | μ^(a, ν))`, in which +`μ^(a, ν) = renyiMeasure a μ ν`. For `a = 1`, this is the chain rule for the Kullback-Leibler +divergence. -/ +theorem renyiDiv_compProd_eq_add_condRenyiDiv + [IsFiniteMeasure μ] [IsFiniteMeasure ν] [IsMarkovKernel κ] [IsMarkovKernel η] + (ha0 : 0 < a) : + renyiDiv a (μ ⊗ₘ κ) (ν ⊗ₘ η) = renyiDiv a μ ν + condRenyiDiv a κ η (renyiMeasure a μ ν) := by + -- degenerate cases: `μ = 0` or `ν = 0` + rcases eq_zero_or_neZero μ with rfl | hμ + · rcases eq_or_ne a 1 with rfl | ha1 + · rcases eq_zero_or_neZero ν with rfl | hν + · simp [condRenyiDiv] + have hc : (ν .univ)⁻¹ ≠ ∞ := ENNReal.inv_ne_top.mpr (NeZero.ne _) + have := ν.smul_finite hc + have := (ν ⊗ₘ η).smul_finite hc + simp [condRenyiDiv, klDiv_zero_left, Measure.compProd_apply_univ, + ENNReal.inv_mul_cancel (NeZero.ne (ν .univ)) (measure_ne_top _ _)] + simp only [Measure.compProd_zero_left, renyiMeasure_zero_left ha0, condRenyiDiv, + renyiDiv_zero_measure_left ha0.le ha1] + split_ifs <;> simp + rcases eq_zero_or_neZero ν with rfl | hν + · simp [renyiDiv_zero_measure_right ha0.le] + by_cases hR : renyiDiv a μ ν = ∞ + · rw [hR, top_add, eq_top_iff, ← hR] + calc renyiDiv a μ ν = renyiDiv a (μ ⊗ₘ κ).fst (ν ⊗ₘ η).fst := by + rw [Measure.fst_compProd, Measure.fst_compProd] + _ ≤ renyiDiv a (μ ⊗ₘ κ) (ν ⊗ₘ η) := renyiDiv_fst_le ha0.le _ _ + -- reduce to probability measures by normalizing `μ` and `ν`: the Rényi divergences do not change + -- and the Rényi measure is multiplied by a constant `k ∈ (0, ∞)` + have h_or : a < 1 ∨ μ ≪ ν := (lt_or_ge a 1).imp_right fun ha1 ↦ + absolutelyContinuous_of_renyiDiv_ne_top ha1 hR + set cμ := (μ .univ)⁻¹ + set cν := (ν .univ)⁻¹ + have hcμ0 : cμ ≠ 0 := ENNReal.inv_ne_zero.mpr (measure_ne_top _ _) + have hcμ_top : cμ ≠ ∞ := ENNReal.inv_ne_top.mpr (NeZero.ne _) + have hcν0 : cν ≠ 0 := ENNReal.inv_ne_zero.mpr (measure_ne_top _ _) + have hcν_top : cν ≠ ∞ := ENNReal.inv_ne_top.mpr (NeZero.ne _) + set k := cμ ^ a * cν ^ (1 - a) + have hk0 : k ≠ 0 := mul_ne_zero (ENNReal.rpow_pos (pos_iff_ne_zero.mpr hcμ0) hcμ_top).ne' + (ENNReal.rpow_pos (pos_iff_ne_zero.mpr hcν0) hcν_top).ne' + have hk_top : k ≠ ∞ := ENNReal.mul_ne_top (ENNReal.rpow_ne_top_of_ne_zero hcμ0 hcμ_top) + (ENNReal.rpow_ne_top_of_ne_zero hcν0 hcν_top) + have h_eq := renyiMeasure_smul_smul ha0.le h_or hcμ0 hcμ_top hcν0 hcν_top + have hR' : renyiDiv a (cμ • μ) (cν • ν) ≠ ∞ := by + rwa [renyiDiv_smul_smul ha0.le hcμ0 hcμ_top hcν0 hcν_top] + -- the Rényi measure of `μ` and `ν` is finite, since the normalized one is a probability measure + have : IsFiniteMeasure (renyiMeasure a μ ν) := by + have h_prob := isProbabilityMeasure_renyiMeasure_of_renyiDiv_ne_top ha0 hR' + rw [h_eq] at h_prob + rw [← one_smul ℝ≥0∞ (renyiMeasure a μ ν), ← ENNReal.inv_mul_cancel hk0 hk_top, ← smul_smul] + exact Measure.smul_finite _ (ENNReal.inv_ne_top.mpr hk0) + calc renyiDiv a (μ ⊗ₘ κ) (ν ⊗ₘ η) = renyiDiv a ((cμ • μ) ⊗ₘ κ) ((cν • ν) ⊗ₘ η) := by + rw [Measure.compProd_smul_left, Measure.compProd_smul_left, + renyiDiv_smul_smul ha0.le hcμ0 hcμ_top hcν0 hcν_top] + _ = renyiDiv a (cμ • μ) (cν • ν) + condRenyiDiv a κ η (renyiMeasure a (cμ • μ) (cν • ν)) := + renyiDiv_compProd_eq_add_condRenyiDiv_of_isProbabilityMeasure ha0 hR' + _ = renyiDiv a μ ν + condRenyiDiv a κ η (renyiMeasure a μ ν) := by + rw [renyiDiv_smul_smul ha0.le hcμ0 hcμ_top hcν0 hcν_top, h_eq, + condRenyiDiv_smul_measure ha0.le κ η _ hk0 hk_top] + +/-- **Chain rule** for the Rényi divergence of order `a > 0`, with posterior kernels +(Bayesian inverses): `Rₐ(μ ⊗ₘ κ, ν ⊗ₘ η) = Rₐ(κ ∘ₘ μ, η ∘ₘ ν) + Rₐ(κ†μ, η†ν | ρ)` with +`ρ = renyiMeasure a (κ ∘ₘ μ) (η ∘ₘ ν)`. -/ +theorem renyiDiv_compProd_eq_add_condRenyiDiv_posterior [StandardBorelSpace α] [Nonempty α] + [IsFiniteMeasure μ] [IsFiniteMeasure ν] [IsFiniteKernel κ] [IsFiniteKernel η] (ha0 : 0 < a) : + renyiDiv a (μ ⊗ₘ κ) (ν ⊗ₘ η) + = renyiDiv a (κ ∘ₘ μ) (η ∘ₘ ν) + + condRenyiDiv a (κ†μ) (η†ν) (renyiMeasure a (κ ∘ₘ μ) (η ∘ₘ ν)) := by + rw [← renyiDiv_compProd_eq_add_condRenyiDiv ha0, compProd_posterior_eq_map_swap, + compProd_posterior_eq_map_swap] + exact (renyiDiv_map_measurableEmbedding ha0.le _ _ + MeasurableEquiv.prodComm.measurableEmbedding).symm + +end ProbabilityTheory diff --git a/Statlib/Divergence/Renyi/CondRenyi.lean b/Statlib/Divergence/Renyi/CondRenyi.lean index da741a2..bee8d3f 100644 --- a/Statlib/Divergence/Renyi/CondRenyi.lean +++ b/Statlib/Divergence/Renyi/CondRenyi.lean @@ -19,6 +19,7 @@ public import Statlib.Divergence.Renyi.Basic ## Main statements * `condRenyiDiv_zero`, `condRenyiDiv_one`: the special cases. +* `condRenyiDiv_smul_measure`: invariance under scaling of the measure. * `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 @@ -33,11 +34,15 @@ open scoped ENNReal NNReal Topology namespace ProbabilityTheory -variable {α β γ : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} {mγ : MeasurableSpace γ} - {μ ν : Measure α} {κ η : Kernel α β} {a : ℝ} +variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} {μ ν : Measure α} + {κ η : Kernel α β} {a : ℝ} -/-- Rényi divergence between two kernels κ and η conditional to a measure μ. -It is defined as `Rₐ(κ, η | μ) := Rₐ(μ ⊗ₘ κ, μ ⊗ₘ η)`. -/ +/-- The Rényi divergence of order `a` between the kernels `κ` and `η` conditional to the measure +`μ`, defined as `Rₐ(κ, η | μ) := Rₐ(μ ⊗ₘ κ, μ ⊗ₘ η)`. + +Unlike the conditional f-divergences, it is not the integral of `renyiDiv a (κ x) (η x)` with +respect to `μ`. Its finiteness is characterized in terms of the kernels by +`condRenyiDiv_eq_top_iff_of_one_lt` and `condRenyiDiv_eq_top_iff_of_lt_one`. -/ noncomputable def condRenyiDiv (a : ℝ) (κ η : Kernel α β) (μ : Measure α) : ℝ≥0∞ := renyiDiv a (μ ⊗ₘ κ) (μ ⊗ₘ η) @@ -48,11 +53,18 @@ lemma condRenyiDiv_zero (κ η : Kernel α β) (μ : Measure α) [IsMarkovKernel rw [condRenyiDiv, renyiDiv_zero, Measure.compProd_apply_univ] @[simp] -lemma condRenyiDiv_one [CountableOrCountablyGenerated α β] (κ η : Kernel α β) (μ : Measure α) +lemma condRenyiDiv_one (κ η : 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] + klDiv_smul_same' (ENNReal.inv_ne_top.mpr (NeZero.ne _)), ← condKL] + +/-- The conditional Rényi divergence is invariant under scaling of the measure. -/ +lemma condRenyiDiv_smul_measure (ha : 0 ≤ a) (κ η : Kernel α β) [IsFiniteKernel κ] + [IsFiniteKernel η] (μ : Measure α) [IsFiniteMeasure μ] {c : ℝ≥0∞} (hc0 : c ≠ 0) (hc : c ≠ ∞) : + condRenyiDiv a κ η (c • μ) = condRenyiDiv a κ η μ := by + rw [condRenyiDiv, condRenyiDiv, Measure.compProd_smul_left, Measure.compProd_smul_left, + renyiDiv_smul_smul ha hc0 hc hc0 hc] lemma integrable_rpow_rnDeriv_compProd_right_iff [CountableOrCountablyGenerated α β] (ha_pos : 0 < a) (ha_ne : a ≠ 1) (κ η : Kernel α β) (μ : Measure α) @@ -86,10 +98,6 @@ lemma condRenyiDiv_eq_top_iff_of_one_lt [CountableOrCountablyGenerated α β] (h ↔ ¬ (∀ᵐ 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 @@ -119,8 +127,6 @@ 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 κ η μ := diff --git a/Statlib/Divergence/Renyi/DataProcessing.lean b/Statlib/Divergence/Renyi/DataProcessing.lean new file mode 100644 index 0000000..30d5cfd --- /dev/null +++ b/Statlib/Divergence/Renyi/DataProcessing.lean @@ -0,0 +1,135 @@ +/- +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.Renyi.Order + +/-! +# Data-processing inequalities for the Rényi divergence + +For finite measures and every order `a ≥ 0`, the Rényi divergence satisfies the data-processing +inequality. For `a > 0`, it is deduced from the data-processing inequality for the Hellinger +divergence of order `a` (`le_renyiDiv_of_le_hellingerDiv`). The order `0` follows by taking the +limit `a → 0⁺` (`tendsto_renyiDiv_nhdsGT_zero`). + +## Main statements + +* `le_renyiDiv_of_forall_le_hellingerDiv`: for `a ≥ 0` and measures with the same masses, an + inequality between the Hellinger divergences of all positive orders gives the same inequality + between Rényi divergences of order `a`. +* `renyiDiv_comp_le_compProd`, `renyiDiv_comp_right_le`, `renyiDiv_map_le`: data-processing + inequalities. +* `renyiDiv_map_measurableEmbedding`: invariance under measurable embeddings. +* `renyiDiv_boolMeasure_le`: data-processing inequality for the indicator of an event, + `Rₐ(μ_E, ν_E) ≤ Rₐ(μ, ν)` for the laws `μ_E`, `ν_E` of `x ↦ decide (x ∈ E)`. + +This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli +(https://github.com/RemyDegenne/testing-lower-bounds). + +## References + +* T. van Erven, P. Harremoës, *Rényi divergence and Kullback-Leibler divergence*, IEEE + Transactions on Information Theory 60(7) (2014), Theorem 9. +-/ + +@[expose] public section + +open MeasureTheory Filter + +open scoped ENNReal Topology + +namespace ProbabilityTheory + +variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} {a : ℝ} + +/-- For `a ≥ 0` and measures with the same masses, an inequality between the Hellinger divergences +of all positive orders gives the same inequality between the Rényi divergences of order `a`. For +`a > 0`, only the order `a` matters (`le_renyiDiv_of_le_hellingerDiv`); the order `0` is the limit +of the positive orders. -/ +lemma le_renyiDiv_of_forall_le_hellingerDiv {μ₁ ν₁ : Measure α} {μ₂ ν₂ : Measure β} + [IsFiniteMeasure μ₁] [IsFiniteMeasure ν₁] [IsFiniteMeasure μ₂] [IsFiniteMeasure ν₂] + (ha : 0 ≤ a) (h_eq_μ : μ₁ .univ = μ₂ .univ) (h_eq_ν : ν₁ .univ = ν₂ .univ) + (h_le : ∀ b, 0 < b → hellingerDiv b μ₁ ν₁ ≤ hellingerDiv b μ₂ ν₂) : + renyiDiv a μ₁ ν₁ ≤ renyiDiv a μ₂ ν₂ := by + rcases ha.eq_or_lt with rfl | ha + · exact le_of_tendsto_of_tendsto tendsto_renyiDiv_nhdsGT_zero tendsto_renyiDiv_nhdsGT_zero + (eventually_nhdsWithin_of_forall fun b hb ↦ + le_renyiDiv_of_le_hellingerDiv hb h_eq_μ h_eq_ν (h_le b hb)) + exact le_renyiDiv_of_le_hellingerDiv ha h_eq_μ h_eq_ν (h_le a ha) + +/-- The Rényi divergence between composition-products with Markov kernels is at least the Rényi +divergence between the first marginals. -/ +lemma le_renyiDiv_compProd (ha : 0 ≤ a) + (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ η : Kernel α β) [IsMarkovKernel κ] [IsMarkovKernel η] : + renyiDiv a μ ν ≤ renyiDiv a (μ ⊗ₘ κ) (ν ⊗ₘ η) := + le_renyiDiv_of_forall_le_hellingerDiv ha Measure.compProd_apply_univ.symm + Measure.compProd_apply_univ.symm fun _ _ ↦ le_hellingerDiv_compProd μ ν κ η + +/-- **Data processing inequality** for the first marginals. -/ +lemma renyiDiv_fst_le (ha : 0 ≤ a) + (μ ν : Measure (α × β)) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + renyiDiv a μ.fst ν.fst ≤ renyiDiv a μ ν := + le_renyiDiv_of_forall_le_hellingerDiv ha Measure.fst_univ Measure.fst_univ + fun _ _ ↦ hellingerDiv_fst_le μ ν + +/-- **Data processing inequality** for the second marginals. -/ +lemma renyiDiv_snd_le (ha : 0 ≤ a) + (μ ν : Measure (α × β)) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + renyiDiv a μ.snd ν.snd ≤ renyiDiv a μ ν := + le_renyiDiv_of_forall_le_hellingerDiv ha Measure.snd_univ Measure.snd_univ + fun _ _ ↦ hellingerDiv_snd_le μ ν + +/-- The Rényi divergence between the compositions `κ ∘ₘ μ` and `η ∘ₘ ν` is at most the Rényi +divergence between the composition-products. -/ +lemma renyiDiv_comp_le_compProd (ha : 0 ≤ a) + (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + renyiDiv a (κ ∘ₘ μ) (η ∘ₘ ν) ≤ renyiDiv a (μ ⊗ₘ κ) (ν ⊗ₘ η) := + le_renyiDiv_of_forall_le_hellingerDiv ha (Measure.snd_compProd μ κ ▸ Measure.snd_univ) + (Measure.snd_compProd ν η ▸ Measure.snd_univ) fun _ _ ↦ hellingerDiv_comp_le_compProd μ ν κ η + +/-- **Data processing inequality** for the Rényi divergence and a Markov kernel. -/ +lemma renyiDiv_comp_right_le (ha : 0 ≤ a) + (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (κ : Kernel α β) [IsMarkovKernel κ] : + renyiDiv a (κ ∘ₘ μ) (κ ∘ₘ ν) ≤ renyiDiv a μ ν := + le_renyiDiv_of_forall_le_hellingerDiv ha Measure.comp_apply_univ Measure.comp_apply_univ + fun _ _ ↦ hellingerDiv_comp_right_le μ ν κ + +/-- **Data processing inequality** for the Rényi divergence and a measurable map. -/ +lemma renyiDiv_map_le (ha : 0 ≤ a) (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + {g : α → β} (hg : Measurable g) : + renyiDiv a (μ.map g) (ν.map g) ≤ renyiDiv a μ ν := by + rw [← Measure.deterministic_comp_eq_map hg, ← Measure.deterministic_comp_eq_map hg] + exact renyiDiv_comp_right_le ha μ ν _ + +/-- The Rényi divergence is invariant under measurable embeddings. -/ +lemma renyiDiv_map_measurableEmbedding (ha : 0 ≤ a) (μ ν : Measure α) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] {g : α → β} (hg : MeasurableEmbedding g) : + renyiDiv a (μ.map g) (ν.map g) = renyiDiv a μ ν := by + refine le_antisymm (renyiDiv_map_le ha μ ν hg.measurable) ?_ + cases isEmpty_or_nonempty α + · -- both sides are Rényi divergences between zero measures, on `α` and on `β` + rcases eq_or_ne a 1 with rfl | ha1 + · simp [Measure.eq_zero_of_isEmpty μ, Measure.eq_zero_of_isEmpty ν] + · simp [Measure.eq_zero_of_isEmpty μ, Measure.eq_zero_of_isEmpty ν, ha, ha1] + calc renyiDiv a μ ν = renyiDiv a ((μ.map g).map hg.invFun) ((ν.map g).map hg.invFun) := by + simp [Measure.map_map hg.measurable_invFun hg.measurable, hg.leftInverse_invFun.id] + _ ≤ renyiDiv a (μ.map g) (ν.map g) := renyiDiv_map_le ha _ _ hg.measurable_invFun + +/-- **Data processing inequality** for the indicator of an event: the Rényi divergence between +the laws of `x ↦ decide (x ∈ E)` under `μ` and `ν` is at most `Rₐ(μ, ν)`. For probability +measures, those laws are the Bernoulli distributions with means `μ E` and `ν E`. -/ +lemma renyiDiv_boolMeasure_le (ha : 0 ≤ a) (μ ν : Measure α) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] {E : Set α} (hE : MeasurableSet E) : + renyiDiv a (Measure.boolMeasure (μ Eᶜ) (μ E)) (Measure.boolMeasure (ν Eᶜ) (ν E)) + ≤ renyiDiv a μ ν := by + classical + rw [← Measure.map_decide_mem_eq_boolMeasure μ hE, ← Measure.map_decide_mem_eq_boolMeasure ν hE] + exact renyiDiv_map_le ha μ ν (measurable_decide_mem hE) + +end ProbabilityTheory diff --git a/Statlib/Divergence/Renyi/Order.lean b/Statlib/Divergence/Renyi/Order.lean new file mode 100644 index 0000000..8a9a6b4 --- /dev/null +++ b/Statlib/Divergence/Renyi/Order.lean @@ -0,0 +1,366 @@ +/- +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.Variational + +/-! +# The Rényi divergence as a function of its order + +We prove that `a ↦ Rₐ(μ, ν)` is monotone on `[0, ∞)`, for finite measures with `μ ≠ 0`, and that +`R₀(μ, ν)` is the limit of `Rₐ(μ, ν)` as `a → 0⁺`. The limits at the order `1` and the continuity +in the order are in `Statlib.Divergence.Renyi.Order.Limits`. + +The main tool is the log-convexity of `a ↦ ∫ (∂μ/∂ν) ^ a ∂ν`, a consequence of Hölder's +inequality (`integral_rpow_rnDeriv_le_rpow_mul_rpow`). For probability measures, +`Rₐ(μ, ν) = log (∫ (∂μ/∂ν) ^ a ∂ν) / (a - 1)` for `a ∈ (0, 1) ∪ (1, ∞)` (when finite), and +log-convexity together with `∫ ∂μ/∂ν ∂ν ≤ 1` (with equality when `μ ≪ ν`) gives the comparisons +between positive orders different from `1`. The order `1` (Kullback-Leibler divergence) is handled +with the variational formula for `a < 1` and with the limit of `(a - 1)⁻¹ * log ∫ (∂μ/∂ν) ^ a ∂ν` +as `a → 1⁻` for `a > 1`. The order `0` is handled by the limit `Rₐ(μ, ν) → R₀(μ, ν)` as `a → 0⁺`, +which follows from `∫ (∂μ/∂ν) ^ a ∂ν → ν {x | 0 < (∂μ/∂ν) x}` (dominated convergence). + +## Main statements + +* `tendsto_renyiDiv_nhdsGT_zero`: for finite measures, `Rₐ(μ, ν) → R₀(μ, ν)` as `a → 0⁺`. +* `renyiDiv_le_renyiDiv_of_le`: for finite measures with `μ ≠ 0`, `a ↦ Rₐ(μ, ν)` is monotone on + `[0, ∞)`. +* `monotoneOn_renyiDiv`: the same statement with `MonotoneOn`. +* `iSup_Ioo_mul_renyiDiv_eq_iSup_Icc`: + `⨆ a ∈ (0, 1), (1 - a) * Rₐ(μ, ν) = ⨆ a ∈ [0, 1], (1 - a) * Rₐ(μ, ν)`. + +## Implementation notes + +The statements are proved for probability measures, then extended to finite measures with +`renyiDiv_eq_renyiDiv_inv_smul`. Monotonicity requires `μ ≠ 0`: `Rₐ(0, ν)` is `∞` for `a < 1` and +`0` for `a > 1`. + +## References + +* T. van Erven, P. Harremoës, *Rényi divergence and Kullback-Leibler divergence*, IEEE + Transactions on Information Theory 60(7) (2014), Theorems 3 and 7. +-/ + +@[expose] public section + +open MeasureTheory Filter Set InformationTheory + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {a b : ℝ} + +section Probability + +variable [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + +/-! ### Comparisons between positive orders -/ + +/-- Monotonicity of the Rényi divergence on `(0, 1)`. -/ +private lemma renyiDiv_le_renyiDiv_of_lt_one (ha_pos : 0 < a) (hab : a ≤ b) (hb : b < 1) : + renyiDiv a μ ν ≤ renyiDiv b μ ν := by + have ha1 : a < 1 := hab.trans_lt hb + have hb_pos : 0 < b := ha_pos.trans_le hab + by_cases h_ms : μ ⟂ₘ ν + · rw [(renyiDiv_eq_top_iff_mutuallySingular_of_lt_one hb_pos.le hb).mpr h_ms] + exact le_top + have ha_top : renyiDiv a μ ν ≠ ∞ := + fun h ↦ h_ms ((renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha_pos.le ha1).mp h) + have hb_top : renyiDiv b μ ν ≠ ∞ := + fun h ↦ h_ms ((renyiDiv_eq_top_iff_mutuallySingular_of_lt_one hb_pos.le hb).mp h) + rw [← ENNReal.ofReal_toReal ha_top, ← ENNReal.ofReal_toReal hb_top] + refine ENNReal.ofReal_le_ofReal ?_ + rw [toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure ha_pos ha1.ne ha_top, + toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure hb_pos hb.ne hb_top, ← div_eq_inv_mul, + ← div_eq_inv_mul] + have hIa := integral_rpow_rnDeriv_pos_of_renyiDiv_ne_top ha_pos ha_top + have hIb := integral_rpow_rnDeriv_pos_of_renyiDiv_ne_top hb_pos hb_top + set Ia := ∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν with hIa_def + set Ib := ∫ x, ((∂μ/∂ν) x).toReal ^ b ∂ν with hIb_def + set θ := (1 - b) / (1 - a) with hθ + have h1a : 0 < 1 - a := by linarith + have hθ0 : 0 ≤ θ := div_nonneg (by linarith) h1a.le + have hθ1 : θ ≤ 1 := (div_le_one h1a).mpr (by linarith) + -- Hölder: `Ib ≤ Ia ^ θ * I₁ ^ (1 - θ) ≤ Ia ^ θ` + have h_holder := integral_rpow_rnDeriv_le_rpow_mul_rpow (c := b) ha_pos.le zero_le_one hθ0 hθ1 + (by rw [hθ]; field_simp; ring) (integrable_rpow_rnDeriv_of_lt_one ha_pos.le ha1) + (by simpa using Measure.integrable_toReal_rnDeriv (μ := μ) (ν := ν)) + have hI1 : ∫ x, ((∂μ/∂ν) x).toReal ^ (1 : ℝ) ∂ν ≤ 1 := by + simp [Measure.integral_toReal_rnDeriv'] + have h_le : Ib ≤ Ia ^ θ := by + refine h_holder.trans ?_ + refine mul_le_of_le_one_right (by positivity) ?_ + exact Real.rpow_le_one integral_rpow_rnDeriv_nonneg hI1 (by linarith) + have h_log : Real.log Ib ≤ θ * Real.log Ia := by + rw [← Real.log_rpow hIa] + exact Real.log_le_log hIb h_le + have h_eq : Real.log Ia / (a - 1) = θ * Real.log Ia / (b - 1) := by + rw [hθ] + have : b - 1 ≠ 0 := by linarith + have : a - 1 ≠ 0 := by linarith + have : 1 - a ≠ 0 := by linarith + field_simp + ring + rw [h_eq] + exact div_le_div_of_nonpos_of_le (by linarith) h_log + +/-- For `a < 1 < b`, `Rₐ(μ, ν) ≤ R_b(μ, ν)`. -/ +private lemma renyiDiv_le_renyiDiv_of_lt_one_of_one_lt (ha_pos : 0 < a) (ha : a < 1) (hb : 1 < b) : + renyiDiv a μ ν ≤ renyiDiv b μ ν := by + have hb_pos : 0 < b := by linarith + by_cases hb_top : renyiDiv b μ ν = ∞ + · rw [hb_top]; exact le_top + obtain ⟨hb_int, h_ac⟩ := (renyiDiv_ne_top_iff_of_one_lt hb).mp hb_top + have ha_top : renyiDiv a μ ν ≠ ∞ := fun h ↦ hb_top (renyiDiv_of_mutuallySingular hb_pos.le + ((renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha_pos.le ha).mp h)) + rw [← ENNReal.ofReal_toReal ha_top, ← ENNReal.ofReal_toReal hb_top] + refine ENNReal.ofReal_le_ofReal ?_ + rw [toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure ha_pos ha.ne ha_top, + toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure hb_pos hb.ne' hb_top, ← div_eq_inv_mul, + ← div_eq_inv_mul] + have hIa := integral_rpow_rnDeriv_pos_of_renyiDiv_ne_top ha_pos ha_top + have hIb := integral_rpow_rnDeriv_pos_of_renyiDiv_ne_top hb_pos hb_top + set Ia := ∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν with hIa_def + set Ib := ∫ x, ((∂μ/∂ν) x).toReal ^ b ∂ν with hIb_def + have hba : 0 < b - a := by linarith + set θ := (b - 1) / (b - a) with hθ + have hθ0 : 0 ≤ θ := div_nonneg (by linarith) hba.le + have hθ1 : θ ≤ 1 := (div_le_one hba).mpr (by linarith) + -- Hölder: `1 = I₁ ≤ Ia ^ θ * Ib ^ (1 - θ)` + have h_holder := integral_rpow_rnDeriv_le_rpow_mul_rpow (c := 1) ha_pos.le hb_pos.le hθ0 hθ1 + (by rw [hθ]; field_simp; ring) (integrable_rpow_rnDeriv_of_lt_one ha_pos.le ha) hb_int + have hI1 : ∫ x, ((∂μ/∂ν) x).toReal ^ (1 : ℝ) ∂ν = 1 := by + simp [Measure.integral_toReal_rnDeriv h_ac] + rw [hI1] at h_holder + have h_log : 0 ≤ θ * Real.log Ia + (1 - θ) * Real.log Ib := by + rw [← Real.log_rpow hIa, ← Real.log_rpow hIb, ← Real.log_mul (by positivity) (by positivity)] + exact Real.log_nonneg h_holder + have h_log' : 0 ≤ (b - 1) * Real.log Ia + (1 - a) * Real.log Ib := by + calc 0 ≤ (b - a) * (θ * Real.log Ia + (1 - θ) * Real.log Ib) := mul_nonneg hba.le h_log + _ = (b - 1) * Real.log Ia + (1 - a) * Real.log Ib := by rw [hθ]; field_simp; ring + have h_eq : Real.log Ia / (a - 1) = - Real.log Ia / (1 - a) := by + rw [← neg_sub, div_neg, neg_div] + rw [h_eq, div_le_div_iff₀ (by linarith) (by linarith)] + linarith + +/-- Monotonicity of the Rényi divergence on `(1, ∞)`. -/ +private lemma renyiDiv_le_renyiDiv_of_one_lt (ha : 1 < a) (hab : a ≤ b) : + renyiDiv a μ ν ≤ renyiDiv b μ ν := by + have hb : 1 < b := ha.trans_le hab + by_cases hb_top : renyiDiv b μ ν = ∞ + · rw [hb_top]; exact le_top + obtain ⟨hb_int, h_ac⟩ := (renyiDiv_ne_top_iff_of_one_lt hb).mp hb_top + have hb1 : 0 < b - 1 := by linarith + set θ := (b - a) / (b - 1) with hθ + have hθ0 : 0 ≤ θ := div_nonneg (by linarith) hb1.le + have hθ1 : θ ≤ 1 := (div_le_one hb1).mpr (by linarith) + have hc : a = θ * 1 + (1 - θ) * b := by rw [hθ]; field_simp; ring + have ha_int := integrable_rpow_rnDeriv_of_le (by linarith) hab hb_int + have ha_top : renyiDiv a μ ν ≠ ∞ := (renyiDiv_ne_top_iff_of_one_lt ha).mpr ⟨ha_int, h_ac⟩ + rw [← ENNReal.ofReal_toReal ha_top, ← ENNReal.ofReal_toReal hb_top] + refine ENNReal.ofReal_le_ofReal ?_ + rw [toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure (by linarith) ha.ne' ha_top, + toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure (by linarith) hb.ne' hb_top, ← div_eq_inv_mul, + ← div_eq_inv_mul] + have hIa := integral_rpow_rnDeriv_pos_of_renyiDiv_ne_top (by linarith) ha_top + have hIb := integral_rpow_rnDeriv_pos_of_renyiDiv_ne_top (by linarith) hb_top + set Ia := ∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν with hIa_def + set Ib := ∫ x, ((∂μ/∂ν) x).toReal ^ b ∂ν with hIb_def + have h_holder := integral_rpow_rnDeriv_le_rpow_mul_rpow (c := a) zero_le_one (by linarith) + hθ0 hθ1 hc + (by simpa using Measure.integrable_toReal_rnDeriv (μ := μ) (ν := ν)) hb_int + have hI1 : ∫ x, ((∂μ/∂ν) x).toReal ^ (1 : ℝ) ∂ν = 1 := by + simp [Measure.integral_toReal_rnDeriv h_ac] + rw [hI1, Real.one_rpow, one_mul] at h_holder + have h_log : Real.log Ia ≤ (1 - θ) * Real.log Ib := by + rw [← Real.log_rpow hIb] + exact Real.log_le_log hIa h_holder + have h1θ : 1 - θ = (a - 1) / (b - 1) := by rw [hθ]; field_simp; ring + rw [h1θ] at h_log + rw [div_le_div_iff₀ (by linarith) hb1] + calc Real.log Ia * (b - 1) ≤ (a - 1) / (b - 1) * Real.log Ib * (b - 1) := by gcongr + _ = Real.log Ib * (a - 1) := by field_simp + +/-- For `a ∈ (0, 1)`, `Rₐ(μ, ν) ≤ KL(μ, ν)`, by the variational formula. -/ +private lemma renyiDiv_le_renyiDiv_one (ha_pos : 0 < a) (ha : a < 1) : + renyiDiv a μ ν ≤ renyiDiv 1 μ ν := by + rw [renyiDiv_one_of_isProbabilityMeasure] + have h_le : ENNReal.ofReal (1 - a) * renyiDiv a μ ν ≤ ENNReal.ofReal (1 - a) * klDiv μ ν := + (mul_renyiDiv_le_mul_klDiv_add_mul_klDiv μ ν μ ha_pos ha).trans_eq (by simp [klDiv_self]) + exact (ENNReal.mul_le_mul_iff_right (by simpa using ha) ENNReal.ofReal_ne_top).mp h_le + +/-- For `b > 1`, `KL(μ, ν) ≤ R_b(μ, ν)`. -/ +private lemma renyiDiv_one_le_renyiDiv (hb : 1 < b) : renyiDiv 1 μ ν ≤ renyiDiv b μ ν := by + by_cases hb_top : renyiDiv b μ ν = ∞ + · rw [hb_top]; exact le_top + obtain ⟨hb_int, h_ac⟩ := (renyiDiv_ne_top_iff_of_one_lt hb).mp hb_top + have h_llr : Integrable (llr μ ν) μ := integrable_llr_of_integrable_rpow_rnDeriv hb h_ac hb_int + rw [renyiDiv_one_of_isProbabilityMeasure, ← ENNReal.ofReal_toReal (klDiv_ne_top h_ac h_llr), + ← ENNReal.ofReal_toReal hb_top, toReal_klDiv_of_measure_eq h_ac (by simp)] + refine ENNReal.ofReal_le_ofReal ?_ + refine le_of_tendsto (tendsto_mul_log_integral_rpow_rnDeriv h_ac h_llr) ?_ + filter_upwards [Ioo_mem_nhdsLT (show (0 : ℝ) < 1 by norm_num)] with a ha + have ha_le := renyiDiv_le_renyiDiv_of_lt_one_of_one_lt (μ := μ) (ν := ν) ha.1 ha.2 hb + have ha_top : renyiDiv a μ ν ≠ ∞ := ne_top_of_le_ne_top hb_top ha_le + rw [← toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure ha.1 ha.2.ne ha_top] + exact ENNReal.toReal_mono hb_top ha_le + +/-! ### The order `0` -/ + +/-- For probability measures, `Rₐ(μ, ν) → R₀(μ, ν)` as `a → 0⁺`. -/ +private lemma tendsto_renyiDiv_nhdsGT_zero_of_isProbabilityMeasure : + Tendsto (fun a ↦ renyiDiv a μ ν) (𝓝[>] 0) (𝓝 (renyiDiv 0 μ ν)) := by + have h_mem : Ioo (0 : ℝ) 1 ∈ 𝓝[>] (0 : ℝ) := Ioo_mem_nhdsGT (by norm_num) + by_cases h_ms : μ ⟂ₘ ν + · rw [(renyiDiv_eq_top_iff_mutuallySingular_of_lt_one le_rfl zero_lt_one).mpr h_ms] + refine tendsto_const_nhds.congr' ?_ + filter_upwards [h_mem] with a ha + exact ((renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha.1.le ha.2).mpr h_ms).symm + set p := ν {x | 0 < (∂μ/∂ν) x} with hp + have hs : MeasurableSet {x | 0 < (∂μ/∂ν) x} := + measurableSet_lt measurable_const (μ.measurable_rnDeriv ν) + have hp_zero : p ≠ 0 := by + intro hp0 + rw [hp] at hp0 + refine h_ms ((Measure.rnDeriv_eq_zero μ ν).mp ?_) + rw [Filter.EventuallyEq, ae_iff] + simpa [pos_iff_ne_zero] using hp0 + have hp_top : p ≠ ∞ := measure_ne_top _ _ + have hp_pos : 0 < p.toReal := ENNReal.toReal_pos hp_zero hp_top + have h_zero : renyiDiv 0 μ ν = ENNReal.ofReal (-Real.log p.toReal) := by + rw [renyiDiv_zero, measure_univ, div_one, ← hp, ENNReal.log_pos_real hp_zero hp_top, + ← EReal.coe_neg, EReal.real_coe_toENNReal] + -- `∫ (∂μ/∂ν) ^ a ∂ν → ν {0 < ∂μ/∂ν}` by dominated convergence + have h_int_tendsto : Tendsto (fun a : ℝ ↦ ∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν) (𝓝[>] 0) + (𝓝 p.toReal) := by + have hp_eq : p.toReal = ∫ x, {x | 0 < (∂μ/∂ν) x}.indicator 1 x ∂ν := by + rw [integral_indicator_one hs, measureReal_def] + rw [hp_eq] + refine tendsto_integral_filter_of_dominated_convergence + (fun x ↦ 1 + ((∂μ/∂ν) x).toReal ^ (1 : ℝ)) ?_ ?_ ?_ ?_ + · exact Eventually.of_forall fun a ↦ + ((μ.measurable_rnDeriv ν).ennreal_toReal.pow_const _).aestronglyMeasurable + · filter_upwards [h_mem] with a ha + refine Eventually.of_forall fun x ↦ ?_ + rw [Real.norm_eq_abs, abs_of_nonneg (by positivity)] + exact Real.rpow_le_one_add_rpow ENNReal.toReal_nonneg ha.1.le ha.2.le + · exact (integrable_const _).add (by simpa using Measure.integrable_toReal_rnDeriv) + · filter_upwards [μ.rnDeriv_lt_top ν] with x hx + by_cases hx0 : 0 < (∂μ/∂ν) x + · rw [Set.indicator_of_mem (show x ∈ {x | 0 < (∂μ/∂ν) x} from hx0)] + have h_pos : 0 < ((∂μ/∂ν) x).toReal := ENNReal.toReal_pos hx0.ne' hx.ne + have h := (Real.continuousAt_const_rpow (b := 0) h_pos.ne').tendsto.mono_left + (nhdsWithin_le_nhds (s := Ioi 0)) + simpa using h + · rw [Set.indicator_of_notMem (show x ∉ {x | 0 < (∂μ/∂ν) x} from hx0)] + have hx0' : (∂μ/∂ν) x = 0 := by simpa using hx0 + refine tendsto_const_nhds.congr' ?_ + filter_upwards [self_mem_nhdsWithin] with a ha + simp [hx0', Real.zero_rpow (ne_of_gt (Set.mem_Ioi.mp ha))] + have h_log : Tendsto (fun a : ℝ ↦ Real.log (∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν) / (a - 1)) + (𝓝[>] 0) (𝓝 (-Real.log p.toReal)) := by + have h1 : Tendsto (fun a : ℝ ↦ a - 1) (𝓝[>] 0) (𝓝 (-1)) := by + have := ((continuous_sub_right (1 : ℝ)).tendsto 0).mono_left + (nhdsWithin_le_nhds (s := Ioi 0)) + simpa using this + have h2 := ((Real.continuousAt_log hp_pos.ne').tendsto.comp h_int_tendsto).div h1 + (by norm_num) + rw [div_neg, div_one] at h2 + exact h2 + rw [h_zero] + refine (ENNReal.tendsto_ofReal h_log).congr' ?_ + filter_upwards [h_mem] with a ha + have ha_top : renyiDiv a μ ν ≠ ∞ := + fun h ↦ h_ms ((renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha.1.le ha.2).mp h) + rw [← ENNReal.ofReal_toReal ha_top, + toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure ha.1 ha.2.ne ha_top, + div_eq_inv_mul] + +/-- For probability measures, `a ↦ Rₐ(μ, ν)` is monotone on `(0, ∞)`. -/ +private lemma renyiDiv_le_renyiDiv_of_pos_of_isProbabilityMeasure (ha_pos : 0 < a) (hab : a ≤ b) : + renyiDiv a μ ν ≤ renyiDiv b μ ν := by + rcases hab.eq_or_lt with rfl | hab + · exact le_rfl + rcases lt_trichotomy a 1 with ha1 | rfl | ha1 + · rcases lt_trichotomy b 1 with hb | rfl | hb + · exact renyiDiv_le_renyiDiv_of_lt_one ha_pos hab.le hb + · exact renyiDiv_le_renyiDiv_one ha_pos ha1 + · exact renyiDiv_le_renyiDiv_of_lt_one_of_one_lt ha_pos ha1 hb + · exact renyiDiv_one_le_renyiDiv hab + · exact renyiDiv_le_renyiDiv_of_one_lt ha1 hab.le + +/-- For probability measures, `a ↦ Rₐ(μ, ν)` is monotone on `[0, ∞)`. -/ +private lemma renyiDiv_le_renyiDiv_of_le_of_isProbabilityMeasure (ha : 0 ≤ a) (hab : a ≤ b) : + renyiDiv a μ ν ≤ renyiDiv b μ ν := by + rcases ha.eq_or_lt with rfl | ha_pos + · rcases hab.eq_or_lt with rfl | hb + · exact le_rfl + -- `R₀(μ, ν)` is the limit of `Rₐ(μ, ν) ≤ R_b(μ, ν)` as `a → 0⁺` + refine le_of_tendsto tendsto_renyiDiv_nhdsGT_zero_of_isProbabilityMeasure ?_ + filter_upwards [Ioo_mem_nhdsGT hb] with a ha + exact renyiDiv_le_renyiDiv_of_pos_of_isProbabilityMeasure ha.1 ha.2.le + exact renyiDiv_le_renyiDiv_of_pos_of_isProbabilityMeasure ha_pos hab + +end Probability + +/-- For finite measures, `Rₐ(μ, ν) → R₀(μ, ν)` as `a → 0⁺`. -/ +theorem tendsto_renyiDiv_nhdsGT_zero [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + Tendsto (fun a ↦ renyiDiv a μ ν) (𝓝[>] 0) (𝓝 (renyiDiv 0 μ ν)) := by + have h_mem : Ioo (0 : ℝ) 1 ∈ 𝓝[>] (0 : ℝ) := Ioo_mem_nhdsGT (by norm_num) + rcases eq_zero_or_neZero μ with rfl | hμ + · rw [renyiDiv_zero_measure_left le_rfl zero_ne_one] + refine tendsto_const_nhds.congr' ?_ + filter_upwards [h_mem] with a ha + rw [renyiDiv_zero_measure_left ha.1.le ha.2.ne] + simp [ha.2] + rcases eq_zero_or_neZero ν with rfl | hν + · rw [renyiDiv_zero_measure_right le_rfl] + refine tendsto_const_nhds.congr' ?_ + filter_upwards [h_mem] with a ha + rw [renyiDiv_zero_measure_right ha.1.le] + rw [renyiDiv_eq_renyiDiv_inv_smul le_rfl] + refine tendsto_renyiDiv_nhdsGT_zero_of_isProbabilityMeasure.congr' ?_ + filter_upwards [h_mem] with a ha + exact (renyiDiv_eq_renyiDiv_inv_smul ha.1.le).symm + +/-- For finite measures with `μ ≠ 0`, `a ↦ Rₐ(μ, ν)` is monotone on `[0, ∞)`. -/ +@[gcongr] +theorem renyiDiv_le_renyiDiv_of_le [IsFiniteMeasure μ] [IsFiniteMeasure ν] [NeZero μ] + (ha : 0 ≤ a) (hab : a ≤ b) : + renyiDiv a μ ν ≤ renyiDiv b μ ν := by + rcases eq_zero_or_neZero ν with rfl | hν + · rw [renyiDiv_zero_measure_right (ha.trans hab)] + exact le_top + rw [renyiDiv_eq_renyiDiv_inv_smul ha, renyiDiv_eq_renyiDiv_inv_smul (ha.trans hab)] + exact renyiDiv_le_renyiDiv_of_le_of_isProbabilityMeasure ha hab + +/-- For finite measures with `μ ≠ 0`, `a ↦ Rₐ(μ, ν)` is monotone on `[0, ∞)`. -/ +theorem monotoneOn_renyiDiv [IsFiniteMeasure μ] [IsFiniteMeasure ν] [NeZero μ] : + MonotoneOn (fun a ↦ renyiDiv a μ ν) (Ici 0) := + fun _ ha _ _ hab ↦ renyiDiv_le_renyiDiv_of_le ha hab + +/-- The supremum of `(1 - a) * Rₐ(μ, ν)` over `a ∈ [0, 1]` is the supremum over `a ∈ (0, 1)`: the +term for `a = 1` is `0` and the term for `a = 0` is a limit of terms with `a ∈ (0, 1)`. -/ +lemma iSup_Ioo_mul_renyiDiv_eq_iSup_Icc [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + ⨆ a ∈ Ioo (0 : ℝ) 1, ENNReal.ofReal (1 - a) * renyiDiv a μ ν + = ⨆ a ∈ Icc (0 : ℝ) 1, ENNReal.ofReal (1 - a) * renyiDiv a μ ν := by + set f : ℝ → ℝ≥0∞ := fun a ↦ ENNReal.ofReal (1 - a) * renyiDiv a μ ν + have h_le : ∀ a ∈ Ioo (0 : ℝ) 1, f a ≤ ⨆ a ∈ Ioo (0 : ℝ) 1, f a := + fun a ha ↦ le_iSup₂ (f := fun a (_ : a ∈ Ioo (0 : ℝ) 1) ↦ f a) a ha + refine le_antisymm (biSup_mono fun _ h ↦ Ioo_subset_Icc_self h) (iSup₂_le fun a ha ↦ ?_) + rcases ha.1.eq_or_lt with rfl | ha0 + · have h_tendsto : Tendsto f (𝓝[>] 0) (𝓝 (f 0)) := by + refine ENNReal.Tendsto.mul ?_ (by simp) tendsto_renyiDiv_nhdsGT_zero (by simp) + exact (ENNReal.continuous_ofReal.tendsto _).comp + (((continuous_sub_left (1 : ℝ)).tendsto 0).mono_left nhdsWithin_le_nhds) + refine le_of_tendsto h_tendsto ?_ + filter_upwards [Ioo_mem_nhdsGT zero_lt_one] with a ha using h_le a ha + rcases ha.2.eq_or_lt with rfl | ha1 + · simp + · exact h_le a ⟨ha0, ha1⟩ + +end ProbabilityTheory diff --git a/Statlib/Divergence/Renyi/Order/Limits.lean b/Statlib/Divergence/Renyi/Order/Limits.lean new file mode 100644 index 0000000..aa57fe7 --- /dev/null +++ b/Statlib/Divergence/Renyi/Order/Limits.lean @@ -0,0 +1,409 @@ +/- +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.Order + +/-! +# Limits and continuity of the Rényi divergence in its order + +We prove that the Rényi divergence of order `1` (the normalized Kullback-Leibler divergence) is the +limit of `Rₐ(μ, ν)` as `a → 1⁻` (always) and as `a → 1⁺` (when `R_b(μ, ν)` is finite for some +`b > 1`). Together with the limit `Rₐ(μ, ν) → R₀(μ, ν)` as `a → 0⁺` (`tendsto_renyiDiv_nhdsGT_zero`) +and the monotonicity of `a ↦ Rₐ(μ, ν)`, we deduce that `a ↦ Rₐ(μ, ν)` is continuous on `[0, 1]` +and on `[0, b]` whenever `R_b(μ, ν) < ∞`. + +The proofs use the secant slopes `(t ^ a - t) / (a - 1)` of the convex function `s ↦ t ^ s`, which +are monotone in `a` and tend to `t * log t` as `a → 1`. Since +`∫ (∂μ/∂ν) ^ a ∂ν - ∫ ∂μ/∂ν ∂ν = (a - 1) * ∫ ((∂μ/∂ν) ^ a - ∂μ/∂ν) / (a - 1) ∂ν`, monotone or +dominated convergence of these slopes gives the behaviour of `Rₐ(μ, ν)` near `a = 1`. + +## Main statements + +* `tendsto_renyiDiv_nhdsLT_one`: `Rₐ(μ, ν) → R₁(μ, ν)` as `a → 1⁻`. +* `tendsto_renyiDiv_nhdsGT_one`: if `R_b(μ, ν) < ∞` for some `b > 1`, then `Rₐ(μ, ν) → R₁(μ, ν)` + as `a → 1⁺`. +* `continuousOn_renyiDiv_Icc`: `a ↦ Rₐ(μ, ν)` is continuous on `[0, 1]`. +* `continuousOn_renyiDiv_Icc_of_ne_top`: if `R_b(μ, ν) < ∞`, then `a ↦ Rₐ(μ, ν)` is continuous on + `[0, b]`. + +## Implementation notes + +All statements are proved for probability measures, then extended to finite measures with +`renyiDiv_eq_renyiDiv_inv_smul`. They require `μ ≠ 0`: `R₁(0, ν) = 1` if `ν ≠ 0`, while +`Rₐ(0, ν) = ∞` for `a < 1` and `Rₐ(0, ν) = 0` for `a > 1`. + +## References + +* T. van Erven, P. Harremoës, *Rényi divergence and Kullback-Leibler divergence*, IEEE + Transactions on Information Theory 60(7) (2014), Theorems 5 and 7. +-/ + +@[expose] public section + +open MeasureTheory Filter Set InformationTheory + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {a b : ℝ} + +section IntegralRPow + +/-- The integral of the secant slopes `((∂μ/∂ν) ^ a - ∂μ/∂ν) / (a - 1)`. -/ +private lemma integral_rpow_sub_self_div_sub_one [IsFiniteMeasure μ] + (ha_int : Integrable (fun x ↦ ((∂μ/∂ν) x).toReal ^ a) ν) : + ∫ x, (((∂μ/∂ν) x).toReal ^ a - ((∂μ/∂ν) x).toReal) / (a - 1) ∂ν + = (∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν - ∫ x, ((∂μ/∂ν) x).toReal ∂ν) / (a - 1) := by + rw [integral_div, integral_sub ha_int Measure.integrable_toReal_rnDeriv] + +private lemma integrable_rpow_sub_self_div_sub_one [IsFiniteMeasure μ] + (ha_int : Integrable (fun x ↦ ((∂μ/∂ν) x).toReal ^ a) ν) : + Integrable (fun x ↦ (((∂μ/∂ν) x).toReal ^ a - ((∂μ/∂ν) x).toReal) / (a - 1)) ν := + (ha_int.sub Measure.integrable_toReal_rnDeriv).div_const _ + +end IntegralRPow + +section Probability + +variable [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + +/-- For `a ∈ (0, 1)`, `(1 - ∫ (∂μ/∂ν) ^ a ∂ν) / (1 - a) ≤ Rₐ(μ, ν)`. -/ +private lemma one_sub_integral_rpow_div_le_toReal_renyiDiv (ha0 : 0 < a) (ha1 : a < 1) + (h_ms : ¬ μ ⟂ₘ ν) : + (1 - ∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν) / (1 - a) ≤ (renyiDiv a μ ν).toReal := by + have h_top : renyiDiv a μ ν ≠ ∞ := + fun h ↦ h_ms ((renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha0.le ha1).mp h) + have hI := integral_rpow_rnDeriv_pos_of_renyiDiv_ne_top ha0 h_top + rw [toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure ha0 ha1.ne h_top, ← div_eq_inv_mul, + show a - 1 = -(1 - a) by ring, div_neg, ← neg_div] + exact div_le_div_of_nonneg_right (by linarith [Real.log_le_sub_one_of_pos hI]) (by linarith) + +/-- If the Kullback-Leibler divergence is infinite, the Rényi divergences of orders `a < 1` are +unbounded. -/ +private lemma exists_lt_renyiDiv_of_klDiv_eq_top (h : klDiv μ ν = ∞) (M : ℝ≥0) : + ∃ a ∈ Ioo (0 : ℝ) 1, (M : ℝ≥0∞) < renyiDiv a μ ν := by + by_cases h_ms : μ ⟂ₘ ν + · refine ⟨2⁻¹, ⟨by norm_num, by norm_num⟩, ?_⟩ + rw [(renyiDiv_eq_top_iff_mutuallySingular_of_lt_one (by norm_num) (by norm_num)).mpr h_ms] + exact ENNReal.coe_lt_top + -- it suffices to find `a` with `M < (1 - I a) / (1 - a)` + suffices ∃ a ∈ Ico (2⁻¹ : ℝ) 1, + (M : ℝ) < (1 - ∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν) / (1 - a) by + obtain ⟨a, ha, hM⟩ := this + have ha0 : 0 < a := by linarith [ha.1] + refine ⟨a, ⟨ha0, ha.2⟩, ?_⟩ + have h_top : renyiDiv a μ ν ≠ ∞ := + fun h ↦ h_ms ((renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha0.le ha.2).mp h) + have h_lt := hM.trans_le (one_sub_integral_rpow_div_le_toReal_renyiDiv ha0 ha.2 h_ms) + rw [← ENNReal.ofReal_toReal h_top, ← ENNReal.ofReal_coe_nnreal] + exact (ENNReal.ofReal_lt_ofReal_iff'.mpr ⟨h_lt, M.2.trans_lt h_lt⟩) + set c := ∫ x, ((∂μ/∂ν) x).toReal ∂ν with hc_def + -- decomposition `(1 - I a) / (1 - a) = (1 - c) / (1 - a) + ∫ slope` + have h_decomp : ∀ a ∈ Ico (2⁻¹ : ℝ) 1, (1 - ∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν) / (1 - a) + = (1 - c) / (1 - a) + + ∫ x, (((∂μ/∂ν) x).toReal ^ a - ((∂μ/∂ν) x).toReal) / (a - 1) ∂ν := by + intro a ha + have h1a : 1 - a ≠ 0 := by linarith [ha.2] + have ha1 : a - 1 ≠ 0 := by linarith [ha.2] + rw [integral_rpow_sub_self_div_sub_one + (integrable_rpow_rnDeriv_of_lt_one (by linarith [ha.1]) ha.2), ← hc_def] + field_simp + ring + have h_slope_ge : ∀ a ∈ Ico (2⁻¹ : ℝ) 1, + -2⁻¹ ≤ ∫ x, (((∂μ/∂ν) x).toReal ^ a - ((∂μ/∂ν) x).toReal) / (a - 1) ∂ν := by + intro a ha + calc -2⁻¹ = ∫ _, -2⁻¹ ∂ν := by simp + _ ≤ _ := integral_mono (integrable_const _) + (integrable_rpow_sub_self_div_sub_one + (integrable_rpow_rnDeriv_of_lt_one (by linarith [ha.1]) ha.2)) + fun x ↦ Real.neg_inv_two_le_rpow_sub_self_div_sub_one ENNReal.toReal_nonneg ha.1 ha.2.ne + by_cases h_ac : μ ≪ ν + swap + · -- `c < 1` since `μ` has a nonzero singular part with respect to `ν` + have hc_lt : c < 1 := by + have h_sing : μ.singularPart ν ≠ 0 := + fun h0 ↦ h_ac ((Measure.singularPart_eq_zero μ ν).mp h0) + rw [hc_def, Measure.integral_toReal_rnDeriv', probReal_univ, sub_lt_self_iff] + exact ENNReal.toReal_pos (Measure.measure_univ_ne_zero.mpr h_sing) (measure_ne_top _ _) + have h_tend : Tendsto (fun a : ℝ ↦ (1 - c) / (1 - a)) (𝓝[<] 1) atTop := by + have h1 : Tendsto (fun a : ℝ ↦ 1 - a) (𝓝[<] 1) (𝓝[>] 0) := by + refine tendsto_nhdsWithin_of_tendsto_nhds_of_eventually_within _ ?_ ?_ + · have : Tendsto (fun a : ℝ ↦ 1 - a) (𝓝 1) (𝓝 (1 - 1)) := + tendsto_const_nhds.sub tendsto_id + simpa using this.mono_left nhdsWithin_le_nhds + · filter_upwards [self_mem_nhdsWithin] with a ha + simpa using ha + simp_rw [div_eq_mul_inv] + exact Tendsto.const_mul_atTop (by linarith) (tendsto_inv_nhdsGT_zero.comp h1) + obtain ⟨a, ha_gt, ha⟩ := ((h_tend.eventually_gt_atTop ((M : ℝ) + 2⁻¹)).and + (Ico_mem_nhdsLT (show (2⁻¹ : ℝ) < 1 by norm_num))).exists + refine ⟨a, ha, ?_⟩ + rw [h_decomp a ha] + linarith [h_slope_ge a ha] + -- `μ ≪ ν` and the log-likelihood ratio is not integrable: monotone convergence + have h_int : ¬ Integrable (llr μ ν) μ := klDiv_eq_top_iff.mp h h_ac + have hc1 : c = 1 := by rw [hc_def, Measure.integral_toReal_rnDeriv h_ac]; simp + by_contra h_contra + simp only [not_exists, not_and, not_lt] at h_contra + refine h_int ((integrable_rnDeriv_mul_log_iff h_ac).mp ?_) + obtain ⟨s, hs_mono, hs_mem, hs_lim⟩ := + exists_seq_strictMono_tendsto' (show (2⁻¹ : ℝ) < 1 by norm_num) + replace hs_mem n : s n ∈ Ico (2⁻¹ : ℝ) 1 := Ioo_subset_Ico_self (hs_mem n) + have hs_tendsto : Tendsto s atTop (𝓝[≠] 1) := + tendsto_nhdsWithin_iff.mpr ⟨hs_lim, .of_forall fun n ↦ (hs_mem n).2.ne⟩ + have h_lim : Tendsto (fun n ↦ ∫⁻ x, ENNReal.ofReal + ((((∂μ/∂ν) x).toReal ^ s n - ((∂μ/∂ν) x).toReal) / (s n - 1) + 2⁻¹) ∂ν) atTop + (𝓝 (∫⁻ x, ENNReal.ofReal + (((∂μ/∂ν) x).toReal * Real.log ((∂μ/∂ν) x).toReal + 2⁻¹) ∂ν)) := by + refine lintegral_tendsto_of_tendsto_of_monotone (fun n ↦ ?_) ?_ ?_ + · exact (ENNReal.measurable_ofReal.comp (((((μ.measurable_rnDeriv ν).ennreal_toReal.pow_const + _).sub (μ.measurable_rnDeriv ν).ennreal_toReal).div_const _).add_const _)).aemeasurable + · filter_upwards with x + intro n m hnm + refine ENNReal.ofReal_le_ofReal ?_ + gcongr ?_ + _ + exact Real.rpow_sub_self_div_sub_one_le ENNReal.toReal_nonneg + (by linarith [(hs_mem n).1]) (hs_mem n).2.ne (hs_mem m).2.ne (hs_mono.monotone hnm) + · filter_upwards with x + refine (ENNReal.continuous_ofReal.tendsto _).comp ?_ + exact ((Real.tendsto_rpow_sub_self_div_sub_one _).comp hs_tendsto).add_const _ + have h_bound : ∀ n, ∫⁻ x, ENNReal.ofReal + ((((∂μ/∂ν) x).toReal ^ s n - ((∂μ/∂ν) x).toReal) / (s n - 1) + 2⁻¹) ∂ν + ≤ ENNReal.ofReal (M + 2⁻¹) := by + intro n + have h_int_n := integrable_rpow_sub_self_div_sub_one + (integrable_rpow_rnDeriv_of_lt_one (μ := μ) (ν := ν) (by linarith [(hs_mem n).1]) + (hs_mem n).2) + have h_int_n' : Integrable (fun x ↦ + (((∂μ/∂ν) x).toReal ^ s n - ((∂μ/∂ν) x).toReal) / (s n - 1) + 2⁻¹) ν := + h_int_n.add (integrable_const _) + rw [← ofReal_integral_eq_lintegral_ofReal h_int_n' (.of_forall fun x ↦ by + have := Real.neg_inv_two_le_rpow_sub_self_div_sub_one (t := ((∂μ/∂ν) x).toReal) + ENNReal.toReal_nonneg (hs_mem n).1 (hs_mem n).2.ne + simp only [Pi.zero_apply] + linarith)] + refine ENNReal.ofReal_le_ofReal ?_ + rw [integral_add h_int_n (integrable_const _)] + have := h_contra (s n) (hs_mem n) + rw [h_decomp (s n) (hs_mem n), hc1, sub_self, zero_div, zero_add] at this + simp only [integral_const, probReal_univ, smul_eq_mul, one_mul] + linarith + have h_fin : ∫⁻ x, ENNReal.ofReal + (((∂μ/∂ν) x).toReal * Real.log ((∂μ/∂ν) x).toReal + 2⁻¹) ∂ν ≤ ENNReal.ofReal (M + 2⁻¹) := + le_of_tendsto' h_lim h_bound + have h_nonneg : 0 ≤ᵐ[ν] + fun x ↦ ((∂μ/∂ν) x).toReal * Real.log ((∂μ/∂ν) x).toReal + 2⁻¹ := .of_forall fun x ↦ by + have := Real.neg_inv_two_le_mul_log (t := ((∂μ/∂ν) x).toReal) ENNReal.toReal_nonneg + simp only [Pi.zero_apply] + linarith + have h_int' : Integrable + (fun x ↦ ((∂μ/∂ν) x).toReal * Real.log ((∂μ/∂ν) x).toReal + 2⁻¹) ν := + ⟨(((μ.measurable_rnDeriv ν).ennreal_toReal.mul + (μ.measurable_rnDeriv ν).ennreal_toReal.log).add_const _).aestronglyMeasurable, + (hasFiniteIntegral_iff_ofReal h_nonneg).mpr (h_fin.trans_lt ENNReal.ofReal_lt_top)⟩ + exact (h_int'.sub (integrable_const (2⁻¹ : ℝ))).congr (.of_forall fun x ↦ by simp) + +/-- For probability measures, `Rₐ(μ, ν) → R₁(μ, ν) = KL(μ, ν)` as `a → 1⁻`. -/ +private lemma tendsto_renyiDiv_nhdsLT_one_of_isProbabilityMeasure : + Tendsto (fun a ↦ renyiDiv a μ ν) (𝓝[<] 1) (𝓝 (renyiDiv 1 μ ν)) := by + have h_mem : Ioo (0 : ℝ) 1 ∈ 𝓝[<] (1 : ℝ) := Ioo_mem_nhdsLT (by norm_num) + rw [renyiDiv_one_of_isProbabilityMeasure] + by_cases h_top : klDiv μ ν = ∞ + · rw [h_top, ENNReal.tendsto_nhds_top_iff_nnreal] + intro M + obtain ⟨a₀, ha₀, hM⟩ := exists_lt_renyiDiv_of_klDiv_eq_top h_top M + filter_upwards [Ioo_mem_nhdsLT ha₀.2] with a ha + exact hM.trans_le (renyiDiv_le_renyiDiv_of_le ha₀.1.le ha.1.le) + obtain ⟨h_ac, h_int⟩ := klDiv_ne_top_iff.mp h_top + rw [← ENNReal.ofReal_toReal h_top, toReal_klDiv_of_measure_eq h_ac (by simp)] + refine (ENNReal.tendsto_ofReal (tendsto_mul_log_integral_rpow_rnDeriv h_ac h_int)).congr' ?_ + filter_upwards [h_mem] with a ha + have ha_top : renyiDiv a μ ν ≠ ∞ := by + refine ne_top_of_le_ne_top ?_ (renyiDiv_le_renyiDiv_of_le ha.1.le ha.2.le) + rwa [renyiDiv_one_of_isProbabilityMeasure] + rw [← ENNReal.ofReal_toReal ha_top, + toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure ha.1 ha.2.ne ha_top] + +/-- For probability measures, if `R_b(μ, ν) < ∞` for some `b > 1`, then +`Rₐ(μ, ν) → R₁(μ, ν) = KL(μ, ν)` as `a → 1⁺`. -/ +private lemma tendsto_renyiDiv_nhdsGT_one_of_isProbabilityMeasure (hb : 1 < b) + (hb_top : renyiDiv b μ ν ≠ ∞) : + Tendsto (fun a ↦ renyiDiv a μ ν) (𝓝[>] 1) (𝓝 (renyiDiv 1 μ ν)) := by + obtain ⟨hb_int, h_ac⟩ := (renyiDiv_ne_top_iff_of_one_lt hb).mp hb_top + have h_llr := integrable_llr_of_integrable_rpow_rnDeriv hb h_ac hb_int + have h_kl_top : klDiv μ ν ≠ ∞ := klDiv_ne_top h_ac h_llr + have h_mem : Ioc (1 : ℝ) b ∈ 𝓝[>] (1 : ℝ) := Ioc_mem_nhdsGT hb + have h_kl_eq : renyiDiv 1 μ ν = ENNReal.ofReal (∫ x, llr μ ν x ∂μ) := by + rw [renyiDiv_one_of_isProbabilityMeasure, ← ENNReal.ofReal_toReal h_kl_top, + toReal_klDiv_of_measure_eq h_ac (by simp)] + -- the integral of the slopes tends to `KL(μ, ν)` by dominated convergence + have h_tendsto : Tendsto (fun a ↦ ∫ x, (((∂μ/∂ν) x).toReal ^ a - ((∂μ/∂ν) x).toReal) / (a - 1) ∂ν) + (𝓝[>] 1) (𝓝 (∫ x, llr μ ν x ∂μ)) := by + rw [← integral_rnDeriv_mul_log h_ac] + refine tendsto_integral_filter_of_dominated_convergence + (fun x ↦ |((∂μ/∂ν) x).toReal * Real.log ((∂μ/∂ν) x).toReal| + + |(((∂μ/∂ν) x).toReal ^ b - ((∂μ/∂ν) x).toReal) / (b - 1)|) ?_ ?_ ?_ ?_ + · exact Eventually.of_forall fun a ↦ ((((μ.measurable_rnDeriv ν).ennreal_toReal.pow_const + _).sub (μ.measurable_rnDeriv ν).ennreal_toReal).div_const _).aestronglyMeasurable + · filter_upwards [h_mem] with a ha + refine Eventually.of_forall fun x ↦ ?_ + rw [Real.norm_eq_abs] + have h1 := Real.mul_log_le_rpow_sub_self_div_sub_one (t := ((∂μ/∂ν) x).toReal) + ENNReal.toReal_nonneg ha.1 + have h2 := Real.rpow_sub_self_div_sub_one_le (t := ((∂μ/∂ν) x).toReal) + ENNReal.toReal_nonneg (by linarith [ha.1]) ha.1.ne' hb.ne' ha.2 + exact (abs_le_max_abs_abs h1 h2).trans (max_le_add_of_nonneg (abs_nonneg _) (abs_nonneg _)) + · exact ((integrable_rnDeriv_mul_log_iff h_ac).mpr h_llr).abs.add + (integrable_rpow_sub_self_div_sub_one hb_int).abs + · exact Eventually.of_forall fun x ↦ + (Real.tendsto_rpow_sub_self_div_sub_one _).mono_left + (nhdsWithin_mono _ fun y hy ↦ ne_of_gt (Set.mem_Ioi.mp hy)) + -- `Rₐ(μ, ν)` is bounded above by the integral of the slopes + have h_upper : ∀ᶠ a in 𝓝[>] (1 : ℝ), renyiDiv a μ ν + ≤ ENNReal.ofReal (∫ x, (((∂μ/∂ν) x).toReal ^ a - ((∂μ/∂ν) x).toReal) / (a - 1) ∂ν) := by + filter_upwards [h_mem] with a ha + have ha_top : renyiDiv a μ ν ≠ ∞ := + ne_top_of_le_ne_top hb_top (renyiDiv_le_renyiDiv_of_le (by linarith [ha.1]) ha.2) + have hI := integral_rpow_rnDeriv_pos_of_renyiDiv_ne_top (by linarith [ha.1]) ha_top + rw [← ENNReal.ofReal_toReal ha_top, + toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure (by linarith [ha.1]) ha.1.ne' ha_top, + ← div_eq_inv_mul] + refine ENNReal.ofReal_le_ofReal ?_ + rw [integral_rpow_sub_self_div_sub_one (integrable_rpow_rnDeriv_of_renyiDiv_ne_top + (by linarith [ha.1]) ha_top), Measure.integral_toReal_rnDeriv h_ac] + simp only [probReal_univ] + exact div_le_div_of_nonneg_right (Real.log_le_sub_one_of_pos hI) (by linarith [ha.1]) + rw [h_kl_eq] + refine tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds + (ENNReal.tendsto_ofReal h_tendsto) ?_ h_upper + filter_upwards [self_mem_nhdsWithin] with a ha + exact h_kl_eq ▸ renyiDiv_le_renyiDiv_of_le zero_le_one (le_of_lt ha) + +/-- For probability measures, `a ↦ Rₐ(μ, ν)` is continuous within `s` at `a ∈ s` with +`a ∉ {0, 1}` if it is finite near `a` in `s` and `t ↦ ∫ (∂μ/∂ν) ^ t ∂ν` is continuous within `s` +at `a`. -/ +private lemma continuousWithinAt_renyiDiv_of_isProbabilityMeasure {s : Set ℝ} (ha : a ∈ s) + (ha0 : 0 < a) (ha1 : a ≠ 1) (h_top : ∀ᶠ t in 𝓝[s] a, renyiDiv t μ ν ≠ ∞) + (hI : ContinuousWithinAt (fun t ↦ ∫ x, ((∂μ/∂ν) x).toReal ^ t ∂ν) s a) : + ContinuousWithinAt (fun t ↦ renyiDiv t μ ν) s a := by + have hIa := integral_rpow_rnDeriv_pos_of_renyiDiv_ne_top ha0 (h_top.self_of_nhdsWithin ha) + have h_cont : ContinuousWithinAt + (fun t ↦ ENNReal.ofReal (Real.log (∫ x, ((∂μ/∂ν) x).toReal ^ t ∂ν) / (t - 1))) s a := + ENNReal.continuous_ofReal.continuousAt.comp_continuousWithinAt + ((hI.log hIa.ne').div (continuousWithinAt_id.sub continuousWithinAt_const) + (sub_ne_zero.mpr ha1)) + refine h_cont.congr_of_eventuallyEq_of_mem ?_ ha + filter_upwards [h_top, mem_nhdsWithin_of_mem_nhds (Ioi_mem_nhds ha0), + mem_nhdsWithin_of_mem_nhds (eventually_ne_nhds ha1)] with t ht ht0 ht1 + rw [← ENNReal.ofReal_toReal ht, toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure ht0 ht1 ht, + div_eq_inv_mul] + +/-- For probability measures, `a ↦ Rₐ(μ, ν)` is continuous on `[0, 1]`. -/ +private lemma continuousOn_renyiDiv_Icc_of_isProbabilityMeasure : + ContinuousOn (fun a ↦ renyiDiv a μ ν) (Icc 0 1) := by + intro a ha + rcases ha.1.eq_or_lt with rfl | ha0 + · exact (continuousWithinAt_Icc_iff_Ici zero_lt_one).mpr + (continuousWithinAt_Ioi_iff_Ici.mp tendsto_renyiDiv_nhdsGT_zero) + rcases ha.2.eq_or_lt with rfl | ha1 + · exact (continuousWithinAt_Icc_iff_Iic zero_lt_one).mpr + (continuousWithinAt_Iio_iff_Iic.mp tendsto_renyiDiv_nhdsLT_one_of_isProbabilityMeasure) + have h_mem : Ioo 0 1 ∈ 𝓝[Icc 0 1] a := mem_nhdsWithin_of_mem_nhds (Ioo_mem_nhds ha0 ha1) + by_cases h_ms : μ ⟂ₘ ν + · refine (continuousWithinAt_const (b := ∞)).congr_of_eventuallyEq_of_mem ?_ ha + filter_upwards [h_mem] with t ht + exact (renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ht.1.le ht.2).mpr h_ms + refine continuousWithinAt_renyiDiv_of_isProbabilityMeasure ha ha0 ha1.ne ?_ ?_ + · filter_upwards [h_mem] with t ht + exact fun h ↦ h_ms ((renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ht.1.le ht.2).mp h) + · exact (continuousOn_integral_rpow_rnDeriv (by simpa using Measure.integrable_toReal_rnDeriv) + a ⟨ha0, ha.2⟩).mono_of_mem_nhdsWithin (mem_of_superset h_mem Ioo_subset_Ioc_self) + +/-- For probability measures, if `R_b(μ, ν) < ∞`, then `a ↦ Rₐ(μ, ν)` is continuous on +`[0, b]`. -/ +private lemma continuousOn_renyiDiv_Icc_of_ne_top_of_isProbabilityMeasure + (hb_top : renyiDiv b μ ν ≠ ∞) : + ContinuousOn (fun a ↦ renyiDiv a μ ν) (Icc 0 b) := by + rcases le_or_gt b 1 with hb1 | hb1 + · exact continuousOn_renyiDiv_Icc_of_isProbabilityMeasure.mono (Icc_subset_Icc_right hb1) + obtain ⟨hb_int, h_ac⟩ := (renyiDiv_ne_top_iff_of_one_lt hb1).mp hb_top + intro a ha + rcases lt_trichotomy a 1 with ha1 | rfl | ha1 + · refine (continuousOn_renyiDiv_Icc_of_isProbabilityMeasure a ⟨ha.1, ha1.le⟩) + |>.mono_of_mem_nhdsWithin ?_ + exact mem_nhdsWithin.mpr ⟨Iio 1, isOpen_Iio, ha1, fun x hx ↦ ⟨hx.2.1, hx.1.le⟩⟩ + · refine ContinuousAt.continuousWithinAt ?_ + exact continuousAt_iff_continuous_left_right.mpr + ⟨continuousWithinAt_Iio_iff_Iic.mp tendsto_renyiDiv_nhdsLT_one_of_isProbabilityMeasure, + continuousWithinAt_Ioi_iff_Ici.mp + (tendsto_renyiDiv_nhdsGT_one_of_isProbabilityMeasure hb1 hb_top)⟩ + -- for `a ∈ (1, b]`, `Rₐ(μ, ν) ≤ R_b(μ, ν) < ∞` and `t ↦ ∫ (∂μ/∂ν) ^ t ∂ν` is continuous on + -- `(0, b]` + have ha0 : 0 < a := zero_lt_one.trans ha1 + refine continuousWithinAt_renyiDiv_of_isProbabilityMeasure ha ha0 ha1.ne' ?_ ?_ + · filter_upwards [self_mem_nhdsWithin] with t ht + exact ne_top_of_le_ne_top hb_top (renyiDiv_le_renyiDiv_of_le ht.1 ht.2) + · exact (continuousOn_integral_rpow_rnDeriv hb_int a ⟨ha0, ha.2⟩).mono_of_mem_nhdsWithin + (mem_nhdsWithin.mpr ⟨Ioi 0, isOpen_Ioi, ha0, fun x hx ↦ ⟨hx.1, hx.2.2⟩⟩) + +end Probability + +/-- For finite measures with `μ ≠ 0`, `Rₐ(μ, ν) → R₁(μ, ν)` as `a → 1⁻`. -/ +theorem tendsto_renyiDiv_nhdsLT_one [IsFiniteMeasure μ] [IsFiniteMeasure ν] [NeZero μ] : + Tendsto (fun a ↦ renyiDiv a μ ν) (𝓝[<] 1) (𝓝 (renyiDiv 1 μ ν)) := by + have h_mem : Ioo (0 : ℝ) 1 ∈ 𝓝[<] (1 : ℝ) := Ioo_mem_nhdsLT (by norm_num) + rcases eq_zero_or_neZero ν with rfl | hν + · rw [renyiDiv_zero_measure_right zero_le_one] + refine tendsto_const_nhds.congr' ?_ + filter_upwards [h_mem] with a ha + rw [renyiDiv_zero_measure_right ha.1.le] + rw [renyiDiv_eq_renyiDiv_inv_smul zero_le_one] + refine tendsto_renyiDiv_nhdsLT_one_of_isProbabilityMeasure.congr' ?_ + filter_upwards [h_mem] with a ha + exact (renyiDiv_eq_renyiDiv_inv_smul ha.1.le).symm + +/-- For finite measures with `μ ≠ 0`, if `R_b(μ, ν) < ∞` for some `b > 1`, then +`Rₐ(μ, ν) → R₁(μ, ν)` as `a → 1⁺`. -/ +theorem tendsto_renyiDiv_nhdsGT_one [IsFiniteMeasure μ] [IsFiniteMeasure ν] [NeZero μ] + (hb : 1 < b) (hb_top : renyiDiv b μ ν ≠ ∞) : + Tendsto (fun a ↦ renyiDiv a μ ν) (𝓝[>] 1) (𝓝 (renyiDiv 1 μ ν)) := by + have h_mem : Ioi (0 : ℝ) ∈ 𝓝[>] (1 : ℝ) := mem_nhdsWithin_of_mem_nhds (Ioi_mem_nhds one_pos) + rcases eq_zero_or_neZero ν with rfl | hν + · rw [renyiDiv_zero_measure_right zero_le_one] + refine tendsto_const_nhds.congr' ?_ + filter_upwards [h_mem] with a ha + rw [renyiDiv_zero_measure_right (le_of_lt ha)] + rw [renyiDiv_eq_renyiDiv_inv_smul zero_le_one] + rw [renyiDiv_eq_renyiDiv_inv_smul (by linarith)] at hb_top + refine (tendsto_renyiDiv_nhdsGT_one_of_isProbabilityMeasure hb hb_top).congr' ?_ + filter_upwards [h_mem] with a ha + exact (renyiDiv_eq_renyiDiv_inv_smul (le_of_lt ha)).symm + +/-- For finite measures with `μ ≠ 0`, `a ↦ Rₐ(μ, ν)` is continuous on `[0, 1]`. -/ +theorem continuousOn_renyiDiv_Icc [IsFiniteMeasure μ] [IsFiniteMeasure ν] [NeZero μ] : + ContinuousOn (fun a ↦ renyiDiv a μ ν) (Icc 0 1) := by + rcases eq_zero_or_neZero ν with rfl | hν + · exact continuousOn_const.congr fun a ha ↦ renyiDiv_zero_measure_right ha.1 μ + exact continuousOn_renyiDiv_Icc_of_isProbabilityMeasure.congr + fun a ha ↦ renyiDiv_eq_renyiDiv_inv_smul ha.1 + +/-- For finite measures with `μ ≠ 0`, if `R_b(μ, ν) < ∞`, then `a ↦ Rₐ(μ, ν)` is continuous on +`[0, b]`. Since `Rₐ(μ, ν) < ∞` for all `a ∈ [0, b]` by monotonicity, this gives continuity on the +set of orders `a ≥ 0` with `Rₐ(μ, ν) < ∞`, an interval `[0, s)` or `[0, s]`. -/ +theorem continuousOn_renyiDiv_Icc_of_ne_top [IsFiniteMeasure μ] [IsFiniteMeasure ν] [NeZero μ] + (hb_top : renyiDiv b μ ν ≠ ∞) : + ContinuousOn (fun a ↦ renyiDiv a μ ν) (Icc 0 b) := by + rcases lt_or_ge b 0 with hb0 | hb0 + · simp [Icc_eq_empty_of_lt hb0] + rcases eq_zero_or_neZero ν with rfl | hν + · exact continuousOn_const.congr fun a ha ↦ renyiDiv_zero_measure_right ha.1 μ + rw [renyiDiv_eq_renyiDiv_inv_smul hb0] at hb_top + exact (continuousOn_renyiDiv_Icc_of_ne_top_of_isProbabilityMeasure hb_top).congr + fun a ha ↦ renyiDiv_eq_renyiDiv_inv_smul ha.1 + +end ProbabilityTheory diff --git a/Statlib/Divergence/Renyi/Prod.lean b/Statlib/Divergence/Renyi/Prod.lean new file mode 100644 index 0000000..cf2d698 --- /dev/null +++ b/Statlib/Divergence/Renyi/Prod.lean @@ -0,0 +1,163 @@ +/- +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.ForMathlib.MeasureTheory.Constructions.Pi +public import Statlib.ForMathlib.MeasureTheory.Measure.Prod +public import Statlib.Divergence.KullbackLeibler.CondKL +public import Statlib.Divergence.Renyi.DataProcessing + +/-! +# Tensorization of the Rényi divergence + +The Rényi divergence between product measures is the sum of the Rényi divergences between the +factors. + +## Main statements + +* `ProbabilityTheory.renyiDiv_prod`: `Rₐ(μ₁ × μ₂, ν₁ × ν₂) = Rₐ(μ₁, ν₁) + Rₐ(μ₂, ν₂)` for finite + measures with `μ₁, μ₂ ≠ 0` and `0 ≤ a`. +* `ProbabilityTheory.renyiDiv_pi`: tensorization for finite products. +* `ProbabilityTheory.renyiDiv_pi_const`: `Rₐ(μ^⊗ι, ν^⊗ι) = |ι| * Rₐ(μ, ν)`. + +## Implementation notes + +The hypothesis `μ₁, μ₂ ≠ 0` cannot be dropped: for `1 < a`, `Rₐ(0, ν) = 0` for all finite `ν`, so +for `μ₁ = 0` the left-hand side vanishes while the right-hand side is `Rₐ(μ₂, ν₂)`. + +For two factors, the order `0` is obtained from the positive orders by taking the limit `a → 0⁺` +(`tendsto_renyiDiv_nhdsGT_zero`). Countable products are treated in +`Statlib.Divergence.Renyi.ProdCountable`. + +## References + +* T. van Erven, P. Harremoës, *Rényi divergence and Kullback-Leibler divergence*, IEEE + Transactions on Information Theory 60(7) (2014), Theorem 28. +-/ + +@[expose] public section + +open Real MeasureTheory Filter InformationTheory + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} {μ ν : Measure α} + {a : ℝ} + +/-- `renyiDiv_prod` for probability measures. -/ +private lemma renyiDiv_prod_of_isProbabilityMeasure (ha : 0 < a) (μ₁ ν₁ : Measure α) + (μ₂ ν₂ : Measure β) [IsProbabilityMeasure μ₁] [IsProbabilityMeasure ν₁] + [IsProbabilityMeasure μ₂] [IsProbabilityMeasure ν₂] : + renyiDiv a (μ₁.prod μ₂) (ν₁.prod ν₂) = renyiDiv a μ₁ ν₁ + renyiDiv a μ₂ ν₂ := by + rcases eq_or_ne a 1 with rfl | ha1 + · simp_rw [renyiDiv_one_of_isProbabilityMeasure] + exact klDiv_prod_two + have h_le₁ : renyiDiv a μ₁ ν₁ ≤ renyiDiv a (μ₁.prod μ₂) (ν₁.prod ν₂) := by + simpa using renyiDiv_map_le ha.le (μ₁.prod μ₂) (ν₁.prod ν₂) measurable_fst + have h_le₂ : renyiDiv a μ₂ ν₂ ≤ renyiDiv a (μ₁.prod μ₂) (ν₁.prod ν₂) := by + simpa using renyiDiv_map_le ha.le (μ₁.prod μ₂) (ν₁.prod ν₂) measurable_snd + by_cases h₁ : renyiDiv a μ₁ ν₁ = ∞ + · rw [h₁, top_add] + exact eq_top_iff.mpr (h₁ ▸ h_le₁) + by_cases h₂ : renyiDiv a μ₂ ν₂ = ∞ + · rw [h₂, add_top] + exact eq_top_iff.mpr (h₂ ▸ h_le₂) + have h_prod : renyiDiv a (μ₁.prod μ₂) (ν₁.prod ν₂) ≠ ∞ := by + rcases ha1.lt_or_gt with ha1' | ha1' + · rw [ne_eq, renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha.le ha1', + ← integral_rpow_rnDeriv_pos_iff_not_mutuallySingular ha.ne' + (integrable_rpow_rnDeriv_of_lt_one ha.le ha1'), integral_rpow_rnDeriv_prod] + exact mul_pos (integral_rpow_rnDeriv_pos_of_renyiDiv_ne_top ha h₁) + (integral_rpow_rnDeriv_pos_of_renyiDiv_ne_top ha h₂) + · have h₁' := (renyiDiv_ne_top_iff_of_one_lt ha1').mp h₁ + have h₂' := (renyiDiv_ne_top_iff_of_one_lt ha1').mp h₂ + rw [renyiDiv_ne_top_iff_of_one_lt ha1'] + refine ⟨(h₁'.1.mul_prod h₂'.1).congr ?_, h₁'.2.prod h₂'.2⟩ + filter_upwards [Measure.rnDeriv_prod μ₁ ν₁ μ₂ ν₂] with p hp + rw [hp, ENNReal.toReal_mul, mul_rpow ENNReal.toReal_nonneg ENNReal.toReal_nonneg] + rw [← ENNReal.ofReal_toReal h_prod, ← ENNReal.ofReal_toReal h₁, ← ENNReal.ofReal_toReal h₂, + ← ENNReal.ofReal_add ENNReal.toReal_nonneg ENNReal.toReal_nonneg, + toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure ha ha1 h_prod, + toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure ha ha1 h₁, + toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure ha ha1 h₂, integral_rpow_rnDeriv_prod, + log_mul (integral_rpow_rnDeriv_pos_of_renyiDiv_ne_top ha h₁).ne' + (integral_rpow_rnDeriv_pos_of_renyiDiv_ne_top ha h₂).ne', mul_add] + +/-- `renyiDiv_prod` for `0 < a`. -/ +private lemma renyiDiv_prod_of_pos (ha : 0 < a) (μ₁ ν₁ : Measure α) (μ₂ ν₂ : Measure β) + [IsFiniteMeasure μ₁] [NeZero μ₁] [IsFiniteMeasure ν₁] [IsFiniteMeasure μ₂] [NeZero μ₂] + [IsFiniteMeasure ν₂] : + renyiDiv a (μ₁.prod μ₂) (ν₁.prod ν₂) = renyiDiv a μ₁ ν₁ + renyiDiv a μ₂ ν₂ := by + rcases eq_zero_or_neZero ν₁ with rfl | _ + · simp [renyiDiv_zero_measure_right ha.le] + rcases eq_zero_or_neZero ν₂ with rfl | _ + · simp [renyiDiv_zero_measure_right ha.le] + -- reduce to probability measures by normalizing + rw [renyiDiv_eq_renyiDiv_inv_smul ha.le (μ := μ₁), renyiDiv_eq_renyiDiv_inv_smul ha.le (μ := μ₂), + ← renyiDiv_prod_of_isProbabilityMeasure ha, Measure.prod_smul_left, Measure.prod_smul_right, + smul_smul, Measure.prod_smul_left, Measure.prod_smul_right, smul_smul, + renyiDiv_smul_smul ha.le] + all_goals simp [ENNReal.mul_eq_top, NeZero.ne, measure_ne_top] + +/-- **Tensorization** of the Rényi divergence: for finite measures with `μ₁, μ₂ ≠ 0` and `0 ≤ a`, +`Rₐ(μ₁ × μ₂, ν₁ × ν₂) = Rₐ(μ₁, ν₁) + Rₐ(μ₂, ν₂)`. -/ +theorem renyiDiv_prod (ha : 0 ≤ a) (μ₁ ν₁ : Measure α) (μ₂ ν₂ : Measure β) + [IsFiniteMeasure μ₁] [NeZero μ₁] [IsFiniteMeasure ν₁] [IsFiniteMeasure μ₂] [NeZero μ₂] + [IsFiniteMeasure ν₂] : + renyiDiv a (μ₁.prod μ₂) (ν₁.prod ν₂) = renyiDiv a μ₁ ν₁ + renyiDiv a μ₂ ν₂ := by + rcases ha.eq_or_lt with rfl | ha + · exact tendsto_nhds_unique tendsto_renyiDiv_nhdsGT_zero + ((tendsto_renyiDiv_nhdsGT_zero.add tendsto_renyiDiv_nhdsGT_zero).congr' + (eventually_nhdsWithin_of_forall fun _ hb ↦ (renyiDiv_prod_of_pos hb _ _ _ _).symm)) + exact renyiDiv_prod_of_pos ha μ₁ ν₁ μ₂ ν₂ + +universe u + +/-- **Tensorization** of the Rényi divergence for finite products of finite measures, with +`μ i ≠ 0` and `0 ≤ a`: `Rₐ(∏ μ i, ∏ ν i) = ∑ i, Rₐ(μ i, ν i)`. -/ +theorem renyiDiv_pi (ha : 0 ≤ a) {ι : Type*} [Fintype ι] {β : ι → Type u} + [∀ i, MeasurableSpace (β i)] {μ ν : (i : ι) → Measure (β i)} [∀ i, IsFiniteMeasure (μ i)] + [∀ i, NeZero (μ i)] [∀ i, IsFiniteMeasure (ν i)] : + renyiDiv a (Measure.pi μ) (Measure.pi ν) = ∑ i, renyiDiv a (μ i) (ν i) := by + refine Fintype.induction_empty_option (P := fun ι ↦ ∀ {β : ι → Type u} + [(i : ι) → MeasurableSpace (β i)] {μ ν : (i : ι) → Measure (β i)} + [∀ i, IsFiniteMeasure (μ i)] [∀ i, NeZero (μ i)] [∀ i, IsFiniteMeasure (ν i)], + renyiDiv a (Measure.pi μ) (Measure.pi ν) = ∑ i, renyiDiv a (μ 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 ↦ renyiDiv a (μ (e i)) (ν (e i))) + (fun i ↦ by rw [Equiv.apply_symm_apply]), ← h, ← Measure.pi_map_piCongrLeft e μ, + ← Measure.pi_map_piCongrLeft e ν, + renyiDiv_map_measurableEmbedding ha _ _ (MeasurableEquiv.measurableEmbedding _)] + · intro β _ μ ν _ _ _ + rw [Measure.pi_of_empty, Measure.pi_of_empty, renyiDiv_self, Finset.univ_eq_empty, + Finset.sum_empty] + · intro ι hι ind_h β _ μ ν _ _ _ + specialize ind_h (β := fun i ↦ β i) (μ := fun i ↦ μ i) (ν := fun i ↦ ν i) + rw [Fintype.sum_option, add_comm, ← ind_h, ← renyiDiv_prod ha, + ← Measure.pi_map_piOptionEquivProd μ, ← Measure.pi_map_piOptionEquivProd ν, + renyiDiv_map_measurableEmbedding ha _ _ (MeasurableEquiv.measurableEmbedding _)] + +/-- **Tensorization** of the Rényi divergence for powers of finite measures, with `μ ≠ 0` and +`0 ≤ a`: `Rₐ(μ^⊗ι, ν^⊗ι) = |ι| * Rₐ(μ, ν)`. -/ +theorem renyiDiv_pi_const (ha : 0 ≤ a) {ι : Type*} [Fintype ι] [IsFiniteMeasure μ] [NeZero μ] + [IsFiniteMeasure ν] : + renyiDiv a (Measure.pi (fun (_ : ι) ↦ μ)) (Measure.pi (fun (_ : ι) ↦ ν)) + = Fintype.card ι * renyiDiv a μ ν := by + rw [renyiDiv_pi ha, Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + +/-- **Tensorization** of the Rényi divergence for powers of finite measures, for the real value: +`Rₐ(μ^⊗ι, ν^⊗ι) = |ι| * Rₐ(μ, ν)`. -/ +lemma toReal_renyiDiv_pi_const (ha : 0 ≤ a) {ι : Type*} [Fintype ι] [IsFiniteMeasure μ] + [NeZero μ] [IsFiniteMeasure ν] : + (renyiDiv a (Measure.pi (fun (_ : ι) ↦ μ)) (Measure.pi (fun (_ : ι) ↦ ν))).toReal + = Fintype.card ι * (renyiDiv a μ ν).toReal := by + rw [renyiDiv_pi_const ha, ENNReal.toReal_mul, ENNReal.toReal_natCast] + +end ProbabilityTheory diff --git a/Statlib/Divergence/Renyi/ProdCountable.lean b/Statlib/Divergence/Renyi/ProdCountable.lean new file mode 100644 index 0000000..f7a08c2 --- /dev/null +++ b/Statlib/Divergence/Renyi/ProdCountable.lean @@ -0,0 +1,145 @@ +/- +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.Analysis.SpecialFunctions.Log.ENNRealLogExp +public import Mathlib.Probability.ProductMeasure +public import Statlib.Divergence.FDiv.TrimApprox +public import Statlib.Divergence.Renyi.Prod +public import Statlib.ForMathlib.Probability.Process.Filtration + +/-! +# Tensorization of the Rényi divergence for countable products + +For a countable family of probability measures, the Rényi divergence of order `a > 0` between the +product measures `Measure.infinitePi μ` and `Measure.infinitePi ν` is the sum of the Rényi +divergences between the factors. + +The finite products `Measure.pi (fun i : s n ↦ μ i)` over an increasing sequence of finite sets +`s n` exhausting the index set are the pushforwards of the infinite product by the restrictions, +whose σ-algebras increase and generate the product σ-algebra. By +`tendsto_renyiDiv_map_of_iSup_comap_eq`, the Rényi divergences between the finite products converge +to the divergence between the infinite products, and the Rényi divergence tensorizes on finite +products (`renyiDiv_pi`). + +The hypothesis `0 < a` cannot be dropped in `renyiDiv_infinitePi` (only the inequality +`tsum_renyiDiv_le_renyiDiv_infinitePi` holds for `a = 0`): if `μ i` and `ν i` are equivalent +Bernoulli distributions with parameters `1/2` and `1/3`, then `R₀(μ i, ν i) = 0` for all `i`, but +the infinite products are mutually singular, hence `R₀(∏ μ i, ∏ ν i) = ∞`. + +## Main statements + +* `ProbabilityTheory.tendsto_renyiDiv_map_of_iSup_comap_eq`: for finite measures and `0 < a`, if the + σ-algebras generated by the maps `g n` increase to the whole σ-algebra, then + `Rₐ(μ.map (g n), ν.map (g n)) → Rₐ(μ, ν)`. +* `ProbabilityTheory.tsum_renyiDiv_le_renyiDiv_infinitePi`: for any index set and `0 ≤ a`, the sum + of the Rényi divergences is at most the Rényi divergence between the products. +* `ProbabilityTheory.renyiDiv_infinitePi`: `Rₐ(∏ μ i, ∏ ν i) = ∑' i, Rₐ(μ i, ν i)` for a countable + index set and `0 < a`. + +## References + +* T. van Erven, P. Harremoës, *Rényi divergence and Kullback-Leibler divergence*, IEEE + Transactions on Information Theory 60(7) (2014), Theorem 28. +-/ + +@[expose] public section + +open Real MeasureTheory Filter Set + +open scoped ENNReal Topology + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {a : ℝ} + +/-- `tendsto_renyiDiv_map_of_iSup_comap_eq` for probability measures. -/ +private lemma tendsto_renyiDiv_map_of_iSup_comap_eq_of_isProbabilityMeasure (ha : 0 < a) + (μ ν : Measure α) [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] {β : ℕ → Type*} + {mβ : ∀ n, MeasurableSpace (β n)} {g : ∀ n, α → β n} (hg : ∀ n, Measurable (g n)) + (h_mono : Monotone fun n ↦ (mβ n).comap (g n)) (h_sup : ⨆ n, (mβ n).comap (g n) = mα) : + Tendsto (fun n ↦ renyiDiv a (μ.map (g n)) (ν.map (g n))) atTop (𝓝 (renyiDiv a μ ν)) := by + have h_tendsto (f : DivFunction) := tendsto_fDiv_map_of_iSup_comap_eq (μ := μ) (ν := ν) (f := f) + hg h_mono h_sup + rcases eq_or_ne a 1 with rfl | ha1 + · simp_rw [renyiDiv_one_of_isProbabilityMeasure, klDiv_eq_fDiv] + exact h_tendsto klDivFun + -- for `a ≠ 1`, the Rényi divergence is a continuous function of the Hellinger divergence + have h_cont : Continuous fun h : ℝ≥0∞ ↦ (((a - 1)⁻¹ : ℝ) * ENNReal.log + ((1 + ((a - 1 : ℝ) : EReal) * h).toENNReal) : EReal).toENNReal := + EReal.continuous_toENNReal.comp ((EReal.continuous_coe_mul _).comp + (ENNReal.continuous_log.comp (EReal.continuous_toENNReal.comp + ((EReal.continuous_coe_add 1).comp + ((EReal.continuous_coe_mul _).comp continuous_coe_ennreal_ereal))))) + simp_rw [renyiDiv_of_ne_one_of_isProbabilityMeasure ha.ne' ha1] + exact (h_cont.tendsto _).comp (h_tendsto (hellingerDivFun a)) + +/-- If the σ-algebras generated by measurable maps `g n` increase to the σ-algebra of the space, +then for `0 < a` the Rényi divergences between the pushforwards by `g n` of two finite measures +converge to the Rényi divergence between the measures. -/ +theorem tendsto_renyiDiv_map_of_iSup_comap_eq (ha : 0 < a) (μ ν : Measure α) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] {β : ℕ → Type*} + {mβ : ∀ n, MeasurableSpace (β n)} {g : ∀ n, α → β n} (hg : ∀ n, Measurable (g n)) + (h_mono : Monotone fun n ↦ (mβ n).comap (g n)) (h_sup : ⨆ n, (mβ n).comap (g n) = mα) : + Tendsto (fun n ↦ renyiDiv a (μ.map (g n)) (ν.map (g n))) atTop (𝓝 (renyiDiv a μ ν)) := by + rcases eq_zero_or_neZero μ with rfl | _ + · -- the divergence from the zero measure only depends on the mass of the second measure + refine tendsto_const_nhds.congr fun n ↦ ?_ + rw [Measure.map_zero] + rcases eq_or_ne a 1 with rfl | ha1 + · simp_rw [renyiDiv_one, Measure.coe_zero, Pi.zero_apply, smul_zero, + InformationTheory.klDiv_of_ac_of_integrable (.zero _) integrable_zero_measure] + simp [measureReal_def, Measure.map_apply (hg n) .univ] + · simp [renyiDiv_zero_measure_left ha.le ha1] + have (n : ℕ) : NeZero (μ.map (g n)) := + ⟨(Measure.map_ne_zero_iff (hg n).aemeasurable).2 (NeZero.ne μ)⟩ + rcases eq_zero_or_neZero ν with rfl | _ + · simp [renyiDiv_zero_measure_right ha.le] + -- reduce to probability measures by normalizing + have h_eq (n : ℕ) : renyiDiv a (μ.map (g n)) (ν.map (g n)) + = renyiDiv a (((μ .univ)⁻¹ • μ).map (g n)) (((ν .univ)⁻¹ • ν).map (g n)) := by + rw [Measure.map_smul, Measure.map_smul, renyiDiv_smul_smul ha.le] + all_goals first | exact (hg n).aemeasurable | simp [NeZero.ne, measure_ne_top] + simp_rw [h_eq, renyiDiv_eq_renyiDiv_inv_smul ha.le (μ := μ)] + exact tendsto_renyiDiv_map_of_iSup_comap_eq_of_isProbabilityMeasure ha _ _ hg h_mono h_sup + +universe u + +variable {ι : Type*} {β : ι → Type u} [∀ i, MeasurableSpace (β i)] + +/-- For products of probability measures and `0 ≤ a`, the sum of the Rényi divergences between the +factors is at most the Rényi divergence between the products. -/ +theorem tsum_renyiDiv_le_renyiDiv_infinitePi (ha : 0 ≤ a) (μ ν : (i : ι) → Measure (β i)) + [∀ i, IsProbabilityMeasure (μ i)] [∀ i, IsProbabilityMeasure (ν i)] : + ∑' i, renyiDiv a (μ i) (ν i) ≤ renyiDiv a (Measure.infinitePi μ) (Measure.infinitePi ν) := by + rw [tsum_eq_iSup_sum] + refine iSup_le fun s ↦ ?_ + calc ∑ i ∈ s, renyiDiv a (μ i) (ν i) = ∑ i : s, renyiDiv a (μ i) (ν i) := + (Finset.sum_coe_sort s _).symm + _ = renyiDiv a (Measure.pi fun i : s ↦ μ i) (Measure.pi fun i : s ↦ ν i) := + (renyiDiv_pi ha).symm + _ ≤ renyiDiv a (Measure.infinitePi μ) (Measure.infinitePi ν) := by + rw [← Measure.infinitePi_map_restrict, ← Measure.infinitePi_map_restrict] + exact renyiDiv_map_le ha _ _ (Finset.measurable_restrict s) + +/-- **Tensorization of the Rényi divergence for countable products**: for a countable family of +probability measures and `0 < a`, `Rₐ(∏ μ i, ∏ ν i) = ∑' i, Rₐ(μ i, ν i)`. -/ +theorem renyiDiv_infinitePi [Countable ι] (ha : 0 < a) (μ ν : (i : ι) → Measure (β i)) + [∀ i, IsProbabilityMeasure (μ i)] [∀ i, IsProbabilityMeasure (ν i)] : + renyiDiv a (Measure.infinitePi μ) (Measure.infinitePi ν) = ∑' i, renyiDiv a (μ i) (ν i) := by + -- restrict to an increasing sequence of finite sets `s n` exhausting `ι` + obtain ⟨s, hs_mono, hs_tendsto⟩ := exists_seq_monotone_tendsto_atTop_atTop (Finset ι) + have hs i : ∃ n, i ∈ s n := + ((tendsto_atTop.1 hs_tendsto {i}).exists).imp fun _ h ↦ Finset.singleton_subset_iff.1 h + refine tendsto_nhds_unique (tendsto_renyiDiv_map_of_iSup_comap_eq ha _ _ + (fun n ↦ Finset.measurable_restrict (s n)) + (fun _ _ hmn ↦ Filtration.piFinset.mono (hs_mono hmn)) + (Filtration.iSup_piFinset_eq_pi hs)) ?_ + simp_rw [Measure.infinitePi_map_restrict, renyiDiv_pi ha.le, + Finset.sum_coe_sort _ fun i ↦ renyiDiv a (μ i) (ν i)] + exact CompleteLattice.summable.hasSum.comp hs_tendsto + +end ProbabilityTheory diff --git a/Statlib/Divergence/Renyi/Variational.lean b/Statlib/Divergence/Renyi/Variational.lean index 7f85dec..c1f6684 100644 --- a/Statlib/Divergence/Renyi/Variational.lean +++ b/Statlib/Divergence/Renyi/Variational.lean @@ -5,11 +5,12 @@ Authors: Rémy Degenne, Lorenzo Luccioli -/ module +public import Statlib.Divergence.KullbackLeibler.CondKL public import Statlib.Divergence.Renyi.Basic public import Statlib.ForMathlib.InformationTheory.KullbackLeibler.EIntegral /-! -# Variational formula for the Rényi divergence +# The Rényi measure and the 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 @@ -21,6 +22,9 @@ 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ₐ(μ, ν)`. +We also compute the Radon-Nikodym derivatives of the Rényi measure with respect to `μ` and `ν`, and +rephrase the variational formula as an infimum of Kullback-Leibler divergences between joint +measures on `Bool × α`. ## Main definitions @@ -32,10 +36,29 @@ everywhere, hence * `isProbabilityMeasure_renyiMeasure`: for probability measures that are not mutually singular and `a ∈ (0, 1)`, `renyiMeasure a μ ν` is a probability measure. +* `rnDeriv_renyiMeasure_right`: for `a ∈ [0, 1]`, + `∂(renyiMeasure a μ ν)/∂ν = (∂μ/∂ν) ^ a * exp (-(a - 1) Rₐ(μ, ν))`, `ν`-almost everywhere. + `rnDeriv_renyiMeasure_right_of_absolutelyContinuous` is the same formula for `a ≥ 0` and `μ ≪ ν`. +* `rnDeriv_renyiMeasure_left`: for `a ∈ [0, 1]`, + `∂(renyiMeasure a μ ν)/∂μ = (∂ν/∂μ) ^ (1 - a) * exp (-(a - 1) Rₐ(μ, ν))`, `μ`-almost everywhere. +* `renyiMeasure_eq_withDensity`: for `a ∈ [0, 1)` or `μ ≪ ν`, the Rényi measure is + `ν.withDensity ((∂μ/∂ν) ^ a * exp (-(a - 1) Rₐ(μ, ν)))`. +* `lintegral_renyiMeasure`: integrals with respect to the Rényi measure. +* `renyiMeasure_smul_smul`: for `c, d ∈ (0, ∞)` and `a ∈ [0, 1)` or `μ ≪ ν`, + `renyiMeasure a (c • μ) (d • ν) = (c ^ a * d ^ (1 - a)) • renyiMeasure a μ ν`. +* `isProbabilityMeasure_renyiMeasure_of_renyiDiv_ne_top`: for probability measures, `a > 0` and + `Rₐ(μ, ν) < ∞`, the Rényi measure 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(ξ, ν))`. +* `mul_renyiDiv_eq_mul_klDiv_renyiMeasure`: for probability measures that are not mutually singular, + the infimum is attained at the Rényi measure. +* `mul_renyiDiv_eq_iInf_klDiv_prod`: with `πₐ = (a, 1 - a)` the prior on `Bool` and + `P = boolKernel μ ν`, `(1 - a) * Rₐ(μ, ν) = ⨅ ξ, KL(πₐ × ξ, πₐ ⊗ P)`. The infimum is attained at + the Rényi measure (`mul_renyiDiv_eq_klDiv_prod_renyiMeasure`), and + `klDiv_boolMeasure_prod_renyiMeasure` computes `KL(πₐ × ξ, ρ ⊗ P)` at that point for any finite + measure `ρ` on `Bool`. ## References @@ -85,6 +108,23 @@ lemma rnDeriv_renyiMeasure (a : ℝ) (μ ν : Measure α) [SigmaFinite μ] [Sigm (renyiMeasure a μ ν).rnDeriv (μ + ν) =ᵐ[μ + ν] renyiDensity a μ ν := Measure.rnDeriv_withDensity _ (measurable_renyiDensity a μ ν) +/-- The Rényi measure of order `1` is `μ`. -/ +@[simp] +lemma renyiMeasure_one [SigmaFinite μ] [SigmaFinite ν] : renyiMeasure 1 μ ν = μ := by + have : renyiDensity 1 μ ν = μ.rnDeriv (μ + ν) := by + ext x + simp [renyiDensity] + rw [renyiMeasure, this, + Measure.withDensity_rnDeriv_eq _ _ (Measure.AbsolutelyContinuous.rfl.add_right ν)] + +/-- The Rényi measure of order `a > 0` between the zero measure and `ν` is zero. -/ +@[simp] +lemma renyiMeasure_zero_left (ha : 0 < a) (ν : Measure α) : renyiMeasure a 0 ν = 0 := by + rw [renyiMeasure, zero_add, ← withDensity_zero] + refine withDensity_congr_ae ?_ + filter_upwards [ν.rnDeriv_zero] with x hx + simp [renyiDensity, hx, ENNReal.zero_rpow_of_pos ha] + lemma sigmaFinite_renyiMeasure [SigmaFinite μ] [SigmaFinite ν] (ha0 : 0 ≤ a) (ha1 : a ≤ 1) : SigmaFinite (renyiMeasure a μ ν) := by refine SigmaFinite.withDensity_of_ne_top ?_ @@ -168,6 +208,179 @@ lemma isProbabilityMeasure_renyiMeasure [IsProbabilityMeasure μ] [IsProbability end RenyiMeasure +section RnDeriv + +/-- Radon-Nikodym derivative of the Rényi measure with respect to `ν`: +`∂(renyiMeasure a μ ν)/∂ν = (∂μ/∂ν) ^ a * exp (-(a - 1) Rₐ(μ, ν))`, `ν`-almost everywhere. -/ +lemma rnDeriv_renyiMeasure_right [SigmaFinite μ] [SigmaFinite ν] (ha0 : 0 ≤ a) (ha1 : a ≤ 1) : + (renyiMeasure a μ ν).rnDeriv ν =ᵐ[ν] + fun x ↦ (μ.rnDeriv ν x) ^ a * ENNReal.ofReal (exp (-(a - 1) * (renyiDiv a μ ν).toReal)) := by + have := sigmaFinite_renyiMeasure (μ := μ) (ν := ν) ha0 ha1 + have hμ : μ ≪ μ + ν := Measure.AbsolutelyContinuous.rfl.add_right ν + have hν : ν ≪ μ + ν := Measure.AbsolutelyContinuous.rfl.add_right' μ + filter_upwards [Measure.rnDeriv_eq_div (renyiMeasure_absolutelyContinuous_add a μ ν) hν, + Measure.rnDeriv_eq_div hμ hν, hν.ae_le (rnDeriv_renyiMeasure a μ ν), + Measure.rnDeriv_pos hν, hν.ae_le (Measure.rnDeriv_lt_top ν (μ + ν))] + with x h1 h2 h3 hq_pos hq_top + set p := μ.rnDeriv (μ + ν) x + set q := ν.rnDeriv (μ + ν) x + set C := ENNReal.ofReal (exp (-(a - 1) * (renyiDiv a μ ν).toReal)) + have hq0 : q ≠ 0 := hq_pos.ne' + have hqa0 : q ^ a ≠ 0 := (ENNReal.rpow_pos hq_pos hq_top.ne).ne' + have hqa_top : q ^ a ≠ ∞ := ENNReal.rpow_ne_top_of_nonneg ha0 hq_top.ne + rw [h1, h3, h2, renyiDensity, ENNReal.div_rpow_of_nonneg _ _ ha0, + ENNReal.rpow_sub _ _ hq0 hq_top.ne, ENNReal.rpow_one] + calc p ^ a * (q / q ^ a) * C / q = p ^ a * C * (q ^ a)⁻¹ * (q * q⁻¹) := by + simp only [div_eq_mul_inv]; ring + _ = p ^ a / q ^ a * C := by + rw [ENNReal.mul_inv_cancel hq0 hq_top.ne, mul_one, div_eq_mul_inv]; ring + +/-- Radon-Nikodym derivative of the Rényi measure with respect to `μ`: +`∂(renyiMeasure a μ ν)/∂μ = (∂ν/∂μ) ^ (1 - a) * exp (-(a - 1) Rₐ(μ, ν))`, `μ`-almost +everywhere. -/ +lemma rnDeriv_renyiMeasure_left [SigmaFinite μ] [SigmaFinite ν] (ha0 : 0 ≤ a) (ha1 : a ≤ 1) : + (renyiMeasure a μ ν).rnDeriv μ =ᵐ[μ] fun x ↦ + (ν.rnDeriv μ x) ^ (1 - a) * ENNReal.ofReal (exp (-(a - 1) * (renyiDiv a μ ν).toReal)) := by + have := sigmaFinite_renyiMeasure (μ := μ) (ν := ν) ha0 ha1 + have hμ : μ ≪ μ + ν := Measure.AbsolutelyContinuous.rfl.add_right ν + have hν : ν ≪ μ + ν := Measure.AbsolutelyContinuous.rfl.add_right' μ + have ha1' : 0 ≤ 1 - a := sub_nonneg.mpr ha1 + filter_upwards [Measure.rnDeriv_eq_div (renyiMeasure_absolutelyContinuous_add a μ ν) hμ, + Measure.rnDeriv_eq_div hν hμ, hμ.ae_le (rnDeriv_renyiMeasure a μ ν), + Measure.rnDeriv_pos hμ, hμ.ae_le (Measure.rnDeriv_lt_top μ (μ + ν))] + with x h1 h2 h3 hp_pos hp_top + set p := μ.rnDeriv (μ + ν) x + set q := ν.rnDeriv (μ + ν) x + set C := ENNReal.ofReal (exp (-(a - 1) * (renyiDiv a μ ν).toReal)) + have hp0 : p ≠ 0 := hp_pos.ne' + have h0 : p ^ (1 - a) ≠ 0 := (ENNReal.rpow_pos hp_pos hp_top.ne).ne' + have htop : p ^ (1 - a) ≠ ∞ := ENNReal.rpow_ne_top_of_nonneg ha1' hp_top.ne + have key : p ^ a = p * (p ^ (1 - a))⁻¹ := by + have h : p ^ (1 - a) * p ^ a = p := by + rw [← ENNReal.rpow_add _ _ hp0 hp_top.ne, sub_add_cancel, ENNReal.rpow_one] + calc p ^ a = (p ^ (1 - a) * p ^ a) * (p ^ (1 - a))⁻¹ := by + rw [mul_comm (p ^ (1 - a)), mul_assoc, ENNReal.mul_inv_cancel h0 htop, mul_one] + _ = p * (p ^ (1 - a))⁻¹ := by rw [h] + rw [h1, h3, h2, renyiDensity, ENNReal.div_rpow_of_nonneg _ _ ha1', key] + calc p * (p ^ (1 - a))⁻¹ * q ^ (1 - a) * C / p + = q ^ (1 - a) * C * (p ^ (1 - a))⁻¹ * (p * p⁻¹) := by + simp only [div_eq_mul_inv]; ring + _ = q ^ (1 - a) / p ^ (1 - a) * C := by + rw [ENNReal.mul_inv_cancel hp0 hp_top.ne, mul_one, div_eq_mul_inv]; ring + +end RnDeriv + +section WithDensity + +/-- For `a ∈ [0, 1)` or `μ ≪ ν`, the Rényi measure is +`ν.withDensity ((∂μ/∂ν) ^ a * exp (-(a - 1) Rₐ(μ, ν)))`. -/ +lemma renyiMeasure_eq_withDensity [SigmaFinite μ] [SigmaFinite ν] (ha : 0 ≤ a) + (h : a < 1 ∨ μ ≪ ν) : + renyiMeasure a μ ν = ν.withDensity + (fun x ↦ ((∂μ/∂ν) x) ^ a * ENNReal.ofReal (exp (-(a - 1) * (renyiDiv a μ ν).toReal))) := by + rcases h with ha1 | hμν + · have := sigmaFinite_renyiMeasure (μ := μ) (ν := ν) ha ha1.le + rw [← Measure.withDensity_rnDeriv_eq _ ν (renyiMeasure_absolutelyContinuous_right μ ha1)] + exact withDensity_congr_ae (rnDeriv_renyiMeasure_right ha ha1.le) + have hν : ν ≪ μ + ν := Measure.AbsolutelyContinuous.rfl.add_right' μ + ext s hs + rw [renyiMeasure, withDensity_apply _ hs, withDensity_apply _ hs, + ← setLIntegral_rnDeriv_mul hν (by fun_prop) hs] + refine lintegral_congr_ae (ae_restrict_of_ae ?_) + filter_upwards [Measure.rnDeriv_mul_rnDeriv (κ := μ + ν) hμν, + Measure.rnDeriv_lt_top ν (μ + ν)] with x hx hq_top + set q := ν.rnDeriv (μ + ν) x + have hq : q ^ a * q ^ (1 - a) = q := by + rw [← ENNReal.rpow_add_of_add_pos hq_top.ne _ _ (by simp), add_sub_cancel, ENNReal.rpow_one] + rw [renyiDensity, ← hx, Pi.mul_apply, ENNReal.mul_rpow_of_nonneg _ _ ha, mul_assoc _ (q ^ a), hq] + ring + +/-- For `μ ≪ ν`, the Rényi measure is σ-finite. -/ +lemma sigmaFinite_renyiMeasure_of_absolutelyContinuous [SigmaFinite μ] [SigmaFinite ν] + (hμν : μ ≪ ν) (ha : 0 ≤ a) : + SigmaFinite (renyiMeasure a μ ν) := by + rw [renyiMeasure_eq_withDensity ha (.inr hμν)] + refine SigmaFinite.withDensity_of_ne_top ?_ + filter_upwards [μ.rnDeriv_lt_top ν] with x hx + exact ENNReal.mul_ne_top (ENNReal.rpow_ne_top_of_nonneg ha hx.ne) ENNReal.ofReal_ne_top + +/-- Radon-Nikodym derivative of the Rényi measure with respect to `ν`, for `μ ≪ ν`. -/ +lemma rnDeriv_renyiMeasure_right_of_absolutelyContinuous [SigmaFinite μ] [SigmaFinite ν] + (hμν : μ ≪ ν) (ha : 0 ≤ a) : + (renyiMeasure a μ ν).rnDeriv ν =ᵐ[ν] + fun x ↦ (μ.rnDeriv ν x) ^ a * ENNReal.ofReal (exp (-(a - 1) * (renyiDiv a μ ν).toReal)) := by + rw [renyiMeasure_eq_withDensity ha (.inr hμν)] + exact Measure.rnDeriv_withDensity _ (by fun_prop) + +/-- Integral with respect to the Rényi measure, for `a ∈ [0, 1)` or `μ ≪ ν`. -/ +lemma lintegral_renyiMeasure [SigmaFinite μ] [SigmaFinite ν] (ha : 0 ≤ a) (h : a < 1 ∨ μ ≪ ν) + {g : α → ℝ≥0∞} : + ∫⁻ x, g x ∂(renyiMeasure a μ ν) + = ENNReal.ofReal (exp (-(a - 1) * (renyiDiv a μ ν).toReal)) + * ∫⁻ x, ((∂μ/∂ν) x) ^ a * g x ∂ν := by + rw [renyiMeasure_eq_withDensity ha h, + lintegral_withDensity_eq_lintegral_mul_non_measurable _ (by fun_prop) ?_, + ← lintegral_const_mul' _ _ ENNReal.ofReal_ne_top] + · congr with x + simp only [Pi.mul_apply] + ring + · filter_upwards [μ.rnDeriv_lt_top ν] with x hx + exact ENNReal.mul_lt_top (ENNReal.rpow_lt_top_of_nonneg ha hx.ne) ENNReal.ofReal_lt_top + +/-- Scaling the measures scales the Rényi measure: for `c, d ∈ (0, ∞)` and `a ∈ [0, 1)` or `μ ≪ ν`, +`renyiMeasure a (c • μ) (d • ν) = (c ^ a * d ^ (1 - a)) • renyiMeasure a μ ν`. -/ +lemma renyiMeasure_smul_smul [IsFiniteMeasure μ] [IsFiniteMeasure ν] (ha : 0 ≤ a) + (h : a < 1 ∨ μ ≪ ν) {c d : ℝ≥0∞} (hc0 : c ≠ 0) (hc : c ≠ ∞) (hd0 : d ≠ 0) (hd : d ≠ ∞) : + renyiMeasure a (c • μ) (d • ν) = (c ^ a * d ^ (1 - a)) • renyiMeasure a μ ν := by + have := μ.smul_finite hc + have := ν.smul_finite hd + have h' : a < 1 ∨ c • μ ≪ d • ν := h.imp_right fun hμν ↦ + Measure.smul_absolutelyContinuous.trans (hμν.trans (Measure.absolutelyContinuous_smul hd0)) + -- `∂(c • μ)/∂(d • ν) = d⁻¹ * c * ∂μ/∂ν`, `ν`-almost everywhere + have h_eq : (fun x ↦ (c • μ).rnDeriv (d • ν) x ^ a) + =ᵐ[ν] fun x ↦ (d⁻¹ * c) ^ a * (∂μ/∂ν) x ^ a := by + filter_upwards [Measure.rnDeriv_smul_right_of_ne_top' (c • μ) ν hd0 hd, + Measure.rnDeriv_smul_left_of_ne_top' μ ν hc] with x hx1 hx2 + rw [hx1, Pi.smul_apply, hx2, Pi.smul_apply, smul_eq_mul, smul_eq_mul, ← mul_assoc, + ENNReal.mul_rpow_of_nonneg _ _ ha] + have h_const : d * (d⁻¹ * c) ^ a = c ^ a * d ^ (1 - a) := by + rw [ENNReal.mul_rpow_of_nonneg _ _ ha, ENNReal.inv_rpow, ENNReal.rpow_sub _ _ hd0 hd, + ENNReal.rpow_one, div_eq_mul_inv] + ring + rw [renyiMeasure_eq_withDensity ha h', renyiMeasure_eq_withDensity ha h, + renyiDiv_smul_smul ha hc0 hc hd0 hd, withDensity_smul_measure, ← h_const, ← smul_smul, + ← withDensity_smul' _ _ (ENNReal.rpow_ne_top_of_nonneg ha + (ENNReal.mul_ne_top (ENNReal.inv_ne_top.mpr hd0) hc))] + congr 1 + refine withDensity_congr_ae ?_ + filter_upwards [h_eq] with x hx + simp only [Pi.smul_apply, smul_eq_mul, hx, mul_assoc] + +/-- For probability measures and `a > 0` with `Rₐ(μ, ν) < ∞`, the Rényi measure is a probability +measure. -/ +lemma isProbabilityMeasure_renyiMeasure_of_renyiDiv_ne_top [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] (ha : 0 < a) (h : renyiDiv a μ ν ≠ ∞) : + IsProbabilityMeasure (renyiMeasure a μ ν) := by + rcases lt_trichotomy a 1 with ha1 | rfl | ha1 + · exact isProbabilityMeasure_renyiMeasure ha ha1 + fun h_ms ↦ h (renyiDiv_of_mutuallySingular ha.le h_ms) + · rw [renyiMeasure_one] + infer_instance + obtain ⟨h_int, hμν⟩ := (renyiDiv_ne_top_iff_of_one_lt ha1).mp h + have h_pos := integral_rpow_rnDeriv_pos_of_renyiDiv_ne_top ha h + have h_lint : ∫⁻ x, ((∂μ/∂ν) x) ^ a ∂ν = ENNReal.ofReal (∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν) := by + rw [integral_rpow_rnDeriv_eq_toReal_lintegral ha.le, + ENNReal.ofReal_toReal ((integrable_rpow_rnDeriv_iff_lintegral_ne_top ha.le).mp h_int)] + constructor + rw [← setLIntegral_one, Measure.restrict_univ, lintegral_renyiMeasure ha.le (.inr hμν)] + simp only [mul_one] + rw [h_lint, ← ENNReal.ofReal_mul (exp_pos _).le, + toReal_renyiDiv_of_ne_top_of_isProbabilityMeasure ha ha1.ne' h, ← mul_assoc, neg_mul, + mul_inv_cancel₀ (sub_ne_zero.mpr ha1.ne'), neg_one_mul, exp_neg, exp_log h_pos, + inv_mul_cancel₀ h_pos.ne', ENNReal.ofReal_one] + +end WithDensity + section Variational /-- For `ξ ≪ μ` and `ξ ≪ ν`, the log-likelihood ratios satisfy @@ -292,6 +505,91 @@ theorem mul_renyiDiv_eq_iInf_klDiv [IsProbabilityMeasure μ] [IsProbabilityMeasu · rw [mul_klDiv_add_mul_klDiv ha0 ha1 (renyiMeasure_absolutelyContinuous_left ν ha0) (renyiMeasure_absolutelyContinuous_right μ ha1), klDiv_self, zero_add] +/-- For probability measures, `a ∈ (0, 1)` and every probability measure `ξ`, +`(1 - a) * Rₐ(μ, ν) ≤ a * KL(ξ, μ) + (1 - a) * KL(ξ, ν)`. This is the easy half of the variational +formula `mul_renyiDiv_eq_iInf_klDiv`. -/ +lemma mul_renyiDiv_le_mul_klDiv_add_mul_klDiv (μ ν ξ : Measure α) [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] [IsProbabilityMeasure ξ] (ha0 : 0 < a) (ha1 : a < 1) : + ENNReal.ofReal (1 - a) * renyiDiv a μ ν + ≤ ENNReal.ofReal a * klDiv ξ μ + ENNReal.ofReal (1 - a) * klDiv ξ ν := + (mul_renyiDiv_eq_iInf_klDiv ha0 ha1).trans_le (iInf₂_le ξ ‹_›) + +/-- For probability measures `μ`, `ν` that are not mutually singular and `a ∈ (0, 1)`, +`(1 - a) * Rₐ(μ, ν) = a * KL(μ^(a, ν), μ) + (1 - a) * KL(μ^(a, ν), ν)`, in which +`μ^(a, ν) = renyiMeasure a μ ν`. -/ +theorem mul_renyiDiv_eq_mul_klDiv_renyiMeasure [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (ha0 : 0 < a) (ha1 : a < 1) (h_ms : ¬ μ ⟂ₘ ν) : + ENNReal.ofReal (1 - a) * renyiDiv a μ ν + = ENNReal.ofReal a * klDiv (renyiMeasure a μ ν) μ + + ENNReal.ofReal (1 - a) * klDiv (renyiMeasure a μ ν) ν := by + have := isProbabilityMeasure_renyiMeasure ha0 ha1 h_ms + rw [mul_klDiv_add_mul_klDiv ha0 ha1 (renyiMeasure_absolutelyContinuous_left ν ha0) + (renyiMeasure_absolutelyContinuous_right μ ha1), klDiv_self, zero_add] + +/-- For probability measures that are not mutually singular and `a ∈ (0, 1)`, the +Kullback-Leibler divergence from the tilted measure `renyiMeasure a μ ν` to `μ` is finite. -/ +lemma klDiv_renyiMeasure_left_ne_top [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (ha0 : 0 < a) (ha1 : a < 1) (h_ms : ¬ μ ⟂ₘ ν) : + klDiv (renyiMeasure a μ ν) μ ≠ ∞ := by + have h := ENNReal.mul_ne_top (ENNReal.ofReal_ne_top (r := 1 - a)) + (mt (renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha0.le ha1).mp h_ms) + rw [mul_renyiDiv_eq_mul_klDiv_renyiMeasure ha0 ha1 h_ms] at h + exact fun h' ↦ (ENNReal.add_ne_top.mp h).1 (by rw [h', ENNReal.mul_top (by simpa using ha0)]) + +/-- For probability measures that are not mutually singular and `a ∈ (0, 1)`, the +Kullback-Leibler divergence from the tilted measure `renyiMeasure a μ ν` to `ν` is finite. -/ +lemma klDiv_renyiMeasure_right_ne_top [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (ha0 : 0 < a) (ha1 : a < 1) (h_ms : ¬ μ ⟂ₘ ν) : + klDiv (renyiMeasure a μ ν) ν ≠ ∞ := by + have h := ENNReal.mul_ne_top (ENNReal.ofReal_ne_top (r := 1 - a)) + (mt (renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha0.le ha1).mp h_ms) + rw [mul_renyiDiv_eq_mul_klDiv_renyiMeasure ha0 ha1 h_ms] at h + exact fun h' ↦ (ENNReal.add_ne_top.mp h).2 (by rw [h', ENNReal.mul_top (by simpa using ha1)]) + +/-- **Variational formula** for the Rényi divergence, as an infimum of Kullback-Leibler divergences +between joint measures: let `πₐ = boolMeasure a (1 - a)` be the prior on `Bool` and +`P = boolKernel μ ν` the kernel with `P false = μ` and `P true = ν`. Then for `a ∈ (0, 1)`, +`(1 - a) * Rₐ(μ, ν) = ⨅ ξ, KL(πₐ × ξ, πₐ ⊗ₘ P)` over probability measures `ξ`. -/ +theorem mul_renyiDiv_eq_iInf_klDiv_prod [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (ha0 : 0 < a) (ha1 : a < 1) : + ENNReal.ofReal (1 - a) * renyiDiv a μ ν + = ⨅ (ξ : Measure α) (_ : IsProbabilityMeasure ξ), + klDiv ((Measure.boolMeasure (ENNReal.ofReal a) (ENNReal.ofReal (1 - a))).prod ξ) + (Measure.boolMeasure (ENNReal.ofReal a) (ENNReal.ofReal (1 - a)) + ⊗ₘ Kernel.boolKernel μ ν) := by + rw [mul_renyiDiv_eq_iInf_klDiv ha0 ha1] + congr with ξ + congr with hξ + rw [klDiv_prod_compProd_boolKernel, Measure.boolMeasure_apply_false, + Measure.boolMeasure_apply_true] + +/-- The infimum in `mul_renyiDiv_eq_iInf_klDiv_prod` is attained at the Rényi measure +`renyiMeasure a μ ν`. -/ +lemma mul_renyiDiv_eq_klDiv_prod_renyiMeasure [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (ha0 : 0 < a) (ha1 : a < 1) (h_ms : ¬ μ ⟂ₘ ν) : + ENNReal.ofReal (1 - a) * renyiDiv a μ ν + = klDiv ((Measure.boolMeasure (ENNReal.ofReal a) (ENNReal.ofReal (1 - a))).prod + (renyiMeasure a μ ν)) + (Measure.boolMeasure (ENNReal.ofReal a) (ENNReal.ofReal (1 - a)) + ⊗ₘ Kernel.boolKernel μ ν) := by + have := isProbabilityMeasure_renyiMeasure ha0 ha1 h_ms + rw [klDiv_prod_compProd_boolKernel, Measure.boolMeasure_apply_false, + Measure.boolMeasure_apply_true, mul_renyiDiv_eq_mul_klDiv_renyiMeasure ha0 ha1 h_ms] + +/-- For `πₐ = (a, 1 - a)`, the Rényi measure `ξ = renyiMeasure a μ ν` and a finite measure `ρ` on +`Bool`, `KL(πₐ × ξ, ρ ⊗ₘ boolKernel μ ν) = KL(πₐ, ρ) + (1 - a) * Rₐ(μ, ν)`. For `ρ = πₐ`, this is +`mul_renyiDiv_eq_klDiv_prod_renyiMeasure`. -/ +lemma klDiv_boolMeasure_prod_renyiMeasure (μ ν : Measure α) [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] (ρ : Measure Bool) [IsFiniteMeasure ρ] (ha0 : 0 < a) (ha1 : a < 1) + (h_ms : ¬ μ ⟂ₘ ν) : + klDiv ((Measure.boolMeasure (.ofReal a) (.ofReal (1 - a))).prod (renyiMeasure a μ ν)) + (ρ ⊗ₘ Kernel.boolKernel μ ν) + = klDiv (Measure.boolMeasure (.ofReal a) (.ofReal (1 - a))) ρ + + ENNReal.ofReal (1 - a) * renyiDiv a μ ν := by + have := isProbabilityMeasure_renyiMeasure ha0 ha1 h_ms + rw [mul_renyiDiv_eq_klDiv_prod_renyiMeasure ha0 ha1 h_ms, ← Measure.compProd_const, + klDiv_compProd_eq_add_condKL, ← condKL] + end Variational end ProbabilityTheory diff --git a/Statlib/Divergence/StatInfo/Basic.lean b/Statlib/Divergence/StatInfo/Basic.lean index 1ddc7be..ffe1ba6 100644 --- a/Statlib/Divergence/StatInfo/Basic.lean +++ b/Statlib/Divergence/StatInfo/Basic.lean @@ -18,7 +18,7 @@ the decrease of the Bayes risk of the simple binary hypothesis testing problem b 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). +informations (Liese and Vajda, see `Statlib.Divergence.FDiv.IntegralRepresentation`). ## Main definitions @@ -28,6 +28,9 @@ informations (Liese and Vajda). ## Main statements +* `statInfo_eq_statInfo_one_one`: the statistical information for a prior `π` is the statistical + information for the prior `(1, 1)` of the measures weighted by `π`. +* `statInfo_smul_prior`: the statistical information is positively homogeneous in the prior. * `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 `μ`. @@ -61,16 +64,31 @@ variable {𝒳 𝒳' : Type*} {m𝒳 : MeasurableSpace 𝒳} {m𝒳' : Measurabl observation is discarded. -/ noncomputable def statInfo (μ ν : Measure 𝒳) (π : Measure Bool) : ℝ≥0∞ := - riskIncrease simpleBinaryLoss (Kernel.boolKernel μ ν) π + riskIncrease zeroOneLoss (Kernel.boolKernel μ ν) π lemma statInfo_eq_riskIncrease (μ ν : Measure 𝒳) (π : Measure Bool) : - statInfo μ ν π = riskIncrease simpleBinaryLoss (Kernel.boolKernel μ ν) π := rfl + statInfo μ ν π = riskIncrease zeroOneLoss (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] + rw [statInfo, riskIncrease_eq_iInf_sub' measurable_zeroOneLoss, iInf_bool_eq] simp [lintegral_bool, bayesBinaryRisk, mul_comm] +/-- The statistical information for a prior `π` is the statistical information for the prior +`(1, 1)` (the counting measure on `Bool`) of the measures weighted by `π`. -/ +lemma statInfo_eq_statInfo_one_one (μ ν : Measure 𝒳) (π : Measure Bool) : + statInfo μ ν π = statInfo (π {false} • μ) (π {true} • ν) (Measure.boolMeasure 1 1) := by + rw [statInfo_eq_min_sub, statInfo_eq_min_sub, bayesBinaryRisk_eq_bayesBinaryRisk_one_one] + simp + +/-- The statistical information is positively homogeneous in the prior: scaling the prior by a +finite factor scales the statistical information by the same factor. -/ +lemma statInfo_smul_prior (μ ν : Measure 𝒳) (π : Measure Bool) {c : ℝ≥0∞} (hc : c ≠ ∞) : + statInfo μ ν (c • π) = c * statInfo μ ν π := by + rw [statInfo_eq_min_sub, statInfo_eq_min_sub, bayesBinaryRisk_smul_prior μ ν π hc, + Measure.smul_apply, Measure.smul_apply, smul_eq_mul, smul_eq_mul, mul_assoc, mul_assoc, + ← mul_min, ENNReal.mul_sub fun _ _ ↦ hc] + @[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] @@ -112,7 +130,7 @@ lemma statInfo_of_measure_false_eq_zero (μ ν : Measure 𝒳) (hπ : π {false} lemma statInfo_comp_le (μ ν : Measure 𝒳) (π : Measure Bool) (η : Kernel 𝒳 𝒳') [IsMarkovKernel η] : statInfo (η ∘ₘ μ) (η ∘ₘ ν) π ≤ statInfo μ ν π := by simpa [statInfo, Kernel.comp_boolKernel] - using riskIncrease_comp_le simpleBinaryLoss (Kernel.boolKernel μ ν) π η + using riskIncrease_comp_le zeroOneLoss (Kernel.boolKernel μ ν) π η /-- **Data processing inequality** for the statistical information, applied to the indicator of an event `E`. -/ @@ -153,6 +171,24 @@ lemma statInfo_eq_min_sub_lintegral' {ζ : Measure 𝒳} [IsFiniteMeasure μ] [I rw [mul_min, mul_comm, mul_comm _ (π _ * _), mul_assoc, mul_assoc] congr +/-- The statistical information `I_{(a, b)}(μ, ν)` for the prior `(a, b)` is a measurable function +of `(a, b)`. -/ +lemma measurable_statInfo_boolMeasure_ofReal (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] : + Measurable fun p : ℝ × ℝ ↦ + statInfo μ ν (Measure.boolMeasure (ENNReal.ofReal p.1) (ENNReal.ofReal p.2)) := by + have hμ : μ ≪ μ + ν := Measure.AbsolutelyContinuous.rfl.add_right ν + have hν : ν ≪ μ + ν := Measure.absolutelyContinuous_of_le (Measure.le_add_left le_rfl) + have h_eq (p : ℝ × ℝ) : + statInfo μ ν (Measure.boolMeasure (ENNReal.ofReal p.1) (ENNReal.ofReal p.2)) + = min (ENNReal.ofReal p.1 * μ univ) (ENNReal.ofReal p.2 * ν univ) + - ∫⁻ x, min (ENNReal.ofReal p.1 * (∂μ/∂(μ + ν)) x) + (ENNReal.ofReal p.2 * (∂ν/∂(μ + ν)) x) ∂(μ + ν) := by + simpa using statInfo_eq_min_sub_lintegral' + (Measure.boolMeasure (ENNReal.ofReal p.1) (ENNReal.ofReal p.2)) hμ hν + simp_rw [h_eq] + exact Measurable.sub (by fun_prop) (Measurable.lintegral_prod_right (by fun_prop)) + lemma toReal_statInfo_eq_min_sub_integral (μ ν : Measure 𝒳) [IsFiniteMeasure μ] [IsFiniteMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] : (statInfo μ ν π).toReal = min (π {false} * μ univ).toReal (π {true} * ν univ).toReal diff --git a/Statlib/Divergence/StatInfo/CurvatureMeasure.lean b/Statlib/Divergence/StatInfo/CurvatureMeasure.lean new file mode 100644 index 0000000..7aa5fa4 --- /dev/null +++ b/Statlib/Divergence/StatInfo/CurvatureMeasure.lean @@ -0,0 +1,163 @@ +/- +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.CurvatureMeasure +public import Statlib.Divergence.StatInfo.StatInfoDivFun + +/-! +# Curvature measure of the statistical information divergence functions + +For `0 < β` and `0 < γ`, the hockey-stick function `statInfoFun β γ` is piecewise linear on +`[0, ∞)`, with a single kink at `γ / β` where its slope increases by `β`. Its curvature measure is +therefore `β • dirac (γ / β)`, plus an infinite atom at `0`: by convention, the right derivative +`rightDerivStieltjes` of a divergence function is `⊥` below the lower end `xmin` of its effective +domain (here `0`), and its right derivative at `0` is finite. + +## Main statements + +* `measure_rightDerivStieltjes_statInfoDivFun`: the Stieltjes measure of the right derivative of + `statInfoDivFun β γ` is `∞ • dirac 0 + β • dirac (γ / β)`. +* `curvatureMeasure_statInfoDivFun`, `curvatureMeasureReal_statInfoDivFun`: the curvature measure + of `statInfoDivFun β γ`, as a measure on `ℝ≥0∞` and on `ℝ`. +* `curvatureMeasureReal_statInfoDivFun_restrict_Ioi`: on `(0, ∞)`, the curvature measure of + `statInfoDivFun β γ` is `β • dirac (γ / β)`. +-/ + +@[expose] public section + +open MeasureTheory Set Filter + +open scoped ENNReal NNReal Topology + +namespace ProbabilityTheory + +variable {β γ : ℝ} + +section RightDeriv + +/-- The right derivative of `statInfoDivFun β γ` at `0 ≤ x`, for `0 ≤ β`: it is `-β` (if `γ ≤ β`) +or `0` (if `β < γ`) before the kink `γ / β`, and it increases by `β` at the kink. -/ +lemma rightDerivStieltjes_statInfoDivFun_of_nonneg (hβ : 0 ≤ β) {x : ℝ} (hx : 0 ≤ x) : + (statInfoDivFun β γ).rightDerivStieltjes x + = (((if γ ≤ β then -β else 0) + if γ / β ≤ x then β else 0 : ℝ) : EReal) := by + have h_pos {x : ℝ} (hx : 0 < x) : (statInfoDivFun β γ).rightDerivStieltjes x + = (((if γ ≤ β then -β else 0) + if γ / β ≤ x then β else 0 : ℝ) : EReal) := by + rw [DivFunction.rightDerivStieltjes_of_mem_interior (by simpa using hx) (by simp)] + congr 1 + refine HasDerivWithinAt.derivWithin ?_ (uniqueDiffWithinAt_Ioi x) + refine (hasDerivWithinAt_statInfoFun_Ioi hβ x).congr_of_eventuallyEq ?_ + (realFun_statInfoDivFun_of_nonneg hx.le) + filter_upwards [self_mem_nhdsWithin] with y (hy : x < y) + exact realFun_statInfoDivFun_of_nonneg (hx.trans hy).le + rcases hx.lt_or_eq with hx | rfl + · exact h_pos hx + -- at `0`, the right derivative is the infimum of its values on `(0, ∞)` + rw [← ERealStieltjes.iInf_Ioi_eq] + refine le_antisymm ?_ (le_iInf fun r ↦ ?_) + · by_cases hc : γ / β ≤ 0 + · refine (iInf_le _ ⟨1, zero_lt_one⟩).trans_eq ?_ + simp [h_pos zero_lt_one, hc, hc.trans zero_le_one] + · have h_half : 0 < γ / β / 2 := by linarith + refine (iInf_le _ ⟨γ / β / 2, h_half⟩).trans_eq ?_ + simp [h_pos h_half, hc, show ¬ γ / β ≤ γ / β / 2 by linarith] + · rw [h_pos r.2] + exact EReal.coe_le_coe_iff.mpr (by split_ifs <;> linarith [mem_Ioi.mp r.2]) + +end RightDeriv + +section CurvatureMeasure + +/-- The Stieltjes measure of the right derivative of `statInfoDivFun β γ` has an atom of mass `β` +at the kink `γ / β`, and an infinite atom at `0`, where the right derivative jumps from `⊥` to a +finite value. -/ +lemma measure_rightDerivStieltjes_statInfoDivFun (hβ : 0 < β) (hγ : 0 < γ) : + (statInfoDivFun β γ).rightDerivStieltjes.measure + = ∞ • Measure.dirac 0 + ENNReal.ofReal β • Measure.dirac (γ / β) := by + set g := (statInfoDivFun β γ).rightDerivStieltjes + set a : ℝ := if γ ≤ β then -β else 0 + have hc : 0 < γ / β := div_pos hγ hβ + have hg_pos (x : ℝ) (hx : 0 ≤ x) : g x = ((a + if γ / β ≤ x then β else 0 : ℝ) : EReal) := + rightDerivStieltjes_statInfoDivFun_of_nonneg hβ.le hx + have hg0 : g 0 = a := by simpa [hc.not_ge] using hg_pos 0 le_rfl + have hg_neg (x : ℝ) (hx : x < 0) : g x = ⊥ := DivFunction.rightDerivStieltjes_of_neg hx + -- the part of the measure on `Iic 0` is an infinite atom at `0` + have h_Iic : g.measure.restrict (Iic 0) = ∞ • Measure.dirac 0 := by + ext s hs + rw [Measure.restrict_apply hs, Measure.smul_apply, Measure.dirac_apply' _ hs, smul_eq_mul] + by_cases h0 : (0 : ℝ) ∈ s + · rw [indicator_of_mem h0, Pi.one_apply, mul_one] + refine top_le_iff.mp ?_ + calc ∞ = g.measure {0} := (g.measure_singleton_eq_top fun y hy ↦ by + rw [hg0, hg_neg y hy]; simp).symm + _ ≤ g.measure (s ∩ Iic 0) := + measure_mono (singleton_subset_iff.mpr ⟨h0, mem_Iic.mpr le_rfl⟩) + · rw [indicator_of_notMem h0, mul_zero] + refine measure_mono_null (fun x hx ↦ ?_) + (g.measure_Iio_eq_zero_of_forall_lt_eq_bot hg_neg) + exact lt_of_le_of_ne hx.2 fun h ↦ h0 (h ▸ hx.1) + -- the part of the measure on `Ioi 0` is an atom of mass `β` at `γ / β` + have h_Ioi_univ : g.measure (Ioi 0) = ENNReal.ofReal β := by + have h_tendsto : Tendsto g atTop (𝓝 ((a + β : ℝ) : EReal)) := by + refine tendsto_const_nhds.congr' ?_ + filter_upwards [eventually_ge_atTop (γ / β)] with x hx + rw [hg_pos x (hc.le.trans hx), ite_eq_left hx] + rw [g.measure_Ioi h_tendsto, hg0, ← EReal.coe_sub, add_sub_cancel_left, + EReal.toENNReal_of_ne_top (EReal.coe_ne_top _), EReal.toReal_coe] + have : IsFiniteMeasure (g.measure.restrict (Ioi 0)) := ⟨by + rw [Measure.restrict_apply_univ, h_Ioi_univ] + exact ENNReal.ofReal_lt_top⟩ + have h_Ioi : g.measure.restrict (Ioi 0) = ENNReal.ofReal β • Measure.dirac (γ / β) := by + refine Measure.ext_of_Iic _ _ fun x ↦ ?_ + rw [Measure.restrict_apply measurableSet_Iic, Iic_inter_Ioi, Measure.smul_apply, + Measure.dirac_apply' _ measurableSet_Iic, smul_eq_mul] + rcases le_or_gt x 0 with hx | hx + · rw [Ioc_eq_empty (not_lt.mpr hx), measure_empty, + indicator_of_notMem (by simp only [mem_Iic, not_le]; linarith), mul_zero] + · rw [g.measure_Ioc, hg_pos x hx.le, hg0, ← EReal.coe_sub, add_sub_cancel_left] + by_cases hcx : γ / β ≤ x + · rw [ite_eq_left hcx, indicator_of_mem (mem_Iic.mpr hcx), Pi.one_apply, mul_one, + EReal.toENNReal_of_ne_top (EReal.coe_ne_top _), EReal.toReal_coe] + · rw [ite_eq_right hcx, indicator_of_notMem (by simpa using hcx), mul_zero] + simp + rw [← Measure.restrict_add_restrict_compl (μ := g.measure) measurableSet_Iic, compl_Iic, h_Iic, + h_Ioi] + +/-- **Curvature measure of the statistical information divergence functions**: for `0 < β` and +`0 < γ`, the curvature measure of `statInfoDivFun β γ` is `β • dirac (γ / β)`, plus an infinite +atom at `0 = (statInfoDivFun β γ).xmin`. -/ +theorem curvatureMeasure_statInfoDivFun (hβ : 0 < β) (hγ : 0 < γ) : + (statInfoDivFun β γ).curvatureMeasure + = ∞ • Measure.dirac 0 + ENNReal.ofReal β • Measure.dirac (ENNReal.ofReal (γ / β)) := by + rw [DivFunction.curvatureMeasure, measure_rightDerivStieltjes_statInfoDivFun hβ hγ, + Measure.map_add _ _ ENNReal.measurable_ofReal, Measure.map_smul, Measure.map_smul, + Measure.map_dirac' ENNReal.measurable_ofReal, Measure.map_dirac' ENNReal.measurable_ofReal, + ENNReal.ofReal_zero] + all_goals fun_prop + +/-- **Curvature measure of the statistical information divergence functions**, as a measure on +`ℝ`: for `0 < β` and `0 < γ`, it is `β • dirac (γ / β)`, plus an infinite atom at `0`. -/ +theorem curvatureMeasureReal_statInfoDivFun (hβ : 0 < β) (hγ : 0 < γ) : + (statInfoDivFun β γ).curvatureMeasureReal + = ∞ • Measure.dirac 0 + ENNReal.ofReal β • Measure.dirac (γ / β) := by + rw [DivFunction.curvatureMeasureReal, curvatureMeasure_statInfoDivFun hβ hγ, + Measure.map_add _ _ ENNReal.measurable_toReal, Measure.map_smul, Measure.map_smul, + Measure.map_dirac' ENNReal.measurable_toReal, Measure.map_dirac' ENNReal.measurable_toReal, + ENNReal.toReal_zero, ENNReal.toReal_ofReal (div_pos hγ hβ).le] + all_goals fun_prop + +/-- The restriction to `(0, ∞)` of the curvature measure of `statInfoDivFun β γ` is the Dirac mass +`β • dirac (γ / β)`. -/ +lemma curvatureMeasureReal_statInfoDivFun_restrict_Ioi (hβ : 0 < β) (hγ : 0 < γ) : + (statInfoDivFun β γ).curvatureMeasureReal.restrict (Ioi 0) + = ENNReal.ofReal β • Measure.dirac (γ / β) := by + rw [curvatureMeasureReal_statInfoDivFun hβ hγ, Measure.restrict_add, Measure.restrict_smul, + Measure.restrict_smul, restrict_dirac' measurableSet_Ioi, restrict_dirac' measurableSet_Ioi] + simp [div_pos hγ hβ] + +end CurvatureMeasure + +end ProbabilityTheory diff --git a/Statlib/Divergence/StatInfo/Event.lean b/Statlib/Divergence/StatInfo/Event.lean new file mode 100644 index 0000000..c3d7416 --- /dev/null +++ b/Statlib/Divergence/StatInfo/Event.lean @@ -0,0 +1,93 @@ +/- +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.TotalVariation +public import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.Hahn +public import Statlib.ForMathlib.MeasureTheory.Measure.Real + +/-! +# Statistical information as a supremum over events + +We express the statistical information `statInfo μ ν π` of finite measures as a supremum over +events of differences of the measures weighted by the prior, using a Hahn decomposition and the +relation between the statistical information and the total variation distance. + +## Main statements + +* `statInfo_eq_iSup_sub`, `statInfo_eq_iSup_sub'`: for finite measures and a finite prior, + `I_π(μ, ν) = sup_E (π₁ ν(E) - π₀ μ(E)) - max {0, π₁ ν(𝒳) - π₀ μ(𝒳)}`, and the symmetric + formula. Since the subtraction in `ℝ≥0∞` is truncated at `0`, the maximum is written as a + subtraction. +* `statInfo_one_one_eq_iSup_sub`: if `μ(𝒳) ≤ ν(𝒳)`, the statistical information for the prior + `(1, 1)` is `sup_E (μ(E) - ν(E))`. + +In all these statements, the suprema are over measurable sets `E`. +-/ + +@[expose] public section + +open MeasureTheory Set + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {𝒳 : Type*} {m𝒳 : MeasurableSpace 𝒳} {μ ν : Measure 𝒳} + +/-- The statistical information for the prior `(1, 1)` is +`sup_E (ν(E) - μ(E)) - max {0, ν(𝒳) - μ(𝒳)}`. -/ +private lemma statInfo_one_one_eq_iSup_sub_sub [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + statInfo μ ν (Measure.boolMeasure 1 1) + = (⨆ E, ⨆ (_ : MeasurableSet E), ν E - μ E) - (ν univ - μ univ) := by + obtain ⟨s, hs⟩ := exists_isHahnDecomposition μ ν + -- real form of the statistical information, from its expression in terms of `tvDist` + have h_real : (statInfo μ ν (Measure.boolMeasure 1 1)).toReal + = (ν.real s - μ.real s) - max (ν.real univ - μ.real univ) 0 := by + have h_tv := tvDist_eq_two_mul_toReal_statInfo_add_abs μ ν + rw [hs.tvDist_eq] at h_tv + have hμ := measureReal_add_measureReal_compl (μ := μ) hs.measurableSet + have hν := measureReal_add_measureReal_compl (μ := ν) hs.measurableSet + rcases le_total (μ.real univ) (ν.real univ) with h | h + · rw [abs_of_nonpos (sub_nonpos.mpr h)] at h_tv + rw [max_eq_left (sub_nonneg.mpr h)] + linarith + · rw [abs_of_nonneg (sub_nonneg.mpr h)] at h_tv + rw [max_eq_right (sub_nonpos.mpr h)] + linarith + rw [hs.compl.iSup_measure_sub, compl_compl, ← ofReal_measureReal_sub_measureReal, + ← ofReal_measureReal_sub_measureReal, ← ENNReal.ofReal_toReal (statInfo_ne_top _ _ _), + h_real, ENNReal.ofReal_sub _ (le_max_right _ 0), ENNReal.ofReal_max, ENNReal.ofReal_zero, + max_zero] + +/-- **Statistical information as a supremum over events**: for finite measures and a finite prior, +`I_π(μ, ν) = sup_E (π₁ ν(E) - π₀ μ(E)) - max {0, π₁ ν(𝒳) - π₀ μ(𝒳)}`. -/ +theorem statInfo_eq_iSup_sub (μ ν : Measure 𝒳) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (π : Measure Bool) [IsFiniteMeasure π] : + statInfo μ ν π = (⨆ E, ⨆ (_ : MeasurableSet E), π {true} * ν E - π {false} * μ E) + - (π {true} * ν univ - π {false} * μ univ) := by + have := μ.smul_finite (measure_ne_top π {false}) + have := ν.smul_finite (measure_ne_top π {true}) + rw [statInfo_eq_statInfo_one_one, statInfo_one_one_eq_iSup_sub_sub] + simp only [Measure.smul_apply, smul_eq_mul] + +/-- **Statistical information as a supremum over events**: for finite measures and a finite prior, +`I_π(μ, ν) = sup_E (π₀ μ(E) - π₁ ν(E)) - max {0, π₀ μ(𝒳) - π₁ ν(𝒳)}`. -/ +theorem statInfo_eq_iSup_sub' (μ ν : Measure 𝒳) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (π : Measure Bool) [IsFiniteMeasure π] : + statInfo μ ν π = (⨆ E, ⨆ (_ : MeasurableSet E), π {false} * μ E - π {true} * ν E) + - (π {false} * μ univ - π {true} * ν univ) := by + rw [statInfo_symm, statInfo_eq_iSup_sub] + simp [Measure.map_apply (measurable_of_countable _) (measurableSet_singleton _), Set.preimage] + +/-- If `μ(𝒳) ≤ ν(𝒳)`, the statistical information for the prior `(1, 1)` is +`sup_E (μ(E) - ν(E))`. -/ +lemma statInfo_one_one_eq_iSup_sub (μ ν : Measure 𝒳) [IsFiniteMeasure ν] (h : μ univ ≤ ν univ) : + statInfo μ ν (Measure.boolMeasure 1 1) = ⨆ E, ⨆ (_ : MeasurableSet E), μ E - ν E := by + have : IsFiniteMeasure μ := ⟨h.trans_lt (measure_lt_top ν _)⟩ + simpa [tsub_eq_zero_of_le h] using statInfo_eq_iSup_sub' μ ν (Measure.boolMeasure 1 1) + +end ProbabilityTheory diff --git a/Statlib/Divergence/StatInfo/FDiv.lean b/Statlib/Divergence/StatInfo/FDiv.lean index 978ce95..1ef699c 100644 --- a/Statlib/Divergence/StatInfo/FDiv.lean +++ b/Statlib/Divergence/StatInfo/FDiv.lean @@ -263,8 +263,6 @@ lemma toReal_fDiv_statInfoDivFun_eq_statInfo_of_nonneg_of_le [IsFiniteMeasure μ = (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γ] @@ -279,8 +277,6 @@ lemma toReal_fDiv_statInfoDivFun_eq_statInfo_of_nonneg_of_gt [IsFiniteMeasure μ = (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γ] diff --git a/Statlib/Divergence/StatInfo/StatInfoDivFun.lean b/Statlib/Divergence/StatInfo/StatInfoDivFun.lean index 11a61d4..a67ac17 100644 --- a/Statlib/Divergence/StatInfo/StatInfoDivFun.lean +++ b/Statlib/Divergence/StatInfo/StatInfoDivFun.lean @@ -20,6 +20,9 @@ public import Statlib.Divergence.StatInfo.StatInfoFun ## Main statements +* `statInfoDivFun_apply_of_ne_top`, `realFun_statInfoDivFun_of_nonneg`: on `[0, ∞)`, + `statInfoDivFun β γ` is `statInfoFun β γ`. In particular it is finite there + (`statInfoDivFun_ne_top`, `xmin_statInfoDivFun`, `xmax_statInfoDivFun`). * `derivAtTop_statInfoDivFun_eq`: the derivative at infinity of `statInfoDivFun β γ`. * `measurable_lintegral_statInfoDivFun`: measurability in the parameters `(β, γ)`. @@ -48,6 +51,29 @@ 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 +/-- `statInfoDivFun β γ` is finite on `[0, ∞)`. -/ +lemma statInfoDivFun_ne_top (β γ : ℝ) {x : ℝ≥0∞} (hx : x ≠ ∞) : statInfoDivFun β γ x ≠ ∞ := by + rw [statInfoDivFun_apply_of_ne_top hx] + exact ENNReal.ofReal_ne_top + +@[simp] +lemma xmin_statInfoDivFun (β γ : ℝ) : (statInfoDivFun β γ).xmin = 0 := by + rw [DivFunction.xmin] + exact le_antisymm (sInf_le (statInfoDivFun_ne_top β γ ENNReal.zero_ne_top)) bot_le + +@[simp] +lemma xmax_statInfoDivFun (β γ : ℝ) : (statInfoDivFun β γ).xmax = ∞ := by + rw [DivFunction.xmax] + exact ENNReal.eq_top_of_forall_nnreal_le fun r ↦ + le_sSup (statInfoDivFun_ne_top β γ ENNReal.coe_ne_top) + +/-- On `[0, ∞)`, the real function associated with `statInfoDivFun β γ` is `statInfoFun β γ`. -/ +lemma realFun_statInfoDivFun_of_nonneg {x : ℝ} (hx : 0 ≤ x) : + (statInfoDivFun β γ).realFun x = statInfoFun β γ x := by + simp only [DivFunction.realFun] + rw [statInfoDivFun_apply_of_ne_top ENNReal.ofReal_ne_top, + ENNReal.toReal_ofReal (statInfoFun_nonneg _ _ _), ENNReal.toReal_ofReal hx] + /-- The integral of `statInfoDivFun β γ` against `ν` of the Radon-Nikodym derivative is a measurable function of the parameters `(β, γ)`. -/ lemma measurable_lintegral_statInfoDivFun [SigmaFinite μ] [SFinite ν] : diff --git a/Statlib/Divergence/StatInfo/StatInfoFun.lean b/Statlib/Divergence/StatInfo/StatInfoFun.lean index f9402d9..fbade1f 100644 --- a/Statlib/Divergence/StatInfo/StatInfoFun.lean +++ b/Statlib/Divergence/StatInfo/StatInfoFun.lean @@ -24,6 +24,7 @@ f-divergence is an integral of such f-divergences ## Main statements * `convexOn_statInfoFun`, `continuous_statInfoFun`, `measurable_statInfoFun`: regularity. +* `hasDerivWithinAt_statInfoFun_Ioi`: the right derivative of `statInfoFun β γ` for `0 ≤ β`. * `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` @@ -119,6 +120,53 @@ lemma continuousWithinAt_statInfoFun_zero : ContinuousWithinAt (statInfoFun β γ) (Ioi 0) 0 := continuous_statInfoFun.continuousWithinAt +/-- The right derivative of `statInfoFun β γ` for `0 ≤ β`: it is `-β` (if `γ ≤ β`) or `0` +(if `β < γ`) before `γ / β`, and increases by `β` at `γ / β`. -/ +lemma hasDerivWithinAt_statInfoFun_Ioi (hβ : 0 ≤ β) (x : ℝ) : + HasDerivWithinAt (statInfoFun β γ) + ((if γ ≤ β then -β else 0) + if γ / β ≤ x then β else 0) (Ioi x) x := by + rcases hβ.eq_or_lt with rfl | hβ + · simpa [statInfoFun_zero', Pi.zero_def] using hasDerivWithinAt_const x (Ioi x) (0 : ℝ) + rcases le_or_gt γ β with hγβ | hγβ + · rw [ite_eq_left hγβ] + rcases lt_or_ge x (γ / β) with hx | hx + · rw [ite_eq_right (not_le.mpr hx), add_zero] + have h_eq : ∀ y, y < γ / β → statInfoFun β γ y = γ - β * y := fun y hy ↦ by + rw [statInfoFun_of_le hγβ, max_eq_right] + have : β * y < γ := by rwa [lt_div_iff₀ hβ, mul_comm] at hy + linarith + have h_aff : HasDerivWithinAt (fun y ↦ γ - β * y) (-β) (Ioi x) x := by + have := ((hasDerivAt_id x).const_mul β).const_sub γ + simpa using this.hasDerivWithinAt + refine h_aff.congr_of_eventuallyEq ?_ (h_eq x hx) + filter_upwards [Ioo_mem_nhdsGT hx] with y hy using h_eq y hy.2 + · rw [ite_eq_left hx, neg_add_cancel] + have h_eq : ∀ y, γ / β ≤ y → statInfoFun β γ y = 0 := fun y hy ↦ by + rw [statInfoFun_of_le hγβ, max_eq_left] + have : γ ≤ β * y := by rwa [div_le_iff₀ hβ, mul_comm] at hy + linarith + refine (hasDerivWithinAt_const x _ (0 : ℝ)).congr_of_eventuallyEq ?_ (h_eq x hx) + filter_upwards [self_mem_nhdsWithin] with y (hy : x < y) using h_eq y (hx.trans hy.le) + · rw [ite_eq_right (not_le.mpr hγβ), zero_add] + rcases lt_or_ge x (γ / β) with hx | hx + · rw [ite_eq_right (not_le.mpr hx)] + have h_eq : ∀ y, y < γ / β → statInfoFun β γ y = 0 := fun y hy ↦ by + rw [statInfoFun_of_gt hγβ, max_eq_left] + have : β * y < γ := by rwa [lt_div_iff₀ hβ, mul_comm] at hy + linarith + refine (hasDerivWithinAt_const x _ (0 : ℝ)).congr_of_eventuallyEq ?_ (h_eq x hx) + filter_upwards [Ioo_mem_nhdsGT hx] with y hy using h_eq y hy.2 + · rw [ite_eq_left hx] + have h_eq : ∀ y, γ / β ≤ y → statInfoFun β γ y = β * y - γ := fun y hy ↦ by + rw [statInfoFun_of_gt hγβ, max_eq_right] + have : γ ≤ β * y := by rwa [div_le_iff₀ hβ, mul_comm] at hy + linarith + have h_aff : HasDerivWithinAt (fun y ↦ β * y - γ) β (Ioi x) x := by + have := ((hasDerivAt_id x).const_mul β).sub_const γ + simpa using this.hasDerivWithinAt + refine h_aff.congr_of_eventuallyEq ?_ (h_eq x hx) + filter_upwards [self_mem_nhdsWithin] with y (hy : x < y) using h_eq y (hx.trans hy.le) + section derivAtTop lemma derivAtTop_statInfoFun_of_nonneg_of_le (hβ : 0 ≤ β) (hγ : γ ≤ β) : diff --git a/Statlib/Divergence/TotalVariation.lean b/Statlib/Divergence/TotalVariation.lean index c1de26b..f6f705e 100644 --- a/Statlib/Divergence/TotalVariation.lean +++ b/Statlib/Divergence/TotalVariation.lean @@ -14,9 +14,9 @@ public import Statlib.Divergence.StatInfo.Basic 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. +masses of `μ` and `ν`, the statistical information `statInfo μ ν (boolMeasure 1 1)` for the prior +`(1, 1)` (the counting measure on `Bool`). We use this to transfer results about the statistical +information to the total variation distance. ## Main definitions @@ -28,9 +28,13 @@ distance. `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. + statistical information for the prior `(1, 1)`. +* `bayesBinaryRisk_one_one_eq_add_sub_etvDist_div_two`: for finite measures, the Bayes binary risk + for the prior `(1, 1)` is `(μ(𝒳) + ν(𝒳) - etvDist μ ν) / 2`. + `bayesBinaryRisk_one_one_eq_ofReal_one_sub_tvDist_div_two` is the case of probability measures. +* `tvDist_comp_le`, `etvDist_comp_le`: **data processing inequality** for the total variation + distance. `tvDist_map_le`, `etvDist_map_le` are its versions for measurable maps, and + `tvDist_boolMeasure_le`, `etvDist_boolMeasure_le` its applications to the indicator of an event. * `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 @@ -38,7 +42,7 @@ distance. 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. +defined as the statistical information for the prior `(1, 1)`. -/ @[expose] public section @@ -52,7 +56,7 @@ namespace ProbabilityTheory variable {𝒳 𝒳' : Type*} {m𝒳 : MeasurableSpace 𝒳} {m𝒳' : MeasurableSpace 𝒳'} {μ ν : Measure 𝒳} -/-- The total variation distance in terms of the statistical information for the uniform prior. -/ +/-- The total variation distance in terms of the statistical information for the prior `(1, 1)`. -/ lemma tvDist_eq_two_mul_toReal_statInfo_add_abs (μ ν : Measure 𝒳) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : tvDist μ ν @@ -63,21 +67,51 @@ lemma tvDist_eq_two_mul_toReal_statInfo_add_abs (μ ν : Measure 𝒳) [IsFinite 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) : +distance is twice the statistical information for the prior `(1, 1)`. -/ +lemma tvDist_eq_two_mul_toReal_statInfo [IsFiniteMeasure μ] (h : μ .univ = ν .univ) : tvDist μ ν = 2 * (statInfo μ ν (Measure.boolMeasure 1 1)).toReal := by + have : IsFiniteMeasure ν := ⟨h ▸ measure_lt_top μ _⟩ 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) : +distance is twice the statistical information for the prior `(1, 1)`. -/ +lemma etvDist_eq_two_mul_statInfo [IsFiniteMeasure μ] (h : μ .univ = ν .univ) : etvDist μ ν = 2 * statInfo μ ν (Measure.boolMeasure 1 1) := by + have : IsFiniteMeasure ν := ⟨h ▸ measure_lt_top μ _⟩ 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 _ _ _)] +/-- For finite measures, the Bayes binary risk for the prior `(1, 1)` is +`(μ(𝒳) + ν(𝒳) - etvDist μ ν) / 2`. -/ +lemma bayesBinaryRisk_one_one_eq_add_sub_etvDist_div_two (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] : + bayesBinaryRisk μ ν (Measure.boolMeasure 1 1) = (μ .univ + ν .univ - etvDist μ ν) / 2 := by + have hB_le : bayesBinaryRisk μ ν (Measure.boolMeasure 1 1) ≤ min (μ .univ) (ν .univ) := by + simpa using bayesBinaryRisk_le_min μ ν (Measure.boolMeasure 1 1) + have h_tv := tvDist_eq_two_mul_toReal_statInfo_add_abs μ ν + rw [statInfo_eq_min_sub] at h_tv + simp only [Measure.boolMeasure_apply_false, Measure.boolMeasure_apply_true, one_mul] at h_tv + rw [ENNReal.toReal_sub_of_le hB_le (ne_top_of_le_ne_top (measure_ne_top μ _) (min_le_left _ _)), + ENNReal.toReal_min (measure_ne_top _ _) (measure_ne_top _ _), ← measureReal_def, + ← measureReal_def] at h_tv + -- compare the real parts of both sides + rw [← ENNReal.toReal_eq_toReal_iff' (bayesBinaryRisk_ne_top μ ν _) (by finiteness), + ENNReal.toReal_div, ENNReal.toReal_sub_of_le etvDist_le_add (by finiteness), + ENNReal.toReal_add (measure_ne_top _ _) (measure_ne_top _ _), ← measureReal_def, + ← measureReal_def, ← tvDist, h_tv, ENNReal.toReal_ofNat, ← max_sub_min_eq_abs', + ← min_add_max (μ.real .univ) (ν.real .univ)] + ring + +/-- For probability measures, the Bayes binary risk for the prior `(1, 1)` is `1 - TV(μ, ν)`, where +`TV(μ, ν) = tvDist μ ν / 2`. -/ +lemma bayesBinaryRisk_one_one_eq_ofReal_one_sub_tvDist_div_two (μ ν : Measure 𝒳) + [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + bayesBinaryRisk μ ν (Measure.boolMeasure 1 1) = ENNReal.ofReal (1 - tvDist μ ν / 2) := by + rw [bayesBinaryRisk_one_one_eq_add_sub_etvDist_div_two, measure_univ, measure_univ, + one_add_one_eq_two, ← ofReal_tvDist, sub_div' two_ne_zero, one_mul, + ENNReal.ofReal_div_of_pos two_pos, ENNReal.ofReal_sub _ tvDist_nonneg, ENNReal.ofReal_ofNat] + /-- **Data processing inequality** for the total variation distance. -/ lemma tvDist_comp_le (μ ν : Measure 𝒳) (κ : Kernel 𝒳 𝒳') [IsMarkovKernel κ] : tvDist (κ ∘ₘ μ) (κ ∘ₘ ν) ≤ tvDist μ ν := by @@ -95,6 +129,22 @@ lemma tvDist_comp_le (μ ν : Measure 𝒳) (κ : Kernel 𝒳 𝒳') [IsMarkovKe rw [tvDist_of_not_isFiniteMeasure h_comp] exact tvDist_nonneg +/-- **Data processing inequality** for the total variation distance and a measurable map. -/ +lemma tvDist_map_le (μ ν : Measure 𝒳) {g : 𝒳 → 𝒳'} (hg : Measurable g) : + tvDist (μ.map g) (ν.map g) ≤ tvDist μ ν := by + simpa [Measure.deterministic_comp_eq_map hg] using tvDist_comp_le μ ν (Kernel.deterministic g hg) + +/-- **Data processing inequality** for the total variation distance, applied to the indicator of an +event `E`: the distance between the laws of `x ↦ decide (x ∈ E)` under `μ` and `ν` is at most +`tvDist μ ν`. For probability measures, those laws are the Bernoulli distributions with means +`μ E` and `ν E`. -/ +lemma tvDist_boolMeasure_le (μ ν : Measure 𝒳) {E : Set 𝒳} (hE : MeasurableSet E) : + tvDist (Measure.boolMeasure (μ Eᶜ) (μ E)) (Measure.boolMeasure (ν Eᶜ) (ν E)) + ≤ tvDist μ ν := by + classical + rw [← Measure.map_decide_mem_eq_boolMeasure μ hE, ← Measure.map_decide_mem_eq_boolMeasure ν hE] + exact tvDist_map_le μ ν (measurable_decide_mem hE) + /-- **Data processing inequality** for the total variation distance. -/ lemma etvDist_comp_le (μ ν : Measure 𝒳) (κ : Kernel 𝒳 𝒳') [IsMarkovKernel κ] : etvDist (κ ∘ₘ μ) (κ ∘ₘ ν) ≤ etvDist μ ν := by @@ -105,17 +155,32 @@ lemma etvDist_comp_le (μ ν : Measure 𝒳) (κ : Kernel 𝒳 𝒳') [IsMarkovK · rw [etvDist_of_not_isFiniteMeasure h] exact le_top -/-- For the uniform prior, the statistical information is `∫⁻ x, 1 - (∂μ/∂ν) x ∂ν`, provided that +/-- **Data processing inequality** for the total variation distance and a measurable map. -/ +lemma etvDist_map_le (μ ν : Measure 𝒳) {g : 𝒳 → 𝒳'} (hg : Measurable g) : + etvDist (μ.map g) (ν.map g) ≤ etvDist μ ν := by + simpa [Measure.deterministic_comp_eq_map hg] using etvDist_comp_le μ ν (Kernel.deterministic g hg) + +/-- **Data processing inequality** for the total variation distance, applied to the indicator of an +event `E`: the distance between the laws of `x ↦ decide (x ∈ E)` under `μ` and `ν` is at most +`etvDist μ ν`. For probability measures, those laws are the Bernoulli distributions with means +`μ E` and `ν E`. -/ +lemma etvDist_boolMeasure_le (μ ν : Measure 𝒳) {E : Set 𝒳} (hE : MeasurableSet E) : + etvDist (Measure.boolMeasure (μ Eᶜ) (μ E)) (Measure.boolMeasure (ν Eᶜ) (ν E)) + ≤ etvDist μ ν := by + classical + rw [← Measure.map_decide_mem_eq_boolMeasure μ hE, ← Measure.map_decide_mem_eq_boolMeasure ν hE] + exact etvDist_map_le μ ν (measurable_decide_mem hE) + +/-- For the prior `(1, 1)`, 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) : +lemma lintegral_one_sub_rnDeriv_eq_statInfo [IsFiniteMeasure μ] (h : ν .univ ≤ μ .univ) : ∫⁻ x, 1 - (∂μ/∂ν) x ∂ν = statInfo μ ν (Measure.boolMeasure 1 1) := by + have : IsFiniteMeasure ν := ⟨h.trans_lt (measure_lt_top μ _)⟩ 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) : +lemma lintegral_one_sub_rnDeriv_eq_etvDist_div_two [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] @@ -135,6 +200,14 @@ lemma tvDivFun_apply {x : ℝ≥0∞} (hx : x ≠ ∞) : tvDivFun x = ENNReal.of DivFunction.ofReal_apply_of_continuousWithinAt (continuous_abs.comp (continuous_sub_left 1)).continuousWithinAt hx +@[simp] lemma tvDivFun_zero : tvDivFun 0 = 1 := by simp [tvDivFun_apply] + +@[simp] +lemma tvDivFun_apply_top : tvDivFun ∞ = ∞ := by + refine DivFunction.ofReal_apply_top_of_tendsto_atTop ?_ + have h : Tendsto (fun x : ℝ ↦ x - 1) atTop atTop := tendsto_atTop_add_const_right _ _ tendsto_id + exact (tendsto_abs_atTop_atTop.comp h).congr fun x ↦ by simp [abs_sub_comm] + @[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 diff --git a/Statlib/Divergence/TotalVariation/Event.lean b/Statlib/Divergence/TotalVariation/Event.lean new file mode 100644 index 0000000..280b1d4 --- /dev/null +++ b/Statlib/Divergence/TotalVariation/Event.lean @@ -0,0 +1,84 @@ +/- +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.TotalVariation +public import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.Hahn +public import Statlib.ForMathlib.MeasureTheory.Measure.Real + +/-! +# Total variation distance and events + +We express the total variation distance `etvDist μ ν` (the total variation norm of `μ - ν`) in +terms of the suprema over events of `μ E - ν E` and of `ν E - μ E`, using a Hahn decomposition of +`μ` and `ν`. + +## Main statements + +* `etvDist_eq_iSup_sub_add_iSup_sub`: if `μ` is finite, + `etvDist μ ν = (⨆ E, μ E - ν E) + ⨆ E, ν E - μ E`. +* `etvDist_eq_two_mul_iSup_sub_add`: if `μ` is finite and `μ(𝒳) ≤ ν(𝒳)`, + `etvDist μ ν = 2 * (⨆ E, μ E - ν E) + (ν(𝒳) - μ(𝒳))`. +* `etvDist_eq_two_mul_iSup_sub`: for finite measures with the same mass (for example probability + measures), `etvDist μ ν = 2 * ⨆ E, μ E - ν E`. + +In all these statements, the suprema are over measurable sets `E`. +-/ + +@[expose] public section + +open MeasureTheory Set + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {𝒳 : Type*} {m𝒳 : MeasurableSpace 𝒳} + +/-- The total variation distance is the sum of the suprema over events of `μ E - ν E` and of +`ν E - μ E`. This needs only one of the two measures to be finite: if `ν` is not finite, both sides +are infinite. -/ +theorem etvDist_eq_iSup_sub_add_iSup_sub (μ ν : Measure 𝒳) [IsFiniteMeasure μ] : + etvDist μ ν = (⨆ E, ⨆ (_ : MeasurableSet E), μ E - ν E) + + ⨆ E, ⨆ (_ : MeasurableSet E), ν E - μ E := by + by_cases hν : IsFiniteMeasure ν + swap + · have h_top : ⨆ E, ⨆ (_ : MeasurableSet E), ν E - μ E = ∞ := by + refine eq_top_iff.mpr (le_iSup₂_of_le univ MeasurableSet.univ ?_) + rw [not_isFiniteMeasure_iff.mp hν, ENNReal.top_sub (measure_ne_top μ _)] + rw [etvDist_of_not_isFiniteMeasure_right hν, h_top, add_top] + obtain ⟨s, hs⟩ := exists_isHahnDecomposition μ ν + rw [hs.iSup_measure_sub, hs.compl.iSup_measure_sub, compl_compl, hs.etvDist_eq, add_comm] + +/-- If `μ` is finite and `μ(𝒳) ≤ ν(𝒳)`, then `etvDist μ ν = 2 * (⨆ E, μ E - ν E) + (ν(𝒳) - μ(𝒳))`. +If `ν` is not finite, both sides are infinite. -/ +theorem etvDist_eq_two_mul_iSup_sub_add (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + (h : μ univ ≤ ν univ) : + etvDist μ ν = 2 * (⨆ E, ⨆ (_ : MeasurableSet E), μ E - ν E) + (ν univ - μ univ) := by + by_cases hν : IsFiniteMeasure ν + swap + · rw [etvDist_of_not_isFiniteMeasure_right hν, not_isFiniteMeasure_iff.mp hν, + ENNReal.top_sub (measure_ne_top μ _), add_top] + obtain ⟨s, hs⟩ := exists_isHahnDecomposition μ ν + have h_real : μ.real univ ≤ ν.real univ := ENNReal.toReal_mono (measure_ne_top _ _) h + have h_s : ν.real sᶜ ≤ μ.real sᶜ := ENNReal.toReal_mono (measure_ne_top _ _) + (by simpa using Measure.le_iff'.mp hs.ge_on_compl univ) + rw [hs.iSup_measure_sub, ← ofReal_tvDist, hs.tvDist_eq, ← ofReal_measureReal_sub_measureReal, + ← ofReal_measureReal_sub_measureReal, ← ENNReal.ofReal_ofNat 2, + ← ENNReal.ofReal_mul (by norm_num), ← ENNReal.ofReal_add (by linarith) (by linarith)] + congr 1 + have := measureReal_add_measureReal_compl (μ := μ) hs.measurableSet + have := measureReal_add_measureReal_compl (μ := ν) hs.measurableSet + linarith + +/-- For finite measures with the same mass, for example probability measures, +`etvDist μ ν = 2 * ⨆ E, μ E - ν E`. -/ +theorem etvDist_eq_two_mul_iSup_sub (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + (h : μ univ = ν univ) : + etvDist μ ν = 2 * ⨆ E, ⨆ (_ : MeasurableSet E), μ E - ν E := by + rw [etvDist_eq_two_mul_iSup_sub_add μ ν h.le, h, tsub_self, add_zero] + +end ProbabilityTheory diff --git a/Statlib/Divergence/TotalVariation/Integral.lean b/Statlib/Divergence/TotalVariation/Integral.lean new file mode 100644 index 0000000..1635ef4 --- /dev/null +++ b/Statlib/Divergence/TotalVariation/Integral.lean @@ -0,0 +1,190 @@ +/- +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.TotalVariation + +/-! +# Integral forms of the total variation distance + +Mathlib's `tvDist μ ν` is the total variation norm of `μ - ν`. Mathlib gives its expression in +terms of the Radon-Nikodym derivative `∂μ/∂ν` and of the singular part of `μ` with respect to `ν` +(`tvDist_eq_integral_abs_rnDeriv_add_singularPart`). We give other integral forms, and the +variational formula as a supremum over functions bounded by `1`. + +## Main statements + +* `tvDist_eq_add_sub_two_mul_integral_min`: for any measure `ζ` dominating `μ` and `ν`, + `tvDist μ ν = μ(𝒳) + ν(𝒳) - 2 * ∫ min (∂μ/∂ζ) (∂ν/∂ζ) ∂ζ`. +* `tvDist_eq_integral_abs_sub_rnDeriv`: for any measure `ζ` dominating `μ` and `ν`, + `tvDist μ ν = ∫ |∂μ/∂ζ - ∂ν/∂ζ| ∂ζ`. +* `tvDist_eq_two_mul_integral_max_one_sub_add`, `tvDist_eq_two_mul_integral_max_sub_one_add`: + one-sided integral forms with respect to `ν`. +* `integral_sub_integral_le_tvDist`: for `f` with `|f| ≤ 1` (almost everywhere), + `∫ f ∂μ - ∫ f ∂ν ≤ tvDist μ ν`. +* `tvDist_eq_iSup_integral_sub`: the total variation distance is the supremum of + `∫ f ∂μ - ∫ f ∂ν` over measurable functions with `|f| ≤ 1`. +-/ + +@[expose] public section + +open MeasureTheory Set + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {𝒳 : Type*} {m𝒳 : MeasurableSpace 𝒳} {μ ν ζ : Measure 𝒳} + +/-- For finite measures `μ, ν` and any measure `ζ` with `μ ≪ ζ` and `ν ≪ ζ`, +`tvDist μ ν = μ(𝒳) + ν(𝒳) - 2 * ∫ min (∂μ/∂ζ) (∂ν/∂ζ) ∂ζ`. -/ +theorem tvDist_eq_add_sub_two_mul_integral_min [IsFiniteMeasure μ] [IsFiniteMeasure ν] + [SigmaFinite ζ] (hμζ : μ ≪ ζ) (hνζ : ν ≪ ζ) : + tvDist μ ν = μ.real univ + ν.real univ + - 2 * ∫ x, min ((∂μ/∂ζ) x).toReal ((∂ν/∂ζ) x).toReal ∂ζ := by + have h_stat := statInfo_eq_min_sub_lintegral' (Measure.boolMeasure 1 1) hμζ hνζ + simp only [Measure.boolMeasure_apply_false, Measure.boolMeasure_apply_true, one_mul] at h_stat + have h_le : ∫⁻ x, min ((∂μ/∂ζ) x) ((∂ν/∂ζ) x) ∂ζ ≤ min (μ univ) (ν univ) := by + refine le_min ?_ ?_ + · exact (lintegral_mono fun _ ↦ min_le_left _ _).trans_eq (Measure.lintegral_rnDeriv hμζ) + · exact (lintegral_mono fun _ ↦ min_le_right _ _).trans_eq (Measure.lintegral_rnDeriv hνζ) + have h_int : (∫⁻ x, min ((∂μ/∂ζ) x) ((∂ν/∂ζ) x) ∂ζ).toReal + = ∫ x, min ((∂μ/∂ζ) x).toReal ((∂ν/∂ζ) x).toReal ∂ζ := by + rw [← integral_toReal + ((Measure.measurable_rnDeriv μ ζ).min (Measure.measurable_rnDeriv ν ζ)).aemeasurable] + · refine integral_congr_ae ?_ + filter_upwards [Measure.rnDeriv_lt_top μ ζ, Measure.rnDeriv_lt_top ν ζ] with x hμ hν + exact ENNReal.toReal_min hμ.ne hν.ne + · filter_upwards [Measure.rnDeriv_lt_top μ ζ] with x hx using (min_le_left _ _).trans_lt hx + rw [tvDist_eq_two_mul_toReal_statInfo_add_abs, h_stat, + ENNReal.toReal_sub_of_le h_le (by simp), h_int, + ENNReal.toReal_min (measure_ne_top _ _) (measure_ne_top _ _), ← measureReal_def, + ← measureReal_def, ← max_sub_min_eq_abs', ← min_add_max (μ.real univ) (ν.real univ)] + ring + +/-- For finite measures `μ, ν` and any measure `ζ` with `μ ≪ ζ` and `ν ≪ ζ`, +`tvDist μ ν = ∫ |∂μ/∂ζ - ∂ν/∂ζ| ∂ζ`. -/ +theorem tvDist_eq_integral_abs_sub_rnDeriv [IsFiniteMeasure μ] [IsFiniteMeasure ν] + [SigmaFinite ζ] (hμζ : μ ≪ ζ) (hνζ : ν ≪ ζ) : + tvDist μ ν = ∫ x, |((∂μ/∂ζ) x).toReal - ((∂ν/∂ζ) x).toReal| ∂ζ := by + have hp : Integrable (fun x ↦ ((∂μ/∂ζ) x).toReal) ζ := Measure.integrable_toReal_rnDeriv + have hq : Integrable (fun x ↦ ((∂ν/∂ζ) x).toReal) ζ := Measure.integrable_toReal_rnDeriv + have h_min : Integrable (fun x ↦ min ((∂μ/∂ζ) x).toReal ((∂ν/∂ζ) x).toReal) ζ := hp.inf hq + have h_abs : ∀ x, |((∂μ/∂ζ) x).toReal - ((∂ν/∂ζ) x).toReal| + = ((∂μ/∂ζ) x).toReal + ((∂ν/∂ζ) x).toReal + - 2 * min ((∂μ/∂ζ) x).toReal ((∂ν/∂ζ) x).toReal := fun x ↦ by + rw [← max_sub_min_eq_abs', ← min_add_max ((∂μ/∂ζ) x).toReal] + ring + have h_add : Integrable (fun x ↦ ((∂μ/∂ζ) x).toReal + ((∂ν/∂ζ) x).toReal) ζ := hp.add hq + simp_rw [h_abs] + rw [integral_sub h_add (h_min.const_mul 2), integral_add hp hq, integral_const_mul, + Measure.integral_toReal_rnDeriv hμζ, Measure.integral_toReal_rnDeriv hνζ, + tvDist_eq_add_sub_two_mul_integral_min hμζ hνζ] + +/-- One-sided integral form of the total variation distance: +`tvDist μ ν = 2 * ∫ max 0 (1 - ∂μ/∂ν) ∂ν + μ(𝒳) - ν(𝒳)`. -/ +theorem tvDist_eq_two_mul_integral_max_one_sub_add [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + tvDist μ ν = 2 * ∫ x, max 0 (1 - ((∂μ/∂ν) x).toReal) ∂ν + μ.real univ - ν.real univ := by + have hr : Integrable (fun x ↦ ((∂μ/∂ν) x).toReal) ν := Measure.integrable_toReal_rnDeriv + have h1 : Integrable (fun x ↦ 1 - ((∂μ/∂ν) x).toReal) ν := (integrable_const 1).sub hr + have h_abs : ∀ x, |1 - ((∂μ/∂ν) x).toReal| + = 2 * max 0 (1 - ((∂μ/∂ν) x).toReal) - (1 - ((∂μ/∂ν) x).toReal) := by + intro x + rcases le_total 0 (1 - ((∂μ/∂ν) x).toReal) with h | h + · rw [max_eq_right h, abs_of_nonneg h] + ring + · rw [max_eq_left h, abs_of_nonpos h] + ring + have h_pos : Integrable (fun x ↦ max 0 (1 - ((∂μ/∂ν) x).toReal)) ν := by + simpa only [max_comm] using h1.pos_part + rw [tvDist_eq_integral_abs_rnDeriv_add_singularPart] + simp_rw [h_abs] + rw [integral_sub (h_pos.const_mul 2) h1, integral_const_mul, + integral_sub (integrable_const 1) hr, Measure.integral_toReal_rnDeriv', integral_const] + simp only [smul_eq_mul, mul_one] + ring + +/-- One-sided integral form of the total variation distance: +`tvDist μ ν = 2 * (∫ max 0 (∂μ/∂ν - 1) ∂ν + μ⟂ν(𝒳)) + ν(𝒳) - μ(𝒳)`. -/ +theorem tvDist_eq_two_mul_integral_max_sub_one_add [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + tvDist μ ν = 2 * (∫ x, max 0 (((∂μ/∂ν) x).toReal - 1) ∂ν + (μ.singularPart ν).real univ) + + ν.real univ - μ.real univ := by + have hr : Integrable (fun x ↦ ((∂μ/∂ν) x).toReal) ν := Measure.integrable_toReal_rnDeriv + have h1 : Integrable (fun x ↦ ((∂μ/∂ν) x).toReal - 1) ν := hr.sub (integrable_const 1) + have h_abs : ∀ x, |1 - ((∂μ/∂ν) x).toReal| + = 2 * max 0 (((∂μ/∂ν) x).toReal - 1) - (((∂μ/∂ν) x).toReal - 1) := by + intro x + rcases le_total 0 (((∂μ/∂ν) x).toReal - 1) with h | h + · rw [max_eq_right h, abs_of_nonpos (by linarith)] + ring + · rw [max_eq_left h, abs_of_nonneg (by linarith)] + ring + have h_pos : Integrable (fun x ↦ max 0 (((∂μ/∂ν) x).toReal - 1)) ν := by + simpa only [max_comm] using h1.pos_part + rw [tvDist_eq_integral_abs_rnDeriv_add_singularPart] + simp_rw [h_abs] + rw [integral_sub (h_pos.const_mul 2) h1, integral_const_mul, + integral_sub hr (integrable_const 1), Measure.integral_toReal_rnDeriv', integral_const] + simp only [smul_eq_mul, mul_one] + ring + +/-! ### Variational formula -/ + +/-- For a function `f` with `|f| ≤ 1` almost everywhere with respect to `μ` and `ν`, +`∫ f ∂μ - ∫ f ∂ν ≤ tvDist μ ν`. -/ +theorem integral_sub_integral_le_tvDist [IsFiniteMeasure μ] [IsFiniteMeasure ν] {f : 𝒳 → ℝ} + (hf : AEStronglyMeasurable f (μ + ν)) (hf_le : ∀ᵐ x ∂(μ + ν), |f x| ≤ 1) : + ∫ x, f x ∂μ - ∫ x, f x ∂ν ≤ tvDist μ ν := by + have hμζ : μ ≪ μ + ν := Measure.AbsolutelyContinuous.rfl.add_right ν + have hνζ : ν ≪ μ + ν := Measure.absolutelyContinuous_of_le (Measure.le_add_left le_rfl) + have hf_int (ξ : Measure 𝒳) [IsFiniteMeasure ξ] (hξ : ξ ≪ μ + ν) : Integrable f ξ := by + refine Integrable.of_bound (hf.mono_ac hξ) 1 ?_ + filter_upwards [hξ.ae_le hf_le] with x hx using by simpa using hx + have hμ_int := (integrable_rnDeriv_smul_iff hμζ).mpr (hf_int μ hμζ) + have hν_int := (integrable_rnDeriv_smul_iff hνζ).mpr (hf_int ν hνζ) + rw [← integral_rnDeriv_smul hμζ, ← integral_rnDeriv_smul hνζ, ← integral_sub hμ_int hν_int, + tvDist_eq_integral_abs_sub_rnDeriv hμζ hνζ] + refine integral_mono_ae (hμ_int.sub hν_int) + (Measure.integrable_toReal_rnDeriv.sub Measure.integrable_toReal_rnDeriv).abs ?_ + filter_upwards [hf_le] with x hx + simp only [smul_eq_mul, ← sub_mul] + exact (le_abs_self _).trans ((abs_mul _ _).trans_le (mul_le_of_le_one_right (abs_nonneg _) hx)) + +/-- **Variational formula** for the total variation distance: `tvDist μ ν` is the supremum of +`∫ f ∂μ - ∫ f ∂ν` over measurable functions `f` with `|f| ≤ 1`. -/ +theorem tvDist_eq_iSup_integral_sub [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + tvDist μ ν = ⨆ f : {f : 𝒳 → ℝ // Measurable f ∧ ∀ x, |f x| ≤ 1}, + (∫ x, f.1 x ∂μ - ∫ x, f.1 x ∂ν) := by + have h_bdd : BddAbove (range fun f : {f : 𝒳 → ℝ // Measurable f ∧ ∀ x, |f x| ≤ 1} ↦ + ∫ x, f.1 x ∂μ - ∫ x, f.1 x ∂ν) := by + refine ⟨tvDist μ ν, ?_⟩ + rintro _ ⟨f, rfl⟩ + exact integral_sub_integral_le_tvDist f.2.1.aestronglyMeasurable (ae_of_all _ f.2.2) + obtain ⟨s, hs⟩ := exists_isHahnDecomposition μ ν + refine le_antisymm ?_ ?_ + · -- the supremum is attained at `f = 1` on `sᶜ` and `f = -1` on `s` + let f : 𝒳 → ℝ := fun x ↦ sᶜ.indicator (fun _ ↦ (1 : ℝ)) x - s.indicator (fun _ ↦ 1) x + have hf_meas : Measurable f := + ((measurable_const.indicator hs.measurableSet.compl).sub + (measurable_const.indicator hs.measurableSet)) + have hf_le : ∀ x, |f x| ≤ 1 := by + intro x + by_cases hx : x ∈ s <;> simp [f, hx] + refine le_ciSup_of_le h_bdd ⟨f, hf_meas, hf_le⟩ (le_of_eq ?_) + have h_int (ξ : Measure 𝒳) [IsFiniteMeasure ξ] : + ∫ x, f x ∂ξ = ξ.real sᶜ - ξ.real s := by + rw [integral_sub ((integrable_const 1).indicator hs.measurableSet.compl) + ((integrable_const 1).indicator hs.measurableSet), + integral_indicator_const _ hs.measurableSet.compl, + integral_indicator_const _ hs.measurableSet, smul_eq_mul, smul_eq_mul, mul_one, mul_one] + rw [h_int μ, h_int ν, hs.tvDist_eq] + ring + · have : Nonempty {f : 𝒳 → ℝ // Measurable f ∧ ∀ x, |f x| ≤ 1} := + ⟨⟨0, measurable_const, fun _ ↦ by simp⟩⟩ + exact ciSup_le fun f ↦ + integral_sub_integral_le_tvDist f.2.1.aestronglyMeasurable (ae_of_all _ f.2.2) + +end ProbabilityTheory diff --git a/Statlib/ForMathlib/Analysis/Convex/Deriv.lean b/Statlib/ForMathlib/Analysis/Convex/Deriv.lean new file mode 100644 index 0000000..70d87af --- /dev/null +++ b/Statlib/ForMathlib/Analysis/Convex/Deriv.lean @@ -0,0 +1,55 @@ +/- +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.Analysis.Convex.Deriv + +/-! +# Comparison of functions from a comparison of their second derivatives + +## Main statements + +* `le_mul_of_deriv2_le`: let `φ, ψ : ℝ → ℝ` be twice differentiable on a convex set `D` and let + `x₀` be an interior point of `D` with `φ x₀ = c * ψ x₀` and `φ' x₀ = c * ψ' x₀`. + If `φ'' ≤ c * ψ''` on `D`, then `φ ≤ c * ψ` on `D`. +-/ + +@[expose] public section + +open Set + +/-- Let `φ, ψ : ℝ → ℝ` be twice differentiable on a convex set `D` and let `x₀` be an interior +point of `D` with `φ x₀ = c * ψ x₀` and `φ' x₀ = c * ψ' x₀`. If `φ'' ≤ c * ψ''` on `D`, then +`φ ≤ c * ψ` on `D`. + +The function `c * ψ - φ` is convex on `D` since its second derivative is nonnegative, and its +derivative vanishes at `x₀`: it attains its minimum `0` at `x₀`. -/ +lemma le_mul_of_deriv2_le {φ ψ φ' ψ' φ'' ψ'' : ℝ → ℝ} {c : ℝ} {D : Set ℝ} {x₀ : ℝ} + (hD : Convex ℝ D) (hx₀ : x₀ ∈ interior D) + (hφ : ∀ x ∈ D, HasDerivAt φ (φ' x) x) (hφ' : ∀ x ∈ D, HasDerivAt φ' (φ'' x) x) + (hψ : ∀ x ∈ D, HasDerivAt ψ (ψ' x) x) (hψ' : ∀ x ∈ D, HasDerivAt ψ' (ψ'' x) x) + (h_eq : φ x₀ = c * ψ x₀) (h_deriv_eq : φ' x₀ = c * ψ' x₀) + (h : ∀ x ∈ D, φ'' x ≤ c * ψ'' x) {x : ℝ} (hx : x ∈ D) : + φ x ≤ c * ψ x := by + have hu (y : ℝ) (hy : y ∈ D) : HasDerivAt (fun y ↦ c * ψ y - φ y) (c * ψ' y - φ' y) y := + ((hψ y hy).const_mul c).sub (hφ y hy) + have hu' (y : ℝ) (hy : y ∈ D) : + HasDerivAt (fun y ↦ c * ψ' y - φ' y) (c * ψ'' y - φ'' y) y := + ((hψ' y hy).const_mul c).sub (hφ' y hy) + have h_cvx : ConvexOn ℝ D (fun y ↦ c * ψ y - φ y) := + convexOn_of_hasDerivWithinAt2_nonneg (f' := fun y ↦ c * ψ' y - φ' y) + (f'' := fun y ↦ c * ψ'' y - φ'' y) hD + (fun y hy ↦ (hu y hy).continuousAt.continuousWithinAt) + (fun y hy ↦ (hu y (interior_subset hy)).hasDerivWithinAt) + (fun y hy ↦ (hu' y (interior_subset hy)).hasDerivWithinAt) + (fun y hy ↦ sub_nonneg.mpr (h y (interior_subset hy))) + have h_min : IsMinOn (fun y ↦ c * ψ y - φ y) D x₀ := by + refine h_cvx.isMinOn_of_rightDeriv_eq_zero hx₀ ?_ + rw [(hu x₀ (interior_subset hx₀)).hasDerivWithinAt.derivWithin (uniqueDiffWithinAt_Ioi x₀), + h_deriv_eq, sub_self] + have := isMinOn_iff.mp h_min x hx + simp only [h_eq, sub_self] at this + linarith diff --git a/Statlib/ForMathlib/Analysis/SpecialFunctions/Log/ENNRealLogExp.lean b/Statlib/ForMathlib/Analysis/SpecialFunctions/Log/ENNRealLogExp.lean new file mode 100644 index 0000000..5e1eef9 --- /dev/null +++ b/Statlib/ForMathlib/Analysis/SpecialFunctions/Log/ENNRealLogExp.lean @@ -0,0 +1,40 @@ +/- +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.Analysis.SpecialFunctions.Log.ENNRealLogExp + +/-! +# Bounds by the exponential of a supremum + +## Main statements + +* `EReal.le_exp_neg_biSup`: if `x ≤ exp (-f i)` for all `i` in a nonempty set `s`, then + `x ≤ exp (-⨆ i ∈ s, f i)`. +-/ + +@[expose] public section + +open scoped ENNReal + +namespace EReal + +/-- If `x ≤ exp (-f i)` for all `i` in a nonempty set `s`, then `x ≤ exp (-⨆ i ∈ s, f i)`. -/ +lemma le_exp_neg_biSup {ι : Type*} {s : Set ι} (hs : s.Nonempty) {f : ι → ℝ≥0∞} + {x : ℝ≥0∞} (h : ∀ i ∈ s, x ≤ EReal.exp (-(f i : EReal))) : + x ≤ EReal.exp (-((⨆ i ∈ s, f i : ℝ≥0∞) : EReal)) := by + have h' : ∀ i ∈ s, (f i : EReal) ≤ -ENNReal.log x := fun i hi ↦ by + have h := h i hi + rwa [← ENNReal.exp_log x, EReal.exp_le_exp_iff, EReal.le_neg] at h + obtain ⟨i₀, hi₀⟩ := hs + rw [← ENNReal.exp_log x, EReal.exp_le_exp_iff, EReal.le_neg, + ← EReal.coe_toENNReal ((EReal.coe_ennreal_nonneg _).trans (h' i₀ hi₀)), + EReal.coe_ennreal_le_coe_ennreal_iff] + refine iSup₂_le fun i hi ↦ ?_ + rw [← EReal.toENNReal_coe (x := f i)] + exact EReal.toENNReal_le_toENNReal (h' i hi) + +end EReal diff --git a/Statlib/ForMathlib/Analysis/SpecialFunctions/Pow/Deriv.lean b/Statlib/ForMathlib/Analysis/SpecialFunctions/Pow/Deriv.lean new file mode 100644 index 0000000..aa52c80 --- /dev/null +++ b/Statlib/ForMathlib/Analysis/SpecialFunctions/Pow/Deriv.lean @@ -0,0 +1,105 @@ +/- +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.Analysis.Convex.SpecificFunctions.Basic +public import Mathlib.Analysis.SpecialFunctions.Pow.Deriv + +/-! +# Secant slopes of `s ↦ t ^ s` at `1` + +We study the secant slopes `(t ^ a - t) / (a - 1)` at `1` of the function `s ↦ t ^ s`, whose +derivative at `1` is `t * log t`. For `t > 0` that function is convex (`convexOn_rpow_left`), so its +slopes are monotone; for `t = 0` they are monotone on `[0, ∞)`. + +## Main statements + +* `Real.rpow_sub_self_div_sub_one_le`: the slopes are monotone in `a ≥ 0`. +* `Real.tendsto_rpow_sub_self_div_sub_one`: the slopes tend to `t * log t` as `a → 1`. +* `Real.neg_inv_two_le_rpow_sub_self_div_sub_one`, `Real.neg_inv_two_le_mul_log`: lower bounds by + `-1/2`. +* `Real.mul_log_le_rpow_sub_self_div_sub_one`, `Real.rpow_sub_self_div_sub_one_le_mul_log`: the + derivative `t * log t` lies between the slopes for `a < 1` and those for `a > 1`. +-/ + +@[expose] public section + +open Filter Set + +open scoped Topology + +namespace Real + +variable {a b : ℝ} + +/-- The secant slopes `(t ^ a - t) / (a - 1)` of `s ↦ t ^ s` at `1` are monotone in `a ≥ 0`. -/ +lemma rpow_sub_self_div_sub_one_le {t : ℝ} (ht : 0 ≤ t) (ha : 0 ≤ a) (ha1 : a ≠ 1) + (hb1 : b ≠ 1) (hab : a ≤ b) : + (t ^ a - t) / (a - 1) ≤ (t ^ b - t) / (b - 1) := by + rcases ht.eq_or_lt with rfl | ht + · rcases ha.eq_or_lt with rfl | ha + · rcases hab.eq_or_lt with rfl | hb + · exact le_rfl + · simp [zero_rpow hb.ne'] + · simp [zero_rpow ha.ne', zero_rpow (ha.trans_le hab).ne'] + have h := (convexOn_rpow_left ht).secant_mono (mem_univ 1) (mem_univ a) (mem_univ b) ha1 hb1 hab + simpa only [rpow_one] using h + +/-- The secant slopes `(t ^ a - t) / (a - 1)` of `s ↦ t ^ s` tend to `t * log t` as `a → 1`. -/ +lemma tendsto_rpow_sub_self_div_sub_one (t : ℝ) : + Tendsto (fun a ↦ (t ^ a - t) / (a - 1)) (𝓝[≠] 1) (𝓝 (t * log t)) := by + have h : HasDerivAt (fun a : ℝ ↦ t ^ a) (t * log t) 1 := by + rcases lt_trichotomy t 0 with ht | rfl | ht + · simpa using (hasStrictDerivAt_const_rpow_of_neg (x := 1) ht).hasDerivAt + · rw [zero_mul] + refine (hasDerivAt_const (1 : ℝ) (0 : ℝ)).congr_of_eventuallyEq (f := fun _ ↦ 0) ?_ + filter_upwards [eventually_ne_nhds one_ne_zero] with a ha + simp [zero_rpow ha] + · simpa using (hasStrictDerivAt_const_rpow ht 1).hasDerivAt + refine h.tendsto_slope.congr fun a ↦ ?_ + rw [slope_def_field, rpow_one] + +/-- The secant slopes `(t ^ a - t) / (a - 1)` of `s ↦ t ^ s` at `1` are bounded below by `-1 / 2` +for `a ≥ 1 / 2`. -/ +lemma neg_inv_two_le_rpow_sub_self_div_sub_one {t : ℝ} (ht : 0 ≤ t) (ha : 2⁻¹ ≤ a) + (ha1 : a ≠ 1) : + -2⁻¹ ≤ (t ^ a - t) / (a - 1) := by + refine le_trans ?_ (rpow_sub_self_div_sub_one_le ht (by norm_num) (by norm_num) ha1 ha) + have h_sqrt : t ^ (2⁻¹ : ℝ) = √t := by rw [sqrt_eq_rpow]; norm_num + have hs := sq_sqrt ht + rw [h_sqrt, show (2⁻¹ : ℝ) - 1 = -2⁻¹ by norm_num, div_neg, div_inv_eq_mul] + nlinarith [sq_nonneg (√t - 2⁻¹)] + +/-- For `a > 1`, the secant slope `(t ^ a - t) / (a - 1)` of `s ↦ t ^ s` at `1` is at least its +derivative `t * log t` at `1`. -/ +lemma mul_log_le_rpow_sub_self_div_sub_one {t : ℝ} (ht : 0 ≤ t) (ha : 1 < a) : + t * log t ≤ (t ^ a - t) / (a - 1) := by + refine le_of_tendsto ((tendsto_rpow_sub_self_div_sub_one t).mono_left + (nhdsWithin_mono _ fun x hx ↦ ne_of_lt (Set.mem_Iio.mp hx))) ?_ + filter_upwards [Ioo_mem_nhdsLT (show (2⁻¹ : ℝ) < 1 by norm_num)] with b hb + exact rpow_sub_self_div_sub_one_le ht (by linarith [hb.1]) hb.2.ne ha.ne' + (hb.2.le.trans ha.le) + +/-- For `a < 1`, the secant slope `(t ^ a - t) / (a - 1)` of `s ↦ t ^ s` at `1` is at most its +derivative `t * log t` at `1`. -/ +lemma rpow_sub_self_div_sub_one_le_mul_log {t : ℝ} (ht : 0 ≤ t) (ha : a < 1) : + (t ^ a - t) / (a - 1) ≤ t * log t := by + rcases ht.eq_or_lt with rfl | ht + · rcases eq_or_ne a 0 with rfl | ha0 + · norm_num + · simp [zero_rpow ha0] + refine ge_of_tendsto ((tendsto_rpow_sub_self_div_sub_one t).mono_left + (nhdsWithin_mono _ fun x hx ↦ ne_of_gt (Set.mem_Ioi.mp hx))) ?_ + filter_upwards [self_mem_nhdsWithin] with b (hb : 1 < b) + simpa only [rpow_one] using (convexOn_rpow_left ht).secant_mono (mem_univ 1) (mem_univ a) + (mem_univ b) ha.ne hb.ne' (ha.trans hb).le + +/-- For `t ≥ 0`, `-1 / 2 ≤ t * log t` (the optimal lower bound is `-exp (-1)`). -/ +lemma neg_inv_two_le_mul_log {t : ℝ} (ht : 0 ≤ t) : -2⁻¹ ≤ t * log t := + (neg_inv_two_le_rpow_sub_self_div_sub_one ht le_rfl (by norm_num)).trans + (rpow_sub_self_div_sub_one_le_mul_log ht (by norm_num)) + +end Real diff --git a/Statlib/ForMathlib/Analysis/SpecialFunctions/Pow/NNReal.lean b/Statlib/ForMathlib/Analysis/SpecialFunctions/Pow/NNReal.lean new file mode 100644 index 0000000..87fe926 --- /dev/null +++ b/Statlib/ForMathlib/Analysis/SpecialFunctions/Pow/NNReal.lean @@ -0,0 +1,88 @@ +/- +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.Analysis.SpecialFunctions.Pow.NNReal + +/-! +# Weighted geometric means in `ℝ≥0∞` + +## Main statements + +* `ENNReal.rpow_sum_of_nonneg`: `x ^ ∑ i ∈ s, w i = ∏ i ∈ s, x ^ w i` for nonnegative exponents. +* `ENNReal.prod_rpow_le_iSup`: a weighted geometric mean is at most the maximum. +* `ENNReal.min_le_rpow_mul_rpow`: for `a ∈ [0, 1]`, `min x y ≤ x ^ a * y ^ (1 - a)`. +* `ENNReal.min_eq_rpow_mul_rpow_mul_min`: for `u, v ∈ (0, ∞)` and `a : ℝ`, + `min u v = u ^ a * v ^ (1 - a) * min ((u / v) ^ (1 - a)) ((v / u) ^ a)`. +-/ + +@[expose] public section + +namespace ENNReal + +variable {a : ℝ} + +/-- `x ^ ∑ i ∈ s, w i = ∏ i ∈ s, x ^ w i` for nonnegative exponents. This is the analogue of +`Real.rpow_sum_of_nonneg`. -/ +lemma rpow_sum_of_nonneg {ι : Type*} (x : ℝ≥0∞) {s : Finset ι} {w : ι → ℝ} + (hw : ∀ i ∈ s, 0 ≤ w i) : + x ^ ∑ i ∈ s, w i = ∏ i ∈ s, x ^ w i := by + induction s using Finset.cons_induction with + | empty => simp + | cons i s hi ih => + rw [Finset.prod_cons, Finset.sum_cons, ← ih fun j hj ↦ hw j (by simp [hj]), + ENNReal.rpow_add_of_nonneg _ _ (hw i (by simp)) + (Finset.sum_nonneg fun j hj ↦ hw j (by simp [hj]))] + +/-- A weighted geometric mean is at most the maximum: if `w i ≥ 0` for `i ∈ s` and +`∑ i ∈ s, w i = 1`, then `∏ i ∈ s, f i ^ w i ≤ ⨆ i ∈ s, f i`. -/ +lemma prod_rpow_le_iSup {ι : Type*} {s : Finset ι} (f : ι → ℝ≥0∞) {w : ι → ℝ} + (hw : ∀ i ∈ s, 0 ≤ w i) (hw_sum : ∑ i ∈ s, w i = 1) : + ∏ i ∈ s, f i ^ w i ≤ ⨆ i ∈ s, f i := + calc ∏ i ∈ s, f i ^ w i + _ ≤ ∏ i ∈ s, (⨆ j ∈ s, f j) ^ w i := + Finset.prod_le_prod fun i hi ↦ ENNReal.rpow_le_rpow (le_biSup f hi) (hw i hi) + _ = ⨆ i ∈ s, f i := by rw [← rpow_sum_of_nonneg _ hw, hw_sum, ENNReal.rpow_one] + +/-- The minimum of two numbers is at most any of their weighted geometric means: +for `a ∈ [0, 1]`, `min x y ≤ x ^ a * y ^ (1 - a)`. -/ +lemma min_le_rpow_mul_rpow (x y : ℝ≥0∞) (ha0 : 0 ≤ a) (ha1 : a ≤ 1) : + min x y ≤ x ^ a * y ^ (1 - a) := by + have ha1' : 0 ≤ 1 - a := by linarith + rcases le_total x y with h | h + · rw [min_eq_left h] + calc x = x ^ a * x ^ (1 - a) := by + rw [← ENNReal.rpow_add_of_nonneg _ _ ha0 ha1']; simp + _ ≤ x ^ a * y ^ (1 - a) := by gcongr + · rw [min_eq_right h] + calc y = y ^ a * y ^ (1 - a) := by + rw [← ENNReal.rpow_add_of_nonneg _ _ ha0 ha1']; simp + _ ≤ x ^ a * y ^ (1 - a) := by gcongr + +/-- For `u, v ∈ (0, ∞)` and `a : ℝ`, +`min u v = u ^ a * v ^ (1 - a) * min ((u / v) ^ (1 - a)) ((v / u) ^ a)`. -/ +lemma min_eq_rpow_mul_rpow_mul_min {u v : ℝ≥0∞} (hu0 : u ≠ 0) (hu : u ≠ ∞) + (hv0 : v ≠ 0) (hv : v ≠ ∞) (a : ℝ) : + min u v = u ^ a * v ^ (1 - a) * min ((u / v) ^ (1 - a)) ((v / u) ^ a) := by + have h_cancel {x : ℝ≥0∞} (hx0 : x ≠ 0) (hx : x ≠ ∞) (b : ℝ) : x ^ b * (x ^ b)⁻¹ = 1 := + ENNReal.mul_inv_cancel (ENNReal.rpow_pos (pos_iff_ne_zero.mpr hx0) hx).ne' + (ENNReal.rpow_ne_top_of_ne_zero hx0 hx) + rw [Monotone.map_min (mul_right_mono : Monotone (u ^ a * v ^ (1 - a) * ·))] + congr 1 + · rw [div_eq_mul_inv, ENNReal.mul_rpow_of_ne_zero hu0 (ENNReal.inv_ne_zero.mpr hv), + ENNReal.inv_rpow] + calc u = u ^ a * u ^ (1 - a) * (v ^ (1 - a) * (v ^ (1 - a))⁻¹) := by + rw [← ENNReal.rpow_add _ _ hu0 hu, h_cancel hv0 hv] + simp + _ = u ^ a * v ^ (1 - a) * (u ^ (1 - a) * (v ^ (1 - a))⁻¹) := by ring + · rw [div_eq_mul_inv, ENNReal.mul_rpow_of_ne_zero hv0 (ENNReal.inv_ne_zero.mpr hu), + ENNReal.inv_rpow] + calc v = v ^ a * v ^ (1 - a) * (u ^ a * (u ^ a)⁻¹) := by + rw [← ENNReal.rpow_add _ _ hv0 hv, h_cancel hu0 hu] + simp + _ = u ^ a * v ^ (1 - a) * (v ^ a * (u ^ a)⁻¹) := by ring + +end ENNReal diff --git a/Statlib/ForMathlib/Analysis/SpecialFunctions/Pow/Real.lean b/Statlib/ForMathlib/Analysis/SpecialFunctions/Pow/Real.lean new file mode 100644 index 0000000..8c8ec2a --- /dev/null +++ b/Statlib/ForMathlib/Analysis/SpecialFunctions/Pow/Real.lean @@ -0,0 +1,54 @@ +/- +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.Analysis.SpecialFunctions.Pow.Real + +/-! +# Elementary bounds on real powers + +## Main statements + +* `Real.rpow_le_one_add_rpow`: `t ^ a ≤ 1 + t ^ c` for `t ≥ 0` and `0 ≤ a ≤ c`. +* `Real.abs_mul_log_le_one_add_rpow`: `|t * log t| ≤ 1 + t ^ b / (b - 1)` for `t ≥ 0` and `b > 1`. +-/ + +@[expose] public section + +namespace Real + +variable {a b : ℝ} + +/-- For `t ≥ 0` and `0 ≤ a ≤ c`, `t ^ a ≤ 1 + t ^ c`. -/ +lemma rpow_le_one_add_rpow {t c : ℝ} (ht : 0 ≤ t) (ha : 0 ≤ a) (hac : a ≤ c) : + t ^ a ≤ 1 + t ^ c := by + rcases le_total t 1 with ht1 | ht1 + · linarith [rpow_le_one ht ht1 ha, rpow_nonneg ht c] + · linarith [rpow_le_rpow_of_exponent_le ht1 hac] + +/-- For `t ≥ 0` and `b > 1`, `|t * log t| ≤ 1 + t ^ b / (b - 1)`. -/ +lemma abs_mul_log_le_one_add_rpow {t : ℝ} (ht : 0 ≤ t) (hb : 1 < b) : + |t * log t| ≤ 1 + t ^ b / (b - 1) := by + have hb1 : 0 < b - 1 := by linarith + have h_nonneg : 0 ≤ t ^ b / (b - 1) := by positivity + rcases le_or_gt t 1 with ht1 | ht1 + · rcases ht.eq_or_lt with rfl | ht0 + · simpa using h_nonneg.trans (le_add_of_nonneg_left zero_le_one) + · have h := abs_log_mul_self_lt t ht0 ht1 + rw [mul_comm] at h + linarith + · have hlog : 0 ≤ log t := log_nonneg ht1.le + rw [abs_of_nonneg (mul_nonneg ht hlog)] + have h1 : log t ≤ t ^ (b - 1) / (b - 1) := log_le_rpow_div ht hb1 + have h2 : t * t ^ (b - 1) = t ^ b := by + rw [← rpow_one_add' ht (by linarith)] + congr 1 + ring + calc t * log t ≤ t * (t ^ (b - 1) / (b - 1)) := by gcongr + _ = t ^ b / (b - 1) := by rw [← h2]; ring + _ ≤ 1 + t ^ b / (b - 1) := by linarith + +end Real diff --git a/Statlib/ForMathlib/ENNReal.lean b/Statlib/ForMathlib/ENNReal.lean index 20cb17d..cca3c06 100644 --- a/Statlib/ForMathlib/ENNReal.lean +++ b/Statlib/ForMathlib/ENNReal.lean @@ -74,6 +74,10 @@ 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] +/-- An extended nonnegative real number bounded by `1` gives an element of the unit interval. -/ +lemma toReal_mem_unitInterval {r : ℝ≥0∞} (hr : r ≤ 1) : r.toReal ∈ unitInterval := + ⟨ENNReal.toReal_nonneg, ENNReal.toReal_le_of_le_ofReal zero_le_one (by simpa using hr)⟩ + section Ioo open Set diff --git a/Statlib/ForMathlib/EReal.lean b/Statlib/ForMathlib/EReal.lean index 4f04ee1..ca2c965 100644 --- a/Statlib/ForMathlib/EReal.lean +++ b/Statlib/ForMathlib/EReal.lean @@ -551,6 +551,11 @@ lemma continuousAt_sub_const {c x : EReal} (h' : x ≠ ⊥ ∨ c ≠ ⊥) : 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_add (c : ℝ) : Continuous (fun x : EReal ↦ c + x) := + continuous_iff_continuousAt.2 fun x ↦ (EReal.continuousAt_add (p := (c, x)) + (.inl (EReal.coe_ne_top c)) (.inl (EReal.coe_ne_bot c))).comp + (continuous_const.prodMk continuous_id).continuousAt + 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] diff --git a/Statlib/ForMathlib/InformationTheory/KullbackLeibler/Basic.lean b/Statlib/ForMathlib/InformationTheory/KullbackLeibler/Basic.lean index ef23dd0..066d820 100644 --- a/Statlib/ForMathlib/InformationTheory/KullbackLeibler/Basic.lean +++ b/Statlib/ForMathlib/InformationTheory/KullbackLeibler/Basic.lean @@ -6,9 +6,11 @@ Authors: Rémy Degenne, Lorenzo Luccioli module public import Mathlib.InformationTheory.KullbackLeibler.Basic +public import Mathlib.Probability.ConditionalProbability +public import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.RadonNikodym /-! -# Kullback-Leibler divergence of rescaled measures +# Kullback-Leibler divergence of rescaled and restricted measures ## Main statements @@ -17,8 +19,14 @@ public import Mathlib.InformationTheory.KullbackLeibler.Basic * `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_smul_smul_eq_add`: for probability measures `μ`, `ν` and `ρ`, + `KL(a • μ, c • ν) = KL(a • ρ, c • ρ) + a * KL(μ, ν)`. * `klDiv_inv_smul_le_of_le`: an inequality between Kullback-Leibler divergences of measures with the same masses also holds for the normalized measures. +* `mul_log_le_setIntegral_llr`: for an event `s`, + `μ(s) log (μ(s) / ν(s)) ≤ ∫ x in s, llr μ ν x ∂μ`. +* `klDiv_restrict_eq_add`: `KL(μ|s, ν|s) = KL(μ(s) • ρ, ν(s) • ρ) + μ(s) KL(μ[|s], ν[|s])`, in + which `μ[|s]` is the measure `μ` conditioned on `s`. This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli (https://github.com/RemyDegenne/testing-lower-bounds). @@ -79,6 +87,51 @@ lemma klDiv_smul_same' [IsFiniteMeasure μ] [IsFiniteMeasure ν] {c : ℝ≥0∞ rw [← ENNReal.smul_def, ← ENNReal.smul_def] exact klDiv_smul_same c +/-- The Kullback-Leibler divergence between rescaled probability measures: +`KL(a • μ, c • ν) = KL(a • ρ, c • ρ) + a * KL(μ, ν)` for any probability measure `ρ`. The first +term depends only on `a` and `c`. -/ +lemma klDiv_smul_smul_eq_add {β : Type*} {mβ : MeasurableSpace β} (μ ν : Measure α) + [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] (ρ : Measure β) [IsProbabilityMeasure ρ] + {a c : ℝ≥0∞} (ha : a ≠ ∞) (hc : c ≠ ∞) : + klDiv (a • μ) (c • ν) = klDiv (a • ρ) (c • ρ) + a * klDiv μ ν := by + have := μ.smul_finite ha + have := ν.smul_finite hc + have := ρ.smul_finite ha + have := ρ.smul_finite hc + rcases eq_or_ne a 0 with rfl | ha0 + · simp [klDiv_zero_left] + rcases eq_or_ne c 0 with rfl | hc0 + · have : NeZero (a • μ) := ⟨by simp [ha0, IsProbabilityMeasure.ne_zero]⟩ + have : NeZero (a • ρ) := ⟨by simp [ha0, IsProbabilityMeasure.ne_zero]⟩ + simp [klDiv_zero_right] + rw [klDiv_smul_right_eq_smul_left' hc0 hc, klDiv_smul_right_eq_smul_left' hc0 hc, smul_smul, + smul_smul] + set k := c⁻¹ * a with hk_def + have hk : k ≠ ∞ := ENNReal.mul_ne_top (ENNReal.inv_ne_top.2 hc0) ha + have hk0 : k ≠ 0 := mul_ne_zero (ENNReal.inv_ne_zero.2 hc) ha0 + have hck : c * k = a := by + rw [hk_def, ← mul_assoc, ENNReal.mul_inv_cancel hc0 hc, one_mul] + by_cases h_top : klDiv μ ν = ∞ + · rw [(klDiv_smul_left_eq_top_iff hk0 hk).mpr h_top, h_top, ENNReal.mul_top hc0, + ENNReal.mul_top ha0, add_top] + rw [klDiv_smul_left_eq_ofReal h_top hk, klDiv_smul_left_eq_ofReal (by simp [klDiv_self]) hk] + simp only [klDiv_self, measure_univ, ENNReal.toReal_one, ENNReal.toReal_zero, mul_zero, + zero_add, mul_one] + have hY : 0 ≤ 1 - k.toReal + k.toReal * Real.log k.toReal := by + have h := klFun_nonneg (ENNReal.toReal_nonneg (a := k)) + rw [klFun] at h + linarith + have hkK : k * klDiv μ ν = ENNReal.ofReal (k.toReal * (klDiv μ ν).toReal) := by + rw [ENNReal.ofReal_mul ENNReal.toReal_nonneg, ENNReal.ofReal_toReal hk, + ENNReal.ofReal_toReal h_top] + have h_eq : ENNReal.ofReal (k.toReal * (klDiv μ ν).toReal + (1 - k.toReal) + + k.toReal * Real.log k.toReal) + = ENNReal.ofReal (1 - k.toReal + k.toReal * Real.log k.toReal) + k * klDiv μ ν := by + rw [hkK, ← ENNReal.ofReal_add hY (mul_nonneg ENNReal.toReal_nonneg ENNReal.toReal_nonneg)] + congr 1 + ring + rw [h_eq, mul_add, ← mul_assoc, hck] + lemma klDiv_smul_left_le_of_le {β : Type*} {mβ : MeasurableSpace β} {μ₁ ν₁ : Measure α} {μ₂ ν₂ : Measure β} [IsFiniteMeasure μ₁] [IsFiniteMeasure ν₁] [IsFiniteMeasure μ₂] [IsFiniteMeasure ν₂] (h_eq_μ : μ₁ .univ = μ₂ .univ) (h_eq_ν : ν₁ .univ = ν₂ .univ) @@ -140,4 +193,52 @@ lemma klDiv_inv_smul_le_of_le {β : Type*} {mβ : MeasurableSpace β} {μ₁ ν 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ν) +/-! ### Restriction to an event -/ + +section Restrict + +open ProbabilityTheory + +variable {s : Set α} + +/-- **Expectation of the log-likelihood ratio on an event**: +`μ(s) log (μ(s) / ν(s)) ≤ ∫ x in s, llr μ ν x ∂μ`. Only the restrictions of `μ` and `ν` to `s` +matter: absolute continuity and integrability are required on `s` only. -/ +lemma mul_log_le_setIntegral_llr [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (hμν : μ.restrict s ≪ ν.restrict s) (h_int : IntegrableOn (llr μ ν) s μ) + (hs : MeasurableSet s) : + μ.real s * Real.log (μ.real s / ν.real s) ≤ ∫ x in s, llr μ ν x ∂μ := by + have h_llr : llr (μ.restrict s) (ν.restrict s) =ᵐ[μ.restrict s] llr μ ν := by + filter_upwards [hμν.ae_le (Measure.rnDeriv_restrict_restrict μ ν hs)] with x hx + rw [llr, llr, hx] + have h_int' : Integrable (llr (μ.restrict s) (ν.restrict s)) (μ.restrict s) := + h_int.congr h_llr.symm + have h := mul_log_le_toReal_klDiv hμν h_int' + rw [toReal_klDiv hμν h_int', integral_congr_ae h_llr] at h + simp only [measureReal_restrict_apply_univ] at h + linarith + +/-- The Kullback-Leibler divergence between the restrictions of two finite measures to an event +`s`: `KL(μ|s, ν|s) = KL(μ(s) • ρ, ν(s) • ρ) + μ(s) KL(μ[|s], ν[|s])` for any probability +measure `ρ`. -/ +lemma klDiv_restrict_eq_add {β : Type*} {mβ : MeasurableSpace β} [IsFiniteMeasure μ] + [IsFiniteMeasure ν] (s : Set α) (ρ : Measure β) [IsProbabilityMeasure ρ] : + klDiv (μ.restrict s) (ν.restrict s) = klDiv (μ s • ρ) (ν s • ρ) + μ s * klDiv μ[|s] ν[|s] := by + rcases eq_or_ne (μ s) 0 with hμs | hμs + · have := ρ.smul_finite (measure_ne_top ν s) + simp [Measure.restrict_eq_zero.mpr hμs, hμs, klDiv_zero_left] + rcases eq_or_ne (ν s) 0 with hνs | hνs + · have : NeZero (μ.restrict s) := ⟨by simp [Measure.restrict_eq_zero, hμs]⟩ + have : NeZero (μ s • ρ) := ⟨by simp [hμs, IsProbabilityMeasure.ne_zero]⟩ + simp [Measure.restrict_eq_zero.mpr hνs, hνs, klDiv_zero_right] + have h_restrict (ξ : Measure α) [IsFiniteMeasure ξ] (h : ξ s ≠ 0) : + ξ.restrict s = ξ s • ξ[|s] := by + rw [ProbabilityTheory.cond, smul_smul, ENNReal.mul_inv_cancel h (measure_ne_top _ _), one_smul] + have := cond_isProbabilityMeasure (μ := μ) hμs + have := cond_isProbabilityMeasure (μ := ν) hνs + rw [h_restrict μ hμs, h_restrict ν hνs] + exact klDiv_smul_smul_eq_add _ _ ρ (measure_ne_top _ _) (measure_ne_top _ _) + +end Restrict + end InformationTheory diff --git a/Statlib/ForMathlib/InformationTheory/KullbackLeibler/Bernoulli.lean b/Statlib/ForMathlib/InformationTheory/KullbackLeibler/Bernoulli.lean index 3f1ec94..d7792be 100644 --- a/Statlib/ForMathlib/InformationTheory/KullbackLeibler/Bernoulli.lean +++ b/Statlib/ForMathlib/InformationTheory/KullbackLeibler/Bernoulli.lean @@ -32,6 +32,12 @@ Bernoulli.lean`), which also defines an `ℝ≥0∞`-valued version. * `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)`. +* `ofReal_klBerReal_le_klDiv_bernoulliMeasure`: for `x ≠ y` and any `p, q`, + `ENNReal.ofReal (klBerReal p q) ≤ klDiv Ber(x, y, p) Ber(x, y, q)`. +* `klDiv_boolMeasure_ofReal_eq_klBerReal`: for `p ∈ [0, 1]` and `q ∈ (0, 1)`, the divergence + between the priors `boolMeasure (ENNReal.ofReal p) (ENNReal.ofReal (1 - p))` and + `boolMeasure (ENNReal.ofReal q) (ENNReal.ofReal (1 - q))` on `Bool` is + `ENNReal.ofReal (klBerReal p q)`. -/ @[expose] public section @@ -83,6 +89,13 @@ lemma klBerReal_eq_neg_binEntropy_sub (hq : q ≠ 0) (hq1 : q ≠ 1) : simp only [binEntropy_eq_negMulLog_add_negMulLog_one_sub, negMulLog_def] ring +/-- The binary Kullback-Leibler divergence to the parameter `1/2`. -/ +lemma klBerReal_two_inv_right (p : ℝ) : klBerReal p 2⁻¹ = log 2 - binEntropy p := by + rw [klBerReal_eq_neg_binEntropy_sub (by norm_num) (by norm_num)] + have h : (1 : ℝ) - 2⁻¹ = 2⁻¹ := by norm_num + rw [h, Real.log_inv] + ring + /-- **Gibbs' inequality** for Bernoulli distributions: the binary divergence is nonnegative. -/ lemma klBerReal_nonneg (hp0 : 0 ≤ p) (hp1 : p ≤ 1) (hq0 : 0 < q) (hq1 : q < 1) : 0 ≤ klBerReal p q := by @@ -120,6 +133,37 @@ lemma klDiv_bernoulliMeasure_eq_klBerReal (hxy : x ≠ y) (p : I) {q : I} (hq : field_simp ring +/-- The binary Kullback-Leibler divergence `klBerReal p q` is a lower bound for the +Kullback-Leibler divergence between the Bernoulli distributions with parameters `p` and `q`, with +equality for `q ∉ {0, 1}` (`klDiv_bernoulliMeasure_eq_klBerReal`). -/ +lemma ofReal_klBerReal_le_klDiv_bernoulliMeasure (hxy : x ≠ y) (p q : I) : + ENNReal.ofReal (klBerReal p q) ≤ klDiv Ber(x, y, p) Ber(x, y, q) := by + rcases eq_or_ne q 0 with rfl | hq0 + · -- `klBerReal p 0 = (1 - p) * log (1 - p) ≤ 0` + refine (ENNReal.ofReal_of_nonpos ?_).trans_le zero_le + simpa [klBerReal] using mul_log_nonpos (sub_nonneg.2 p.2.2) (sub_le_self _ p.2.1) + rcases eq_or_ne q 1 with rfl | hq1 + · -- `klBerReal p 1 = p * log p ≤ 0` + refine (ENNReal.ofReal_of_nonpos ?_).trans_le zero_le + simpa [klBerReal] using mul_log_nonpos p.2.1 p.2.2 + rw [klDiv_bernoulliMeasure_eq_klBerReal hxy p hq0 hq1] + +/-- The Kullback-Leibler divergence between two priors on `Bool` is the binary Kullback-Leibler +divergence between their parameters, for `p ∈ [0, 1]` and `q ∈ (0, 1)`. -/ +lemma klDiv_boolMeasure_ofReal_eq_klBerReal {p q : ℝ} (hp0 : 0 ≤ p) (hp1 : p ≤ 1) (hq0 : 0 < q) + (hq1 : q < 1) : + klDiv (Measure.boolMeasure (ENNReal.ofReal p) (ENNReal.ofReal (1 - p))) + (Measure.boolMeasure (ENNReal.ofReal q) (ENNReal.ofReal (1 - q))) + = ENNReal.ofReal (klBerReal p q) := by + have hp := Measure.boolMeasure_ofReal_eq_bernoulliMeasure ⟨p, hp0, hp1⟩ + have hq := Measure.boolMeasure_ofReal_eq_bernoulliMeasure ⟨q, hq0.le, hq1.le⟩ + simp only at hp hq + rw [hp, hq, klDiv_bernoulliMeasure_eq_klBerReal (by decide)] + · simp only [ne_eq, Subtype.ext_iff, Set.Icc.coe_zero] + exact hq0.ne' + · simp only [ne_eq, Subtype.ext_iff, Set.Icc.coe_one] + exact hq1.ne + end BernoulliMeasure end InformationTheory diff --git a/Statlib/ForMathlib/InformationTheory/KullbackLeibler/ChainRule.lean b/Statlib/ForMathlib/InformationTheory/KullbackLeibler/ChainRule.lean new file mode 100644 index 0000000..469a835 --- /dev/null +++ b/Statlib/ForMathlib/InformationTheory/KullbackLeibler/ChainRule.lean @@ -0,0 +1,138 @@ +/- +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.ChainRule +public import Statlib.ForMathlib.InformationTheory.KullbackLeibler.DataProcessing +public import Statlib.ForMathlib.Probability.Kernel.Composition.MeasureCompProd + +/-! +# Chain rule for the Kullback-Leibler divergence with an arbitrary joint measure + +Mathlib's chain rule `InformationTheory.klDiv_compProd_eq_add` decomposes +`KL(μ ⊗ₘ κ, ν ⊗ₘ η)` along the first coordinate. The first argument does not need to be a +composition-product: for any finite measure `ρ` on `α × β`, any finite measure `μ` on `α` and any +Markov kernel `η`, `KL(ρ, μ ⊗ₘ η) = KL(ρ.fst, μ) + KL(ρ, ρ.fst ⊗ₘ η)`. Since `ρ` is not +disintegrated, this holds without assumptions on the measurable spaces. + +Applied after swapping the coordinates, with a constant kernel, this decomposes the divergence with +respect to a product measure: `KL(ρ, μ × ξ) = KL(ρ.snd, ξ) + KL(ρ, μ × ρ.snd)` for a probability +measure `μ`. + +## Main statements + +* `InformationTheory.llr_compProd_ae_eq_add`: for `ρ ≪ μ ⊗ₘ η`, the log-likelihood ratio + `llr ρ (μ ⊗ₘ η)` is `ρ`-a.e. equal to `(x, y) ↦ llr ρ.fst μ x + llr ρ (ρ.fst ⊗ₘ η) (x, y)`. +* `InformationTheory.integrable_llr_compProd_iff_fst`: the corresponding equivalence for the + integrability of the log-likelihood ratios. +* `InformationTheory.klDiv_compProd_eq_klDiv_fst_add`: **chain rule**, + `KL(ρ, μ ⊗ₘ η) = KL(ρ.fst, μ) + KL(ρ, ρ.fst ⊗ₘ η)`. +* `InformationTheory.klDiv_prod_eq_klDiv_snd_add`: `KL(ρ, μ × ξ) = KL(ρ.snd, ξ) + KL(ρ, μ × ρ.snd)` + for a probability measure `μ`. + +## Implementation notes + +As for Mathlib's chain rule, the proof treats separately the cases in which absolute continuity +fails (`MeasureTheory.Measure.absolutelyContinuous_compProd_iff_fst`) and in which the +log-likelihood ratios are not integrable. The integrability of `llr ρ (ρ.fst ⊗ₘ η)` follows from +those of `llr ρ (μ ⊗ₘ η)` and `llr ρ.fst μ`, the latter given by the data-processing inequality +`KL(ρ.fst, μ) ≤ KL(ρ, μ ⊗ₘ η)`. +-/ + +@[expose] public section + +open MeasureTheory ProbabilityTheory Real + +open scoped ENNReal + +namespace InformationTheory + +variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} + {ρ : Measure (α × β)} {μ : Measure α} {η : Kernel α β} + [IsFiniteMeasure ρ] [IsFiniteMeasure μ] [IsMarkovKernel η] + +/-- For `ρ ≪ μ ⊗ₘ η`, the log-likelihood ratio of `ρ` with respect to `μ ⊗ₘ η` is the sum of the +log-likelihood ratio of the first marginals and of that of `ρ` with respect to `ρ.fst ⊗ₘ η`. -/ +lemma llr_compProd_ae_eq_add (h_ac : ρ ≪ μ ⊗ₘ η) : + llr ρ (μ ⊗ₘ η) =ᵐ[ρ] fun p ↦ llr ρ.fst μ p.1 + llr ρ (ρ.fst ⊗ₘ η) p := by + obtain ⟨h_fst, h_ac'⟩ := Measure.absolutelyContinuous_compProd_iff_fst.mp h_ac + have h_ae_fst {P : α → Prop} (h : ∀ᵐ x ∂ρ.fst, P x) : ∀ᵐ p ∂ρ, P p.1 := + ae_of_ae_map measurable_fst.aemeasurable h + -- `∂ρ/∂(μ ⊗ₘ η) = ∂ρ/∂(ρ.fst ⊗ₘ η) * (∂ρ.fst/∂μ ∘ fst)`, both factors being positive and finite + filter_upwards [h_ac.ae_le (Measure.rnDeriv_mul_rnDeriv (κ := μ ⊗ₘ η) h_ac'), + h_ac.ae_le (rnDeriv_measure_compProd_left ρ.fst μ η), Measure.rnDeriv_pos h_ac', + h_ac'.ae_le (Measure.rnDeriv_lt_top ρ (ρ.fst ⊗ₘ η)), h_ae_fst (Measure.rnDeriv_pos h_fst), + h_ae_fst (h_fst.ae_le (Measure.rnDeriv_lt_top ρ.fst μ))] with p h1 h2 h3 h4 h5 h6 + rw [llr, llr, llr, ← h1, Pi.mul_apply, h2, ENNReal.toReal_mul, + log_mul (ENNReal.toReal_pos h3.ne' h4.ne).ne' (ENNReal.toReal_pos h5.ne' h6.ne).ne', add_comm] + +/-- For `ρ ≪ μ ⊗ₘ η`, the log-likelihood ratio `llr ρ (μ ⊗ₘ η)` is integrable if and only if +`llr ρ.fst μ` and `llr ρ (ρ.fst ⊗ₘ η)` are. -/ +lemma integrable_llr_compProd_iff_fst (h_ac : ρ ≪ μ ⊗ₘ η) : + Integrable (llr ρ (μ ⊗ₘ η)) ρ + ↔ Integrable (llr ρ.fst μ) ρ.fst ∧ Integrable (llr ρ (ρ.fst ⊗ₘ η)) ρ := by + have h_fst_iff : Integrable (llr ρ.fst μ) ρ.fst ↔ Integrable (fun p ↦ llr ρ.fst μ p.1) ρ := + integrable_map_measure (measurable_llr _ _).aestronglyMeasurable measurable_fst.aemeasurable + refine ⟨fun h ↦ ?_, fun h ↦ ?_⟩ + · -- data processing: `KL(ρ.fst, μ) ≤ KL(ρ, μ ⊗ₘ η) < ∞` + have h_le : klDiv ρ.fst μ ≤ klDiv ρ (μ ⊗ₘ η) := by + simpa [Measure.fst_compProd] using klDiv_fst_le ρ (μ ⊗ₘ η) + have h_int_fst : Integrable (llr ρ.fst μ) ρ.fst := + (klDiv_ne_top_iff.mp (ne_top_of_le_ne_top (klDiv_ne_top h_ac h) h_le)).2 + refine ⟨h_int_fst, (h.sub (h_fst_iff.mp h_int_fst)).congr ?_⟩ + filter_upwards [llr_compProd_ae_eq_add h_ac] with p hp + rw [Pi.sub_apply, hp, add_sub_cancel_left] + · exact (integrable_congr (llr_compProd_ae_eq_add h_ac)).mpr ((h_fst_iff.mp h.1).add h.2) + +variable (ρ μ η) in +/-- **Chain rule** for the Kullback-Leibler divergence with an arbitrary joint measure `ρ`: +`KL(ρ, μ ⊗ₘ η) = KL(ρ.fst, μ) + KL(ρ, ρ.fst ⊗ₘ η)`. Mathlib's `klDiv_compProd_eq_add` is the case +of a composition-product `ρ`. This holds without assumptions on the measurable spaces. -/ +theorem klDiv_compProd_eq_klDiv_fst_add : + klDiv ρ (μ ⊗ₘ η) = klDiv ρ.fst μ + klDiv ρ (ρ.fst ⊗ₘ η) := by + -- if absolute continuity does not hold, both sides are `∞` + by_cases h_ac : ρ ≪ μ ⊗ₘ η + swap + · rw [klDiv_of_not_ac h_ac] + rw [Measure.absolutelyContinuous_compProd_iff_fst, not_and_or] at h_ac + rcases h_ac with h | h <;> simp [klDiv_of_not_ac h] + -- same if the log-likelihood ratio is not integrable + by_cases h_int : Integrable (llr ρ (μ ⊗ₘ η)) ρ + swap + · rw [klDiv_of_not_integrable h_int] + rw [integrable_llr_compProd_iff_fst h_ac, not_and_or] at h_int + rcases h_int with h | h <;> simp [klDiv_of_not_integrable h] + obtain ⟨h_ac_fst, h_ac'⟩ := Measure.absolutelyContinuous_compProd_iff_fst.mp h_ac + obtain ⟨h_int_fst, h_int'⟩ := (integrable_llr_compProd_iff_fst h_ac).mp h_int + -- the integral of the log-likelihood ratio splits + have h_integral : ∫ p, llr ρ (μ ⊗ₘ η) p ∂ρ + = ∫ x, llr ρ.fst μ x ∂ρ.fst + ∫ p, llr ρ (ρ.fst ⊗ₘ η) p ∂ρ := by + have h_int_fst' : Integrable (fun p ↦ llr ρ.fst μ p.1) ρ := + (integrable_map_measure (measurable_llr _ _).aestronglyMeasurable + measurable_fst.aemeasurable).mp h_int_fst + rw [integral_congr_ae (llr_compProd_ae_eq_add h_ac), integral_add h_int_fst' h_int'] + congr 1 + exact (integral_map measurable_fst.aemeasurable + (measurable_llr _ _).aestronglyMeasurable).symm + rw [klDiv_of_ac_of_integrable h_ac h_int, klDiv_of_ac_of_integrable h_ac_fst h_int_fst, + klDiv_of_ac_of_integrable h_ac' h_int', + ← ENNReal.ofReal_add (integral_llr_add_sub_measure_univ_nonneg h_ac_fst h_int_fst) + (integral_llr_add_sub_measure_univ_nonneg h_ac' h_int'), h_integral] + simp only [measureReal_def, Measure.compProd_apply_univ, Measure.fst_univ] + ring_nf + +/-- The Kullback-Leibler divergence between a measure `ρ` on `α × β` and a product measure +`μ × ξ`, for a probability measure `μ`: `KL(ρ, μ × ξ) = KL(ρ.snd, ξ) + KL(ρ, μ × ρ.snd)`. -/ +theorem klDiv_prod_eq_klDiv_snd_add (ρ : Measure (α × β)) [IsFiniteMeasure ρ] (μ : Measure α) + [IsProbabilityMeasure μ] (ξ : Measure β) [IsFiniteMeasure ξ] : + klDiv ρ (μ.prod ξ) = klDiv ρ.snd ξ + klDiv ρ (μ.prod ρ.snd) := by + -- swap the coordinates and apply the chain rule with the constant kernel `Kernel.const β μ` + have h := klDiv_compProd_eq_klDiv_fst_add (ρ.map Prod.swap) ξ (Kernel.const β μ) + rw [Measure.fst_map_swap, Measure.compProd_const, Measure.compProd_const, ← Measure.prod_swap, + ← Measure.prod_swap (μ := μ), klDiv_map_swap, klDiv_map_swap] at h + exact h + +end InformationTheory diff --git a/Statlib/ForMathlib/InformationTheory/KullbackLeibler/DataProcessing.lean b/Statlib/ForMathlib/InformationTheory/KullbackLeibler/DataProcessing.lean index d870a84..d402963 100644 --- a/Statlib/ForMathlib/InformationTheory/KullbackLeibler/DataProcessing.lean +++ b/Statlib/ForMathlib/InformationTheory/KullbackLeibler/DataProcessing.lean @@ -18,6 +18,12 @@ Consequences of Mathlib's data-processing inequality for measurable maps, `klDiv between the joint measures. * `le_klDiv_compProd`: `klDiv μ ν ≤ klDiv (μ ⊗ₘ κ) (ν ⊗ₘ η)` for Markov kernels `κ, η`. * `klDiv_comp_le_compProd`: `klDiv (κ ∘ₘ μ) (η ∘ₘ ν) ≤ klDiv (μ ⊗ₘ κ) (ν ⊗ₘ η)`. +* `klDiv_map_measurableEmbedding`: the divergence is invariant under measurable embeddings, and in + particular under the swap of the coordinates of a product space (`klDiv_map_swap`). +* `klDiv_trim_mono`: the divergence between the restrictions of two finite measures to a + sub-σ-algebra is monotone in the sub-σ-algebra. For instance, the divergence between the + restrictions to the σ-algebras of stopping times `σ ≤ τ` is monotone, by + `MeasureTheory.IsStoppingTime.measurableSpace_mono`. This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli (https://github.com/RemyDegenne/testing-lower-bounds). @@ -49,4 +55,28 @@ lemma klDiv_comp_le_compProd (μ ν : Measure α) [IsFiniteMeasure μ] [IsFinite klDiv (κ ∘ₘ μ) (η ∘ₘ ν) ≤ klDiv (μ ⊗ₘ κ) (ν ⊗ₘ η) := by simpa using klDiv_snd_le (μ ⊗ₘ κ) (ν ⊗ₘ η) +/-- The Kullback-Leibler divergence is invariant under measurable embeddings. -/ +lemma klDiv_map_measurableEmbedding (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + {f : α → β} (hf : MeasurableEmbedding f) : + klDiv (μ.map f) (ν.map f) = klDiv μ ν := by + refine le_antisymm (klDiv_map_le μ ν hf.measurable) ?_ + cases isEmpty_or_nonempty α + · simp [Measure.eq_zero_of_isEmpty μ, Measure.eq_zero_of_isEmpty ν] + calc klDiv μ ν = klDiv ((μ.map f).map hf.invFun) ((ν.map f).map hf.invFun) := by + simp [Measure.map_map hf.measurable_invFun hf.measurable, hf.leftInverse_invFun.id] + _ ≤ klDiv (μ.map f) (ν.map f) := klDiv_map_le _ _ hf.measurable_invFun + +/-- The Kullback-Leibler divergence is invariant under swapping the coordinates. -/ +lemma klDiv_map_swap (μ ν : Measure (α × β)) [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + klDiv (μ.map Prod.swap) (ν.map Prod.swap) = klDiv μ ν := + klDiv_map_measurableEmbedding μ ν MeasurableEquiv.prodComm.measurableEmbedding + +/-- The Kullback-Leibler divergence between the restrictions of two finite measures to a +sub-σ-algebra is monotone in the sub-σ-algebra. -/ +lemma klDiv_trim_mono (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasure ν] + {m₁ m₂ : MeasurableSpace α} (h₁₂ : m₁ ≤ m₂) (h₂ : m₂ ≤ mα) : + klDiv (μ.trim (h₁₂.trans h₂)) (ν.trim (h₁₂.trans h₂)) ≤ klDiv (μ.trim h₂) (ν.trim h₂) := by + rw [← trim_trim (μ := μ) (hm₁₂ := h₁₂), ← trim_trim (μ := ν) (hm₁₂ := h₁₂)] + exact klDiv_trim_le _ _ h₁₂ + end InformationTheory diff --git a/Statlib/ForMathlib/MeasureTheory/Constructions/Pi.lean b/Statlib/ForMathlib/MeasureTheory/Constructions/Pi.lean new file mode 100644 index 0000000..0d401f1 --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Constructions/Pi.lean @@ -0,0 +1,57 @@ +/- +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.MeasureTheory.Constructions.Pi + +/-! +# Complements on finite products of measures + +## Main statements + +* `MeasureTheory.Measure.pi.instNeZero`: a finite product of nonzero σ-finite measures is nonzero. +* `MeasureTheory.Measure.pi_map_comp_of_injective`: the image of a product of probability measures + `Measure.pi μ` by the restriction of the coordinates along an injective map `f` is + `Measure.pi (fun i ↦ μ (f i))`. +-/ + +@[expose] public section + +open Set + +namespace MeasureTheory.Measure + +instance pi.instNeZero {ι : Type*} [Fintype ι] {X : ι → Type*} {mX : ∀ i, MeasurableSpace (X i)} + {μ : (i : ι) → Measure (X i)} [∀ i, SigmaFinite (μ i)] [∀ i, NeZero (μ i)] : + NeZero (Measure.pi μ) := + ⟨fun h ↦ by simpa [pi_univ, Finset.prod_eq_zero_iff, NeZero.ne] using congr($h .univ)⟩ + +/-- The image of a product of probability measures by the restriction of the coordinates along an +injective map `f` is the product of the measures indexed by `f`. -/ +lemma pi_map_comp_of_injective {ι κ : Type*} [Fintype ι] [Fintype κ] {X : κ → Type*} + {mX : ∀ k, MeasurableSpace (X k)} (μ : (k : κ) → Measure (X k)) + [∀ k, IsProbabilityMeasure (μ k)] {f : ι → κ} (hf : f.Injective) : + (Measure.pi μ).map (fun x i ↦ x (f i)) = Measure.pi fun i ↦ μ (f i) := by + refine (Measure.pi_eq fun s hs ↦ ?_).symm + rw [Measure.map_apply (by fun_prop) (MeasurableSet.univ_pi hs)] + -- the preimage of the box `univ.pi s` is the box with side `s i` at `f i` and `univ` elsewhere + let t (k : κ) : Set (X k) := {y | ∀ i (h : f i = k), cast (congrArg X h.symm) y ∈ s i} + have ht (i : ι) : t (f i) = s i := by + ext y + refine ⟨fun hy ↦ hy i rfl, fun hy j hj ↦ ?_⟩ + obtain rfl := hf hj + exact hy + have h_pre : (fun x i ↦ x (f i)) ⁻¹' univ.pi s = univ.pi t := by + ext x + simp only [mem_preimage, mem_univ_pi] + refine ⟨fun hx k i hik ↦ ?_, fun hx i ↦ ht i ▸ hx (f i)⟩ + subst hik + exact hx i + rw [h_pre, Measure.pi_pi] + refine (Fintype.prod_of_injective f hf _ _ (fun k hk ↦ ?_) fun i ↦ by rw [ht]).symm + rw [show t k = univ from eq_univ_of_forall fun y i hik ↦ absurd ⟨i, hik⟩ hk, measure_univ] + +end MeasureTheory.Measure diff --git a/Statlib/ForMathlib/MeasureTheory/Function/ConditionalLExpectation.lean b/Statlib/ForMathlib/MeasureTheory/Function/ConditionalLExpectation.lean new file mode 100644 index 0000000..181be6d --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Function/ConditionalLExpectation.lean @@ -0,0 +1,73 @@ +/- +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.MeasureTheory.Function.ConditionalLExpectation +public import Statlib.ForMathlib.MeasureTheory.Measure.Trim + +/-! +# Conditional Lebesgue expectation with respect to a countable partition + +For a measurable map `g : α → β` to a countable space with measurable singletons, the +sigma-algebra `mβ.comap g` is generated by the countable partition `{g ⁻¹' {b}}`. The conditional +Lebesgue expectation with respect to it is the average over the cell containing the point. + +## Main statements + +* `MeasureTheory.ae_measure_preimage_singleton_ne_zero`: almost every point lies in a cell of + positive measure. +* `MeasureTheory.condLExp_comap_ae_eq`: `P⁻[X | mβ.comap g] x` is the average of `X` over the cell + `g ⁻¹' {g x}`, for `P`-almost every `x`. +-/ + +@[expose] public section + +open Set MeasureTheory + +open scoped ENNReal + +namespace MeasureTheory + +variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} + [Countable β] {g : α → β} {P : Measure α} + +/-- Almost every point lies in a cell `g ⁻¹' {g x}` of positive measure. -/ +lemma ae_measure_preimage_singleton_ne_zero : + ∀ᵐ x ∂P, P (g ⁻¹' {g x}) ≠ 0 := by + have h_null : P (⋃ b ∈ {b | P (g ⁻¹' {b}) = 0}, g ⁻¹' {b}) = 0 := + (measure_biUnion_null_iff (to_countable _)).2 fun b hb ↦ hb + refine measure_mono_null (fun x hx ↦ ?_) h_null + simp only [mem_iUnion, mem_preimage, mem_singleton_iff, exists_prop] + exact ⟨g x, not_not.mp hx, rfl⟩ + +/-- The conditional Lebesgue expectation with respect to the sigma-algebra induced by a map `g` +with countable codomain is the average over the cell `g ⁻¹' {g x}`. + +The hypothesis that `P.map g` is σ-finite means that all the cells have finite measure. -/ +theorem condLExp_comap_ae_eq [MeasurableSingletonClass β] [SigmaFinite (P.map g)] + (hg : Measurable g) (X : α → ℝ≥0∞) : + P⁻[X | mβ.comap g] =ᵐ[P] fun x ↦ (∫⁻ y in g ⁻¹' {g x}, X y ∂P) / P (g ⁻¹' {g x}) := by + have := sigmaFinite_trim_comap (μ := P) hg + set c : β → ℝ≥0∞ := fun b ↦ (∫⁻ y in g ⁻¹' {b}, X y ∂P) / P (g ⁻¹' {b}) + have h_cell (b : β) : ∫⁻ x in g ⁻¹' {b}, c (g x) ∂P = ∫⁻ x in g ⁻¹' {b}, X x ∂P := by + have hb : MeasurableSet (g ⁻¹' {b}) := hg (measurableSet_singleton b) + rw [setLIntegral_congr_fun hb (g := fun _ ↦ c b) fun x hx ↦ by rw [hx], setLIntegral_const] + rcases eq_or_ne (P (g ⁻¹' {b})) 0 with h0 | h0 + · rw [h0, mul_zero, setLIntegral_measure_zero _ _ h0] + · refine ENNReal.div_mul_cancel h0 ?_ + rw [← Measure.map_apply hg (measurableSet_singleton b)] + exact measure_singleton_lt_top.ne + refine (ae_eq_condLExp hg.comap_le P X ((measurable_of_countable c).comp (comap_measurable g)) + fun s hs ↦ ?_).symm + obtain ⟨t, -, rfl⟩ := hs + have h_disj : t.PairwiseDisjoint fun b ↦ g ⁻¹' {b} := + fun a _ b _ hab ↦ (disjoint_singleton.2 hab).preimage g + have h_meas : ∀ b ∈ t, MeasurableSet (g ⁻¹' {b}) := fun b _ ↦ hg (measurableSet_singleton b) + rw [← biUnion_preimage_singleton, lintegral_biUnion (to_countable t) h_meas h_disj, + lintegral_biUnion (to_countable t) h_meas h_disj] + simp_rw [Function.comp_apply, h_cell] + +end MeasureTheory diff --git a/Statlib/ForMathlib/MeasureTheory/Integral/Layercake.lean b/Statlib/ForMathlib/MeasureTheory/Integral/Layercake.lean new file mode 100644 index 0000000..c7be0f7 --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Integral/Layercake.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 Mathlib.MeasureTheory.Function.Floor +public import Mathlib.MeasureTheory.Integral.Bochner.Basic + +/-! +# Tail-sum formula for random variables with values in `ℕ` + +A discrete version of the layer cake formula: for a random variable `σ` with values in `ℕ`, +`∑ n, P {n ≤ σ} = ∫ (σ + 1) ∂P`. + +## Main statements + +* `sum_Iic_eq_tsum_indicator`: a sum up to a random time `τ` is the series of the terms restricted + to the events `{n ≤ τ}`. +* `MeasureTheory.tsum_measure_le_eq_lintegral`: **tail-sum formula**, + `∑ n, P {n ≤ σ} = ∫⁻ (σ + 1) ∂P` for a random variable `σ` with values in `ℕ`. +* `MeasureTheory.hasSum_measureReal_le`: **tail-sum formula**, `∑ n, P {n ≤ σ} = ∫ (σ + 1) ∂P` for + an integrable random variable `σ` with values in `ℕ`. +-/ + +@[expose] public section + +open scoped ENNReal + +/-- A sum up to a random time `τ` is the series of the terms restricted to the events +`{n ≤ τ}`. -/ +lemma sum_Iic_eq_tsum_indicator {Ω M : Type*} [AddCommMonoid M] [TopologicalSpace M] + (X : ℕ → Ω → M) (τ : Ω → ℕ) (ω : Ω) : + ∑ n ∈ Finset.Iic (τ ω), X n ω = ∑' n, {ω | n ≤ τ ω}.indicator (X n) ω := by + rw [tsum_eq_sum (s := Finset.Iic (τ ω))] + · refine Finset.sum_congr rfl fun n hn ↦ ?_ + rw [Set.indicator_of_mem] + simpa using hn + · intro n hn + rw [Set.indicator_of_notMem] + simpa using hn + +namespace MeasureTheory + +variable {Ω : Type*} {mΩ : MeasurableSpace Ω} {P : Measure Ω} + +/-- For an integrable random variable `σ` with values in `ℕ`, the expectation of `σ + 1` computed in +`ℝ` and in `ℝ≥0∞` agree. -/ +lemma ofReal_integral_natCast_add_one_eq_lintegral [IsFiniteMeasure P] {σ : Ω → ℕ} + (hσ_int : Integrable (fun ω ↦ (σ ω : ℝ)) P) : + ENNReal.ofReal (∫ ω, (σ ω + 1 : ℝ) ∂P) = ∫⁻ ω, (σ ω + 1 : ℝ≥0∞) ∂P := by + rw [ofReal_integral_eq_lintegral_ofReal (f := fun ω ↦ (σ ω + 1 : ℝ)) + (hσ_int.add (integrable_const _)) (ae_of_all _ fun ω ↦ by positivity)] + congr with ω + rw [ENNReal.ofReal_add (by positivity) zero_le_one] + simp + +/-- **Tail-sum formula** for a random variable `σ` with values in `ℕ`: +`∑ n, P {n ≤ σ} = ∫⁻ (σ + 1) ∂P`. -/ +lemma tsum_measure_le_eq_lintegral {σ : Ω → ℕ} (hσ : AEMeasurable σ P) : + ∑' n, P {ω | n ≤ σ ω} = ∫⁻ ω, (σ ω + 1 : ℝ≥0∞) ∂P := by + have h_meas (n : ℕ) : NullMeasurableSet {ω | n ≤ σ ω} P := + nullMeasurableSet_le aemeasurable_const hσ + have h_pt (ω : Ω) : ∑' n, {ω | n ≤ σ ω}.indicator (1 : Ω → ℝ≥0∞) ω = σ ω + 1 := by + rw [← sum_Iic_eq_tsum_indicator (fun _ ↦ 1)] + simp + rw [← funext h_pt, lintegral_tsum fun n ↦ measurable_one.aemeasurable.indicator₀ (h_meas n)] + congr with n + rw [lintegral_indicator_one₀ (h_meas n)] + +/-- **Tail-sum formula** for an integrable random variable `σ` with values in `ℕ`: +`∑ n, P {n ≤ σ} = ∫ (σ + 1) ∂P`. -/ +lemma hasSum_measureReal_le [IsFiniteMeasure P] {σ : Ω → ℕ} + (hσ_int : Integrable (fun ω ↦ (σ ω : ℝ)) P) : + HasSum (fun n ↦ P.real {ω | n ≤ σ ω}) (∫ ω, (σ ω + 1 : ℝ) ∂P) := by + -- `σ = ⌊σ⌋₊` is a.e.-measurable since its cast to `ℝ` is integrable + have hσ : AEMeasurable σ P := by + simpa [Function.comp_def] using Nat.measurable_floor.comp_aemeasurable hσ_int.aemeasurable + have h_lint : ∑' n, P {ω | n ≤ σ ω} = ENNReal.ofReal (∫ ω, (σ ω + 1 : ℝ) ∂P) := by + rw [tsum_measure_le_eq_lintegral hσ, ofReal_integral_natCast_add_one_eq_lintegral hσ_int] + have h := ENNReal.hasSum_toReal (f := fun n ↦ P {ω | n ≤ σ ω}) + (by rw [h_lint]; exact ENNReal.ofReal_ne_top) + rwa [← ENNReal.tsum_toReal_eq (fun n ↦ measure_ne_top _ _), h_lint, + ENNReal.toReal_ofReal (integral_nonneg fun ω ↦ by positivity)] at h + +end MeasureTheory diff --git a/Statlib/ForMathlib/MeasureTheory/Integral/MeanInequalities.lean b/Statlib/ForMathlib/MeasureTheory/Integral/MeanInequalities.lean new file mode 100644 index 0000000..b9547e2 --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Integral/MeanInequalities.lean @@ -0,0 +1,42 @@ +/- +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.MeasureTheory.Function.SpecialFunctions.Basic +public import Mathlib.MeasureTheory.Integral.MeanInequalities + +/-! +# Log-convexity of the integrals of powers + +## Main statements + +* `ENNReal.lintegral_rpow_le_rpow_mul_rpow`: the function `a ↦ ∫⁻ x, f x ^ a ∂μ` is log-convex on + `[0, ∞)`, a consequence of Hölder's inequality. +-/ + +@[expose] public section + +open MeasureTheory + +namespace ENNReal + +variable {α : Type*} {mα : MeasurableSpace α} {μ : Measure α} + +/-- Log-convexity of `a ↦ ∫⁻ x, f x ^ a ∂μ` on `[0, ∞)`, a consequence of Hölder's inequality. -/ +lemma lintegral_rpow_le_rpow_mul_rpow {f : α → ℝ≥0∞} (hf : AEMeasurable f μ) + {a b θ : ℝ} (ha : 0 ≤ a) (hb : 0 ≤ b) (hθ0 : 0 ≤ θ) (hθ1 : θ ≤ 1) : + ∫⁻ x, f x ^ (θ * a + (1 - θ) * b) ∂μ + ≤ (∫⁻ x, f x ^ a ∂μ) ^ θ * (∫⁻ x, f x ^ b ∂μ) ^ (1 - θ) := by + have hθ1' : 0 ≤ 1 - θ := by linarith + have h_eq : ∀ x, f x ^ (θ * a + (1 - θ) * b) = (f x ^ a) ^ θ * (f x ^ b) ^ (1 - θ) := by + intro x + rw [ENNReal.rpow_add_of_nonneg _ _ (mul_nonneg hθ0 ha) (mul_nonneg hθ1' hb), + ← ENNReal.rpow_mul, ← ENNReal.rpow_mul, mul_comm θ a, mul_comm (1 - θ) b] + simp_rw [h_eq] + exact ENNReal.lintegral_mul_norm_pow_le (hf.pow_const a) (hf.pow_const b) hθ0 hθ1' + (by ring) + +end ENNReal diff --git a/Statlib/ForMathlib/MeasureTheory/Integral/Pi.lean b/Statlib/ForMathlib/MeasureTheory/Integral/Pi.lean new file mode 100644 index 0000000..21abcf5 --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Integral/Pi.lean @@ -0,0 +1,68 @@ +/- +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.MeasureTheory.Integral.Pi + +/-! +# Tonelli's theorem for finite products of functions + +Lebesgue integral versions of Mathlib's `MeasureTheory.integral_fin_nat_prod_eq_prod` and +`MeasureTheory.integral_fintype_prod_eq_prod`. + +## Main statements + +* `MeasureTheory.lintegral_fintype_prod_eq_prod`: **Tonelli's theorem** for a product of functions + of each coordinate, `∫⁻ x, ∏ i, f i (x i) ∂(Measure.pi μ) = ∏ i, ∫⁻ x, f i x ∂(μ i)`. +-/ + +@[expose] public section + +open scoped ENNReal + +namespace MeasureTheory + +/-- **Tonelli's theorem** for a product of functions of each coordinate, on a product space indexed +by `Fin n`. -/ +theorem lintegral_fin_nat_prod_eq_prod {n : ℕ} {E : Fin n → Type*} + {mE : ∀ i, MeasurableSpace (E i)} {μ : (i : Fin n) → Measure (E i)} [∀ i, SigmaFinite (μ i)] + {f : (i : Fin n) → E i → ℝ≥0∞} (hf : ∀ i, AEMeasurable (f i) (μ i)) : + ∫⁻ x, ∏ i, f i (x i) ∂(Measure.pi μ) = ∏ i, ∫⁻ x, f i x ∂(μ i) := by + induction n with + | zero => simp + | succ n ih => + calc ∫⁻ x, ∏ i, f i (x i) ∂(Measure.pi μ) + _ = ∫⁻ y : E 0 × ((j : Fin n) → E (Fin.succAbove 0 j)), + f 0 y.1 * ∏ j, f (Fin.succAbove 0 j) (y.2 j) + ∂((μ 0).prod (Measure.pi fun j ↦ μ (Fin.succAbove 0 j))) := by + rw [← ((measurePreserving_piFinSuccAbove μ 0).symm).lintegral_comp_emb + (MeasurableEquiv.measurableEmbedding _)] + refine lintegral_congr fun y ↦ ?_ + simp only [Fin.prod_univ_succAbove _ 0, MeasurableEquiv.piFinSuccAbove_symm_apply, + Fin.insertNthEquiv, Equiv.coe_fn_mk, Fin.insertNth_apply_same, + Fin.insertNth_apply_succAbove] + _ = (∫⁻ x, f 0 x ∂μ 0) * ∏ j, ∫⁻ x, f (Fin.succAbove 0 j) x ∂(μ (Fin.succAbove 0 j)) := by + have h_meas : AEMeasurable (fun y : (j : Fin n) → E (Fin.succAbove 0 j) ↦ + ∏ j, f (Fin.succAbove 0 j) (y j)) (Measure.pi fun j ↦ μ (Fin.succAbove 0 j)) := + Finset.aemeasurable_fun_prod _ fun j _ ↦ + (hf _).comp_quasiMeasurePreserving (Measure.quasiMeasurePreserving_eval _ j) + rw [lintegral_prod_mul (hf 0) h_meas, ih fun i ↦ hf _] + _ = ∏ i, ∫⁻ x, f i x ∂(μ i) := + (Fin.prod_univ_succAbove (fun i ↦ ∫⁻ x, f i x ∂(μ i)) 0).symm + +/-- **Tonelli's theorem** for a product of functions of each coordinate, on a product space indexed +by a finite type. -/ +theorem lintegral_fintype_prod_eq_prod {ι : Type*} [Fintype ι] {E : ι → Type*} + {mE : ∀ i, MeasurableSpace (E i)} {μ : (i : ι) → Measure (E i)} [∀ i, SigmaFinite (μ i)] + {f : (i : ι) → E i → ℝ≥0∞} (hf : ∀ i, AEMeasurable (f i) (μ i)) : + ∫⁻ x, ∏ i, f i (x i) ∂(Measure.pi μ) = ∏ i, ∫⁻ x, f i x ∂(μ i) := by + let e := (Fintype.equivFin ι).symm + rw [← (measurePreserving_piCongrLeft _ e).lintegral_comp_emb + (MeasurableEquiv.measurableEmbedding _)] + simp_rw [← e.prod_comp, MeasurableEquiv.coe_piCongrLeft, Equiv.piCongrLeft_apply_apply] + exact lintegral_fin_nat_prod_eq_prod fun i ↦ hf _ + +end MeasureTheory diff --git a/Statlib/ForMathlib/MeasureTheory/MeasurableSpace/Basic.lean b/Statlib/ForMathlib/MeasureTheory/MeasurableSpace/Basic.lean new file mode 100644 index 0000000..38b5d6e --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/MeasurableSpace/Basic.lean @@ -0,0 +1,34 @@ +/- +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.MeasureTheory.MeasurableSpace.Basic + +/-! +# Measurable spaces + +## Main statements + +* `MeasurableSpace.finite_setOf_measurableSet_comap`: if `g` has finite range, the σ-algebra + `mβ.comap g` has finitely many measurable sets. +-/ + +@[expose] public section + +open Set MeasureTheory + +namespace MeasurableSpace + +variable {α β : Type*} {mβ : MeasurableSpace β} + +/-- The σ-algebra induced by a map with finite range has finitely many measurable sets. -/ +lemma finite_setOf_measurableSet_comap {g : α → β} (hg : (range g).Finite) : + {s | MeasurableSet[mβ.comap g] s}.Finite := by + refine (hg.finite_subsets.image fun t ↦ g ⁻¹' t).subset ?_ + rintro s ⟨t, -, rfl⟩ + exact ⟨t ∩ range g, inter_subset_right, preimage_inter_range⟩ + +end MeasurableSpace diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/Bool.lean b/Statlib/ForMathlib/MeasureTheory/Measure/Bool.lean index 42c90fd..3185a79 100644 --- a/Statlib/ForMathlib/MeasureTheory/Measure/Bool.lean +++ b/Statlib/ForMathlib/MeasureTheory/Measure/Bool.lean @@ -23,17 +23,32 @@ A measure on `Bool` is determined by its values on `{false}` and `{true}`. are equal. * `MeasureTheory.Measure.eq_boolMeasure`: every measure `π` on `Bool` is `boolMeasure (π {false}) (π {true})`. +* `MeasureTheory.Measure.prob_true_eq_one_sub`: `π {true} = 1 - π {false}` for a probability + measure `π` on `Bool`. +* `MeasureTheory.Measure.isProbabilityMeasure_boolMeasure`: `boolMeasure a b` is a probability + measure if `a + b = 1`. +* `MeasureTheory.Measure.eq_boolMeasure_toNNReal`: every probability measure `π` on `Bool` is the + prior `boolMeasure α (1 - α)` with `α = π {false}`. * `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}`. +## Implementation notes + +Two conventions are used for the prior `(α, 1 - α)` on `Bool`: +`boolMeasure (α : ℝ≥0∞) ((1 - α : ℝ≥0) : ℝ≥0∞)` with `α : ℝ≥0`, and +`boolMeasure (ENNReal.ofReal p) (ENNReal.ofReal (1 - p))` with `p : ℝ`. They are related by +`MeasureTheory.Measure.boolMeasure_coe_eq_ofReal`. The second one is the Bernoulli distribution +`Ber(false, true, p)` (`MeasureTheory.Measure.boolMeasure_ofReal_eq_bernoulliMeasure`, in +`Statlib.ForMathlib.Probability.Distributions.Bernoulli`). + 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 +open scoped ENNReal NNReal namespace MeasureTheory @@ -74,13 +89,70 @@ lemma isFiniteMeasure_boolMeasure {a b : ℝ≥0∞} (ha : a ≠ ∞) (hb : b instance isFiniteMeasure_boolMeasure_one_one : IsFiniteMeasure (boolMeasure 1 1) := isFiniteMeasure_boolMeasure ENNReal.one_ne_top ENNReal.one_ne_top +/-- `boolMeasure a b` is finite for masses `a b : ℝ≥0`. -/ +instance isFiniteMeasure_boolMeasure_coe (a b : ℝ≥0) : IsFiniteMeasure (boolMeasure a b) := + isFiniteMeasure_boolMeasure ENNReal.coe_ne_top ENNReal.coe_ne_top + +/-- `boolMeasure a b` is finite for masses given by `ENNReal.ofReal`. -/ +instance isFiniteMeasure_boolMeasure_ofReal (a b : ℝ) : + IsFiniteMeasure (boolMeasure (ENNReal.ofReal a) (ENNReal.ofReal b)) := + isFiniteMeasure_boolMeasure ENNReal.ofReal_ne_top ENNReal.ofReal_ne_top + +/-- `boolMeasure a b` is a probability measure if `a + b = 1`. -/ +lemma isProbabilityMeasure_boolMeasure {a b : ℝ≥0∞} (h : a + b = 1) : + IsProbabilityMeasure (boolMeasure a b) := + ⟨by simp [h]⟩ + +/-- The prior `(α, 1 - α)` on `Bool`, for `α : ℝ≥0` with `α ≤ 1`, is a probability measure. -/ +lemma isProbabilityMeasure_boolMeasure_coe {α : ℝ≥0} (hα : α ≤ 1) : + IsProbabilityMeasure (boolMeasure (α : ℝ≥0∞) ((1 - α : ℝ≥0) : ℝ≥0∞)) := + isProbabilityMeasure_boolMeasure <| by + rw [← ENNReal.coe_add, add_tsub_cancel_of_le hα, ENNReal.coe_one] + +/-- The prior `(p, 1 - p)` on `Bool`, for `p ∈ [0, 1]`, is a probability measure. -/ +lemma isProbabilityMeasure_boolMeasure_ofReal {p : ℝ} (hp0 : 0 ≤ p) (hp1 : p ≤ 1) : + IsProbabilityMeasure (boolMeasure (ENNReal.ofReal p) (ENNReal.ofReal (1 - p))) := + isProbabilityMeasure_boolMeasure <| by + rw [← ENNReal.ofReal_add hp0 (sub_nonneg.mpr hp1), add_sub_cancel, ENNReal.ofReal_one] + +/-- The prior `boolMeasure α (1 - α)` with `α : ℝ≥0`, written with `ENNReal.ofReal`. -/ +lemma boolMeasure_coe_eq_ofReal (α : ℝ≥0) : + boolMeasure (α : ℝ≥0∞) ((1 - α : ℝ≥0) : ℝ≥0∞) + = boolMeasure (ENNReal.ofReal α) (ENNReal.ofReal (1 - α)) := by + rw [ENNReal.ofReal_coe_nnreal, ENNReal.ofReal, NNReal.sub_def, NNReal.coe_one] + lemma eq_boolMeasure (π : Measure Bool) : π = boolMeasure (π {false}) (π {true}) := by ext <;> simp +lemma prob_true_eq_one_sub (π : Measure Bool) [IsProbabilityMeasure π] : + π {true} = 1 - π {false} := by + rw [← prob_compl_eq_one_sub (measurableSet_singleton false), Bool.compl_singleton, Bool.not_false] + +/-- A probability measure `π` on `Bool` is `boolMeasure α (1 - α)` for `α = π {false}`. -/ +lemma eq_boolMeasure_toNNReal (π : Measure Bool) [IsProbabilityMeasure π] : + π = boolMeasure ((π {false}).toNNReal : ℝ≥0∞) ((1 - (π {false}).toNNReal : ℝ≥0) : ℝ≥0∞) := by + conv_lhs => rw [eq_boolMeasure π] + rw [ENNReal.coe_toNNReal (measure_ne_top π _), ENNReal.coe_sub, ENNReal.coe_one, + ENNReal.coe_toNNReal (measure_ne_top π _), prob_true_eq_one_sub] + lemma withDensity_eq_boolMeasure (π : Measure Bool) (f : Bool → ℝ≥0∞) : π.withDensity f = boolMeasure (f false * π {false}) (f true * π {true}) := by ext <;> simp [mul_comm] +@[simp] +lemma smul_boolMeasure (c a b : ℝ≥0∞) : c • boolMeasure a b = boolMeasure (c * a) (c * b) := by + simp [boolMeasure, smul_add, smul_smul] + +/-- The restriction of `boolMeasure a b` to `{true}` is `b • dirac true`. -/ +lemma restrict_boolMeasure_true (a b : ℝ≥0∞) : + (boolMeasure a b).restrict {true} = b • dirac true := by + simp [boolMeasure] + +/-- The restriction of `boolMeasure a b` to `{true}ᶜ` is `a • dirac false`. -/ +lemma restrict_boolMeasure_compl_true (a b : ℝ≥0∞) : + (boolMeasure a b).restrict {true}ᶜ = a • dirac false := by + simp [boolMeasure] + /-- 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) : diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/Hahn.lean b/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/Hahn.lean new file mode 100644 index 0000000..2e43d64 --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/Hahn.lean @@ -0,0 +1,69 @@ +/- +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.MeasureTheory.Measure.Decomposition.Hahn + +/-! +# Hahn decompositions and suprema over measurable sets + +If `s` is a Hahn decomposition for the measures `μ` and `ν` (`μ ≤ ν` on `s` and `ν ≤ μ` on `sᶜ`) +and `ν sᶜ < ∞`, then the supremum of `μ E - ν E` over measurable sets `E` is attained at `sᶜ`. +The finiteness assumption is needed: for `x ≠ y`, `∅` is a Hahn decomposition for +`μ = δ_x + ∞ • δ_y` and `ν = ∞ • δ_y`, but `μ univ - ν univ = 0 < 1 = μ {x} - ν {x}`. + +## Main statements + +* `MeasureTheory.IsHahnDecomposition.measure_sub_le`: if `s` is a Hahn decomposition for `μ` and + `ν`, then `μ E - ν E ≤ μ sᶜ - ν sᶜ` for every measurable set `E`. +* `MeasureTheory.IsHahnDecomposition.iSup_measure_sub`: if `s` is a Hahn decomposition for `μ` and + `ν`, then `⨆ E, μ E - ν E = μ sᶜ - ν sᶜ`, where the supremum is over measurable sets. +-/ + +@[expose] public section + +open Set + +open scoped ENNReal + +namespace MeasureTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {s E : Set α} + +/-- If `s` is a Hahn decomposition for `μ` and `ν` (`μ ≤ ν` on `s` and `ν ≤ μ` on `sᶜ`) with +`ν sᶜ < ∞`, then `μ E - ν E ≤ μ sᶜ - ν sᶜ` for every measurable set `E`. -/ +lemma IsHahnDecomposition.measure_sub_le (h : IsHahnDecomposition μ ν s) (hE : MeasurableSet E) + (hν : ν sᶜ ≠ ∞ := by finiteness) : + μ E - ν E ≤ μ sᶜ - ν sᶜ := by + have h_le : μ (E ∩ s) ≤ ν (E ∩ s) := by + simpa [Measure.restrict_apply' h.measurableSet] using Measure.le_iff'.mp h.le_on E + have h_ge (t : Set α) : ν (sᶜ ∩ t) ≤ μ (sᶜ ∩ t) := by + simpa [Measure.restrict_apply' h.measurableSet.compl, inter_comm] + using Measure.le_iff'.mp h.ge_on_compl t + have hE_sdiff : E \ s = sᶜ ∩ E := by rw [sdiff_eq, inter_comm] + -- split `E` along `s`, then complete `sᶜ ∩ E` into `sᶜ` + calc μ E - ν E = μ (E ∩ s) + μ (sᶜ ∩ E) - (ν (E ∩ s) + ν (sᶜ ∩ E)) := by + rw [← hE_sdiff, measure_inter_add_sdiff _ h.measurableSet, + measure_inter_add_sdiff _ h.measurableSet] + _ ≤ ν (E ∩ s) + μ (sᶜ ∩ E) - (ν (E ∩ s) + ν (sᶜ ∩ E)) := by gcongr + _ ≤ μ (sᶜ ∩ E) - ν (sᶜ ∩ E) := add_tsub_add_le_tsub_left + _ ≤ μ (sᶜ ∩ E) - ν (sᶜ ∩ E) + (μ (sᶜ \ E) - ν (sᶜ \ E)) := le_self_add + _ = μ (sᶜ ∩ E) + μ (sᶜ \ E) - (ν (sᶜ ∩ E) + ν (sᶜ \ E)) := + AddLECancellable.tsub_add_tsub_comm + (ENNReal.cancel_of_ne (ne_top_of_le_ne_top hν (measure_mono inter_subset_left))) + (ENNReal.cancel_of_ne (ne_top_of_le_ne_top hν (measure_mono sdiff_subset))) (h_ge E) + (by simpa [sdiff_eq] using h_ge Eᶜ) + _ = μ sᶜ - ν sᶜ := by rw [measure_inter_add_sdiff _ hE, measure_inter_add_sdiff _ hE] + +/-- If `s` is a Hahn decomposition for `μ` and `ν` (`μ ≤ ν` on `s` and `ν ≤ μ` on `sᶜ`) with +`ν sᶜ < ∞`, then the supremum of `μ E - ν E` over measurable sets `E` is attained at `sᶜ`. -/ +lemma IsHahnDecomposition.iSup_measure_sub (h : IsHahnDecomposition μ ν s) + (hν : ν sᶜ ≠ ∞ := by finiteness) : + ⨆ E, ⨆ (_ : MeasurableSet E), μ E - ν E = μ sᶜ - ν sᶜ := + le_antisymm (iSup₂_le fun _ hE ↦ h.measure_sub_le hE hν) + (le_iSup₂_of_le sᶜ h.measurableSet.compl le_rfl) + +end MeasureTheory diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/IntegralRPowRNDeriv.lean b/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/IntegralRPowRNDeriv.lean index c9f4671..8894007 100644 --- a/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/IntegralRPowRNDeriv.lean +++ b/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/IntegralRPowRNDeriv.lean @@ -5,11 +5,13 @@ 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 Mathlib.MeasureTheory.Measure.Decomposition.IntegralRNDeriv +public import Statlib.ForMathlib.Analysis.SpecialFunctions.Pow.Deriv +public import Statlib.ForMathlib.Analysis.SpecialFunctions.Pow.Real +public import Statlib.ForMathlib.MeasureTheory.Integral.MeanInequalities +public import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.RNDerivProd public import Statlib.ForMathlib.MeasureTheory.Measure.LogLikelihoodRatio /-! @@ -23,12 +25,26 @@ divergences. * `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_eq_toReal_lintegral`: for `0 ≤ a`, `∫ (∂μ/∂ν) ^ a ∂ν` is the `toReal` of + `∫⁻ (∂μ/∂ν) ^ a ∂ν`, and `integrable_rpow_rnDeriv_iff_lintegral_ne_top`: `(∂μ/∂ν) ^ a` is + `ν`-integrable iff `∫⁻ (∂μ/∂ν) ^ a ∂ν ≠ ∞`. +* `integrable_rpow_rnDeriv_of_le`: for a finite measure `ν` and `0 ≤ a ≤ b`, integrability of + `(∂μ/∂ν) ^ b` implies that of `(∂μ/∂ν) ^ a`; `integrable_rpow_rnDeriv_of_lt_one`: for finite + measures and `a ∈ [0, 1)`, `(∂μ/∂ν) ^ a` is `ν`-integrable. +* `integrable_llr_of_integrable_rpow_rnDeriv`: if `(∂μ/∂ν) ^ b` is `ν`-integrable for some `b > 1`, + then the log-likelihood ratio is `μ`-integrable. +* `lintegral_rpow_rnDeriv_eq_zero_iff_mutuallySingular` (for `0 < a`), + `integral_rpow_rnDeriv_eq_zero_iff_mutuallySingular` (for `a ≠ 0`): the integral vanishes iff `μ ⟂ₘ ν`. +* `integral_rpow_rnDeriv_le_rpow_mul_rpow`: log-convexity of `a ↦ ∫ (∂μ/∂ν) ^ a ∂ν`. +* `setIntegral_rpow_rnDeriv_le_rpow_mul_rpow_of_le_one`: **Hölder's inequality** + `∫_E (∂μ/∂ν) ^ a ∂ν ≤ μ(E) ^ a * ν(E) ^ (1 - a)` for `a ∈ [0, 1]`, finite measures and any set + `E`; `integral_rpow_rnDeriv_le_rpow_mul_rpow_of_le_one` is the case `E = univ`. +* `continuousOn_integral_rpow_rnDeriv`: if `(∂μ/∂ν) ^ c` is integrable, then + `a ↦ ∫ (∂μ/∂ν) ^ a ∂ν` is continuous on `(0, c]`. * `integral_rpow_rnDeriv_smul_left`, `integral_rpow_rnDeriv_smul_right`: behaviour under scaling of the measures. +* `integral_rpow_rnDeriv_prod`: the integral for product measures is the product of the integrals. * `tendsto_mul_log_integral_rpow_rnDeriv`: for probability measures with `μ ≪ ν` and `llr μ ν` integrable, `(a - 1)⁻¹ * log (∫ (∂μ/∂ν) ^ a ∂ν)` tends to `∫ llr μ ν ∂μ` as `a → 1⁻`. @@ -44,7 +60,9 @@ open scoped ENNReal NNReal Topology namespace MeasureTheory -variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {a : ℝ} +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {a b : ℝ} + +/-! ### Symmetry -/ /-- Symmetry of the Hellinger integral: `∫ (∂μ/∂ν)^a ∂ν = ∫ (∂ν/∂μ)^(1 - a) ∂μ`. -/ lemma integral_rpow_rnDeriv_symm (ha_pos : 0 < a) (ha : a ≠ 1) [SigmaFinite μ] [SigmaFinite ν] : @@ -99,6 +117,16 @@ lemma integral_rpow_rnDeriv_symm (ha_pos : 0 < a) (ha : a ≠ 1) [SigmaFinite μ (Measure.AbsolutelyContinuous.rfl.add_right ν)] with x hx simp only [hx, Pi.div_apply, p, q] +/-- For `μ ≪ ν`, `∫ (∂μ/∂ν) ^ a ∂ν = ∫ (∂μ/∂ν) ^ (a - 1) ∂μ`. -/ +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] + /-- 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 ν] @@ -122,6 +150,28 @@ lemma lintegral_rpow_rnDeriv_add_mul_rpow_rnDeriv_add [SigmaFinite μ] [SigmaFin filter_upwards [Measure.rnDeriv_eq_div hμ hν] with x hx rw [← hx] +/-! ### Integrability -/ + +/-- For `0 ≤ a`, the Hellinger integral `∫ (∂μ/∂ν) ^ a ∂ν` is the `toReal` of the Lebesgue integral +`∫⁻ (∂μ/∂ν) ^ a ∂ν` (both sides are `0` when the latter is infinite). -/ +lemma integral_rpow_rnDeriv_eq_toReal_lintegral [SigmaFinite μ] (ha : 0 ≤ a) : + ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν = (∫⁻ x, (μ.rnDeriv ν x) ^ a ∂ν).toReal := by + rw [← integral_toReal (by fun_prop)] + · simp_rw [ENNReal.toReal_rpow] + · filter_upwards [μ.rnDeriv_lt_top ν] with x hx + exact (ENNReal.rpow_ne_top_of_nonneg ha hx.ne).lt_top + +/-- For `0 ≤ a`, the function `(∂μ/∂ν) ^ a` is integrable if and only if its integral is +finite. -/ +lemma integrable_rpow_rnDeriv_iff_lintegral_ne_top [SigmaFinite μ] (ha : 0 ≤ a) : + Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ a) ν ↔ ∫⁻ x, (μ.rnDeriv ν x) ^ a ∂ν ≠ ∞ := by + simp_rw [ENNReal.toReal_rpow] + refine integrable_toReal_iff (by fun_prop) ?_ + filter_upwards [μ.rnDeriv_lt_top ν] with x hx + exact ENNReal.rpow_ne_top_of_nonneg ha hx.ne + +/-- For `μ ≪ ν` and `0 < a`, `(∂μ/∂ν) ^ a` is `μ`-integrable if and only if `(∂μ/∂ν) ^ (1 + a)` is +`ν`-integrable. -/ 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 @@ -135,32 +185,57 @@ lemma integrable_rpow_rnDeriv_iff [SigmaFinite ν] [SigmaFinite μ] (hμν : μ linarith · rw [rpow_add (ENNReal.toReal_pos h_zero hx), rpow_one] +/-- For a finite measure `ν` and `0 ≤ a ≤ b`, if `(∂μ/∂ν) ^ b` is `ν`-integrable, then so is +`(∂μ/∂ν) ^ a`. -/ +lemma integrable_rpow_rnDeriv_of_le [IsFiniteMeasure ν] (ha : 0 ≤ a) (hab : a ≤ b) + (h_int : Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ b) ν) : + Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ a) ν := by + refine ((integrable_const 1).add h_int).mono' + ((μ.measurable_rnDeriv ν).ennreal_toReal.pow_const a).aestronglyMeasurable + (.of_forall fun x ↦ ?_) + rw [Real.norm_of_nonneg (by positivity)] + exact Real.rpow_le_one_add_rpow ENNReal.toReal_nonneg ha hab + +/-- For finite measures and `a ∈ [0, 1)`, `(∂μ/∂ν) ^ a` is `ν`-integrable. -/ 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 = ⊤) + Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ a) ν := + integrable_rpow_rnDeriv_of_le ha_nonneg ha.le + (by simpa using Measure.integrable_toReal_rnDeriv (μ := μ) (ν := ν)) + +/-- If `(∂μ/∂ν) ^ b` is integrable for some `b > 1`, then the log-likelihood ratio is +`μ`-integrable. -/ +lemma integrable_llr_of_integrable_rpow_rnDeriv [SigmaFinite μ] [IsFiniteMeasure ν] + (hb : 1 < b) (h_ac : μ ≪ ν) (h_int : Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ b) ν) : + Integrable (llr μ ν) μ := by + rw [← integrable_rnDeriv_mul_log_iff h_ac] + refine Integrable.mono' ((integrable_const 1).add (h_int.div_const (b - 1))) ?_ ?_ + · exact ((μ.measurable_rnDeriv ν).ennreal_toReal.mul + (μ.measurable_rnDeriv ν).ennreal_toReal.log).aestronglyMeasurable + · filter_upwards with x + rw [Real.norm_eq_abs] + exact Real.abs_mul_log_le_one_add_rpow ENNReal.toReal_nonneg hb + +/-! ### Positivity -/ + +/-- The Hellinger integral `∫ (∂μ/∂ν) ^ a ∂ν` is nonnegative. -/ +lemma integral_rpow_rnDeriv_nonneg : 0 ≤ ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν := + integral_nonneg fun _ ↦ by positivity + +/-- For `0 < a`, the Hellinger integral `∫⁻ (∂μ/∂ν) ^ a ∂ν` vanishes if and only if `μ` and `ν` +are mutually singular. -/ +lemma lintegral_rpow_rnDeriv_eq_zero_iff_mutuallySingular [μ.HaveLebesgueDecomposition ν] + (ha : 0 < a) : + ∫⁻ x, (μ.rnDeriv ν x) ^ a ∂ν = 0 ↔ μ ⟂ₘ ν := by + rw [lintegral_eq_zero_iff (by fun_prop), ← Measure.rnDeriv_eq_zero] + refine eventually_congr (Eventually.of_forall fun x ↦ ?_) + simp [ENNReal.rpow_eq_zero_iff, ha, not_lt.mpr ha.le] + +/-- For a nonnegative function `f` vanishing exactly at `0` and `∞`, `∫ f (∂μ/∂ν) ∂ν` vanishes if +and only if `μ` and `ν` are mutually singular. -/ +lemma integral_fun_rnDeriv_eq_zero_iff_mutuallySingular [SigmaFinite μ] + [μ.HaveLebesgueDecomposition ν] {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] @@ -168,8 +243,11 @@ lemma integral_fun_rnDeriv_eq_zero_iff_mutuallySingular [SigmaFinite μ] [SigmaF 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) ν) : +/-- For `a ≠ 0` and `(∂μ/∂ν) ^ a` integrable, the Hellinger integral `∫ (∂μ/∂ν) ^ a ∂ν` vanishes if +and only if `μ` and `ν` are mutually singular. -/ +lemma integral_rpow_rnDeriv_eq_zero_iff_mutuallySingular [SigmaFinite μ] + [μ.HaveLebesgueDecomposition ν] (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 @@ -177,13 +255,107 @@ lemma integral_rpow_rnDeriv_eq_zero_iff_mutuallySingular [SigmaFinite μ] [Sigma 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) ν) : +/-- For `a ≠ 0` and `(∂μ/∂ν) ^ a` integrable, the Hellinger integral `∫ (∂μ/∂ν) ^ a ∂ν` is positive +if and only if `μ` and `ν` are not mutually singular. -/ +lemma integral_rpow_rnDeriv_pos_iff_not_mutuallySingular [SigmaFinite μ] + [μ.HaveLebesgueDecomposition ν] (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⟩ +/-! ### Log-convexity and continuity in the exponent -/ + +/-- Real version of the log-convexity of `a ↦ ∫ (∂μ/∂ν) ^ a ∂ν`. -/ +lemma integral_rpow_rnDeriv_le_rpow_mul_rpow [SigmaFinite μ] {c θ : ℝ} + (ha : 0 ≤ a) (hb : 0 ≤ b) (hθ0 : 0 ≤ θ) (hθ1 : θ ≤ 1) (hc : c = θ * a + (1 - θ) * b) + (ha_int : Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ a) ν) + (hb_int : Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ b) ν) : + ∫ x, (μ.rnDeriv ν x).toReal ^ c ∂ν + ≤ (∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν) ^ θ + * (∫ x, (μ.rnDeriv ν x).toReal ^ b ∂ν) ^ (1 - θ) := by + have hc_nonneg : 0 ≤ c := hc ▸ add_nonneg (mul_nonneg hθ0 ha) (mul_nonneg (by linarith) hb) + have ha_top := (integrable_rpow_rnDeriv_iff_lintegral_ne_top ha).mp ha_int + have hb_top := (integrable_rpow_rnDeriv_iff_lintegral_ne_top hb).mp hb_int + rw [integral_rpow_rnDeriv_eq_toReal_lintegral hc_nonneg, + integral_rpow_rnDeriv_eq_toReal_lintegral ha, integral_rpow_rnDeriv_eq_toReal_lintegral hb, + ENNReal.toReal_rpow, ENNReal.toReal_rpow, ← ENNReal.toReal_mul] + have h := ENNReal.lintegral_rpow_le_rpow_mul_rpow (μ := ν) + (μ.measurable_rnDeriv ν).aemeasurable ha hb hθ0 hθ1 + rw [← hc] at h + refine ENNReal.toReal_mono ?_ h + exact ENNReal.mul_ne_top (ENNReal.rpow_ne_top_of_nonneg hθ0 ha_top) + (ENNReal.rpow_ne_top_of_nonneg (by linarith) hb_top) + +/-- If `(∂μ/∂ν) ^ c` is integrable, then `a ↦ ∫ (∂μ/∂ν) ^ a ∂ν` is continuous on `(0, c]`. -/ +lemma continuousOn_integral_rpow_rnDeriv [IsFiniteMeasure ν] {c : ℝ} + (h_int : Integrable (fun x ↦ (μ.rnDeriv ν x).toReal ^ c) ν) : + ContinuousOn (fun a ↦ ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν) (Ioc 0 c) := by + refine continuousOn_of_dominated (bound := fun x ↦ 1 + (μ.rnDeriv ν x).toReal ^ c) ?_ ?_ ?_ ?_ + · exact fun a _ ↦ ((μ.measurable_rnDeriv ν).ennreal_toReal.pow_const _).aestronglyMeasurable + · intro a ha + refine Eventually.of_forall fun x ↦ ?_ + rw [Real.norm_eq_abs, abs_of_nonneg (by positivity)] + exact Real.rpow_le_one_add_rpow ENNReal.toReal_nonneg ha.1.le ha.2 + · exact (integrable_const _).add h_int + · exact Eventually.of_forall fun x a ha ↦ + (Real.continuousAt_const_rpow' ha.1.ne').continuousWithinAt + +/-! ### Hölder's inequality -/ + +/-- **Hölder's inequality** for the Radon-Nikodym derivative: for `a ∈ [0, 1]`, finite measures +and any set `E`, `∫_E (∂μ/∂ν) ^ a ∂ν ≤ μ(E) ^ a * ν(E) ^ (1 - a)`. -/ +lemma setIntegral_rpow_rnDeriv_le_rpow_mul_rpow_of_le_one [IsFiniteMeasure μ] [IsFiniteMeasure ν] + (ha0 : 0 ≤ a) (ha1 : a ≤ 1) (E : Set α) : + ∫ x in E, (μ.rnDeriv ν x).toReal ^ a ∂ν ≤ μ.real E ^ a * ν.real E ^ (1 - a) := by + have h_le : ∫⁻ x in E, μ.rnDeriv ν x ^ a ∂ν ≤ μ E ^ a * ν E ^ (1 - a) := + calc ∫⁻ x in E, μ.rnDeriv ν x ^ a ∂ν = ∫⁻ x in E, μ.rnDeriv ν x ^ a * 1 ^ (1 - a) ∂ν := by simp + _ ≤ (∫⁻ x in E, μ.rnDeriv ν x ∂ν) ^ a * (∫⁻ _ in E, 1 ∂ν) ^ (1 - a) := + ENNReal.lintegral_mul_norm_pow_le (μ.measurable_rnDeriv ν).aemeasurable aemeasurable_const + ha0 (sub_nonneg.mpr ha1) (by ring) + _ ≤ μ E ^ a * ν E ^ (1 - a) := by + rw [setLIntegral_one] + gcongr + exact Measure.setLIntegral_rnDeriv_le E + have h_eq : + ∫ x in E, (μ.rnDeriv ν x).toReal ^ a ∂ν = (∫⁻ x in E, μ.rnDeriv ν x ^ a ∂ν).toReal := by + simp_rw [ENNReal.toReal_rpow] + refine integral_toReal ((μ.measurable_rnDeriv ν).pow_const a).aemeasurable ?_ + filter_upwards [ae_restrict_of_ae (μ.rnDeriv_lt_top ν)] with x hx + exact ENNReal.rpow_lt_top_of_nonneg ha0 hx.ne + rw [h_eq, measureReal_def, measureReal_def, ENNReal.toReal_rpow, ENNReal.toReal_rpow, + ← ENNReal.toReal_mul] + exact ENNReal.toReal_mono (by finiteness) h_le + +/-- **Hölder's inequality** for the Radon-Nikodym derivative: for `a ∈ [0, 1]` and finite +measures, `∫ (∂μ/∂ν) ^ a ∂ν ≤ μ(α) ^ a * ν(α) ^ (1 - a)`. -/ +lemma integral_rpow_rnDeriv_le_rpow_mul_rpow_of_le_one (ha0 : 0 ≤ a) (ha1 : a ≤ 1) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] : + ∫ x, (μ.rnDeriv ν x).toReal ^ a ∂ν ≤ (μ .univ).toReal ^ a * (ν .univ).toReal ^ (1 - a) := by + simpa [measureReal_def] using setIntegral_rpow_rnDeriv_le_rpow_mul_rpow_of_le_one ha0 ha1 .univ + +/-- For `a ∈ (0, 1)` and finite measures that are not mutually singular, +`log (∫ (∂μ/∂ν) ^ a ∂ν) ≤ a * log μ(α) + (1 - a) * log ν(α)`. -/ +lemma log_integral_rpow_rnDeriv_le_of_lt_one (ha_pos : 0 < a) (ha_lt : a < 1) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] (h_ms : ¬ μ ⟂ₘ ν) : + Real.log (∫ x, (μ.rnDeriv ν 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_le_one ha_pos.le ha_lt.le) + 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 + +/-! ### Scaling and products -/ + +/-- Scaling `μ` by `c` multiplies the Hellinger integral `∫ (∂μ/∂ν) ^ a ∂ν` by `c ^ a`. -/ 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] @@ -192,6 +364,7 @@ lemma integral_rpow_rnDeriv_smul_left [SigmaFinite μ] [SigmaFinite ν] (c : ℝ rw [← mul_rpow NNReal.zero_le_coe ENNReal.toReal_nonneg, hx, Pi.smul_apply, ENNReal.toReal_smul] rfl +/-- Scaling `ν` by `c` multiplies the Hellinger integral `∫ (∂μ/∂ν) ^ a ∂ν` by `c ^ (1 - a)`. -/ lemma integral_rpow_rnDeriv_smul_right [SigmaFinite μ] [SigmaFinite ν] (c : ℝ≥0) (ha : c = 0 → a ≠ 1) : ∫ x, (μ.rnDeriv (c • ν) x).toReal ^ a ∂(c • ν) @@ -208,15 +381,7 @@ lemma integral_rpow_rnDeriv_smul_right [SigmaFinite μ] [SigmaFinite ν] (c : 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] - +/-- Version of `integral_rpow_rnDeriv_smul_left` for a scalar `c : ℝ≥0∞`. -/ 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 @@ -224,6 +389,7 @@ lemma integral_rpow_rnDeriv_smul_left' [SigmaFinite μ] [SigmaFinite ν] {c : rw [← ENNReal.smul_def, ENNReal.coe_toReal] exact integral_rpow_rnDeriv_smul_left c +/-- Version of `integral_rpow_rnDeriv_smul_right` for a scalar `c : ℝ≥0∞`. -/ lemma integral_rpow_rnDeriv_smul_right' [SigmaFinite μ] [SigmaFinite ν] {c : ℝ≥0∞} (hc : c ≠ ∞) (ha : c = 0 → a ≠ 1) : ∫ x, (μ.rnDeriv (c • ν) x).toReal ^ a ∂(c • ν) @@ -248,86 +414,58 @@ lemma integral_rpow_rnDeriv_eq_mul_integral_rpow_rnDeriv_inv_smul (ha_ne : a ≠ 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 +/-- The Hellinger integral `∫ (∂μ/∂ν) ^ a ∂ν` of product measures is the product of the Hellinger +integrals. -/ +lemma integral_rpow_rnDeriv_prod {β : Type*} {mβ : MeasurableSpace β} (μ₁ ν₁ : Measure α) + (μ₂ ν₂ : Measure β) + [SigmaFinite μ₁] [SigmaFinite ν₁] [SigmaFinite μ₂] [SigmaFinite ν₂] : + ∫ p, ((μ₁.prod μ₂).rnDeriv (ν₁.prod ν₂) p).toReal ^ a ∂(ν₁.prod ν₂) + = (∫ x, (μ₁.rnDeriv ν₁ x).toReal ^ a ∂ν₁) * ∫ y, (μ₂.rnDeriv ν₂ y).toReal ^ a ∂ν₂ := by + rw [← integral_prod_mul] + refine integral_congr_ae ?_ + filter_upwards [Measure.rnDeriv_prod μ₁ ν₁ μ₂ ν₂] with p hp + rw [hp, ENNReal.toReal_mul, mul_rpow ENNReal.toReal_nonneg ENNReal.toReal_nonneg] + +/-! ### Behaviour as `a → 1⁻` -/ +/-- For `μ ≪ ν` with `llr μ ν` integrable, the slope +`(a - 1)⁻¹ * (∫ (∂μ/∂ν) ^ a ∂ν - μ univ)` tends to `∫ llr μ ν ∂μ` as `a → 1⁻`: this is the left +derivative at `1` of `a ↦ ∫ (∂μ/∂ν) ^ a ∂ν`. -/ 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] + rw [← integral_rnDeriv_mul_log hμν] have h_ev : ∀ᶠ a in 𝓝[<] (1:ℝ), a ∈ Set.Ico 2⁻¹ 1 := Ico_mem_nhdsLT (by norm_num) + -- the slope of the integral is the integral of the slopes `((∂μ/∂ν) ^ a - ∂μ/∂ν) / (a - 1)` 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 + fun a ↦ ∫ x, ((μ.rnDeriv ν x).toReal ^ a - (μ.rnDeriv ν x).toReal) / (a - 1) ∂ν := 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] + rw [integral_div, 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, + div_eq_inv_mul] refine Tendsto.congr' h_eq.symm ?_ + -- for `a ∈ [1/2, 1)`, the slopes lie between `-1/2` and `∂μ/∂ν * log (∂μ/∂ν)` refine tendsto_integral_filter_of_dominated_convergence - (fun x ↦ 2 + (μ.rnDeriv ν x).toReal * |log (μ.rnDeriv ν x).toReal|) ?_ ?_ ?_ ?_ + (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] + refine Eventually.of_forall fun x ↦ ?_ + have h1 := Real.neg_inv_two_le_rpow_sub_self_div_sub_one (t := (μ.rnDeriv ν x).toReal) + ENNReal.toReal_nonneg ha.1 ha.2.ne + have h2 := Real.rpow_sub_self_div_sub_one_le_mul_log (t := (μ.rnDeriv ν x).toReal) + ENNReal.toReal_nonneg ha.2 + rw [Real.norm_eq_abs, abs_le] + constructor <;> linarith [abs_nonneg ((μ.rnDeriv ν x).toReal * log (μ.rnDeriv ν x).toReal), + le_abs_self ((μ.rnDeriv ν x).toReal * log (μ.rnDeriv ν x).toReal)] + · exact (integrable_const _).add ((integrable_rnDeriv_mul_log_iff hμν).mpr h_int).abs + · exact Eventually.of_forall fun x ↦ (Real.tendsto_rpow_sub_self_div_sub_one _).mono_left + (nhdsWithin_mono _ fun y hy ↦ ne_of_lt (Set.mem_Iio.mp hy)) +/-- For finite measures with `μ ≠ 0`, `μ ≪ ν` and `llr μ ν` integrable, the slope at `1` of +`a ↦ log (∫ (∂μ/∂ν) ^ a ∂ν) - a * log (μ univ) - (1 - a) * log (ν univ)` tends to +`(μ univ)⁻¹ * ∫ llr μ ν ∂μ - log (μ univ / ν univ)` as `a → 1⁻`. -/ 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 ∂ν) @@ -364,6 +502,8 @@ lemma tendsto_mul_log_integral_rpow_rnDeriv' [IsFiniteMeasure μ] [IsFiniteMeasu field_simp ring +/-- For probability measures with `μ ≪ ν` and `llr μ ν` integrable, +`(a - 1)⁻¹ * log (∫ (∂μ/∂ν) ^ a ∂ν)` tends to `∫ llr μ ν ∂μ` as `a → 1⁻`. -/ 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) diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/RNDerivProd.lean b/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/RNDerivProd.lean new file mode 100644 index 0000000..45bf427 --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/RNDerivProd.lean @@ -0,0 +1,177 @@ +/- +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.MeasureTheory.Measure.Decomposition.RadonNikodym +public import Statlib.ForMathlib.MeasureTheory.Constructions.Pi +public import Statlib.ForMathlib.MeasureTheory.Integral.Pi + +/-! +# Densities and Radon-Nikodym derivatives of products of measures + +For σ-finite measures `μ i` and `ν i` indexed by a finite type, the Radon-Nikodym derivative of the +product measure `Measure.pi μ` with respect to `Measure.pi ν` is `x ↦ ∏ i, ∂(μ i)/∂(ν i) (x i)`, +and similarly for binary products. + +## Main statements + +* `MeasureTheory.Measure.rnDeriv_prod`: `∂(μ₁.prod μ₂)/∂(ν₁.prod ν₂) =ᵐ ∂μ₁/∂ν₁ p.1 * ∂μ₂/∂ν₂ p.2`. +* `MeasureTheory.Measure.pi_withDensity`: the product of the measures `(ν i).withDensity (f i)` is + `(Measure.pi ν).withDensity (fun x ↦ ∏ i, f i (x i))`. +* `MeasureTheory.Measure.pi_eq_withDensity_prod_rnDeriv`: if `μ i ≪ ν i` for all `i`, then + `Measure.pi μ = (Measure.pi ν).withDensity (fun x ↦ ∏ i, ∂(μ i)/∂(ν i) (x i))`. +* `MeasureTheory.Measure.rnDeriv_pi`: `∂(Measure.pi μ)/∂(Measure.pi ν) =ᵐ ∏ i, ∂(μ i)/∂(ν i) (x i)`. +* `MeasureTheory.Measure.AbsolutelyContinuous.pi`: if `μ i ≪ ν i` for all `i`, then + `Measure.pi μ ≪ Measure.pi ν`. +* `MeasureTheory.Measure.not_mutuallySingular_pi`: products of σ-finite measures which are not + mutually singular are not mutually singular. +-/ + +@[expose] public section + +open scoped ENNReal + +namespace MeasureTheory + +namespace Measure + +section Prod + +variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} + +/-- The Radon-Nikodym derivative of a product of σ-finite measures is the product of the +Radon-Nikodym derivatives. -/ +lemma rnDeriv_prod (μ₁ ν₁ : Measure α) (μ₂ ν₂ : Measure β) [SigmaFinite μ₁] [SigmaFinite ν₁] + [SigmaFinite μ₂] [SigmaFinite ν₂] : + (μ₁.prod μ₂).rnDeriv (ν₁.prod ν₂) =ᵐ[ν₁.prod ν₂] + fun p ↦ μ₁.rnDeriv ν₁ p.1 * μ₂.rnDeriv ν₂ p.2 := by + -- both products have product densities with respect to `ξ₁.prod ξ₂`, where `ξᵢ = μᵢ + νᵢ` + set ξ₁ := μ₁ + ν₁ + set ξ₂ := μ₂ + ν₂ + have h_rn {ρ₁ : Measure α} {ρ₂ : Measure β} [SigmaFinite ρ₁] [SigmaFinite ρ₂] (h₁ : ρ₁ ≪ ξ₁) + (h₂ : ρ₂ ≪ ξ₂) : (ρ₁.prod ρ₂).rnDeriv (ξ₁.prod ξ₂) + =ᵐ[ξ₁.prod ξ₂] fun p ↦ ρ₁.rnDeriv ξ₁ p.1 * ρ₂.rnDeriv ξ₂ p.2 := by + conv_lhs => rw [← withDensity_rnDeriv_eq _ _ h₁, ← withDensity_rnDeriv_eq _ _ h₂, + prod_withDensity (measurable_rnDeriv _ _) (measurable_rnDeriv _ _)] + exact rnDeriv_withDensity _ (by fun_prop) + have hμ₁ : μ₁ ≪ ξ₁ := AbsolutelyContinuous.rfl.add_right _ + have hν₁ : ν₁ ≪ ξ₁ := AbsolutelyContinuous.rfl.add_right' _ + have hμ₂ : μ₂ ≪ ξ₂ := AbsolutelyContinuous.rfl.add_right _ + have hν₂ : ν₂ ≪ ξ₂ := AbsolutelyContinuous.rfl.add_right' _ + have hν := hν₁.prod hν₂ + -- coordinatewise, `∂μᵢ/∂νᵢ = ∂μᵢ/∂ξᵢ / ∂νᵢ/∂ξᵢ` + filter_upwards [rnDeriv_eq_div (hμ₁.prod hμ₂) hν, hν (h_rn hμ₁ hμ₂), hν (h_rn hν₁ hν₂), + quasiMeasurePreserving_fst.ae (rnDeriv_eq_div hμ₁ hν₁), + quasiMeasurePreserving_snd.ae (rnDeriv_eq_div hμ₂ hν₂), + quasiMeasurePreserving_fst.ae (hν₁.ae_le (rnDeriv_ne_top ν₁ ξ₁)), + quasiMeasurePreserving_snd.ae (hν₂.ae_le (rnDeriv_ne_top ν₂ ξ₂))] with p h1 h2 h3 h4 h5 h6 h7 + rw [h1, h2, h3, h4, h5, ENNReal.mul_div_mul_comm (.inr h7) (.inl h6)] + +end Prod + +section Pi + +variable {ι : Type*} [Fintype ι] {X : ι → Type*} {mX : ∀ i, MeasurableSpace (X i)} + {μ ν : (i : ι) → Measure (X i)} + +/-- The product of the measures `(ν i).withDensity (f i)` is the measure with density +`x ↦ ∏ i, f i (x i)` with respect to `Measure.pi ν`. -/ +lemma pi_withDensity [∀ i, SigmaFinite (ν i)] {f : (i : ι) → X i → ℝ≥0∞} + [∀ i, SigmaFinite ((ν i).withDensity (f i))] (hf : ∀ i, AEMeasurable (f i) (ν i)) : + Measure.pi (fun i ↦ (ν i).withDensity (f i)) + = (Measure.pi ν).withDensity (fun x ↦ ∏ i, f i (x i)) := by + refine Measure.pi_eq fun s hs ↦ ?_ + rw [withDensity_apply _ (MeasurableSet.univ_pi hs), ← lintegral_indicator (.univ_pi hs)] + have h_ind : (Set.univ.pi s).indicator (fun x ↦ ∏ i, f i (x i)) + = fun x ↦ ∏ i, (s i).indicator (f i) (x i) := by + ext x + by_cases hx : x ∈ Set.univ.pi s + · rw [Set.indicator_of_mem hx] + exact Finset.prod_congr rfl fun i _ ↦ (Set.indicator_of_mem (hx i (Set.mem_univ i)) _).symm + · rw [Set.indicator_of_notMem hx] + simp only [Set.mem_pi, Set.mem_univ, true_implies, not_forall] at hx + obtain ⟨i, hi⟩ := hx + exact (Finset.prod_eq_zero (Finset.mem_univ i) (Set.indicator_of_notMem hi _)).symm + rw [h_ind, lintegral_fintype_prod_eq_prod fun i ↦ (hf i).indicator (hs i)] + exact Finset.prod_congr rfl fun i _ ↦ by + rw [lintegral_indicator (hs i), withDensity_apply _ (hs i)] + +/-- If `μ i ≪ ν i` for all `i`, the product measure `Measure.pi μ` has density +`x ↦ ∏ i, ∂(μ i)/∂(ν i) (x i)` with respect to `Measure.pi ν`. -/ +lemma pi_eq_withDensity_prod_rnDeriv [∀ i, SigmaFinite (μ i)] [∀ i, SigmaFinite (ν i)] + (hμν : ∀ i, μ i ≪ ν i) : + Measure.pi μ = (Measure.pi ν).withDensity (fun x ↦ ∏ i, (μ i).rnDeriv (ν i) (x i)) := by + have h_eq : μ = fun i ↦ (ν i).withDensity ((μ i).rnDeriv (ν i)) := + funext fun i ↦ (withDensity_rnDeriv_eq _ _ (hμν i)).symm + have (i : ι) : SigmaFinite ((ν i).withDensity ((μ i).rnDeriv (ν i))) := by + rw [withDensity_rnDeriv_eq _ _ (hμν i)] + infer_instance + conv_lhs => rw [h_eq] + exact pi_withDensity fun i ↦ (measurable_rnDeriv _ _).aemeasurable + +/-- The Radon-Nikodym derivative of `Measure.pi μ` with respect to `Measure.pi ν` is +`x ↦ ∏ i, ∂(μ i)/∂(ν i) (x i)`. -/ +lemma rnDeriv_pi [∀ i, SigmaFinite (μ i)] [∀ i, SigmaFinite (ν i)] : + (Measure.pi μ).rnDeriv (Measure.pi ν) + =ᵐ[Measure.pi ν] fun x ↦ ∏ i, (μ i).rnDeriv (ν i) (x i) := by + -- both `Measure.pi μ` and `Measure.pi ν` have product densities with respect to + -- `Measure.pi ξ`, where `ξ i = μ i + ν i` + set ξ : (i : ι) → Measure (X i) := fun i ↦ μ i + ν i + have hμξ (i : ι) : μ i ≪ ξ i := AbsolutelyContinuous.rfl.add_right _ + have hνξ (i : ι) : ν i ≪ ξ i := AbsolutelyContinuous.rfl.add_right' _ + have h_meas (κ : (i : ι) → Measure (X i)) : + Measurable fun x : (i : ι) → X i ↦ ∏ i, (κ i).rnDeriv (ξ i) (x i) := + Finset.measurable_prod _ fun i _ ↦ (measurable_rnDeriv _ _).comp (measurable_pi_apply i) + have hμ := pi_eq_withDensity_prod_rnDeriv hμξ + have hν := pi_eq_withDensity_prod_rnDeriv hνξ + have h_acμ : Measure.pi μ ≪ Measure.pi ξ := hμ ▸ withDensity_absolutelyContinuous _ _ + have h_acν : Measure.pi ν ≪ Measure.pi ξ := hν ▸ withDensity_absolutelyContinuous _ _ + have h_rnμ : (Measure.pi μ).rnDeriv (Measure.pi ξ) + =ᵐ[Measure.pi ξ] fun x ↦ ∏ i, (μ i).rnDeriv (ξ i) (x i) := by + conv_lhs => rw [hμ] + exact rnDeriv_withDensity _ (h_meas μ) + have h_rnν : (Measure.pi ν).rnDeriv (Measure.pi ξ) + =ᵐ[Measure.pi ξ] fun x ↦ ∏ i, (ν i).rnDeriv (ξ i) (x i) := by + conv_lhs => rw [hν] + exact rnDeriv_withDensity _ (h_meas ν) + -- coordinatewise, `∂(μ i)/∂(ν i) = ∂(μ i)/∂(ξ i) / ∂(ν i)/∂(ξ i)` + have h_coord : ∀ᵐ x ∂(Measure.pi ν), ∀ i, (μ i).rnDeriv (ν i) (x i) + = (μ i).rnDeriv (ξ i) (x i) / (ν i).rnDeriv (ξ i) (x i) := + ae_all_iff.2 fun i ↦ tendsto_eval_ae_ae.eventually (rnDeriv_eq_div (hμξ i) (hνξ i)) + have h_top : ∀ᵐ x ∂(Measure.pi ν), ∀ i, (ν i).rnDeriv (ξ i) (x i) ≠ ∞ := + ae_all_iff.2 fun i ↦ tendsto_eval_ae_ae.eventually ((hνξ i).ae_le (rnDeriv_ne_top _ _)) + filter_upwards [rnDeriv_eq_div h_acμ h_acν, h_acν h_rnμ, h_acν h_rnν, h_coord, h_top] + with x h1 h2 h3 h4 h5 + rw [h1, h2, h3, Finset.prod_congr rfl fun i _ ↦ h4 i, + ENNReal.prod_div_distrib_of_ne_top fun i _ ↦ h5 i] + +/-- If `μ i ≪ ν i` for all `i`, then `Measure.pi μ ≪ Measure.pi ν`. -/ +lemma AbsolutelyContinuous.pi [∀ i, SigmaFinite (μ i)] [∀ i, SigmaFinite (ν i)] + (h : ∀ i, μ i ≪ ν i) : + Measure.pi μ ≪ Measure.pi ν := by + rw [pi_eq_withDensity_prod_rnDeriv h] + exact withDensity_absolutelyContinuous _ _ + +/-- Products of σ-finite measures which are not mutually singular are not mutually singular. -/ +lemma not_mutuallySingular_pi [∀ i, SigmaFinite (μ i)] [∀ i, SigmaFinite (ν i)] + (h : ∀ i, ¬ μ i ⟂ₘ ν i) : + ¬ Measure.pi μ ⟂ₘ Measure.pi ν := by + -- the absolutely continuous part `ρ i` of `μ i` with respect to `ν i` is nonzero, and the + -- product of the `ρ i` is absolutely continuous with respect to both products + set ρ : (i : ι) → Measure (X i) := fun i ↦ (ν i).withDensity ((μ i).rnDeriv (ν i)) + have (i : ι) : NeZero (ρ i) := ⟨by simpa [ρ] using h i⟩ + have hρμ : Measure.pi ρ ≪ Measure.pi μ := AbsolutelyContinuous.pi fun i ↦ + absolutelyContinuous_of_le (withDensity_rnDeriv_le (μ i) (ν i)) + have hρν : Measure.pi ρ ≪ Measure.pi ν := AbsolutelyContinuous.pi fun i ↦ + withDensity_absolutelyContinuous (ν i) ((μ i).rnDeriv (ν i)) + intro h_ms + exact NeZero.ne _ ((MutuallySingular.self_iff _).mp (h_ms.mono_ac hρμ hρν)) + +end Pi + +end Measure + +end MeasureTheory diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/RNDerivTrim.lean b/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/RNDerivTrim.lean new file mode 100644 index 0000000..63b9f3b --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/RNDerivTrim.lean @@ -0,0 +1,111 @@ +/- +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.MeasureTheory.Measure.Decomposition.RadonNikodym +public import Statlib.ForMathlib.MeasureTheory.Measure.Trim + +/-! +# Radon-Nikodym derivative of a restriction to the σ-algebra induced by a map + +For a measurable function `g : 𝓧 → 𝓨`, the restrictions of measures `μ` and `ν` to the σ-algebra +`m𝓨.comap g` are isomorphic to the pushforwards `μ.map g` and `ν.map g`. In particular, the +Radon-Nikodym derivative of the restrictions is `x ↦ ∂(μ.map g)/∂(ν.map g) (g x)`. + +None of these statements requires `μ ≪ ν` on the whole space: for infinite product measures for +example, `μ` and `ν` are typically mutually singular while their restrictions to the σ-algebras +generated by finitely many coordinates are not. + +## Main statements + +* `absolutelyContinuous_trim_comap_iff`: `μ.trim _ ≪ ν.trim _ ↔ μ.map g ≪ ν.map g`. +* `trim_comap_eq_withDensity`: if `μ.map g ≪ ν.map g`, the restriction of `μ` to `m𝓨.comap g` has + density `x ↦ ∂(μ.map g)/∂(ν.map g) (g x)` with respect to the restriction of `ν`. +* `rnDeriv_trim_comap_ae_eq`: `∂(μ.trim _)/∂(ν.trim _) =ᵐ[ν.trim _] ∂(μ.map g)/∂(ν.map g) ∘ g`. +* `rnDeriv_map_comp_ae_eq_rnDeriv_trim`: the same, `ν`-almost everywhere. + +See `MeasureTheory.rnDeriv_map` and `MeasureTheory.rnDeriv_trim` for the expressions of these +Radon-Nikodym derivatives as conditional expectations of `∂μ/∂ν`, when `μ ≪ ν`. +-/ + +@[expose] public section + +open scoped ENNReal + +namespace MeasureTheory + +variable {𝓧 𝓨 : Type*} {m𝓧 : MeasurableSpace 𝓧} {m𝓨 : MeasurableSpace 𝓨} {μ ν : Measure 𝓧} + {g : 𝓧 → 𝓨} + +/-- The restrictions of `μ` and `ν` to the σ-algebra `m𝓨.comap g` are absolutely continuous if and +only if the pushforwards `μ.map g` and `ν.map g` are. -/ +lemma absolutelyContinuous_trim_comap_iff (hg : Measurable g) : + μ.trim hg.comap_le ≪ ν.trim hg.comap_le ↔ μ.map g ≪ ν.map g := by + refine ⟨fun h ↦ ?_, fun h ↦ Measure.AbsolutelyContinuous.mk fun s hs hνs ↦ ?_⟩ + · rw [← map_trim_comap hg, ← map_trim_comap (μ := ν) hg] + exact h.map (comap_measurable g) + · obtain ⟨t, ht, rfl⟩ := hs + have hs : MeasurableSet[m𝓨.comap g] (g ⁻¹' t) := ⟨t, ht, rfl⟩ + rw [trim_measurableSet_eq hg.comap_le hs, ← Measure.map_apply hg ht] at hνs ⊢ + exact h hνs + +/-- If `μ.map g ≪ ν.map g`, the restriction of `μ` to the σ-algebra `m𝓨.comap g` has density +`x ↦ ∂(μ.map g)/∂(ν.map g) (g x)` with respect to the restriction of `ν`. -/ +lemma trim_comap_eq_withDensity [SFinite (ν.map g)] [(μ.map g).HaveLebesgueDecomposition (ν.map g)] + (hg : Measurable g) (h_ac : μ.map g ≪ ν.map g) : + μ.trim hg.comap_le + = (ν.trim hg.comap_le).withDensity fun x ↦ (μ.map g).rnDeriv (ν.map g) (g x) := by + have hf_meas : Measurable[m𝓨.comap g] fun x ↦ (μ.map g).rnDeriv (ν.map g) (g x) := + (Measure.measurable_rnDeriv _ _).comp (comap_measurable g) + refine @Measure.ext _ (m𝓨.comap g) _ _ fun s hs ↦ ?_ + obtain ⟨t, ht, rfl⟩ := hs + have hs : MeasurableSet[m𝓨.comap g] (g ⁻¹' t) := ⟨t, ht, rfl⟩ + rw [trim_measurableSet_eq hg.comap_le hs, withDensity_apply _ hs, + setLIntegral_trim hg.comap_le hf_meas hs, ← Measure.map_apply hg ht, + ← setLIntegral_map ht (Measure.measurable_rnDeriv _ _) hg, Measure.setLIntegral_rnDeriv h_ac] + +/-- The Radon-Nikodym derivative of the restrictions of `μ` and `ν` to the σ-algebra `m𝓨.comap g` +is `x ↦ ∂(μ.map g)/∂(ν.map g) (g x)`. -/ +lemma rnDeriv_trim_comap_ae_eq [SigmaFinite (μ.map g)] [SigmaFinite (ν.map g)] + (hg : Measurable g) : + (μ.trim hg.comap_le).rnDeriv (ν.trim hg.comap_le) + =ᵐ[ν.trim hg.comap_le] fun x ↦ (μ.map g).rnDeriv (ν.map g) (g x) := by + -- we compare both sides through their densities with respect to `ξ = μ + ν` + set ξ := μ + ν + have := sigmaFinite_trim_comap (μ := μ) hg + have := sigmaFinite_trim_comap (μ := ν) hg + have h_map : ξ.map g = μ.map g + ν.map g := Measure.map_add _ _ hg + have h_trim : ξ.trim hg.comap_le = μ.trim hg.comap_le + ν.trim hg.comap_le := trim_add _ + have hμξ : μ.map g ≪ ξ.map g := h_map ▸ Measure.AbsolutelyContinuous.rfl.add_right _ + have hνξ : ν.map g ≪ ξ.map g := h_map ▸ Measure.AbsolutelyContinuous.rfl.add_right' _ + have hξ_trim : ν.trim hg.comap_le ≪ ξ.trim hg.comap_le := + h_trim ▸ Measure.AbsolutelyContinuous.rfl.add_right' _ + have : SigmaFinite (ξ.map g) := h_map ▸ inferInstance + have : SigmaFinite (ξ.trim hg.comap_le) := h_trim ▸ inferInstance + have h_rn (κ : Measure 𝓧) [SigmaFinite (κ.map g)] (hκ : κ.map g ≪ ξ.map g) : + (κ.trim hg.comap_le).rnDeriv (ξ.trim hg.comap_le) + =ᵐ[ξ.trim hg.comap_le] fun x ↦ (κ.map g).rnDeriv (ξ.map g) (g x) := by + rw [trim_comap_eq_withDensity hg hκ] + exact Measure.rnDeriv_withDensity _ ((Measure.measurable_rnDeriv _ _).comp (comap_measurable g)) + have h_div : ∀ᵐ y ∂@Measure.map _ _ (m𝓨.comap g) _ g (ν.trim hg.comap_le), + (μ.map g).rnDeriv (ν.map g) y + = (μ.map g).rnDeriv (ξ.map g) y / (ν.map g).rnDeriv (ξ.map g) y := by + rw [map_trim_comap hg] + exact Measure.rnDeriv_eq_div hμξ hνξ + filter_upwards [Measure.rnDeriv_eq_div (h_trim ▸ Measure.AbsolutelyContinuous.rfl.add_right _) + hξ_trim, hξ_trim (h_rn μ hμξ), hξ_trim (h_rn ν hνξ), + ae_of_ae_map (comap_measurable g).aemeasurable h_div] with x h1 h2 h3 h4 + rw [h1, h2, h3, h4] + +/-- The Radon-Nikodym derivative `∂(μ.map g)/∂(ν.map g)` evaluated at `g x` is `ν`-a.e. equal to +the Radon-Nikodym derivative of the restrictions of `μ` and `ν` to the σ-algebra `m𝓨.comap g`. -/ +lemma rnDeriv_map_comp_ae_eq_rnDeriv_trim [SigmaFinite (μ.map g)] [SigmaFinite (ν.map g)] + (hg : Measurable g) : + (fun x ↦ (μ.map g).rnDeriv (ν.map g) (g x)) + =ᵐ[ν] (μ.trim hg.comap_le).rnDeriv (ν.trim hg.comap_le) := + (ae_eq_of_ae_eq_trim (rnDeriv_trim_comap_ae_eq hg)).symm + +end MeasureTheory diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/RadonNikodym.lean b/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/RadonNikodym.lean index e09ffab..099604e 100644 --- a/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/RadonNikodym.lean +++ b/Statlib/ForMathlib/MeasureTheory/Measure/Decomposition/RadonNikodym.lean @@ -17,6 +17,8 @@ public import Mathlib.MeasureTheory.Measure.Decomposition.RadonNikodym * `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.singularPart_eq_restrict_rnDeriv_add_eq_zero`: the singular part of `μ` + with respect to `ν` is the restriction of `μ` to the set where `∂ν/∂(μ + ν)` vanishes. * `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 @@ -62,6 +64,30 @@ lemma singularPart_restrict_restrict (μ ν : Measure α) [SigmaFinite μ] [Sigm conv_lhs => rw [μ.haveLebesgueDecomposition_add ν] rw [restrict_add, restrict_withDensity hs] +/-- The singular part of `μ` with respect to `ν` is the restriction of `μ` to the set where +`∂ν/∂(μ + ν)` vanishes. -/ +lemma singularPart_eq_restrict_rnDeriv_add_eq_zero (μ ν : Measure α) [SigmaFinite μ] + [SigmaFinite ν] : + μ.singularPart ν = μ.restrict {x | ν.rnDeriv (μ + ν) x = 0} := by + set N := {x | ν.rnDeriv (μ + ν) x = 0} + have hN : MeasurableSet N := measurableSet_eq_fun (ν.measurable_rnDeriv _) measurable_const + have hνρ : ν ≪ μ + ν := AbsolutelyContinuous.rfl.add_right' μ + have hνN : ν N = 0 := by + rw [← setLIntegral_rnDeriv hνρ, setLIntegral_congr_fun hN (g := 0) fun x hx ↦ hx] + simp + -- outside of `N`, `μ` is absolutely continuous with respect to `ν` + have h_ac : μ.restrict Nᶜ ≪ ν := by + refine AbsolutelyContinuous.mk fun s hs hνs ↦ ?_ + rw [restrict_apply hs] + refine AbsolutelyContinuous.rfl.add_right ν ?_ + rw [← setLIntegral_rnDeriv hνρ, setLIntegral_eq_zero_iff hs (ν.measurable_rnDeriv _)] at hνs + rw [← compl_compl (s ∩ Nᶜ), ← mem_ae_iff] + filter_upwards [hνs] with x hx hxN + exact hxN.2 (hx hxN.1) + refine singularPart_eq_restrict ?_ hνN + rw [← restrict_apply_univ, ← singularPart_restrict μ ν hN.compl, singularPart_eq_zero_of_ac h_ac, + coe_zero, Pi.zero_apply] + /-- 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 diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/ERealStieltjes.lean b/Statlib/ForMathlib/MeasureTheory/Measure/ERealStieltjes.lean index 5cfc39b..8b87331 100644 --- a/Statlib/ForMathlib/MeasureTheory/Measure/ERealStieltjes.lean +++ b/Statlib/ForMathlib/MeasureTheory/Measure/ERealStieltjes.lean @@ -325,7 +325,7 @@ theorem length_subadditive_Icc_Ioo {a b : ℝ} {c d : ℕ → ℝ} (ss : Icc a b ⟨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] + rw [tsum_eq_iSup_sum] refine le_trans ?_ (le_iSup _ hf.toFinset) exact this hf.toFinset _ (by simpa only [e] ) clear ss b @@ -381,7 +381,7 @@ theorem outer_Ioc_of_ne_bot (a b : ℝ) (ha : f a ≠ ⊥) : rw [← iUnion_inter] simp [hs'] have h : ∑' i, f.length (s i) < ⊤ := by - refine (ENNReal.tsum_le_tsum fun n ↦ ?_).trans_lt h' + refine (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 ?_ @@ -405,7 +405,7 @@ theorem outer_Ioc_of_ne_bot (a b : ℝ) (ha : f a ≠ ⊥) : ∧ (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') + ENNReal.lt_add_right ((le_tsum _ i).trans_lt h).ne (ENNReal.coe_ne_zero.2 (ε'0 i).ne') conv at hl => lhs rw [length] @@ -456,9 +456,9 @@ theorem outer_Ioc_of_ne_bot (a b : ℝ) (ha : f a ≠ ⊥) : 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) + (add_le_add (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) + ∑' i, (ε' i : ℝ≥0∞) + δ := by rw [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] @@ -507,7 +507,7 @@ lemma outer_singleton_eq_top' {b : ℝ} (hb : ∀ a < b, f b - f a = ∞) : rw [outer_def, OuterMeasure.ofFunction_apply] simp only [iInf_eq_top] intro s hs - refine ENNReal.tsum_eq_top_of_eq_top ?_ + refine 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 @@ -596,13 +596,13 @@ theorem outer_trim : f.outer.trim = f.outer := by 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] + rw [← 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' + ENNReal.lt_add_right ((le_tsum _ i).trans_lt h).ne (ENNReal.coe_pos.2 (ε'0 i)).ne' conv at hl => lhs rw [length] @@ -614,7 +614,7 @@ theorem outer_trim : f.outer.trim = f.outer := by 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) + exact le_trans (measure_iUnion_le _) (tsum_le_tsum fun i => (hg i).2.2) theorem borel_le_measurable : borel ℝ ≤ f.outer.caratheodory := by rw [borel_eq_generateFrom_Ioi] diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/Prod.lean b/Statlib/ForMathlib/MeasureTheory/Measure/Prod.lean new file mode 100644 index 0000000..fc97859 --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Measure/Prod.lean @@ -0,0 +1,57 @@ +/- +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.MeasureTheory.Measure.Prod + +/-! +# Products of mutually singular measures + +Complements to `Mathlib.MeasureTheory.Measure.Prod`. + +## Main statements + +* `MeasureTheory.Measure.MutuallySingular.prod_of_left`, + `MeasureTheory.Measure.MutuallySingular.prod_of_right`: products of measures are mutually singular + if one pair of factors is. +* `MeasureTheory.Measure.prod.instNeZero`: the product of two nonzero measures is nonzero. +-/ + +@[expose] public section + +namespace MeasureTheory.Measure + +variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} + +/-- If `μ₁ ⟂ₘ ν₁`, then `μ₁.prod μ₂ ⟂ₘ ν₁.prod ν₂`. -/ +lemma MutuallySingular.prod_of_left {μ₁ ν₁ : Measure α} (h : μ₁ ⟂ₘ ν₁) (μ₂ ν₂ : Measure β) : + μ₁.prod μ₂ ⟂ₘ ν₁.prod ν₂ := by + by_cases hμ₂ : SFinite μ₂ + swap; · simp [prod_eq_zero_of_not_sfinite hμ₂] + by_cases hν₂ : SFinite ν₂ + swap; · simp [prod_eq_zero_of_not_sfinite hν₂] + refine ⟨h.nullSet ×ˢ Set.univ, h.measurableSet_nullSet.prod .univ, ?_, ?_⟩ + · rw [prod_prod, h.measure_nullSet, zero_mul] + · rw [show (h.nullSet ×ˢ Set.univ)ᶜ = h.nullSetᶜ ×ˢ (Set.univ : Set β) by ext; simp, prod_prod, + h.measure_compl_nullSet, zero_mul] + +/-- If `μ₂ ⟂ₘ ν₂`, then `μ₁.prod μ₂ ⟂ₘ ν₁.prod ν₂`. -/ +lemma MutuallySingular.prod_of_right {μ₂ ν₂ : Measure β} (h : μ₂ ⟂ₘ ν₂) (μ₁ ν₁ : Measure α) : + μ₁.prod μ₂ ⟂ₘ ν₁.prod ν₂ := by + by_cases hμ₂ : SFinite μ₂ + swap; · simp [prod_eq_zero_of_not_sfinite hμ₂] + by_cases hν₂ : SFinite ν₂ + swap; · simp [prod_eq_zero_of_not_sfinite hν₂] + refine ⟨Set.univ ×ˢ h.nullSet, MeasurableSet.univ.prod h.measurableSet_nullSet, ?_, ?_⟩ + · rw [prod_prod, h.measure_nullSet, mul_zero] + · rw [show (Set.univ ×ˢ h.nullSet)ᶜ = (Set.univ : Set α) ×ˢ h.nullSetᶜ by ext; simp, prod_prod, + h.measure_compl_nullSet, mul_zero] + +instance prod.instNeZero {μ : Measure α} {ν : Measure β} [SFinite ν] [NeZero μ] [NeZero ν] : + NeZero (μ.prod ν) := + ⟨fun h ↦ by simpa [← Set.univ_prod_univ, prod_prod, NeZero.ne] using congr($h .univ)⟩ + +end MeasureTheory.Measure diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/Real.lean b/Statlib/ForMathlib/MeasureTheory/Measure/Real.lean new file mode 100644 index 0000000..603a5f7 --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Measure/Real.lean @@ -0,0 +1,34 @@ +/- +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.MeasureTheory.Measure.Real + +/-! +# Differences of real-valued measures of sets + +## Main statements + +* `MeasureTheory.ofReal_measureReal_sub_measureReal`: for sets of finite measure, + `ENNReal.ofReal (μ.real s - ν.real t) = μ s - ν t`. +-/ + +@[expose] public section + +open scoped ENNReal + +namespace MeasureTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {s t : Set α} + +/-- The difference of the measures of two sets of finite measure, as the image of the difference +of their real-valued measures. -/ +lemma ofReal_measureReal_sub_measureReal (hs : μ s ≠ ∞ := by finiteness) + (ht : ν t ≠ ∞ := by finiteness) : + ENNReal.ofReal (μ.real s - ν.real t) = μ s - ν t := by + rw [ENNReal.ofReal_sub _ measureReal_nonneg, ofReal_measureReal hs, ofReal_measureReal ht] + +end MeasureTheory diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/Trim.lean b/Statlib/ForMathlib/MeasureTheory/Measure/Trim.lean new file mode 100644 index 0000000..a01a486 --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Measure/Trim.lean @@ -0,0 +1,39 @@ +/- +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.MeasureTheory.Measure.Trim +public import Mathlib.MeasureTheory.Measure.Typeclasses.Probability + +/-! +# Restriction of a measure to a sub-σ-algebra + +## Main statements + +* `MeasureTheory.isProbabilityMeasure_trim`: the restriction `μ.trim hm` of a probability measure + to a sub-σ-algebra is a probability measure. +* `MeasureTheory.sigmaFinite_trim_comap`: if `μ.map g` is σ-finite, so is the restriction of `μ` + to the σ-algebra `mβ.comap g`. +-/ + +@[expose] public section + +namespace MeasureTheory + +/-- The restriction of a probability measure to a sub-σ-algebra is a probability measure. -/ +instance isProbabilityMeasure_trim {α : Type*} {m m0 : MeasurableSpace α} {μ : Measure α} + (hm : m ≤ m0) [IsProbabilityMeasure μ] : IsProbabilityMeasure (μ.trim hm) := + ⟨by rw [trim_measurableSet_eq hm MeasurableSet.univ, measure_univ]⟩ + +/-- If `μ.map g` is σ-finite, so is the restriction of `μ` to the σ-algebra `mβ.comap g`. -/ +lemma sigmaFinite_trim_comap {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} + {μ : Measure α} {g : α → β} (hg : Measurable g) [SigmaFinite (μ.map g)] : + SigmaFinite (μ.trim hg.comap_le) := by + have h : SigmaFinite (μ.map g) := inferInstance + rw [← map_trim_comap hg] at h + exact SigmaFinite.of_map _ (comap_measurable g).aemeasurable h + +end MeasureTheory diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/Typeclasses/Probability.lean b/Statlib/ForMathlib/MeasureTheory/Measure/Typeclasses/Probability.lean new file mode 100644 index 0000000..2641a15 --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Measure/Typeclasses/Probability.lean @@ -0,0 +1,34 @@ +/- +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.MeasureTheory.Measure.Typeclasses.Probability + +/-! +# Convex combinations of probability measures + +## Main statements + +* `MeasureTheory.isProbabilityMeasure_smul_add_one_sub_smul`: for probability measures `μ` and `ν` + and `t : ℝ≥0` with `t ≤ 1`, `t • μ + (1 - t) • ν` is a probability measure. Mathlib has the + corresponding instance for `toNNReal p • μ + toNNReal (σ p) • ν` with `p : unitInterval`. +-/ + +@[expose] public section + +open scoped NNReal + +namespace MeasureTheory + +variable {α : Type*} {mα : MeasurableSpace α} + +/-- A convex combination `t • μ + (1 - t) • ν` of probability measures is a probability measure. -/ +lemma isProbabilityMeasure_smul_add_one_sub_smul {μ ν : Measure α} [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] {t : ℝ≥0} (ht : t ≤ 1) : + IsProbabilityMeasure (t • μ + (1 - t) • ν) where + measure_univ := by simp [add_tsub_cancel_of_le (ENNReal.coe_le_one_iff.mpr ht)] + +end MeasureTheory diff --git a/Statlib/ForMathlib/MeasureTheory/Measure/Typeclasses/SFinite.lean b/Statlib/ForMathlib/MeasureTheory/Measure/Typeclasses/SFinite.lean new file mode 100644 index 0000000..1d27d5c --- /dev/null +++ b/Statlib/ForMathlib/MeasureTheory/Measure/Typeclasses/SFinite.lean @@ -0,0 +1,44 @@ +/- +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.MeasureTheory.Measure.Typeclasses.SFinite + +/-! +# Atoms of maximal mass + +## Main statements + +* `MeasureTheory.Measure.exists_forall_measure_singleton_le`: a finite measure on a nonempty space + with measurable singletons has an atom of maximal mass. +-/ + +@[expose] public section + +open Set + +open scoped ENNReal + +namespace MeasureTheory.Measure + +/-- A finite measure has an atom of maximal mass. -/ +lemma exists_forall_measure_singleton_le {α : Type*} {mα : MeasurableSpace α} + [MeasurableSingletonClass α] [Nonempty α] (μ : Measure α) [IsFiniteMeasure μ] : + ∃ z, ∀ y, μ {y} ≤ μ {z} := by + by_cases! h : ∀ y, μ {y} = 0 + · exact ⟨Classical.arbitrary α, fun y ↦ by simp [h y]⟩ + obtain ⟨y₀, hy₀⟩ := h + -- only finitely many atoms have mass at least `μ {y₀}`, and we take the largest of them + have h_fin : {y | μ {y₀} ≤ μ {y}}.Finite := + finite_const_le_meas_of_disjoint_iUnion μ (pos_iff_ne_zero.mpr hy₀) measurableSet_singleton + (fun _ _ hij ↦ disjoint_singleton.mpr hij) (measure_ne_top μ _) + obtain ⟨z, hz, hz_max⟩ := exists_max_image _ (fun y ↦ μ {y}) h_fin ⟨y₀, le_refl (μ {y₀})⟩ + refine ⟨z, fun y ↦ ?_⟩ + by_cases hy : μ {y₀} ≤ μ {y} + · exact hz_max y hy + · exact (not_le.mp hy).le.trans hz + +end MeasureTheory.Measure diff --git a/Statlib/ForMathlib/Probability/Decision/BayesEstimator.lean b/Statlib/ForMathlib/Probability/Decision/BayesEstimator.lean index b9e867c..d215d8a 100644 --- a/Statlib/ForMathlib/Probability/Decision/BayesEstimator.lean +++ b/Statlib/ForMathlib/Probability/Decision/BayesEstimator.lean @@ -10,8 +10,15 @@ public import Mathlib.Probability.Kernel.Posterior public import Statlib.ForMathlib.MeasureTheory.Measure.Bool /-! -# Bayes risk of estimation problems with parameter space `Bool` +# Bayes risk of problems which admit an argmin estimator +## Main statements + +* `ProbabilityTheory.HasArgminEstimator.bayesRisk_eq_lintegral_rnDeriv`: if the estimation problem + admits an argmin estimator and `P θ ≪ P ∘ₘ π` for `π`-almost every `θ`, then the Bayes risk is + `∫⁻ x, ⨅ y, ∫⁻ θ, (dP_θ/d(P ∘ₘ π))(x) * ℓ θ y ∂π ∂(P ∘ₘ π)`. + `ProbabilityTheory.HasArgminEstimator.bayesRisk_eq_lintegral_rnDeriv_of_countable` is the same + statement for a countable parameter space, without the absolute continuity assumption. * `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. @@ -22,19 +29,58 @@ This file is adapted from the testing-lower-bounds project of Rémy Degenne and @[expose] public section -open MeasureTheory +open MeasureTheory Function open scoped ENNReal namespace ProbabilityTheory -variable {𝒳 : Type*} {m𝒳 : MeasurableSpace 𝒳} +section Posterior + +variable {Θ 𝓧 𝓨 : Type*} {mΘ : MeasurableSpace Θ} {m𝓧 : MeasurableSpace 𝓧} + {m𝓨 : MeasurableSpace 𝓨} {ℓ : Θ → 𝓨 → ℝ≥0∞} [StandardBorelSpace Θ] [Nonempty Θ] + {P : Kernel Θ 𝓧} [IsFiniteKernel P] {π : Measure Θ} [IsFiniteMeasure π] + +/-- If the estimation problem admits an argmin estimator and `P θ ≪ P ∘ₘ π` for `π`-almost every +`θ`, then the Bayes risk is +`∫⁻ x, ⨅ y, ∫⁻ θ, (dP_θ/d(P ∘ₘ π))(x) * ℓ θ y ∂π ∂(P ∘ₘ π)`, in which the jointly measurable version +`P.rnDeriv (Kernel.const Θ (P ∘ₘ π))` of the Radon-Nikodym derivatives is used. -/ +lemma HasArgminEstimator.bayesRisk_eq_lintegral_rnDeriv + [MeasurableSpace.CountableOrCountablyGenerated Θ 𝓧] + (hl : Measurable (uncurry ℓ)) (h : HasArgminEstimator ℓ P π) + (h_ac : ∀ᵐ θ ∂π, P θ ≪ P ∘ₘ π) : + bayesRisk ℓ P π + = ∫⁻ x, ⨅ y, ∫⁻ θ, P.rnDeriv (Kernel.const Θ (P ∘ₘ π)) θ x * ℓ θ y ∂π ∂(P ∘ₘ π) := by + rw [h.bayesRisk_eq hl] + refine lintegral_congr_ae ?_ + filter_upwards [posterior_eq_withDensity h_ac] with x hx + congr with y + rw [hx, lintegral_withDensity_eq_lintegral_mul _ _ (by fun_prop)] + · rfl + · exact (Kernel.measurable_rnDeriv _ _).comp (measurable_id.prodMk measurable_const) + +/-- If the parameter space is countable and the estimation problem admits an argmin estimator, +then the Bayes risk is `∫⁻ x, ⨅ y, ∫⁻ θ, (dP_θ/d(P ∘ₘ π))(x) * ℓ θ y ∂π ∂(P ∘ₘ π)`. -/ +lemma HasArgminEstimator.bayesRisk_eq_lintegral_rnDeriv_of_countable [Countable Θ] + (hl : Measurable (uncurry ℓ)) (h : HasArgminEstimator ℓ P π) : + bayesRisk ℓ P π + = ∫⁻ x, ⨅ y, ∫⁻ θ, (P θ).rnDeriv (P ∘ₘ π) x * ℓ θ y ∂π ∂(P ∘ₘ π) := by + rw [h.bayesRisk_eq hl] + refine lintegral_congr_ae ?_ + filter_upwards [posterior_eq_withDensity_of_countable P π] with x hx + congr with y + rw [hx, lintegral_withDensity_eq_lintegral_mul _ (measurable_of_countable _) (by fun_prop)] + rfl + +end Posterior + +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 ν] +lemma bayesRisk_boolKernel_eq_lintegral_iInf {𝓨 : Type*} [MeasurableSpace 𝓨] + {ℓ : Bool → 𝓨 → ℝ≥0∞} (hℓ : Measurable (uncurry ℓ)) + (μ ν : Measure 𝓧) [IsFiniteMeasure μ] [IsFiniteMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] (h : HasArgminEstimator ℓ (Kernel.boolKernel μ ν) π) : bayesRisk ℓ (Kernel.boolKernel μ ν) π = ∫⁻ x, ⨅ y, π {true} * ν.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x * ℓ true y diff --git a/Statlib/ForMathlib/Probability/Decision/Risk/Basic.lean b/Statlib/ForMathlib/Probability/Decision/Risk/Basic.lean new file mode 100644 index 0000000..67aa75f --- /dev/null +++ b/Statlib/ForMathlib/Probability/Decision/Risk/Basic.lean @@ -0,0 +1,150 @@ +/- +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.Probability.Decision.Risk.Basic + +/-! +# Additional properties of the average and Bayes risks + +## Main statements + +* `bayesRisk_smul_prior`: the Bayes risk is positively homogeneous in the prior. +* `bayesRisk_le_bayesRisk_fst`, `bayesRisk_le_bayesRisk_snd`: forgetting a component of the + observation increases the Bayes risk. +* `mul_bayesRisk_add_mul_bayesRisk_le`: **concavity of the Bayes risk** in the data generating + kernel. +* `avgRisk_eq_lintegral_compProd`: the average risk is the integral of the expected loss of the + estimator against the joint law `π ⊗ₘ P` of the parameter and the data. +* `avgRisk_le_one`, `bayesRisk_le_one`: the risks of a loss bounded by `1` are at most `1`. +* `bayesRisk_const_eq_bayesRisk_discard`: observing data with a law that does not depend on the + parameter is as good as observing nothing. +-/ + +@[expose] public section + +open MeasureTheory Function + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +variable {Θ 𝓧 𝓧' 𝓨 : Type*} {mΘ : MeasurableSpace Θ} {m𝓧 : MeasurableSpace 𝓧} + {m𝓧' : MeasurableSpace 𝓧'} {m𝓨 : MeasurableSpace 𝓨} {ℓ : Θ → 𝓨 → ℝ≥0∞} + +/-! ### Scaling the prior -/ + +@[simp] +lemma avgRisk_smul_prior (ℓ : Θ → 𝓨 → ℝ≥0∞) (P : Kernel Θ 𝓧) (κ : Kernel 𝓧 𝓨) (π : Measure Θ) + (c : ℝ≥0∞) : + avgRisk ℓ P κ (c • π) = c * avgRisk ℓ P κ π := by + simp [avgRisk, lintegral_smul_measure] + +/-- The Bayes risk is positively homogeneous in the prior: scaling the prior by a finite factor +scales the Bayes risk by the same factor. -/ +lemma bayesRisk_smul_prior [Nonempty 𝓨] (ℓ : Θ → 𝓨 → ℝ≥0∞) (P : Kernel Θ 𝓧) (π : Measure Θ) + {c : ℝ≥0∞} (hc : c ≠ ∞) : + bayesRisk ℓ P (c • π) = c * bayesRisk ℓ P π := by + rcases eq_or_ne c 0 with rfl | hc0 + · simp + simp_rw [bayesRisk, avgRisk_smul_prior, ENNReal.mul_iInf_of_ne hc0 hc] + +/-! ### Processing the observation -/ + +/-- Forgetting the second component of the observation increases the Bayes risk. -/ +lemma bayesRisk_le_bayesRisk_fst (ℓ : Θ → 𝓨 → ℝ≥0∞) (P : Kernel Θ (𝓧 × 𝓧')) (π : Measure Θ) : + bayesRisk ℓ P π ≤ bayesRisk ℓ P.fst π := by + rw [Kernel.fst_eq] + exact bayesRisk_le_bayesRisk_map _ _ _ measurable_fst + +/-- Forgetting the first component of the observation increases the Bayes risk. -/ +lemma bayesRisk_le_bayesRisk_snd (ℓ : Θ → 𝓨 → ℝ≥0∞) (P : Kernel Θ (𝓧 × 𝓧')) (π : Measure Θ) : + bayesRisk ℓ P π ≤ bayesRisk ℓ P.snd π := by + rw [Kernel.snd_eq] + exact bayesRisk_le_bayesRisk_map _ _ _ measurable_snd + +/-- The Bayes risk of a constant kernel with value a probability measure is the Bayes risk without +observations. -/ +lemma bayesRisk_const_eq_bayesRisk_discard (ℓ : Θ → 𝓨 → ℝ≥0∞) (ξ : Measure 𝓧) + [IsProbabilityMeasure ξ] (π : Measure Θ) : + bayesRisk ℓ (Kernel.const Θ ξ) π = bayesRisk ℓ (Kernel.discard Θ) π := by + -- in both problems, the laws of the estimates are exactly the probability measures on `𝓨` + refine le_antisymm (le_iInf₂ fun κ hκ ↦ ?_) (le_iInf₂ fun κ hκ ↦ ?_) + · refine iInf₂_le_of_le (Kernel.const 𝓧 (κ PUnit.unit)) inferInstance (le_of_eq ?_) + simp [avgRisk, Kernel.discard_eq_const, Measure.dirac_bind κ.measurable] + · refine iInf₂_le_of_le (Kernel.const _ (κ ∘ₘ ξ)) inferInstance (le_of_eq ?_) + simp [avgRisk, Kernel.discard_eq_const] + +/-! ### Concavity in the data generating kernel -/ + +/-- If `P θ = a • P₁ θ + b • P₂ θ` for `π`-almost every `θ`, then +`a * avgRisk ℓ P₁ κ π + b * avgRisk ℓ P₂ κ π ≤ avgRisk ℓ P κ π`. -/ +lemma mul_avgRisk_add_mul_avgRisk_le (ℓ : Θ → 𝓨 → ℝ≥0∞) {P₁ P₂ P : Kernel Θ 𝓧} {a b : ℝ≥0∞} + {π : Measure Θ} (hP : ∀ᵐ θ ∂π, P θ = a • P₁ θ + b • P₂ θ) (κ : Kernel 𝓧 𝓨) : + a * avgRisk ℓ P₁ κ π + b * avgRisk ℓ P₂ κ π ≤ avgRisk ℓ P κ π := by + calc a * avgRisk ℓ P₁ κ π + b * avgRisk ℓ P₂ κ π + _ ≤ ∫⁻ θ, a * ∫⁻ y, ℓ θ y ∂((κ ∘ₖ P₁) θ) + b * ∫⁻ y, ℓ θ y ∂((κ ∘ₖ P₂) θ) ∂π := + (add_le_add (lintegral_const_mul_le _ _) (lintegral_const_mul_le _ _)).trans + (le_lintegral_add _ _) + _ = avgRisk ℓ P κ π := by + refine lintegral_congr_ae ?_ + filter_upwards [hP] with θ hθ + simp_rw [Kernel.comp_apply, hθ, Measure.comp_add, Measure.comp_smul, lintegral_add_measure, + lintegral_smul_measure, smul_eq_mul] + +/-- **Concavity of the Bayes risk** in the data generating kernel: if `P θ = a • P₁ θ + b • P₂ θ` +for `π`-almost every `θ`, then `a * bayesRisk ℓ P₁ π + b * bayesRisk ℓ P₂ π ≤ bayesRisk ℓ P π`. -/ +lemma mul_bayesRisk_add_mul_bayesRisk_le (ℓ : Θ → 𝓨 → ℝ≥0∞) {P₁ P₂ P : Kernel Θ 𝓧} + {a b : ℝ≥0∞} {π : Measure Θ} (hP : ∀ᵐ θ ∂π, P θ = a • P₁ θ + b • P₂ θ) : + a * bayesRisk ℓ P₁ π + b * bayesRisk ℓ P₂ π ≤ bayesRisk ℓ P π := by + refine le_iInf₂ fun κ hκ ↦ le_trans ?_ (mul_avgRisk_add_mul_avgRisk_le ℓ hP κ) + gcongr <;> exact bayesRisk_le_avgRisk _ _ _ _ + +/-! ### The average risk as an integral against the joint law -/ + +/-- The expected loss `∫⁻ y, ℓ θ y ∂(κ x)` of an estimator `κ` is a measurable function of the +parameter-data pair `(θ, x)`. -/ +lemma measurable_lintegral_loss (hℓ : Measurable (uncurry ℓ)) (κ : Kernel 𝓧 𝓨) + [IsSFiniteKernel κ] : + Measurable fun z : Θ × 𝓧 ↦ ∫⁻ y, ℓ z.1 y ∂(κ z.2) := by + have h := (hℓ.comp (measurable_fst.fst.prodMk measurable_snd)).lintegral_kernel_prod_right' + (κ := κ.comap Prod.snd measurable_snd) + simpa [Kernel.comap_apply] using h + +/-- The average risk is the integral of the expected loss of the estimator with respect to the +joint law `π ⊗ₘ P` of the parameter and the data. -/ +lemma avgRisk_eq_lintegral_compProd (hℓ : Measurable (uncurry ℓ)) (P : Kernel Θ 𝓧) + [IsSFiniteKernel P] (κ : Kernel 𝓧 𝓨) [IsSFiniteKernel κ] (π : Measure Θ) [SFinite π] : + avgRisk ℓ P κ π = ∫⁻ z, ∫⁻ y, ℓ z.1 y ∂(κ z.2) ∂(π ⊗ₘ P) := by + rw [avgRisk, Measure.lintegral_compProd (measurable_lintegral_loss hℓ κ)] + congr with θ + rw [Kernel.lintegral_comp _ _ _ (show Measurable (ℓ θ) from hℓ.comp measurable_prodMk_left)] + +/-! ### Losses bounded by `1` -/ + +/-- For a loss bounded by `1`, a prior and kernels that are either zero or of mass `1` (for example +a probability prior and Markov kernels), the average risk is at most `1`. -/ +lemma avgRisk_le_one (hℓ1 : ∀ θ y, ℓ θ y ≤ 1) (P : Kernel Θ 𝓧) [IsZeroOrMarkovKernel P] + (κ : Kernel 𝓧 𝓨) [IsZeroOrMarkovKernel κ] (π : Measure Θ) [IsZeroOrProbabilityMeasure π] : + avgRisk ℓ P κ π ≤ 1 := by + refine (avgRisk_le_mul' P κ π (C := 1) (by simpa using hℓ1)).trans ?_ + calc ((1 : ℝ≥0) : ℝ≥0∞) * κ.bound * P.bound * π Set.univ ≤ 1 * 1 * 1 * 1 := by + gcongr + exacts [le_of_eq ENNReal.coe_one, κ.bound_le_one, P.bound_le_one, prob_le_one] + _ = 1 := by simp + +/-- For a loss bounded by `1`, a prior and a kernel that are either zero or of mass `1` (for +example a probability prior and a Markov kernel), the Bayes risk is at most `1`. -/ +lemma bayesRisk_le_one [Nonempty 𝓨] (hℓ1 : ∀ θ y, ℓ θ y ≤ 1) (P : Kernel Θ 𝓧) + [IsZeroOrMarkovKernel P] (π : Measure Θ) [IsZeroOrProbabilityMeasure π] : + bayesRisk ℓ P π ≤ 1 := by + refine (bayesRisk_le_mul' P π (C := 1) (by simpa using hℓ1)).trans ?_ + calc ((1 : ℝ≥0) : ℝ≥0∞) * P.bound * π Set.univ ≤ 1 * 1 * 1 := by + gcongr + exacts [le_of_eq ENNReal.coe_one, P.bound_le_one, prob_le_one] + _ = 1 := by simp + +end ProbabilityTheory diff --git a/Statlib/ForMathlib/Probability/Decision/Risk/RiskIncrease.lean b/Statlib/ForMathlib/Probability/Decision/Risk/RiskIncrease.lean new file mode 100644 index 0000000..a1e3ea0 --- /dev/null +++ b/Statlib/ForMathlib/Probability/Decision/Risk/RiskIncrease.lean @@ -0,0 +1,46 @@ +/- +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.Probability.Decision.Risk.Basic +public import Mathlib.Probability.Decision.Risk.RiskIncrease + +/-! +# Additional properties of the risk increase + +## Main statements + +* `riskIncrease_eq_sub_add_riskIncrease_comp`: for a Markov kernel `η`, the risk increase of `P` + is the increase of the Bayes risk when the data is processed with `η`, plus the risk increase + of `η ∘ₖ P`. +-/ + +@[expose] public section + +open MeasureTheory + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {Θ 𝓧 𝓧' 𝓨 : Type*} {mΘ : MeasurableSpace Θ} {m𝓧 : MeasurableSpace 𝓧} + {m𝓧' : MeasurableSpace 𝓧'} {m𝓨 : MeasurableSpace 𝓨} + +/-- The risk increase of `P` is the increase of the Bayes risk when processing the data with a +Markov kernel `η`, plus the risk increase of `η ∘ₖ P`. -/ +lemma riskIncrease_eq_sub_add_riskIncrease_comp (ℓ : Θ → 𝓨 → ℝ≥0∞) (P : Kernel Θ 𝓧) + (π : Measure Θ) (η : Kernel 𝓧 𝓧') [IsMarkovKernel η] : + riskIncrease ℓ P π + = (bayesRisk ℓ (η ∘ₖ P) π - bayesRisk ℓ P π) + riskIncrease ℓ (η ∘ₖ P) π := by + have h_discard : bayesRisk ℓ (Kernel.discard 𝓧' ∘ₖ (η ∘ₖ P)) π + = bayesRisk ℓ (Kernel.discard 𝓧 ∘ₖ P) π := by + rw [← Kernel.comp_assoc, Kernel.comp_discard] + have h1 : bayesRisk ℓ P π ≤ bayesRisk ℓ (η ∘ₖ P) π := bayesRisk_le_bayesRisk_comp ℓ P π η + have h2 : bayesRisk ℓ (η ∘ₖ P) π ≤ bayesRisk ℓ (Kernel.discard 𝓧 ∘ₖ P) π := + h_discard ▸ bayesRisk_le_bayesRisk_comp ℓ (η ∘ₖ P) π (Kernel.discard 𝓧') + rw [riskIncrease, riskIncrease, h_discard, add_comm, tsub_add_tsub_cancel h2 h1] + +end ProbabilityTheory diff --git a/Statlib/ForMathlib/Probability/Decision/ZeroOneLoss.lean b/Statlib/ForMathlib/Probability/Decision/ZeroOneLoss.lean new file mode 100644 index 0000000..48e1c33 --- /dev/null +++ b/Statlib/ForMathlib/Probability/Decision/ZeroOneLoss.lean @@ -0,0 +1,253 @@ +/- +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.Probability.Decision.BayesEstimator +public import Statlib.ForMathlib.Analysis.SpecialFunctions.Pow.NNReal +public import Statlib.ForMathlib.MeasureTheory.Measure.Typeclasses.SFinite +public import Statlib.ForMathlib.Probability.Kernel.Posterior + +/-! +# Losses with values in `{0, 1}` and the 0-1 loss + +For a loss with values in `{0, 1}`, the average risk of an estimator is the probability that the +loss is `1`. + +The main example is the 0-1 loss `zeroOneLoss θ z = 𝕀{θ ≠ z}`, for estimation problems in which +the action space is the parameter space `Θ` itself. The Bayes risk of such a problem is the +probability of misidentifying the parameter, and a Bayes estimator is given by a maximizer of the +posterior probability of the parameter. + +## Main definitions + +* `zeroOneLoss`: the 0-1 loss `𝕀{θ ≠ z}`. + +## Main statements + +* `avgRisk_eq_measure_of_mem_zero_one`, `map_uncurry_compProd_of_mem_zero_one`: for a loss with + values in `{0, 1}`, the average risk is the probability that the loss is `1`, and the law of the + loss puts that mass at `1` and the rest of the total mass at `0` (a Bernoulli law when the total + mass is `1`). +* `HasArgminEstimator.bayesRisk_zeroOneLoss_eq_sub`: when the problem admits an argmin estimator + (for example when `Θ` is countable), the Bayes risk of the 0-1 loss is + `(P ∘ₘ π)(univ) - ∫⁻ x, ⨆ z, (P†π) x {z} ∂(P ∘ₘ π)`. +* `isArgminEstimator_zeroOneLoss_of_posterior`, `isArgminEstimator_zeroOneLoss`: an estimator + that maximizes the posterior probability `z ↦ (P†π) x {z}`, or equivalently for countable `Θ` + the function `z ↦ π {z} * (dP_z/d(P ∘ₘ π))(x)`, is an argmin estimator, hence a Bayes + estimator. +* `hasArgminEstimator_zeroOneLoss`: if `Θ` is countable, such an estimator exists. +* `bayesRisk_zeroOneLoss_eq_sub_rnDeriv`: for countable `Θ`, the Bayes risk of the 0-1 loss is + `(P ∘ₘ π)(univ) - ∫⁻ x, ⨆ z, π {z} * (dP_z/d(P ∘ₘ π))(x) ∂(P ∘ₘ π)`. +* `bayesRisk_zeroOneLoss_le_sub_prod`: for `Θ` countable and weights `w θ ≥ 0` summing to `1` on a + finite set `s`, the Bayes risk of the 0-1 loss is at most `(P ∘ₘ π)(univ)` minus + `(∏ θ ∈ s, π {θ} ^ w θ) * ∫⁻ x, ∏ θ ∈ s, (dP_θ/d(P ∘ₘ π))(x) ^ w θ ∂(P ∘ₘ π)`. +-/ + +@[expose] public section + +open MeasureTheory Function Set + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {Θ 𝓧 𝓨 : Type*} {mΘ : MeasurableSpace Θ} {m𝓧 : MeasurableSpace 𝓧} + {m𝓨 : MeasurableSpace 𝓨} + +/-! ### Losses with values in `{0, 1}` -/ + +section ZeroOneValued + +variable {ℓ : Θ → 𝓨 → ℝ≥0∞} + +/-- For a loss with values in `{0, 1}`, the average risk of an estimator `κ` is the probability +that the loss is `1` under the joint law of the parameter and the estimate. -/ +lemma avgRisk_eq_measure_of_mem_zero_one (hℓ : Measurable (uncurry ℓ)) + (h01 : ∀ θ y, ℓ θ y = 0 ∨ ℓ θ y = 1) (P : Kernel Θ 𝓧) [IsSFiniteKernel P] (κ : Kernel 𝓧 𝓨) + [IsSFiniteKernel κ] (π : Measure Θ) [SFinite π] : + avgRisk ℓ P κ π = (π ⊗ₘ (κ ∘ₖ P)) {p | ℓ p.1 p.2 = 1} := by + have h_eq : uncurry ℓ = {p | ℓ p.1 p.2 = 1}.indicator 1 := by + ext p + rcases h01 p.1 p.2 with h | h <;> simp [uncurry_def, h] + have h_meas : MeasurableSet {p : Θ × 𝓨 | ℓ p.1 p.2 = 1} := + hℓ (measurableSet_singleton 1) + rw [avgRisk, ← lintegral_indicator_one h_meas, ← h_eq, Measure.lintegral_compProd hℓ] + rfl + +/-- For a loss with values in `{0, 1}`, the law of the loss of an estimator `κ` under the joint +law of the parameter and the estimate is a Bernoulli law (scaled by the total mass) whose mass at +`1` is the average risk. -/ +lemma map_uncurry_compProd_of_mem_zero_one (hℓ : Measurable (uncurry ℓ)) + (h01 : ∀ θ y, ℓ θ y = 0 ∨ ℓ θ y = 1) (P : Kernel Θ 𝓧) [IsFiniteKernel P] (κ : Kernel 𝓧 𝓨) + [IsFiniteKernel κ] (π : Measure Θ) [IsFiniteMeasure π] : + (π ⊗ₘ (κ ∘ₖ P)).map (uncurry ℓ) + = ((π ⊗ₘ (κ ∘ₖ P)) univ - avgRisk ℓ P κ π) • Measure.dirac 0 + + avgRisk ℓ P κ π • Measure.dirac 1 := by + classical + rw [avgRisk_eq_measure_of_mem_zero_one hℓ h01] + set A := {p : Θ × 𝓨 | ℓ p.1 p.2 = 1} + have hA : MeasurableSet A := hℓ (measurableSet_singleton 1) + ext s hs + rw [Measure.map_apply hℓ hs, Measure.add_apply, Measure.smul_apply, Measure.smul_apply, + Measure.dirac_apply' _ hs, Measure.dirac_apply' _ hs, smul_eq_mul, smul_eq_mul] + have h_pre : uncurry ℓ ⁻¹' s + = (if (0 : ℝ≥0∞) ∈ s then Aᶜ else ∅) ∪ (if (1 : ℝ≥0∞) ∈ s then A else ∅) := by + ext p + by_cases h0 : (0 : ℝ≥0∞) ∈ s <;> by_cases h1 : (1 : ℝ≥0∞) ∈ s <;> + rcases h01 p.1 p.2 with hp | hp <;> simp [A, uncurry_def, hp, h0, h1] + rw [h_pre] + by_cases h0 : (0 : ℝ≥0∞) ∈ s <;> by_cases h1 : (1 : ℝ≥0∞) ∈ s + · simp [h0, h1, tsub_add_cancel_of_le (measure_mono (subset_univ A))] + · simp [h0, h1, measure_compl hA (measure_ne_top _ A)] + · simp [h0, h1] + · simp [h0, h1] + +end ZeroOneValued + +/-! ### The 0-1 loss -/ + +/-- The 0-1 loss `𝕀{θ ≠ z}`. -/ +noncomputable +def zeroOneLoss (θ z : Θ) : ℝ≥0∞ := ({z}ᶜ : Set Θ).indicator 1 θ + +lemma zeroOneLoss_apply [DecidableEq Θ] (θ z : Θ) : + zeroOneLoss θ z = if θ = z then 0 else 1 := by + by_cases h : θ = z <;> simp [zeroOneLoss, h] + +@[simp] lemma zeroOneLoss_self (θ : Θ) : zeroOneLoss θ θ = 0 := by simp [zeroOneLoss] + +lemma zeroOneLoss_of_ne {θ z : Θ} (h : θ ≠ z) : zeroOneLoss θ z = 1 := by simp [zeroOneLoss, h] + +lemma zeroOneLoss_le_one (θ z : Θ) : zeroOneLoss θ z ≤ 1 := + Set.indicator_apply_le' (fun _ ↦ le_rfl) (fun _ ↦ zero_le_one) + +lemma measurable_zeroOneLoss [MeasurableEq Θ] : Measurable (uncurry (zeroOneLoss (Θ := Θ))) := by + have h_eq : uncurry (zeroOneLoss (Θ := Θ)) = (diagonal Θ)ᶜ.indicator 1 := by + ext p + by_cases h : p.1 = p.2 <;> simp [uncurry_def, zeroOneLoss, mem_diagonal_iff, h] + rw [h_eq] + exact measurable_one.indicator measurableSet_diagonal.compl + +lemma lintegral_zeroOneLoss [MeasurableSingletonClass Θ] (ρ : Measure Θ) (z : Θ) : + ∫⁻ θ, zeroOneLoss θ z ∂ρ = ρ {z}ᶜ := + lintegral_indicator_one (measurableSet_singleton z).compl + +/-- The smallest expected 0-1 loss of an action under a finite measure `ρ` is the mass of `ρ` +minus the maximal mass of an atom. -/ +lemma iInf_lintegral_zeroOneLoss [MeasurableSingletonClass Θ] [Nonempty Θ] (ρ : Measure Θ) + [IsFiniteMeasure ρ] : + ⨅ z, ∫⁻ θ, zeroOneLoss θ z ∂ρ = ρ univ - ⨆ z, ρ {z} := by + simp_rw [lintegral_zeroOneLoss, measure_compl (measurableSet_singleton _) (measure_ne_top _ _)] + exact (ENNReal.sub_iSup (measure_ne_top ρ univ)).symm + +variable [StandardBorelSpace Θ] [Nonempty Θ] {P : Kernel Θ 𝓧} [IsFiniteKernel P] + {π : Measure Θ} [IsFiniteMeasure π] + +/-- If the estimation problem with the 0-1 loss admits an argmin estimator, then its Bayes risk is +the mass of `P ∘ₘ π` minus the expected maximal posterior probability of a parameter. -/ +lemma HasArgminEstimator.bayesRisk_zeroOneLoss_eq_sub (h : HasArgminEstimator zeroOneLoss P π) : + bayesRisk zeroOneLoss P π = (P ∘ₘ π) univ - ∫⁻ x, ⨆ z, (P†π) x {z} ∂(P ∘ₘ π) := by + rw [h.bayesRisk_eq measurable_zeroOneLoss] + simp_rw [iInf_lintegral_zeroOneLoss, measure_univ] + have h_le x : ⨆ z, (P†π) x {z} ≤ 1 := iSup_le fun z ↦ prob_le_one + -- the supremum is almost surely attained at the value of an argmin estimator `f`, hence it is + -- almost everywhere measurable + obtain ⟨f, hf⟩ := h.exists_isArgminEstimator + have hf_meas : Measurable fun x ↦ (P†π) x {f x} := (P†π).measurable_kernel_prodMk_left + (measurableSet_eq_fun measurable_snd (hf.measurable.comp measurable_fst)) + have h_eq : (fun x ↦ ⨆ z, (P†π) x {z}) =ᵐ[P ∘ₘ π] fun x ↦ (P†π) x {f x} := by + filter_upwards [hf.property] with x hx + rw [lintegral_zeroOneLoss, iInf_lintegral_zeroOneLoss, + prob_compl_eq_one_sub (measurableSet_singleton _), measure_univ] at hx + rw [← ENNReal.sub_sub_cancel ENNReal.one_ne_top (h_le x), ← hx, + ENNReal.sub_sub_cancel ENNReal.one_ne_top prob_le_one] + rw [lintegral_sub' (hf_meas.aemeasurable.congr h_eq.symm) ?_ (ae_of_all _ h_le), lintegral_one] + refine ((lintegral_mono h_le).trans_lt ?_).ne + simp [measure_lt_top] + +/-- An estimator that maximizes the posterior probability `z ↦ (P†π) x {z}` for almost every `x` +is an argmin estimator for the 0-1 loss, hence a Bayes estimator. -/ +lemma isArgminEstimator_zeroOneLoss_of_posterior {f : 𝓧 → Θ} (hf : Measurable f) + (h : ∀ᵐ x ∂(P ∘ₘ π), ∀ z, (P†π) x {z} ≤ (P†π) x {f x}) : + IsArgminEstimator zeroOneLoss P π f := by + refine ⟨hf, ?_⟩ + filter_upwards [h] with x hx + simp_rw [lintegral_zeroOneLoss, prob_compl_eq_one_sub (measurableSet_singleton _)] + exact le_antisymm (le_iInf fun z ↦ tsub_le_tsub_left (hx z) 1) (iInf_le _ _) + +section Countable + +variable [Countable Θ] + +/-- The **generalized Bayes estimator** for the 0-1 loss: for a countable parameter space, an +estimator that maximizes `z ↦ π {z} * (dP_z/d(P ∘ₘ π))(x)` for almost every `x` is an argmin +estimator, hence a Bayes estimator. -/ +lemma isArgminEstimator_zeroOneLoss {f : 𝓧 → Θ} (hf : Measurable f) + (h : ∀ᵐ x ∂(P ∘ₘ π), ∀ z, + π {z} * (P z).rnDeriv (P ∘ₘ π) x ≤ π {f x} * (P (f x)).rnDeriv (P ∘ₘ π) x) : + IsArgminEstimator zeroOneLoss P π f := by + refine isArgminEstimator_zeroOneLoss_of_posterior hf ?_ + filter_upwards [h, posterior_singleton_ae_eq P π] with x hx hpost + simpa only [hpost] using hx + +/-- If the parameter space is countable, the estimation problem with the 0-1 loss admits an argmin +estimator: a measurable maximizer of the posterior probability of the parameter. -/ +lemma hasArgminEstimator_zeroOneLoss : HasArgminEstimator zeroOneLoss P π := by + classical + have : Encodable Θ := Encodable.ofCountable Θ + have hg z : Measurable fun x ↦ (P†π) x {z} := (P†π).measurable_coe (measurableSet_singleton z) + -- `p x n`: the parameter with code `n` maximizes the posterior probability `(P†π) x {·}` + let p : 𝓧 → ℕ → Prop := + fun x n ↦ ∃ z, Encodable.encode z = n ∧ ∀ y, (P†π) x {y} ≤ (P†π) x {z} + have hp x : ∃ n, p x n := by + obtain ⟨z, hz⟩ := ((P†π) x).exists_forall_measure_singleton_le + exact ⟨_, z, rfl, hz⟩ + have hp_meas k : MeasurableSet {x | p x k} := by + simp only [p, ofPred_exists, ofPred_and, ofPred_forall] + exact MeasurableSet.iUnion fun z ↦ (MeasurableSet.const _).inter + (MeasurableSet.iInter fun y ↦ measurableSet_le (hg y) (hg z)) + let f : 𝓧 → Θ := fun x ↦ (Encodable.decode₂ Θ (Nat.find (hp x))).getD (Classical.arbitrary Θ) + have hf_meas : Measurable f := + (measurable_from_nat (f := fun n ↦ (Encodable.decode₂ Θ n).getD (Classical.arbitrary Θ))).comp + (measurable_find hp hp_meas) + refine ⟨f, isArgminEstimator_zeroOneLoss_of_posterior hf_meas (ae_of_all _ fun x z ↦ ?_)⟩ + obtain ⟨z', hz'_eq, hz'⟩ := Nat.find_spec (hp x) + have hfx : f x = z' := by simp [f, ← hz'_eq, Encodable.decode₂_encode] + rw [hfx] + exact hz' z + +/-- For a countable parameter space, the Bayes risk of the 0-1 loss is +`(P ∘ₘ π)(univ) - ∫⁻ x, ⨆ z, π {z} * (dP_z/d(P ∘ₘ π))(x) ∂(P ∘ₘ π)`. -/ +lemma bayesRisk_zeroOneLoss_eq_sub_rnDeriv : + bayesRisk zeroOneLoss P π + = (P ∘ₘ π) univ - ∫⁻ x, ⨆ z, π {z} * (P z).rnDeriv (P ∘ₘ π) x ∂(P ∘ₘ π) := by + rw [hasArgminEstimator_zeroOneLoss.bayesRisk_zeroOneLoss_eq_sub] + congr 1 + refine lintegral_congr_ae ?_ + filter_upwards [posterior_singleton_ae_eq P π] with x hx + simp_rw [hx] + +/-- For a countable parameter space, a finite set `s` of parameters and weights `w θ ≥ 0` with +`∑ θ ∈ s, w θ = 1`, the Bayes risk of the 0-1 loss is at most +`(P ∘ₘ π)(univ) - (∏ θ ∈ s, π {θ} ^ w θ) * ∫⁻ x, ∏ θ ∈ s, (dP_θ/d(P ∘ₘ π))(x) ^ w θ ∂(P ∘ₘ π)`. +For a finite parameter space, take `s = Finset.univ`. -/ +lemma bayesRisk_zeroOneLoss_le_sub_prod {s : Finset Θ} {w : Θ → ℝ} (hw : ∀ θ ∈ s, 0 ≤ w θ) + (hw_sum : ∑ θ ∈ s, w θ = 1) : + bayesRisk zeroOneLoss P π + ≤ (P ∘ₘ π) univ + - (∏ θ ∈ s, π {θ} ^ w θ) * ∫⁻ x, ∏ θ ∈ s, (P θ).rnDeriv (P ∘ₘ π) x ^ w θ ∂(P ∘ₘ π) := by + rw [bayesRisk_zeroOneLoss_eq_sub_rnDeriv] + refine tsub_le_tsub_left ?_ _ + rw [← lintegral_const_mul _ (Finset.measurable_prod _ fun θ _ ↦ + (Measure.measurable_rnDeriv _ _).pow_const _)] + refine lintegral_mono fun x ↦ ?_ + rw [← Finset.prod_mul_distrib, + Finset.prod_congr rfl fun θ hθ ↦ (ENNReal.mul_rpow_of_nonneg _ _ (hw θ hθ)).symm] + exact (ENNReal.prod_rpow_le_iSup _ hw hw_sum).trans (iSup₂_le fun θ _ ↦ le_iSup_of_le θ le_rfl) + +end Countable + +end ProbabilityTheory diff --git a/Statlib/ForMathlib/Probability/Distributions/Bernoulli.lean b/Statlib/ForMathlib/Probability/Distributions/Bernoulli.lean index 088d243..6b5b9e8 100644 --- a/Statlib/ForMathlib/Probability/Distributions/Bernoulli.lean +++ b/Statlib/ForMathlib/Probability/Distributions/Bernoulli.lean @@ -8,6 +8,7 @@ module public import Mathlib.Probability.Distributions.Bernoulli public import Mathlib.Probability.Kernel.Composition.CompNotation public import Mathlib.MeasureTheory.Measure.Decomposition.Lebesgue +public import Statlib.ForMathlib.MeasureTheory.Measure.Bool /-! # Bernoulli distribution: integrals, symmetry and the Bernoulli kernel @@ -24,19 +25,26 @@ 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)`. +* `bernoulliMeasure_eq_dirac_of_dirac_eq`: if `dirac x = dirac y`, then `Ber(x, y, p) = dirac x`. * `eq_bernoulliMeasure_real_true`: every probability measure on `Bool` is a Bernoulli distribution. +* `MeasureTheory.Measure.boolMeasure_ofReal_eq_bernoulliMeasure`: the prior + `boolMeasure (ENNReal.ofReal p) (ENNReal.ofReal (1 - p))` on `Bool` is `Ber(false, true, p)`. +* `bernoulliMeasure_eq_smul_add_smul`: a Bernoulli distribution whose parameter is a convex + combination of `a` and `b` is the corresponding mixture of `Ber(x, y, a)` and `Ber(x, y, b)`. * `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`. +* `bernoulliKernel_comp_eq_bernoulliMeasure`: the composition of `bernoulliKernel x y` with a + probability measure on the unit interval with mean `p` is `Ber(x, y, p)`. -/ @[expose] public section open MeasureTheory -open scoped ENNReal +open scoped ENNReal NNReal namespace unitInterval @@ -47,6 +55,10 @@ lemma coe_toNNReal_symm_eq_ofReal (p : I) : (toNNReal (σ p) : ℝ≥0∞) = ENNReal.ofReal (1 - p) := by rw [coe_toNNReal_eq_ofReal, coe_symm_eq] +/-- The inclusion of the unit interval in `ℝ` is integrable with respect to any finite measure. -/ +lemma integrable_coe (μ : Measure I) [IsFiniteMeasure μ] : Integrable (fun p : I ↦ (p : ℝ)) μ := + .of_bound (by fun_prop) 1 (ae_of_all _ fun p ↦ by simpa [abs_of_nonneg p.2.1] using p.2.2) + end unitInterval open unitInterval @@ -58,6 +70,13 @@ variable {𝓧 : Type*} [MeasurableSpace 𝓧] lemma bernoulliMeasure_swap (x y : 𝓧) (p : I) : Ber(y, x, σ p) = Ber(x, y, p) := by rw [bernoulliMeasure_def, bernoulliMeasure_def, symm_symm, add_comm] +/-- If no measurable set separates `x` and `y`, that is `dirac x = dirac y`, then +`Ber(x, y, p) = dirac x`. This generalizes `bernoulliMeasure_self_eq_dirac`. -/ +lemma bernoulliMeasure_eq_dirac_of_dirac_eq {x y : 𝓧} (h : Measure.dirac x = Measure.dirac y) + (p : I) : + Ber(x, y, p) = Measure.dirac x := by + simp [bernoulliMeasure_def, ← h, ← add_smul] + lemma lintegral_bernoulliMeasure [MeasurableSingletonClass 𝓧] (x y : 𝓧) (p : I) (f : 𝓧 → ℝ≥0∞) : ∫⁻ z, f z ∂Ber(x, y, p) = ENNReal.ofReal p * f x + ENNReal.ofReal (1 - p) * f y := by @@ -102,6 +121,22 @@ 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 +/-- A Bernoulli distribution whose parameter is a convex combination of `a` and `b` is the +corresponding mixture of Bernoulli distributions. -/ +lemma bernoulliMeasure_eq_smul_add_smul (x y : 𝓧) {a b c : I} {t : ℝ≥0} (ht : t ≤ 1) + (hc : (c : ℝ) = t * a + (1 - t) * b) : + Ber(x, y, c) = t • Ber(x, y, a) + (1 - t) • Ber(x, y, b) := by + have h1 : toNNReal c = t * toNNReal a + (1 - t) * toNNReal b := by + ext + simp [hc, NNReal.coe_sub ht] + have h2 : toNNReal (σ c) = t * toNNReal (σ a) + (1 - t) * toNNReal (σ b) := by + ext + simp only [coe_toNNReal, coe_symm_eq, hc, NNReal.coe_add, NNReal.coe_mul, + NNReal.coe_sub ht, NNReal.coe_one] + ring + simp only [bernoulliMeasure_def, smul_add, smul_smul, h1, h2, add_smul] + abel + /-! ### Densities of Bernoulli distributions The following lemmas are copied from LMLPapers @@ -179,11 +214,42 @@ interval is the integral of the identity. -/ lemma bernoulliKernel_comp_real_apply_singleton_left [MeasurableSingletonClass 𝓧] {x y : 𝓧} (hxy : x ≠ y) (μ : Measure I) [IsFiniteMeasure μ] : (bernoulliKernel x y ∘ₘ μ).real {x} = ∫ p, (p : ℝ) ∂μ := by - have h_int : Integrable (fun p : I ↦ (p : ℝ)) μ := - (integrable_const (1 : ℝ)).mono' (by fun_prop) - (ae_of_all _ fun p ↦ by rw [Real.norm_of_nonneg p.2.1]; exact p.2.2) rw [measureReal_def, bernoulliKernel_comp_apply_singleton_left hxy, - ← ofReal_integral_eq_lintegral_ofReal h_int (ae_of_all _ fun p ↦ p.2.1), + ← ofReal_integral_eq_lintegral_ofReal (integrable_coe μ) (ae_of_all _ fun p ↦ p.2.1), ENNReal.toReal_ofReal (integral_nonneg fun p ↦ p.2.1)] +/-- The composition of `bernoulliKernel x y` with a probability measure on the unit interval with +mean `p` is `Ber(x, y, p)`. -/ +lemma bernoulliKernel_comp_eq_bernoulliMeasure (x y : 𝓧) (μ : Measure I) [IsProbabilityMeasure μ] + {p : I} (hp : (p : ℝ) = ∫ q, (q : ℝ) ∂μ) : + bernoulliKernel x y ∘ₘ μ = Ber(x, y, p) := by + have h_int := integrable_coe μ + have h1 : ∫⁻ q, ENNReal.ofReal q ∂μ = ENNReal.ofReal p := by + rw [hp, ofReal_integral_eq_lintegral_ofReal h_int (ae_of_all _ fun q ↦ q.2.1)] + have h2 : ∫⁻ q, ENNReal.ofReal (1 - q) ∂μ = ENNReal.ofReal (1 - p) := by + have h_int' : Integrable (fun q : I ↦ 1 - (q : ℝ)) μ := (integrable_const 1).sub h_int + rw [← ofReal_integral_eq_lintegral_ofReal h_int' (ae_of_all _ fun q ↦ sub_nonneg.mpr q.2.2), + integral_sub (integrable_const 1) h_int, hp] + simp + ext s hs + rw [Measure.bind_apply hs (bernoulliKernel x y).aemeasurable] + simp_rw [bernoulliKernel_apply, bernoulliMeasure_def, Measure.add_apply, Measure.smul_apply, + ENNReal.smul_def, smul_eq_mul, coe_toNNReal_eq_ofReal, coe_symm_eq] + rw [lintegral_add_left (by fun_prop), lintegral_mul_const _ (by fun_prop), + lintegral_mul_const _ (by fun_prop), h1, h2] + end ProbabilityTheory + +namespace MeasureTheory.Measure + +open ProbabilityTheory + +/-- The prior `boolMeasure p (1 - p)` on `Bool` is the Bernoulli distribution +`Ber(false, true, p)`. -/ +lemma boolMeasure_ofReal_eq_bernoulliMeasure (p : I) : + boolMeasure (ENNReal.ofReal p) (ENNReal.ofReal (1 - p)) = Ber(false, true, p) := by + refine ext_bool ?_ ?_ + · rw [boolMeasure_apply_false, bernoulliMeasure_apply_singleton_left (by decide)] + · rw [boolMeasure_apply_true, bernoulliMeasure_apply_singleton_right (by decide)] + +end MeasureTheory.Measure diff --git a/Statlib/ForMathlib/Probability/Kernel/Basic.lean b/Statlib/ForMathlib/Probability/Kernel/Basic.lean new file mode 100644 index 0000000..977eadf --- /dev/null +++ b/Statlib/ForMathlib/Probability/Kernel/Basic.lean @@ -0,0 +1,33 @@ +/- +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.Probability.Kernel.Basic + +/-! +# The kernel `boolKernel μ μ` + +## Main statements + +* `ProbabilityTheory.Kernel.boolKernel_self`: `boolKernel μ μ` is the constant kernel with value + `μ`. +-/ + +@[expose] public section + +open MeasureTheory + +namespace ProbabilityTheory.Kernel + +variable {α : Type*} {mα : MeasurableSpace α} + +/-- The kernel `boolKernel μ μ` is the constant kernel with value `μ`. -/ +@[simp] +lemma boolKernel_self (μ : Measure α) : boolKernel μ μ = const Bool μ := by + ext b : 1 + cases b <;> rfl + +end ProbabilityTheory.Kernel diff --git a/Statlib/ForMathlib/Probability/Kernel/Composition/Lemmas.lean b/Statlib/ForMathlib/Probability/Kernel/Composition/Lemmas.lean new file mode 100644 index 0000000..159267f --- /dev/null +++ b/Statlib/ForMathlib/Probability/Kernel/Composition/Lemmas.lean @@ -0,0 +1,66 @@ +/- +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.Probability.Kernel.Composition.KernelLemmas +public import Mathlib.Probability.Kernel.Composition.Lemmas + +/-! +# Compositions of measures with parallel compositions of kernels + +Complements to `Mathlib.Probability.Kernel.Composition.Lemmas`. + +## Main statements + +* `MeasureTheory.Measure.fst_parallelComp_comp`, `MeasureTheory.Measure.snd_parallelComp_comp`: + the marginals of `(κ ∥ₖ η) ∘ₘ ρ` are `κ ∘ₘ ρ.fst` and `η ∘ₘ ρ.snd` (for Markov kernels `η`, + resp. `κ`). +* `MeasureTheory.Measure.prod_comp_comp`: `(κ ∘ₘ μ).prod (η ∘ₘ ν) = (κ ∥ₖ η) ∘ₘ (μ.prod ν)`. +-/ + +@[expose] public section + +open ProbabilityTheory + +namespace MeasureTheory.Measure + +variable {α β γ δ : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} + {mγ : MeasurableSpace γ} {mδ : MeasurableSpace δ} + +/-- The first marginal of `(κ ∥ₖ η) ∘ₘ ρ` is `κ ∘ₘ ρ.fst` when `η` is a Markov kernel. -/ +lemma fst_parallelComp_comp (ρ : Measure (α × β)) (κ : Kernel α γ) [IsSFiniteKernel κ] + (η : Kernel β δ) [IsMarkovKernel η] : + ((κ ∥ₖ η) ∘ₘ ρ).fst = κ ∘ₘ ρ.fst := by + ext s hs + rw [fst_apply hs, bind_apply (measurable_fst hs) (Kernel.aemeasurable _), + bind_apply hs (Kernel.aemeasurable _), Measure.fst, + lintegral_map (κ.measurable_coe hs) measurable_fst] + congr with p + rw [show Prod.fst ⁻¹' s = s ×ˢ (Set.univ : Set δ) by ext; simp, + Kernel.parallelComp_apply_prod] + simp + +/-- The second marginal of `(κ ∥ₖ η) ∘ₘ ρ` is `η ∘ₘ ρ.snd` when `κ` is a Markov kernel. -/ +lemma snd_parallelComp_comp (ρ : Measure (α × β)) (κ : Kernel α γ) [IsMarkovKernel κ] + (η : Kernel β δ) [IsSFiniteKernel η] : + ((κ ∥ₖ η) ∘ₘ ρ).snd = η ∘ₘ ρ.snd := by + ext s hs + rw [snd_apply hs, bind_apply (measurable_snd hs) (Kernel.aemeasurable _), + bind_apply hs (Kernel.aemeasurable _), Measure.snd, + lintegral_map (η.measurable_coe hs) measurable_snd] + congr with p + rw [show Prod.snd ⁻¹' s = (Set.univ : Set γ) ×ˢ s by ext; simp, + Kernel.parallelComp_apply_prod] + simp + +/-- The product of `κ ∘ₘ μ` and `η ∘ₘ ν` is the composition of `μ.prod ν` with `κ ∥ₖ η`. -/ +lemma prod_comp_comp (μ : Measure α) [SFinite μ] (ν : Measure β) [SFinite ν] + (κ : Kernel α γ) [IsSFiniteKernel κ] (η : Kernel β δ) [IsSFiniteKernel η] : + (κ ∘ₘ μ).prod (η ∘ₘ ν) = (κ ∥ₖ η) ∘ₘ (μ.prod ν) := by + rw [prod_comp_right, prod_comp_left, comp_assoc, Kernel.parallelComp_comp_parallelComp, + Kernel.id_comp, Kernel.comp_id] + +end MeasureTheory.Measure diff --git a/Statlib/ForMathlib/Probability/Kernel/Composition/MeasureCompProd.lean b/Statlib/ForMathlib/Probability/Kernel/Composition/MeasureCompProd.lean index e95c3ab..a1bb2db 100644 --- a/Statlib/ForMathlib/Probability/Kernel/Composition/MeasureCompProd.lean +++ b/Statlib/ForMathlib/Probability/Kernel/Composition/MeasureCompProd.lean @@ -17,6 +17,8 @@ public import Statlib.ForMathlib.Probability.Kernel.Composition.RadonNikodym ## Main statements +* `MeasureTheory.Measure.absolutelyContinuous_compProd_iff_fst`: + `ρ ≪ μ ⊗ₘ η ↔ ρ.fst ≪ μ ∧ ρ ≪ ρ.fst ⊗ₘ η` for a measure `ρ` on a product space. * `ProbabilityTheory.singularPart_compProd_left`, `ProbabilityTheory.singularPart_compProd`, `ProbabilityTheory.singularPart_compProd_right`: singular part of `μ ⊗ₘ κ` with respect to `ν ⊗ₘ η`. @@ -26,6 +28,8 @@ public import Statlib.ForMathlib.Probability.Kernel.Composition.RadonNikodym `f ((∂μ ⊗ₘ κ/∂ν ⊗ₘ η) x)` in terms of the integrability of its sections, for convex `f`. * `ProbabilityTheory.Measure.compProd_univ_toReal`: `((μ ⊗ₘ κ) univ).toReal` as a Bochner integral. +* `MeasureTheory.Measure.neZero_compProd`: `NeZero (μ ⊗ₘ κ)` for a nonzero `μ` and a Markov + kernel `κ`. This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli (https://github.com/RemyDegenne/testing-lower-bounds). @@ -51,6 +55,30 @@ lemma singularPart_compProd_left (μ ν : Measure α) [IsFiniteMeasure μ] [IsFi rw [this, add_zero, Measure.singularPart_eq_self] exact Measure.MutuallySingular.compProd_of_left (Measure.mutuallySingular_singularPart _ _) κ κ +/-- A measure `ρ` on a product space is absolutely continuous with respect to `μ ⊗ₘ η` if and only +if its first marginal is absolutely continuous with respect to `μ` and `ρ ≪ ρ.fst ⊗ₘ η`. -/ +lemma _root_.MeasureTheory.Measure.absolutelyContinuous_compProd_iff_fst {ρ : Measure (α × β)} + [IsFiniteMeasure ρ] {μ : Measure α} [SigmaFinite μ] {η : Kernel α β} [IsSFiniteKernel η] : + ρ ≪ μ ⊗ₘ η ↔ ρ.fst ≪ μ ∧ ρ ≪ ρ.fst ⊗ₘ η := by + -- `(ν ⊗ₘ η) (s ×ˢ univ) = 0` as soon as `ν s = 0` + have h_null {ν : Measure α} [SFinite ν] {s : Set α} (hs : MeasurableSet s) (hs0 : ν s = 0) : + (ν ⊗ₘ η) (Prod.fst ⁻¹' s) = 0 := by + rw [← Set.prod_univ, Measure.compProd_apply_prod hs .univ, setLIntegral_measure_zero _ _ hs0] + refine ⟨fun h ↦ ⟨?_, ?_⟩, fun h ↦ h.2.trans (h.1.compProd_left η)⟩ + · refine Measure.AbsolutelyContinuous.mk fun s hs hs0 ↦ ?_ + rw [Measure.fst_apply hs] + exact h (h_null hs hs0) + -- the part of `μ` singular with respect to `ρ.fst` is also singular with respect to `ρ` + have hs := Measure.mutuallySingular_singularPart μ ρ.fst + have h_ms : ρ ⟂ₘ μ.singularPart ρ.fst ⊗ₘ η := by + refine ⟨Prod.fst ⁻¹' hs.nullSetᶜ, measurable_fst hs.measurableSet_nullSet.compl, ?_, ?_⟩ + · rw [← Measure.fst_apply hs.measurableSet_nullSet.compl, hs.measure_compl_nullSet] + · rw [← Set.preimage_compl, compl_compl] + exact h_null hs.measurableSet_nullSet hs.measure_nullSet + rw [μ.haveLebesgueDecomposition_add ρ.fst, Measure.compProd_add_left, add_comm] at h + exact (Measure.absolutelyContinuous_of_add_of_mutuallySingular h h_ms).trans + ((withDensity_absolutelyContinuous _ _).compProd_left η) + section CompProd open Real Filter MeasurableSpace @@ -108,12 +136,15 @@ lemma singularPart_compProd (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteM rw [this] abel -lemma singularPart_compProd_right (μ : Measure α) [IsFiniteMeasure μ] +lemma singularPart_compProd_right (μ : Measure α) (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : - (μ ⊗ₘ κ).singularPart (μ ⊗ₘ η) = μ ⊗ₘ κ.singularPart η := by - rw [singularPart_compProd, Measure.singularPart_self, Measure.compProd_zero_left, zero_add] + (μ ⊗ₘ κ).singularPart (μ ⊗ₘ η) = μ ⊗ₘ κ.singularPart η := + (Measure.eq_singularPart (Kernel.measurable_rnDeriv κ η) + (Measure.MutuallySingular.compProd_of_right μ μ + (.of_forall <| Kernel.mutuallySingular_singularPart κ η)) + (compProd_eq_compProd_singularPart_add_withDensity μ κ η)).symm -lemma setLIntegral_singularPart (μ : Measure α) [IsFiniteMeasure μ] +lemma setLIntegral_singularPart (μ : Measure α) [SFinite μ] (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] {s : Set α} (hs : MeasurableSet s) {t : Set β} (ht : MeasurableSet t) : ∫⁻ a in s, (κ a).singularPart (η a) t ∂μ = (μ ⊗ₘ κ).singularPart (μ ⊗ₘ η) (s ×ˢ t) := by @@ -121,7 +152,7 @@ lemma setLIntegral_singularPart (μ : Measure α) [IsFiniteMeasure μ] simp only [Kernel.singularPart_eq_singularPart_measure] rw [lintegral_apply_prodMk_preimage (fun _ ↦ by simp) hs] -lemma lintegral_singularPart (μ : Measure α) [IsFiniteMeasure μ] +lemma lintegral_singularPart (μ : Measure α) [SFinite μ] (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] {s : Set β} (hs : MeasurableSet s) : ∫⁻ a, (κ a).singularPart (η a) s ∂μ = (μ ⊗ₘ κ).singularPart (μ ⊗ₘ η) (.univ ×ˢ s) := by @@ -244,7 +275,7 @@ lemma f_compProd_congr (μ ν : Measure α) [IsFiniteMeasure μ] [IsFiniteMeasur (κ η : 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' μ ν κ η + have h_eq_compProd := rnDeriv_measure_compProd' μ ν κ η filter_upwards [h_eq_compProd] with a ha filter_upwards [ha] with b hb rw [hb] @@ -302,6 +333,13 @@ lemma Measure.compProd_univ_toReal [SFinite μ] [IsFiniteKernel κ] : ((μ ⊗ₘ κ) .univ).toReal = ∫ x, (κ x .univ).toReal ∂μ := compProd_apply_toReal .univ +/-- The composition-product of a nonzero measure and a Markov kernel is nonzero. -/ +instance _root_.MeasureTheory.Measure.neZero_compProd [SFinite μ] [NeZero μ] [IsMarkovKernel κ] : + NeZero (μ ⊗ₘ κ) := + ⟨fun h ↦ NeZero.ne μ (by + rw [← Measure.measure_univ_eq_zero, ← Measure.compProd_apply_univ (κ := κ), h, + Measure.coe_zero, Pi.zero_apply])⟩ + end CompProd end ProbabilityTheory diff --git a/Statlib/ForMathlib/Probability/Kernel/Composition/RadonNikodym.lean b/Statlib/ForMathlib/Probability/Kernel/Composition/RadonNikodym.lean index 5738914..21860ec 100644 --- a/Statlib/ForMathlib/Probability/Kernel/Composition/RadonNikodym.lean +++ b/Statlib/ForMathlib/Probability/Kernel/Composition/RadonNikodym.lean @@ -5,17 +5,46 @@ Authors: Rémy Degenne, Lorenzo Luccioli -/ module +public import Mathlib.MeasureTheory.Function.ConditionalExpectation.RadonNikodym +public import Mathlib.Probability.Kernel.Composition.AbsolutelyContinuous +public import Mathlib.Probability.Kernel.Composition.MeasureComp public import Mathlib.Probability.Kernel.Composition.RadonNikodym +public import Mathlib.Probability.Kernel.Composition.WithDensity /-! -# Radon-Nikodym derivatives of composition-products, in "a.e. a, a.e. b" form +# Radon-Nikodym derivatives of compositions and composition-products -* `ProbabilityTheory.Kernel.rnDeriv_measure_compProd_right'`, - `ProbabilityTheory.Kernel.rnDeriv_measure_compProd'`: corollaries of the Mathlib results - `rnDeriv_measure_compProd_right` and `rnDeriv_measure_compProd`. +## Main statements + +* `ProbabilityTheory.rnDeriv_compProd'`: `∂(μ ⊗ₘ κ)/∂(ν ⊗ₘ η) = ∂μ/∂ν * ∂(μ ⊗ₘ κ)/∂(μ ⊗ₘ η)`, + without assumptions on the measurable spaces nor absolute continuity hypotheses. +* `ProbabilityTheory.rnDeriv_compProd_of_absolutelyContinuous`: for `ρ ≪ μ`, + `∂(ρ ⊗ₘ κ)/∂(ρ ⊗ₘ η) = ∂(μ ⊗ₘ κ)/∂(μ ⊗ₘ η)`, `ρ ⊗ₘ η`-almost everywhere. +* `MeasureTheory.Measure.sigmaFinite_compProd`: `μ ⊗ₘ κ` is σ-finite for a σ-finite `μ` and a + finite kernel `κ`. +* `ProbabilityTheory.compProd_eq_compProd_singularPart_add_withDensity`: Lebesgue decomposition of + `μ ⊗ₘ κ` with respect to `μ ⊗ₘ η`. +* `ProbabilityTheory.rnDeriv_measure_compProd_right_of_sigmaFinite`: Mathlib's + `rnDeriv_measure_compProd_right`, `∂(μ ⊗ₘ κ)/∂(μ ⊗ₘ η) = ∂κ/∂η`, for a σ-finite measure `μ`. +* `ProbabilityTheory.rnDeriv_measure_compProd_right'`, + `ProbabilityTheory.rnDeriv_measure_compProd'`: corollaries of + `rnDeriv_measure_compProd_right_of_sigmaFinite` and of the Mathlib result + `rnDeriv_measure_compProd`, in "a.e. a, a.e. b" form. +* `ProbabilityTheory.toReal_rnDeriv_comp_ae_eq_condExp`: the Radon-Nikodym derivative + `∂(κ ∘ₘ μ)/∂(η ∘ₘ ν)`, evaluated at the second coordinate, is the conditional expectation of + `∂(μ ⊗ₘ κ)/∂(ν ⊗ₘ η)` given the second coordinate. +* `ProbabilityTheory.toReal_rnDeriv_comp_ae_eq_condExp_right`: the Radon-Nikodym derivative + `∂(κ ∘ₘ μ)/∂(κ ∘ₘ ν)`, evaluated at the second coordinate, is the conditional expectation of + `(x, y) ↦ ∂μ/∂ν x` given the second coordinate (see [Csiszár, 1963]). This file is adapted from the testing-lower-bounds project of Rémy Degenne and Lorenzo Luccioli (https://github.com/RemyDegenne/testing-lower-bounds). + +## References + +* I. Csiszár, *Eine informationstheoretische Ungleichung und ihre Anwendung auf den Beweis der + Ergodizität von Markoffschen Ketten*, A Magyar Tudományos Akadémia Matematikai Kutató + Intézetének Közleményei 8 (1963), 85–108. -/ @[expose] public section @@ -24,24 +53,123 @@ open MeasureTheory MeasurableSpace Set open scoped ENNReal -namespace ProbabilityTheory.Kernel +namespace ProbabilityTheory + +variable {α β : Type*} {mα : MeasurableSpace α} {mβ : MeasurableSpace β} {μ ν : Measure α} + {κ η : Kernel α β} + +/-- The composition-product of a σ-finite measure and a finite kernel is σ-finite. -/ +instance _root_.MeasureTheory.Measure.sigmaFinite_compProd [SigmaFinite μ] [IsFiniteKernel κ] : + SigmaFinite (μ ⊗ₘ κ) := by + refine ⟨⟨⟨fun n ↦ spanningSets μ n ×ˢ Set.univ, fun _ ↦ trivial, fun n ↦ ?_, ?_⟩⟩⟩ + · rw [Measure.compProd_apply_prod (measurableSet_spanningSets μ n) .univ] + calc ∫⁻ a in spanningSets μ n, κ a .univ ∂μ + _ ≤ ∫⁻ _ in spanningSets μ n, κ.bound ∂μ := + lintegral_mono fun a ↦ Kernel.measure_le_bound κ a .univ + _ < ∞ := by + rw [setLIntegral_const] + exact ENNReal.mul_lt_top κ.bound_lt_top (measure_spanningSets_lt_top μ n) + · rw [← Set.iUnion_prod_const, iUnion_spanningSets, Set.univ_prod_univ] + +/-- The Radon-Nikodym derivative `∂(μ ⊗ₘ κ)/∂(ν ⊗ₘ η)` is the product of `∂μ/∂ν` and +`∂(μ ⊗ₘ κ)/∂(μ ⊗ₘ η)`. This is Mathlib's `rnDeriv_compProd` without its hypothesis +`μ ⊗ₘ κ ≪ μ ⊗ₘ η`. -/ +lemma rnDeriv_compProd' (μ ν : Measure α) (κ η : Kernel α β) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] [IsFiniteKernel κ] [IsFiniteKernel η] : + (μ ⊗ₘ κ).rnDeriv (ν ⊗ₘ η) =ᵐ[ν ⊗ₘ η] + fun p ↦ μ.rnDeriv ν p.1 * (μ ⊗ₘ κ).rnDeriv (μ ⊗ₘ η) p := by + -- the part of `μ ⊗ₘ κ` singular with respect to `μ ⊗ₘ η` is also singular with respect to + -- `ν ⊗ₘ η`, whose part absolutely continuous with respect to `μ ⊗ₘ η` comes from `ν`'s part + -- absolutely continuous with respect to `μ` + have h_sing : (μ ⊗ₘ κ).singularPart (μ ⊗ₘ η) ⟂ₘ ν ⊗ₘ η := by + have hν : ν ⊗ₘ η = ν.singularPart μ ⊗ₘ η + μ.withDensity (ν.rnDeriv μ) ⊗ₘ η := by + rw [← Measure.compProd_add_left, ← ν.haveLebesgueDecomposition_add μ] + rw [hν] + refine Measure.MutuallySingular.add_right ?_ ?_ + · exact ((Measure.mutuallySingular_singularPart ν μ).symm.compProd_of_left κ η).mono_ac + (Measure.absolutelyContinuous_of_le (Measure.singularPart_le _ _)) .rfl + · exact (Measure.mutuallySingular_singularPart _ _).mono_ac .rfl + ((withDensity_absolutelyContinuous _ _).compProd_left η) + have h_add := Measure.rnDeriv_add' ((μ ⊗ₘ κ).singularPart (μ ⊗ₘ η)) + ((μ ⊗ₘ η).withDensity ((μ ⊗ₘ κ).rnDeriv (μ ⊗ₘ η))) (ν ⊗ₘ η) + rw [← (μ ⊗ₘ κ).haveLebesgueDecomposition_add (μ ⊗ₘ η)] at h_add + filter_upwards [h_add, Measure.rnDeriv_eq_zero_of_mutuallySingular h_sing .rfl, + Measure.rnDeriv_withDensity_left (μ := μ ⊗ₘ η) (ν := ν ⊗ₘ η) + (Measure.measurable_rnDeriv _ _).aemeasurable (Measure.rnDeriv_ne_top (μ ⊗ₘ κ) _), + rnDeriv_measure_compProd_left μ ν η] with p h1 h2 h3 h4 + rw [h1, Pi.add_apply, h2, h3, h4, Pi.zero_apply, zero_add, mul_comm] + +/-- If `ρ ≪ μ`, then `∂(ρ ⊗ₘ κ)/∂(ρ ⊗ₘ η)` is `ρ ⊗ₘ η`-almost everywhere equal to +`∂(μ ⊗ₘ κ)/∂(μ ⊗ₘ η)`. -/ +lemma rnDeriv_compProd_of_absolutelyContinuous {ρ : Measure α} [IsFiniteMeasure ρ] + [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] (hρμ : ρ ≪ μ) : + (ρ ⊗ₘ κ).rnDeriv (ρ ⊗ₘ η) =ᵐ[ρ ⊗ₘ η] (μ ⊗ₘ κ).rnDeriv (μ ⊗ₘ η) := by + -- with `h = ∂ρ/∂μ`, `ρ ⊗ₘ κ` is `μ ⊗ₘ κ` with density `h ∘ fst`, and the same for `η`: both + -- derivatives with respect to `μ ⊗ₘ η` are `h ∘ fst` times the derivatives of the statement + have hρ (ξ : Kernel α β) [IsFiniteKernel ξ] : + ρ ⊗ₘ ξ = (μ ⊗ₘ ξ).withDensity (fun p ↦ ρ.rnDeriv μ p.1) := by + conv_lhs => rw [← Measure.withDensity_rnDeriv_eq ρ μ hρμ] + exact Measure.withDensity_compProd (Measure.measurable_rnDeriv ρ μ) + have h_top : ∀ᵐ p ∂(μ ⊗ₘ η), ρ.rnDeriv μ p.1 ≠ ∞ := + Measure.ae_compProd_of_ae_fst η ((Measure.measurable_rnDeriv ρ μ) + (measurableSet_singleton ∞).compl) (Measure.rnDeriv_ne_top ρ μ) + have h_top' : ∀ᵐ p ∂(μ ⊗ₘ κ), ρ.rnDeriv μ p.1 ≠ ∞ := + Measure.ae_compProd_of_ae_fst κ ((Measure.measurable_rnDeriv ρ μ) + (measurableSet_singleton ∞).compl) (Measure.rnDeriv_ne_top ρ μ) + have h_eq : ∀ᵐ p ∂(μ ⊗ₘ η), ρ.rnDeriv μ p.1 ≠ 0 → + (ρ ⊗ₘ κ).rnDeriv (ρ ⊗ₘ η) p = (μ ⊗ₘ κ).rnDeriv (μ ⊗ₘ η) p := by + have h2 : (ρ ⊗ₘ κ).rnDeriv (μ ⊗ₘ η) =ᵐ[μ ⊗ₘ η] + fun p ↦ ρ.rnDeriv μ p.1 * (μ ⊗ₘ κ).rnDeriv (μ ⊗ₘ η) p := by + rw [hρ κ] + exact Measure.rnDeriv_withDensity_left (by fun_prop) h_top' + filter_upwards [rnDeriv_compProd' ρ μ κ η, h2, h_top] with p hp1 hp2 hp_top hp0 + exact (ENNReal.mul_right_inj hp0 hp_top).mp (hp1.symm.trans hp2) + rw [hρ η, Filter.EventuallyEq, ae_withDensity_iff (by fun_prop)] + rwa [← hρ η] -variable {α γ : Type*} {mα : MeasurableSpace α} {mγ : MeasurableSpace γ} - {μ ν : Measure α} {κ η : Kernel α γ} +section CountableOrCountablyGenerated -variable [CountableOrCountablyGenerated α γ] +variable [CountableOrCountablyGenerated α β] -lemma rnDeriv_measure_compProd_right' (μ : Measure α) (κ η : Kernel α γ) - [IsFiniteMeasure μ] [IsFiniteKernel κ] [IsFiniteKernel η] : +/-- Lebesgue decomposition of `μ ⊗ₘ κ` with respect to `μ ⊗ₘ η`: the singular part is +`μ ⊗ₘ κ.singularPart η` and the density is `(a, b) ↦ ∂κ/∂η a b`. -/ +lemma compProd_eq_compProd_singularPart_add_withDensity (μ : Measure α) + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + μ ⊗ₘ κ = μ ⊗ₘ κ.singularPart η + (μ ⊗ₘ η).withDensity (fun p ↦ κ.rnDeriv η p.1 p.2) := by + by_cases hμ : SFinite μ + swap; · simp [Measure.compProd_of_not_sfinite _ _ hμ] + conv_lhs => rw [← Kernel.rnDeriv_add_singularPart κ η] + rw [Measure.compProd_add_right, add_comm, + Measure.compProd_withDensity (Kernel.measurable_rnDeriv κ η)] + +/-- The Radon-Nikodym derivative `∂(μ ⊗ₘ κ)/∂(μ ⊗ₘ η)` (with the same measure) equals `∂κ/∂η`. +This is Mathlib's `rnDeriv_measure_compProd_right` for a σ-finite instead of finite measure `μ`. + +σ-finiteness cannot be weakened to s-finiteness: for `μ = ∞ • Measure.dirac a`, the measure +`μ ⊗ₘ η` is not σ-finite and densities with respect to it are not unique. -/ +lemma rnDeriv_measure_compProd_right_of_sigmaFinite (μ : Measure α) [SigmaFinite μ] + (κ η : Kernel α β) [IsFiniteKernel κ] [IsFiniteKernel η] : + (μ ⊗ₘ κ).rnDeriv (μ ⊗ₘ η) =ᵐ[μ ⊗ₘ η] fun p ↦ κ.rnDeriv η p.1 p.2 := + (Measure.eq_rnDeriv (Kernel.measurable_rnDeriv κ η) + (Measure.MutuallySingular.compProd_of_right μ μ + (.of_forall <| Kernel.mutuallySingular_singularPart κ η)) + (compProd_eq_compProd_singularPart_add_withDensity μ κ η)).symm + +/-- Version of `rnDeriv_measure_compProd_right_of_sigmaFinite` in "a.e. a, a.e. b" form: for +`μ`-almost every `a`, `b ↦ ∂(μ ⊗ₘ κ)/∂(μ ⊗ₘ η) (a, b)` is `η a`-a.e. equal to `∂(κ a)/∂(η a)`. -/ +lemma rnDeriv_measure_compProd_right' (μ : Measure α) [SigmaFinite μ] (κ η : Kernel α β) + [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 μ κ η + have h' := Measure.ae_ae_of_ae_compProd <| rnDeriv_measure_compProd_right_of_sigmaFinite μ κ η filter_upwards [h'] with a ha filter_upwards [ha, h a] with b hb1 hb2 rw [hb1, hb2] -lemma rnDeriv_measure_compProd' (μ ν : Measure α) (κ η : Kernel α γ) +/-- Version of `rnDeriv_measure_compProd` in "a.e. a, a.e. b" form: for `ν`-almost every `a`, +`b ↦ ∂(μ ⊗ₘ κ)/∂(ν ⊗ₘ η) (a, b)` is `η a`-a.e. equal to `∂μ/∂ν a * ∂(κ a)/∂(η a) b`. -/ +lemma rnDeriv_measure_compProd' (μ ν : Measure α) (κ η : Kernel α β) [IsFiniteMeasure μ] [IsFiniteMeasure ν] [IsFiniteKernel κ] [IsFiniteKernel η] : ∀ᵐ a ∂ν, (fun b ↦ (∂(μ ⊗ₘ κ)/∂(ν ⊗ₘ η)) (a, b)) =ᵐ[η a] fun b ↦ (∂μ/∂ν) a * (∂κ a/∂η a) b := by @@ -51,4 +179,29 @@ lemma rnDeriv_measure_compProd' (μ ν : Measure α) (κ η : Kernel α γ) filter_upwards [ha, h a] with b hb1 hb2 rw [hb1, hb2] -end ProbabilityTheory.Kernel +end CountableOrCountablyGenerated + +/-- The Radon-Nikodym derivative `∂(κ ∘ₘ μ)/∂(η ∘ₘ ν)`, evaluated at the second coordinate, is +the conditional expectation of `∂(μ ⊗ₘ κ)/∂(ν ⊗ₘ η)` given the second coordinate. + +The absolute continuity hypothesis holds for example if `μ ≪ ν` and `κ a ≪ η a` for `μ`-almost +every `a` (see `MeasureTheory.Measure.AbsolutelyContinuous.compProd`). -/ +lemma toReal_rnDeriv_comp_ae_eq_condExp [IsFiniteMeasure μ] [IsFiniteMeasure ν] + [IsFiniteKernel κ] [IsFiniteKernel η] (h_ac : μ ⊗ₘ κ ≪ ν ⊗ₘ η) : + (fun p : α × β ↦ ((κ ∘ₘ μ).rnDeriv (η ∘ₘ ν) p.2).toReal) + =ᵐ[ν ⊗ₘ η] (ν ⊗ₘ η)[fun p ↦ ((μ ⊗ₘ κ).rnDeriv (ν ⊗ₘ η) p).toReal | mβ.comap Prod.snd] := by + have h := toReal_rnDeriv_map h_ac measurable_snd + rwa [← Measure.snd, ← Measure.snd, Measure.snd_compProd, Measure.snd_compProd] at h + +/-- The Radon-Nikodym derivative `∂(κ ∘ₘ μ)/∂(κ ∘ₘ ν)`, evaluated at the second coordinate, is the +conditional expectation of `(x, y) ↦ ∂μ/∂ν x` given the second coordinate. -/ +lemma toReal_rnDeriv_comp_ae_eq_condExp_right [IsFiniteMeasure μ] [IsFiniteMeasure ν] + [IsFiniteKernel κ] (hμν : μ ≪ ν) : + (fun p : α × β ↦ ((κ ∘ₘ μ).rnDeriv (κ ∘ₘ ν) p.2).toReal) + =ᵐ[ν ⊗ₘ κ] (ν ⊗ₘ κ)[fun p ↦ (μ.rnDeriv ν p.1).toReal | mβ.comap Prod.snd] := by + refine (toReal_rnDeriv_comp_ae_eq_condExp (hμν.compProd_left κ)).trans ?_ + refine condExp_congr_ae ?_ + filter_upwards [rnDeriv_measure_compProd_left μ ν κ] with p hp + rw [hp] + +end ProbabilityTheory diff --git a/Statlib/ForMathlib/Probability/Kernel/Posterior.lean b/Statlib/ForMathlib/Probability/Kernel/Posterior.lean new file mode 100644 index 0000000..6be3cdc --- /dev/null +++ b/Statlib/ForMathlib/Probability/Kernel/Posterior.lean @@ -0,0 +1,38 @@ +/- +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.Probability.Kernel.Posterior + +/-! +# Bayes' formula for the posterior of a singleton + +## Main statements + +* `ProbabilityTheory.posterior_singleton_ae_eq`: for a countable parameter space, + `(P†π) x {z} = π {z} * (dP_z/d(P ∘ₘ π))(x)` for `(P ∘ₘ π)`-almost every `x`. +-/ + +@[expose] public section + +open MeasureTheory + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {Θ 𝓧 : Type*} {mΘ : MeasurableSpace Θ} {m𝓧 : MeasurableSpace 𝓧} [StandardBorelSpace Θ] + [Nonempty Θ] + +/-- **Bayes' formula** for the posterior probability of a parameter, for a countable parameter +space. -/ +lemma posterior_singleton_ae_eq [Countable Θ] (P : Kernel Θ 𝓧) [IsFiniteKernel P] (π : Measure Θ) + [IsFiniteMeasure π] : + ∀ᵐ x ∂(P ∘ₘ π), ∀ z, (P†π) x {z} = π {z} * (P z).rnDeriv (P ∘ₘ π) x := by + filter_upwards [posterior_eq_withDensity_of_countable P π] with x hx z + rw [hx, withDensity_apply _ (measurableSet_singleton z), lintegral_singleton, mul_comm] + +end ProbabilityTheory diff --git a/Statlib/ForMathlib/Probability/Moments/Variance.lean b/Statlib/ForMathlib/Probability/Moments/Variance.lean new file mode 100644 index 0000000..5e716d2 --- /dev/null +++ b/Statlib/ForMathlib/Probability/Moments/Variance.lean @@ -0,0 +1,52 @@ +/- +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.Probability.Moments.Variance + +/-! +# A one-sided Chebyshev bound + +## Main statements + +* `ProbabilityTheory.measure_sqrt_variance_mul_lt_sub_le`: the probability that `X` exceeds its + mean by more than `√(Var[X] * β)` is at most `β⁻¹`. Mathlib has the two-sided bounds + `meas_ge_le_variance_div_sq` and `meas_ge_le_evariance_div_sq`. +-/ + +@[expose] public section + +open MeasureTheory Real + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {Ω : Type*} {mΩ : MeasurableSpace Ω} {P : Measure Ω} {X : Ω → ℝ} + +/-- **One-sided Chebyshev-type bound**: the probability that `X` exceeds its mean by more than +`√(Var[X] * β)` is at most `β⁻¹`. -/ +lemma measure_sqrt_variance_mul_lt_sub_le [IsFiniteMeasure P] (hX : MemLp X 2 P) {β : ℝ} + (hβ : 0 < β) : + P {ω | √(variance X P * β) < X ω - P[X]} ≤ ENNReal.ofReal β⁻¹ := by + rcases (variance_nonneg X P).eq_or_lt with h_var | h_var + · -- if the variance is zero, `X` is a.e. equal to its mean + have h_ae : X =ᵐ[P] fun _ ↦ P[X] := by + rw [← evariance_eq_zero_iff hX.aestronglyMeasurable.aemeasurable, ← hX.ofReal_variance_eq, + ← h_var, ENNReal.ofReal_zero] + suffices P {ω | √(variance X P * β) < X ω - P[X]} = 0 by rw [this]; exact zero_le + rw [measure_eq_zero_iff_ae_notMem] + filter_upwards [h_ae] with ω hω + simp [hω, ← h_var] + · have hc : 0 < √(variance X P * β) := sqrt_pos.mpr (mul_pos h_var hβ) + calc P {ω | √(variance X P * β) < X ω - P[X]} + _ ≤ P {ω | √(variance X P * β) ≤ |X ω - P[X]|} := + measure_mono fun ω (hω : _ < _) ↦ hω.le.trans (le_abs_self _) + _ ≤ ENNReal.ofReal (variance X P / √(variance X P * β) ^ 2) := meas_ge_le_variance_div_sq hX hc + _ = ENNReal.ofReal β⁻¹ := by + rw [sq_sqrt (mul_pos h_var hβ).le, div_mul_eq_div_div, div_self h_var.ne', one_div] + +end ProbabilityTheory diff --git a/Statlib/ForMathlib/Probability/Process/Filtration.lean b/Statlib/ForMathlib/Probability/Process/Filtration.lean new file mode 100644 index 0000000..b85c14e --- /dev/null +++ b/Statlib/ForMathlib/Probability/Process/Filtration.lean @@ -0,0 +1,46 @@ +/- +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.Probability.Process.Filtration + +/-! +# Filtrations of finitely many coordinates + +## Main statements + +* `MeasureTheory.Filtration.iSup_piFinset_eq_pi`: for a family of finite sets `s n` covering the + index set, the σ-algebras `Filtration.piFinset (s n)` of events depending only on the coordinates + in `s n` generate the product σ-algebra. +* `MeasureTheory.Filtration.measurable_piLE_apply`: the coordinate `i` is measurable with respect + to `Filtration.piLE j` for `i ≤ j`. +-/ + +@[expose] public section + +open MeasurableSpace + +namespace MeasureTheory.Filtration + +/-- The σ-algebras of events depending only on the coordinates in `s n`, for a family of finite sets +`s n` covering the index set, generate the product σ-algebra. -/ +lemma iSup_piFinset_eq_pi {ι κ : Type*} {X : ι → Type*} [∀ i, MeasurableSpace (X i)] + {s : κ → Finset ι} (hs : ∀ i, ∃ n, i ∈ s n) : + ⨆ n, piFinset (X := X) (s n) = pi := by + refine le_antisymm (iSup_le fun n ↦ piFinset.le (s n)) (iSup_le fun i ↦ ?_) + obtain ⟨n, hn⟩ := hs i + -- the evaluation at `i` is the evaluation at `⟨i, hn⟩` of the restriction to `s n` + exact le_iSup_of_le n + ((measurable_pi_apply (⟨i, hn⟩ : s n)).comp (comap_measurable (s n).restrict)).comap_le + +/-- The coordinate `i` of `ω : Π i, X i` is measurable with respect to `Filtration.piLE j` for +`i ≤ j`. -/ +lemma measurable_piLE_apply {ι : Type*} [Preorder ι] {X : ι → Type*} [∀ i, MeasurableSpace (X i)] + {i j : ι} (hij : i ≤ j) : + Measurable[piLE (X := X) j] fun ω ↦ ω i := + (measurable_pi_apply (⟨i, hij⟩ : Set.Iic j)).comp (comap_measurable (Preorder.restrictLe j)) + +end MeasureTheory.Filtration diff --git a/Statlib/ForMathlib/Probability/Process/PartitionFiltration.lean b/Statlib/ForMathlib/Probability/Process/PartitionFiltration.lean new file mode 100644 index 0000000..8855e15 --- /dev/null +++ b/Statlib/ForMathlib/Probability/Process/PartitionFiltration.lean @@ -0,0 +1,44 @@ +/- +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.Probability.Process.PartitionFiltration + +/-! +# Finiteness of the σ-algebras of partition filtrations + +## Main statements + +* `ProbabilityTheory.finite_setOf_measurableSet_partitionFiltration`: the σ-algebras of the + filtration `partitionFiltration ht` generated by the partitions `memPartition t n` have finitely + many measurable sets. +* `ProbabilityTheory.finite_setOf_measurableSet_countableFiltration`: the same for the filtration + `countableFiltration α` of a countably generated measurable space. +-/ + +@[expose] public section + +open MeasureTheory MeasurableSpace + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} + +/-- The σ-algebras of the filtration `partitionFiltration ht` have finitely many measurable sets. -/ +lemma finite_setOf_measurableSet_partitionFiltration {t : ℕ → Set α} + (ht : ∀ n, MeasurableSet (t n)) (n : ℕ) : + {s | MeasurableSet[partitionFiltration ht n] s}.Finite := by + refine ((finite_memPartition t n).finite_subsets.image fun S ↦ ⋃₀ S).subset fun s hs ↦ ?_ + obtain ⟨S, hS, rfl⟩ := (measurableSet_generateFrom_memPartition_iff t n s).1 hs + exact ⟨S, hS, rfl⟩ + +/-- The σ-algebras of the filtration `countableFiltration α` have finitely many measurable sets. -/ +lemma finite_setOf_measurableSet_countableFiltration [CountablyGenerated α] (n : ℕ) : + {s | MeasurableSet[countableFiltration α n] s}.Finite := + finite_setOf_measurableSet_partitionFiltration + (measurableSet_enumerateCountable_countableGeneratingSet α) n + +end ProbabilityTheory diff --git a/Statlib/ForMathlib/Probability/Process/Stopping.lean b/Statlib/ForMathlib/Probability/Process/Stopping.lean new file mode 100644 index 0000000..ff260c8 --- /dev/null +++ b/Statlib/ForMathlib/Probability/Process/Stopping.lean @@ -0,0 +1,79 @@ +/- +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.Probability.Process.Stopping + +/-! +# Stopping times that never take the value `⊤` + +## Main statements + +* `MeasureTheory.measurable_of_isStoppingTime`: a stopping time with values in a countable index + type `ι` is measurable. +* `MeasureTheory.trim_stoppingTime_eq_withDensity`: for a filtration `ℱ` indexed by `ℕ`, if the + restriction of `P` to `ℱ n` has density `L n` with respect to the restriction of `Q` for all `n`, + then the restriction of `P` to the σ-algebra of a stopping time `τ` has density + `ω ↦ L (τ ω) ω`. + +## Implementation notes + +The stopping time `τ` takes values in the index type `ι` (`ℕ` for the second statement) and the +stopping time property is stated for its coercion `fun ω ↦ (τ ω : WithTop ι)`, as required by +`MeasureTheory.IsStoppingTime`. +-/ + +@[expose] public section + +open scoped ENNReal + +namespace MeasureTheory + +/-- A stopping time with values in a countable index type `ι` is measurable. -/ +lemma measurable_of_isStoppingTime {Ω ι : Type*} {mΩ : MeasurableSpace Ω} [PartialOrder ι] + [Countable ι] [MeasurableSpace ι] {ℱ : Filtration ι mΩ} {τ : Ω → ι} + (hτ : IsStoppingTime ℱ (fun ω ↦ (τ ω : WithTop ι))) : + Measurable τ := by + refine measurable_to_countable' fun n ↦ ?_ + have h := ℱ.le n _ (hτ.measurableSet_eq_of_countable n) + simpa [Set.preimage, Set.mem_singleton_iff] using h + +/-- Let `τ` be a stopping time with values in `ℕ`. If for all `n`, the restriction of `P` to the +σ-algebra `ℱ n` has density `L n` with respect to the restriction of `Q`, then the restriction of +`P` to the σ-algebra of `τ` has density `ω ↦ L (τ ω) ω` with respect to the restriction of `Q`. -/ +lemma trim_stoppingTime_eq_withDensity {Ω : Type*} {mΩ : MeasurableSpace Ω} + {ℱ : Filtration ℕ mΩ} {P Q : Measure Ω} {L : ℕ → Ω → ℝ≥0∞} + (hL : ∀ n, Measurable[ℱ n] (L n)) + (hPQ : ∀ n, P.trim (ℱ.le n) = (Q.trim (ℱ.le n)).withDensity (L n)) {τ : Ω → ℕ} + (hτ : IsStoppingTime ℱ (fun ω ↦ (τ ω : WithTop ℕ))) : + P.trim hτ.measurableSpace_le + = (Q.trim hτ.measurableSpace_le).withDensity fun ω ↦ L (τ ω) ω := by + have hL_τ : Measurable[hτ.measurableSpace] fun ω ↦ L (τ ω) ω := + measurable_stoppedValue (StronglyAdapted.isStronglyProgressive_of_discrete + fun n ↦ (hL n).stronglyMeasurable) hτ + refine @Measure.ext _ hτ.measurableSpace _ _ fun E hE ↦ ?_ + -- `E` is the disjoint union of the events `E ∩ {τ = n}`, which are measurable at time `n` + have h_meas (n : ℕ) : MeasurableSet[ℱ n] (E ∩ {ω | τ ω = n}) := by + simpa using (hτ.measurableSet_inter_eq_iff E n).mp + (hE.inter (hτ.measurableSet_eq_of_countable' n)) + have h_meas' (n : ℕ) : MeasurableSet (E ∩ {ω | τ ω = n}) := ℱ.le n _ (h_meas n) + have h_union : E = ⋃ n, E ∩ {ω | τ ω = n} := by + ext ω; simp + have h_disj : Pairwise (Function.onFun Disjoint fun n ↦ E ∩ {ω | τ ω = n}) := by + intro n m hnm + refine Set.disjoint_left.mpr fun ω hω hω' ↦ hnm ?_ + rw [← hω.2, ← hω'.2] + rw [trim_measurableSet_eq _ hE, withDensity_apply _ hE, setLIntegral_trim _ hL_τ hE, h_union, + measure_iUnion h_disj h_meas', lintegral_iUnion h_meas' h_disj] + congr with n + have h_n := congr($(hPQ n) (E ∩ {ω | τ ω = n})) + rw [trim_measurableSet_eq _ (h_meas n), withDensity_apply _ (h_meas n), + setLIntegral_trim _ (hL n) (h_meas n)] at h_n + rw [h_n] + refine setLIntegral_congr_fun (h_meas' n) fun ω hω ↦ ?_ + rw [hω.2] + +end MeasureTheory diff --git a/Statlib/ForMathlib/Probability/ProductMeasure.lean b/Statlib/ForMathlib/Probability/ProductMeasure.lean new file mode 100644 index 0000000..14ca2f3 --- /dev/null +++ b/Statlib/ForMathlib/Probability/ProductMeasure.lean @@ -0,0 +1,45 @@ +/- +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.Probability.ProductMeasure + +/-! +# Infinite product measures + +## Main statements + +* `MeasureTheory.integral_comp_eval_infinitePi`: the integral of a function of the coordinate `i` + under `Measure.infinitePi μ` is its integral against `μ i`. This is the analogue of Mathlib's + `MeasureTheory.integral_comp_eval` for finite products. +* `MeasureTheory.Measure.infinitePi_map_restrictLe`: the law of the coordinates `≤ n` under + `Measure.infinitePi μ` is the finite product measure. +-/ + +@[expose] public section + +namespace MeasureTheory + +variable {ι : Type*} {X : ι → Type*} {mX : ∀ i, MeasurableSpace (X i)} + {μ : (i : ι) → Measure (X i)} [∀ i, IsProbabilityMeasure (μ i)] + +/-- The integral of a function of the coordinate `i` under `Measure.infinitePi μ` is its integral +against `μ i`. -/ +lemma integral_comp_eval_infinitePi {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] {i : ι} + {f : X i → E} (hf : AEStronglyMeasurable f (μ i)) : + ∫ x, f (x i) ∂Measure.infinitePi μ = ∫ x, f x ∂μ i := by + rw [← (measurePreserving_eval_infinitePi μ i).map_eq, integral_map] + · exact Measurable.aemeasurable (by fun_prop) + · rwa [(measurePreserving_eval_infinitePi μ i).map_eq] + +/-- The law of the coordinates `≤ n` under the product measure `Measure.infinitePi μ` is the finite +product measure. -/ +lemma Measure.infinitePi_map_restrictLe [Preorder ι] [LocallyFiniteOrderBot ι] + (μ : (i : ι) → Measure (X i)) [∀ i, IsProbabilityMeasure (μ i)] (n : ι) : + (Measure.infinitePi μ).map (Preorder.restrictLe n) = Measure.pi fun i : Set.Iic n ↦ μ i := by + rw [Preorder.restrictLe, Measure.infinitePi_map_restrict', Measure.infinitePi_eq_pi] + +end MeasureTheory diff --git a/Statlib/ForMathlib/Probability/StrongLaw.lean b/Statlib/ForMathlib/Probability/StrongLaw.lean new file mode 100644 index 0000000..ed023ca --- /dev/null +++ b/Statlib/ForMathlib/Probability/StrongLaw.lean @@ -0,0 +1,122 @@ +/- +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.Probability.Independence.InfinitePi +public import Mathlib.Probability.Independence.Integrable +public import Mathlib.Probability.StrongLaw +public import Statlib.ForMathlib.Probability.ProductMeasure + +/-! +# Weak law of large numbers + +## Main statements + +* `ProbabilityTheory.weak_law_tendstoInMeasure`: **weak law of large numbers**, for a sequence of + pairwise independent identically distributed integrable random variables with values in a Banach + space: the empirical means converge in measure to the mean. It is deduced from Mathlib's strong + law `ProbabilityTheory.strong_law_ae`. +* `ProbabilityTheory.tendsto_measureReal_lt_sum_comp_eval`: the weak law for an i.i.d. sequence with + law `ξ`, realized as the coordinates under `ξ^ℕ = Measure.infinitePi`: for `β > 0`, the + probability that `∑ i ≤ m, f (ω i)` exceeds `(m + 1) * (∫ f ∂ξ + β)` tends to `0`. +-/ + +@[expose] public section + +open MeasureTheory Filter + +open scoped Function Topology + +namespace ProbabilityTheory + +section WeakLaw + +variable {Ω : Type*} {mΩ : MeasurableSpace Ω} {μ : Measure Ω} + {E : Type*} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E] + [MeasurableSpace E] [BorelSpace E] + +/-- **Weak law of large numbers**: if `X n` is a sequence of pairwise independent identically +distributed integrable random variables taking values in a Banach space, then +`n⁻¹ • ∑ i ∈ range n, X i` converges in measure to `𝔼[X 0]`. -/ +theorem weak_law_tendstoInMeasure (X : ℕ → Ω → E) (hint : Integrable (X 0) μ) + (hindep : Pairwise ((· ⟂ᵢ[μ] ·) on X)) (hident : ∀ i, IdentDistrib (X i) (X 0) μ μ) : + TendstoInMeasure μ (fun (n : ℕ) ω ↦ (n : ℝ)⁻¹ • ∑ i ∈ Finset.range n, X i ω) atTop + (fun _ ↦ μ[X 0]) := by + -- if `X 0 = 0` almost everywhere, then all the means vanish almost everywhere + by_cases h : ∀ᵐ ω ∂μ, X 0 ω = 0 + · have I : ∀ᵐ ω ∂μ, ∀ i, X i ω = 0 := + ae_all_iff.2 fun i ↦ (hident i).symm.ae_snd (p := fun x ↦ x = 0) measurableSet_eq h + refine fun ε hε ↦ tendsto_const_nhds.congr fun n ↦ ?_ + refine (measure_eq_zero_iff_ae_notMem.2 ?_).symm + filter_upwards [I] with ω hω + simp [hω, integral_eq_zero_of_ae h, hε.ne'] + -- otherwise `μ` is a probability measure and we use the strong law + have : IsProbabilityMeasure μ := + hint.isProbabilityMeasure_of_indepFun (X 0) (X 1) h (hindep zero_ne_one) + have hmeas (i : ℕ) : AEStronglyMeasurable (X i) μ := + (hident i).aestronglyMeasurable_iff.2 hint.aestronglyMeasurable + exact tendstoInMeasure_of_tendsto_ae + (fun n ↦ (Finset.aestronglyMeasurable_fun_sum _ fun i _ ↦ hmeas i).const_smul _) + (strong_law_ae X hint hindep hident) + +end WeakLaw + +variable {𝓧 : Type*} {m𝓧 : MeasurableSpace 𝓧} {ξ : Measure 𝓧} + +/-- **Weak law of large numbers** for an i.i.d. sequence: for `β > 0`, the probability under +`ξ^ℕ` that `∑ i ≤ m, f (ω i)` exceeds `(m + 1) * (∫ f ∂ξ + β)` tends to `0`. -/ +lemma tendsto_measureReal_lt_sum_comp_eval [IsProbabilityMeasure ξ] {f : 𝓧 → ℝ} + (hf : Integrable f ξ) {β : ℝ} (hβ : 0 < β) : + Tendsto (fun m : ℕ ↦ (Measure.infinitePi fun _ : ℕ ↦ ξ).real + {ω | (m + 1) * (∫ x, f x ∂ξ + β) < ∑ i ∈ Finset.Iic m, f (ω i)}) + atTop (𝓝 0) := by + -- reduce to the case of a measurable function + wlog hf_meas : Measurable f generalizing f with h_meas + · have hfg : f =ᵐ[ξ] hf.1.mk f := hf.1.ae_eq_mk + have h_ae : ∀ᵐ ω ∂(Measure.infinitePi fun _ : ℕ ↦ ξ), ∀ i, f (ω i) = hf.1.mk f (ω i) := + ae_all_iff.2 fun i ↦ + (measurePreserving_eval_infinitePi (fun _ : ℕ ↦ ξ) i).quasiMeasurePreserving.ae hfg + convert h_meas (hf.congr hfg) hf.1.stronglyMeasurable_mk.measurable using 2 with m + rw [integral_congr_ae hfg] + refine measureReal_congr ?_ + filter_upwards [h_ae] with ω hω + simp only [hω] + set P := Measure.infinitePi fun _ : ℕ ↦ ξ + set K := ∫ x, f x ∂ξ + -- the coordinates of `ω` are i.i.d. with law `ξ` + have h_ident (i : ℕ) : IdentDistrib (fun ω : ℕ → 𝓧 ↦ f (ω i)) (fun ω ↦ f (ω 0)) P P := by + refine IdentDistrib.comp + ⟨(measurable_pi_apply i).aemeasurable, (measurable_pi_apply 0).aemeasurable, ?_⟩ hf_meas + rw [(measurePreserving_eval_infinitePi _ i).map_eq, + (measurePreserving_eval_infinitePi _ 0).map_eq] + have h_tim := weak_law_tendstoInMeasure (fun i (ω : ℕ → 𝓧) ↦ f (ω i)) + ((measurePreserving_eval_infinitePi _ 0).integrable_comp_of_integrable hf) + (fun i j hij ↦ (iIndepFun_infinitePi (X := fun _ ↦ f) fun _ ↦ hf_meas).indepFun hij) h_ident + (ENNReal.ofReal β) (ENNReal.ofReal_pos.mpr hβ) + rw [show P[fun ω ↦ f (ω 0)] = K from + integral_comp_eval_infinitePi (i := 0) hf.aestronglyMeasurable] at h_tim + -- the event of the statement is included in the deviation event of the empirical mean + have h_lim : Tendsto (fun m : ℕ ↦ P + {ω | (m + 1) * (K + β) < ∑ i ∈ Finset.Iic m, f (ω i)}) atTop (𝓝 0) := by + refine tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds + ((tendsto_add_atTop_iff_nat 1).mpr h_tim) (fun _ ↦ zero_le) fun m ↦ measure_mono + fun ω hω ↦ ?_ + have h_range : Finset.Iic m = Finset.range (m + 1) := by + ext i; simp + simp only [Set.mem_ofPred_eq, h_range] at hω ⊢ + rw [edist_dist, Real.dist_eq] + refine ENNReal.ofReal_le_ofReal ?_ + have hm : (0 : ℝ) < (m + 1 : ℕ) := by positivity + have h_avg : β < ((m + 1 : ℕ) : ℝ)⁻¹ • ∑ i ∈ Finset.range (m + 1), f (ω i) - K := by + rw [smul_eq_mul, lt_sub_iff_add_lt, add_comm, inv_mul_eq_div, lt_div_iff₀ hm] + calc (K + β) * ((m + 1 : ℕ) : ℝ) = (m + 1) * (K + β) := by push_cast; ring + _ < _ := hω + exact h_avg.le.trans (le_abs_self _) + have h := (ENNReal.tendsto_toReal ENNReal.zero_ne_top).comp h_lim + rw [ENNReal.toReal_zero] at h + exact h + +end ProbabilityTheory diff --git a/Statlib/Testing/Binary.lean b/Statlib/Testing/Binary.lean index dcdcde8..5a1cbb9 100644 --- a/Statlib/Testing/Binary.lean +++ b/Statlib/Testing/Binary.lean @@ -10,27 +10,34 @@ 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 +public import Statlib.ForMathlib.Probability.Decision.Risk.Basic +public import Statlib.ForMathlib.Probability.Decision.ZeroOneLoss /-! # 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`. +data generating kernel `Kernel.boolKernel μ ν` and the 0-1 loss `zeroOneLoss` on `Bool`. ## Main definitions -* `simpleBinaryLoss`: the 0-1 loss on `Bool`, `ℓ(y, z) = 𝕀{y ≠ z}`. +* `binaryArgminEstimator μ ν π`: the test that answers `true` (that is, `ν`) where + `π {false} * ∂μ/∂P ≤ π {true} * ∂ν/∂P`, for `P = Kernel.boolKernel μ ν ∘ₘ π`. * `bayesBinaryRisk μ ν π`: the Bayes risk of the simple binary hypothesis testing problem between `μ` and `ν` with respect to the prior `π`. ## Main statements +* `isArgminEstimator_binaryArgminEstimator`: `binaryArgminEstimator μ ν π` is an argmin estimator, + hence a Bayes estimator. * `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_zero_iff_mutuallySingular`: for a prior with positive weights, the Bayes + binary risk vanishes if and only if `μ ⟂ₘ ν`. * `bayesBinaryRisk_eq_lintegral_min`, `toReal_bayesBinaryRisk_eq_integral_abs`: integral formulas for the Bayes binary risk with respect to the joint law `Kernel.boolKernel μ ν ∘ₘ π`. @@ -51,31 +58,27 @@ variable {𝒳 𝒳' : Type*} {m𝒳 : MeasurableSpace 𝒳} {m𝒳' : Measurabl 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 zeroOneLoss_true_false : zeroOneLoss true false = 1 := zeroOneLoss_of_ne (by simp) -@[simp] lemma simpleBinaryLoss_false_true : simpleBinaryLoss false true = 1 := by - simp [simpleBinaryLoss] - -lemma measurable_simpleBinaryLoss : Measurable (Function.uncurry simpleBinaryLoss) := - .of_discrete +@[simp] lemma zeroOneLoss_false_true : zeroOneLoss false true = 1 := zeroOneLoss_of_ne (by simp) @[simp] -lemma lintegral_simpleBinaryLoss_true (ξ : Measure Bool) : - ∫⁻ z, simpleBinaryLoss true z ∂ξ = ξ {false} := by - simp [lintegral_fintype, simpleBinaryLoss] +lemma lintegral_zeroOneLoss_true (ξ : Measure Bool) : + ∫⁻ z, zeroOneLoss true z ∂ξ = ξ {false} := by + simp [lintegral_fintype] @[simp] -lemma lintegral_simpleBinaryLoss_false (ξ : Measure Bool) : - ∫⁻ z, simpleBinaryLoss false z ∂ξ = ξ {true} := by - simp [lintegral_fintype, simpleBinaryLoss] +lemma lintegral_zeroOneLoss_false (ξ : Measure Bool) : + ∫⁻ z, zeroOneLoss false z ∂ξ = ξ {true} := by + simp [lintegral_fintype] + +/-- For a measure `ζ` on `Bool`, the smallest expected 0-1 loss of an action is +`min (ζ {false}) (ζ {true})`: this is the Bayes risk of a constant kernel for simple binary +hypothesis testing with prior `ζ`. -/ +lemma iInf_lintegral_zeroOneLoss_bool (ζ : Measure Bool) : + ⨅ y, ∫⁻ θ, zeroOneLoss θ y ∂ζ = min (ζ {false}) (ζ {true}) := by + rw [iInf_bool_eq] + simp [lintegral_fintype] /-- The function `x ↦ 𝕀{π₀ * ∂μ/∂(boolKernel μ ν ∘ₘ π) x ≤ π₁ * ∂ν/∂(boolKernel μ ν ∘ₘ π) x}`. It is an argmin estimator for the simple binary hypothesis testing problem. -/ @@ -85,34 +88,32 @@ def binaryArgminEstimator (μ ν : Measure 𝒳) (π : Measure Bool) : 𝒳 → ≤ π {true} * ν.rnDeriv (Kernel.boolKernel μ ν ∘ₘ π) x} fun x ↦ Bool.ofNat (E.indicator 1 x) +/-- `binaryArgminEstimator μ ν π` maximizes the posterior weight +`z ↦ π {z} * ∂(boolKernel μ ν z)/∂(boolKernel μ ν ∘ₘ π)`, hence is an argmin estimator, and a +Bayes estimator, for simple binary hypothesis testing. -/ lemma isArgminEstimator_binaryArgminEstimator (μ ν : Measure 𝒳) [IsFiniteMeasure μ] [IsFiniteMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] : - IsArgminEstimator simpleBinaryLoss (Kernel.boolKernel μ ν) π + IsArgminEstimator zeroOneLoss (Kernel.boolKernel μ ν) π (binaryArgminEstimator μ ν π) := by - refine ⟨?_, ?_⟩ + refine isArgminEstimator_zeroOneLoss ?_ (ae_of_all _ fun x z ↦ ?_) · 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 + · have hf : binaryArgminEstimator μ ν π x = decide (π {false} * (∂μ/∂Kernel.boolKernel μ ν ∘ₘ π) x + ≤ π {true} * (∂ν/∂Kernel.boolKernel μ ν ∘ₘ π) x) := by + simp [binaryArgminEstimator, Bool.ofNat, Set.indicator_apply] + rw [hf] + by_cases h : π {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 μ ν π⟩ + · cases z <;> simp [h] + · cases z <;> simp [h, (not_le.mp h).le] 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 μ ν) π + bayesRisk zeroOneLoss (Kernel.boolKernel μ ν) π lemma bayesBinaryRisk_eq_iInf_kernel (μ ν : Measure 𝒳) (π : Measure Bool) : bayesBinaryRisk μ ν π @@ -122,8 +123,8 @@ lemma bayesBinaryRisk_eq_iInf_kernel (μ ν : Measure 𝒳) (π : Measure Bool) 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] + Bool.false_eq_true, ↓reduceIte, zeroOneLoss_self, zeroOneLoss_true_false, + zeroOneLoss_false_true, zero_mul, one_mul, zero_add, add_zero] ring variable {π : Measure Bool} @@ -134,6 +135,12 @@ lemma bayesBinaryRisk_smul_smul (μ ν : Measure 𝒳) (π : Measure Bool) (a b = bayesBinaryRisk μ ν (π.withDensity (fun x ↦ bif x then b else a)) := by simp [bayesBinaryRisk_eq_iInf_kernel, lintegral_dirac, mul_assoc] +/-- The Bayes binary risk is positively homogeneous in the prior: scaling the prior by a finite +factor scales the Bayes binary risk by the same factor. -/ +lemma bayesBinaryRisk_smul_prior (μ ν : Measure 𝒳) (π : Measure Bool) {c : ℝ≥0∞} (hc : c ≠ ∞) : + bayesBinaryRisk μ ν (c • π) = c * bayesBinaryRisk μ ν π := + bayesRisk_smul_prior _ _ _ hc + lemma bayesBinaryRisk_eq_bayesBinaryRisk_one_one (μ ν : Measure 𝒳) (π : Measure Bool) : bayesBinaryRisk μ ν π = bayesBinaryRisk (π {false} • μ) (π {true} • ν) (Measure.boolMeasure 1 1) := by @@ -184,6 +191,15 @@ lemma bayesBinaryRisk_le_min (μ ν : Measure 𝒳) (π : Measure Bool) : convert bayesBinaryRisk_le_bayesBinaryRisk_comp μ ν π (Kernel.discard 𝒳) rw [Measure.discard_comp, Measure.discard_comp, bayesBinaryRisk_dirac] +/-- For a probability measure `μ`, the Bayes binary risk for a prior with mass `α` at `false` (for +example the prior `(α, 1 - α)`) is at most `α`. -/ +lemma toReal_bayesBinaryRisk_boolMeasure_le (μ ν : Measure 𝒳) [IsProbabilityMeasure μ] (α : ℝ≥0) + (b : ℝ≥0∞) : + (bayesBinaryRisk μ ν (Measure.boolMeasure α b)).toReal ≤ α := by + have h := (bayesBinaryRisk_le_min μ ν (Measure.boolMeasure α b)).trans (min_le_left _ _) + rw [Measure.boolMeasure_apply_false, measure_univ, mul_one] at h + exact ENNReal.toReal_le_coe_of_le_coe h + @[simp] lemma bayesBinaryRisk_zero_left : bayesBinaryRisk 0 ν π = 0 := le_antisymm ((bayesBinaryRisk_le_min _ _ _).trans (by simp)) zero_le @@ -252,7 +268,7 @@ lemma bayesBinaryRisk_symm (μ ν : Measure 𝒳) (π : Measure Bool) : lemma avgRisk_binary_of_deterministic_indicator (μ ν : Measure 𝒳) (π : Measure Bool) {E : Set 𝒳} (hE : MeasurableSet E) : - avgRisk simpleBinaryLoss (Kernel.boolKernel μ ν) + avgRisk zeroOneLoss (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 @@ -263,8 +279,8 @@ lemma avgRisk_binary_of_deterministic_indicator (μ ν : Measure 𝒳) (π : Mea 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, + Bool.false_eq_true, ↓reduceIte, zeroOneLoss_self, zeroOneLoss_true_false, + zeroOneLoss_false_true, zero_mul, one_mul, zero_add, add_zero, Measure.deterministic_comp_eq_map, Measure.map_apply h_meas trivial, h1, h2] ring @@ -280,7 +296,7 @@ lemma bayesBinaryRisk_eq_iInf_measurableSet (μ ν : Measure 𝒳) [IsFiniteMeas ≤ π {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] + measurable_zeroOneLoss, IsArgminEstimator.kernel] simp_rw [binaryArgminEstimator] rw [avgRisk_binary_of_deterministic_indicator _ _ _ hE] exact iInf_le_of_le E (iInf_le _ hE) @@ -289,8 +305,8 @@ 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_rw [bayesBinaryRisk, bayesRisk_boolKernel_eq_lintegral_iInf measurable_zeroOneLoss μ ν π + hasArgminEstimator_zeroOneLoss, iInf_bool_eq] simp /-- The Bayes binary risk as an integral with respect to `ν`. The singular part of `μ` with respect @@ -341,6 +357,27 @@ lemma bayesBinaryRisk_eq_lintegral_min_rnDeriv (μ ν : Measure 𝒳) [IsFiniteM gcongr exact μ.withDensity_rnDeriv_le ν +/-- The Bayes binary risk of two mutually singular measures vanishes: the test with rejection +region a `μ`-null set carrying `ν` makes no error. -/ +lemma bayesBinaryRisk_of_mutuallySingular (h : μ ⟂ₘ ν) (π : Measure Bool) : + bayesBinaryRisk μ ν π = 0 := by + have h_le := bayesRisk_le_avgRisk zeroOneLoss (Kernel.boolKernel μ ν) + (Kernel.deterministic (fun x ↦ Bool.ofNat (h.nullSet.indicator 1 x)) + (Measurable.of_discrete.fun_comp (measurable_one.indicator h.measurableSet_nullSet))) π + rw [avgRisk_binary_of_deterministic_indicator _ _ _ h.measurableSet_nullSet, h.measure_nullSet, + h.measure_compl_nullSet, mul_zero, mul_zero, add_zero, nonpos_iff_eq_zero] at h_le + exact h_le + +/-- For a prior with positive weights, the Bayes binary risk vanishes if and only if the two +measures are mutually singular. -/ +lemma bayesBinaryRisk_eq_zero_iff_mutuallySingular [IsFiniteMeasure μ] [IsFiniteMeasure ν] + [IsFiniteMeasure π] (h_false : π {false} ≠ 0) (h_true : π {true} ≠ 0) : + bayesBinaryRisk μ ν π = 0 ↔ μ ⟂ₘ ν := by + rw [bayesBinaryRisk_eq_lintegral_min_rnDeriv, lintegral_eq_zero_iff (by fun_prop), + ← Measure.rnDeriv_eq_zero] + refine Filter.eventually_congr (.of_forall fun x ↦ ?_) + simp +contextual [min_eq_iff, h_false, h_true] + lemma toReal_bayesBinaryRisk_eq_integral_min (μ ν : Measure 𝒳) [IsFiniteMeasure μ] [IsFiniteMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] : (bayesBinaryRisk μ ν π).toReal diff --git a/Statlib/Testing/BinaryRenyi.lean b/Statlib/Testing/BinaryRenyi.lean new file mode 100644 index 0000000..8888c28 --- /dev/null +++ b/Statlib/Testing/BinaryRenyi.lean @@ -0,0 +1,190 @@ +/- +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.ForMathlib.Analysis.SpecialFunctions.Log.ENNRealLogExp +public import Statlib.ForMathlib.Analysis.SpecialFunctions.Pow.NNReal +public import Statlib.Divergence.Chernoff.Properties +public import Statlib.Divergence.TotalVariation + +/-! +# Bayes binary risk, Rényi and Chernoff divergences + +We bound the Bayes risk of simple binary hypothesis testing by the Rényi divergences between the +two hypotheses: for `a ∈ (0, 1)` and probability measures `μ`, `ν`, +`B_π(μ, ν) ≤ π({false}) ^ a * π({true}) ^ (1 - a) * exp (-(1 - a) * Rₐ(μ, ν))`. +Optimizing over `a`, we get a bound in terms of the Chernoff divergence: +`B_π(μ, ν) ≤ max (π({false}), π({true})) * exp (-C₁(μ, ν))`. + +The proof uses `min x y ≤ x ^ a * y ^ (1 - a)` inside the integral formula +`B_π(μ, ν) = ∫ min (π({false}) * ∂μ/∂ν, π({true})) ∂ν`, and the expression of +`∫ (∂μ/∂ν) ^ a ∂ν` in terms of the Rényi divergence (`lintegral_rpow_rnDeriv_eq_mul_exp_renyiDiv`). + +## Main statements + +* `bayesBinaryRisk_le_mul_lintegral_rpow_rnDeriv`: for `a ∈ [0, 1]`, + `B_π(μ, ν) ≤ π({false}) ^ a * π({true}) ^ (1 - a) * ∫⁻ x, (∂μ/∂ν) x ^ a ∂ν`. +* `bayesBinaryRisk_eq_mul_lintegral_min_withDensity_rpow`: an identity of Zhou and Li, an exact + expression of the Bayes binary risk as an integral with respect to a tilted measure. +* `bayesBinaryRisk_le_mul_exp_renyiDiv`: the bound on the Bayes binary risk, for finite measures. + `bayesBinaryRisk_le_mul_exp_renyiDiv_of_isProbabilityMeasure` is its version for probability + measures. +* `bayesBinaryRisk_le_max_mul_exp_chernoffDiv`: for finite measures, + `B_π(μ, ν) ≤ max (π({false}) * μ(univ), π({true}) * ν(univ)) * exp (-C₁(μ, ν))`. +* `bayesBinaryRisk_le_exp_chernoffDiv`: for probability measures, + `B_π(μ, ν) ≤ exp (-C₁(μ, ν))` when `π({false}), π({true}) ≤ 1`. +* `ofReal_one_sub_tvDist_div_two_le_exp_chernoffDiv`: `1 - tvDist μ ν / 2 ≤ exp (-C₁(μ, ν))`. + +The Rényi divergence of statlib is the one of the normalized measures, hence the factors +`μ(univ) ^ a * ν(univ) ^ (1 - a)` for finite measures. The exponential is `EReal.exp`, so that +the bounds are also correct (and equal to `0`) when the divergence is infinite. + +## References + +* Z. Zhou, P. Li, *Non-asymptotic Chernoff lower bound and its application to community detection + in stochastic block model*, arXiv:1812.11269 (2018). +-/ + +@[expose] public section + +open MeasureTheory Set + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {𝒳 : Type*} {m𝒳 : MeasurableSpace 𝒳} {a : ℝ} + +/-- For `a ∈ [0, 1]`, the Bayes binary risk is bounded by +`π({false}) ^ a * π({true}) ^ (1 - a) * ∫⁻ x, (∂μ/∂ν) x ^ a ∂ν`. -/ +lemma bayesBinaryRisk_le_mul_lintegral_rpow_rnDeriv (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] (ha0 : 0 ≤ a) (ha1 : a ≤ 1) : + bayesBinaryRisk μ ν π ≤ π {false} ^ a * π {true} ^ (1 - a) * ∫⁻ x, (∂μ/∂ν) x ^ a ∂ν := by + rw [bayesBinaryRisk_eq_lintegral_min_rnDeriv, ← lintegral_const_mul _ + ((μ.measurable_rnDeriv ν).pow_const a)] + refine lintegral_mono fun x ↦ ?_ + calc min (π {false} * (∂μ/∂ν) x) (π {true}) + ≤ (π {false} * (∂μ/∂ν) x) ^ a * π {true} ^ (1 - a) := + ENNReal.min_le_rpow_mul_rpow _ _ ha0 ha1 + _ = π {false} ^ a * π {true} ^ (1 - a) * (∂μ/∂ν) x ^ a := by + rw [ENNReal.mul_rpow_of_nonneg _ _ ha0]; ring + +/-- An identity of Zhou and Li: for `a ∈ (0, 1)`, the Bayes binary risk is +`π({false}) ^ a * π({true}) ^ (1 - a) * ∫ min ((π({false}) * ∂μ/∂ν / π({true})) ^ (1 - a), +(π({true}) / (π({false}) * ∂μ/∂ν)) ^ a)` with respect to the tilted measure +`ν.withDensity ((∂μ/∂ν) ^ a)`. For probability measures, that tilted measure has total mass +`exp (-(1 - a) * Rₐ(μ, ν))` (see `lintegral_rpow_rnDeriv_eq_mul_exp_renyiDiv`), and +`renyiMeasure a μ ν` is its normalization (see `renyiMeasure_eq_withDensity`). -/ +theorem bayesBinaryRisk_eq_mul_lintegral_min_withDensity_rpow (μ ν : Measure 𝒳) + [IsFiniteMeasure μ] [IsFiniteMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] + (ha0 : 0 < a) (ha1 : a < 1) : + bayesBinaryRisk μ ν π = π {false} ^ a * π {true} ^ (1 - a) + * ∫⁻ x, min ((π {false} * (∂μ/∂ν) x / π {true}) ^ (1 - a)) + ((π {true} / (π {false} * (∂μ/∂ν) x)) ^ a) ∂(ν.withDensity fun x ↦ (∂μ/∂ν) x ^ a) := by + have ha1' : 0 < 1 - a := by linarith + by_cases hπ0 : π {false} = 0 + · rw [bayesBinaryRisk_of_measure_false_eq_zero μ ν hπ0, hπ0, ENNReal.zero_rpow_of_pos ha0, + zero_mul, zero_mul] + by_cases hπ1 : π {true} = 0 + · rw [bayesBinaryRisk_of_measure_true_eq_zero μ ν hπ1, hπ1, ENNReal.zero_rpow_of_pos ha1', + mul_zero, zero_mul] + have hπ0_top : π {false} ≠ ∞ := measure_ne_top _ _ + have hπ1_top : π {true} ≠ ∞ := measure_ne_top _ _ + have h_meas : Measurable fun x ↦ min ((π {false} * (∂μ/∂ν) x / π {true}) ^ (1 - a)) + ((π {true} / (π {false} * (∂μ/∂ν) x)) ^ a) := by + have h := μ.measurable_rnDeriv ν + exact ((h.const_mul _).div_const _ |>.pow_const _).min + ((measurable_const.div (h.const_mul _)).pow_const _) + rw [lintegral_withDensity_eq_lintegral_mul _ ((μ.measurable_rnDeriv ν).pow_const a) h_meas, + ← lintegral_const_mul _ (((μ.measurable_rnDeriv ν).pow_const a).mul h_meas), + bayesBinaryRisk_eq_lintegral_min_rnDeriv] + refine lintegral_congr_ae ?_ + filter_upwards [μ.rnDeriv_lt_top ν] with x hx + simp only [Pi.mul_apply] + by_cases hx0 : (∂μ/∂ν) x = 0 + · simp [hx0, ENNReal.zero_rpow_of_pos ha0] + rw [ENNReal.min_eq_rpow_mul_rpow_mul_min (mul_ne_zero hπ0 hx0) + (ENNReal.mul_ne_top hπ0_top hx.ne) hπ1 hπ1_top a, + ENNReal.mul_rpow_of_nonneg _ _ ha0.le] + ring + +/-- For `a ∈ (0, 1)` and finite measures, the Bayes binary risk is bounded by +`π({false}) ^ a * π({true}) ^ (1 - a) * μ(univ) ^ a * ν(univ) ^ (1 - a) +* exp (-(1 - a) * Rₐ(μ, ν))`. -/ +theorem bayesBinaryRisk_le_mul_exp_renyiDiv (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] (ha0 : 0 < a) (ha1 : a < 1) : + bayesBinaryRisk μ ν π + ≤ π {false} ^ a * π {true} ^ (1 - a) * μ .univ ^ a * ν .univ ^ (1 - a) + * EReal.exp (-(((1 - a : ℝ) : EReal) * renyiDiv a μ ν)) := by + refine (bayesBinaryRisk_le_mul_lintegral_rpow_rnDeriv μ ν π ha0.le ha1.le).trans_eq ?_ + rw [lintegral_rpow_rnDeriv_eq_mul_exp_renyiDiv ha0 ha1] + ring + +/-- For `a ∈ (0, 1)` and probability measures, the Bayes binary risk is bounded by +`π({false}) ^ a * π({true}) ^ (1 - a) * exp (-(1 - a) * Rₐ(μ, ν))`. -/ +theorem bayesBinaryRisk_le_mul_exp_renyiDiv_of_isProbabilityMeasure (μ ν : Measure 𝒳) + [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] + (ha0 : 0 < a) (ha1 : a < 1) : + bayesBinaryRisk μ ν π + ≤ π {false} ^ a * π {true} ^ (1 - a) + * EReal.exp (-(((1 - a : ℝ) : EReal) * renyiDiv a μ ν)) := by + simpa using bayesBinaryRisk_le_mul_exp_renyiDiv μ ν π ha0 ha1 + +/-- For finite measures `μ`, `ν`, the Bayes binary risk is bounded by +`max (π({false}) * μ(univ), π({true}) * ν(univ)) * exp (-C₁(μ, ν))`, where `C₁` is the Chernoff +divergence. -/ +theorem bayesBinaryRisk_le_max_mul_exp_chernoffDiv (μ ν : Measure 𝒳) [IsFiniteMeasure μ] + [IsFiniteMeasure ν] (π : Measure Bool) [IsFiniteMeasure π] : + bayesBinaryRisk μ ν π ≤ max (π {false} * μ .univ) (π {true} * ν .univ) + * EReal.exp (-(chernoffDiv 1 μ ν : EReal)) := by + set M := max (π {false} * μ .univ) (π {true} * ν .univ) with hM_def + rcases eq_or_ne M 0 with hM0 | hM0 + · have hB := (bayesBinaryRisk_le_min μ ν π).trans (min_le_max.trans_eq hM0) + rw [nonpos_iff_eq_zero.mp hB] + exact zero_le + have hM_top : M ≠ ∞ := max_ne_top (by finiteness) (by finiteness) + -- bound for each order `a ∈ (0, 1)` + have h_open : ∀ a ∈ Ioo (0 : ℝ) 1, bayesBinaryRisk μ ν π / M + ≤ EReal.exp (-((ENNReal.ofReal (1 - a) * renyiDiv a μ ν : ℝ≥0∞) : EReal)) := by + intro a ha + have ha1 : 0 ≤ 1 - a := by linarith [ha.2] + rw [ENNReal.div_le_iff' hM0 hM_top, EReal.coe_ennreal_mul, EReal.coe_ennreal_ofReal, + max_eq_left ha1] + refine (bayesBinaryRisk_le_mul_exp_renyiDiv μ ν π ha.1 ha.2).trans (mul_le_mul_left ?_ _) + calc π {false} ^ a * π {true} ^ (1 - a) * μ .univ ^ a * ν .univ ^ (1 - a) + = (π {false} * μ .univ) ^ a * (π {true} * ν .univ) ^ (1 - a) := by + rw [ENNReal.mul_rpow_of_nonneg _ _ ha.1.le, ENNReal.mul_rpow_of_nonneg _ _ ha1] + ring + _ ≤ M ^ a * M ^ (1 - a) := mul_le_mul' (ENNReal.rpow_le_rpow (le_max_left _ _) ha.1.le) + (ENNReal.rpow_le_rpow (le_max_right _ _) ha1) + _ = M := by rw [← ENNReal.rpow_add_of_nonneg _ _ ha.1.le ha1]; simp + -- optimize over the order + rw [← ENNReal.div_le_iff' hM0 hM_top, chernoffDiv_one_eq_iSup_mul_renyiDiv, + ← iSup_Ioo_mul_renyiDiv_eq_iSup_Icc] + exact EReal.le_exp_neg_biSup (nonempty_Ioo.mpr zero_lt_one) h_open + +/-- For probability measures `μ`, `ν` and a prior with `π({false}), π({true}) ≤ 1`, the Bayes binary +risk is bounded by `exp (-C₁(μ, ν))`, where `C₁` is the Chernoff divergence. -/ +theorem bayesBinaryRisk_le_exp_chernoffDiv (μ ν : Measure 𝒳) [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] (π : Measure Bool) (hπ0 : π {false} ≤ 1) (hπ1 : π {true} ≤ 1) : + bayesBinaryRisk μ ν π ≤ EReal.exp (-(chernoffDiv 1 μ ν : EReal)) := by + have : IsFiniteMeasure π := by + rw [Measure.eq_boolMeasure π] + exact Measure.isFiniteMeasure_boolMeasure (ne_top_of_le_ne_top ENNReal.one_ne_top hπ0) + (ne_top_of_le_ne_top ENNReal.one_ne_top hπ1) + refine (bayesBinaryRisk_le_max_mul_exp_chernoffDiv μ ν π).trans + (mul_le_of_le_one_left zero_le ?_) + simpa using max_le hπ0 hπ1 + +/-- For probability measures, `1 - TV(μ, ν) ≤ exp (-C₁(μ, ν))`, where `TV(μ, ν) = tvDist μ ν / 2` +and `C₁` is the Chernoff divergence. -/ +theorem ofReal_one_sub_tvDist_div_two_le_exp_chernoffDiv (μ ν : Measure 𝒳) + [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + ENNReal.ofReal (1 - tvDist μ ν / 2) ≤ EReal.exp (-(chernoffDiv 1 μ ν : EReal)) := by + rw [← bayesBinaryRisk_one_one_eq_ofReal_one_sub_tvDist_div_two] + exact bayesBinaryRisk_le_exp_chernoffDiv μ ν _ (by simp) (by simp) + +end ProbabilityTheory diff --git a/Statlib/Testing/ChangeMeasure.lean b/Statlib/Testing/ChangeMeasure.lean index ad91236..12dae6c 100644 --- a/Statlib/Testing/ChangeMeasure.lean +++ b/Statlib/Testing/ChangeMeasure.lean @@ -11,11 +11,16 @@ 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. +at most `c` is at most `exp c` times the mass that `ν` puts on `s`. More generally, the same holds +for the integrals of a function with values in `[0, 1]`. These inequalities are the basis of lower +bounds for hypothesis testing in terms of the log-likelihood ratio. ## Main statements +* `lintegral_sub_le_lintegral_mul_exp`: for `μ ≪ ν` and `f` with values in `[0, 1]`, + `∫⁻ f ∂μ - μ {x | c < llr μ ν x} ≤ (∫⁻ f ∂ν) * exp c`. +* `integral_sub_le_integral_mul_exp`: the same inequality for real functions, for a finite + measure `ν`. * `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 @@ -36,35 +41,61 @@ 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 +/-- **Change of measure inequality** for functions with values in `[0, 1]`: +`∫⁻ f ∂μ - μ {x | c < llr μ ν x} ≤ (∫⁻ f ∂ν) * exp c`. +See `measure_sub_le_measure_mul_exp` for the case of an indicator function. -/ +lemma lintegral_sub_le_lintegral_mul_exp [SigmaFinite μ] [SigmaFinite ν] (hμν : μ ≪ ν) + {f : α → ℝ≥0∞} (hf_le : ∀ᵐ x ∂μ, f x ≤ 1) (c : ℝ) : + ∫⁻ x, f x ∂μ - μ {x | c < llr μ ν x} ≤ (∫⁻ x, f x ∂ν) * ENNReal.ofReal (exp c) := by set t := {x | llr μ ν x ≤ c} have ht : MeasurableSet t := measurableSet_le (measurable_llr _ _) measurable_const + have ht_compl : tᶜ = {x | c < llr μ ν x} := by ext; simp [t] -- 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 ?_ + have h_ae : ∀ᵐ x ∂μ.restrict t, f x ≤ ENNReal.ofReal (exp c) * (ν.rnDeriv μ x * f x) := by 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) + have h1 : 1 ≤ ENNReal.ofReal (exp c) * ν.rnDeriv μ x := by + 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 f x = 1 * f x := (one_mul _).symm + _ ≤ ENNReal.ofReal (exp c) * ν.rnDeriv μ x * f x := by gcongr + _ = ENNReal.ofReal (exp c) * (ν.rnDeriv μ x * f x) := mul_assoc _ _ _ + calc ∫⁻ x, f x ∂μ - μ {x | c < llr μ ν x} + _ ≤ ∫⁻ x in t, f x ∂μ := by + rw [tsub_le_iff_right, ← lintegral_add_compl f ht, ← ht_compl] + gcongr + calc ∫⁻ x in tᶜ, f x ∂μ ≤ ∫⁻ _ in tᶜ, 1 ∂μ := lintegral_mono_ae (ae_restrict_of_ae hf_le) + _ = μ tᶜ := by simp + _ ≤ ∫⁻ x in t, ENNReal.ofReal (exp c) * (ν.rnDeriv μ x * f x) ∂μ := lintegral_mono_ae h_ae + _ = ENNReal.ofReal (exp c) * ∫⁻ x in t, ν.rnDeriv μ x * f x ∂μ := + lintegral_const_mul' _ _ ENNReal.ofReal_ne_top + _ ≤ ENNReal.ofReal (exp c) * ∫⁻ x, ν.rnDeriv μ x * f x ∂μ := by + gcongr + exact Measure.restrict_le_self + _ = ENNReal.ofReal (exp c) * ∫⁻ x, f x ∂(μ.withDensity (ν.rnDeriv μ)) := by + rw [lintegral_withDensity_eq_lintegral_mul_non_measurable _ (ν.measurable_rnDeriv μ) + (ν.rnDeriv_lt_top μ)] + rfl + _ ≤ ENNReal.ofReal (exp c) * ∫⁻ x, f x ∂ν := by + gcongr + exact Measure.withDensity_rnDeriv_le ν μ + _ = (∫⁻ x, f x ∂ν) * ENNReal.ofReal (exp c) := mul_comm _ _ + +/-- **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 + have ht := measurableSet_toMeasurable ν s 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] + _ ≤ ∫⁻ x, (toMeasurable ν s).indicator 1 x ∂μ - μ {x | c < llr μ ν x} := by + rw [lintegral_indicator_one ht] + gcongr + exact subset_toMeasurable ν s + _ ≤ (∫⁻ x, (toMeasurable ν s).indicator 1 x ∂ν) * ENNReal.ofReal (exp c) := + lintegral_sub_le_lintegral_mul_exp hμν + (ae_of_all _ fun x ↦ Set.indicator_le (fun _ _ ↦ le_rfl) x) c + _ = ν s * ENNReal.ofReal (exp c) := by rw [lintegral_indicator_one ht, measure_toMeasurable] /-- **Change of measure inequality**: `μ s - μ {x | c < llr μ ν x} ≤ ν s * exp c`. -/ lemma measureReal_sub_le_measureReal_mul_exp [SigmaFinite μ] [IsFiniteMeasure ν] (hμν : μ ≪ ν) @@ -77,6 +108,40 @@ lemma measureReal_sub_le_measureReal_mul_exp [SigmaFinite μ] [IsFiniteMeasure _ = ν.real s * exp c := by rw [ENNReal.toReal_mul, ENNReal.toReal_ofReal (exp_pos _).le, measureReal_def] +/-- **Change of measure inequality** for real functions with values in `[0, 1]`: +`∫ f ∂μ - μ {x | c < llr μ ν x} ≤ (∫ f ∂ν) * exp c`. -/ +lemma integral_sub_le_integral_mul_exp [SigmaFinite μ] [IsFiniteMeasure ν] (hμν : μ ≪ ν) + {f : α → ℝ} (hf : AEStronglyMeasurable f ν) (hf_nonneg : ∀ᵐ x ∂ν, 0 ≤ f x) + (hf_le : ∀ᵐ x ∂ν, f x ≤ 1) (c : ℝ) (hμc : μ {x | c < llr μ ν x} ≠ ∞) : + ∫ x, f x ∂μ - μ.real {x | c < llr μ ν x} ≤ (∫ x, f x ∂ν) * exp c := by + have h_nonneg (ρ : Measure α) (hρ : ρ ≪ ν) : 0 ≤ ∫ x, f x ∂ρ := + integral_nonneg_of_ae (hρ.ae_le hf_nonneg) + have h_int (ρ : Measure α) (hρ : ρ ≪ ν) (hρf : Integrable f ρ) : + ∫⁻ x, ENNReal.ofReal (f x) ∂ρ = ENNReal.ofReal (∫ x, f x ∂ρ) := + (ofReal_integral_eq_lintegral_ofReal hρf (hρ.ae_le hf_nonneg)).symm + have hν_int : Integrable f ν := by + refine Integrable.of_bound (C := 1) hf ?_ + filter_upwards [hf_nonneg, hf_le] with x hx0 hx1 + rwa [Real.norm_of_nonneg hx0] + by_cases hμ_int : Integrable f μ + swap + · -- `f` is not `μ`-integrable (`μ` may be infinite): the left-hand side is nonpositive + rw [integral_undef hμ_int, zero_sub] + exact (neg_nonpos.mpr measureReal_nonneg).trans + (mul_nonneg (h_nonneg ν .rfl) (exp_pos _).le) + have h := lintegral_sub_le_lintegral_mul_exp hμν + (hμν.ae_le (hf_le.mono fun x hx ↦ ENNReal.ofReal_le_one.mpr hx)) c + rw [h_int μ hμν hμ_int, h_int ν .rfl hν_int] at h + calc ∫ x, f x ∂μ - μ.real {x | c < llr μ ν x} + _ ≤ (ENNReal.ofReal (∫ x, f x ∂μ) - μ {x | c < llr μ ν x}).toReal := by + have h_sub := ENNReal.le_toReal_sub (a := ENNReal.ofReal (∫ x, f x ∂μ)) hμc + rwa [ENNReal.toReal_ofReal (h_nonneg μ hμν)] at h_sub + _ ≤ (ENNReal.ofReal (∫ x, f x ∂ν) * ENNReal.ofReal (exp c)).toReal := + ENNReal.toReal_mono (by finiteness) h + _ = (∫ x, f x ∂ν) * exp c := by + rw [ENNReal.toReal_mul, ENNReal.toReal_ofReal (h_nonneg ν .rfl), + ENNReal.toReal_ofReal (exp_pos _).le] + /-- 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 ν'] diff --git a/Statlib/Testing/ChangeMeasureMoments.lean b/Statlib/Testing/ChangeMeasureMoments.lean new file mode 100644 index 0000000..47a30f0 --- /dev/null +++ b/Statlib/Testing/ChangeMeasureMoments.lean @@ -0,0 +1,177 @@ +/- +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.ForMathlib.Probability.Moments.Variance +public import Statlib.Divergence.Renyi.Variational +public import Statlib.Testing.Binary +public import Statlib.Testing.ChangeMeasureRisk +public import Statlib.Testing.RenyiChangeMeasure + +/-! +# Change of measure and the moments of the log-likelihood ratio + +The change of measure inequality `measure_sub_le_measure_mul_exp` involves the probability that the +log-likelihood ratio `llr μ ν` exceeds a threshold. We choose thresholds adapted to the moments of +`llr μ ν`: its variance (through Chebyshev's inequality), its cumulant generating function (through +Rényi divergences) or its mean (the Kullback-Leibler divergence). + +## Main statements + +* `measureReal_sub_inv_le_measureReal_mul_exp_variance`: for probability measures and `β > 0`, + `μ s - β⁻¹ ≤ ν s * exp (KL(μ, ν) + √(Var_μ[llr μ ν] * β))`. +* `one_sub_two_mul_inv_le_add_measureReal_mul_exp_variance`: for probability measures `μ, ν, ξ` + and `β > 0`, the errors `μ s` and `ν sᶜ` of a test cannot both be small. +* `iInf_lintegral_sub_exp_le_bayesRisk_mul_exp_renyiDiv`: change of measure for Bayes risks, in + which the probability of large values of the log-likelihood ratio is controlled through a Rényi + divergence of order `1 + ε`. +* `min_sub_exp_le_bayesBinaryRisk_mul_exp_renyiDiv`: its specialization to the Bayes binary risk. +* `min_sub_le_bayesBinaryRisk_mul_exp_klDiv_add_renyiDiv`: change of measure for the Bayes binary + risk, with the threshold centered at the mean `KL(π_γ × ξ, π ⊗ₘ P)` of the log-likelihood ratio, + where `π_γ = (γ, 1 - γ)`, `ξ = renyiMeasure γ μ ν` is the tilted measure and `P = boolKernel μ ν`. + That mean is `KL(π_γ, π) + (1 - γ) * R_γ(μ, ν)` (`klDiv_boolMeasure_prod_renyiMeasure`). +-/ + +@[expose] public section + +open MeasureTheory InformationTheory + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν ξ : Measure α} + +section Variance + +open Real + +variable {Ω : Type*} {mΩ : MeasurableSpace Ω} {P : Measure Ω} {X : Ω → ℝ} + +/-- The probability under `μ` that the log-likelihood ratio exceeds `KL(μ, ν) + √(Var[llr] * β)` is +at most `β⁻¹`. -/ +lemma measureReal_llr_gt_klDiv_add_sqrt_le_inv [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (hμν : μ ≪ ν) (h : MemLp (llr μ ν) 2 μ) {β : ℝ} (hβ : 0 < β) : + μ.real {x | (klDiv μ ν).toReal + √(variance (llr μ ν) μ * β) < llr μ ν x} ≤ β⁻¹ := by + have h_kl : (klDiv μ ν).toReal = μ[llr μ ν] := toReal_klDiv_of_measure_eq hμν (by simp) + have h_set : {x | (klDiv μ ν).toReal + √(variance (llr μ ν) μ * β) < llr μ ν x} + = {x | √(variance (llr μ ν) μ * β) < llr μ ν x - μ[llr μ ν]} := by + ext x + simp only [h_kl, Set.mem_ofPred_eq] + constructor <;> intro hx <;> linarith + rw [h_set, measureReal_def] + refine ENNReal.toReal_le_of_le_ofReal (inv_nonneg.mpr hβ.le) ?_ + exact measure_sqrt_variance_mul_lt_sub_le h hβ + +/-- **Change of measure inequality**, with a threshold given by the mean and the variance of the +log-likelihood ratio: `μ s - β⁻¹ ≤ ν s * exp (KL(μ, ν) + √(Var_μ[llr μ ν] * β))`. -/ +lemma measureReal_sub_inv_le_measureReal_mul_exp_variance [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] (hμν : μ ≪ ν) (h : MemLp (llr μ ν) 2 μ) (s : Set α) {β : ℝ} + (hβ : 0 < β) : + μ.real s - β⁻¹ ≤ ν.real s * exp ((klDiv μ ν).toReal + √(variance (llr μ ν) μ * β)) := by + refine le_trans ?_ (measureReal_sub_le_measureReal_mul_exp hμν s _ (measure_ne_top _ _)) + gcongr + exact measureReal_llr_gt_klDiv_add_sqrt_le_inv hμν h hβ + +/-- For probability measures `μ, ν, ξ` and any set `s`, the errors `μ s` and `ν sᶜ` of a test +cannot both be small: a lower bound in terms of the mean and the variance of the log-likelihood +ratios of `ξ` with respect to `μ` and `ν`. -/ +lemma one_sub_two_mul_inv_le_add_measureReal_mul_exp_variance [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] [IsProbabilityMeasure ξ] (hξμ : ξ ≪ μ) (hξν : ξ ≪ ν) + (hμ : MemLp (llr ξ μ) 2 ξ) (hν : MemLp (llr ξ ν) 2 ξ) (s : Set α) {β : ℝ} (hβ : 0 < β) : + 1 - 2 * β⁻¹ + ≤ μ.real s * exp ((klDiv ξ μ).toReal + √(variance (llr ξ μ) ξ * β)) + + ν.real sᶜ * exp ((klDiv ξ ν).toReal + √(variance (llr ξ ν) ξ * β)) := by + refine le_trans ?_ (one_sub_le_add_measureReal_mul_exp hξμ hξν s _ _) + have h1 := measureReal_llr_gt_klDiv_add_sqrt_le_inv hξμ hμ hβ + have h2 := measureReal_llr_gt_klDiv_add_sqrt_le_inv hξν hν hβ + linarith + +end Variance + +section Risk + +variable {Θ 𝓧 𝓨 : Type*} {mΘ : MeasurableSpace Θ} {m𝓧 : MeasurableSpace 𝓧} + {m𝓨 : MeasurableSpace 𝓨} {ℓ : Θ → 𝓨 → ℝ≥0∞} + +/-- **Change of measure for the Bayes risk**, with the probability of large values of the +log-likelihood ratio controlled through a Rényi divergence of order `1 + ε`. For a loss bounded by +`1`, a probability measure `ξ` and `R = R_{1+ε}(ζ × ξ, π ⊗ₘ P)`, +`(⨅ y, ∫⁻ θ, ℓ θ y ∂ζ) - exp (-ε * c) ≤ R_π^P * exp (R + c)`. -/ +lemma iInf_lintegral_sub_exp_le_bayesRisk_mul_exp_renyiDiv (hl : Measurable (Function.uncurry ℓ)) + (hl_le : ∀ θ y, ℓ θ y ≤ 1) {P : Kernel Θ 𝓧} [IsMarkovKernel P] {π ζ : Measure Θ} + [IsProbabilityMeasure π] [IsProbabilityMeasure ζ] {ξ : Measure 𝓧} [IsProbabilityMeasure ξ] + {ε : ℝ} (hε : 0 < ε) (c : ℝ) (h : renyiDiv (1 + ε) (ζ.prod ξ) (π ⊗ₘ P) ≠ ∞) : + (⨅ y, ∫⁻ θ, ℓ θ y ∂ζ) - ENNReal.ofReal (Real.exp (-ε * c)) + ≤ bayesRisk ℓ P π + * ENNReal.ofReal (Real.exp ((renyiDiv (1 + ε) (ζ.prod ξ) (π ⊗ₘ P)).toReal + c)) := by + refine le_trans ?_ (iInf_lintegral_sub_le_bayesRisk_mul_exp hl hl_le + (absolutelyContinuous_of_renyiDiv_ne_top (by linarith) h) _) + gcongr + rw [← ofReal_measureReal] + exact ENNReal.ofReal_le_ofReal (measureReal_llr_gt_renyiDiv_le_exp hε c h) + +/-- **Change of measure for the Bayes binary risk**, with the probability of large values of the +log-likelihood ratio controlled through a Rényi divergence of order `1 + ε`: for a probability +measure `ξ` and `R = R_{1+ε}(ζ × ξ, π ⊗ₘ boolKernel μ ν)`, +`min ζ({false}) ζ({true}) - exp (-ε * c) ≤ B_π(μ, ν) * exp (R + c)`. -/ +lemma min_sub_exp_le_bayesBinaryRisk_mul_exp_renyiDiv {μ ν : Measure 𝓧} [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] {π ζ : Measure Bool} [IsProbabilityMeasure π] + [IsProbabilityMeasure ζ] {ξ : Measure 𝓧} [IsProbabilityMeasure ξ] {ε : ℝ} (hε : 0 < ε) (c : ℝ) + (h : renyiDiv (1 + ε) (ζ.prod ξ) (π ⊗ₘ Kernel.boolKernel μ ν) ≠ ∞) : + min (ζ {false}) (ζ {true}) - ENNReal.ofReal (Real.exp (-ε * c)) + ≤ bayesBinaryRisk μ ν π * ENNReal.ofReal + (Real.exp ((renyiDiv (1 + ε) (ζ.prod ξ) (π ⊗ₘ Kernel.boolKernel μ ν)).toReal + c)) := by + rw [← iInf_lintegral_zeroOneLoss_bool] + exact iInf_lintegral_sub_exp_le_bayesRisk_mul_exp_renyiDiv measurable_zeroOneLoss + zeroOneLoss_le_one hε c h + +/-- **Change of measure for the Bayes binary risk**, with the threshold centered at the mean of the +log-likelihood ratio. Let `π_γ = (γ, 1 - γ)`, `ξ = renyiMeasure γ μ ν` be the tilted measure and +`P = boolKernel μ ν`. The mean of `llr (π_γ × ξ) (π ⊗ₘ P)` under `π_γ × ξ` is +`KL(π_γ × ξ, π ⊗ₘ P) = KL(π_γ, π) + (1 - γ) * R_γ(μ, ν)`, and +`min γ (1 - γ) - (π_γ × ξ) {llr > KL(π_γ × ξ, π ⊗ₘ P) + c} + ≤ B_π(μ, ν) * exp (KL(π_γ, π) + (1 - γ) * R_γ(μ, ν) + c)`. -/ +lemma min_sub_le_bayesBinaryRisk_mul_exp_klDiv_add_renyiDiv {μ ν : Measure 𝓧} + [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] {π : Measure Bool} [IsFiniteMeasure π] + (hπ_false : π {false} ≠ 0) (hπ_true : π {true} ≠ 0) {γ : ℝ} (hγ0 : 0 < γ) (hγ1 : γ < 1) + (h_ms : ¬ μ ⟂ₘ ν) (c : ℝ) : + min (ENNReal.ofReal γ) (ENNReal.ofReal (1 - γ)) + - (Measure.boolMeasure (.ofReal γ) (.ofReal (1 - γ))).prod (renyiMeasure γ μ ν) + {x | (klDiv ((Measure.boolMeasure (.ofReal γ) (.ofReal (1 - γ))).prod + (renyiMeasure γ μ ν)) (π ⊗ₘ Kernel.boolKernel μ ν)).toReal + c + < llr ((Measure.boolMeasure (.ofReal γ) (.ofReal (1 - γ))).prod (renyiMeasure γ μ ν)) + (π ⊗ₘ Kernel.boolKernel μ ν) x} + ≤ bayesBinaryRisk μ ν π + * ENNReal.ofReal (Real.exp + ((klDiv (Measure.boolMeasure (.ofReal γ) (.ofReal (1 - γ))) π + + ENNReal.ofReal (1 - γ) * renyiDiv γ μ ν).toReal + c)) := by + have := isProbabilityMeasure_renyiMeasure hγ0 hγ1 h_ms + -- `π_γ × ξ ≪ π ⊗ₘ P` since `π` charges both points and `ξ ≪ μ`, `ξ ≪ ν` + have h_ac : (Measure.boolMeasure (.ofReal γ) (.ofReal (1 - γ))).prod (renyiMeasure γ μ ν) + ≪ π ⊗ₘ Kernel.boolKernel μ ν := by + rw [← Measure.compProd_const] + refine Measure.AbsolutelyContinuous.compProd ?_ (ae_of_all _ fun b ↦ ?_) + · refine Measure.AbsolutelyContinuous.mk fun s _ hs ↦ ?_ + suffices s = ∅ by simp [this] + refine Set.eq_empty_of_forall_notMem fun b hb ↦ ?_ + cases b + · exact hπ_false (measure_mono_null (Set.singleton_subset_iff.mpr hb) hs) + · exact hπ_true (measure_mono_null (Set.singleton_subset_iff.mpr hb) hs) + · cases b + · exact renyiMeasure_absolutelyContinuous_left ν hγ0 + · exact renyiMeasure_absolutelyContinuous_right μ hγ1 + rw [← klDiv_boolMeasure_prod_renyiMeasure μ ν π hγ0 hγ1 h_ms] + have h := iInf_lintegral_sub_le_bayesRisk_mul_exp measurable_zeroOneLoss + zeroOneLoss_le_one h_ac + ((klDiv ((Measure.boolMeasure (.ofReal γ) (.ofReal (1 - γ))).prod (renyiMeasure γ μ ν)) + (π ⊗ₘ Kernel.boolKernel μ ν)).toReal + c) + rwa [iInf_lintegral_zeroOneLoss_bool, Measure.boolMeasure_apply_false, + Measure.boolMeasure_apply_true] at h + +end Risk + +end ProbabilityTheory diff --git a/Statlib/Testing/ChangeMeasureRisk.lean b/Statlib/Testing/ChangeMeasureRisk.lean new file mode 100644 index 0000000..bbcc426 --- /dev/null +++ b/Statlib/Testing/ChangeMeasureRisk.lean @@ -0,0 +1,94 @@ +/- +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.ForMathlib.Probability.Decision.Risk.Basic +public import Statlib.ForMathlib.Probability.Kernel.Composition.MeasureCompProd +public import Statlib.Testing.ChangeMeasure + +/-! +# Change of measure for risks + +We deduce from the change of measure inequality for functions with values in `[0, 1]` +(`lintegral_sub_le_lintegral_mul_exp`) change of measure inequalities for Bayes risks of +estimation problems with a loss bounded by `1`. + +## Main statements + +* `bayesRisk_sub_le_bayesRisk_mul_exp`: for a loss bounded by `1` and `ζ ⊗ₘ Q ≪ π ⊗ₘ P`, + `R_ζ^Q - (ζ ⊗ₘ Q) {llr (ζ ⊗ₘ Q) (π ⊗ₘ P) > c} ≤ R_π^P * exp c`. +* `iInf_lintegral_sub_le_bayesRisk_mul_exp`: the same inequality with `Q` the constant kernel with + value a probability measure `ξ`. The Bayes risk of a constant kernel does not depend on its value, + and is `⨅ y, ∫⁻ θ, ℓ θ y ∂ζ`. +* `iInf_lintegral_sub_iInf_le_bayesRisk_mul_exp`: the previous inequality, optimized over `ξ`. +-/ + +@[expose] public section + +open MeasureTheory + +open scoped ENNReal + +namespace ProbabilityTheory + +section Risk + +variable {Θ 𝓧 𝓨 : Type*} {mΘ : MeasurableSpace Θ} {m𝓧 : MeasurableSpace 𝓧} + {m𝓨 : MeasurableSpace 𝓨} {ℓ : Θ → 𝓨 → ℝ≥0∞} + +/-- **Change of measure for the Bayes risk**. For a loss bounded by `1` and `ζ ⊗ₘ Q ≪ π ⊗ₘ P`, +`R_ζ^Q - (ζ ⊗ₘ Q) {llr (ζ ⊗ₘ Q) (π ⊗ₘ P) > c} ≤ R_π^P * exp c`. -/ +lemma bayesRisk_sub_le_bayesRisk_mul_exp (hl : Measurable (Function.uncurry ℓ)) + (hl_le : ∀ θ y, ℓ θ y ≤ 1) {P Q : Kernel Θ 𝓧} [IsFiniteKernel P] [IsFiniteKernel Q] + {π ζ : Measure Θ} [SigmaFinite π] [SigmaFinite ζ] (h_ac : ζ ⊗ₘ Q ≪ π ⊗ₘ P) (c : ℝ) : + bayesRisk ℓ Q ζ - (ζ ⊗ₘ Q) {p | c < llr (ζ ⊗ₘ Q) (π ⊗ₘ P) p} + ≤ bayesRisk ℓ P π * ENNReal.ofReal (Real.exp c) := by + have h_exp_ne_zero : ENNReal.ofReal (Real.exp c) ≠ 0 := by simp [Real.exp_pos] + rw [← ENNReal.div_le_iff h_exp_ne_zero ENNReal.ofReal_ne_top] + refine le_iInf₂ fun κ hκ ↦ ?_ + rw [ENNReal.div_le_iff h_exp_ne_zero ENNReal.ofReal_ne_top] + have h_le_one (p : Θ × 𝓧) : ∫⁻ y, ℓ p.1 y ∂(κ p.2) ≤ 1 := + (lintegral_mono fun y ↦ hl_le _ y).trans (by simp) + calc bayesRisk ℓ Q ζ - (ζ ⊗ₘ Q) {p | c < llr (ζ ⊗ₘ Q) (π ⊗ₘ P) p} + _ ≤ avgRisk ℓ Q κ ζ - (ζ ⊗ₘ Q) {p | c < llr (ζ ⊗ₘ Q) (π ⊗ₘ P) p} := by + gcongr + exact bayesRisk_le_avgRisk ℓ Q κ ζ + _ ≤ avgRisk ℓ P κ π * ENNReal.ofReal (Real.exp c) := by + rw [avgRisk_eq_lintegral_compProd hl, avgRisk_eq_lintegral_compProd hl] + exact lintegral_sub_le_lintegral_mul_exp h_ac (ae_of_all _ h_le_one) c + +/-- **Change of measure for the Bayes risk** of a constant kernel. For a loss bounded by `1` and a +probability measure `ξ` with `ζ × ξ ≪ π ⊗ₘ P`, +`(⨅ y, ∫⁻ θ, ℓ θ y ∂ζ) - (ζ × ξ) {llr (ζ × ξ) (π ⊗ₘ P) > c} ≤ R_π^P * exp c`. +The first term is the Bayes risk with respect to `ζ` of the constant kernel with value `ξ`. -/ +lemma iInf_lintegral_sub_le_bayesRisk_mul_exp (hl : Measurable (Function.uncurry ℓ)) + (hl_le : ∀ θ y, ℓ θ y ≤ 1) {P : Kernel Θ 𝓧} [IsFiniteKernel P] {π ζ : Measure Θ} + [SigmaFinite π] [SigmaFinite ζ] {ξ : Measure 𝓧} [IsProbabilityMeasure ξ] + (h_ac : ζ.prod ξ ≪ π ⊗ₘ P) (c : ℝ) : + (⨅ y, ∫⁻ θ, ℓ θ y ∂ζ) - ζ.prod ξ {p | c < llr (ζ.prod ξ) (π ⊗ₘ P) p} + ≤ bayesRisk ℓ P π * ENNReal.ofReal (Real.exp c) := by + have h := bayesRisk_sub_le_bayesRisk_mul_exp hl hl_le (P := P) (π := π) + (Q := Kernel.const Θ ξ) (ζ := ζ) (by rwa [Measure.compProd_const]) c + rwa [Measure.compProd_const, bayesRisk_const hl] at h + +/-- **Change of measure for the Bayes risk**, optimized over constant kernels. For a loss bounded by +`1`, `(⨅ y, ∫⁻ θ, ℓ θ y ∂ζ) - ⨅ ξ, (ζ × ξ) {llr (ζ × ξ) (π ⊗ₘ P) > c} ≤ R_π^P * exp c`, where the +infimum is over the probability measures `ξ` with `ζ × ξ ≪ π ⊗ₘ P`. The first term is the Bayes +risk with respect to `ζ` of any constant kernel. -/ +lemma iInf_lintegral_sub_iInf_le_bayesRisk_mul_exp (hl : Measurable (Function.uncurry ℓ)) + (hl_le : ∀ θ y, ℓ θ y ≤ 1) (P : Kernel Θ 𝓧) [IsFiniteKernel P] (π ζ : Measure Θ) + [SigmaFinite π] [SigmaFinite ζ] (c : ℝ) : + (⨅ y, ∫⁻ θ, ℓ θ y ∂ζ) + - ⨅ (ξ : Measure 𝓧) (_ : IsProbabilityMeasure ξ) (_ : ζ.prod ξ ≪ π ⊗ₘ P), + ζ.prod ξ {p | c < llr (ζ.prod ξ) (π ⊗ₘ P) p} + ≤ bayesRisk ℓ P π * ENNReal.ofReal (Real.exp c) := by + simp_rw [ENNReal.sub_iInf] + exact iSup_le fun ξ ↦ iSup_le fun _ ↦ iSup_le fun h_ac ↦ + iInf_lintegral_sub_le_bayesRisk_mul_exp hl hl_le h_ac c + +end Risk + +end ProbabilityTheory diff --git a/Statlib/Testing/Chernoff.lean b/Statlib/Testing/Chernoff.lean new file mode 100644 index 0000000..25ad3b7 --- /dev/null +++ b/Statlib/Testing/Chernoff.lean @@ -0,0 +1,248 @@ +/- +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.Chernoff.Prod +public import Statlib.ForMathlib.Probability.StrongLaw +public import Statlib.Testing.ChangeMeasure +public import Statlib.Testing.RenyiChangeMeasure +public import Statlib.Testing.Sequential.Basic + +/-! +# Testing lower bounds from the Chernoff divergence + +The Chernoff divergence gives lower bounds on the errors of tests, both for a fixed number of +samples and asymptotically. + +For probability measures `μ`, `ν` and `a > 0`, a test between `μ` and `ν`, that is an event `s`, +satisfies `μ(s) + ν(sᶜ) ≥ 2⁻¹ * exp (- C_{1+a}(μ, ν) - log 4 / a)`, where `C_b` is the Chernoff +divergence of order `b`. This follows from the change of measure inequality with three measures +`exp_neg_max_renyiDiv_le_add_measureReal`, optimized over the intermediate measure. +For a test with `n` samples, that is an event `s` on `𝓧^n`, applying that bound to the product +measures at order `1 + a / √n` and using the subadditivity of the Chernoff divergence on powers +gives `μ^⊗n(s) + ν^⊗n(sᶜ) ≥ 2⁻¹ * exp (-n C_{1 + a/√n}(μ, ν) - log 4 / a * √n)`. + +Let `μ^ℕ = Measure.infinitePi (fun _ : ℕ ↦ μ)`. For events `E m` that depend only on the first +`m + 1` observations (they are measurable with respect to `Filtration.piLE m`), the errors +`μ^ℕ (E m)` and `ν^ℕ (E m)ᶜ` of the corresponding tests cannot both decrease exponentially faster +than `exp (-(m + 1) C₁(μ, ν))`: +`limsup (m + 1)⁻¹ * log (1 / (γ * μ^ℕ (E m) + (1 - γ) * ν^ℕ (E m)ᶜ)) ≤ C₁(μ, ν)`. +The proof uses a change of measure to `ξ^ℕ` for a probability measure `ξ` and the law of large +numbers for the log-likelihood ratios `llr ξ μ (ω i)` and `llr ξ ν (ω i)` under `ξ^ℕ` +(`tendsto_measureReal_lt_sum_comp_eval`). + +## Main statements + +* `exp_neg_chernoffDiv_le_add_measureReal`: + `2⁻¹ * exp (- C_{1+a}(μ, ν) - log 4 / a) ≤ μ(s) + ν(sᶜ)`. +* `exp_neg_mul_chernoffDiv_le_add_measureReal_pi`: the bound for `n` samples, for a finite index + type `ι` in place of `Fin n` (so that `n = |ι|`). +* `measureReal_sub_le_measureReal_mul_exp_piLE`: change of measure for events determined by the + first `m + 1` observations. +* `eventually_exp_neg_mul_le_add_measureReal`: **the Chernoff divergence bounds the error exponent + of tests**. For every `c > C₁(μ, ν)`, eventually + `exp (-(m + 1) * c) ≤ γ * μ^ℕ (E m) + (1 - γ) * ν^ℕ (E m)ᶜ`. + +## References + +* H. Chernoff, *A measure of asymptotic efficiency for tests of a hypothesis based on the sum of + observations*, Annals of Mathematical Statistics 23(4) (1952). +-/ + +@[expose] public section + +open MeasureTheory Filtration InformationTheory Filter Real + +open scoped ENNReal Topology + +namespace ProbabilityTheory + +/-! ### Tests with a fixed number of samples -/ + +section FixedSamples + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {a : ℝ} + +/-- Lower bound on the sum of the errors `μ s + ν sᶜ` of a test between two probability measures +in terms of their Chernoff divergence of order `1 + a`: +`2⁻¹ * exp (- C_{1+a}(μ, ν) - log 4 / a) ≤ μ s + ν sᶜ`. -/ +lemma exp_neg_chernoffDiv_le_add_measureReal [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (s : Set α) (ha : 0 < a) (h : chernoffDiv (1 + a) μ ν ≠ ∞) : + 2⁻¹ * exp (-(chernoffDiv (1 + a) μ ν).toReal - log 4 / a) ≤ μ.real s + ν.real sᶜ := by + -- the bound holds for every `x > C_{1+a}(μ, ν)` in place of `C_{1+a}(μ, ν)`, by + -- `exp_neg_max_renyiDiv_le_add_measureReal` for a measure `ξ` almost attaining the infimum + have h_gt (x : ℝ) (hx : (chernoffDiv (1 + a) μ ν).toReal < x) : + 2⁻¹ * exp (-x - log 4 / a) ≤ μ.real s + ν.real sᶜ := by + obtain ⟨ξ, hξ, h_lt⟩ : ∃ ξ : Measure α, ∃ _ : IsProbabilityMeasure ξ, + max (renyiDiv (1 + a) ξ μ) (renyiDiv (1 + a) ξ ν) < ENNReal.ofReal x := by + simpa only [chernoffDiv, iInf_lt_iff] using (ENNReal.lt_ofReal_iff_toReal_lt h).mpr hx + rw [max_lt_iff] at h_lt + refine le_trans ?_ (exp_neg_max_renyiDiv_le_add_measureReal s ha h_lt.1.ne_top h_lt.2.ne_top) + have hx0 : 0 ≤ x := ENNReal.toReal_nonneg.trans hx.le + gcongr + exact max_le (ENNReal.toReal_le_of_le_ofReal hx0 h_lt.1.le) + (ENNReal.toReal_le_of_le_ofReal hx0 h_lt.2.le) + exact le_of_tendsto (f := fun x ↦ 2⁻¹ * exp (-x - log 4 / a)) + (x := 𝓝[>] (chernoffDiv (1 + a) μ ν).toReal) + (Continuous.continuousWithinAt (by fun_prop)).tendsto (eventually_nhdsWithin_of_forall h_gt) + +/-- Lower bound on the sum of the errors of a test between powers of probability measures in terms +of the Chernoff divergence of order `1 + a / √n`, where `n = |ι|`: +`2⁻¹ * exp (-n C_{1 + a/√n}(μ, ν) - log 4 / a * √n) ≤ μ^⊗ι(s) + ν^⊗ι(sᶜ)`. -/ +theorem exp_neg_mul_chernoffDiv_le_add_measureReal_pi [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] {ι : Type*} [Fintype ι] (s : Set (ι → α)) (ha : 0 < a) + (h : chernoffDiv (1 + a / √(Fintype.card ι)) μ ν ≠ ∞) : + 2⁻¹ * exp (-(Fintype.card ι * (chernoffDiv (1 + a / √(Fintype.card ι)) μ ν).toReal) + - log 4 / a * √(Fintype.card ι)) + ≤ (Measure.pi fun _ : ι ↦ μ).real s + (Measure.pi fun _ : ι ↦ ν).real sᶜ := by + rcases isEmpty_or_nonempty ι with hι | hι + · -- for `n = 0`, the left-hand side is `2⁻¹` and the right-hand side is at least `1` + have h_eq : (Measure.pi fun _ : ι ↦ ν) = Measure.pi fun _ : ι ↦ μ := by + rw [Measure.pi_of_empty, Measure.pi_of_empty] + have h_one : 1 ≤ (Measure.pi fun _ : ι ↦ μ).real s + (Measure.pi fun _ : ι ↦ μ).real sᶜ := by + rw [← ENNReal.toReal_one, ← measure_univ (μ := Measure.pi fun _ : ι ↦ μ), measureReal_def, + measureReal_def, ← ENNReal.toReal_add (by finiteness) (by finiteness)] + exact ENNReal.toReal_mono (by finiteness) (measure_univ_le_add_compl s) + simp only [Fintype.card_eq_zero, Nat.cast_zero, sqrt_zero, zero_mul, neg_zero, mul_zero, + sub_zero, exp_zero, mul_one, h_eq] + linarith + set n : ℝ := (Fintype.card ι : ℝ) with hn_def + have hn : 0 < n := Nat.cast_pos.2 Fintype.card_pos + set b := a / √n with hb_def + have hb : 0 < b := div_pos ha (sqrt_pos.2 hn) + have hC := chernoffDiv_pi_const_le (a := 1 + b) (by linarith) (ι := ι) (μ := μ) (ν := ν) + have hC_ne : chernoffDiv (1 + b) (Measure.pi fun _ : ι ↦ μ) (Measure.pi fun _ : ι ↦ ν) ≠ ∞ := + (hC.trans_lt (ENNReal.mul_lt_top (by simp) h.lt_top)).ne + refine le_trans ?_ (exp_neg_chernoffDiv_le_add_measureReal s hb hC_ne) + refine mul_le_mul_of_nonneg_left (exp_le_exp.2 ?_) (by norm_num) + have h1 : (chernoffDiv (1 + b) (Measure.pi fun _ : ι ↦ μ) + (Measure.pi fun _ : ι ↦ ν)).toReal ≤ n * (chernoffDiv (1 + b) μ ν).toReal := by + simpa [ENNReal.toReal_mul, hn_def] using + ENNReal.toReal_mono (ENNReal.mul_ne_top (by simp) h) hC + have h2 : log 4 / b = log 4 / a * √n := by + rw [hb_def, div_div_eq_mul_div, div_mul_eq_mul_div] + linarith + +end FixedSamples + +/-! ### Error exponent -/ + +section ErrorExponent + +variable {𝓧 : Type*} {m𝓧 : MeasurableSpace 𝓧} {μ ν ξ : Measure 𝓧} + +section ChangeMeasure + +/-- **Change of measure** for events determined by the first `m + 1` observations: +`ξ^ℕ E - ξ^ℕ {t < ∑ i ≤ m, llr ξ μ (ω i)} ≤ μ^ℕ E * exp t`. -/ +lemma measureReal_sub_le_measureReal_mul_exp_piLE [IsProbabilityMeasure ξ] + [IsProbabilityMeasure μ] (hξμ : ξ ≪ μ) (m : ℕ) {E : Set (ℕ → 𝓧)} + (hE : MeasurableSet[piLE (X := fun _ : ℕ ↦ 𝓧) m] E) (t : ℝ) : + (Measure.infinitePi fun _ : ℕ ↦ ξ).real E + - (Measure.infinitePi fun _ : ℕ ↦ ξ).real + {ω | t < ∑ i ∈ Finset.Iic m, llr ξ μ (ω i)} + ≤ (Measure.infinitePi fun _ : ℕ ↦ μ).real E * exp t := by + set hm := (piLE (X := fun _ : ℕ ↦ 𝓧)).le m + set P := Measure.infinitePi fun _ : ℕ ↦ ξ + set Q := Measure.infinitePi fun _ : ℕ ↦ μ + have h := @measureReal_sub_le_measureReal_mul_exp _ (piLE (X := fun _ : ℕ ↦ 𝓧) m) (P.trim hm) + (Q.trim hm) _ _ (absolutelyContinuous_trim_piLE_infinitePi hξμ m) E t (measure_ne_top _ _) + have h_set : MeasurableSet[piLE (X := fun _ : ℕ ↦ 𝓧) m] {ω | t < llr (P.trim hm) (Q.trim hm) ω} := + measurableSet_lt measurable_const (@measurable_llr _ (piLE (X := fun _ : ℕ ↦ 𝓧) m) _ _) + have h_eq : (P.trim hm) {ω | t < llr (P.trim hm) (Q.trim hm) ω} + = P {ω | t < ∑ i ∈ Finset.Iic m, llr ξ μ (ω i)} := by + rw [trim_measurableSet_eq hm h_set] + refine measure_congr ?_ + filter_upwards [llr_trim_piLE_infinitePi_ae_eq hξμ m] with ω hω + rw [hω] + simp only [measureReal_def] at h ⊢ + rwa [trim_measurableSet_eq hm hE, trim_measurableSet_eq hm hE, h_eq] at h + +end ChangeMeasure + +/-- **The Chernoff divergence bounds the error exponent of tests**. Let `μ, ν` be probability +measures, `γ ∈ (0, 1)` and let `E m` be events determined by the first `m + 1` observations. For +every `c > C₁(μ, ν)`, eventually `exp (-(m + 1) * c) ≤ γ * μ^ℕ (E m) + (1 - γ) * ν^ℕ (E m)ᶜ`. That +is, `limsup (m + 1)⁻¹ * log (1 / (γ * μ^ℕ (E m) + (1 - γ) * ν^ℕ (E m)ᶜ)) ≤ C₁(μ, ν)`. -/ +theorem eventually_exp_neg_mul_le_add_measureReal [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] {E : ℕ → Set (ℕ → 𝓧)} + (hE : ∀ m, MeasurableSet[piLE (X := fun _ : ℕ ↦ 𝓧) m] (E m)) {γ : ℝ} (hγ0 : 0 < γ) + (hγ1 : γ < 1) {c : ℝ} (hc : chernoffDiv 1 μ ν < ENNReal.ofReal c) : + ∀ᶠ m : ℕ in atTop, exp (-(m + 1) * c) + ≤ γ * (Measure.infinitePi fun _ : ℕ ↦ μ).real (E m) + + (1 - γ) * (Measure.infinitePi fun _ : ℕ ↦ ν).real (E m)ᶜ := by + -- choose `ξ` with `max (KL(ξ, μ)) (KL(ξ, ν)) < c` + rw [chernoffDiv_one] at hc + obtain ⟨ξ, hc⟩ := iInf_lt_iff.mp hc + obtain ⟨hξ, hc⟩ := iInf_lt_iff.mp hc + have hμ_top : klDiv ξ μ ≠ ∞ := (hc.trans_le' (le_max_left _ _)).ne_top + have hν_top : klDiv ξ ν ≠ ∞ := (hc.trans_le' (le_max_right _ _)).ne_top + obtain ⟨hξμ, h_int_μ⟩ := klDiv_ne_top_iff.mp hμ_top + obtain ⟨hξν, h_int_ν⟩ := klDiv_ne_top_iff.mp hν_top + have hM : max (klDiv ξ μ).toReal (klDiv ξ ν).toReal < c := by + have hc_pos : 0 < c := ENNReal.ofReal_pos.mp (zero_le.trans_lt hc) + rw [← ENNReal.toReal_max hμ_top hν_top] + exact (ENNReal.toReal_lt_toReal (max_ne_top hμ_top hν_top) ENNReal.ofReal_ne_top).mpr hc + |>.trans_eq (ENNReal.toReal_ofReal hc_pos.le) + set K₁ := (klDiv ξ μ).toReal + set K₂ := (klDiv ξ ν).toReal + set M := max K₁ K₂ + set β := (c - M) / 2 + have hβ : 0 < β := by simp only [β]; linarith + set P := Measure.infinitePi fun _ : ℕ ↦ ξ + set δ := min γ (1 - γ) + have hδ : 0 < δ := lt_min hγ0 (by linarith) + -- the deviation probabilities of the log-likelihood ratios tend to `0` + have h_dev₁ := tendsto_measureReal_lt_sum_comp_eval h_int_μ hβ + have h_dev₂ := tendsto_measureReal_lt_sum_comp_eval h_int_ν hβ + rw [← toReal_klDiv_of_measure_eq hξμ (by simp)] at h_dev₁ + rw [← toReal_klDiv_of_measure_eq hξν (by simp)] at h_dev₂ + have h_dev := h_dev₁.add h_dev₂ + rw [add_zero] at h_dev + -- the factor `exp (-(m + 1) * β)` tends to `0` + have h_exp : Tendsto (fun m : ℕ ↦ exp (-(m + 1) * β)) atTop (𝓝 0) := by + refine Real.tendsto_exp_atBot.comp ?_ + refine Tendsto.atBot_mul_const hβ ?_ + exact tendsto_neg_atTop_atBot.comp (tendsto_natCast_atTop_atTop.atTop_add tendsto_const_nhds) + filter_upwards [h_dev.eventually (gt_mem_nhds (half_pos hδ)), + h_exp.eventually (gt_mem_nhds (half_pos hδ))] with m h_small h_exp_small + set p := P.real {ω | (m + 1) * (K₁ + β) < ∑ i ∈ Finset.Iic m, llr ξ μ (ω i)} + set q := P.real {ω | (m + 1) * (K₂ + β) < ∑ i ∈ Finset.Iic m, llr ξ ν (ω i)} + set C := (m + 1) * (M + β) + -- change of measure from `ξ^ℕ` to `μ^ℕ` and to `ν^ℕ` + have h1 : P.real (E m) - p ≤ (Measure.infinitePi fun _ : ℕ ↦ μ).real (E m) * exp C := + (measureReal_sub_le_measureReal_mul_exp_piLE hξμ m (hE m) _).trans + (by gcongr; simp only [C]; gcongr; exact le_max_left _ _) + have h2 : P.real (E m)ᶜ - q ≤ (Measure.infinitePi fun _ : ℕ ↦ ν).real (E m)ᶜ * exp C := + (measureReal_sub_le_measureReal_mul_exp_piLE hξν m (hE m).compl _).trans + (by gcongr; simp only [C]; gcongr; exact le_max_right _ _) + have h_compl : P.real (E m) + P.real (E m)ᶜ = 1 := by + rw [measureReal_add_measureReal_compl ((piLE (X := fun _ : ℕ ↦ 𝓧)).le m _ (hE m)), + probReal_univ] + -- combine the two changes of measure + have h_main : δ / 2 ≤ (γ * (Measure.infinitePi fun _ : ℕ ↦ μ).real (E m) + + (1 - γ) * (Measure.infinitePi fun _ : ℕ ↦ ν).real (E m)ᶜ) * exp C := by + have hp : 0 ≤ p := measureReal_nonneg + have hq : 0 ≤ q := measureReal_nonneg + nlinarith [mul_le_mul_of_nonneg_left h1 hγ0.le, + mul_le_mul_of_nonneg_left h2 (sub_nonneg.mpr hγ1.le), + mul_nonneg (sub_nonneg.mpr (min_le_left γ (1 - γ))) (measureReal_nonneg (μ := P) (s := E m)), + mul_nonneg (sub_nonneg.mpr (min_le_right γ (1 - γ))) + (measureReal_nonneg (μ := P) (s := (E m)ᶜ))] + -- `exp (-(m + 1) * c) = exp (-C) * exp (-(m + 1) * β)` + have h_split : exp (-(m + 1) * c) = exp (-C) * exp (-(m + 1) * β) := by + rw [← exp_add] + congr 1 + simp only [C, β] + ring + calc exp (-(m + 1) * c) ≤ exp (-C) * (δ / 2) := by rw [h_split]; gcongr + _ ≤ exp (-C) * ((γ * (Measure.infinitePi fun _ : ℕ ↦ μ).real (E m) + + (1 - γ) * (Measure.infinitePi fun _ : ℕ ↦ ν).real (E m)ᶜ) * exp C) := by gcongr + _ = _ := by rw [mul_comm, mul_assoc, ← exp_add, add_neg_cancel, exp_zero, mul_one] + +end ErrorExponent + +end ProbabilityTheory diff --git a/Statlib/Testing/Fano.lean b/Statlib/Testing/Fano.lean new file mode 100644 index 0000000..108e8e8 --- /dev/null +++ b/Statlib/Testing/Fano.lean @@ -0,0 +1,241 @@ +/- +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.JensenShannon.Variational +public import Statlib.Divergence.KullbackLeibler.Estimation +public import Statlib.Divergence.Renyi.Variational + +/-! +# Binary Fano inequality and Rényi lower bound on the Bayes binary risk + +Let `μ, ν` be probability measures and let `B_α(μ, ν)` be the Bayes binary risk of the simple +binary hypothesis testing problem between `μ` and `ν` with prior `π_α = (α, 1 - α)` on `Bool` +(`bayesBinaryRisk μ ν (boolMeasure α (1 - α))`). We prove two lower bounds on that risk. + +* The **binary Fano inequality**: `h₂(α) - h₂(B_α(μ, ν)) ≤ JS_α(μ, ν)`, where `h₂` is the binary + entropy and `JS_α` is the Jensen-Shannon divergence. +* A lower bound in terms of the Rényi divergence: for `β ∈ [0, 1/2]`, + `β log (α / B_α(μ, ν)) + (1 - β) log ((1 - α) / (1 - B_α(μ, ν))) ≤ (1 - β) R_β(μ, ν)`, and as a + consequence `log (α / B_α(μ, ν)) ≤ R_{1/2}(μ, ν) + log 2` for `α ≤ 1/2`. + +Both bounds compare the testing problem between `μ` and `ν` with the trivial problem in which both +hypotheses have the same law `ζ` (lemmas +`ofReal_klBerReal_bayesBinaryRisk_min_le_klDiv_compProd_prod_add` and +`ofReal_klBerReal_min_bayesBinaryRisk_le_klDiv_prod_compProd_add`), then take an infimum over `ζ` +using the variational formulas for the Jensen-Shannon divergence +(`jensenShannon_eq_iInf_klDiv_compProd`) and for the Rényi divergence +(`mul_renyiDiv_eq_iInf_klDiv_prod`). + +## Main statements + +* `ofReal_binEntropy_sub_binEntropy_bayesBinaryRisk_le_jensenShannon`: binary Fano inequality. +* `ofReal_klBerReal_sub_klBerReal_le_mul_renyiDiv`: + `kl(β, B_α(μ, ν)) - kl(β, α) ≤ (1 - β) R_β(μ, ν)` for `β ∈ [0, 1/2]`. +* `ofReal_mul_log_add_mul_log_le_mul_renyiDiv`: the same bound written with logarithms. +* `ofReal_mul_log_div_bayesBinaryRisk_le_mul_renyiDiv_add`: + `β log (α / B_α(μ, ν)) ≤ (1 - β) (R_β(μ, ν) + log 2)`. +* `ofReal_log_div_bayesBinaryRisk_le_renyiDiv_add`: `log (α / B_α(μ, ν)) ≤ R_{1/2}(μ, ν) + log 2`. + +## Implementation notes + +The quantities on the left-hand sides are real numbers which may be negative, while the divergences +take values in `ℝ≥0∞`: we state the bounds with `ENNReal.ofReal` of the left-hand side. The Bayes +risk enters through `ENNReal.toReal`. Logarithms use Mathlib's convention `log 0 = 0`; the bounds +remain true (and trivial) when the Bayes risk vanishes. + +The prior `(α, 1 - α)` is `boolMeasure α (1 - α)` with `α : ℝ≥0`, as in the Jensen-Shannon +divergence, while the variational formula for the Rényi divergence uses the prior +`boolMeasure (ENNReal.ofReal β) (ENNReal.ofReal (1 - β))` with `β : ℝ`. These priors are related +to each other by `Measure.boolMeasure_coe_eq_ofReal` and to the Bernoulli distribution +`Ber(false, true, p)` by `Measure.boolMeasure_ofReal_eq_bernoulliMeasure`. +-/ + +@[expose] public section + +open MeasureTheory Real InformationTheory ProbabilityTheory unitInterval + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +variable {𝓧 : Type*} {m𝓧 : MeasurableSpace 𝓧} (μ ν : Measure 𝓧) [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] {α : ℝ≥0} + +section Fano + +/-- **Binary Fano inequality**: for probability measures `μ, ν` and `α ∈ [0, 1]`, +`h₂(α) - h₂(B_α(μ, ν)) ≤ JS_α(μ, ν)`, where `h₂` is the binary entropy, `B_α(μ, ν)` is the Bayes +binary risk for the prior `(α, 1 - α)` and `JS_α` is the Jensen-Shannon divergence. -/ +theorem ofReal_binEntropy_sub_binEntropy_bayesBinaryRisk_le_jensenShannon (hα : α ≤ 1) : + ENNReal.ofReal (binEntropy α - binEntropy + (bayesBinaryRisk μ ν (Measure.boolMeasure α ((1 - α : ℝ≥0) : ℝ≥0∞))).toReal) + ≤ jensenShannon α μ ν := by + set ρ := Measure.boolMeasure (α : ℝ≥0∞) ((1 - α : ℝ≥0) : ℝ≥0∞) with hρ + have : IsProbabilityMeasure ρ := Measure.isProbabilityMeasure_boolMeasure_coe hα + -- compare with the trivial problem `(ζ, ζ)` under the uniform prior `ξ` + set ξ := Measure.boolMeasure (ENNReal.ofReal 2⁻¹) (ENNReal.ofReal (1 - 2⁻¹)) with hξ + have : IsProbabilityMeasure ξ := Measure.isProbabilityMeasure_boolMeasure_ofReal + (by norm_num) (by norm_num) + rw [jensenShannon_eq_iInf_klDiv_compProd hα] + refine le_iInf₂ fun ζ _ ↦ ?_ + have h := ofReal_klBerReal_bayesBinaryRisk_min_le_klDiv_compProd_prod_add μ ν ρ ξ ζ + have h_min : (min (ξ {false}) (ξ {true})).toReal = 2⁻¹ := by + rw [hξ, Measure.boolMeasure_apply_false, Measure.boolMeasure_apply_true] + norm_num + have h_kl : klDiv ρ ξ = ENNReal.ofReal (klBerReal α 2⁻¹) := by + rw [hρ, Measure.boolMeasure_coe_eq_ofReal, hξ] + exact klDiv_boolMeasure_ofReal_eq_klBerReal α.2 (by exact_mod_cast hα) (by norm_num) + (by norm_num) + rw [h_min, h_kl, klBerReal_two_inv_right, klBerReal_two_inv_right] at h + have h_nonneg : 0 ≤ log 2 - binEntropy α := sub_nonneg.2 binEntropy_le_log_two + calc ENNReal.ofReal (binEntropy α - binEntropy (bayesBinaryRisk μ ν ρ).toReal) + _ = ENNReal.ofReal ((log 2 - binEntropy (bayesBinaryRisk μ ν ρ).toReal) + - (log 2 - binEntropy α)) := by ring_nf + _ = ENNReal.ofReal (log 2 - binEntropy (bayesBinaryRisk μ ν ρ).toReal) + - ENNReal.ofReal (log 2 - binEntropy α) := ENNReal.ofReal_sub _ h_nonneg + _ ≤ klDiv (ρ ⊗ₘ Kernel.boolKernel μ ν) (ρ.prod ζ) := tsub_le_iff_right.2 h + +end Fano + +section Renyi + +variable {β : ℝ} + +/-- **Lower bound on the Bayes binary risk from the Rényi divergence**, in terms of the binary +Kullback-Leibler divergence: for `β ∈ [0, 1/2]` and `α ∈ [0, 1)`, +`kl(β, B_α(μ, ν)) - kl(β, α) ≤ (1 - β) R_β(μ, ν)`. -/ +theorem ofReal_klBerReal_sub_klBerReal_le_mul_renyiDiv (hβ0 : 0 ≤ β) (hβ : β ≤ 2⁻¹) + (hα1 : α < 1) : + ENNReal.ofReal (klBerReal β + (bayesBinaryRisk μ ν (Measure.boolMeasure α ((1 - α : ℝ≥0) : ℝ≥0∞))).toReal + - klBerReal β α) + ≤ ENNReal.ofReal (1 - β) * renyiDiv β μ ν := by + rcases eq_or_ne α 0 with rfl | hα0 + · -- the prior is a Dirac mass: the Bayes risk vanishes + rw [bayesBinaryRisk_of_measure_false_eq_zero _ _ (by simp)] + simp + replace hα0 : 0 < α := pos_iff_ne_zero.2 hα0 + have hα1' : (α : ℝ) < 1 := by exact_mod_cast hα1 + rcases hβ0.eq_or_lt with rfl | hβ0 + · -- for `β = 0`, the left-hand side is `log (1 - α) - log (1 - B_α(μ, ν)) ≤ 0` + have hB_le := toReal_bayesBinaryRisk_boolMeasure_le μ ν α ((1 - α : ℝ≥0) : ℝ≥0∞) + rw [ENNReal.ofReal_of_nonpos] + · exact zero_le + rw [klBerReal_zero_left, klBerReal_zero_left, neg_sub_neg, sub_nonpos] + exact Real.log_le_log (by linarith) (by linarith) + set ξ := Measure.boolMeasure (α : ℝ≥0∞) ((1 - α : ℝ≥0) : ℝ≥0∞) with hξ + have : IsProbabilityMeasure ξ := Measure.isProbabilityMeasure_boolMeasure_coe hα1.le + -- compare with the trivial problem `(ζ, ζ)` under the prior `ρ = (β, 1 - β)` + set ρ := Measure.boolMeasure (ENNReal.ofReal β) (ENNReal.ofReal (1 - β)) with hρ + have hβ1 : β < 1 := by linarith + have : IsProbabilityMeasure ρ := Measure.isProbabilityMeasure_boolMeasure_ofReal hβ0.le hβ1.le + rw [mul_renyiDiv_eq_iInf_klDiv_prod hβ0 hβ1] + refine le_iInf₂ fun ζ _ ↦ ?_ + have h := ofReal_klBerReal_min_bayesBinaryRisk_le_klDiv_prod_compProd_add μ ν ρ ξ ζ + have h_min : (min (ρ {false}) (ρ {true})).toReal = β := by + rw [hρ, Measure.boolMeasure_apply_false, Measure.boolMeasure_apply_true, + min_eq_left (ENNReal.ofReal_le_ofReal (by linarith)), ENNReal.toReal_ofReal hβ0.le] + have h_kl : klDiv ρ ξ = ENNReal.ofReal (klBerReal β α) := by + rw [hξ, Measure.boolMeasure_coe_eq_ofReal, hρ] + exact klDiv_boolMeasure_ofReal_eq_klBerReal hβ0.le hβ1.le (by exact_mod_cast hα0) hα1' + rw [h_min, h_kl] at h + have h_nonneg : 0 ≤ klBerReal β α := + klBerReal_nonneg hβ0.le hβ1.le (by exact_mod_cast hα0) hα1' + rw [ENNReal.ofReal_sub _ h_nonneg] + exact tsub_le_iff_right.2 h + +/-- **Lower bound on the Bayes binary risk from the Rényi divergence**: for `β ∈ [0, 1/2]` and +`α ∈ [0, 1]`, writing `B = B_α(μ, ν)`, +`β log (α / B) + (1 - β) log ((1 - α) / (1 - B)) ≤ (1 - β) R_β(μ, ν)`. -/ +theorem ofReal_mul_log_add_mul_log_le_mul_renyiDiv (hβ0 : 0 ≤ β) (hβ : β ≤ 2⁻¹) + (hα1 : α ≤ 1) : + ENNReal.ofReal + (β * log (α / (bayesBinaryRisk μ ν (Measure.boolMeasure α ((1 - α : ℝ≥0) : ℝ≥0∞))).toReal) + + (1 - β) * log ((1 - α) / + (1 - (bayesBinaryRisk μ ν (Measure.boolMeasure α ((1 - α : ℝ≥0) : ℝ≥0∞))).toReal))) + ≤ ENNReal.ofReal (1 - β) * renyiDiv β μ ν := by + rcases hα1.eq_or_lt with rfl | hα1 + · -- the prior is a Dirac mass: the Bayes risk and the left-hand side vanish + rw [bayesBinaryRisk_of_measure_true_eq_zero _ _ (by simp)] + simp + set B := (bayesBinaryRisk μ ν (Measure.boolMeasure α ((1 - α : ℝ≥0) : ℝ≥0∞))).toReal with hB + have hB_le : B ≤ α := toReal_bayesBinaryRisk_boolMeasure_le μ ν α _ + have hα1' : (α : ℝ) < 1 := by exact_mod_cast hα1 + have hβ1 : β < 1 := by linarith + rcases (show 0 ≤ B from ENNReal.toReal_nonneg).eq_or_lt with hB0 | hB0 + · -- the Bayes risk vanishes: the left-hand side is nonpositive + rw [← hB0, div_zero, Real.log_zero, mul_zero, zero_add, sub_zero, div_one, + ENNReal.ofReal_of_nonpos] + · exact zero_le + · exact mul_nonpos_of_nonneg_of_nonpos (by linarith) + (Real.log_nonpos (by linarith [α.2]) (by linarith [α.2])) + have hα0' : (0 : ℝ) < α := hB0.trans_le hB_le + have hB1 : B < 1 := hB_le.trans_lt hα1' + have h := ofReal_klBerReal_sub_klBerReal_le_mul_renyiDiv μ ν hβ0 hβ hα1 + rw [← hB] at h + convert h using 2 + rw [klBerReal_eq_of_ne hB0.ne' hB1.ne, klBerReal_eq_of_ne hα0'.ne' hα1'.ne, + Real.log_div hα0'.ne' hB0.ne', Real.log_div (by linarith) (by linarith)] + ring + +/-- **Lower bound on the Bayes binary risk from the Rényi divergence**: for `β ∈ [0, 1/2]` and +`α ∈ [0, 1/2]`, `β log (α / B_α(μ, ν)) ≤ (1 - β) (R_β(μ, ν) + log 2)`. -/ +theorem ofReal_mul_log_div_bayesBinaryRisk_le_mul_renyiDiv_add (hβ0 : 0 ≤ β) (hβ : β ≤ 2⁻¹) + (hα : α ≤ 2⁻¹) : + ENNReal.ofReal + (β * log (α / (bayesBinaryRisk μ ν (Measure.boolMeasure α ((1 - α : ℝ≥0) : ℝ≥0∞))).toReal)) + ≤ ENNReal.ofReal (1 - β) * (renyiDiv β μ ν + ENNReal.ofReal (log 2)) := by + have hα1 : α < 1 := hα.trans_lt (by norm_num) + set B := (bayesBinaryRisk μ ν (Measure.boolMeasure α ((1 - α : ℝ≥0) : ℝ≥0∞))).toReal with hB + have hB_le : B ≤ α := toReal_bayesBinaryRisk_boolMeasure_le μ ν α _ + have hα' : (α : ℝ) ≤ 2⁻¹ := by exact_mod_cast hα + have hB1 : B < 1 := hB_le.trans_lt (by linarith) + have hβ1 : β < 1 := by linarith + have h := ofReal_mul_log_add_mul_log_le_mul_renyiDiv μ ν hβ0 hβ hα1.le + rw [← hB] at h + -- `log ((1 - α) / (1 - B)) ≥ - log 2` since `(1 - α) / (1 - B) ≥ 1 - α ≥ 1/2` + have h_log : -log 2 ≤ log ((1 - α) / (1 - B)) := by + rw [← Real.log_inv] + refine Real.log_le_log (by norm_num) ?_ + rw [le_div_iff₀ (by linarith)] + have : 0 ≤ B := ENNReal.toReal_nonneg + nlinarith + calc ENNReal.ofReal (β * log (α / B)) + _ ≤ ENNReal.ofReal ((β * log (α / B) + (1 - β) * log ((1 - α) / (1 - B))) + + (1 - β) * log 2) := by + refine ENNReal.ofReal_le_ofReal ?_ + nlinarith + _ ≤ ENNReal.ofReal (β * log (α / B) + (1 - β) * log ((1 - α) / (1 - B))) + + ENNReal.ofReal ((1 - β) * log 2) := ENNReal.ofReal_add_le + _ ≤ ENNReal.ofReal (1 - β) * renyiDiv β μ ν + + ENNReal.ofReal (1 - β) * ENNReal.ofReal (log 2) := by + gcongr + rw [ENNReal.ofReal_mul (by linarith)] + _ = ENNReal.ofReal (1 - β) * (renyiDiv β μ ν + ENNReal.ofReal (log 2)) := by ring + +/-- **Lower bound on the Bayes binary risk from the Rényi divergence of order `1/2`**: for +`α ∈ [0, 1/2]`, `log (α / B_α(μ, ν)) ≤ R_{1/2}(μ, ν) + log 2`. -/ +theorem ofReal_log_div_bayesBinaryRisk_le_renyiDiv_add (hα : α ≤ 2⁻¹) : + ENNReal.ofReal + (log (α / (bayesBinaryRisk μ ν (Measure.boolMeasure α ((1 - α : ℝ≥0) : ℝ≥0∞))).toReal)) + ≤ renyiDiv 2⁻¹ μ ν + ENNReal.ofReal (log 2) := by + have h := ofReal_mul_log_div_bayesBinaryRisk_le_mul_renyiDiv_add μ ν (β := 2⁻¹) (by norm_num) + le_rfl hα + set L := log (α / (bayesBinaryRisk μ ν (Measure.boolMeasure α ((1 - α : ℝ≥0) : ℝ≥0∞))).toReal) + have h2 : ENNReal.ofReal L = 2 * ENNReal.ofReal (2⁻¹ * L) := by + rw [← ENNReal.ofReal_ofNat 2, ← ENNReal.ofReal_mul (by norm_num), ← mul_assoc] + norm_num + rw [h2] + calc 2 * ENNReal.ofReal (2⁻¹ * L) + _ ≤ 2 * (ENNReal.ofReal (1 - 2⁻¹) * (renyiDiv 2⁻¹ μ ν + ENNReal.ofReal (log 2))) := by gcongr + _ = renyiDiv 2⁻¹ μ ν + ENNReal.ofReal (log 2) := by + rw [← mul_assoc, ← ENNReal.ofReal_ofNat 2, ← ENNReal.ofReal_mul (by norm_num)] + norm_num + +end Renyi + +end ProbabilityTheory diff --git a/Statlib/Testing/Hellinger.lean b/Statlib/Testing/Hellinger.lean new file mode 100644 index 0000000..90a7649 --- /dev/null +++ b/Statlib/Testing/Hellinger.lean @@ -0,0 +1,94 @@ +/- +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.Hellinger.Renyi + +/-! +# Testing lower bounds from Rényi divergences of order less than `1` + +For probability measures `μ`, `ν`, an event `s` and `a ∈ (0, 1)`, +`μ(s) ^ a + ν(sᶜ) ^ (1 - a) ≥ exp (-(1 - a) * Rₐ(μ, ν))`. In particular, the two errors of a test +cannot both be small if the Rényi divergence is small. For `a = 1/2`, this gives a bound in terms of +the squared Hellinger distance: `√μ(s) + √ν(sᶜ) ≥ exp (-R_{1/2}(μ, ν) / 2) = 1 - H²(μ, ν)`. + +## Main statements + +* `exp_neg_mul_renyiDiv_le_add_rpow`: `exp (-(1 - a) * Rₐ(μ, ν)) ≤ μ(s) ^ a + ν(sᶜ) ^ (1 - a)`. +* `one_sub_sqHellinger_le_sqrt_add_sqrt`: `1 - H²(μ, ν) ≤ √μ(s) + √ν(sᶜ)`. +-/ + +@[expose] public section + +open Real MeasureTheory + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {α : Type*} {mα : MeasurableSpace α} {μ ν : Measure α} {a : ℝ} + +/-- **Testing lower bound** from the Rényi divergence: for probability measures `μ`, `ν`, an event +`s` and `a ∈ [0, 1]`, `exp (-(1 - a) * Rₐ(μ, ν)) ≤ μ(s) ^ a + ν(sᶜ) ^ (1 - a)`. The cases `a = 0` +and `a = 1` are trivial: the left-hand side is at most `1` and the right-hand side at least `1`. -/ +theorem exp_neg_mul_renyiDiv_le_add_rpow [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (s : Set α) (ha0 : 0 ≤ a) (ha1 : a ≤ 1) (h : renyiDiv a μ ν ≠ ∞) : + exp (-(1 - a) * (renyiDiv a μ ν).toReal) ≤ μ.real s ^ a + ν.real sᶜ ^ (1 - a) := by + rcases ha0.eq_or_lt with rfl | ha0 + · have : exp (-(renyiDiv 0 μ ν).toReal) ≤ 1 := exp_le_one_iff.mpr (by simp) + simp only [sub_zero, neg_mul, one_mul, rpow_zero, rpow_one] + linarith [measureReal_nonneg (μ := ν) (s := sᶜ)] + rcases ha1.eq_or_lt with rfl | ha1 + · simp + have ha1' : 0 ≤ 1 - a := sub_nonneg.mpr ha1.le + -- it suffices to prove the bound for the measurable set `F = toMeasurable μ s ⊇ s` + set F := toMeasurable μ s + have hF : MeasurableSet F := measurableSet_toMeasurable μ s + have h_le : μ.real F ^ a + ν.real Fᶜ ^ (1 - a) ≤ μ.real s ^ a + ν.real sᶜ ^ (1 - a) := by + have hFE : μ.real F = μ.real s := by simp [F, measureReal_def, measure_toMeasurable] + have h_compl : ν.real Fᶜ ^ (1 - a) ≤ ν.real sᶜ ^ (1 - a) := + rpow_le_rpow measureReal_nonneg + (measureReal_mono (Set.compl_subset_compl.mpr (subset_toMeasurable μ s))) ha1' + rw [hFE] + linarith + refine le_trans ?_ h_le + have h_ms : ¬ μ ⟂ₘ ν := (renyiDiv_eq_top_iff_mutuallySingular_of_lt_one ha0.le ha1).not.mp h + have h_int := integrable_rpow_rnDeriv_of_lt_one (μ := μ) (ν := ν) ha0.le ha1 + have h_pos := (integral_rpow_rnDeriv_pos_iff_not_mutuallySingular ha0.ne' h_int).mpr h_ms + have h_exp : exp (-(1 - a) * (renyiDiv a μ ν).toReal) = ∫ x, ((∂μ/∂ν) x).toReal ^ a ∂ν := 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] + rw [← mul_assoc, show -(1 - a) * (a - 1)⁻¹ = 1 by + rw [neg_sub, mul_inv_cancel₀ (sub_ne_zero.mpr ha1.ne)], one_mul, exp_log h_pos] + have h1 : μ.real F ^ a * ν.real F ^ (1 - a) ≤ μ.real F ^ a := + mul_le_of_le_one_right (by positivity) (rpow_le_one measureReal_nonneg measureReal_le_one ha1') + have h2 : μ.real Fᶜ ^ a * ν.real Fᶜ ^ (1 - a) ≤ ν.real Fᶜ ^ (1 - a) := + mul_le_of_le_one_left (by positivity) (rpow_le_one measureReal_nonneg measureReal_le_one ha0.le) + rw [h_exp, ← integral_add_compl hF h_int] + exact add_le_add + ((setIntegral_rpow_rnDeriv_le_rpow_mul_rpow_of_le_one ha0.le ha1.le F).trans h1) + ((setIntegral_rpow_rnDeriv_le_rpow_mul_rpow_of_le_one ha0.le ha1.le Fᶜ).trans h2) + +/-- **Testing lower bound** from the squared Hellinger distance: for probability measures `μ`, +`ν` and an event `s`, `1 - H²(μ, ν) ≤ √μ(s) + √ν(sᶜ)`. If `μ` and `ν` are not mutually singular, +`1 - H²(μ, ν) = exp (-R_{1/2}(μ, ν) / 2)` (`exp_neg_toReal_renyiDiv_inv_two_div_two`), and this is +the case `a = 1/2` of `exp_neg_mul_renyiDiv_le_add_rpow`. -/ +theorem one_sub_sqHellinger_le_sqrt_add_sqrt (μ ν : Measure α) [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] (s : Set α) : + 1 - (sqHellinger μ ν).toReal ≤ √(μ.real s) + √(ν.real sᶜ) := by + by_cases h_ms : μ ⟂ₘ ν + · rw [toReal_sqHellinger_eq_one_iff.mpr h_ms, sub_self] + positivity + have h_ne_top : renyiDiv 2⁻¹ μ ν ≠ ∞ := by + rwa [Ne, renyiDiv_eq_top_iff_mutuallySingular_of_lt_one (by norm_num) (by norm_num)] + have h := exp_neg_mul_renyiDiv_le_add_rpow s (by norm_num) (by norm_num) h_ne_top + rw [← exp_neg_toReal_renyiDiv_inv_two_div_two h_ms, sqrt_eq_rpow, sqrt_eq_rpow] + convert h using 2 + · ring + · norm_num + · norm_num + +end ProbabilityTheory diff --git a/Statlib/Testing/SampleComplexity.lean b/Statlib/Testing/SampleComplexity.lean new file mode 100644 index 0000000..df6421f --- /dev/null +++ b/Statlib/Testing/SampleComplexity.lean @@ -0,0 +1,212 @@ +/- +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.Basic.Real.ENatENNReal +public import Statlib.ForMathlib.MeasureTheory.Constructions.Pi +public import Statlib.Testing.Binary + +/-! +# Sample complexity + +In a sequence of estimation problems `(P n)_{n ∈ ℕ}`, for example the problems in which the data +consists of `n` i.i.d. samples, the sample complexity at risk level `δ` is the smallest `n` such +that the Bayes risk of `P n` is at most `δ`. + +## Main definitions + +* `priorSampleComplexity ℓ P π δ`: the sample complexity of Bayesian estimation for the sequence of + data generating kernels `P`, the loss `ℓ`, the prior `π` and the risk level `δ`. +* `binaryPriorSampleComplexity μ ν π δ`: the sample complexity of simple binary hypothesis testing + between `μ` and `ν` from i.i.d. samples, with prior `π` and risk level `δ`. + +## Main statements + +* `div_le_priorSampleComplexity_of_forall`, `priorSampleComplexity_le_div_add_one_of_forall`: lower + and upper bounds on the sample complexity from bounds on the Bayes risk at each `n`, of the form + `x / D ≤ n(δ)` and `n(δ) ≤ x / D + 1`. They are the common form of the bounds of + `Statlib.Testing.SampleComplexityBounds`. +* `bayesBinaryRisk_pi_le_of_le`: the Bayes binary risk between `μ^⊗m` and `ν^⊗m` is + non-increasing in `m`. +* `binaryPriorSampleComplexity_le_iff`: `n(μ, ν, π, δ) ≤ n ↔ B_π(μ^⊗n, ν^⊗n) ≤ δ`. +* `binaryPriorSampleComplexity_eq_zero_iff`: no sample is needed if and only if + `min (π {false}) (π {true}) ≤ δ`. + +## Implementation notes + +The sample complexity takes values in `ℕ∞`, with value `⊤` if the risk level `δ` is never reached. +It is defined for an arbitrary sequence of data generating kernels `P n : Kernel Θ (𝓩 n)`, not +only for `n` i.i.d. observations: the Bayes risk of `P n` need not be monotone in `n`, and the +characterization `n(δ) ≤ n ↔ R(P n) ≤ δ` holds under the hypothesis that it is +(`priorSampleComplexity_le_iff_of_antitone`). +-/ + +@[expose] public section + +open MeasureTheory + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +section General + +variable {Θ 𝓨 : Type*} {mΘ : MeasurableSpace Θ} [MeasurableSpace 𝓨] {𝓩 : ℕ → Type*} + [∀ n, MeasurableSpace (𝓩 n)] {ℓ : Θ → 𝓨 → ℝ≥0∞} {P : (n : ℕ) → Kernel Θ (𝓩 n)} + {π : Measure Θ} {δ : ℝ≥0∞} {n : ℕ} + +/-- The sample complexity of Bayesian estimation for a sequence of estimation problems with data +generating kernels `P n` (for example `n` i.i.d. observations), loss `ℓ`, prior `π` and risk +level `δ`: the smallest `n` such that the Bayes risk of `P n` is at most `δ`, or `⊤` if there is +no such `n`. -/ +noncomputable +def priorSampleComplexity (ℓ : Θ → 𝓨 → ℝ≥0∞) (P : (n : ℕ) → Kernel Θ (𝓩 n)) (π : Measure Θ) + (δ : ℝ≥0∞) : ℕ∞ := + ⨅ (n : ℕ) (_ : bayesRisk ℓ (P n) π ≤ δ), (n : ℕ∞) + +lemma priorSampleComplexity_le (h : bayesRisk ℓ (P n) π ≤ δ) : + priorSampleComplexity ℓ P π δ ≤ n := + iInf₂_le n h + +lemma le_priorSampleComplexity_iff {m : ℕ∞} : + m ≤ priorSampleComplexity ℓ P π δ ↔ ∀ n, bayesRisk ℓ (P n) π ≤ δ → m ≤ n := by + simp [priorSampleComplexity] + +lemma priorSampleComplexity_eq_top_iff : + priorSampleComplexity ℓ P π δ = ⊤ ↔ ∀ n, δ < bayesRisk ℓ (P n) π := by + simp [priorSampleComplexity, not_le] + +/-- The infimum defining the sample complexity is attained. -/ +lemma bayesRisk_le_of_priorSampleComplexity_eq (h : priorSampleComplexity ℓ P π δ = n) : + bayesRisk ℓ (P n) π ≤ δ := by + obtain ⟨m, hm⟩ : ∃ m, bayesRisk ℓ (P m) π ≤ δ := by + by_contra! h_not + simp [priorSampleComplexity_eq_top_iff.mpr h_not] at h + have hs : {m | bayesRisk ℓ (P m) π ≤ δ}.Nonempty := ⟨m, hm⟩ + -- the sample complexity is the cast of the infimum of the nonempty set `hs` of natural numbers + have h_eq : sInf {m | bayesRisk ℓ (P m) π ≤ δ} = n := + Nat.cast_inj.1 ((ENat.natCast_sInf hs).trans h) + exact h_eq ▸ Nat.sInf_mem hs + +/-- The sample complexity is `0` if and only if the risk level `δ` is reached without samples. -/ +lemma priorSampleComplexity_eq_zero_iff : + priorSampleComplexity ℓ P π δ = 0 ↔ bayesRisk ℓ (P 0) π ≤ δ := by + refine ⟨fun h ↦ bayesRisk_le_of_priorSampleComplexity_eq (by simpa using h), fun h ↦ ?_⟩ + simpa using priorSampleComplexity_le (n := 0) h + +/-- **Lower bound on the sample complexity**: if `x ≤ n * D` for every `n` such that the Bayes risk +of `P n` is at most `δ`, then `x / D` is at most the sample complexity. -/ +lemma div_le_priorSampleComplexity_of_forall {x D : ℝ≥0∞} + (h : ∀ n : ℕ, bayesRisk ℓ (P n) π ≤ δ → x ≤ n * D) : + x / D ≤ priorSampleComplexity ℓ P π δ := by + rcases eq_or_ne (priorSampleComplexity ℓ P π δ) ⊤ with htop | htop + · simp [htop] + obtain ⟨n, hn⟩ := ENat.ne_top_iff_exists.1 htop + rw [← hn, ENat.toENNReal_coe] + exact ENNReal.div_le_of_le_mul (h n (bayesRisk_le_of_priorSampleComplexity_eq hn.symm)) + +/-- **Upper bound on the sample complexity**: if the Bayes risk of `P n` is at most `δ` for every +`n` such that `x ≤ n * D`, then the sample complexity is at most `x / D + 1`. -/ +lemma priorSampleComplexity_le_div_add_one_of_forall {x D : ℝ≥0∞} + (h : ∀ n : ℕ, x ≤ n * D → bayesRisk ℓ (P n) π ≤ δ) : + priorSampleComplexity ℓ P π δ ≤ x / D + 1 := by + rcases eq_or_ne (x / D) ∞ with hxD | hxD + · simp [hxD] + -- `N = ⌊x / D⌋ + 1` samples suffice + obtain ⟨q, hq⟩ : ∃ q : ℝ≥0, (q : ℝ≥0∞) = x / D := ⟨_, ENNReal.coe_toNNReal hxD⟩ + have hN : priorSampleComplexity ℓ P π δ ≤ (⌊q⌋₊ + 1 : ℕ) := by + refine priorSampleComplexity_le (h _ ?_) + rw [← ENNReal.div_le_iff_le_mul (by simp) (by simp), ← hq] + exact_mod_cast (Nat.lt_floor_add_one q).le + calc (priorSampleComplexity ℓ P π δ : ℝ≥0∞) + _ ≤ ((⌊q⌋₊ + 1 : ℕ) : ℝ≥0∞) := by exact_mod_cast hN + _ ≤ x / D + 1 := by + rw [← hq, Nat.cast_add, Nat.cast_one] + gcongr + exact_mod_cast Nat.floor_le q.2 + +/-- If the Bayes risk is non-increasing in the number of samples, then the sample complexity is +at most `n` if and only if the Bayes risk of `P n` is at most `δ`. -/ +lemma priorSampleComplexity_le_iff_of_antitone (hP : Antitone fun n ↦ bayesRisk ℓ (P n) π) : + priorSampleComplexity ℓ P π δ ≤ n ↔ bayesRisk ℓ (P n) π ≤ δ := by + refine ⟨fun h ↦ ?_, priorSampleComplexity_le⟩ + obtain ⟨m, hm⟩ := ENat.ne_top_iff_exists.1 (ne_top_of_le_ne_top (ENat.natCast_ne_top n) h) + rw [← hm, Nat.cast_le] at h + exact (hP h).trans (bayesRisk_le_of_priorSampleComplexity_eq hm.symm) + +end General + +section Binary + +variable {𝓧 : Type*} {m𝓧 : MeasurableSpace 𝓧} + +/-- The Bayes binary risk between `μ^⊗m` and `ν^⊗m` is non-increasing in `m`. -/ +lemma bayesBinaryRisk_pi_le_of_le (μ ν : Measure 𝓧) [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] (π : Measure Bool) {n m : ℕ} (hnm : n ≤ m) : + bayesBinaryRisk (Measure.pi fun _ : Fin m ↦ μ) (Measure.pi fun _ : Fin m ↦ ν) π + ≤ bayesBinaryRisk (Measure.pi fun _ : Fin n ↦ μ) (Measure.pi fun _ : Fin n ↦ ν) π := by + have hf : Measurable (fun x (i : Fin n) ↦ x (Fin.castLE hnm i) : (Fin m → 𝓧) → Fin n → 𝓧) := by + fun_prop + have h := bayesBinaryRisk_le_bayesBinaryRisk_comp (Measure.pi fun _ : Fin m ↦ μ) + (Measure.pi fun _ : Fin m ↦ ν) π (Kernel.deterministic _ hf) + rwa [Measure.deterministic_comp_eq_map, Measure.deterministic_comp_eq_map, + Measure.pi_map_comp_of_injective _ (Fin.castLE_injective hnm), + Measure.pi_map_comp_of_injective _ (Fin.castLE_injective hnm)] at h + +/-- The sample complexity of simple binary hypothesis testing between `μ` and `ν` with prior `π` +and risk level `δ`: the smallest `n` such that the Bayes binary risk between the product measures +`μ^⊗n` and `ν^⊗n` is at most `δ`, or `⊤` if there is no such `n`. -/ +noncomputable +def binaryPriorSampleComplexity (μ ν : Measure 𝓧) (π : Measure Bool) (δ : ℝ≥0∞) : ℕ∞ := + priorSampleComplexity zeroOneLoss + (fun n ↦ Kernel.boolKernel (Measure.pi fun _ : Fin n ↦ μ) (Measure.pi fun _ : Fin n ↦ ν)) π δ + +variable {μ ν : Measure 𝓧} {π : Measure Bool} {δ : ℝ≥0∞} {n : ℕ} + +lemma binaryPriorSampleComplexity_le + (h : bayesBinaryRisk (Measure.pi fun _ : Fin n ↦ μ) (Measure.pi fun _ : Fin n ↦ ν) π ≤ δ) : + binaryPriorSampleComplexity μ ν π δ ≤ n := + priorSampleComplexity_le h + +lemma le_binaryPriorSampleComplexity_iff {m : ℕ∞} : + m ≤ binaryPriorSampleComplexity μ ν π δ ↔ ∀ n, + bayesBinaryRisk (Measure.pi fun _ : Fin n ↦ μ) (Measure.pi fun _ : Fin n ↦ ν) π ≤ δ → + m ≤ n := + le_priorSampleComplexity_iff + +lemma div_le_binaryPriorSampleComplexity_of_forall {x D : ℝ≥0∞} + (h : ∀ n : ℕ, bayesBinaryRisk (Measure.pi fun _ : Fin n ↦ μ) (Measure.pi fun _ : Fin n ↦ ν) π + ≤ δ → x ≤ n * D) : + x / D ≤ binaryPriorSampleComplexity μ ν π δ := + div_le_priorSampleComplexity_of_forall h + +lemma binaryPriorSampleComplexity_le_div_add_one_of_forall {x D : ℝ≥0∞} + (h : ∀ n : ℕ, x ≤ n * D → + bayesBinaryRisk (Measure.pi fun _ : Fin n ↦ μ) (Measure.pi fun _ : Fin n ↦ ν) π ≤ δ) : + binaryPriorSampleComplexity μ ν π δ ≤ x / D + 1 := + priorSampleComplexity_le_div_add_one_of_forall h + +lemma bayesBinaryRisk_le_of_binaryPriorSampleComplexity_eq + (h : binaryPriorSampleComplexity μ ν π δ = n) : + bayesBinaryRisk (Measure.pi fun _ : Fin n ↦ μ) (Measure.pi fun _ : Fin n ↦ ν) π ≤ δ := + bayesRisk_le_of_priorSampleComplexity_eq h + +lemma binaryPriorSampleComplexity_le_iff [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] : + binaryPriorSampleComplexity μ ν π δ ≤ n + ↔ bayesBinaryRisk (Measure.pi fun _ : Fin n ↦ μ) (Measure.pi fun _ : Fin n ↦ ν) π ≤ δ := + priorSampleComplexity_le_iff_of_antitone fun _ _ h ↦ bayesBinaryRisk_pi_le_of_le μ ν π h + +/-- The sample complexity of simple binary hypothesis testing is `0` if and only if +`min (π {false}) (π {true}) ≤ δ`. -/ +lemma binaryPriorSampleComplexity_eq_zero_iff : + binaryPriorSampleComplexity μ ν π δ = 0 ↔ min (π {false}) (π {true}) ≤ δ := by + rw [binaryPriorSampleComplexity, priorSampleComplexity_eq_zero_iff, ← bayesBinaryRisk, + Measure.pi_of_empty, Measure.pi_of_empty] + simp + +end Binary + +end ProbabilityTheory diff --git a/Statlib/Testing/SampleComplexityBounds.lean b/Statlib/Testing/SampleComplexityBounds.lean new file mode 100644 index 0000000..0e35329 --- /dev/null +++ b/Statlib/Testing/SampleComplexityBounds.lean @@ -0,0 +1,233 @@ +/- +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.Prod +public import Statlib.Testing.BinaryRenyi +public import Statlib.Testing.Fano +public import Statlib.Testing.SampleComplexity + +/-! +# Bounds on the sample complexity of simple binary hypothesis testing + +Let `n(μ, ν, α, δ)` be the sample complexity of simple binary hypothesis testing between `μ` and +`ν` with prior `(α, 1 - α)` at risk level `δ` (`binaryPriorSampleComplexity`): the smallest `n` such +that the Bayes binary risk between the product measures `μ^⊗n` and `ν^⊗n` is at most `δ`. We prove +two lower bounds and an upper bound. + +* From the binary Fano inequality and the subadditivity of the Jensen-Shannon divergence on + products, `n(μ, ν, α, δ) ≥ (h₂(α) - h₂(δ)) / JS_α(μ, ν)` for `δ ≤ 1/2`, where `h₂` is the binary + entropy. +* From the Rényi lower bound on the Bayes risk and the tensorization of the Rényi divergence, + `n(μ, ν, α, δ) ≥ log (α / (2 δ)) / R_{1/2}(μ, ν)` for `α ≤ 1/2`. +* From the Rényi upper bound on the Bayes risk + `B_α(μ^⊗n, ν^⊗n) ≤ α ^ a (1 - α) ^ (1 - a) exp (-n (1 - a) Rₐ(μ, ν))`, for every `a ∈ (0, 1)` and + `δ ≠ 0`, `n(μ, ν, α, δ) ≤ (a log (α / δ) + (1 - a) log ((1 - α) / δ)) / ((1 - a) Rₐ(μ, ν)) + 1`. + +Each bound is first proved for a fixed number of samples `n`: if the Bayes binary risk of `μ^⊗n` +and `ν^⊗n` is at most `δ` then `x ≤ n * D` (lower bounds), or conversely (upper bound). The bounds +on the sample complexity follow from `div_le_binaryPriorSampleComplexity_of_forall` and +`binaryPriorSampleComplexity_le_div_add_one_of_forall`. + +## Main statements + +* `ofReal_binEntropy_sub_binEntropy_le_mul_jensenShannon`, + `ofReal_binEntropy_sub_binEntropy_div_jensenShannon_le_binaryPriorSampleComplexity`: the + Jensen-Shannon lower bound. +* `ofReal_log_div_two_mul_le_mul_renyiDiv`, + `ofReal_log_div_two_mul_div_renyiDiv_le_binaryPriorSampleComplexity`: the Rényi lower bound. +* `bayesBinaryRisk_pi_le_of_ofReal_le_mul_renyiDiv`, + `binaryPriorSampleComplexity_le_ofReal_div_mul_renyiDiv_add_one`: the Rényi upper bound. +* `binaryPriorSampleComplexity_le_of_iInf_le`: `n(μ, ν, ρ, δ) ≤ n` if the infimum over `a ∈ (0, 1)` + of the bounds `ρ({false}) ^ a ρ({true}) ^ (1 - a) exp (-n (1 - a) Rₐ(μ, ν))` on the Bayes binary + risk is at most `δ`, for any prior `ρ`. + +## Implementation notes + +The sample complexity takes values in `ℕ∞` and is cast to `ℝ≥0∞`. The bounds are stated as +`x / D ≤ n(μ, ν, α, δ)` and `n(μ, ν, α, δ) ≤ x / D + 1` in `ℝ≥0∞`, which remain meaningful when the +divergence `D` is `0` or `∞`. The real numbers `x` may be negative and appear through +`ENNReal.ofReal`; the risk level `δ` appears in them through `ENNReal.toReal`. + +## References + +* A. Pensia, V. Jog, P.-L. Loh, *The sample complexity of simple binary hypothesis testing*, COLT + 2024. +-/ + +@[expose] public section + +open MeasureTheory Real InformationTheory + +open scoped ENNReal NNReal + +namespace ProbabilityTheory + +variable {𝓧 : Type*} {m𝓧 : MeasurableSpace 𝓧} {μ ν : Measure 𝓧} [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] {α : ℝ≥0} {a : ℝ} {δ : ℝ≥0∞} {n : ℕ} + +/-! ### Lower bound from the Jensen-Shannon divergence -/ + +/-- **Jensen-Shannon lower bound on the number of samples**: if the Bayes binary risk between +`μ^⊗n` and `ν^⊗n` for the prior `(α, 1 - α)` is at most `δ ≤ 1/2`, then +`h₂(α) - h₂(δ) ≤ n JS_α(μ, ν)`. -/ +theorem ofReal_binEntropy_sub_binEntropy_le_mul_jensenShannon (hα : α ≤ 1) (hδ : δ ≤ 2⁻¹) + (h : bayesBinaryRisk (Measure.pi fun _ : Fin n ↦ μ) (Measure.pi fun _ : Fin n ↦ ν) + (Measure.boolMeasure α ((1 - α : ℝ≥0) : ℝ≥0∞)) ≤ δ) : + ENNReal.ofReal (binEntropy α - binEntropy δ.toReal) ≤ n * jensenShannon α μ ν := by + have h_fano := ofReal_binEntropy_sub_binEntropy_bayesBinaryRisk_le_jensenShannon + (Measure.pi fun _ : Fin n ↦ μ) (Measure.pi fun _ : Fin n ↦ ν) hα + have h_js := jensenShannon_pi_const_le hα (ι := Fin n) μ ν + rw [Fintype.card_fin] at h_js + refine le_trans (ENNReal.ofReal_le_ofReal ?_) (h_fano.trans h_js) + have hδ_top : δ ≠ ∞ := ne_top_of_le_ne_top (by simp) hδ + have hδ_half : δ.toReal ≤ 2⁻¹ := by simpa using ENNReal.toReal_mono (by simp) hδ + gcongr + exact binEntropy_strictMonoOn.monotoneOn ⟨ENNReal.toReal_nonneg, + (ENNReal.toReal_mono hδ_top h).trans hδ_half⟩ + ⟨ENNReal.toReal_nonneg, hδ_half⟩ (ENNReal.toReal_mono hδ_top h) + +variable (μ ν) in +/-- **Jensen-Shannon lower bound on the sample complexity** of simple binary hypothesis testing: +for `δ ≤ 1/2`, `n(μ, ν, α, δ) ≥ (h₂(α) - h₂(δ)) / JS_α(μ, ν)`. -/ +theorem ofReal_binEntropy_sub_binEntropy_div_jensenShannon_le_binaryPriorSampleComplexity + (hα : α ≤ 1) (hδ : δ ≤ 2⁻¹) : + ENNReal.ofReal (binEntropy α - binEntropy δ.toReal) / jensenShannon α μ ν + ≤ binaryPriorSampleComplexity μ ν (Measure.boolMeasure α ((1 - α : ℝ≥0) : ℝ≥0∞)) δ := + div_le_binaryPriorSampleComplexity_of_forall fun _ h ↦ + ofReal_binEntropy_sub_binEntropy_le_mul_jensenShannon hα hδ h + +/-! ### Lower bound from the Rényi divergence -/ + +/-- **Rényi lower bound on the number of samples**: for `α ≤ 1/2`, if the Bayes binary risk +between `μ^⊗n` and `ν^⊗n` for the prior `(α, 1 - α)` is at most `δ`, then +`log (α / (2 δ)) ≤ n R_{1/2}(μ, ν)`. -/ +theorem ofReal_log_div_two_mul_le_mul_renyiDiv (hα : α ≤ 2⁻¹) + (h : bayesBinaryRisk (Measure.pi fun _ : Fin n ↦ μ) (Measure.pi fun _ : Fin n ↦ ν) + (Measure.boolMeasure α ((1 - α : ℝ≥0) : ℝ≥0∞)) ≤ δ) : + ENNReal.ofReal (log (α / (2 * δ.toReal))) ≤ n * renyiDiv 2⁻¹ μ ν := by + rcases eq_or_ne α 0 with rfl | hα0 + · simp + have hα1 : α < 1 := hα.trans_lt (by norm_num) + rw [← Fintype.card_fin n, ← renyiDiv_pi_const (by norm_num)] + by_cases hδ_top : δ = ∞ + · simp [hδ_top] + set B := bayesBinaryRisk (Measure.pi fun _ : Fin n ↦ μ) (Measure.pi fun _ : Fin n ↦ ν) + (Measure.boolMeasure α ((1 - α : ℝ≥0) : ℝ≥0∞)) with hB + rcases eq_or_ne B 0 with hB0 | hB0 + · -- the Bayes risk vanishes: the product measures are mutually singular + have h_ms := (bayesBinaryRisk_eq_zero_iff_mutuallySingular (by simpa using hα0) + (by simpa [tsub_eq_zero_iff_le, not_le] using hα1)).1 hB0 + rw [(renyiDiv_eq_top_iff_mutuallySingular_of_lt_one (by norm_num) (by norm_num)).2 h_ms] + exact le_top + have hB_pos : 0 < B.toReal := ENNReal.toReal_pos hB0 (ne_top_of_le_ne_top hδ_top h) + have hBδ : B.toReal ≤ δ.toReal := ENNReal.toReal_mono hδ_top h + have hα0' : (0 : ℝ) < α := by exact_mod_cast pos_iff_ne_zero.2 hα0 + have h_renyi := ofReal_log_div_bayesBinaryRisk_le_renyiDiv_add + (Measure.pi fun _ : Fin n ↦ μ) (Measure.pi fun _ : Fin n ↦ ν) hα + rw [← hB] at h_renyi + calc ENNReal.ofReal (log (α / (2 * δ.toReal))) + _ ≤ ENNReal.ofReal (log (α / B.toReal) - log 2) := by + refine ENNReal.ofReal_le_ofReal ?_ + have hδ_pos : 0 < δ.toReal := hB_pos.trans_le hBδ + rw [Real.log_div hα0'.ne' (by positivity), Real.log_mul two_ne_zero hδ_pos.ne', + Real.log_div hα0'.ne' hB_pos.ne'] + linarith [Real.log_le_log hB_pos hBδ] + _ = ENNReal.ofReal (log (α / B.toReal)) - ENNReal.ofReal (log 2) := + ENNReal.ofReal_sub _ (Real.log_nonneg one_le_two) + _ ≤ _ := tsub_le_iff_right.2 h_renyi + +variable (μ ν δ) in +/-- **Rényi lower bound on the sample complexity** of simple binary hypothesis testing: for +`α ≤ 1/2`, `n(μ, ν, α, δ) ≥ log (α / (2 δ)) / R_{1/2}(μ, ν)`. -/ +theorem ofReal_log_div_two_mul_div_renyiDiv_le_binaryPriorSampleComplexity (hα : α ≤ 2⁻¹) : + ENNReal.ofReal (log (α / (2 * δ.toReal))) / renyiDiv 2⁻¹ μ ν + ≤ binaryPriorSampleComplexity μ ν (Measure.boolMeasure α ((1 - α : ℝ≥0) : ℝ≥0∞)) δ := + div_le_binaryPriorSampleComplexity_of_forall fun _ h ↦ ofReal_log_div_two_mul_le_mul_renyiDiv hα h + +/-! ### Upper bound from the Rényi divergence -/ + +variable (μ ν) in +/-- For `a ∈ (0, 1)`, the Bayes binary risk between `μ^⊗n` and `ν^⊗n` is at most +`ρ({false}) ^ a * ρ({true}) ^ (1 - a) * exp (-(1 - a) * (n * Rₐ(μ, ν)))`. -/ +theorem bayesBinaryRisk_pi_le_mul_exp_renyiDiv (ρ : Measure Bool) [IsFiniteMeasure ρ] (ha0 : 0 < a) + (ha1 : a < 1) (n : ℕ) : + bayesBinaryRisk (Measure.pi fun _ : Fin n ↦ μ) (Measure.pi fun _ : Fin n ↦ ν) ρ + ≤ ρ {false} ^ a * ρ {true} ^ (1 - a) + * EReal.exp (-(((1 - a : ℝ) : EReal) * ((n * renyiDiv a μ ν : ℝ≥0∞) : EReal))) := by + refine (bayesBinaryRisk_le_mul_exp_renyiDiv_of_isProbabilityMeasure _ _ ρ ha0 ha1).trans_eq ?_ + rw [renyiDiv_pi_const ha0.le, Fintype.card_fin] + +/-- **Rényi upper bound on the number of samples**: for `a ∈ (0, 1)` and `δ ≠ 0`, if +`a log (α / δ) + (1 - a) log ((1 - α) / δ) ≤ n (1 - a) Rₐ(μ, ν)`, then the Bayes binary risk between +`μ^⊗n` and `ν^⊗n` for the prior `(α, 1 - α)` is at most `δ`. -/ +theorem bayesBinaryRisk_pi_le_of_ofReal_le_mul_renyiDiv (ha0 : 0 < a) (ha1 : a < 1) (hδ : δ ≠ 0) + (h : ENNReal.ofReal (a * log (α / δ.toReal) + (1 - a) * log ((1 - α) / δ.toReal)) + ≤ n * (ENNReal.ofReal (1 - a) * renyiDiv a μ ν)) : + bayesBinaryRisk (Measure.pi fun _ : Fin n ↦ μ) (Measure.pi fun _ : Fin n ↦ ν) + (Measure.boolMeasure α ((1 - α : ℝ≥0) : ℝ≥0∞)) ≤ δ := by + refine (bayesBinaryRisk_pi_le_mul_exp_renyiDiv μ ν _ ha0 ha1 n).trans ?_ + rw [Measure.boolMeasure_apply_false, Measure.boolMeasure_apply_true] + rcases eq_or_ne δ ∞ with rfl | hδ_top + · exact le_top + -- if the prior is a Dirac mass, the bound vanishes + rcases eq_or_ne α 0 with rfl | hα0 + · simp [ENNReal.zero_rpow_of_pos ha0] + rcases le_or_gt 1 α with hα1 | hα1 + · simp [tsub_eq_zero_of_le hα1, ENNReal.zero_rpow_of_pos (sub_pos.2 ha1)] + -- if `n Rₐ(μ, ν) = ∞`, the bound vanishes + set D := (n : ℝ≥0∞) * renyiDiv a μ ν with hD + rcases eq_or_ne D ∞ with hD_top | hD_top + · rw [hD_top, EReal.coe_ennreal_top, EReal.mul_top_of_pos (by exact_mod_cast sub_pos.2 ha1), + EReal.neg_top, EReal.exp_bot, mul_zero] + exact zero_le + -- otherwise, write the bound as `ENNReal.ofReal` of a real number and compare the logarithms + have hδ_pos : 0 < δ.toReal := ENNReal.toReal_pos hδ hδ_top + have hα0' : (0 : ℝ) < α := by exact_mod_cast pos_iff_ne_zero.2 hα0 + have hα1' : (0 : ℝ) < 1 - α := sub_pos.2 (by exact_mod_cast hα1) + have h_exp : EReal.exp (-(((1 - a : ℝ) : EReal) * (D : EReal))) + = ENNReal.ofReal (exp (-((1 - a) * D.toReal))) := by + rw [← EReal.coe_ennreal_toReal hD_top, ← EReal.coe_mul, ← EReal.coe_neg, EReal.exp_coe] + have h_α : ((α : ℝ≥0∞)) ^ a = ENNReal.ofReal ((α : ℝ) ^ a) := by + rw [← ENNReal.ofReal_coe_nnreal, ENNReal.ofReal_rpow_of_nonneg α.coe_nonneg ha0.le] + have h_α' : (((1 - α : ℝ≥0) : ℝ≥0∞)) ^ (1 - a) = ENNReal.ofReal ((1 - (α : ℝ)) ^ (1 - a)) := by + rw [← ENNReal.ofReal_coe_nnreal, NNReal.coe_sub hα1.le, NNReal.coe_one, + ENNReal.ofReal_rpow_of_nonneg hα1'.le (by linarith)] + rw [h_exp, h_α, h_α', ← ENNReal.ofReal_mul (by positivity), ← ENNReal.ofReal_mul (by positivity), + ENNReal.ofReal_le_iff_le_toReal hδ_top] + have h_eq : (α : ℝ) ^ a * (1 - (α : ℝ)) ^ (1 - a) * exp (-((1 - a) * D.toReal)) + = exp (a * log α + (1 - a) * log (1 - α) - (1 - a) * D.toReal) := by + rw [rpow_def_of_pos hα0', rpow_def_of_pos hα1', ← exp_add, ← exp_add] + ring_nf + rw [h_eq, ← exp_log hδ_pos, exp_le_exp] + rw [mul_left_comm, ← hD, ← ENNReal.ofReal_toReal hD_top, ← ENNReal.ofReal_mul (by linarith), + ENNReal.ofReal_le_ofReal_iff (mul_nonneg (by linarith) ENNReal.toReal_nonneg), + Real.log_div hα0'.ne' hδ_pos.ne', Real.log_div hα1'.ne' hδ_pos.ne'] at h + linarith + +variable (μ ν α) in +/-- **Rényi upper bound on the sample complexity** of simple binary hypothesis testing: for +`a ∈ (0, 1)` and `δ ≠ 0`, +`n(μ, ν, α, δ) ≤ (a log (α / δ) + (1 - a) log ((1 - α) / δ)) / ((1 - a) Rₐ(μ, ν)) + 1`. -/ +theorem binaryPriorSampleComplexity_le_ofReal_div_mul_renyiDiv_add_one (ha0 : 0 < a) (ha1 : a < 1) + (hδ : δ ≠ 0) : + binaryPriorSampleComplexity μ ν (Measure.boolMeasure α ((1 - α : ℝ≥0) : ℝ≥0∞)) δ + ≤ ENNReal.ofReal (a * log (α / δ.toReal) + (1 - a) * log ((1 - α) / δ.toReal)) + / (ENNReal.ofReal (1 - a) * renyiDiv a μ ν) + 1 := + binaryPriorSampleComplexity_le_div_add_one_of_forall fun _ h ↦ + bayesBinaryRisk_pi_le_of_ofReal_le_mul_renyiDiv ha0 ha1 hδ h + +/-- If the infimum over `a ∈ (0, 1)` of +`ρ({false}) ^ a * ρ({true}) ^ (1 - a) * exp (-(1 - a) * (n * Rₐ(μ, ν)))` is at most `δ`, then the +sample complexity of simple binary hypothesis testing with prior `ρ` is at most `n`. -/ +theorem binaryPriorSampleComplexity_le_of_iInf_le (ρ : Measure Bool) [IsFiniteMeasure ρ] + (h : ⨅ a ∈ Set.Ioo (0 : ℝ) 1, ρ {false} ^ a * ρ {true} ^ (1 - a) + * EReal.exp (-(((1 - a : ℝ) : EReal) * ((n * renyiDiv a μ ν : ℝ≥0∞) : EReal))) ≤ δ) : + binaryPriorSampleComplexity μ ν ρ δ ≤ n := + binaryPriorSampleComplexity_le + ((le_iInf₂ fun _ ha ↦ bayesBinaryRisk_pi_le_mul_exp_renyiDiv μ ν ρ ha.1 ha.2 n).trans h) + +end ProbabilityTheory diff --git a/Statlib/Testing/Sequential/Basic.lean b/Statlib/Testing/Sequential/Basic.lean new file mode 100644 index 0000000..fafccce --- /dev/null +++ b/Statlib/Testing/Sequential/Basic.lean @@ -0,0 +1,244 @@ +/- +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.MeasureTheory.Measure.LogLikelihoodRatio +public import Mathlib.Probability.ProductMeasure +public import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.RNDerivProd +public import Statlib.ForMathlib.MeasureTheory.Measure.Decomposition.RNDerivTrim +public import Statlib.ForMathlib.MeasureTheory.Measure.Trim +public import Statlib.ForMathlib.Probability.Process.Filtration +public import Statlib.ForMathlib.Probability.Process.Stopping +public import Statlib.ForMathlib.Probability.ProductMeasure + +/-! +# Likelihood ratios of i.i.d. sequences observed up to a stopping time + +For a probability measure `μ` on `𝓧`, let `μ^ℕ = Measure.infinitePi (fun _ : ℕ ↦ μ)` be the law of +an i.i.d. sequence with law `μ`. We consider the filtration `Filtration.piLE` on `ℕ → 𝓧`, in which +the σ-algebra at time `n` is generated by the first `n + 1` coordinates `ω 0, …, ω n`, and a +stopping time `τ` for that filtration, with values in `ℕ`. The observations available at time `τ` +are `ω 0, …, ω (τ ω)`, and `μ_τ` denotes the restriction of `μ^ℕ` to the σ-algebra of the stopping +time. + +Note that `μ^ℕ` and `ν^ℕ` are mutually singular as soon as `μ ≠ ν`: we cannot obtain the +Radon-Nikodym derivatives of the restrictions from a Radon-Nikodym derivative `∂μ^ℕ/∂ν^ℕ`. + +## Main statements + +* `rnDeriv_trim_piLE_infinitePi`: the Radon-Nikodym derivative of the restrictions of `μ^ℕ` and + `ν^ℕ` to the σ-algebra at time `n` is `ω ↦ ∏ i ≤ n, ∂μ/∂ν (ω i)`. +* `trim_piLE_infinitePi_eq_withDensity`: for `μ ≪ ν`, the restriction of `μ^ℕ` to the σ-algebra at + time `n` has density `ω ↦ ∏ i ≤ n, ∂μ/∂ν (ω i)` with respect to the restriction of `ν^ℕ`. +* `rnDeriv_trim_stoppingTime_infinitePi`, `trim_stoppingTime_infinitePi_eq_withDensity`: the same + statements for the σ-algebra of the stopping time `τ`, with density + `ω ↦ ∏ i ≤ τ ω, ∂μ/∂ν (ω i)`. +* `llr_trim_piLE_infinitePi_ae_eq`, `llr_trim_stoppingTime_infinitePi_ae_eq`: for `μ ≪ ν`, the + log-likelihood ratios of these restrictions are `μ^ℕ`-almost surely equal to + `ω ↦ ∑ i ≤ n, llr μ ν (ω i)` and `ω ↦ ∑ i ≤ τ ω, llr μ ν (ω i)`. + +## Implementation notes + +The stopping time `τ` takes values in `ℕ` and the stopping time property is stated for its coercion +`fun ω ↦ (τ ω : WithTop ℕ)`, as required by `MeasureTheory.IsStoppingTime`. +-/ + +@[expose] public section + +open MeasureTheory Filtration + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {𝓧 : Type*} {m𝓧 : MeasurableSpace 𝓧} {μ ν : Measure 𝓧} + +section Filtration + +/-- A product of functions of the first `n + 1` coordinates is measurable at time `n`. -/ +lemma measurable_piLE_prod (n : ℕ) {f : 𝓧 → ℝ≥0∞} (hf : Measurable f) : + Measurable[piLE (X := fun _ : ℕ ↦ 𝓧) n] fun ω ↦ ∏ i ∈ Finset.Iic n, f (ω i) := + Finset.measurable_prod _ fun _ hi ↦ hf.comp (measurable_piLE_apply (Finset.mem_Iic.mp hi)) + +/-- The Radon-Nikodym derivative of the restrictions of `μ^ℕ` and `ν^ℕ` to the σ-algebra generated +by the first `n + 1` coordinates is `ω ↦ ∏ i ≤ n, ∂μ/∂ν (ω i)`. -/ +lemma rnDeriv_trim_piLE_infinitePi [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] (n : ℕ) : + ((Measure.infinitePi fun _ : ℕ ↦ μ).trim ((piLE (X := fun _ : ℕ ↦ 𝓧)).le n)).rnDeriv + ((Measure.infinitePi fun _ : ℕ ↦ ν).trim ((piLE (X := fun _ : ℕ ↦ 𝓧)).le n)) + =ᵐ[(Measure.infinitePi fun _ : ℕ ↦ ν).trim ((piLE (X := fun _ : ℕ ↦ 𝓧)).le n)] + fun ω ↦ ∏ i ∈ Finset.Iic n, μ.rnDeriv ν (ω i) := by + have hg := Preorder.measurable_restrictLe (X := fun _ : ℕ ↦ 𝓧) n + refine (rnDeriv_trim_comap_ae_eq hg).trans (ae_eq_trim_of_measurable _ + ((Measure.measurable_rnDeriv _ _).comp (comap_measurable _)) + (measurable_piLE_prod n (Measure.measurable_rnDeriv _ _)) ?_) + have h_pi := Measure.rnDeriv_pi (μ := fun _ : Set.Iic n ↦ μ) (ν := fun _ ↦ ν) + rw [← Measure.infinitePi_map_restrictLe (fun _ ↦ ν) n, + ← Measure.infinitePi_map_restrictLe (fun _ ↦ μ) n] at h_pi + filter_upwards [ae_of_ae_map hg.aemeasurable h_pi] with ω hω + rw [hω] + exact (Finset.prod_subtype (Finset.Iic n) (fun _ ↦ by simp) (fun i ↦ μ.rnDeriv ν (ω i))).symm + +/-- For `μ ≪ ν`, the restriction of `μ^ℕ` to the σ-algebra generated by the first `n + 1` +coordinates is absolutely continuous with respect to the restriction of `ν^ℕ`. -/ +lemma absolutelyContinuous_trim_piLE_infinitePi [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (hμν : μ ≪ ν) (n : ℕ) : + (Measure.infinitePi fun _ : ℕ ↦ μ).trim ((piLE (X := fun _ : ℕ ↦ 𝓧)).le n) + ≪ (Measure.infinitePi fun _ : ℕ ↦ ν).trim ((piLE (X := fun _ : ℕ ↦ 𝓧)).le n) := by + refine (absolutelyContinuous_trim_comap_iff (Preorder.measurable_restrictLe n)).mpr ?_ + rw [Measure.infinitePi_map_restrictLe, Measure.infinitePi_map_restrictLe, + Measure.pi_eq_withDensity_prod_rnDeriv fun _ ↦ hμν] + exact withDensity_absolutelyContinuous _ _ + +/-- For `μ ≪ ν`, the restriction of `μ^ℕ` to the σ-algebra generated by the first `n + 1` +coordinates has density `ω ↦ ∏ i ≤ n, ∂μ/∂ν (ω i)` with respect to the restriction of `ν^ℕ`. -/ +lemma trim_piLE_infinitePi_eq_withDensity [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (hμν : μ ≪ ν) (n : ℕ) : + (Measure.infinitePi fun _ : ℕ ↦ μ).trim ((piLE (X := fun _ : ℕ ↦ 𝓧)).le n) + = ((Measure.infinitePi fun _ : ℕ ↦ ν).trim ((piLE (X := fun _ : ℕ ↦ 𝓧)).le n)).withDensity + fun ω ↦ ∏ i ∈ Finset.Iic n, μ.rnDeriv ν (ω i) := by + conv_lhs => + rw [← Measure.withDensity_rnDeriv_eq _ _ (absolutelyContinuous_trim_piLE_infinitePi hμν n)] + exact withDensity_congr_ae (rnDeriv_trim_piLE_infinitePi n) + +/-- For `μ ≪ ν`, `μ^ℕ`-almost surely, `log (∏ i ∈ s, ∂μ/∂ν (ω i)) = ∑ i ∈ s, llr μ ν (ω i)` for +all finite sets `s`. -/ +lemma ae_log_prod_rnDeriv_eq_sum_llr [IsProbabilityMeasure μ] [SigmaFinite ν] (hμν : μ ≪ ν) : + ∀ᵐ ω ∂(Measure.infinitePi fun _ : ℕ ↦ μ), ∀ s : Finset ℕ, + Real.log (∏ i ∈ s, μ.rnDeriv ν (ω i)).toReal = ∑ i ∈ s, llr μ ν (ω i) := by + have h_pos : ∀ᵐ ω ∂(Measure.infinitePi fun _ : ℕ ↦ μ), ∀ i, (μ.rnDeriv ν (ω i)).toReal ≠ 0 := by + refine ae_all_iff.2 fun i ↦ (measurePreserving_eval_infinitePi (fun _ : ℕ ↦ μ) i) + |>.quasiMeasurePreserving.ae (p := fun x ↦ (μ.rnDeriv ν x).toReal ≠ 0) ?_ + filter_upwards [Measure.rnDeriv_pos hμν, hμν.ae_le (Measure.rnDeriv_lt_top μ ν)] with x h1 h2 + exact ENNReal.toReal_ne_zero.mpr ⟨h1.ne', h2.ne⟩ + filter_upwards [h_pos] with ω hω s + rw [ENNReal.toReal_prod, Real.log_prod fun i _ ↦ hω i] + rfl + +/-- For `μ ≪ ν`, the log-likelihood ratio of the restrictions of `μ^ℕ` and `ν^ℕ` to the σ-algebra +generated by the first `n + 1` coordinates is `ω ↦ ∑ i ≤ n, llr μ ν (ω i)`. -/ +lemma llr_trim_piLE_infinitePi_ae_eq [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (hμν : μ ≪ ν) (n : ℕ) : + llr ((Measure.infinitePi fun _ : ℕ ↦ μ).trim ((piLE (X := fun _ : ℕ ↦ 𝓧)).le n)) + ((Measure.infinitePi fun _ : ℕ ↦ ν).trim ((piLE (X := fun _ : ℕ ↦ 𝓧)).le n)) + =ᵐ[Measure.infinitePi fun _ : ℕ ↦ μ] fun ω ↦ ∑ i ∈ Finset.Iic n, llr μ ν (ω i) := by + filter_upwards [ae_of_ae_trim _ ((absolutelyContinuous_trim_piLE_infinitePi hμν n).ae_le + (rnDeriv_trim_piLE_infinitePi (μ := μ) n)), ae_log_prod_rnDeriv_eq_sum_llr hμν] + with ω h_rn h_log + rw [llr, h_rn, h_log] + +end Filtration + +section StoppingTime + +variable {τ : (ℕ → 𝓧) → ℕ} + +/-- A product of functions of the observations up to a stopping time `τ` is measurable with respect +to the σ-algebra of `τ`. -/ +lemma measurable_stoppingTime_prod + (hτ : IsStoppingTime (piLE (X := fun _ : ℕ ↦ 𝓧)) (fun ω ↦ (τ ω : WithTop ℕ))) + {f : 𝓧 → ℝ≥0∞} (hf : Measurable f) : + Measurable[hτ.measurableSpace] fun ω ↦ ∏ i ∈ Finset.Iic (τ ω), f (ω i) := by + have h_adapted : StronglyAdapted (piLE (X := fun _ : ℕ ↦ 𝓧)) + (fun n ω ↦ ∏ i ∈ Finset.Iic n, f (ω i)) := + fun n ↦ (measurable_piLE_prod n hf).stronglyMeasurable + exact measurable_stoppedValue h_adapted.isStronglyProgressive_of_discrete hτ + +/-- For `μ ≪ ν` and a stopping time `τ` with values in `ℕ`, the restriction of `μ^ℕ` to the +σ-algebra of `τ` has density `ω ↦ ∏ i ≤ τ ω, ∂μ/∂ν (ω i)` with respect to the restriction of +`ν^ℕ`. -/ +lemma trim_stoppingTime_infinitePi_eq_withDensity [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] (hμν : μ ≪ ν) + (hτ : IsStoppingTime (piLE (X := fun _ : ℕ ↦ 𝓧)) (fun ω ↦ (τ ω : WithTop ℕ))) : + (Measure.infinitePi fun _ : ℕ ↦ μ).trim hτ.measurableSpace_le + = ((Measure.infinitePi fun _ : ℕ ↦ ν).trim hτ.measurableSpace_le).withDensity + fun ω ↦ ∏ i ∈ Finset.Iic (τ ω), μ.rnDeriv ν (ω i) := + trim_stoppingTime_eq_withDensity (ℱ := piLE (X := fun _ : ℕ ↦ 𝓧)) + (P := Measure.infinitePi fun _ : ℕ ↦ μ) (Q := Measure.infinitePi fun _ : ℕ ↦ ν) + (L := fun n ω ↦ ∏ i ∈ Finset.Iic n, μ.rnDeriv ν (ω i)) + (fun n ↦ measurable_piLE_prod n (μ.measurable_rnDeriv ν)) + (trim_piLE_infinitePi_eq_withDensity hμν) hτ + +/-- For `μ ≪ ν`, the restriction of `μ^ℕ` to the σ-algebra of a stopping time is absolutely +continuous with respect to the restriction of `ν^ℕ`. -/ +lemma absolutelyContinuous_trim_stoppingTime_infinitePi [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] (hμν : μ ≪ ν) + (hτ : IsStoppingTime (piLE (X := fun _ : ℕ ↦ 𝓧)) (fun ω ↦ (τ ω : WithTop ℕ))) : + (Measure.infinitePi fun _ : ℕ ↦ μ).trim hτ.measurableSpace_le + ≪ (Measure.infinitePi fun _ : ℕ ↦ ν).trim hτ.measurableSpace_le := by + rw [trim_stoppingTime_infinitePi_eq_withDensity hμν hτ] + exact withDensity_absolutelyContinuous _ _ + +/-- For a stopping time `τ` with values in `ℕ`, the Radon-Nikodym derivative of the restrictions of +`μ^ℕ` and `ν^ℕ` to the σ-algebra of `τ` is `ω ↦ ∏ i ≤ τ ω, ∂μ/∂ν (ω i)`. -/ +lemma rnDeriv_trim_stoppingTime_infinitePi [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (hτ : IsStoppingTime (piLE (X := fun _ : ℕ ↦ 𝓧)) (fun ω ↦ (τ ω : WithTop ℕ))) : + ((Measure.infinitePi fun _ : ℕ ↦ μ).trim hτ.measurableSpace_le).rnDeriv + ((Measure.infinitePi fun _ : ℕ ↦ ν).trim hτ.measurableSpace_le) + =ᵐ[(Measure.infinitePi fun _ : ℕ ↦ ν).trim hτ.measurableSpace_le] + fun ω ↦ ∏ i ∈ Finset.Iic (τ ω), μ.rnDeriv ν (ω i) := by + -- both restrictions have densities with respect to the restriction of `ρ^ℕ`, where + -- `ρ = (μ + ν) / 2` + set ρ : Measure 𝓧 := (2 : ℝ≥0∞)⁻¹ • (μ + ν) + have : IsProbabilityMeasure ρ := + ⟨by simp [ρ, ENNReal.inv_two_add_inv_two]⟩ + have hμρ : μ ≪ ρ := (Measure.AbsolutelyContinuous.rfl.add_right ν).trans + (Measure.absolutelyContinuous_smul (by simp)) + have hνρ : ν ≪ ρ := (Measure.AbsolutelyContinuous.rfl.add_right' μ).trans + (Measure.absolutelyContinuous_smul (by simp)) + set hm := hτ.measurableSpace_le + have h_meas (κ : Measure 𝓧) := measurable_stoppingTime_prod hτ (κ.measurable_rnDeriv ρ) + have hμ := trim_stoppingTime_infinitePi_eq_withDensity hμρ hτ + have hν := trim_stoppingTime_infinitePi_eq_withDensity hνρ hτ + have h_acμ := absolutelyContinuous_trim_stoppingTime_infinitePi hμρ hτ + have h_acν := absolutelyContinuous_trim_stoppingTime_infinitePi hνρ hτ + have h_rnμ : ((Measure.infinitePi fun _ : ℕ ↦ μ).trim hm).rnDeriv + ((Measure.infinitePi fun _ : ℕ ↦ ρ).trim hm) + =ᵐ[(Measure.infinitePi fun _ : ℕ ↦ ρ).trim hm] + fun ω ↦ ∏ i ∈ Finset.Iic (τ ω), μ.rnDeriv ρ (ω i) := by + rw [hμ] + exact Measure.rnDeriv_withDensity _ (h_meas μ) + have h_rnν : ((Measure.infinitePi fun _ : ℕ ↦ ν).trim hm).rnDeriv + ((Measure.infinitePi fun _ : ℕ ↦ ρ).trim hm) + =ᵐ[(Measure.infinitePi fun _ : ℕ ↦ ρ).trim hm] + fun ω ↦ ∏ i ∈ Finset.Iic (τ ω), ν.rnDeriv ρ (ω i) := by + rw [hν] + exact Measure.rnDeriv_withDensity _ (h_meas ν) + -- coordinatewise, `∂μ/∂ν = ∂μ/∂ρ / ∂ν/∂ρ`, `ν`-almost everywhere + have h_coord : (fun ω ↦ ∏ i ∈ Finset.Iic (τ ω), μ.rnDeriv ν (ω i)) + =ᵐ[(Measure.infinitePi fun _ : ℕ ↦ ν).trim hm] fun ω ↦ (∏ i ∈ Finset.Iic (τ ω), + μ.rnDeriv ρ (ω i)) / ∏ i ∈ Finset.Iic (τ ω), ν.rnDeriv ρ (ω i) := by + refine (StronglyMeasurable.ae_eq_trim_iff hm + (measurable_stoppingTime_prod hτ (μ.measurable_rnDeriv ν)).stronglyMeasurable + ((h_meas μ).div (h_meas ν)).stronglyMeasurable).mpr ?_ + have h_eval (i : ℕ) := + (measurePreserving_eval_infinitePi (fun _ : ℕ ↦ ν) i).quasiMeasurePreserving + have h_div : ∀ᵐ ω ∂(Measure.infinitePi fun _ : ℕ ↦ ν), ∀ i, + μ.rnDeriv ν (ω i) = μ.rnDeriv ρ (ω i) / ν.rnDeriv ρ (ω i) := + ae_all_iff.2 fun i ↦ (h_eval i).ae (Measure.rnDeriv_eq_div hμρ hνρ) + have h_top : ∀ᵐ ω ∂(Measure.infinitePi fun _ : ℕ ↦ ν), ∀ i, ν.rnDeriv ρ (ω i) ≠ ∞ := + ae_all_iff.2 fun i ↦ (h_eval i).ae (hνρ.ae_le (Measure.rnDeriv_ne_top _ _)) + filter_upwards [h_div, h_top] with ω h_div h_top + rw [Finset.prod_congr rfl fun i _ ↦ h_div i, + ENNReal.prod_div_distrib_of_ne_top fun i _ ↦ h_top i, Pi.div_apply] + filter_upwards [Measure.rnDeriv_eq_div h_acμ h_acν, h_acν.ae_le h_rnμ, h_acν.ae_le h_rnν, h_coord] + with ω h1 h2 h3 h4 + rw [h1, h2, h3, h4] + +/-- For `μ ≪ ν` and a stopping time `τ` with values in `ℕ`, the log-likelihood ratio of the +restrictions of `μ^ℕ` and `ν^ℕ` to the σ-algebra of `τ` is `ω ↦ ∑ i ≤ τ ω, llr μ ν (ω i)`. -/ +lemma llr_trim_stoppingTime_infinitePi_ae_eq [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (hμν : μ ≪ ν) (hτ : IsStoppingTime (piLE (X := fun _ : ℕ ↦ 𝓧)) (fun ω ↦ (τ ω : WithTop ℕ))) : + llr ((Measure.infinitePi fun _ : ℕ ↦ μ).trim hτ.measurableSpace_le) + ((Measure.infinitePi fun _ : ℕ ↦ ν).trim hτ.measurableSpace_le) + =ᵐ[Measure.infinitePi fun _ : ℕ ↦ μ] fun ω ↦ ∑ i ∈ Finset.Iic (τ ω), llr μ ν (ω i) := by + filter_upwards [ae_of_ae_trim _ ((absolutelyContinuous_trim_stoppingTime_infinitePi hμν hτ).ae_le + (rnDeriv_trim_stoppingTime_infinitePi (μ := μ) hτ)), ae_log_prod_rnDeriv_eq_sum_llr hμν] + with ω h_rn h_log + rw [llr, h_rn, h_log] + +end StoppingTime + +end ProbabilityTheory diff --git a/Statlib/Testing/Sequential/KLDiv.lean b/Statlib/Testing/Sequential/KLDiv.lean new file mode 100644 index 0000000..b4b3c70 --- /dev/null +++ b/Statlib/Testing/Sequential/KLDiv.lean @@ -0,0 +1,147 @@ +/- +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.ForMathlib.InformationTheory.KullbackLeibler.DataProcessing +public import Statlib.Testing.Sequential.Basic +public import Statlib.Testing.Sequential.Wald + +/-! +# Kullback-Leibler divergence of i.i.d. sequences observed up to a stopping time + +Let `μ^ℕ = Measure.infinitePi (fun _ : ℕ ↦ μ)` and let `τ` be a stopping time for the filtration +`Filtration.piLE` of the first coordinates, with values in `ℕ`. The observations available at time +`τ` are `ω 0, …, ω (τ ω)`, and `μ_τ` is the restriction of `μ^ℕ` to the σ-algebra of the +stopping time. + +## Main statements + +* `klDiv_trim_stoppingTime`: `KL(μ_τ, ν_τ) = μ^ℕ[τ + 1] * KL(μ, ν)`, with the expectation computed + in `ℝ≥0∞` (both sides may be infinite). + +Note that with the filtration `Filtration.piLE`, the number of observations at time `τ` is +`τ + 1`. +-/ +@[expose] public section + +open MeasureTheory Filtration InformationTheory + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {𝓧 : Type*} {m𝓧 : MeasurableSpace 𝓧} {μ ν : Measure 𝓧} {τ : (ℕ → 𝓧) → ℕ} + +/-- The first observation `ω 0` is available at any stopping time `τ`, hence +`KL(μ, ν) ≤ KL(μ_τ, ν_τ)`. -/ +lemma klDiv_le_klDiv_trim_stoppingTime (μ ν : Measure 𝓧) [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] + (hτ : IsStoppingTime (piLE (X := fun _ : ℕ ↦ 𝓧)) (fun ω ↦ (τ ω : WithTop ℕ))) : + klDiv μ ν ≤ klDiv ((Measure.infinitePi fun _ : ℕ ↦ μ).trim hτ.measurableSpace_le) + ((Measure.infinitePi fun _ : ℕ ↦ ν).trim hτ.measurableSpace_le) := by + set hm := hτ.measurableSpace_le + -- `ω 0` is measurable at time `0`, hence with respect to the σ-algebra of `τ` + have h_meas : Measurable[hτ.measurableSpace] fun ω : ℕ → 𝓧 ↦ ω 0 := by + have h_le := (isStoppingTime_const (piLE (X := fun _ : ℕ ↦ 𝓧)) 0).measurableSpace_mono hτ + fun ω ↦ by simp + rw [IsStoppingTime.measurableSpace_const] at h_le + exact (measurable_piLE_apply le_rfl).mono h_le le_rfl + -- the law of `ω 0` under the restriction of `ρ^ℕ` to the σ-algebra of `τ` is `ρ` + have h_map (ρ : Measure 𝓧) [IsProbabilityMeasure ρ] : + @Measure.map _ _ hτ.measurableSpace _ (fun ω ↦ ω 0) + ((Measure.infinitePi fun _ : ℕ ↦ ρ).trim hm) = ρ := by + ext s hs + rw [@Measure.map_apply _ _ hτ.measurableSpace _ _ _ h_meas _ hs, + trim_measurableSet_eq _ (h_meas hs), ← Measure.map_apply (measurable_pi_apply 0) hs, + (measurePreserving_eval_infinitePi (fun _ : ℕ ↦ ρ) 0).map_eq] + calc klDiv μ ν + _ = klDiv (@Measure.map _ _ hτ.measurableSpace _ (fun ω ↦ ω 0) + ((Measure.infinitePi fun _ : ℕ ↦ μ).trim hm)) + (@Measure.map _ _ hτ.measurableSpace _ (fun ω ↦ ω 0) + ((Measure.infinitePi fun _ : ℕ ↦ ν).trim hm)) := by + rw [h_map, h_map] + _ ≤ _ := klDiv_map_le _ _ h_meas + +/-- `KL(μ_τ, ν_τ) = μ^ℕ[τ + 1] * KL(μ, ν)` for an integrable stopping time `τ`. -/ +private lemma klDiv_trim_stoppingTime_of_integrable [IsProbabilityMeasure μ] + [IsProbabilityMeasure ν] + (hτ : IsStoppingTime (piLE (X := fun _ : ℕ ↦ 𝓧)) (fun ω ↦ (τ ω : WithTop ℕ))) + (hτ_int : Integrable (fun ω ↦ (τ ω : ℝ)) (Measure.infinitePi fun _ ↦ μ)) : + klDiv ((Measure.infinitePi fun _ : ℕ ↦ μ).trim hτ.measurableSpace_le) + ((Measure.infinitePi fun _ : ℕ ↦ ν).trim hτ.measurableSpace_le) + = (∫⁻ ω, (τ ω + 1 : ℝ≥0∞) ∂(Measure.infinitePi fun _ : ℕ ↦ μ)) * klDiv μ ν := by + set P := Measure.infinitePi fun _ : ℕ ↦ μ + set Q := Measure.infinitePi fun _ : ℕ ↦ ν + set hm := hτ.measurableSpace_le + by_cases h_top : klDiv μ ν = ∞ + · -- both sides are infinite + have h_ne : ∫⁻ ω, (τ ω + 1 : ℝ≥0∞) ∂P ≠ 0 := + (lt_of_lt_of_le (by simp) (lintegral_mono fun ω ↦ le_add_self)).ne' + rw [h_top, ENNReal.mul_top h_ne, ← top_le_iff, ← h_top] + exact klDiv_le_klDiv_trim_stoppingTime μ ν hτ + obtain ⟨hμν, h_int⟩ := klDiv_ne_top_iff.mp h_top + have h_llr := llr_trim_stoppingTime_infinitePi_ae_eq hμν hτ + have h_meas : StronglyMeasurable[hτ.measurableSpace] (llr (P.trim hm) (Q.trim hm)) := + (@measurable_llr _ hτ.measurableSpace _ _).stronglyMeasurable + have h_int_trim : Integrable (llr (P.trim hm) (Q.trim hm)) (P.trim hm) := + ((integrable_sum_comp_stoppingTime h_int hτ hτ_int).congr h_llr.symm).trim hm h_meas + rw [klDiv_of_ac_of_integrable (absolutelyContinuous_trim_stoppingTime_infinitePi hμν hτ) + h_int_trim, klDiv_of_ac_of_integrable hμν h_int, ← integral_trim hm h_meas, + integral_congr_ae h_llr, integral_sum_comp_stoppingTime h_int hτ hτ_int] + simp only [probReal_univ, add_sub_cancel_right] + rw [ENNReal.ofReal_mul (integral_nonneg fun ω ↦ by positivity), + ofReal_integral_natCast_add_one_eq_lintegral hτ_int] + +/-- **Kullback-Leibler divergence at a stopping time**: for a stopping time `τ` with values in `ℕ`, +`KL(μ_τ, ν_τ) = μ^ℕ[τ + 1] * KL(μ, ν)`, where `μ_τ` and `ν_τ` are the restrictions of `μ^ℕ` and +`ν^ℕ` to the σ-algebra of `τ` and `τ + 1` is the number of observations. The expectation +`μ^ℕ[τ + 1]` is a Lebesgue integral, which is infinite if `τ` is not integrable. -/ +theorem klDiv_trim_stoppingTime [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (hτ : IsStoppingTime (piLE (X := fun _ : ℕ ↦ 𝓧)) (fun ω ↦ (τ ω : WithTop ℕ))) : + klDiv ((Measure.infinitePi fun _ : ℕ ↦ μ).trim hτ.measurableSpace_le) + ((Measure.infinitePi fun _ : ℕ ↦ ν).trim hτ.measurableSpace_le) + = (∫⁻ ω, (τ ω + 1 : ℝ≥0∞) ∂(Measure.infinitePi fun _ : ℕ ↦ μ)) * klDiv μ ν := by + by_cases h0 : klDiv μ ν = 0 + · obtain rfl := klDiv_eq_zero_iff.mp h0 + rw [klDiv_self, klDiv_self, mul_zero] + set P := Measure.infinitePi fun _ : ℕ ↦ μ + by_cases hτ_int : Integrable (fun ω ↦ (τ ω : ℝ)) P + · exact klDiv_trim_stoppingTime_of_integrable hτ hτ_int + -- if `τ` is not integrable, then `μ^ℕ[τ + 1] = ∞` + have hτ_meas := measurable_of_isStoppingTime (τ := τ) hτ + have h_top : ∫⁻ ω, (τ ω + 1 : ℝ≥0∞) ∂P = ∞ := by + refine eq_top_mono (lintegral_mono fun ω ↦ le_self_add) ?_ + by_contra h + exact hτ_int (by simpa using (integrable_toReal_iff (f := fun ω ↦ (τ ω : ℝ≥0∞)) + (by fun_prop) (ae_of_all _ fun _ ↦ by simp)).mpr h) + -- the stopping times `min τ n` are bounded, hence integrable + have h_le (n : ℕ) : (∫⁻ ω, ((min (τ ω) n : ℕ) + 1 : ℝ≥0∞) ∂P) * klDiv μ ν + ≤ klDiv (P.trim hτ.measurableSpace_le) + ((Measure.infinitePi fun _ : ℕ ↦ ν).trim hτ.measurableSpace_le) := by + have hτn : IsStoppingTime (piLE (X := fun _ : ℕ ↦ 𝓧)) + (fun ω ↦ ((min (τ ω) n : ℕ) : WithTop ℕ)) := by + convert hτ.min_const n using 2 + have hτn_int : Integrable (fun ω ↦ ((min (τ ω) n : ℕ) : ℝ)) P := + (integrable_const (n : ℝ)).mono' (by fun_prop) + (ae_of_all _ fun ω ↦ by + rw [Real.norm_eq_abs, abs_of_nonneg (by positivity)] + exact_mod_cast min_le_right _ _) + rw [← klDiv_trim_stoppingTime_of_integrable hτn hτn_int] + exact klDiv_trim_mono _ _ (hτn.measurableSpace_mono hτ fun ω ↦ by simp) hτ.measurableSpace_le + -- monotone convergence + have h_sup : ⨆ n : ℕ, ∫⁻ ω, ((min (τ ω) n : ℕ) + 1 : ℝ≥0∞) ∂P = ∫⁻ ω, (τ ω + 1 : ℝ≥0∞) ∂P := by + rw [← lintegral_iSup (fun n ↦ by fun_prop) fun n m hnm ω ↦ by gcongr] + congr with ω + rw [← ENNReal.iSup_add] + congr 1 + exact le_antisymm (iSup_le fun n ↦ by simp) (le_iSup_of_le (τ ω) (by simp)) + refine le_antisymm ?_ ?_ + · rw [h_top, ENNReal.top_mul h0] + exact le_top + · rw [← h_sup, ENNReal.iSup_mul] + exact iSup_le h_le + +end ProbabilityTheory diff --git a/Statlib/Testing/Sequential/Renyi.lean b/Statlib/Testing/Sequential/Renyi.lean new file mode 100644 index 0000000..a20e9bb --- /dev/null +++ b/Statlib/Testing/Sequential/Renyi.lean @@ -0,0 +1,69 @@ +/- +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.Variational +public import Statlib.Testing.Sequential.KLDiv + +/-! +# Rényi divergence of i.i.d. sequences observed up to a stopping time + +Let `μ^ℕ = Measure.infinitePi (fun _ : ℕ ↦ μ)`, let `τ` be a stopping time for the filtration +`Filtration.piLE` with values in `ℕ`, and let `μ_τ` be the restriction of `μ^ℕ` to the σ-algebra of +`τ`. For `a ∈ (0, 1)` and probability measures `μ`, `ν` that are not mutually singular, let +`ξ = renyiMeasure a μ ν` be the tilted probability measure of the variational formula for the Rényi +divergence. Then `R_a(μ_τ, ν_τ) ≤ ξ^ℕ[τ + 1] * R_a(μ, ν)`. + +The inequality is in general strict: by a change of measure, +`exp ((a - 1) R_a(μ_τ, ν_τ)) = ξ^ℕ[exp ((a - 1) (τ + 1) R_a(μ, ν))]`, and the inequality follows +from Jensen's inequality, with equality when `τ` is deterministic. In particular the restriction of +`ξ^ℕ` to the σ-algebra of `τ` is not `renyiMeasure a μ_τ ν_τ` in general. + +## Main statements + +* `renyiDiv_trim_stoppingTime_le`: `R_a(μ_τ, ν_τ) ≤ ξ^ℕ[τ + 1] * R_a(μ, ν)`, with the expectation + computed in `ℝ≥0∞`. +-/ + +@[expose] public section + +open MeasureTheory Filtration InformationTheory + +open scoped ENNReal + +namespace ProbabilityTheory + +variable {𝓧 : Type*} {m𝓧 : MeasurableSpace 𝓧} {μ ν : Measure 𝓧} {τ : (ℕ → 𝓧) → ℕ} {a : ℝ} + +/-- **Rényi divergence at a stopping time**: for `a ∈ (0, 1)`, probability measures `μ`, `ν` that +are not mutually singular and `ξ = renyiMeasure a μ ν`, `R_a(μ_τ, ν_τ) ≤ ξ^ℕ[τ + 1] * R_a(μ, ν)`, +where `μ_τ` and `ν_τ` are the restrictions of `μ^ℕ` and `ν^ℕ` to the σ-algebra of the stopping +time `τ`. -/ +theorem renyiDiv_trim_stoppingTime_le [IsProbabilityMeasure μ] [IsProbabilityMeasure ν] + (ha0 : 0 < a) (ha1 : a < 1) (h_ms : ¬ μ ⟂ₘ ν) + (hτ : IsStoppingTime (piLE (X := fun _ : ℕ ↦ 𝓧)) (fun ω ↦ (τ ω : WithTop ℕ))) : + renyiDiv a ((Measure.infinitePi fun _ : ℕ ↦ μ).trim hτ.measurableSpace_le) + ((Measure.infinitePi fun _ : ℕ ↦ ν).trim hτ.measurableSpace_le) + ≤ (∫⁻ ω, (τ ω + 1 : ℝ≥0∞) ∂(Measure.infinitePi fun _ : ℕ ↦ renyiMeasure a μ ν)) + * renyiDiv a μ ν := by + have := isProbabilityMeasure_renyiMeasure ha0 ha1 h_ms + set ξ := renyiMeasure a μ ν + set hm := hτ.measurableSpace_le + -- `(1 - a) R_a(μ, ν) = a KL(ξ, μ) + (1 - a) KL(ξ, ν)` + have h_kl := mul_klDiv_add_mul_klDiv ha0 ha1 (renyiMeasure_absolutelyContinuous_left ν ha0) + (renyiMeasure_absolutelyContinuous_right μ ha1) + rw [klDiv_self, zero_add] at h_kl + -- variational formula for the Rényi divergence between the stopped measures, with `ξ_τ` + refine (ENNReal.mul_le_mul_iff_right (a := ENNReal.ofReal (1 - a)) (by simp [ha1]) + ENNReal.ofReal_ne_top).mp ?_ + refine (mul_renyiDiv_le_mul_klDiv_add_mul_klDiv _ _ + ((Measure.infinitePi fun _ : ℕ ↦ ξ).trim hm) ha0 ha1).trans_eq ?_ + rw [klDiv_trim_stoppingTime hτ, klDiv_trim_stoppingTime hτ] + calc _ = (∫⁻ ω, (τ ω + 1 : ℝ≥0∞) ∂(Measure.infinitePi fun _ : ℕ ↦ ξ)) + * (ENNReal.ofReal a * klDiv ξ μ + ENNReal.ofReal (1 - a) * klDiv ξ ν) := by ring + _ = _ := by rw [h_kl]; ring + +end ProbabilityTheory diff --git a/Statlib/Testing/Sequential/Wald.lean b/Statlib/Testing/Sequential/Wald.lean new file mode 100644 index 0000000..e1b773e --- /dev/null +++ b/Statlib/Testing/Sequential/Wald.lean @@ -0,0 +1,229 @@ +/- +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.Probability.Independence.InfinitePi +public import Mathlib.Probability.Independence.Integration +public import Statlib.ForMathlib.MeasureTheory.Integral.Layercake +public import Statlib.ForMathlib.Probability.Process.Stopping +public import Statlib.ForMathlib.Probability.ProductMeasure + +/-! +# Wald's identity + +Let `X : ℕ → Ω → ℝ` be integrable random variables and `τ : Ω → ℕ` a random time. Suppose that +for all `n`, `∫ ω in {n ≤ τ}, X n ω = P {n ≤ τ} * ∫ X n` (which holds if `X n` is independent of +the event `{n ≤ τ}`, for example if `τ` is a stopping time and `X n` is independent of the past +before `n`) and that `∑ n, ∫ ω in {n ≤ τ}, |X n ω| < ∞`. Then the stopped sums +`S = ∑ n ≤ τ, X n` and `T = ∑ n ≤ τ, ∫ X n` are integrable and have the same integral. + +We then specialize to i.i.d. sequences: for `μ^ℕ = Measure.infinitePi (fun _ : ℕ ↦ μ)` and a +stopping time `τ` for the filtration `Filtration.piLE` of the first coordinates, with values in `ℕ` +and integrable, the number of observations at time `τ` is `τ + 1` and +`∫ ω, ∑ n ≤ τ ω, f (ω n) ∂μ^ℕ = (∫ ω, (τ ω + 1) ∂μ^ℕ) * ∫ f ∂μ`. + +## Main statements + +* `integrable_sum_Iic_of_summable`, `integrable_sum_Iic_integral_of_summable`: the stopped sums + `ω ↦ ∑ n ≤ τ ω, X n ω` and `ω ↦ ∑ n ≤ τ ω, ∫ X n` are integrable. +* `integral_sum_Iic_eq_integral_sum_Iic_integral` (**Wald's identity**): + `∫ ω, ∑ n ≤ τ ω, X n ω = ∫ ω, ∑ n ≤ τ ω, ∫ X n`. +* `integral_sum_comp_stoppingTime` (**Wald's identity** for i.i.d. sequences): + `∫ ω, ∑ n ≤ τ ω, f (ω n) ∂μ^ℕ = (∫ ω, (τ ω + 1) ∂μ^ℕ) * ∫ f ∂μ`. Its proof uses the tail-sum + formula `∑ n, P {n ≤ σ} = ∫ (σ + 1) ∂P` (`MeasureTheory.hasSum_measureReal_le`). + +## References + +* A. Wald, *On cumulative sums of random variables*, Annals of Mathematical Statistics 15(3) + (1944). +-/ + +@[expose] public section + +open MeasureTheory Filter Filtration + +open scoped ENNReal Topology + +namespace ProbabilityTheory + +section General + +variable {Ω : Type*} {mΩ : MeasurableSpace Ω} {P : Measure Ω} {X : ℕ → Ω → ℝ} {τ : Ω → ℕ} + +private lemma integrable_indicator_le (hτ : Measurable τ) + (hX : ∀ n, IntegrableOn (X n) {ω | n ≤ τ ω} P) (n : ℕ) : + Integrable ({ω | n ≤ τ ω}.indicator (X n)) P := + (integrable_indicator_iff (measurableSet_le measurable_const hτ)).mpr (hX n) + +private lemma summable_integral_norm_indicator (hτ : Measurable τ) + (h_sum : Summable fun n ↦ ∫ ω in {ω | n ≤ τ ω}, |X n ω| ∂P) : + Summable fun n ↦ ∫ ω, ‖{ω | n ≤ τ ω}.indicator (X n) ω‖ ∂P := by + convert h_sum using 2 with n + rw [← integral_indicator (measurableSet_le measurable_const hτ)] + congr with ω + rw [norm_indicator_eq_indicator_norm] + rfl + +/-- The stopped sum `ω ↦ ∑ n ≤ τ ω, X n ω` is integrable if each `X n` is integrable on `{n ≤ τ}` +and `∑ n, ∫ ω in {n ≤ τ}, |X n ω| < ∞`. -/ +lemma integrable_sum_Iic_of_summable (hX : ∀ n, IntegrableOn (X n) {ω | n ≤ τ ω} P) + (hτ : Measurable τ) (h_sum : Summable fun n ↦ ∫ ω in {ω | n ≤ τ ω}, |X n ω| ∂P) : + Integrable (fun ω ↦ ∑ n ∈ Finset.Iic (τ ω), X n ω) P := by + simp_rw [sum_Iic_eq_tsum_indicator] + set F := fun n ↦ {ω | n ≤ τ ω}.indicator (X n) + have hF_int := integrable_indicator_le hτ hX + have hF_sum := summable_integral_norm_indicator hτ h_sum + refine ⟨?_, ?_⟩ + · refine aestronglyMeasurable_of_tendsto_ae (u := atTop) + (f := fun N ω ↦ ∑ n ∈ Finset.range N, F n ω) + (fun N ↦ Finset.aestronglyMeasurable_fun_sum _ fun n _ ↦ (hF_int n).1) ?_ + refine ae_of_all _ fun ω ↦ ?_ + refine (summable_of_ne_finset_zero (s := Finset.Iic (τ ω)) fun n hn ↦ ?_).hasSum + |>.tendsto_sum_nat + simp only [F] + rw [Set.indicator_of_notMem] + simpa using hn + · calc ∫⁻ ω, ‖∑' n, F n ω‖ₑ ∂P + _ ≤ ∫⁻ ω, ∑' n, ‖F n ω‖ₑ ∂P := lintegral_mono fun ω ↦ enorm_tsum_le_tsum_enorm + _ = ∑' n, ∫⁻ ω, ‖F n ω‖ₑ ∂P := + lintegral_tsum fun n ↦ (hF_int n).1.enorm + _ = ∑' n, ENNReal.ofReal (∫ ω, ‖F n ω‖ ∂P) := by + congr with n + rw [ofReal_integral_norm_eq_lintegral_enorm (hF_int n)] + _ = ENNReal.ofReal (∑' n, ∫ ω, ‖F n ω‖ ∂P) := + (ENNReal.ofReal_tsum_of_nonneg (fun n ↦ integral_nonneg fun _ ↦ norm_nonneg _) hF_sum).symm + _ < ∞ := ENNReal.ofReal_lt_top + +/-- Under the hypotheses of Wald's identity, `∑ n, ∫ ω in {n ≤ τ}, |∫ X n| < ∞`: indeed +`P {n ≤ τ} * |∫ X n| = |∫ ω in {n ≤ τ}, X n ω| ≤ ∫ ω in {n ≤ τ}, |X n ω|`. -/ +private lemma summable_setIntegral_abs_integral + (h_indep : ∀ n, ∫ ω in {ω | n ≤ τ ω}, X n ω ∂P = P.real {ω | n ≤ τ ω} * ∫ ω, X n ω ∂P) + (h_sum : Summable fun n ↦ ∫ ω in {ω | n ≤ τ ω}, |X n ω| ∂P) : + Summable fun n ↦ ∫ _ in {ω | n ≤ τ ω}, |∫ ω, X n ω ∂P| ∂P := by + refine h_sum.of_nonneg_of_le (fun n ↦ integral_nonneg fun _ ↦ abs_nonneg _) fun n ↦ ?_ + calc ∫ _ in {ω | n ≤ τ ω}, |∫ ω, X n ω ∂P| ∂P + _ = |∫ ω in {ω | n ≤ τ ω}, X n ω ∂P| := by + rw [setIntegral_const, smul_eq_mul, h_indep n, abs_mul, abs_of_nonneg measureReal_nonneg] + _ ≤ ∫ ω in {ω | n ≤ τ ω}, |X n ω| ∂P := abs_integral_le_integral_abs + +/-- Under the hypotheses of Wald's identity, the sum `ω ↦ ∑ n ≤ τ ω, ∫ X n` is integrable. -/ +lemma integrable_sum_Iic_integral_of_summable [IsFiniteMeasure P] (hτ : Measurable τ) + (h_indep : ∀ n, ∫ ω in {ω | n ≤ τ ω}, X n ω ∂P = P.real {ω | n ≤ τ ω} * ∫ ω, X n ω ∂P) + (h_sum : Summable fun n ↦ ∫ ω in {ω | n ≤ τ ω}, |X n ω| ∂P) : + Integrable (fun ω ↦ ∑ n ∈ Finset.Iic (τ ω), ∫ ω', X n ω' ∂P) P := + integrable_sum_Iic_of_summable (X := fun n _ ↦ ∫ ω', X n ω' ∂P) + (fun _ ↦ integrableOn_const) hτ (summable_setIntegral_abs_integral h_indep h_sum) + +/-- **Wald's identity**. Let `X : ℕ → Ω → ℝ` be integrable and `τ : Ω → ℕ` measurable. Suppose +that for all `n`, `∫ ω in {n ≤ τ}, X n ω = P {n ≤ τ} * ∫ X n` and that +`∑ n, ∫ ω in {n ≤ τ}, |X n ω| < ∞`. Then +`∫ ω, ∑ n ≤ τ ω, X n ω = ∫ ω, ∑ n ≤ τ ω, ∫ X n`. Both stopped sums are integrable, by +`integrable_sum_Iic_of_summable` and `integrable_sum_Iic_integral_of_summable`. -/ +theorem integral_sum_Iic_eq_integral_sum_Iic_integral [IsFiniteMeasure P] + (hX : ∀ n, Integrable (X n) P) (hτ : Measurable τ) + (h_indep : ∀ n, ∫ ω in {ω | n ≤ τ ω}, X n ω ∂P = P.real {ω | n ≤ τ ω} * ∫ ω, X n ω ∂P) + (h_sum : Summable fun n ↦ ∫ ω in {ω | n ≤ τ ω}, |X n ω| ∂P) : + ∫ ω, ∑ n ∈ Finset.Iic (τ ω), X n ω ∂P + = ∫ ω, ∑ n ∈ Finset.Iic (τ ω), ∫ ω', X n ω' ∂P ∂P := by + have h_meas (n : ℕ) : MeasurableSet {ω | n ≤ τ ω} := measurableSet_le measurable_const hτ + simp_rw [sum_Iic_eq_tsum_indicator (fun n _ ↦ ∫ ω', X n ω' ∂P), sum_Iic_eq_tsum_indicator X] + rw [← integral_tsum_of_summable_integral_norm + (integrable_indicator_le hτ fun n ↦ (hX n).integrableOn) + (summable_integral_norm_indicator hτ h_sum), + ← integral_tsum_of_summable_integral_norm + (integrable_indicator_le (X := fun n _ ↦ ∫ ω', X n ω' ∂P) hτ fun _ ↦ integrableOn_const) + (summable_integral_norm_indicator hτ (summable_setIntegral_abs_integral h_indep h_sum))] + congr with n + rw [integral_indicator (h_meas n), integral_indicator (h_meas n), setIntegral_const, h_indep n, + smul_eq_mul] + +end General + +section IID + +variable {𝓧 : Type*} {m𝓧 : MeasurableSpace 𝓧} {μ : Measure 𝓧} [IsProbabilityMeasure μ] + {τ : (ℕ → 𝓧) → ℕ} + +/-- For an event `A` determined by the first `n + 1` coordinates of an i.i.d. sequence, +`∫ ω in A, f (ω (n + 1)) ∂μ^ℕ = μ^ℕ A * ∫ f ∂μ`, since the coordinate `n + 1` is independent of +`A`. -/ +lemma setIntegral_comp_eval_succ {f : 𝓧 → ℝ} (hf : AEStronglyMeasurable f μ) (n : ℕ) + {A : Set (ℕ → 𝓧)} (hA : MeasurableSet[piLE (X := fun _ : ℕ ↦ 𝓧) n] A) : + ∫ ω in A, f (ω (n + 1)) ∂(Measure.infinitePi fun _ ↦ μ) + = (Measure.infinitePi fun _ ↦ μ).real A * ∫ x, f x ∂μ := by + have h_indep : Indep (piLE (X := fun _ : ℕ ↦ 𝓧) n) (m𝓧.comap fun ω : ℕ → 𝓧 ↦ ω (n + 1)) + (Measure.infinitePi fun _ ↦ μ) := by + have h := (iIndepFun_infinitePi (P := fun _ : ℕ ↦ μ) (X := fun _ ↦ id) + fun _ ↦ measurable_id).indepFun_finset (Finset.Iic n) {n + 1} (by simp) + fun i ↦ measurable_pi_apply i + have h' : (fun ω : ℕ → 𝓧 ↦ Preorder.frestrictLe n ω) + ⟂ᵢ[Measure.infinitePi fun _ ↦ μ] fun ω ↦ ω (n + 1) := by + exact h.comp measurable_id (measurable_pi_apply ⟨n + 1, by simp⟩) + rw [piLE_eq_comap_frestrictLe] + exact (IndepFun_iff_Indep _ _ _).mp h' + rw [Indep.setIntegral_eq_mul ((piLE (X := fun _ : ℕ ↦ 𝓧)).le n) h_indep + (measurable_pi_apply _).aemeasurable hA, integral_comp_eval_infinitePi hf] + rwa [(measurePreserving_eval_infinitePi (fun _ : ℕ ↦ μ) (n + 1)).map_eq] + +/-- For a stopping time `τ`, `∫ ω in {n ≤ τ}, f (ω n) ∂μ^ℕ = μ^ℕ {n ≤ τ} * ∫ f ∂μ`, since the +coordinate `n` of an i.i.d. sequence is independent of the event `{n ≤ τ} = {τ ≤ n - 1}ᶜ`. -/ +lemma setIntegral_comp_eval_le_stoppingTime {f : 𝓧 → ℝ} (hf : AEStronglyMeasurable f μ) + (hτ : IsStoppingTime (piLE (X := fun _ : ℕ ↦ 𝓧)) (fun ω ↦ (τ ω : WithTop ℕ))) (n : ℕ) : + ∫ ω in {ω | n ≤ τ ω}, f (ω n) ∂(Measure.infinitePi fun _ ↦ μ) + = (Measure.infinitePi fun _ ↦ μ).real {ω | n ≤ τ ω} * ∫ x, f x ∂μ := by + rcases n with _ | n + · simp [integral_comp_eval_infinitePi (μ := fun _ ↦ μ) hf] + · have h_set : {ω | n + 1 ≤ τ ω} = {ω | (τ ω : WithTop ℕ) ≤ n}ᶜ := by + ext ω + simp only [Set.mem_ofPred_eq, Set.mem_compl_iff, Nat.cast_le, not_le] + omega + rw [h_set] + exact setIntegral_comp_eval_succ hf n (hτ n).compl + +private lemma summable_setIntegral_abs_le_stoppingTime {f : 𝓧 → ℝ} + (hf : AEStronglyMeasurable f μ) + (hτ : IsStoppingTime (piLE (X := fun _ : ℕ ↦ 𝓧)) (fun ω ↦ (τ ω : WithTop ℕ))) + (hτ_int : Integrable (fun ω ↦ (τ ω : ℝ)) (Measure.infinitePi fun _ ↦ μ)) : + Summable fun n ↦ ∫ ω in {ω | n ≤ τ ω}, |f (ω n)| ∂(Measure.infinitePi fun _ ↦ μ) := by + simp_rw [setIntegral_comp_eval_le_stoppingTime (f := fun x ↦ |f x|) + (continuous_abs.comp_aestronglyMeasurable hf) hτ] + exact (hasSum_measureReal_le hτ_int).summable.mul_right _ + +/-- The sum of the values of a function at the observations of an i.i.d. sequence up to an +integrable stopping time is integrable. -/ +lemma integrable_sum_comp_stoppingTime {f : 𝓧 → ℝ} (hf : Integrable f μ) + (hτ : IsStoppingTime (piLE (X := fun _ : ℕ ↦ 𝓧)) (fun ω ↦ (τ ω : WithTop ℕ))) + (hτ_int : Integrable (fun ω ↦ (τ ω : ℝ)) (Measure.infinitePi fun _ ↦ μ)) : + Integrable (fun ω ↦ ∑ n ∈ Finset.Iic (τ ω), f (ω n)) (Measure.infinitePi fun _ ↦ μ) := + integrable_sum_Iic_of_summable (X := fun n ω ↦ f (ω n)) + (fun n ↦ ((measurePreserving_eval_infinitePi _ n).integrable_comp_of_integrable hf) + |>.integrableOn) + (measurable_of_isStoppingTime (τ := τ) hτ) + (summable_setIntegral_abs_le_stoppingTime hf.aestronglyMeasurable hτ hτ_int) + +/-- **Wald's identity** for i.i.d. sequences: for an integrable stopping time `τ`, +`∫ ω, ∑ n ≤ τ ω, f (ω n) ∂μ^ℕ = (∫ ω, (τ ω + 1) ∂μ^ℕ) * ∫ f ∂μ`. -/ +theorem integral_sum_comp_stoppingTime {f : 𝓧 → ℝ} (hf : Integrable f μ) + (hτ : IsStoppingTime (piLE (X := fun _ : ℕ ↦ 𝓧)) (fun ω ↦ (τ ω : WithTop ℕ))) + (hτ_int : Integrable (fun ω ↦ (τ ω : ℝ)) (Measure.infinitePi fun _ ↦ μ)) : + ∫ ω, ∑ n ∈ Finset.Iic (τ ω), f (ω n) ∂(Measure.infinitePi fun _ ↦ μ) + = (∫ ω, (τ ω + 1 : ℝ) ∂(Measure.infinitePi fun _ ↦ μ)) * ∫ x, f x ∂μ := by + rw [integral_sum_Iic_eq_integral_sum_Iic_integral (X := fun n ω ↦ f (ω n)) + (fun n ↦ (measurePreserving_eval_infinitePi _ n).integrable_comp_of_integrable hf) + (measurable_of_isStoppingTime (τ := τ) hτ) + (fun n ↦ by rw [setIntegral_comp_eval_le_stoppingTime hf.aestronglyMeasurable hτ n, + integral_comp_eval_infinitePi hf.aestronglyMeasurable]) + (summable_setIntegral_abs_le_stoppingTime hf.aestronglyMeasurable hτ hτ_int)] + simp_rw [integral_comp_eval_infinitePi (μ := fun _ ↦ μ) hf.aestronglyMeasurable, Finset.sum_const, + Nat.card_Iic, nsmul_eq_mul] + rw [integral_mul_const] + push_cast + -- the two sides differ only in the instance paths of the integrals + rfl + +end IID + +end ProbabilityTheory