From 3cc568c0478e4bf6165fb97727e8d09f9168a376 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 18:02:33 +0000 Subject: [PATCH 1/6] Import complete bicausalot-palomar proof development --- LeanPool.lean | 1 + LeanPool/BicausalOT.lean | 53 ++ LeanPool/BicausalOT/BicausalOT.lean | 8 + LeanPool/BicausalOT/BicausalOT/Basic.lean | 33 + .../BicausalOT/BicausalOT/BicausalOT.lean | 37 + LeanPool/BicausalOT/BicausalOT/Defs.lean | 59 ++ .../BicausalOT/DescriptiveSetTheory.lean | 27 + .../DescriptiveSetTheory/AnalyticSet.lean | 25 + .../AnalyticSigmaAlgebra.lean | 100 +++ .../DescriptiveSetTheory/Capacitability.lean | 606 +++++++++++++ .../CouplingsCompact.lean | 232 +++++ .../DescriptiveSetTheory/CouplingsUHC.lean | 225 +++++ .../EpsOptimalSelection.lean | 243 ++++++ .../JankovVonNeumann.lean | 54 ++ .../DescriptiveSetTheory/KernelIntegral.lean | 473 +++++++++++ .../DescriptiveSetTheory/LintegralLsc.lean | 164 ++++ .../LowerSemianalytic.lean | 81 ++ .../DescriptiveSetTheory/LsaAlgebra.lean | 77 ++ .../DescriptiveSetTheory/LscIntegral.lean | 107 +++ .../MeasurableSelection.lean | 260 ++++++ .../ProbabilityMeasurePolish.lean | 795 ++++++++++++++++++ .../BicausalOT/DescriptiveSetTheory/Tree.lean | 319 +++++++ LeanPool/BicausalOT/BicausalOT/Existence.lean | 38 + .../BicausalOT/BicausalOT/FeasNonempty.lean | 165 ++++ .../BicausalOT/BicausalOT/LowerBound.lean | 38 + .../BicausalOT/BicausalOT/LscBellman.lean | 736 ++++++++++++++++ .../MeasurableFeasibleStrategy.lean | 146 ++++ .../BicausalOT/MeasurableStrategy.lean | 202 +++++ .../BicausalOT/BicausalOT/MultiPeriod.lean | 260 ++++++ .../BicausalOT/MultiPeriodTopology.lean | 205 +++++ .../BicausalOT/BicausalOT/Proposition1.lean | 40 + .../BicausalOT/SemianalyticValue.lean | 223 +++++ .../BicausalOT/BicausalOT/UpperBound.lean | 72 ++ .../BicausalOT/ValueRepresentation.lean | 117 +++ LeanPool/BicausalOT/Solution.lean | 59 ++ .../BicausalOT/SolutionCapacitability.lean | 97 +++ LeanPool/BicausalOT/SolutionJvN.lean | 106 +++ LeanPool/BicausalOT/SolutionPolish.lean | 75 ++ LeanPool/projects.yml | 32 + 39 files changed, 6590 insertions(+) create mode 100644 LeanPool/BicausalOT.lean create mode 100644 LeanPool/BicausalOT/BicausalOT.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/Basic.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/BicausalOT.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/Defs.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSet.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSigmaAlgebra.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Capacitability.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsCompact.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsUHC.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/EpsOptimalSelection.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/JankovVonNeumann.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/KernelIntegral.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LintegralLsc.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LowerSemianalytic.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LsaAlgebra.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LscIntegral.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/MeasurableSelection.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ProbabilityMeasurePolish.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Tree.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/Existence.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/FeasNonempty.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/LowerBound.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/LscBellman.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/MeasurableFeasibleStrategy.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/MeasurableStrategy.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/MultiPeriod.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/MultiPeriodTopology.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/Proposition1.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/SemianalyticValue.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/UpperBound.lean create mode 100644 LeanPool/BicausalOT/BicausalOT/ValueRepresentation.lean create mode 100644 LeanPool/BicausalOT/Solution.lean create mode 100644 LeanPool/BicausalOT/SolutionCapacitability.lean create mode 100644 LeanPool/BicausalOT/SolutionJvN.lean create mode 100644 LeanPool/BicausalOT/SolutionPolish.lean diff --git a/LeanPool.lean b/LeanPool.lean index 50fa6e5b30..9bde6b445e 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -223,6 +223,7 @@ import LeanPool.ArtinWedderburn.SetProd import LeanPool.BannaiBannaiStanton import LeanPool.BannaiBannaiStanton.BoundOnDistanceSet import LeanPool.Basic +import LeanPool.BicausalOT import LeanPool.Biswal import LeanPool.Biswal.Theorem1 import LeanPool.Biswal.Theorem23 diff --git a/LeanPool/BicausalOT.lean b/LeanPool/BicausalOT.lean new file mode 100644 index 0000000000..73aaf4a444 --- /dev/null +++ b/LeanPool/BicausalOT.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ + +import LeanPool.BicausalOT.BicausalOT +import LeanPool.BicausalOT.BicausalOT.Basic +import LeanPool.BicausalOT.BicausalOT.BicausalOT +import LeanPool.BicausalOT.BicausalOT.Defs +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSigmaAlgebra +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsCompact +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsUHC +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.EpsOptimalSelection +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.JankovVonNeumann +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LintegralLsc +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LowerSemianalytic +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LsaAlgebra +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LscIntegral +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.MeasurableSelection +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree +import LeanPool.BicausalOT.BicausalOT.Existence +import LeanPool.BicausalOT.BicausalOT.FeasNonempty +import LeanPool.BicausalOT.BicausalOT.LowerBound +import LeanPool.BicausalOT.BicausalOT.LscBellman +import LeanPool.BicausalOT.BicausalOT.MeasurableFeasibleStrategy +import LeanPool.BicausalOT.BicausalOT.MeasurableStrategy +import LeanPool.BicausalOT.BicausalOT.MultiPeriod +import LeanPool.BicausalOT.BicausalOT.MultiPeriodTopology +import LeanPool.BicausalOT.BicausalOT.Proposition1 +import LeanPool.BicausalOT.BicausalOT.SemianalyticValue +import LeanPool.BicausalOT.BicausalOT.UpperBound +import LeanPool.BicausalOT.BicausalOT.ValueRepresentation +import LeanPool.BicausalOT.Solution +import LeanPool.BicausalOT.SolutionCapacitability +import LeanPool.BicausalOT.SolutionJvN +import LeanPool.BicausalOT.SolutionPolish + +/-! +# BicausalOT + +Source: url:https://github.com/maxwellapexlab/bicausalot-palomar +Authors: KT. Wu +Status: verified +Main declarations: `MeasurableSelection.exists_measurable_selection` +Tags: probability +MSC: 28B20, 54C65, 54H05, 03E15, 28A20, 68V20 +-/ diff --git a/LeanPool/BicausalOT/BicausalOT.lean b/LeanPool/BicausalOT/BicausalOT.lean new file mode 100644 index 0000000000..b4c8fde94a --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT.lean @@ -0,0 +1,8 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +-- This module serves as the root of the `BicausalOT` library. +-- Import modules here that should be built as part of the library. +import LeanPool.BicausalOT.BicausalOT.Basic diff --git a/LeanPool/BicausalOT/BicausalOT/Basic.lean b/LeanPool/BicausalOT/BicausalOT/Basic.lean new file mode 100644 index 0000000000..66711f29b6 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/Basic.lean @@ -0,0 +1,33 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +-- Re-export all modules +import LeanPool.BicausalOT.BicausalOT.Defs +import LeanPool.BicausalOT.BicausalOT.Proposition1 +import LeanPool.BicausalOT.BicausalOT.LowerBound +import LeanPool.BicausalOT.BicausalOT.UpperBound +import LeanPool.BicausalOT.BicausalOT.ValueRepresentation +import LeanPool.BicausalOT.BicausalOT.Existence +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LowerSemianalytic +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.JankovVonNeumann +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LsaAlgebra +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsCompact +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LintegralLsc +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.MeasurableSelection +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.EpsOptimalSelection +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsUHC +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LscIntegral +import LeanPool.BicausalOT.BicausalOT.MultiPeriod +import LeanPool.BicausalOT.BicausalOT.MultiPeriodTopology +import LeanPool.BicausalOT.BicausalOT.FeasNonempty +import LeanPool.BicausalOT.BicausalOT.SemianalyticValue +import LeanPool.BicausalOT.BicausalOT.MeasurableStrategy +import LeanPool.BicausalOT.BicausalOT.LscBellman +import LeanPool.BicausalOT.BicausalOT.MeasurableFeasibleStrategy diff --git a/LeanPool/BicausalOT/BicausalOT/BicausalOT.lean b/LeanPool/BicausalOT/BicausalOT/BicausalOT.lean new file mode 100644 index 0000000000..f5f711ea52 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/BicausalOT.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Bicausal Optimal Transport — Bellman Recursion (T=1) + Formally verified in Lean 4 + Mathlib. + + Main result: bellman_value_eq (Value Representation Theorem) + + Structure: + Defs.lean — definitions + Proposition1.lean — bicausal ⟺ kernel decomposition + LowerBound.lean — Step 2: ∫V₀ ≤ totalCost + UpperBound.lean — Step 3: ε-optimal construction + ValueRepresentation.lean — Step 4: equality (main theorem) + Existence.lean — Step 5: optimal coupling exists + DescriptiveSetTheory/ + Tree.lean — Jankov–von Neumann uniformization (Kechris 18.1) + JankovVonNeumann.lean — ε-optimal selection + AnalyticSigmaAlgebra.lean — σ(Σ₁¹), analytical measurability + LowerSemianalytic.lean — lower semianalytic functions (BS 7.21, 7.47) + Capacitability.lean — Choquet capacitability (Kechris 30.13, BS 7.42) + KernelIntegral.lean — kernel integration of l.s.a. functions (BS 7.48) + AxiomsAudit.lean — #print axioms for every theorem + + Status: 0 error, 0 warning, 0 sorry, 0 custom axioms project-wide + (machine-checked: every audited theorem depends only on + [propext, Classical.choice, Quot.sound]) +-/ +import LeanPool.BicausalOT.BicausalOT.Defs +import LeanPool.BicausalOT.BicausalOT.Proposition1 +import LeanPool.BicausalOT.BicausalOT.LowerBound +import LeanPool.BicausalOT.BicausalOT.UpperBound +import LeanPool.BicausalOT.BicausalOT.ValueRepresentation +import LeanPool.BicausalOT.BicausalOT.Existence diff --git a/LeanPool/BicausalOT/BicausalOT/Defs.lean b/LeanPool/BicausalOT/BicausalOT/Defs.lean new file mode 100644 index 0000000000..1ffdf8e30e --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/Defs.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Bicausal OT — Definitions + Couplings, feasible sets, kernel decomposition, bicausality, Bellman value. +-/ +import Mathlib.MeasureTheory.Measure.MeasureSpace +import Mathlib.MeasureTheory.Measure.Prod +import Mathlib.Probability.Kernel.Basic + +open MeasureTheory ProbabilityTheory Set ENNReal + +noncomputable section + +variable {X₀ X₁ Y₀ Y₁ : Type*} +variable [MeasurableSpace X₀] [MeasurableSpace X₁] +variable [MeasurableSpace Y₀] [MeasurableSpace Y₁] + +def CouplingSet₀ (μ₀ : Measure X₀) (ν₀ : Measure Y₀) : + Set (Measure (X₀ × Y₀)) := + { γ | γ.map Prod.fst = μ₀ ∧ γ.map Prod.snd = ν₀ } + +def FeasibleSet₀ + (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) + (z₀ : X₀ × Y₀) : Set (Measure (X₁ × Y₁)) := + { γ | γ.map Prod.fst = κ_μ z₀.1 ∧ γ.map Prod.snd = κ_ν z₀.2 } + +structure KernelDecomp + (π : Measure ((X₀ × X₁) × (Y₀ × Y₁))) where + γ₀ : Measure (X₀ × Y₀) + γ₁ : X₀ × Y₀ → Measure (X₁ × Y₁) + γ₁_measurable : Measurable γ₁ + decomp : ∀ ⦃s : Set ((X₀ × X₁) × (Y₀ × Y₁))⦄, + MeasurableSet s → + π s = ∫⁻ z₀, (γ₁ z₀) {z₁ | ((z₀.1, z₁.1), (z₀.2, z₁.2)) ∈ s} ∂γ₀ + +def IsBicausal₂ + (μ₀ : Measure X₀) (ν₀ : Measure Y₀) + (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) + (π : Measure ((X₀ × X₁) × (Y₀ × Y₁))) : Prop := + ∃ (kd : KernelDecomp π), + kd.γ₀ ∈ CouplingSet₀ μ₀ ν₀ ∧ + ∀ᵐ z₀ ∂kd.γ₀, kd.γ₁ z₀ ∈ FeasibleSet₀ κ_μ κ_ν z₀ + +variable (c₀ : X₀ × Y₀ → ENNReal) (c₁ : (X₀ × Y₀) × (X₁ × Y₁) → ENNReal) + +def V₀ (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) + (z₀ : X₀ × Y₀) : ENNReal := + c₀ z₀ + ⨅ (γ : Measure (X₁ × Y₁)) (_ : γ ∈ FeasibleSet₀ κ_μ κ_ν z₀), + ∫⁻ z₁, c₁ (z₀, z₁) ∂γ + +def totalCost (kd_γ₀ : Measure (X₀ × Y₀)) + (kd_γ₁ : X₀ × Y₀ → Measure (X₁ × Y₁)) : ENNReal := + ∫⁻ z₀, (c₀ z₀ + ∫⁻ z₁, c₁ (z₀, z₁) ∂(kd_γ₁ z₀)) ∂kd_γ₀ + +end diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory.lean new file mode 100644 index 0000000000..f274d8b2fa --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory.lean @@ -0,0 +1,27 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ + +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSigmaAlgebra +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsCompact +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsUHC +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.EpsOptimalSelection +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.JankovVonNeumann +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LintegralLsc +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LowerSemianalytic +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LsaAlgebra +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LscIntegral +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.MeasurableSelection +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree + +/-! +# DescriptiveSetTheory + +Supporting modules for BicausalOT. +-/ diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSet.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSet.lean new file mode 100644 index 0000000000..a6cac2abdd --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSet.lean @@ -0,0 +1,25 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Analytic Sets — re-exported from Mathlib + + Mathlib already has the full theory in: + Mathlib.MeasureTheory.Constructions.Polish.Basic + + Key results available: + - `MeasureTheory.AnalyticSet` (definition) + - `MeasurableSet.analyticSet` (Borel ⊆ Analytic) + - `AnalyticSet.image_of_continuous` (continuous image) + - `AnalyticSet.iUnion` (countable union) + - `AnalyticSet.iInter` (countable intersection) + - `AnalyticSet.measurablySeparable` (Lusin separation) + + NO sorry needed — everything is already in Mathlib. +-/ +import Mathlib.MeasureTheory.Constructions.Polish.Basic + +-- Re-export for downstream modules +open MeasureTheory diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSigmaAlgebra.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSigmaAlgebra.lean new file mode 100644 index 0000000000..20c89e1d95 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSigmaAlgebra.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + The Analytic σ-algebra σ(Σ₁¹) + + References: + - Kechris, Classical Descriptive Set Theory, §18 + - Bertsekas–Shreve, Definition 7.19–7.20 +-/ +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet + +open MeasureTheory Set + +noncomputable section + +variable {X : Type*} [TopologicalSpace X] + +/-- σ(Σ₁¹): the σ-algebra generated by the analytic subsets. (BS, Def 7.19) -/ +@[reducible] +def analyticMeasurableSpace (X : Type*) [TopologicalSpace X] : MeasurableSpace X := + MeasurableSpace.generateFrom { s : Set X | AnalyticSet s } + +namespace MeasureTheory.AnalyticSet + +theorem mem_analyticMeasurableSpace {s : Set X} + (hs : AnalyticSet s) : + @MeasurableSet X (analyticMeasurableSpace X) s := + MeasurableSpace.measurableSet_generateFrom hs + +theorem compl_mem_analyticMeasurableSpace {s : Set X} + (hs : AnalyticSet s) : + @MeasurableSet X (analyticMeasurableSpace X) sᶜ := + hs.mem_analyticMeasurableSpace.compl + +end MeasureTheory.AnalyticSet + +theorem borel_le_analyticMeasurableSpace + [PolishSpace X] [MeasurableSpace X] [BorelSpace X] : + ‹MeasurableSpace X› ≤ analyticMeasurableSpace X := + fun _ hs => hs.analyticSet.mem_analyticMeasurableSpace + +/-- Open sets in Polish spaces are analytic. -/ +theorem IsOpen.analyticSet [PolishSpace X] {s : Set X} (hs : IsOpen s) : + AnalyticSet s := by + rw [show s = id '' s from (image_id s).symm] + exact hs.analyticSet_image continuous_id + +/-- A function is analytically measurable (BS, Def 7.20) if preimages of Borel + sets in the codomain land in σ(Σ₁¹) on the domain. -/ +def AnalyticallyMeasurable {Y : Type*} [TopologicalSpace Y] + (f : X → Y) : Prop := + @Measurable X Y (analyticMeasurableSpace X) (borel Y) f + +/-- Continuous functions between Polish spaces are analytically measurable. -/ +theorem Continuous.analyticallyMeasurable + [PolishSpace X] + {Y : Type*} [TopologicalSpace Y] + {f : X → Y} (hf : Continuous f) : AnalyticallyMeasurable f := by + intro s hs + induction hs with + | basic s hs => exact (hf.isOpen_preimage _ hs).analyticSet.mem_analyticMeasurableSpace + | empty => exact @MeasurableSet.empty X (analyticMeasurableSpace X) + | compl _ _ ih => exact ih.compl + | iUnion _ _ ih => rw [Set.preimage_iUnion]; exact .iUnion ih + +/-- Composition: analytically measurable after Borel measurable is + analytically measurable. Used for the general reduction. -/ +theorem AnalyticallyMeasurable.comp_borel + {Y Z : Type*} [TopologicalSpace Y] [TopologicalSpace Z] + {f : X → Y} {g : Y → Z} + (hf : AnalyticallyMeasurable f) + (hg : @Measurable Y Z (borel Y) (borel Z) g) : + AnalyticallyMeasurable (g ∘ f) := + fun _ hs => hf (hg hs) + +/-- Continuous functions are Borel-Borel measurable. -/ +theorem Continuous.borel_borel_measurable + {Y : Type*} [TopologicalSpace Y] + {f : X → Y} (hf : Continuous f) : + @Measurable X Y (borel X) (borel Y) f := by + intro s hs + induction hs with + | basic s hs => exact MeasurableSpace.measurableSet_generateFrom (hf.isOpen_preimage _ hs) + | empty => exact @MeasurableSet.empty X (borel X) + | compl _ _ ih => exact ih.compl + | iUnion _ _ ih => rw [Set.preimage_iUnion]; exact .iUnion ih + +/-- Composition of analytically measurable with continuous is + analytically measurable. -/ +theorem AnalyticallyMeasurable.comp_continuous + {Y Z : Type*} [TopologicalSpace Y] [TopologicalSpace Z] + {f : X → Y} {g : Y → Z} + (hf : AnalyticallyMeasurable f) (hg : Continuous g) : + AnalyticallyMeasurable (g ∘ f) := + hf.comp_borel hg.borel_borel_measurable + +end diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Capacitability.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Capacitability.lean new file mode 100644 index 0000000000..d13ba58274 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Capacitability.lean @@ -0,0 +1,606 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Choquet Capacitability for Analytic Sets — Full Proof + + References: + - Kechris, Classical Descriptive Set Theory, Theorem 30.13 (capacitability) + - Bertsekas–Shreve, Prop 7.42 (analytic sets are universally measurable) + + Strategy (avoids König's lemma and metric-diameter bookkeeping): + For A analytic, A = range π with π : ℕᴺ → Z continuous. The Souslin + scheme is G_s := closure (π '' N_s) over cylinders N_s. For a bound + β : ℕ → ℕ, the compact witness is K = π '' Σ(β) where + Σ(β) = {σ | ∀ i, σ i ≤ β i} is compact. The core topological lemma is + + ⋂ n, ⋃ {s ≤ β, |s| = n} G_s ⊆ π '' Σ(β), + + proved by a subsequence-extraction argument in Σ(β). The measure side + is a recursion along increasing unions (continuity from below of outer + measures), mirroring the `leftmostAuxG` pattern of Tree.lean. +-/ +import Mathlib.Topology.MetricSpace.Polish +import Mathlib.Topology.MetricSpace.PiNat +import Mathlib.MeasureTheory.Constructions.Polish.Basic +import Mathlib.Probability.Kernel.MeasurableLIntegral +import Mathlib.Tactic.Finiteness +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet + +open Set Topology MeasureTheory Filter +open scoped Classical ENNReal + +noncomputable section + +/-! ## Part I: Bounded branch sets in Baire space -/ + +/-- Branches bounded by `β` everywhere: the compact set Σ(β). -/ +def capBelow (β : ℕ → ℕ) : Set (ℕ → ℕ) := {σ | ∀ i, σ i ≤ β i} + +/-- Branches bounded by `β` on the first `n` coordinates. -/ +def capBelowN (β : ℕ → ℕ) (n : ℕ) : Set (ℕ → ℕ) := {σ | ∀ i < n, σ i ≤ β i} + +theorem capBelowN_zero (β : ℕ → ℕ) : capBelowN β 0 = univ := by + ext σ; simp [capBelowN] + +theorem capBelowN_congr {β β' : ℕ → ℕ} {n : ℕ} (h : ∀ i < n, β i = β' i) : + capBelowN β n = capBelowN β' n := by + ext σ; constructor <;> intro hσ i hi + · rw [← h i hi]; exact hσ i hi + · rw [h i hi]; exact hσ i hi + +theorem capBelowN_update_subset (β : ℕ → ℕ) (n k : ℕ) : + capBelowN (Function.update β n k) (n + 1) ⊆ capBelowN β n := by + intro σ hσ i hi + have := hσ i (by omega) + rwa [Function.update_of_ne (by omega)] at this + +theorem capBelowN_eq_iUnion_update (β : ℕ → ℕ) (n : ℕ) : + capBelowN β n = ⋃ k, capBelowN (Function.update β n k) (n + 1) := by + ext σ + simp only [mem_iUnion] + constructor + · intro hσ + refine ⟨σ n, fun i hi => ?_⟩ + rcases Nat.lt_succ_iff_lt_or_eq.mp hi with h | h + · rw [Function.update_of_ne (by omega)]; exact hσ i h + · subst h; simp [Function.update_self] + · rintro ⟨k, hk⟩ i hi + have := hk i (by omega) + rwa [Function.update_of_ne (by omega)] at this + +theorem monotone_capBelowN_update (β : ℕ → ℕ) (n : ℕ) : + Monotone (fun k => capBelowN (Function.update β n k) (n + 1)) := by + intro k k' hkk' σ hσ i hi + rcases Nat.lt_succ_iff_lt_or_eq.mp hi with h | h + · rw [Function.update_of_ne (by omega)] + have := hσ i hi + rwa [Function.update_of_ne (by omega)] at this + · subst h + have := hσ i (by omega) + rw [Function.update_self] at this ⊢ + omega + +theorem capBelow_eq_pi (β : ℕ → ℕ) : + capBelow β = Set.pi univ (fun i => Iic (β i)) := by + ext σ; simp [capBelow, Pi.le_def] + +theorem isCompact_capBelow (β : ℕ → ℕ) : IsCompact (capBelow β) := by + rw [capBelow_eq_pi] + exact isCompact_univ_pi fun i => (Set.finite_Iic (β i)).isCompact + +/-- Truncation: keep the first `n` values, zero out the rest. -/ +def capTrunc (σ : ℕ → ℕ) (n : ℕ) : ℕ → ℕ := fun i => if i < n then σ i else 0 + +/-- Normalized representatives of prefixes bounded by `β`: finitely many. -/ +def capSeqs (β : ℕ → ℕ) (n : ℕ) : Set (ℕ → ℕ) := + {s | (∀ i < n, s i ≤ β i) ∧ ∀ i, n ≤ i → s i = 0} + +theorem capTrunc_mem_capSeqs {β : ℕ → ℕ} {n : ℕ} {σ : ℕ → ℕ} + (h : σ ∈ capBelowN β n) : capTrunc σ n ∈ capSeqs β n := by + refine ⟨fun i hi => ?_, fun i hi => ?_⟩ + · simp only [capTrunc, if_pos hi]; exact h i hi + · have hn : ¬ i < n := by omega + simp [capTrunc, hn] + +theorem capSeqs_finite (β : ℕ → ℕ) (n : ℕ) : (capSeqs β n).Finite := by + have hsub : capSeqs β n ⊆ + (fun g : Fin n → ℕ => fun i => if h : i < n then g ⟨i, h⟩ else 0) '' + (Set.pi univ fun j : Fin n => Iic (β j)) := by + rintro s ⟨h1, h2⟩ + refine ⟨fun j => s j, ?_, ?_⟩ + · intro j _; exact h1 j j.isLt + · funext i + by_cases h : i < n + · simp [h] + · simp [h, h2 i (by omega)] + have hfin : (Set.pi univ fun j : Fin n => Iic (β (j : ℕ))).Finite := + Set.Finite.pi fun j => Set.finite_Iic (β (j : ℕ)) + exact (hfin.image _).subset hsub + +theorem capSeqs_congr {β β' : ℕ → ℕ} {n : ℕ} (h : ∀ i < n, β i = β' i) : + capSeqs β n = capSeqs β' n := by + ext s + constructor <;> rintro ⟨h1, h2⟩ <;> refine ⟨fun i hi => ?_, h2⟩ + · rw [← h i hi]; exact h1 i hi + · rw [h i hi]; exact h1 i hi + +/-! ## Part II: The Souslin scheme of a continuous map -/ + +variable {Z : Type*} [TopologicalSpace Z] + +/-- The Souslin scheme piece: closure of the image of the cylinder `N_{f|n}`. -/ +def capScheme (π : (ℕ → ℕ) → Z) (f : ℕ → ℕ) (n : ℕ) : Set Z := + closure (π '' PiNat.cylinder f n) + +theorem capScheme_antitone (π : (ℕ → ℕ) → Z) (f : ℕ → ℕ) {m n : ℕ} (h : m ≤ n) : + capScheme π f n ⊆ capScheme π f m := + closure_mono (Set.image_mono fun _ hσ i hi => hσ i (lt_of_lt_of_le hi h)) + +theorem capScheme_congr (π : (ℕ → ℕ) → Z) {f g : ℕ → ℕ} {n : ℕ} + (h : ∀ i < n, f i = g i) : capScheme π f n = capScheme π g n := by + have hcyl : PiNat.cylinder f n = PiNat.cylinder g n := by + ext σ + simp only [PiNat.mem_cylinder_iff] + constructor <;> intro hσ i hi + · rw [← h i hi]; exact hσ i hi + · rw [h i hi]; exact hσ i hi + unfold capScheme + rw [hcyl] + +theorem capScheme_trunc (π : (ℕ → ℕ) → Z) (σ : ℕ → ℕ) (n : ℕ) : + capScheme π (capTrunc σ n) n = capScheme π σ n := + capScheme_congr π fun i hi => by simp [capTrunc, if_pos hi] + +/-- The n-th bounded approximation: finite union of scheme pieces with + prefix bounded by `β`. Closed. -/ +def capW (π : (ℕ → ℕ) → Z) (β : ℕ → ℕ) (n : ℕ) : Set Z := + ⋃ s ∈ capSeqs β n, capScheme π s n + +theorem isClosed_capW (π : (ℕ → ℕ) → Z) (β : ℕ → ℕ) (n : ℕ) : + IsClosed (capW π β n) := + (capSeqs_finite β n).isClosed_biUnion fun _ _ => isClosed_closure + +theorem capW_antitone (π : (ℕ → ℕ) → Z) (β : ℕ → ℕ) : Antitone (capW π β) := by + intro m n hmn z hz + simp only [capW, mem_iUnion] at hz ⊢ + obtain ⟨s, hs, hzs⟩ := hz + refine ⟨capTrunc s m, ?_, ?_⟩ + · exact capTrunc_mem_capSeqs fun i hi => hs.1 i (lt_of_lt_of_le hi hmn) + · rw [capScheme_trunc] + exact capScheme_antitone π s hmn hzs + +theorem capW_congr (π : (ℕ → ℕ) → Z) {β β' : ℕ → ℕ} {n : ℕ} + (h : ∀ i < n, β i = β' i) : capW π β n = capW π β' n := by + unfold capW + rw [capSeqs_congr h] + +/-! ## Part III: The core topological lemma -/ + +/-- **Core lemma.** For continuous `π` and any bound `β`, the decreasing + intersection of the bounded approximations is contained in the compact + set `π '' Σ(β)`. Proved by subsequence extraction in `Σ(β)`. -/ +theorem iInter_capW_subset {Z : Type*} [TopologicalSpace Z] [PolishSpace Z] + {π : (ℕ → ℕ) → Z} (hπ : Continuous π) (β : ℕ → ℕ) : + (⋂ n, capW π β n) ⊆ π '' capBelow β := by + letI := TopologicalSpace.upgradeIsCompletelyMetrizable Z + intro y hy + -- for each n, obtain a normalized bounded prefix sₙ with y ∈ closure (π '' N_{sₙ,n}) + have hsel : ∀ n : ℕ, ∃ s ∈ capSeqs β n, y ∈ capScheme π s n := by + intro n + have := mem_iInter.mp hy n + simpa only [capW, mem_iUnion, exists_prop] using this + choose s hs hys using hsel + -- for each n, pick τₙ in the cylinder with π τₙ within 1/(n+1) of y + have hτ : ∀ n : ℕ, ∃ τ ∈ PiNat.cylinder (s n) n, dist y (π τ) < 1 / (n + 1) := by + intro n + have hpos : (0 : ℝ) < 1 / (n + 1) := by positivity + obtain ⟨z, hz_mem, hz_dist⟩ := Metric.mem_closure_iff.mp (hys n) _ hpos + obtain ⟨τ, hτ_mem, rfl⟩ := hz_mem + exact ⟨τ, hτ_mem, hz_dist⟩ + choose τ hτ_mem hτ_dist using hτ + -- τₙ is bounded by β on the first n coordinates + have hτ_bdd : ∀ n, ∀ i < n, τ n i ≤ β i := by + intro n i hi + have h1 : τ n i = s n i := hτ_mem n i hi + rw [h1] + exact (hs n).1 i hi + -- clip to Σ(β) and extract a convergent subsequence + set ρ : ℕ → (ℕ → ℕ) := fun n => fun i => min (τ n i) (β i) with hρ + have hρ_mem : ∀ n, ρ n ∈ capBelow β := fun n i => min_le_right _ _ + obtain ⟨σ, hσ_mem, φ, hφ_mono, hφ_tendsto⟩ := + (isCompact_capBelow β).tendsto_subseq hρ_mem + -- τ ∘ φ converges pointwise to σ (eventually agrees with ρ ∘ φ) + have hτφ_tendsto : Tendsto (fun j => τ (φ j)) atTop (𝓝 σ) := by + rw [tendsto_pi_nhds] + intro i + have hρi : Tendsto (fun j => ρ (φ j) i) atTop (𝓝 (σ i)) := + (tendsto_pi_nhds.mp hφ_tendsto) i + apply hρi.congr' + filter_upwards [Filter.eventually_ge_atTop (i + 1)] with j hj + have hij : i < φ j := lt_of_lt_of_le (Nat.lt_succ_self i) (hj.trans (hφ_mono.le_apply)) + simp only [hρ] + exact min_eq_left (hτ_bdd (φ j) i hij) + -- π (τ (φ j)) → π σ, but also π (τ n) → y; conclude y = π σ + have h1 : Tendsto (fun j => π (τ (φ j))) atTop (𝓝 (π σ)) := + (hπ.tendsto σ).comp hτφ_tendsto + have h2 : Tendsto (fun n => π (τ n)) atTop (𝓝 y) := by + rw [tendsto_iff_dist_tendsto_zero] + exact tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds + tendsto_one_div_add_atTop_nhds_zero_nat (fun n => dist_nonneg) + (fun n => le_of_lt (by rw [dist_comm]; exact hτ_dist n)) + have h2φ : Tendsto (fun j => π (τ (φ j))) atTop (𝓝 y) := + h2.comp hφ_mono.tendsto_atTop + exact ⟨σ, hσ_mem, tendsto_nhds_unique h1 h2φ⟩ + +/-! ## Part IV: Branches and the Souslin kernel -/ + +/-- The branch set along `σ`: decreasing intersection of scheme pieces. -/ +def capBranch (π : (ℕ → ℕ) → Z) (σ : ℕ → ℕ) : Set Z := ⋂ n, capScheme π σ n + +/-- The Souslin kernel `𝒜(G)` of the scheme. -/ +def capKernel (π : (ℕ → ℕ) → Z) : Set Z := ⋃ σ, capBranch π σ + +/-- Branches whose first `n` coordinates are bounded by `β`. -/ +def capR (π : (ℕ → ℕ) → Z) (β : ℕ → ℕ) (n : ℕ) : Set Z := + ⋃ σ ∈ capBelowN β n, capBranch π σ + +theorem capR_zero (π : (ℕ → ℕ) → Z) (β : ℕ → ℕ) : capR π β 0 = capKernel π := by + unfold capR capKernel + rw [capBelowN_zero] + ext z; simp + +theorem capR_congr (π : (ℕ → ℕ) → Z) {β β' : ℕ → ℕ} {n : ℕ} + (h : ∀ i < n, β i = β' i) : capR π β n = capR π β' n := by + unfold capR + rw [capBelowN_congr h] + +theorem capR_eq_iUnion_update (π : (ℕ → ℕ) → Z) (β : ℕ → ℕ) (n : ℕ) : + capR π β n = ⋃ k, capR π (Function.update β n k) (n + 1) := by + unfold capR + rw [capBelowN_eq_iUnion_update] + exact biUnion_iUnion _ _ + +theorem monotone_capR_update (π : (ℕ → ℕ) → Z) (β : ℕ → ℕ) (n : ℕ) : + Monotone (fun k => capR π (Function.update β n k) (n + 1)) := fun _ _ hkk' => + biUnion_subset_biUnion_left (monotone_capBelowN_update β n hkk') + +theorem capR_subset_capW (π : (ℕ → ℕ) → Z) (β : ℕ → ℕ) (n : ℕ) : + capR π β n ⊆ capW π β n := by + intro z hz + simp only [capR, mem_iUnion, exists_prop] at hz + obtain ⟨σ, hσ, hz⟩ := hz + have h1 : z ∈ capScheme π σ n := mem_iInter.mp hz n + exact mem_biUnion (capTrunc_mem_capSeqs hσ) (by rwa [capScheme_trunc]) + +theorem range_subset_capKernel (π : (ℕ → ℕ) → Z) : range π ⊆ capKernel π := by + rintro _ ⟨σ, rfl⟩ + exact mem_iUnion.mpr ⟨σ, mem_iInter.mpr fun n => + subset_closure ⟨σ, fun i _ => rfl, rfl⟩⟩ + +/-- The Souslin kernel of the canonical scheme recovers exactly the range: + the nontrivial inclusion is via the core lemma with `β := σ`. -/ +theorem capKernel_eq_range {Z : Type*} [TopologicalSpace Z] [PolishSpace Z] + {π : (ℕ → ℕ) → Z} (hπ : Continuous π) : capKernel π = range π := by + refine subset_antisymm ?_ (range_subset_capKernel π) + intro z hz + obtain ⟨σ, hσ⟩ := mem_iUnion.mp hz + have h1 : z ∈ ⋂ n, capW π σ n := by + refine mem_iInter.mpr fun n => ?_ + have h2 := mem_iInter.mp hσ n + exact mem_biUnion (capTrunc_mem_capSeqs fun i _ => le_refl (σ i)) + (by rwa [capScheme_trunc]) + obtain ⟨ρ, _, rfl⟩ := iInter_capW_subset hπ σ h1 + exact mem_range_self ρ + +/-! ## Part V: The bounded recursion + +Given a monotone set functional `m` continuous along increasing countable +unions (e.g. an outer measure, or `S ↦ κ x (Prod.mk x ⁻¹' S)`), if +`c < m (capKernel π)` then one can recursively choose a bound `β` with +`c < m (capW π β n)` for all `n`. Mirrors `leftmostAuxG` from Tree.lean. -/ + +theorem cap_exists_ext {Z : Type*} [TopologicalSpace Z] + (π : (ℕ → ℕ) → Z) (m : Set Z → ℝ≥0∞) + (hsup : ∀ s : ℕ → Set Z, Monotone s → m (⋃ k, s k) = ⨆ k, m (s k)) + {c : ℝ≥0∞} {b : ℕ → ℕ} {n : ℕ} (hb : c < m (capR π b n)) : + ∃ k, c < m (capR π (Function.update b n k) (n + 1)) := by + have key : m (capR π b n) = ⨆ k, m (capR π (Function.update b n k) (n + 1)) := by + rw [← hsup _ (monotone_capR_update π b n), ← capR_eq_iUnion_update] + rw [key] at hb + exact lt_iSup_iff.mp hb + +/-- Recursive construction of the bound, one coordinate at a time. -/ +def capAux {Z : Type*} [TopologicalSpace Z] + (π : (ℕ → ℕ) → Z) (m : Set Z → ℝ≥0∞) + (hsup : ∀ s : ℕ → Set Z, Monotone s → m (⋃ k, s k) = ⨆ k, m (s k)) + {c : ℝ≥0∞} (h0 : c < m (capKernel π)) : + (n : ℕ) → {b : ℕ → ℕ // c < m (capR π b n)} + | 0 => ⟨fun _ => 0, by rw [capR_zero]; exact h0⟩ + | n + 1 => + ⟨Function.update (capAux π m hsup h0 n).val n + (cap_exists_ext π m hsup (capAux π m hsup h0 n).2).choose, + (cap_exists_ext π m hsup (capAux π m hsup h0 n).2).choose_spec⟩ + +/-- The diagonal bound. -/ +def capBound {Z : Type*} [TopologicalSpace Z] + (π : (ℕ → ℕ) → Z) (m : Set Z → ℝ≥0∞) + (hsup : ∀ s : ℕ → Set Z, Monotone s → m (⋃ k, s k) = ⨆ k, m (s k)) + {c : ℝ≥0∞} (h0 : c < m (capKernel π)) (n : ℕ) : ℕ := + (capAux π m hsup h0 (n + 1)).val n + +theorem capAux_eq {Z : Type*} [TopologicalSpace Z] + (π : (ℕ → ℕ) → Z) (m : Set Z → ℝ≥0∞) + (hsup : ∀ s : ℕ → Set Z, Monotone s → m (⋃ k, s k) = ⨆ k, m (s k)) + {c : ℝ≥0∞} (h0 : c < m (capKernel π)) : + ∀ n i, i < n → (capAux π m hsup h0 n).val i = capBound π m hsup h0 i := by + intro n + induction n with + | zero => intro i hi; omega + | succ n ih => + intro i hi + have hval : (capAux π m hsup h0 (n + 1)).val + = Function.update (capAux π m hsup h0 n).val n + (cap_exists_ext π m hsup (capAux π m hsup h0 n).2).choose := rfl + rcases Nat.lt_succ_iff_lt_or_eq.mp hi with h | h + · rw [hval, Function.update_of_ne (by omega)] + exact ih i h + · subst h + simp only [capBound] + +/-- **Bounded recursion.** From `c < m (𝒜(G))` produce a bound `β` with + `c < m (W(β, n))` for every `n`. -/ +theorem cap_exists_bound {Z : Type*} [TopologicalSpace Z] + (π : (ℕ → ℕ) → Z) (m : Set Z → ℝ≥0∞) + (hmono : ∀ ⦃S T : Set Z⦄, S ⊆ T → m S ≤ m T) + (hsup : ∀ s : ℕ → Set Z, Monotone s → m (⋃ k, s k) = ⨆ k, m (s k)) + {c : ℝ≥0∞} (h0 : c < m (capKernel π)) : + ∃ β : ℕ → ℕ, ∀ n, c < m (capW π β n) := by + refine ⟨capBound π m hsup h0, fun n => ?_⟩ + have h1 : c < m (capR π (capAux π m hsup h0 n).val n) := (capAux π m hsup h0 n).2 + have h2 : capR π (capAux π m hsup h0 n).val n + = capR π (capBound π m hsup h0) n := + capR_congr π fun i hi => capAux_eq π m hsup h0 n i hi + rw [h2] at h1 + exact lt_of_lt_of_le h1 (hmono (capR_subset_capW π _ n)) + +/-! ## Part VI: Choquet capacitability for a single finite measure -/ + +/-- **Choquet capacitability** (Kechris 30.13, measure case; BS Prop 7.42): + for a finite Borel measure on a Polish space, the (outer) measure of an + analytic set is the supremum of the measures of its compact subsets. -/ +theorem MeasureTheory.AnalyticSet.measure_eq_iSup_isCompact + {X : Type*} [TopologicalSpace X] [PolishSpace X] + [MeasurableSpace X] [BorelSpace X] + {A : Set X} (hA : AnalyticSet A) + (μ : Measure X) [IsFiniteMeasure μ] : + μ A = ⨆ (K : Set X) (_ : IsCompact K) (_ : K ⊆ A), μ K := by + refine le_antisymm ?_ + (iSup_le fun K => iSup_le fun _ => iSup_le fun hK => measure_mono hK) + refine le_of_forall_lt fun c hc => ?_ + rw [AnalyticSet] at hA + rcases hA with rfl | ⟨π, hπ_cont, hπ_range⟩ + · simp at hc + subst hπ_range + obtain ⟨c', hcc', hc'A⟩ := exists_between hc + have h0 : c' < μ (capKernel π) := by rwa [capKernel_eq_range hπ_cont] + obtain ⟨β, hβ⟩ := cap_exists_bound π (fun S => μ S) + (fun _ _ h => measure_mono h) (fun _ hs => hs.measure_iUnion) h0 + have h_iInter : μ (⋂ n, capW π β n) = ⨅ n, μ (capW π β n) := + Directed.measure_iInter + (fun n => (isClosed_capW π β n).measurableSet.nullMeasurableSet) + (fun i j => ⟨max i j, capW_antitone π β (le_max_left i j), + capW_antitone π β (le_max_right i j)⟩) + ⟨0, measure_ne_top μ _⟩ + have hKc : c' ≤ μ (π '' capBelow β) := + calc c' ≤ ⨅ n, μ (capW π β n) := le_iInf fun n => (hβ n).le + _ = μ (⋂ n, capW π β n) := h_iInter.symm + _ ≤ μ (π '' capBelow β) := measure_mono (iInter_capW_subset hπ_cont β) + calc c < c' := hcc' + _ ≤ μ (π '' capBelow β) := hKc + _ ≤ ⨆ (K : Set X) (_ : IsCompact K) (_ : K ⊆ range π), μ K := + le_iSup_of_le (π '' capBelow β) + (le_iSup_of_le ((isCompact_capBelow β).image hπ_cont) + (le_iSup_of_le (image_subset_range π _) le_rfl)) + +/-- **Analytic sets are universally measurable** (Lusin; BS Prop 7.42): + null-measurable with respect to every finite Borel measure. -/ +theorem MeasureTheory.AnalyticSet.nullMeasurableSet + {X : Type*} [TopologicalSpace X] [PolishSpace X] + [MeasurableSpace X] [BorelSpace X] + {A : Set X} (hA : AnalyticSet A) + (μ : Measure X) [IsFiniteMeasure μ] : + NullMeasurableSet A μ := by + -- inner approximation by compacts, within 1/(k+1) + have key : ∀ k : ℕ, ∃ K : Set X, + IsCompact K ∧ K ⊆ A ∧ μ A ≤ μ K + ((k : ℝ≥0∞) + 1)⁻¹ := by + intro k + by_cases h0 : μ A = 0 + · exact ⟨∅, isCompact_empty, empty_subset A, by simp [h0]⟩ + have hε : ((k : ℝ≥0∞) + 1)⁻¹ ≠ 0 := + ENNReal.inv_ne_zero.mpr (by finiteness) + have hlt : μ A - ((k : ℝ≥0∞) + 1)⁻¹ + < ⨆ (K : Set X) (_ : IsCompact K) (_ : K ⊆ A), μ K := + lt_of_lt_of_le (ENNReal.sub_lt_self (measure_ne_top μ A) h0 hε) + (le_of_eq (hA.measure_eq_iSup_isCompact μ)) + obtain ⟨K, hK⟩ := lt_iSup_iff.mp hlt + obtain ⟨hcpt, hK2⟩ := lt_iSup_iff.mp hK + obtain ⟨hsub, hK3⟩ := lt_iSup_iff.mp hK2 + exact ⟨K, hcpt, hsub, tsub_le_iff_right.mp hK3.le⟩ + choose K hcpt hsub hge using key + -- B = ⋃ K k is a Borel subset of A of full outer measure + have hBmeas : MeasurableSet (⋃ k, K k) := + MeasurableSet.iUnion fun k => (hcpt k).isClosed.measurableSet + have hBsub : (⋃ k, K k) ⊆ A := iUnion_subset hsub + have hBeq : μ (⋃ k, K k) = μ A := by + refine le_antisymm (measure_mono hBsub) ?_ + refine ENNReal.le_of_forall_pos_le_add fun ε hε _ => ?_ + obtain ⟨k, hk⟩ := ENNReal.exists_inv_nat_lt + (show (ε : ℝ≥0∞) ≠ 0 from by exact_mod_cast hε.ne') + have hk1 : ((k : ℝ≥0∞) + 1)⁻¹ ≤ (ε : ℝ≥0∞) := + le_of_lt (lt_of_le_of_lt (ENNReal.inv_le_inv.mpr le_self_add) hk) + calc μ A ≤ μ (K k) + ((k : ℝ≥0∞) + 1)⁻¹ := hge k + _ ≤ μ (⋃ j, K j) + (ε : ℝ≥0∞) := by + gcongr + exact subset_iUnion K k + -- measurable hull H ⊇ A; then A \ B ⊆ H \ B is null + obtain ⟨H, hAH, hHmeas, hHeq⟩ := exists_measurable_superset μ A + have hnull : μ (H \ ⋃ k, K k) = 0 := by + rw [measure_sdiff (hBsub.trans hAH) hBmeas.nullMeasurableSet + (measure_ne_top μ _), hHeq, hBeq] + exact tsub_self _ + have hABnull : μ (A \ ⋃ k, K k) = 0 := + measure_mono_null (sdiff_subset_sdiff_left hAH) hnull + rw [← union_sdiff_cancel hBsub] + exact hBmeas.nullMeasurableSet.union (NullMeasurableSet.of_null hABnull) + +/-! ## Part VII: Parametrized capacitability — the kernel key lemma -/ + +open ProbabilityTheory + +section KernelLemma + +variable {X Y : Type*} + [TopologicalSpace X] [PolishSpace X] [MeasurableSpace X] [BorelSpace X] + [TopologicalSpace Y] [PolishSpace Y] [MeasurableSpace Y] [BorelSpace Y] + +omit [BorelSpace X] [BorelSpace Y] in +/-- (b) direction, pointwise: from `c < κ x (A_x)` produce a bound `β` + controlling all bounded approximations. -/ +theorem cap_kernel_exists_bound + {π : (ℕ → ℕ) → (X × Y)} (hπ : Continuous π) + (κ : Kernel X Y) {x : X} {c : ℝ≥0∞} + (hc : c < κ x (Prod.mk x ⁻¹' range π)) : + ∃ β : ℕ → ℕ, ∀ n, c < κ x (Prod.mk x ⁻¹' capW π β n) := by + have h0 : c < κ x (Prod.mk x ⁻¹' capKernel π) := by + rwa [capKernel_eq_range hπ] + exact cap_exists_bound π (fun S => κ x (Prod.mk x ⁻¹' S)) + (fun _ _ hST => measure_mono (preimage_mono hST)) + (fun s hs => by + show (κ x) (Prod.mk x ⁻¹' ⋃ k, s k) = ⨆ k, (κ x) (Prod.mk x ⁻¹' s k) + rw [preimage_iUnion] + exact Monotone.measure_iUnion fun i j hij => preimage_mono (hs hij)) + h0 + +omit [BorelSpace X] in +/-- (a) direction, pointwise: a bound `β` controlling all approximations + forces `c ≤ κ x (A_x)` (via the core lemma and continuity from above). -/ +theorem cap_kernel_le_of_bound + {π : (ℕ → ℕ) → (X × Y)} (hπ : Continuous π) + (κ : Kernel X Y) [IsFiniteKernel κ] {x : X} {c : ℝ≥0∞} {β : ℕ → ℕ} + (h : ∀ n, c < κ x (Prod.mk x ⁻¹' capW π β n)) : + c ≤ κ x (Prod.mk x ⁻¹' range π) := by + have hmeas : ∀ n, NullMeasurableSet (Prod.mk x ⁻¹' capW π β n) (κ x) := fun n => + (((isClosed_capW π β n).preimage + (Continuous.prodMk continuous_const continuous_id)).measurableSet).nullMeasurableSet + have h_iInter : κ x (⋂ n, Prod.mk x ⁻¹' capW π β n) + = ⨅ n, κ x (Prod.mk x ⁻¹' capW π β n) := + Directed.measure_iInter hmeas + (fun i j => ⟨max i j, + preimage_mono (capW_antitone π β (le_max_left i j)), + preimage_mono (capW_antitone π β (le_max_right i j))⟩) + ⟨0, measure_ne_top _ _⟩ + calc c ≤ ⨅ n, κ x (Prod.mk x ⁻¹' capW π β n) := le_iInf fun n => (h n).le + _ = κ x (⋂ n, Prod.mk x ⁻¹' capW π β n) := h_iInter.symm + _ ≤ κ x (Prod.mk x ⁻¹' (π '' capBelow β)) := by + refine measure_mono ?_ + rw [← preimage_iInter] + exact preimage_mono (iInter_capW_subset hπ β) + _ ≤ κ x (Prod.mk x ⁻¹' range π) := + measure_mono (preimage_mono (image_subset_range π _)) + +/-- Padding a finite tuple into an `ℕ`-indexed bound. -/ +def capPad (n : ℕ) (b : Fin n → ℕ) : ℕ → ℕ := + fun i => if h : i < n then b ⟨i, h⟩ else 0 + +omit [PolishSpace X] in +/-- Borel measurability of one layer of the parametrized construction: + the bound `β` acts through finitely many coordinates, so the layer is a + countable union of measurable rectangles. -/ +theorem cap_measurable_layer + (π : (ℕ → ℕ) → (X × Y)) (κ : Kernel X Y) [IsSFiniteKernel κ] + (q : ℝ≥0∞) (n : ℕ) : + MeasurableSet {p : X × (ℕ → ℕ) | + q < κ p.1 (Prod.mk p.1 ⁻¹' capW π p.2 n)} := by + have hdecomp : {p : X × (ℕ → ℕ) | q < κ p.1 (Prod.mk p.1 ⁻¹' capW π p.2 n)} + = ⋃ b : Fin n → ℕ, + ({x | q < κ x (Prod.mk x ⁻¹' capW π (capPad n b) n)} ×ˢ + {β : ℕ → ℕ | ∀ i : Fin n, β i = b i}) := by + ext ⟨x, β⟩ + simp only [mem_ofPred_eq, mem_iUnion, mem_prod] + constructor + · intro hq + refine ⟨fun i => β i, ?_, fun i => rfl⟩ + have hW : capW π (capPad n (fun i : Fin n => β i)) n = capW π β n := + capW_congr π fun i hi => by simp [capPad, hi] + rw [hW]; exact hq + · rintro ⟨b, hq, hb⟩ + have hW : capW π β n = capW π (capPad n b) n := + capW_congr π fun i hi => by + have := hb ⟨i, hi⟩ + simp [capPad, hi, this] + rw [hW]; exact hq + rw [hdecomp] + refine MeasurableSet.iUnion fun b => MeasurableSet.prod ?_ ?_ + · exact measurableSet_lt measurable_const + (Kernel.measurable_kernel_prodMk_left (isClosed_capW π _ n).measurableSet) + · have : {β : ℕ → ℕ | ∀ i : Fin n, β i = b i} + = ⋂ i : Fin n, (fun β : ℕ → ℕ => β i) ⁻¹' {b i} := by + ext β; simp + rw [this] + exact MeasurableSet.iInter fun i => + (measurable_pi_apply (i : ℕ)) (measurableSet_singleton (b i)) + +/-- **Parametrized Choquet capacitability** (kernel key lemma; BS Prop 7.46): + for `A` analytic in `X × Y` and a finite Borel kernel `κ`, the function + `x ↦ κ x (A_x)` is upper semianalytic: its strict superlevel sets are + analytic. -/ +theorem MeasureTheory.AnalyticSet.kernel_section_gt + {A : Set (X × Y)} (hA : AnalyticSet A) + (κ : Kernel X Y) [IsFiniteKernel κ] (c : ℝ≥0∞) : + AnalyticSet {x | c < κ x (Prod.mk x ⁻¹' A)} := by + rw [AnalyticSet] at hA + rcases hA with rfl | ⟨π, hπ_cont, hπ_range⟩ + · have hempty : {x : X | c < κ x (Prod.mk x ⁻¹' (∅ : Set (X × Y)))} = ∅ := by + ext x; simp + rw [hempty]; exact analyticSet_empty + subst hπ_range + have main : {x | c < κ x (Prod.mk x ⁻¹' range π)} + = ⋃ q : ℚ, Prod.fst '' + {p : X × (ℕ → ℕ) | c < (Real.toNNReal q : ℝ≥0∞) ∧ + ∀ n, (Real.toNNReal q : ℝ≥0∞) + < κ p.1 (Prod.mk p.1 ⁻¹' capW π p.2 n)} := by + ext x + simp only [mem_ofPred_eq, mem_iUnion, mem_image, Prod.exists] + constructor + · intro hc + obtain ⟨q, _, hq1, hq2⟩ := ENNReal.lt_iff_exists_rat_btwn.mp hc + obtain ⟨β, hβ⟩ := cap_kernel_exists_bound hπ_cont κ hq2 + exact ⟨q, x, β, ⟨hq1, hβ⟩, rfl⟩ + · rintro ⟨q, x', β, ⟨hq1, hβ⟩, rfl⟩ + exact lt_of_lt_of_le hq1 (cap_kernel_le_of_bound hπ_cont κ hβ) + rw [main] + refine AnalyticSet.iUnion fun q => ?_ + refine AnalyticSet.image_of_continuous ?_ continuous_fst + refine MeasurableSet.analyticSet ?_ + by_cases hcq : c < (Real.toNNReal q : ℝ≥0∞) + · have heq : {p : X × (ℕ → ℕ) | c < (Real.toNNReal q : ℝ≥0∞) ∧ + ∀ n, (Real.toNNReal q : ℝ≥0∞) + < κ p.1 (Prod.mk p.1 ⁻¹' capW π p.2 n)} + = ⋂ n, {p : X × (ℕ → ℕ) | (Real.toNNReal q : ℝ≥0∞) + < κ p.1 (Prod.mk p.1 ⁻¹' capW π p.2 n)} := by + ext p; simp [hcq] + rw [heq] + exact MeasurableSet.iInter fun n => cap_measurable_layer π κ _ n + · have heq : {p : X × (ℕ → ℕ) | c < (Real.toNNReal q : ℝ≥0∞) ∧ + ∀ n, (Real.toNNReal q : ℝ≥0∞) + < κ p.1 (Prod.mk p.1 ⁻¹' capW π p.2 n)} = ∅ := by + ext p; simp [hcq] + rw [heq] + exact MeasurableSet.empty + +end KernelLemma + +end diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsCompact.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsCompact.lean new file mode 100644 index 0000000000..f258615078 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsCompact.lean @@ -0,0 +1,232 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Compactness of coupling sets in the topology of weak convergence + + Blueprint: BLUEPRINT.md §7, wave 3, front F3. For Borel Polish spaces + `A`, `B` and probability measures `mu` on `A`, `nu` on `B`, the set of + couplings `{γ | fst_* γ = mu ∧ snd_* γ = nu}` is compact in + `ProbabilityMeasure (A × B)` with the topology of weak convergence. + + Route: (i) the coupling set is uniformly TIGHT — `mu` and `nu` are + individually tight (`isTightMeasureSet_singleton`, Polish ⇒ completely + metrizable + second countable), and for any coupling `γ`, + `γ ((K₁ ×ˢ K₂)ᶜ) ≤ γ (K₁ᶜ ×ˢ univ) + γ (univ ×ˢ K₂ᶜ) = mu K₁ᶜ + nu K₂ᶜ` + via the marginal equations (`Set.compl_prod_eq_union`, + `Measure.map_apply measurable_fst`); (ii) Prokhorov + (`isCompact_closure_of_isTightMeasureSet`) gives compactness of the + closure; (iii) the set is CLOSED (front F2's + `isClosed_probabilityMeasure_couplings`, reproduced below), so it equals + its closure. + + As in F2, the `Measure.map`-level reformulations matching the shape of + the repository's marginal constraints (`CouplingSet₀` in Defs.lean, + `MultiPeriod.Feas`) are provided, including the unconditional plain- + `Measure`-target version (empty when a target is not a probability + measure — and the empty set is compact). + + Bonus: nonemptiness via the product coupling + (`ProbabilityMeasure.prod`, `ProbabilityMeasure.map_fst_prod`) — NOTE + this may duplicate front F1's deliverable; dedupe at integration. + + DEDUPE NOTE FOR THE INTEGRATOR: the section "Translation" and the + theorems `isClosed_probabilityMeasure_couplings`, + `probabilityMeasure_couplings_toMeasure_eq` are copied VERBATIM from + front F2's draft_FeasClosed.lean (scratch files cannot import each + other); keep a single copy when integrating both fronts. +-/ +import Mathlib + +open MeasureTheory Topology + +noncomputable section + +/-! ## Translation between `ProbabilityMeasure.map` and `Measure.map` constraints +(verbatim copy of front F2's lemma — dedupe at integration) -/ + +section Translation + +variable {Ω Ω' : Type*} [MeasurableSpace Ω] [MeasurableSpace Ω'] + +/-- A marginal-type constraint on a `ProbabilityMeasure` can be stated equivalently via +`ProbabilityMeasure.map` or via `Measure.map` on the underlying measures. -/ +theorem probabilityMeasure_map_eq_iff (γ : ProbabilityMeasure Ω) (μ : ProbabilityMeasure Ω') + {f : Ω → Ω'} (hf : Measurable f) : + γ.map hf.aemeasurable = μ ↔ (γ : Measure Ω).map f = (μ : Measure Ω') := by + constructor + · rintro rfl + rfl + · intro h + apply ProbabilityMeasure.toMeasure_injective + rw [ProbabilityMeasure.toMeasure_map] + exact h + +end Translation + +/-! ## Closedness of coupling sets (front F2, reproduced) -/ + +section Couplings + +variable {A B : Type*} + [TopologicalSpace A] [PolishSpace A] [MeasurableSpace A] [BorelSpace A] + [TopologicalSpace B] [PolishSpace B] [MeasurableSpace B] [BorelSpace B] + +/-- **F2, `ProbabilityMeasure` level** (verbatim copy — dedupe at integration). On Borel +Polish spaces, the set of couplings of `mu` and `nu` is closed in the topology of weak +convergence. -/ +theorem isClosed_probabilityMeasure_couplings + (mu : ProbabilityMeasure A) (nu : ProbabilityMeasure B) : + IsClosed {γ : ProbabilityMeasure (A × B) | + γ.map measurable_fst.aemeasurable = mu ∧ γ.map measurable_snd.aemeasurable = nu} := by + have hfst : IsClosed {γ : ProbabilityMeasure (A × B) | + γ.map measurable_fst.aemeasurable = mu} := + isClosed_singleton.preimage (ProbabilityMeasure.continuous_map continuous_fst) + have hsnd : IsClosed {γ : ProbabilityMeasure (A × B) | + γ.map measurable_snd.aemeasurable = nu} := + isClosed_singleton.preimage (ProbabilityMeasure.continuous_map continuous_snd) + exact hfst.inter hsnd + +omit [TopologicalSpace A] [PolishSpace A] [BorelSpace A] + [TopologicalSpace B] [PolishSpace B] [BorelSpace B] in +/-- The coupling set stated with `Measure.map` constraints on the underlying measures +(the shape used by `CouplingSet₀` and `MultiPeriod.Feas`) coincides with the coupling +set stated via `ProbabilityMeasure.map` (verbatim copy of F2 — dedupe at integration). -/ +theorem probabilityMeasure_couplings_toMeasure_eq + (mu : ProbabilityMeasure A) (nu : ProbabilityMeasure B) : + {γ : ProbabilityMeasure (A × B) | + (γ : Measure (A × B)).map Prod.fst = (mu : Measure A) ∧ + (γ : Measure (A × B)).map Prod.snd = (nu : Measure B)} + = {γ : ProbabilityMeasure (A × B) | + γ.map measurable_fst.aemeasurable = mu ∧ + γ.map measurable_snd.aemeasurable = nu} := by + ext γ + exact and_congr (probabilityMeasure_map_eq_iff γ mu measurable_fst).symm + (probabilityMeasure_map_eq_iff γ nu measurable_snd).symm + +/-! ## Tightness of coupling sets (front F3, new) -/ + +/-- **F3, tightness, `Measure` level.** On Borel Polish spaces, the set of measures on +`A × B` with marginals `mu` and `nu` is uniformly tight: `mu` and `nu` are individually +tight, and if `K₁`, `K₂` capture all but `ε / 2` of the mass of `mu`, `nu` respectively, +then `K₁ ×ˢ K₂` captures all but `ε` of the mass of every coupling, by the marginal +equations. -/ +theorem isTightMeasureSet_couplings + (mu : ProbabilityMeasure A) (nu : ProbabilityMeasure B) : + IsTightMeasureSet {γm : Measure (A × B) | + γm.map Prod.fst = (mu : Measure A) ∧ γm.map Prod.snd = (nu : Measure B)} := by + rw [isTightMeasureSet_iff_exists_isCompact_measure_compl_le] + intro ε hε + obtain ⟨K₁, hK₁, hK₁le⟩ := + isTightMeasureSet_iff_exists_isCompact_measure_compl_le.1 + (isTightMeasureSet_singleton (μ := (mu : Measure A))) (ε / 2) (ENNReal.half_pos hε.ne') + obtain ⟨K₂, hK₂, hK₂le⟩ := + isTightMeasureSet_iff_exists_isCompact_measure_compl_le.1 + (isTightMeasureSet_singleton (μ := (nu : Measure B))) (ε / 2) (ENNReal.half_pos hε.ne') + refine ⟨K₁ ×ˢ K₂, hK₁.prod hK₂, ?_⟩ + rintro γm ⟨hfst, hsnd⟩ + calc γm ((K₁ ×ˢ K₂)ᶜ) + = γm ((K₁ᶜ ×ˢ Set.univ) ∪ (Set.univ ×ˢ K₂ᶜ)) := by rw [Set.compl_prod_eq_union] + _ ≤ γm (K₁ᶜ ×ˢ Set.univ) + γm (Set.univ ×ˢ K₂ᶜ) := measure_union_le _ _ + _ = (mu : Measure A) K₁ᶜ + (nu : Measure B) K₂ᶜ := by + rw [Set.prod_univ, Set.univ_prod, + ← Measure.map_apply measurable_fst hK₁.isClosed.measurableSet.compl, + ← Measure.map_apply measurable_snd hK₂.isClosed.measurableSet.compl, hfst, hsnd] + _ ≤ ε / 2 + ε / 2 := + add_le_add (hK₁le _ (Set.mem_singleton _)) (hK₂le _ (Set.mem_singleton _)) + _ = ε := ENNReal.add_halves ε + +/-- **F3, tightness, image form.** The underlying measures of the coupling set of `mu` +and `nu` form a tight set of measures — the exact hypothesis shape of Prokhorov's +theorem `isCompact_closure_of_isTightMeasureSet`. -/ +theorem isTightMeasureSet_probabilityMeasure_couplings + (mu : ProbabilityMeasure A) (nu : ProbabilityMeasure B) : + IsTightMeasureSet {((γ : ProbabilityMeasure (A × B)) : Measure (A × B)) | + γ ∈ {γ' : ProbabilityMeasure (A × B) | + γ'.map measurable_fst.aemeasurable = mu ∧ + γ'.map measurable_snd.aemeasurable = nu}} := by + refine (isTightMeasureSet_couplings mu nu).subset ?_ + rintro x ⟨γ, ⟨h₁, h₂⟩, rfl⟩ + exact ⟨(probabilityMeasure_map_eq_iff γ mu measurable_fst).1 h₁, + (probabilityMeasure_map_eq_iff γ nu measurable_snd).1 h₂⟩ + +/-! ## Compactness of coupling sets (front F3, main results) -/ + +/-- **F3, MAIN TARGET.** On Borel Polish spaces, the set of couplings of `mu` and `nu` +is compact in the topology of weak convergence: it is tight +(`isTightMeasureSet_probabilityMeasure_couplings`), so its closure is compact by +Prokhorov's theorem, and it is closed (`isClosed_probabilityMeasure_couplings`), so it +equals its closure. -/ +theorem isCompact_probabilityMeasure_couplings + (mu : ProbabilityMeasure A) (nu : ProbabilityMeasure B) : + IsCompact {γ : ProbabilityMeasure (A × B) | + γ.map measurable_fst.aemeasurable = mu ∧ γ.map measurable_snd.aemeasurable = nu} := by + have hcompact : IsCompact (closure {γ : ProbabilityMeasure (A × B) | + γ.map measurable_fst.aemeasurable = mu ∧ γ.map measurable_snd.aemeasurable = nu}) := + isCompact_closure_of_isTightMeasureSet + (isTightMeasureSet_probabilityMeasure_couplings mu nu) + rwa [(isClosed_probabilityMeasure_couplings mu nu).closure_eq] at hcompact + +/-- **F3, `Measure` level, `ProbabilityMeasure` targets.** The set of probability +measures on `A × B` whose underlying measure has marginals `mu` and `nu` is compact in +the topology of weak convergence. -/ +theorem isCompact_probabilityMeasure_couplings_toMeasure + (mu : ProbabilityMeasure A) (nu : ProbabilityMeasure B) : + IsCompact {γ : ProbabilityMeasure (A × B) | + (γ : Measure (A × B)).map Prod.fst = (mu : Measure A) ∧ + (γ : Measure (A × B)).map Prod.snd = (nu : Measure B)} := by + rw [probabilityMeasure_couplings_toMeasure_eq] + exact isCompact_probabilityMeasure_couplings mu nu + +/-- **F3, `Measure` level, plain `Measure` targets, unconditional.** For arbitrary +target measures `m`, `n` (the exact shape of `MultiPeriod.Feas` and `CouplingSet₀`, +reindexed over probability measures on the product), the constraint set is compact in +the topology of weak convergence: if either target fails to be a probability measure +the set is empty, and the empty set is compact. -/ +theorem isCompact_probabilityMeasure_marginals (m : Measure A) (n : Measure B) : + IsCompact {γ : ProbabilityMeasure (A × B) | + (γ : Measure (A × B)).map Prod.fst = m ∧ (γ : Measure (A × B)).map Prod.snd = n} := by + by_cases hm : IsProbabilityMeasure m + · by_cases hn : IsProbabilityMeasure n + · exact isCompact_probabilityMeasure_couplings_toMeasure ⟨m, hm⟩ ⟨n, hn⟩ + · have hempty : {γ : ProbabilityMeasure (A × B) | + (γ : Measure (A × B)).map Prod.fst = m ∧ + (γ : Measure (A × B)).map Prod.snd = n} = ∅ := by + ext γ + simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false, iff_false, not_and] + intro _ h2 + exact hn (h2 ▸ (γ : Measure (A × B)).isProbabilityMeasure_map + measurable_snd.aemeasurable) + rw [hempty] + exact isCompact_empty + · have hempty : {γ : ProbabilityMeasure (A × B) | + (γ : Measure (A × B)).map Prod.fst = m ∧ + (γ : Measure (A × B)).map Prod.snd = n} = ∅ := by + ext γ + simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false, iff_false, not_and] + intro h1 _ + exact hm (h1 ▸ (γ : Measure (A × B)).isProbabilityMeasure_map + measurable_fst.aemeasurable) + rw [hempty] + exact isCompact_empty + +/-! ## Bonus: nonemptiness via the product coupling +(NOTE: front F1 owns nonemptiness — dedupe at integration if F1 delivers) -/ + +omit [TopologicalSpace A] [PolishSpace A] [BorelSpace A] + [TopologicalSpace B] [PolishSpace B] [BorelSpace B] in +/-- The coupling set is nonempty: the product measure `mu ⊗ nu` is a coupling. +Together with `isCompact_probabilityMeasure_couplings` this yields a NONEMPTY COMPACT +coupling set — the Existence-upgrade prize. -/ +theorem probabilityMeasure_couplings_nonempty + (mu : ProbabilityMeasure A) (nu : ProbabilityMeasure B) : + {γ : ProbabilityMeasure (A × B) | + γ.map measurable_fst.aemeasurable = mu ∧ + γ.map measurable_snd.aemeasurable = nu}.Nonempty := + ⟨mu.prod nu, ProbabilityMeasure.map_fst_prod mu nu, ProbabilityMeasure.map_snd_prod mu nu⟩ + +end Couplings + +end diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsUHC.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsUHC.lean new file mode 100644 index 0000000000..af66b95b10 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsUHC.lean @@ -0,0 +1,225 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Sequential Upper Hemicontinuity of the Couplings Correspondence + + Phase 5, File 1 (BLUEPRINT §4F). The couplings correspondence + Π : P(A) × P(B) → Set P(A × B) is sequentially upper hemicontinuous: + along convergent marginal sequences, couplings admit convergent + subsequences whose limits couple the limit marginals (U3). Hit-sets of + closed targets are closed (U4), and hit-sets of open targets are Borel + via the Fσ decomposition of opens in metrizable spaces (U5). + + Route: convergent sequences of probability measures are tight (U1, + via compactness of the closure of the range and Mathlib's converse + Prokhorov `isTightMeasureSet_of_isCompact_closure`); couplings of + tight families are tight (U2, slab bound); Prokhorov + metrizability + extract convergent subsequences whose marginals are identified by + continuity of the pushforward (U3). +-/ +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsCompact +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish + +open MeasureTheory Set Filter Topology + +noncomputable section + +/-! ## U1: convergent sequences of probability measures are tight -/ + +/-- A convergent sequence of probability measures on a Polish space is a + tight family (converse Prokhorov on the compact closure of its range). -/ +theorem isTightMeasureSet_range_of_tendsto {Ω : Type*} + [TopologicalSpace Ω] [PolishSpace Ω] [MeasurableSpace Ω] [BorelSpace Ω] + {γs : ℕ → ProbabilityMeasure Ω} {γ : ProbabilityMeasure Ω} + (hγ : Tendsto γs atTop (𝓝 γ)) : + IsTightMeasureSet {((γs n : ProbabilityMeasure Ω) : Measure Ω) | n : ℕ} := by + have hins : IsCompact (insert γ (Set.range γs)) := hγ.isCompact_insert_range + have hclos : IsCompact (closure (Set.range γs)) := + hins.of_isClosed_subset isClosed_closure + (closure_minimal (Set.subset_insert γ (Set.range γs)) hins.isClosed) + letI := TopologicalSpace.upgradeIsCompletelyMetrizable Ω + have htight := isTightMeasureSet_of_isCompact_closure hclos + have hset : {((μ : ProbabilityMeasure Ω) : Measure Ω) | μ ∈ Set.range γs} + = {((γs n : ProbabilityMeasure Ω) : Measure Ω) | n : ℕ} := by + ext m + constructor + · rintro ⟨μ, ⟨n, rfl⟩, rfl⟩ + exact ⟨n, rfl⟩ + · rintro ⟨n, rfl⟩ + exact ⟨γs n, ⟨n, rfl⟩, rfl⟩ + rwa [hset] at htight + +/-! ## U2: couplings of tight families are tight -/ + +variable {A B : Type*} + [TopologicalSpace A] [PolishSpace A] [MeasurableSpace A] [BorelSpace A] + [TopologicalSpace B] [PolishSpace B] [MeasurableSpace B] [BorelSpace B] + +/-- Couplings whose marginals range over tight families form a tight + family: the slab bound `γ ((K₁ ×ˢ K₂)ᶜ) ≤ μ K₁ᶜ + ν K₂ᶜ`. -/ +theorem isTightMeasureSet_couplings_of_isTightMeasureSet + {S : Set (Measure A)} {T : Set (Measure B)} + (hS : IsTightMeasureSet S) (hT : IsTightMeasureSet T) : + IsTightMeasureSet + {γm : Measure (A × B) | γm.map Prod.fst ∈ S ∧ γm.map Prod.snd ∈ T} := by + rw [isTightMeasureSet_iff_exists_isCompact_measure_compl_le] at hS hT ⊢ + intro ε hε + obtain ⟨K₁, hK₁c, hK₁⟩ := hS (ε / 2) (ENNReal.half_pos hε.ne') + obtain ⟨K₂, hK₂c, hK₂⟩ := hT (ε / 2) (ENNReal.half_pos hε.ne') + refine ⟨K₁ ×ˢ K₂, hK₁c.prod hK₂c, fun γm hγm => ?_⟩ + calc γm ((K₁ ×ˢ K₂)ᶜ) + = γm ((K₁ᶜ ×ˢ univ) ∪ (univ ×ˢ K₂ᶜ)) := by rw [Set.compl_prod_eq_union] + _ ≤ γm (K₁ᶜ ×ˢ univ) + γm (univ ×ˢ K₂ᶜ) := measure_union_le _ _ + _ = (γm.map Prod.fst) K₁ᶜ + (γm.map Prod.snd) K₂ᶜ := by + rw [Set.prod_univ, Set.univ_prod, + Measure.map_apply measurable_fst hK₁c.isClosed.measurableSet.compl, + Measure.map_apply measurable_snd hK₂c.isClosed.measurableSet.compl] + _ ≤ ε / 2 + ε / 2 := add_le_add (hK₁ _ hγm.1) (hK₂ _ hγm.2) + _ = ε := ENNReal.add_halves ε + +/-! ## U3: sequential upper hemicontinuity of the couplings correspondence -/ + +/-- **Sequential upper hemicontinuity.** Along convergent marginal + sequences, any sequence of couplings admits a subsequence converging + to a coupling of the limit marginals (tightness + Prokhorov + + continuity of the marginal maps). -/ +theorem exists_tendsto_subseq_couplings + {μs : ℕ → ProbabilityMeasure A} {μ : ProbabilityMeasure A} + {νs : ℕ → ProbabilityMeasure B} {ν : ProbabilityMeasure B} + (hμ : Tendsto μs atTop (𝓝 μ)) (hν : Tendsto νs atTop (𝓝 ν)) + {γs : ℕ → ProbabilityMeasure (A × B)} + (hfst : ∀ n, (γs n : Measure (A × B)).map Prod.fst = (μs n : Measure A)) + (hsnd : ∀ n, (γs n : Measure (A × B)).map Prod.snd = (νs n : Measure B)) : + ∃ γ : ProbabilityMeasure (A × B), + (γ : Measure (A × B)).map Prod.fst = (μ : Measure A) ∧ + (γ : Measure (A × B)).map Prod.snd = (ν : Measure B) ∧ + ∃ φ : ℕ → ℕ, StrictMono φ ∧ Tendsto (γs ∘ φ) atTop (𝓝 γ) := by + -- the couplings are a tight family + have htight : IsTightMeasureSet + {((γs n : ProbabilityMeasure (A × B)) : Measure (A × B)) | n : ℕ} := by + have h12 := isTightMeasureSet_couplings_of_isTightMeasureSet + (isTightMeasureSet_range_of_tendsto hμ) + (isTightMeasureSet_range_of_tendsto hν) + refine h12.subset ?_ + rintro m ⟨n, rfl⟩ + exact ⟨⟨n, (hfst n).symm⟩, ⟨n, (hsnd n).symm⟩⟩ + -- Prokhorov: the closure of the range is compact + have hcomp : IsCompact (closure (Set.range γs)) := by + apply isCompact_closure_of_isTightMeasureSet + have hset : {((γ' : ProbabilityMeasure (A × B)) : Measure (A × B)) | + γ' ∈ Set.range γs} + = {((γs n : ProbabilityMeasure (A × B)) : Measure (A × B)) | n : ℕ} := by + ext m + constructor + · rintro ⟨γ', ⟨n, rfl⟩, rfl⟩ + exact ⟨n, rfl⟩ + · rintro ⟨n, rfl⟩ + exact ⟨γs n, ⟨n, rfl⟩, rfl⟩ + rwa [hset] + -- extract a convergent subsequence + obtain ⟨γ, -, φ, hφmono, hφt⟩ := + hcomp.tendsto_subseq (fun n => subset_closure (Set.mem_range_self n)) + -- identify the marginals of the limit by continuity of the pushforward + have hfst' : (γ : Measure (A × B)).map Prod.fst = (μ : Measure A) := by + refine (probabilityMeasure_map_eq_iff γ μ measurable_fst).mp ?_ + refine tendsto_nhds_unique ?_ (hμ.comp hφmono.tendsto_atTop) + have hc := MeasureTheory.ProbabilityMeasure.continuous_map + (Ω := A × B) (Ω' := A) continuous_fst + have := (hc.tendsto γ).comp hφt + refine (tendsto_congr fun k => ?_).mp this + exact (probabilityMeasure_map_eq_iff _ _ measurable_fst).mpr (hfst (φ k)) + have hsnd' : (γ : Measure (A × B)).map Prod.snd = (ν : Measure B) := by + refine (probabilityMeasure_map_eq_iff γ ν measurable_snd).mp ?_ + refine tendsto_nhds_unique ?_ (hν.comp hφmono.tendsto_atTop) + have hc := MeasureTheory.ProbabilityMeasure.continuous_map + (Ω := A × B) (Ω' := B) continuous_snd + have := (hc.tendsto γ).comp hφt + refine (tendsto_congr fun k => ?_).mp this + exact (probabilityMeasure_map_eq_iff _ _ measurable_snd).mpr (hsnd (φ k)) + exact ⟨γ, hfst', hsnd', φ, hφmono, hφt⟩ + +/-! ## U4: hit-sets of closed targets are closed -/ + +/-- **Closed hit-sets (E3-B).** For a closed set `C` of joint laws, the + set of marginal pairs whose couplings meet `C` is closed. -/ +theorem isClosed_couplings_hit + {C : Set (ProbabilityMeasure (A × B))} (hC : IsClosed C) : + IsClosed {p : ProbabilityMeasure A × ProbabilityMeasure B | + ∃ γ ∈ C, (γ : Measure (A × B)).map Prod.fst = (p.1 : Measure A) ∧ + (γ : Measure (A × B)).map Prod.snd = (p.2 : Measure B)} := by + refine isClosed_of_closure_subset fun p hp => ?_ + rw [mem_closure_iff_seq_limit] at hp + obtain ⟨ps, hmem, hlim⟩ := hp + choose γs hγC hγfst hγsnd using hmem + have hμ : Tendsto (fun n => (ps n).1) atTop (𝓝 p.1) := + ((continuous_fst.tendsto p).comp hlim) + have hν : Tendsto (fun n => (ps n).2) atTop (𝓝 p.2) := + ((continuous_snd.tendsto p).comp hlim) + obtain ⟨γ, hf, hs, φ, -, hφt⟩ := + exists_tendsto_subseq_couplings hμ hν hγfst hγsnd + exact ⟨γ, hC.mem_of_tendsto hφt (Eventually.of_forall fun k => hγC (φ k)), + hf, hs⟩ + +/-! ## U5: opens are Fσ in metrizable spaces; open hit-sets are Borel -/ + +/-- In a (pseudo)metrizable space every open set is a countable union of + closed sets (complement of the Gδ representation of its complement; + Mathlib's `IsOpen.exists_iUnion_isClosed` is the pseudo-emetric + version — this one works directly at the topology level). -/ +theorem IsOpen.exists_iUnion_isClosed_of_pseudoMetrizable + {X : Type*} [TopologicalSpace X] + [TopologicalSpace.PseudoMetrizableSpace X] {U : Set X} (hU : IsOpen U) : + ∃ C : ℕ → Set X, (∀ n, IsClosed (C n)) ∧ U = ⋃ n, C n := by + obtain ⟨T, hTopen, hTcount, hTeq⟩ := hU.isClosed_compl.isGδ + rcases T.eq_empty_or_nonempty with rfl | hTne + · -- Uᶜ = ⋂₀ ∅ = univ, so U = ∅ + refine ⟨fun _ => ∅, fun _ => isClosed_empty, ?_⟩ + have : U = ∅ := by + have h1 : Uᶜ = univ := by rw [hTeq, Set.sInter_empty] + simpa [Set.compl_univ] using congrArg compl h1 + simp [this] + · obtain ⟨f, rfl⟩ := hTcount.exists_eq_range hTne + refine ⟨fun n => (f n)ᶜ, fun n => + (hTopen (f n) (Set.mem_range_self n)).isClosed_compl, ?_⟩ + have h1 : Uᶜ = ⋂ n, f n := by rw [hTeq, Set.sInter_range] + calc U = Uᶜᶜ := (compl_compl U).symm + _ = (⋂ n, f n)ᶜ := by rw [h1] + _ = ⋃ n, (f n)ᶜ := by rw [Set.compl_iInter] + +/-- **Borel hit-sets (E3-C).** For an open set `U` of joint laws, the set + of marginal pairs whose couplings meet `U` is Borel — with respect to + Borel σ-algebras of the weak topology on the factors (σ-algebra + polymorphic via the `BorelSpace` constraints; NOT Mathlib's + Giry-subtype σ-algebra). Decompose `U` into countably many closed + sets and take the union of the closed hit-sets. -/ +theorem measurableSet_couplings_hit + {mPA : MeasurableSpace (ProbabilityMeasure A)} + [BorelSpace (ProbabilityMeasure A)] + {mPB : MeasurableSpace (ProbabilityMeasure B)} + [BorelSpace (ProbabilityMeasure B)] + {U : Set (ProbabilityMeasure (A × B))} (hU : IsOpen U) : + MeasurableSet {p : ProbabilityMeasure A × ProbabilityMeasure B | + ∃ γ ∈ U, (γ : Measure (A × B)).map Prod.fst = (p.1 : Measure A) ∧ + (γ : Measure (A × B)).map Prod.snd = (p.2 : Measure B)} := by + obtain ⟨C, hCclosed, rfl⟩ := hU.exists_iUnion_isClosed_of_pseudoMetrizable + have hsplit : {p : ProbabilityMeasure A × ProbabilityMeasure B | + ∃ γ ∈ ⋃ n, C n, (γ : Measure (A × B)).map Prod.fst = (p.1 : Measure A) ∧ + (γ : Measure (A × B)).map Prod.snd = (p.2 : Measure B)} + = ⋃ n, {p : ProbabilityMeasure A × ProbabilityMeasure B | + ∃ γ ∈ C n, (γ : Measure (A × B)).map Prod.fst = (p.1 : Measure A) ∧ + (γ : Measure (A × B)).map Prod.snd = (p.2 : Measure B)} := by + ext p + simp only [Set.mem_ofPred_eq, Set.mem_iUnion] + constructor + · rintro ⟨γ, ⟨n, hγn⟩, hmarg⟩ + exact ⟨n, γ, hγn, hmarg⟩ + · rintro ⟨n, γ, hγn, hmarg⟩ + exact ⟨γ, ⟨n, hγn⟩, hmarg⟩ + rw [hsplit] + exact MeasurableSet.iUnion fun n => + (isClosed_couplings_hit (hCclosed n)).measurableSet + +end diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/EpsOptimalSelection.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/EpsOptimalSelection.lean new file mode 100644 index 0000000000..ef11864f1d --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/EpsOptimalSelection.lean @@ -0,0 +1,243 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + ε-Optimal Analytically Measurable Selection + + **Bertsekas–Shreve, Proposition 7.50 (ε-optimal half), in ℝ≥0∞.** + For an analytic set Γ ⊆ H × E with nonempty fibers over a Polish space + H into a Polish space E, and a lower semianalytic F : H × E → ℝ≥0∞, + every ε > 0 admits a σ(Σ¹₁)-measurable selector φ with (h, φ h) ∈ Γ and + F (h, φ h) ≤ inf-fiber F h + ε for every h. + + Design (BLUEPRINT.md §4, docs/design_phase4.md): Borel/analytic + ε-optimal selection genuinely fails (Blackwell), so the σ(Σ¹₁) budget + is spent on a countable *band partition* of the domain steered by the + VALUE of the fiber infimum g — both sublevels (analytic) and + superlevels (co-analytic) of the lower semianalytic g lie in σ(Σ¹₁) — + while Jankov–von Neumann uniformization is only ever applied to the + analytic sets Γ ∩ {F < q} at constant thresholds q, never to a set + comparing F with g. The countably many selectors are glued with + Mathlib's `Measurable.find` instantiated at `analyticMeasurableSpace`. +-/ +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral +import Mathlib.MeasureTheory.MeasurableSpace.Constructions + +open MeasureTheory Set ENNReal +open scoped Classical + +noncomputable section + +variable {H E : Type*} [TopologicalSpace H] [TopologicalSpace E] + +/-! ## Fiber infimum approximation -/ + +omit [TopologicalSpace H] [TopologicalSpace E] in +/-- Any value strictly above the fiber infimum is beaten by some element + of the fiber. -/ +theorem iInf_fiber_lt {Γ : Set (H × E)} {F : H × E → ℝ≥0∞} {h : H} + {q : ℝ≥0∞} (hlt : (⨅ (e : E) (_ : (h, e) ∈ Γ), F (h, e)) < q) : + ∃ e : E, (h, e) ∈ Γ ∧ F (h, e) < q := by + rw [iInf_lt_iff] at hlt + obtain ⟨e, he⟩ := hlt + rw [iInf_lt_iff] at he + obtain ⟨hm, hfc⟩ := he + exact ⟨e, hm, hfc⟩ + +/-! ## The selector family: fallback and level selectors -/ + +/-- A σ(Σ¹₁)-measurable everywhere-feasible selector exists as soon as the + graph is analytic, nonempty, and has nonempty fibers + (Jankov–von Neumann). -/ +theorem exists_fallback_selector [PolishSpace H] [PolishSpace E] + {Γ : Set (H × E)} (hΓ : AnalyticSet Γ) (hΓne : Γ.Nonempty) + (hfib : ∀ h : H, ∃ e : E, (h, e) ∈ Γ) : + ∃ φ : H → E, AnalyticallyMeasurable φ ∧ ∀ h, (h, φ h) ∈ Γ := by + obtain ⟨φ, hφ, hsel⟩ := jankov_von_neumann Γ hΓ hΓne + refine ⟨φ, hφ, fun h => ?_⟩ + obtain ⟨e, he⟩ := hfib h + exact hsel h ⟨(h, e), he, rfl⟩ + +/-- Level selector at a constant threshold `q`: a σ(Σ¹₁)-measurable map + that, wherever the fiber meets the strict sublevel set `{F < q}`, + selects a feasible element below `q`; elsewhere it falls back to the + given selector `φ'`. The selection set `Γ ∩ {F < q}` is analytic, so + Jankov–von Neumann applies — this is the only place selection ever + happens, and the threshold is constant by design. -/ +theorem exists_level_selector [PolishSpace H] [PolishSpace E] + {Γ : Set (H × E)} {F : H × E → ℝ≥0∞} + (hΓ : AnalyticSet Γ) (hF : IsLowerSemianalytic (X := H × E) F) + {φ' : H → E} (hφ' : AnalyticallyMeasurable φ') (q : ℝ≥0∞) : + ∃ χ : H → E, AnalyticallyMeasurable χ ∧ + ∀ h : H, (∃ e, (h, e) ∈ Γ ∧ F (h, e) < q) → + (h, χ h) ∈ Γ ∧ F (h, χ h) < q := by + have hA : AnalyticSet (Γ ∩ {p | F p < q}) := hΓ.inter' (hF q) + by_cases hAne : (Γ ∩ {p | F p < q}).Nonempty + · obtain ⟨χ, hχ, hsel⟩ := jankov_von_neumann _ hA hAne + refine ⟨χ, hχ, fun h ⟨e, heΓ, heF⟩ => ?_⟩ + exact hsel h ⟨(h, e), ⟨heΓ, heF⟩, rfl⟩ + · exact ⟨φ', hφ', fun h ⟨e, heΓ, heF⟩ => absurd ⟨(h, e), heΓ, heF⟩ hAne⟩ + +/-! ## The glue lemma: countable σ(Σ¹₁)-piecewise gluing -/ + +/-- **Countable σ(Σ¹₁)-piecewise gluing.** Steering among countably many + analytically measurable maps through the least index satisfying + σ(Σ¹₁)-measurable predicates yields an analytically measurable map: + Mathlib's `Measurable.find` instantiated at + `analyticMeasurableSpace`. -/ +theorem AnalyticallyMeasurable.find + {ψ : ℕ → H → E} (hψ : ∀ m, AnalyticallyMeasurable (ψ m)) + {p : ℕ → H → Prop} [∀ m, DecidablePred (p m)] + (hp : ∀ m, @MeasurableSet H (analyticMeasurableSpace H) {h | p m h}) + (hex : ∀ h, ∃ m, p m h) : + AnalyticallyMeasurable (fun h => ψ (Nat.find (hex h)) h) := by + letI : MeasurableSpace H := analyticMeasurableSpace H + letI : MeasurableSpace E := borel E + exact Measurable.find hψ hp hex + +/-! ## Band bookkeeping in ℝ≥0∞ -/ + +namespace EpsOptimalSelection + +/-- The band predicate for the `ε'`-grid on `ℝ≥0∞`: index `0` is the + infinite band `{v = ∞}`, index `m + 1` the sublevel band + `{v < (m + 1) · ε'}`. Steered through `Nat.find`, the effective bands + are `{m·ε' ≤ v < (m + 1)·ε'}` plus the infinite band. -/ +def bandPred (ε' : ℝ≥0∞) : ℕ → ℝ≥0∞ → Prop + | 0, v => v = ∞ + | m + 1, v => v < ((m + 1 : ℕ) : ℝ≥0∞) * ε' + +/-- Every value lies in some band (Archimedean property of the grid). -/ +theorem exists_band {ε' : ℝ≥0∞} (hε'0 : 0 < ε') (hε'top : ε' ≠ ∞) + (v : ℝ≥0∞) : ∃ m : ℕ, bandPred ε' m v := by + by_cases hv : v = ∞ + · exact ⟨0, hv⟩ + · obtain ⟨n, hn⟩ := + ENNReal.exists_nat_gt (ENNReal.div_lt_top hv hε'0.ne').ne + have hvn : v < (n : ℝ≥0∞) * ε' := + (ENNReal.div_lt_iff (Or.inl hε'0.ne') (Or.inl hε'top)).mp hn + rcases n with _ | m + · exact absurd hvn (by simp) + · exact ⟨m + 1, hvn⟩ + +/-- Failure of all band predicates below `m + 1` bounds the value from + below by the `m`-th band's lower edge. -/ +theorem band_lower_bound {ε' v : ℝ≥0∞} {m : ℕ} + (hmin : ∀ j, j < m + 1 → ¬ bandPred ε' j v) : + ((m : ℕ) : ℝ≥0∞) * ε' ≤ v := by + cases m with + | zero => simp + | succ j => exact not_lt.mp (hmin (j + 1) (by omega)) + +end EpsOptimalSelection + +/-! ## The main theorem: BS Proposition 7.50, ε-optimal half -/ + +open EpsOptimalSelection in +/-- **ε-optimal analytically measurable selection** (Bertsekas–Shreve, + Proposition 7.50 analogue, ε-optimal half, in `ℝ≥0∞`). If `Γ ⊆ H × E` + is analytic with nonempty fibers (H, E Polish) and `F` is lower + semianalytic on the product, then for every `ε > 0` there is a + σ(Σ¹₁)-measurable selector that is everywhere feasible and everywhere + ε-optimal for the fiber infimum. + + Proof: normalize `ε' := min ε 1`; partition the domain into the bands + `{g = ∞}` and `{m·ε' ≤ g < (m+1)·ε'}` of the fiber infimum `g` (lower + semianalytic by BS 7.47, so all bands are σ(Σ¹₁)); on band `m` select + from the analytic set `Γ ∩ {F < (m+1)·ε'}` via Jankov–von Neumann; on + the infinite band any feasible selection is ε-optimal; glue with + `AnalyticallyMeasurable.find`. -/ +theorem exists_eps_optimal_selector [PolishSpace H] [PolishSpace E] + {Γ : Set (H × E)} {F : H × E → ℝ≥0∞} + (hΓ : AnalyticSet Γ) (hF : IsLowerSemianalytic (X := H × E) F) + (hfib : ∀ h : H, ∃ e : E, (h, e) ∈ Γ) + {ε : ℝ≥0∞} (hε : 0 < ε) : + ∃ φ : H → E, AnalyticallyMeasurable φ ∧ (∀ h, (h, φ h) ∈ Γ) ∧ + ∀ h, F (h, φ h) ≤ (⨅ (e : E) (_ : (h, e) ∈ Γ), F (h, e)) + ε := by + rcases isEmpty_or_nonempty H with hH | hH + · -- degenerate domain: everything is vacuous + haveI := hH + letI : MeasurableSpace H := analyticMeasurableSpace H + letI : MeasurableSpace E := borel E + exact ⟨fun h => isEmptyElim h, measurable_of_empty _, + fun h => isEmptyElim h, fun h => isEmptyElim h⟩ + · obtain ⟨h₀⟩ := hH + have hΓne : Γ.Nonempty := ⟨(h₀, (hfib h₀).choose), (hfib h₀).choose_spec⟩ + -- Step 1: normalized tolerance ε' = min ε 1 (positive, finite, ≤ ε) + set ε' : ℝ≥0∞ := min ε 1 with hε'def + have hε'0 : 0 < ε' := lt_min hε zero_lt_one + have hε'top : ε' ≠ ∞ := ((min_le_right ε 1).trans_lt one_lt_top).ne + have hε'ε : ε' ≤ ε := min_le_left ε 1 + -- Step 2: the fiber infimum is lower semianalytic (BS 7.47) + set g : H → ℝ≥0∞ := fun h => ⨅ (e : E) (_ : (h, e) ∈ Γ), F (h, e) + with hgdef + have hg : IsLowerSemianalytic g := IsLowerSemianalytic.iInf_fiber hΓ hF + -- Step 3: the selector family — fallback plus one selector per level + obtain ⟨φ₀, hφ₀meas, hφ₀Γ⟩ := exists_fallback_selector hΓ hΓne hfib + have hlevel : ∀ m : ℕ, ∃ χ : H → E, AnalyticallyMeasurable χ ∧ + ∀ h : H, (∃ e, (h, e) ∈ Γ ∧ F (h, e) < (m : ℝ≥0∞) * ε') → + (h, χ h) ∈ Γ ∧ F (h, χ h) < (m : ℝ≥0∞) * ε' := + fun m => exists_level_selector hΓ hF hφ₀meas _ + choose χ hχmeas hχsel using hlevel + set ψ : ℕ → H → E := fun m => match m with + | 0 => φ₀ + | m + 1 => χ (m + 1) with hψdef + have hψmeas : ∀ m, AnalyticallyMeasurable (ψ m) := by + intro m + cases m with + | zero => exact hφ₀meas + | succ m => exact hχmeas (m + 1) + -- Step 4: the band predicate is σ(Σ¹₁)-measurable + have hp : ∀ m, @MeasurableSet H (analyticMeasurableSpace H) + {h | bandPred ε' m (g h)} := by + intro m + cases m with + | zero => + have hset : {h : H | bandPred ε' 0 (g h)} = {h : H | g h < ⊤}ᶜ := by + ext h + show g h = ∞ ↔ ¬ g h < ⊤ + simp [lt_top_iff_ne_top] + rw [hset] + exact (hg ⊤).compl_mem_analyticMeasurableSpace + | succ m => + have hset : {h : H | bandPred ε' (m + 1) (g h)} + = {h : H | g h < ((m + 1 : ℕ) : ℝ≥0∞) * ε'} := rfl + rw [hset] + exact (hg _).mem_analyticMeasurableSpace + have hex : ∀ h, ∃ m, bandPred ε' m (g h) := fun h => + exists_band hε'0 hε'top (g h) + -- Steps 5–6: glue with Nat.find; correctness by cases on the band + have hcorrect : ∀ h : H, (h, ψ (Nat.find (hex h)) h) ∈ Γ ∧ + F (h, ψ (Nat.find (hex h)) h) ≤ g h + ε' := by + intro h + rcases hfind : Nat.find (hex h) with _ | m + · -- the infinite band: any feasible selection is trivially optimal + have hspec : bandPred ε' 0 (g h) := by + have hs := Nat.find_spec (hex h) + rwa [hfind] at hs + have hginf : g h = ∞ := hspec + exact ⟨hφ₀Γ h, by simp [hginf]⟩ + · -- band m: select below the upper edge, bound below by the lower edge + have hspec : bandPred ε' (m + 1) (g h) := by + have hs := Nat.find_spec (hex h) + rwa [hfind] at hs + have hlt : g h < ((m + 1 : ℕ) : ℝ≥0∞) * ε' := hspec + obtain ⟨e, heΓ, heF⟩ := iInf_fiber_lt hlt + have hsel := hχsel (m + 1) h ⟨e, heΓ, heF⟩ + have hlow : ((m : ℕ) : ℝ≥0∞) * ε' ≤ g h := + band_lower_bound fun j hj => + Nat.find_min (hex h) (by rw [hfind]; exact hj) + refine ⟨hsel.1, ?_⟩ + calc F (h, χ (m + 1) h) + ≤ ((m + 1 : ℕ) : ℝ≥0∞) * ε' := le_of_lt hsel.2 + _ = ((m : ℕ) : ℝ≥0∞) * ε' + ε' := by push_cast; ring + _ ≤ g h + ε' := add_le_add hlow le_rfl + exact ⟨fun h => ψ (Nat.find (hex h)) h, + AnalyticallyMeasurable.find hψmeas hp hex, + fun h => (hcorrect h).1, + fun h => le_trans (hcorrect h).2 (add_le_add le_rfl hε'ε)⟩ + +end diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/JankovVonNeumann.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/JankovVonNeumann.lean new file mode 100644 index 0000000000..59e9e94e40 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/JankovVonNeumann.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + ε-optimal Selection — proved by pointwise choice + + This file provides everything UpperBound.lean needs, with ZERO sorry. + + Note: the original axiom claimed `Measurable sel`, but the statement + has only [MeasurableSpace α] — no topology or Polish structure — making + measurability unprovable. Since `Measurable sel` is discarded at the + call site (UpperBound.lean uses `_`), we drop it and prove the rest. +-/ +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet +import Mathlib.MeasureTheory.Measure.MeasureSpace +import Mathlib.MeasureTheory.Measure.Prod + +open MeasureTheory Set ENNReal + +noncomputable section + +/-- Pointwise ε-optimal element in a nonempty set. -/ +private theorem eps_optimal_element' + {α : Type*} (S : Set α) (h_ne : S.Nonempty) + (f : α → ENNReal) (ε : ENNReal) (hε : 0 < ε) : + ∃ a ∈ S, f a ≤ (⨅ (x : α) (_ : x ∈ S), f x) + ε := by + by_contra h + simp only [not_exists, not_and, not_le] at h + obtain ⟨a, ha⟩ := h_ne + have hlt := h a ha + have : (⨅ (x : α) (_ : x ∈ S), f x) + ε ≤ ⨅ (x : α) (_ : x ∈ S), f x := + le_iInf fun x => le_iInf fun hx => le_of_lt (h x hx) + by_cases htop : (⨅ (x : α) (_ : x ∈ S), f x) = ⊤ + · simp [htop] at hlt + · exact absurd this (not_le.mpr (ENNReal.lt_add_right htop hε.ne')) + +/-- ε-optimal selection: for each a, choose m ∈ S(a) with f(a,m) ≤ inf + ε. -/ +theorem eps_optimal_selection + {α β : Type*} [MeasurableSpace α] [MeasurableSpace β] + (S : α → Set (Measure β)) + (h_ne : ∀ a, (S a).Nonempty) + (f : α → Measure β → ENNReal) + (ε : ENNReal) (hε : 0 < ε) : + ∃ (sel : α → Measure β), + (∀ a, sel a ∈ S a) ∧ + (∀ a, f a (sel a) ≤ (⨅ (m : Measure β) (_ : m ∈ S a), f a m) + ε) := by + have key : ∀ a, ∃ m ∈ S a, f a m ≤ (⨅ (m : Measure β) (_ : m ∈ S a), f a m) + ε := + fun a => eps_optimal_element' (S a) (h_ne a) (f a) ε hε + choose sel hsel_mem hsel_opt using key + exact ⟨sel, hsel_mem, hsel_opt⟩ + +end diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/KernelIntegral.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/KernelIntegral.lean new file mode 100644 index 0000000000..890fd41e5c --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/KernelIntegral.lean @@ -0,0 +1,473 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Integration of Lower Semianalytic Functions along Borel Kernels + + **Bertsekas–Shreve, Proposition 7.48** — now a THEOREM (formerly an axiom): + if f : X × Y → ℝ≥0∞ is lower semianalytic and κ is a Borel-measurable + stochastic kernel, then x ↦ ∫⁻ y, f (x, y) ∂(κ x) is lower semianalytic. + + Proof architecture (BS pp. 180–181): + 1. Epigraph trick: E_n = {(x, y, b) | f (x,y) ≤ ofReal b, b ∈ [0, n]} is + analytic in X × (Y × ℝ). + 2. Fubini for null-measurable sets (via universal measurability of + analytic sets, `AnalyticSet.nullMeasurableSet`): + (κ x ⊗ λ)((E_n)_x) = n − ∫⁻ min (f (x,·)) n dκ x. + 3. Parametrized Choquet capacitability (`AnalyticSet.kernel_section_gt`): + x ↦ (κ x ⊗ λ)((E_n)_x) is upper semianalytic. + 4. Truncation limit n → ∞ and countable rational bookkeeping. +-/ +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LowerSemianalytic +import Mathlib.MeasureTheory.Measure.Prod +import Mathlib.MeasureTheory.Measure.Lebesgue.Basic +import Mathlib.Probability.Kernel.Composition.Prod +import Mathlib.MeasureTheory.Integral.Lebesgue.Sub + +open Set Topology MeasureTheory ProbabilityTheory Filter +open scoped Classical ENNReal + +noncomputable section + +/-! ## Binary closure properties of analytic sets -/ + +theorem MeasureTheory.AnalyticSet.inter' + {W : Type*} [TopologicalSpace W] [T2Space W] + {S T : Set W} (hS : AnalyticSet S) (hT : AnalyticSet T) : + AnalyticSet (S ∩ T) := by + have h : S ∩ T = ⋂ b : Bool, (bif b then S else T) := by + ext w; simp [Bool.forall_bool, and_comm] + rw [h] + exact AnalyticSet.iInter fun b => by cases b <;> simpa + +theorem MeasureTheory.AnalyticSet.union' + {W : Type*} [TopologicalSpace W] + {S T : Set W} (hS : AnalyticSet S) (hT : AnalyticSet T) : + AnalyticSet (S ∪ T) := by + have h : S ∪ T = ⋃ b : Bool, (bif b then S else T) := by + ext w; simp [Bool.exists_bool, or_comm] + rw [h] + exact AnalyticSet.iUnion fun b => by cases b <;> simpa + +/-- Preimages of analytic sets under continuous maps from Polish spaces + are analytic (graph trick: the graph relation is closed, hence analytic, + and the preimage is its first-coordinate projection). -/ +theorem MeasureTheory.AnalyticSet.preimage_of_continuous + {W V : Type*} [TopologicalSpace W] [PolishSpace W] + [TopologicalSpace V] [T2Space V] + {S : Set V} (hS : AnalyticSet S) {h : W → V} (hh : Continuous h) : + AnalyticSet (h ⁻¹' S) := by + rw [AnalyticSet] at hS + rcases hS with rfl | ⟨g, hg_cont, hg_range⟩ + · rw [preimage_empty]; exact analyticSet_empty + have hpre : h ⁻¹' range g = Prod.fst '' {p : W × (ℕ → ℕ) | g p.2 = h p.1} := by + ext w + simp only [mem_preimage, mem_range, mem_image, Prod.exists, mem_ofPred_eq] + constructor + · rintro ⟨σ, hσ⟩; exact ⟨w, σ, hσ, rfl⟩ + · rintro ⟨w', σ, hgσ, rfl⟩; exact ⟨σ, hgσ⟩ + rw [← hg_range, hpre] + refine AnalyticSet.image_of_continuous ?_ continuous_fst + exact (isClosed_eq (hg_cont.comp continuous_snd) + (hh.comp continuous_fst)).analyticSet + +/-! ## ENNReal bookkeeping -/ + +theorem ennreal_le_iff_forall_lt_add_inv {a q : ℝ≥0∞} (hq : q ≠ ∞) : + a ≤ q ↔ ∀ k : ℕ, a < q + ((k : ℝ≥0∞) + 1)⁻¹ := by + constructor + · intro h k + exact lt_of_le_of_lt h + (ENNReal.lt_add_right hq (ENNReal.inv_ne_zero.mpr (by finiteness))) + · intro h + by_contra hlt + rw [not_le] at hlt + obtain ⟨ε, hε0, hεa⟩ := ENNReal.lt_iff_exists_add_pos_lt.mp hlt + obtain ⟨k, hk⟩ := ENNReal.exists_inv_nat_lt + (show (ε : ℝ≥0∞) ≠ 0 from by exact_mod_cast hε0.ne') + have h1 : ((k : ℝ≥0∞) + 1)⁻¹ ≤ (ε : ℝ≥0∞) := + le_of_lt (lt_of_le_of_lt (ENNReal.inv_le_inv.mpr le_self_add) hk) + exact absurd (h k) (not_lt.mpr (le_trans (by gcongr) hεa.le)) + +theorem ennreal_iSup_min_natCast (a : ℝ≥0∞) : ⨆ n : ℕ, min a (n : ℝ≥0∞) = a := by + refine le_antisymm (iSup_le fun n => min_le_left _ _) ?_ + rcases eq_or_ne a ∞ with rfl | ha + · have hmin : ∀ n : ℕ, min (∞ : ℝ≥0∞) (n : ℝ≥0∞) = (n : ℝ≥0∞) := + fun n => min_eq_right le_top + calc (∞ : ℝ≥0∞) = ⨆ n : ℕ, (n : ℝ≥0∞) := ENNReal.iSup_natCast.symm + _ ≤ ⨆ n : ℕ, min (∞ : ℝ≥0∞) (n : ℝ≥0∞) := + iSup_mono fun n => (hmin n).symm.le + · obtain ⟨n, hn⟩ := ENNReal.exists_nat_gt ha + exact le_iSup_of_le n (by simp [min_eq_left hn.le]) + +/-! ## AEMeasurability from analytic sublevel sets + +Combines the universal measurability of analytic sets (Part VI of +Capacitability.lean) with the Borel generation of `ℝ≥0∞` by rays. -/ + +theorem aemeasurable_of_analytic_sublevels + {V : Type*} [TopologicalSpace V] [PolishSpace V] + [MeasurableSpace V] [BorelSpace V] {g : V → ℝ≥0∞} + (hg : ∀ c, AnalyticSet {v | g v < c}) + (μ : Measure V) [IsFiniteMeasure μ] : + AEMeasurable g μ := by + have hnm : NullMeasurable g μ := by + intro s hs + rw [BorelSpace.measurable_eq (α := ℝ≥0∞), + borel_eq_generateFrom_Iio ℝ≥0∞] at hs + induction hs with + | basic u hu => + obtain ⟨c, rfl⟩ := hu + have hpre : g ⁻¹' Iio c = {v | g v < c} := rfl + rw [hpre] + exact (hg c).nullMeasurableSet μ + | empty => + rw [preimage_empty] + exact MeasurableSet.empty.nullMeasurableSet + | compl u _ ih => + rw [preimage_compl] + exact ih.compl + | iUnion u _ ih => + rw [preimage_iUnion] + exact NullMeasurableSet.iUnion ih + exact hnm.aemeasurable + +/-! ## Fubini for analytic sets (null-measurable version) -/ + +/-- For an analytic `S` in a product of Polish spaces and finite Borel + measures, the product (outer) measure of `S` is the integral of the + (outer) measures of its sections. Uses universal measurability. -/ +theorem MeasureTheory.AnalyticSet.prod_apply + {V W : Type*} [TopologicalSpace V] [PolishSpace V] + [MeasurableSpace V] [BorelSpace V] + [TopologicalSpace W] [PolishSpace W] + [MeasurableSpace W] [BorelSpace W] + {S : Set (V × W)} (hS : AnalyticSet S) + (μ : Measure V) [IsFiniteMeasure μ] + (ν : Measure W) [IsFiniteMeasure ν] : + μ.prod ν S = ∫⁻ v, ν (Prod.mk v ⁻¹' S) ∂μ := by + obtain ⟨B, hBmeas, haeq⟩ := hS.nullMeasurableSet (μ.prod ν) + have h1 : μ.prod ν S = μ.prod ν B := measure_congr haeq + have hSB : μ.prod ν (S \ B) = 0 := ae_le_set.mp haeq.le + have hBS : μ.prod ν (B \ S) = 0 := ae_le_set.mp haeq.symm.le + -- measurable hulls of the two null differences + set N₁ := toMeasurable (μ.prod ν) (S \ B) with hN₁ + set N₂ := toMeasurable (μ.prod ν) (B \ S) with hN₂ + have hN₁meas : MeasurableSet N₁ := measurableSet_toMeasurable _ _ + have hN₂meas : MeasurableSet N₂ := measurableSet_toMeasurable _ _ + have hN₁null : μ.prod ν N₁ = 0 := by rw [hN₁, measure_toMeasurable]; exact hSB + have hN₂null : μ.prod ν N₂ = 0 := by rw [hN₂, measure_toMeasurable]; exact hBS + -- a.e. sections of the hulls are ν-null + have hsec : ∀ (N : Set (V × W)), MeasurableSet N → μ.prod ν N = 0 → + ∀ᵐ v ∂μ, ν (Prod.mk v ⁻¹' N) = 0 := by + intro N hNmeas hNnull + have hint := (Measure.prod_apply hNmeas).symm.trans hNnull + exact (lintegral_eq_zero_iff (measurable_measure_prodMk_left hNmeas)).mp hint + have hae : (fun v => ν (Prod.mk v ⁻¹' S)) =ᵐ[μ] fun v => ν (Prod.mk v ⁻¹' B) := by + filter_upwards [hsec N₁ hN₁meas hN₁null, hsec N₂ hN₂meas hN₂null] + with v hv1 hv2 + have hsub1 : Prod.mk v ⁻¹' S ⊆ (Prod.mk v ⁻¹' B) ∪ (Prod.mk v ⁻¹' N₁) := by + intro w hw + by_cases hwB : w ∈ Prod.mk v ⁻¹' B + · exact Or.inl hwB + · exact Or.inr (subset_toMeasurable _ _ ⟨hw, hwB⟩) + have hsub2 : Prod.mk v ⁻¹' B ⊆ (Prod.mk v ⁻¹' S) ∪ (Prod.mk v ⁻¹' N₂) := by + intro w hw + by_cases hwS : w ∈ Prod.mk v ⁻¹' S + · exact Or.inl hwS + · exact Or.inr (subset_toMeasurable _ _ ⟨hw, hwS⟩) + refine le_antisymm ?_ ?_ + · calc ν (Prod.mk v ⁻¹' S) + ≤ ν ((Prod.mk v ⁻¹' B) ∪ (Prod.mk v ⁻¹' N₁)) := measure_mono hsub1 + _ ≤ ν (Prod.mk v ⁻¹' B) + ν (Prod.mk v ⁻¹' N₁) := measure_union_le _ _ + _ = ν (Prod.mk v ⁻¹' B) := by rw [hv1, add_zero] + · calc ν (Prod.mk v ⁻¹' B) + ≤ ν ((Prod.mk v ⁻¹' S) ∪ (Prod.mk v ⁻¹' N₂)) := measure_mono hsub2 + _ ≤ ν (Prod.mk v ⁻¹' S) + ν (Prod.mk v ⁻¹' N₂) := measure_union_le _ _ + _ = ν (Prod.mk v ⁻¹' S) := by rw [hv2, add_zero] + rw [h1, Measure.prod_apply hBmeas, lintegral_congr_ae hae.symm] + +/-! ## The Lebesgue section computation -/ + +theorem volume_restrict_epigraph_section (t : ℝ≥0∞) (n : ℕ) : + volume.restrict (Icc (0 : ℝ) n) {b : ℝ | t ≤ ENNReal.ofReal b} + = (n : ℝ≥0∞) - min t (n : ℝ≥0∞) := by + rw [Measure.restrict_apply' measurableSet_Icc] + rcases eq_or_ne t ∞ with rfl | ht + · have hempty : {b : ℝ | (∞ : ℝ≥0∞) ≤ ENNReal.ofReal b} ∩ Icc (0 : ℝ) n = ∅ := by + ext b + simp [top_le_iff, ENNReal.ofReal_ne_top] + rw [hempty] + simp + · have hinter : {b : ℝ | t ≤ ENNReal.ofReal b} ∩ Icc (0 : ℝ) n + = Icc t.toReal n := by + ext b + simp only [mem_inter_iff, mem_ofPred_eq, mem_Icc] + constructor + · rintro ⟨h1, h2, h3⟩ + exact ⟨(ENNReal.le_ofReal_iff_toReal_le ht h2).mp h1, h3⟩ + · rintro ⟨h1, h2⟩ + have hb0 : (0 : ℝ) ≤ b := le_trans ENNReal.toReal_nonneg h1 + exact ⟨(ENNReal.le_ofReal_iff_toReal_le ht hb0).mpr h1, hb0, h2⟩ + rw [hinter, Real.volume_Icc] + rcases le_or_gt t (n : ℝ≥0∞) with htn | htn + · rw [min_eq_left htn, ← ENNReal.ofReal_natCast n, + ← ENNReal.ofReal_toReal ht, + ← ENNReal.ofReal_sub _ ENNReal.toReal_nonneg, + ENNReal.ofReal_toReal ht] + · have hnt : (n : ℝ) < t.toReal := by + rw [← ENNReal.toReal_natCast n] + exact (ENNReal.toReal_lt_toReal (by finiteness) ht).mpr htn + rw [min_eq_right htn.le, tsub_self, + ENNReal.ofReal_eq_zero.mpr (by linarith)] + +/-! ## The analytic epigraph -/ + +section Epigraph + +variable {X Y : Type*} + [TopologicalSpace X] [PolishSpace X] [MeasurableSpace X] [BorelSpace X] + [TopologicalSpace Y] [PolishSpace Y] [MeasurableSpace Y] [BorelSpace Y] + +omit [MeasurableSpace X] [BorelSpace X] [MeasurableSpace Y] [BorelSpace Y] in +/-- Non-strict sublevel sets at finite levels are analytic. -/ +theorem IsLowerSemianalytic.analyticSet_le + {f : X × Y → ℝ≥0∞} (hf : IsLowerSemianalytic (X := X × Y) f) + {q : ℝ≥0∞} (hq : q ≠ ∞) : + AnalyticSet {p : X × Y | f p ≤ q} := by + have heq : {p : X × Y | f p ≤ q} + = ⋂ k : ℕ, {p | f p < q + ((k : ℝ≥0∞) + 1)⁻¹} := by + ext p + simp only [mem_ofPred_eq, mem_iInter] + exact ennreal_le_iff_forall_lt_add_inv hq + rw [heq] + exact AnalyticSet.iInter fun k => hf _ + +omit [MeasurableSpace X] [BorelSpace X] [MeasurableSpace Y] [BorelSpace Y] in +/-- The epigraph condition in a real parameter is analytic. -/ +theorem IsLowerSemianalytic.analyticSet_epigraph + {f : X × Y → ℝ≥0∞} (hf : IsLowerSemianalytic (X := X × Y) f) : + AnalyticSet {pb : (X × Y) × ℝ | f pb.1 ≤ ENNReal.ofReal pb.2} := by + have heq : {pb : (X × Y) × ℝ | f pb.1 ≤ ENNReal.ofReal pb.2} + = ⋂ q : ℚ, + ({pb : (X × Y) × ℝ | + ENNReal.ofReal pb.2 < (Real.toNNReal q : ℝ≥0∞)}ᶜ + ∪ (Prod.fst ⁻¹' {p : X × Y | f p ≤ (Real.toNNReal q : ℝ≥0∞)})) := by + ext ⟨p, b⟩ + simp only [mem_iInter, mem_union, mem_compl_iff, mem_ofPred_eq, + mem_preimage, not_lt] + constructor + · intro h q + rcases le_or_gt (Real.toNNReal q : ℝ≥0∞) (ENNReal.ofReal b) with hle | hlt + · exact Or.inl hle + · exact Or.inr (h.trans hlt.le) + · intro h + by_contra hcon + rw [not_le] at hcon + obtain ⟨q, _, h1, h2⟩ := ENNReal.lt_iff_exists_rat_btwn.mp hcon + rcases h q with h3 | h3 + · exact absurd h1 (not_lt.mpr h3) + · exact absurd h2 (not_lt.mpr h3) + rw [heq] + refine AnalyticSet.iInter fun q => ?_ + refine AnalyticSet.union' ?_ ?_ + · refine IsClosed.analyticSet ?_ + exact (isOpen_Iio.preimage + (ENNReal.continuous_ofReal.comp continuous_snd)).isClosed_compl + · exact (hf.analyticSet_le (by finiteness)).preimage_of_continuous + continuous_fst + +/-! ## The main theorem: BS Proposition 7.48 -/ + +/-- **Bertsekas–Shreve, Proposition 7.48** (formerly an axiom, now proved): + integration of a lower semianalytic function along a Borel-measurable + stochastic kernel is lower semianalytic. -/ +theorem lintegral_lowerSemianalytic + {f : X × Y → ℝ≥0∞} (hf : IsLowerSemianalytic (X := X × Y) f) + {κ : X → Measure Y} (hκ : Measurable κ) + (hκp : ∀ x, IsProbabilityMeasure (κ x)) : + IsLowerSemianalytic (fun x => ∫⁻ y, f (x, y) ∂(κ x)) := by + -- kernel packaging + set κK : Kernel X Y := ⟨κ, hκ⟩ with hκK + haveI : IsMarkovKernel κK := ⟨fun a => hκp a⟩ + -- transported epigraph pieces Eₙ ⊆ X × (Y × ℝ) + set E : ℕ → Set (X × (Y × ℝ)) := fun n => + (Homeomorph.prodAssoc X Y ℝ).symm ⁻¹' + ({pb : (X × Y) × ℝ | f pb.1 ≤ ENNReal.ofReal pb.2} + ∩ ((univ : Set (X × Y)) ×ˢ Icc (0 : ℝ) n)) with hE + have hE_analytic : ∀ n, AnalyticSet (E n) := by + intro n + refine AnalyticSet.preimage_of_continuous ?_ (Homeomorph.continuous _) + exact hf.analyticSet_epigraph.inter' + ((MeasurableSet.univ.prod measurableSet_Icc).analyticSet) + -- double sections of Eₙ are epigraph slices in ℝ + have hE_sec : ∀ (n : ℕ) (x : X) (y : Y), + Prod.mk y ⁻¹' (Prod.mk x ⁻¹' E n) + = {b : ℝ | f (x, y) ≤ ENNReal.ofReal b} ∩ Icc (0 : ℝ) n := by + intro n x y + ext b + simp only [hE, mem_preimage] + constructor + · rintro ⟨h1, -, h2⟩ + exact ⟨h1, h2⟩ + · rintro ⟨h1, h2⟩ + exact ⟨h1, mem_univ _, h2⟩ + -- the Lebesgue factors + set lam : ℕ → Measure ℝ := fun n => volume.restrict (Icc (0 : ℝ) n) with hlam + haveI hlam_fin : ∀ n, IsFiniteMeasure (lam n) := fun n => by + rw [hlam]; infer_instance + -- truncated integrals + set a : ℕ → X → ℝ≥0∞ := + fun n x => ∫⁻ y, min (f (x, y)) (n : ℝ≥0∞) ∂(κ x) with ha + have ha_le : ∀ n x, a n x ≤ (n : ℝ≥0∞) := by + intro n x + rw [ha] + refine le_trans (lintegral_mono fun y => min_le_right _ _) ?_ + rw [lintegral_const, measure_univ, mul_one] + -- sections of f are AEMeasurable + have hfx_slev : ∀ (x : X) (c : ℝ≥0∞), AnalyticSet {y | f (x, y) < c} := by + intro x c + have hset : {y | f (x, y) < c} = Prod.mk x ⁻¹' {p : X × Y | f p < c} := rfl + rw [hset] + exact (hf c).preimage_of_continuous + (Continuous.prodMk continuous_const continuous_id) + have hfx_ae : ∀ x : X, AEMeasurable (fun y => f (x, y)) (κ x) := fun x => + aemeasurable_of_analytic_sublevels (hfx_slev x) (κ x) + -- key value identity: (κ x ⊗ λₙ)((Eₙ)_x) = n − aₙ x + have hval : ∀ (n : ℕ) (x : X), + (κ x).prod (lam n) (Prod.mk x ⁻¹' E n) = (n : ℝ≥0∞) - a n x := by + intro n x + have hsec_analytic : AnalyticSet (Prod.mk x ⁻¹' E n) := + (hE_analytic n).preimage_of_continuous + (Continuous.prodMk continuous_const continuous_id) + rw [hsec_analytic.prod_apply (κ x) (lam n)] + have hint : ∀ y : Y, (lam n) (Prod.mk y ⁻¹' (Prod.mk x ⁻¹' E n)) + = (n : ℝ≥0∞) - min (f (x, y)) (n : ℝ≥0∞) := by + intro y + rw [hE_sec n x y, hlam] + have h1 : volume.restrict (Icc (0 : ℝ) n) + ({b : ℝ | f (x, y) ≤ ENNReal.ofReal b} ∩ Icc (0 : ℝ) n) + = volume.restrict (Icc (0 : ℝ) n) + {b : ℝ | f (x, y) ≤ ENNReal.ofReal b} := by + rw [Measure.restrict_apply' measurableSet_Icc, + Measure.restrict_apply' measurableSet_Icc, inter_assoc, inter_self] + rw [h1] + exact volume_restrict_epigraph_section _ n + rw [lintegral_congr fun y => hint y] + have hmin_ae : AEMeasurable (fun y => min (f (x, y)) (n : ℝ≥0∞)) (κ x) := + (hfx_ae x).min aemeasurable_const + have hle : (fun y => min (f (x, y)) (n : ℝ≥0∞)) ≤ᵐ[κ x] + fun _ => (n : ℝ≥0∞) := + Filter.Eventually.of_forall fun y => min_le_right _ _ + have hfin : ∫⁻ y, min (f (x, y)) (n : ℝ≥0∞) ∂(κ x) ≠ ∞ := + ne_top_of_le_ne_top (by finiteness) (ha_le n x) + calc ∫⁻ y, ((n : ℝ≥0∞) - min (f (x, y)) (n : ℝ≥0∞)) ∂(κ x) + = ∫⁻ y, ((fun _ => (n : ℝ≥0∞)) y + - (fun y => min (f (x, y)) (n : ℝ≥0∞)) y) ∂(κ x) := rfl + _ = ∫⁻ _, (n : ℝ≥0∞) ∂(κ x) + - ∫⁻ y, min (f (x, y)) (n : ℝ≥0∞) ∂(κ x) := + lintegral_sub' hmin_ae hfin hle + _ = (n : ℝ≥0∞) - a n x := by + rw [lintegral_const, measure_univ, mul_one, ha] + -- parametrized capacitability: superlevels of x ↦ (κ x ⊗ λₙ)((Eₙ)_x) + have hkey : ∀ (n : ℕ) (c' : ℝ≥0∞), + AnalyticSet {x | c' < (κ x).prod (lam n) (Prod.mk x ⁻¹' E n)} := by + intro n c' + have happ : ∀ x : X, (κK ×ₖ Kernel.const X (lam n)) x = (κ x).prod (lam n) := by + intro x + rw [Kernel.prod_apply, Kernel.const_apply] + rfl + have h := (hE_analytic n).kernel_section_gt + (κK ×ₖ Kernel.const X (lam n)) c' + simpa only [happ] using h + -- strict sublevels of the truncated integrals are analytic + have ha_sublevel : ∀ (n : ℕ) (r : ℝ≥0∞), AnalyticSet {x | a n x < r} := by + intro n r + rcases le_or_gt r (n : ℝ≥0∞) with hrn | hrn + · have heq : {x | a n x < r} + = {x | (n : ℝ≥0∞) - r < (κ x).prod (lam n) (Prod.mk x ⁻¹' E n)} := by + ext x + rw [mem_ofPred_eq, mem_ofPred_eq, hval n x] + constructor + · intro h + rw [ENNReal.sub_lt_iff_lt_right + (ne_top_of_le_ne_top (by finiteness) hrn) hrn] + calc (n : ℝ≥0∞) = a n x + ((n : ℝ≥0∞) - a n x) := + (add_tsub_cancel_of_le (ha_le n x)).symm + _ < r + ((n : ℝ≥0∞) - a n x) := + ENNReal.add_lt_add_right + (ne_top_of_le_ne_top (by finiteness) tsub_le_self) h + _ = ((n : ℝ≥0∞) - a n x) + r := add_comm _ _ + · intro h + by_contra hra + rw [not_lt] at hra + exact absurd h (not_lt.mpr (tsub_le_tsub_left hra _)) + rw [heq] + exact hkey n _ + · have heq : {x | a n x < r} = univ := + eq_univ_of_forall fun x => lt_of_le_of_lt (ha_le n x) hrn + rw [heq] + exact MeasurableSet.univ.analyticSet + -- the integral is the increasing limit of the truncations + have hsup : ∀ x : X, (∫⁻ y, f (x, y) ∂(κ x)) = ⨆ n : ℕ, a n x := by + intro x + calc ∫⁻ y, f (x, y) ∂(κ x) + = ∫⁻ y, ⨆ n : ℕ, min (f (x, y)) (n : ℝ≥0∞) ∂(κ x) := by + congr 1 + funext y + rw [ennreal_iSup_min_natCast] + _ = ⨆ n : ℕ, a n x := by + rw [ha] + exact lintegral_iSup' + (fun n => (hfx_ae x).min aemeasurable_const) + (Filter.Eventually.of_forall fun y n m hnm => + min_le_min le_rfl (by exact_mod_cast Nat.cast_le.mpr hnm)) + -- countable rational bookkeeping for the supremum + intro c + have hgoal : {x | (∫⁻ y, f (x, y) ∂(κ x)) < c} + = {x | (⨆ n : ℕ, a n x) < c} := by + ext x + rw [mem_ofPred_eq, mem_ofPred_eq, hsup x] + rw [hgoal] + have hmain : {x | (⨆ n : ℕ, a n x) < c} + = ⋃ q : ℚ, {x | (Real.toNNReal q : ℝ≥0∞) < c ∧ + ∀ n : ℕ, a n x ≤ (Real.toNNReal q : ℝ≥0∞)} := by + ext x + simp only [mem_ofPred_eq, mem_iUnion] + constructor + · intro h + obtain ⟨q, _, h1, h2⟩ := ENNReal.lt_iff_exists_rat_btwn.mp h + exact ⟨q, h2, fun n => + le_of_lt (lt_of_le_of_lt (le_iSup (fun m => a m x) n) h1)⟩ + · rintro ⟨q, hqc, hall⟩ + exact lt_of_le_of_lt (iSup_le fun n => hall n) hqc + rw [hmain] + refine AnalyticSet.iUnion fun q => ?_ + by_cases hqc : (Real.toNNReal q : ℝ≥0∞) < c + · have heq : {x | (Real.toNNReal q : ℝ≥0∞) < c ∧ + ∀ n : ℕ, a n x ≤ (Real.toNNReal q : ℝ≥0∞)} + = ⋂ (n : ℕ) (k : ℕ), + {x | a n x < (Real.toNNReal q : ℝ≥0∞) + ((k : ℝ≥0∞) + 1)⁻¹} := by + ext x + simp only [mem_ofPred_eq, mem_iInter, hqc, true_and] + constructor + · intro h n k + exact (ennreal_le_iff_forall_lt_add_inv (by finiteness)).mp (h n) k + · intro h n + exact (ennreal_le_iff_forall_lt_add_inv (by finiteness)).mpr (h n) + rw [heq] + exact AnalyticSet.iInter fun n => + AnalyticSet.iInter fun k => ha_sublevel n _ + · have heq : {x | (Real.toNNReal q : ℝ≥0∞) < c ∧ + ∀ n : ℕ, a n x ≤ (Real.toNNReal q : ℝ≥0∞)} = ∅ := by + ext x + simp [hqc] + rw [heq] + exact analyticSet_empty + +end Epigraph + +end diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LintegralLsc.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LintegralLsc.lean new file mode 100644 index 0000000000..479f56704c --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LintegralLsc.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- +Copyright (c) 2026. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. + +# Lower semicontinuity of `γ ↦ ∫⁻ f dγ` on `ProbabilityMeasure W` + +For a lower semicontinuous `f : W → ℝ≥0∞` on a Polish Borel space `W`, the +map `γ ↦ ∫⁻ x, f x ∂γ` is lower semicontinuous on `ProbabilityMeasure W` +with the topology of weak convergence. + +## Proof route + +Mathlib has the portmanteau open-set inequality for arbitrary filters +(`MeasureTheory.ProbabilityMeasure.le_liminf_measure_open_of_tendsto`) and the +real-valued layer-cake formula (`MeasureTheory.lintegral_eq_lintegral_meas_lt`), +but only a `Continuous`/`ℝ`-valued version of the liminf inequality for +integrals (`lintegral_le_liminf_lintegral_of_forall_isOpen_measure_le_liminf_measure`). +We upgrade it to lower semicontinuous `ℝ≥0∞`-valued integrands in three steps: + +1. `LowerSemicontinuous.lintegral_le_liminf_of_ne_top`: for `f` lsc with finite + values, rewrite `∫⁻ f ∂ν = ∫⁻ t in Ioi 0, ν {a | t < (f a).toReal}` by the + layer-cake formula; superlevel sets of an lsc function are open, so the + open-set liminf hypothesis applies pointwise in `t`, and Fatou's lemma + (`lintegral_liminf_le`) swaps `liminf` with the `t`-integral. +2. `LowerSemicontinuous.lintegral_le_liminf`: reduce a general lsc `f` to the + truncations `min f n` (again lsc, with finite values) via monotone + convergence. +3. `lowerSemicontinuous_lintegral_probabilityMeasure`: lower semicontinuity at + `γ` follows from the sequential bound: `ProbabilityMeasure W` is metrizable + (Lévy–Prokhorov, `instMetrizableSpaceProbabilityMeasure`), hence first + countable, so a failure of lower semicontinuity yields a sequence + `γs → γ` with `∫⁻ f ∂(γs n) ≤ y < ∫⁻ f ∂γ`, contradicting step 2 combined + with the portmanteau inequality along `γs`. +-/ +import Mathlib + +open MeasureTheory Filter Set Topology +open scoped ENNReal + +/-- Every `a : ℝ≥0∞` is the supremum of its truncations `min a n`. +(A copy of `ennreal_iSup_min_natCast` from `BicausalOT.DescriptiveSetTheory.KernelIntegral`; +kept `private` so that this draft stays self-contained over Mathlib and can be +deduplicated on integration.) -/ +private lemma ennreal_iSup_min_natCast' (a : ℝ≥0∞) : ⨆ n : ℕ, min a (n : ℝ≥0∞) = a := by + refine le_antisymm (iSup_le fun n => min_le_left _ _) ?_ + rcases eq_or_ne a ∞ with rfl | ha + · have hmin : ∀ n : ℕ, min (∞ : ℝ≥0∞) (n : ℝ≥0∞) = (n : ℝ≥0∞) := fun n => + min_eq_right le_top + simp only [hmin] + exact ENNReal.iSup_natCast.ge + · obtain ⟨n, hn⟩ := ENNReal.exists_nat_gt ha + exact le_iSup_of_le n (min_eq_left hn.le).ge + +section SequentialBound + +variable {W : Type*} [MeasurableSpace W] [TopologicalSpace W] [OpensMeasurableSpace W] + +/-- Portmanteau-type liminf inequality for the lower Lebesgue integral of a lower +semicontinuous function with finite values: if `μ G ≤ liminf (μs · G)` for every open `G`, +then `∫⁻ f ∂μ ≤ liminf (∫⁻ f ∂(μs ·))`. + +This is the `ℝ≥0∞`-valued analogue of +`MeasureTheory.lintegral_le_liminf_lintegral_of_forall_isOpen_measure_le_liminf_measure`: +layer-cake formula + openness of superlevel sets + Fatou's lemma. -/ +theorem LowerSemicontinuous.lintegral_le_liminf_of_ne_top + {μ : Measure W} {μs : ℕ → Measure W} {f : W → ℝ≥0∞} + (hf : LowerSemicontinuous f) (hf_ne : ∀ x, f x ≠ ∞) + (h_opens : ∀ G, IsOpen G → μ G ≤ atTop.liminf fun i => μs i G) : + ∫⁻ x, f x ∂μ ≤ atTop.liminf fun i => ∫⁻ x, f x ∂(μs i) := by + have g_nn : ∀ x, (0 : ℝ) ≤ (f x).toReal := fun x => ENNReal.toReal_nonneg + have g_mble : Measurable fun x => (f x).toReal := hf.measurable.ennreal_toReal + -- superlevel sets of `x ↦ (f x).toReal` are open + have levels_open : ∀ t : ℝ, IsOpen {a : W | t < (f a).toReal} := by + intro t + rcases lt_or_ge t 0 with ht | ht + · have huniv : {a : W | t < (f a).toReal} = univ := + eq_univ_of_forall fun a => lt_of_lt_of_le ht (g_nn a) + rw [huniv] + exact isOpen_univ + · have hpre : {a : W | t < (f a).toReal} = f ⁻¹' Ioi (ENNReal.ofReal t) := by + ext a + simp only [mem_ofPred_eq, mem_preimage, mem_Ioi] + exact (ENNReal.ofReal_lt_iff_lt_toReal ht (hf_ne a)).symm + rw [hpre] + exact hf.isOpen_preimage _ + -- layer-cake formula for each measure + have key : ∀ ν : Measure W, + ∫⁻ x, f x ∂ν = ∫⁻ t in Ioi (0 : ℝ), ν {a : W | t < (f a).toReal} := fun ν => + (lintegral_congr fun x => (ENNReal.ofReal_toReal (hf_ne x)).symm).trans + (lintegral_eq_lintegral_meas_lt ν (Eventually.of_forall g_nn) g_mble.aemeasurable) + calc ∫⁻ x, f x ∂μ + = ∫⁻ t in Ioi (0 : ℝ), μ {a : W | t < (f a).toReal} := key μ + _ ≤ ∫⁻ t in Ioi (0 : ℝ), atTop.liminf fun i => μs i {a : W | t < (f a).toReal} := + lintegral_mono fun t => h_opens _ (levels_open t) + _ ≤ atTop.liminf fun i => ∫⁻ t in Ioi (0 : ℝ), μs i {a : W | t < (f a).toReal} := + lintegral_liminf_le fun i => Antitone.measurable fun s t hst => + measure_mono fun ω hω => lt_of_le_of_lt hst hω + _ = atTop.liminf fun i => ∫⁻ x, f x ∂(μs i) := + liminf_congr (Eventually.of_forall fun i => (key (μs i)).symm) + +/-- Portmanteau-type liminf inequality for the lower Lebesgue integral of a lower +semicontinuous `ℝ≥0∞`-valued function: if `μ G ≤ liminf (μs · G)` for every open `G`, +then `∫⁻ f ∂μ ≤ liminf (∫⁻ f ∂(μs ·))`. + +Reduces to `LowerSemicontinuous.lintegral_le_liminf_of_ne_top` via the truncations +`min f n` and monotone convergence. -/ +theorem LowerSemicontinuous.lintegral_le_liminf + {μ : Measure W} {μs : ℕ → Measure W} {f : W → ℝ≥0∞} + (hf : LowerSemicontinuous f) + (h_opens : ∀ G, IsOpen G → μ G ≤ atTop.liminf fun i => μs i G) : + ∫⁻ x, f x ∂μ ≤ atTop.liminf fun i => ∫⁻ x, f x ∂(μs i) := by + -- the truncations are again lower semicontinuous + have h_trunc_lsc : ∀ n : ℕ, LowerSemicontinuous fun x => min (f x) (n : ℝ≥0∞) := by + intro n x y hy + filter_upwards [hf x y (hy.trans_le (min_le_left _ _))] with z hz + exact lt_min hz (hy.trans_le (min_le_right _ _)) + -- each truncation satisfies the liminf bound for the untruncated integrals + have h_bound : ∀ n : ℕ, + ∫⁻ x, min (f x) (n : ℝ≥0∞) ∂μ ≤ atTop.liminf fun i => ∫⁻ x, f x ∂(μs i) := fun n => + ((h_trunc_lsc n).lintegral_le_liminf_of_ne_top + (fun x => ne_top_of_le_ne_top (ENNReal.natCast_ne_top n) (min_le_right _ _)) + h_opens).trans + (liminf_le_liminf + (Eventually.of_forall fun i => lintegral_mono fun x => min_le_left _ _)) + -- monotone convergence for the truncations + calc ∫⁻ x, f x ∂μ + = ⨆ n : ℕ, ∫⁻ x, min (f x) (n : ℝ≥0∞) ∂μ := by + rw [← lintegral_iSup (fun n => hf.measurable.min measurable_const) + (fun n m hnm x => min_le_min le_rfl (by exact_mod_cast hnm))] + exact lintegral_congr fun x => (ennreal_iSup_min_natCast' (f x)).symm + _ ≤ atTop.liminf fun i => ∫⁻ x, f x ∂(μs i) := iSup_le h_bound + +end SequentialBound + +/-- **Lower semicontinuity of integration on `P(W)`.** For a Polish Borel space `W` and a +lower semicontinuous `f : W → ℝ≥0∞`, the map `γ ↦ ∫⁻ x, f x ∂γ` is lower semicontinuous +on `ProbabilityMeasure W` with the topology of weak convergence. -/ +theorem lowerSemicontinuous_lintegral_probabilityMeasure + {W : Type*} [MeasurableSpace W] [TopologicalSpace W] [PolishSpace W] [BorelSpace W] + {f : W → ℝ≥0∞} (hf : LowerSemicontinuous f) : + LowerSemicontinuous fun γ : ProbabilityMeasure W => ∫⁻ x, f x ∂(γ : Measure W) := by + intro γ y hy + by_contra hcon + rw [Filter.not_eventually] at hcon + -- extract a sequence `γs → γ` along which the integrals stay `≤ y`; + -- `ProbabilityMeasure W` is metrizable, hence `𝓝 γ` is countably generated + have h_freq : ∃ᶠ ν : ProbabilityMeasure W in 𝓝 γ, ∫⁻ x, f x ∂(ν : Measure W) ≤ y := + hcon.mono fun ν hν => not_lt.mp hν + obtain ⟨γs, hγs_tendsto, hγs_le⟩ := exists_seq_forall_of_frequently h_freq + -- portmanteau: the open-set liminf condition holds along `γs` + have h_opens : ∀ G, IsOpen G → + (γ : Measure W) G ≤ atTop.liminf fun i => (γs i : Measure W) G := fun _ hG => + ProbabilityMeasure.le_liminf_measure_open_of_tendsto hγs_tendsto hG + have h_le : ∫⁻ x, f x ∂(γ : Measure W) ≤ + atTop.liminf fun i => ∫⁻ x, f x ∂(γs i : Measure W) := + hf.lintegral_le_liminf h_opens + have h_lim_le : (atTop.liminf fun i => ∫⁻ x, f x ∂(γs i : Measure W)) ≤ y := + liminf_le_of_frequently_le' (Frequently.of_forall hγs_le) + exact absurd (hy.trans_le (h_le.trans h_lim_le)) (lt_irrefl y) diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LowerSemianalytic.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LowerSemianalytic.lean new file mode 100644 index 0000000000..b99b6a4e2a --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LowerSemianalytic.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Lower Semianalytic Functions + + Reference: Bertsekas–Shreve, Definition 7.21, Lemma 7.30, Props 7.47–7.48 +-/ +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet +import Mathlib.MeasureTheory.Measure.MeasureSpace +import Mathlib.MeasureTheory.Measure.Prod + +open MeasureTheory Set ENNReal + +noncomputable section + +variable {X : Type*} [TopologicalSpace X] + +/-- A function f : X → ℝ≥0∞ is lower semianalytic if its strict sublevel + sets {f < c} are analytic for all c. (BS, Definition 7.21) -/ +def IsLowerSemianalytic (f : X → ENNReal) : Prop := + ∀ c : ENNReal, AnalyticSet {x | f x < c} + +/-- l.s.c. functions are lower semianalytic. + Proof: {f < c} is open for l.s.c. f, hence Borel, hence analytic. -/ +theorem LowerSemicontinuous.isLowerSemianalytic + [PolishSpace X] [MeasurableSpace X] [BorelSpace X] + {f : X → ENNReal} (hf : LowerSemicontinuous f) : + IsLowerSemianalytic f := by + intro c + have hmeas : MeasurableSet {x | f x < c} := by + exact measurableSet_lt hf.measurable measurable_const + exact hmeas.analyticSet + +/-- inf of lower semianalytic is lower semianalytic. (BS, Prop 7.47) + Proof: {x | inf < c} = projₓ({(x,y) ∈ D | f(x,y) < c}). + Intersection of two analytic sets is analytic; projection preserves analytic. -/ +theorem IsLowerSemianalytic.iInf_fiber + {Y : Type*} [TopologicalSpace Y] [PolishSpace X] [PolishSpace Y] + [T2Space X] + {D : Set (X × Y)} (hD : AnalyticSet D) + {f : X × Y → ENNReal} (hf : IsLowerSemianalytic (X := X × Y) f) : + IsLowerSemianalytic (fun x => ⨅ (y : Y) (_ : (x, y) ∈ D), f (x, y)) := by + intro c + have h_sub : {x | ⨅ (y : Y) (_ : (x, y) ∈ D), f (x, y) < c} = + Prod.fst '' (D ∩ {p | f p < c}) := by + ext x; simp only [mem_ofPred_eq, mem_image, Prod.exists] + constructor + · intro hlt + rw [iInf_lt_iff] at hlt + obtain ⟨y, hy⟩ := hlt + rw [iInf_lt_iff] at hy + obtain ⟨hm, hfc⟩ := hy + exact ⟨x, y, ⟨hm, hfc⟩, rfl⟩ + · rintro ⟨x', y, ⟨hm, hfc⟩, rfl⟩ + exact lt_of_le_of_lt (iInf₂_le y hm) hfc + rw [h_sub] + have h_inter : AnalyticSet (D ∩ {p | f p < c}) := by + have h1 := hD + have h2 := hf c + rw [show D ∩ {p | f p < c} = ⋂ (i : Fin 2), + (![D, {p | f p < c}]) i from by ext x; simp [Fin.forall_fin_two, Matrix.cons_val_zero, Matrix.cons_val_one]] + exact AnalyticSet.iInter (fun i => by fin_cases i <;> simp [Matrix.cons_val_zero, Matrix.cons_val_one] <;> assumption) + exact h_inter.image_of_continuous continuous_fst + +/-! ### On BS Prop 7.48 (integration of lower semianalytic functions) + +An earlier draft stated Bertsekas–Shreve Prop 7.48 as an `axiom` +(`lintegral_lowerSemianalytic`). It is now a fully verified THEOREM — +see `BicausalOT.DescriptiveSetTheory.KernelIntegral`. The missing +ingredient, Choquet's capacitability theorem for analytic sets +(μ(A) = sup{μ(K) | K compact ⊆ A}, not available in Mathlib), is proved +from scratch in `BicausalOT.DescriptiveSetTheory.Capacitability` +(`MeasureTheory.AnalyticSet.measure_eq_iSup_isCompact`), together with +universal measurability (`MeasureTheory.AnalyticSet.nullMeasurableSet`) +and the parametrized kernel version +(`MeasureTheory.AnalyticSet.kernel_section_gt`). -/ + +end diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LsaAlgebra.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LsaAlgebra.lean new file mode 100644 index 0000000000..f02c7f89e6 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LsaAlgebra.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Algebra of Lower Semianalytic Functions + + Closure properties of lower semianalytic functions: addition, constant + functions, and composition with continuous maps. + + Reference: Bertsekas–Shreve, Lemma 7.30 +-/ +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral + +open Set MeasureTheory +open scoped ENNReal + +noncomputable section + +variable {X : Type*} [TopologicalSpace X] + +/-- The sum of two lower semianalytic functions is lower semianalytic. + (BS, Lemma 7.30) Proof: in `ℝ≥0∞` (with truncated subtraction), + `{f + g < c} = ⋃ (q : ℚ), ({f < q} ∩ {g < c - q})`, a countable union of + binary intersections of analytic sets. -/ +theorem IsLowerSemianalytic.add [T2Space X] {f g : X → ℝ≥0∞} + (hf : IsLowerSemianalytic f) (hg : IsLowerSemianalytic g) : + IsLowerSemianalytic (fun x => f x + g x) := by + intro c + show AnalyticSet {x | f x + g x < c} + have hdecomp : {x | f x + g x < c} + = ⋃ q : ℚ, ({x | f x < (Real.toNNReal q : ℝ≥0∞)} + ∩ {x | g x < c - (Real.toNNReal q : ℝ≥0∞)}) := by + ext x + simp only [mem_ofPred_eq, mem_iUnion, mem_inter_iff] + constructor + · intro h + obtain ⟨q, -, hq1, hq2⟩ := ENNReal.lt_iff_exists_rat_btwn.mp + (lt_tsub_iff_right.mpr h) + exact ⟨q, hq1, lt_tsub_iff_left.mpr (lt_tsub_iff_right.mp hq2)⟩ + · rintro ⟨q, hq1, hq2⟩ + exact lt_trans (ENNReal.add_lt_add_right (ne_top_of_lt hq2) hq1) + (lt_tsub_iff_left.mp hq2) + rw [hdecomp] + exact AnalyticSet.iUnion fun q => (hf _).inter' (hg _) + +/-- Constant functions are lower semianalytic: every strict sublevel set is + `univ` or `∅`. -/ +theorem IsLowerSemianalytic.const [PolishSpace X] (c : ℝ≥0∞) : + IsLowerSemianalytic (fun _ : X => c) := by + intro d + by_cases hcd : c < d + · have h : {x : X | (fun _ : X => c) x < d} = univ := + eq_univ_of_forall fun _ => hcd + rw [h] + exact isClosed_univ.analyticSet + · have h : {x : X | (fun _ : X => c) x < d} = ∅ := by + ext x + simp [hcd] + rw [h] + exact analyticSet_empty + +/-- Precomposition with a continuous map preserves lower semianalyticity: + sublevel sets pull back to preimages of analytic sets, which are analytic + by `MeasureTheory.AnalyticSet.preimage_of_continuous`. -/ +theorem IsLowerSemianalytic.comp_continuous [PolishSpace X] + {Y : Type*} [TopologicalSpace Y] [T2Space Y] + {f : Y → ℝ≥0∞} (hf : IsLowerSemianalytic f) + {g : X → Y} (hg : Continuous g) : + IsLowerSemianalytic (f ∘ g) := by + intro c + have h : {x | (f ∘ g) x < c} = g ⁻¹' {y | f y < c} := rfl + rw [h] + exact (hf c).preimage_of_continuous hg + +end diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LscIntegral.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LscIntegral.lean new file mode 100644 index 0000000000..e0c5c9121e --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LscIntegral.lean @@ -0,0 +1,107 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Joint Lower Semicontinuity of the Integral Pairing + + Phase 5, File 2 (BLUEPRINT §4F). + J1 `continuous_probabilityMeasure_map_prodMk`: the pairing + (x, γ) ↦ γ.map (Prod.mk x) is jointly continuous from H × P(W) to + P(H × W) in the weak topologies. + J2 `lowerSemicontinuous_lintegral_prodMk`: consequently, for jointly + lower semicontinuous f : H × W → ℝ≥0∞, the integral + (x, γ) ↦ ∫⁻ z, f (x, z) ∂γ is jointly lower semicontinuous + (the lsc integral functional on P(H × W) after the continuous pairing). + + J1 is sequential (both sides metrizable), via the converse portmanteau + criterion: for open G and r < γ ((Prod.mk x)⁻¹' G), inner regularity + gives a compact K ⊆ (Prod.mk x)⁻¹' G with r < γ K; the tube lemma + around {x} ×ˢ K produces open V ∋ x and O ⊇ K with V ×ˢ O ⊆ G; + eventually xₙ ∈ V, so (Prod.mk xₙ)⁻¹' G ⊇ O, and + liminf γₙ O ≥ γ O ≥ γ K > r by the open portmanteau applied to γₙ → γ. + No tightness and no equicontinuity are needed. +-/ +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LintegralLsc + +open MeasureTheory Set Filter Topology +open scoped ENNReal + +noncomputable section + +variable {H W : Type*} + [TopologicalSpace H] [PolishSpace H] [MeasurableSpace H] [BorelSpace H] + [TopologicalSpace W] [PolishSpace W] [MeasurableSpace W] [BorelSpace W] + +/-! ## J1: joint continuity of the pairing -/ + +/-- **Joint continuity of the pairing** `(x, γ) ↦ γ.map (Prod.mk x)` from + `H × P(W)` to `P(H × W)` (weak topologies, Polish spaces). -/ +theorem continuous_probabilityMeasure_map_prodMk : + Continuous (fun p : H × ProbabilityMeasure W => + ProbabilityMeasure.map p.2 + (measurable_prodMk_left (x := p.1)).aemeasurable) := by + refine SeqContinuous.continuous fun ps p hps => ?_ + have hx : Tendsto (fun n => (ps n).1) atTop (𝓝 p.1) := + (continuous_fst.tendsto p).comp hps + have hγ : Tendsto (fun n => (ps n).2) atTop (𝓝 p.2) := + (continuous_snd.tendsto p).comp hps + refine MeasureTheory.tendsto_of_forall_isOpen_le_liminf' fun G hG => ?_ + simp only [Function.comp_apply, ProbabilityMeasure.toMeasure_map] + rw [Measure.map_apply measurable_prodMk_left hG.measurableSet] + refine le_of_forall_lt fun r hr => ?_ + -- inner regularity: a compact K inside the section of G over p.1 + obtain ⟨K, hKsub, hKc, hK⟩ := + (hG.measurableSet.preimage measurable_prodMk_left).exists_lt_isCompact_of_ne_top + (measure_ne_top _ _) hr + -- tube lemma around {p.1} ×ˢ K + have hxK : {p.1} ×ˢ K ⊆ G := by + rintro ⟨a, z⟩ ⟨ha, hz⟩ + rcases Set.mem_singleton_iff.mp ha with rfl + exact hKsub hz + obtain ⟨V, O, hVopen, hOopen, hxV, hKO, hVO⟩ := + generalized_tube_lemma isCompact_singleton hKc hG hxK + -- eventually the moving section contains O + have hev : ∀ᶠ n in atTop, + ((ps n).2 : Measure W) O + ≤ (((ps n).2 : Measure W).map (Prod.mk (ps n).1)) G := by + filter_upwards [hx.eventually + (hVopen.mem_nhds (Set.singleton_subset_iff.mp hxV))] with n hn + rw [Measure.map_apply measurable_prodMk_left hG.measurableSet] + exact measure_mono fun z hz => hVO ⟨hn, hz⟩ + calc r < (p.2 : Measure W) K := hK + _ ≤ (p.2 : Measure W) O := measure_mono hKO + _ ≤ atTop.liminf (fun n => ((ps n).2 : Measure W) O) := + ProbabilityMeasure.le_liminf_measure_open_of_tendsto hγ hOopen + _ ≤ atTop.liminf + (fun n => (((ps n).2 : Measure W).map (Prod.mk (ps n).1)) G) := + liminf_le_liminf hev + +/-! ## J2: joint lower semicontinuity of the integral pairing -/ + +/-- **Joint lower semicontinuity of the integral pairing.** For jointly + lower semicontinuous `f : H × W → ℝ≥0∞`, the map + `(x, γ) ↦ ∫⁻ z, f (x, z) ∂γ` is jointly lower semicontinuous on + `H × P(W)`: it is the lsc integral functional on `P(H × W)` + (`lowerSemicontinuous_lintegral_probabilityMeasure`) composed with + the continuous pairing (J1). -/ +theorem lowerSemicontinuous_lintegral_prodMk + {f : H × W → ℝ≥0∞} (hf : LowerSemicontinuous f) : + LowerSemicontinuous (fun p : H × ProbabilityMeasure W => + ∫⁻ z, f (p.1, z) ∂(p.2 : Measure W)) := by + have hkey : (fun p : H × ProbabilityMeasure W => + ∫⁻ z, f (p.1, z) ∂(p.2 : Measure W)) + = (fun γ : ProbabilityMeasure (H × W) => + ∫⁻ q, f q ∂(γ : Measure (H × W))) + ∘ (fun p : H × ProbabilityMeasure W => + ProbabilityMeasure.map p.2 + (measurable_prodMk_left (x := p.1)).aemeasurable) := by + funext p + simp only [Function.comp_apply, ProbabilityMeasure.toMeasure_map] + rw [lintegral_map hf.measurable measurable_prodMk_left] + rw [hkey] + exact (lowerSemicontinuous_lintegral_probabilityMeasure hf).comp + continuous_probabilityMeasure_map_prodMk + +end diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/MeasurableSelection.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/MeasurableSelection.lean new file mode 100644 index 0000000000..db2cc6dabd --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/MeasurableSelection.lean @@ -0,0 +1,260 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- +# The Kuratowski–Ryll-Nardzewski measurable selection theorem + +Draft for the BicausalOT campaign (Front F5). + +Main result: `exists_measurable_selection`. A multifunction `Φ : α → Set Y` from a +measurable space `α` into a complete separable metric space `Y`, with nonempty closed +values, which is measurable in the weak sense that `{a | (Φ a ∩ U).Nonempty}` is +measurable for every open `U : Set Y`, admits a Borel-measurable selection +`f : α → Y` with `f a ∈ Φ a` for every `a`. + +Proof strategy (classical, Kuratowski–Ryll-Nardzewski): +fix a dense sequence `u : ℕ → Y`. Build a sequence of *countably-`u`-valued* +measurable approximate selectors `fₙ = u ∘ gₙ` with `gₙ : α → ℕ` measurable, such that +`Φ a` meets `ball (fₙ a) ((1/2)^n)` and `dist (fₙ a) (f_{n+1} a) ≤ (3/2)·(1/2)^n`. +Each `gₙ₊₁ a` is the *least* index `k` such that `Φ a` meets +`ball (u k) ((1/2)^(n+1)) ∩ ball (u (gₙ a)) ((1/2)^n)`; the corresponding test sets +are measurable because, on each fiber `{gₙ = j}` (countably many, measurable), the +condition involves the *fixed* open set `ball (u k) _ ∩ ball (u j) _`, so the +open-set measurability hypothesis applies directly. The limit `f = lim fₙ` is +measurable as a pointwise limit of measurable functions into a metrizable space, and +`f a ∈ Φ a` because `Φ a` is closed. +-/ +import Mathlib + +open Metric Set Filter Topology TopologicalSpace + +namespace MeasurableSelection + +/-! ### Least-index choice over `ℕ`, classical-decidability wrapper -/ + +/-- The least `n : ℕ` satisfying `p`, with classical decidability baked in (so that it +can be used in `noncomputable` constructions without carrying instances around). -/ +noncomputable def firstIdx (p : ℕ → Prop) (h : ∃ n, p n) : ℕ := + @Nat.find p (Classical.decPred p) h + +theorem firstIdx_spec {p : ℕ → Prop} (h : ∃ n, p n) : p (firstIdx p h) := by + letI := Classical.decPred p + exact Nat.find_spec h + +theorem firstIdx_eq_iff {p : ℕ → Prop} (h : ∃ n, p n) {k : ℕ} : + firstIdx p h = k ↔ p k ∧ ∀ j < k, ¬p j := by + letI := Classical.decPred p + exact Nat.find_eq_iff h + +variable {α : Type*} [MeasurableSpace α] + +/-- Taking the least index satisfying a jointly measurable family of predicates is a +measurable operation into `ℕ`. -/ +theorem measurable_firstIdx {p : α → ℕ → Prop} (hex : ∀ a, ∃ n, p a n) + (hm : ∀ k, MeasurableSet {a | p a k}) : + Measurable fun a => firstIdx (p a) (hex a) := by + refine measurable_to_countable' fun k => ?_ + have hset : (fun a => firstIdx (p a) (hex a)) ⁻¹' {k} = + {a | p a k} ∩ ⋂ (j : ℕ) (_ : j < k), {a | p a j}ᶜ := by + ext a + simp only [mem_preimage, mem_singleton_iff, firstIdx_eq_iff, mem_inter_iff, + mem_ofPred_eq, mem_iInter, mem_compl_iff] + rw [hset] + exact (hm k).inter + (MeasurableSet.iInter fun j => MeasurableSet.iInter fun _ => (hm j).compl) + +/-! ### The approximation scheme + +Throughout, `u : ℕ → Y` is a dense sequence and `Φ : α → Set Y` a multifunction with +`{a | (Φ a ∩ U).Nonempty}` measurable for every open `U`. -/ + +variable {Y : Type*} [MetricSpace Y] {Φ : α → Set Y} {u : ℕ → Y} + +omit [MeasurableSpace α] in +/-- Base step: some `u k` comes within distance `1` of the nonempty set `Φ a`. -/ +theorem base_exists (hu : DenseRange u) (hne : ∀ a, (Φ a).Nonempty) (a : α) : + ∃ k, (Φ a ∩ ball (u k) 1).Nonempty := by + obtain ⟨y, hy⟩ := hne a + obtain ⟨k, hk⟩ := hu.exists_dist_lt y one_pos + exact ⟨k, y, hy, mem_ball.mpr hk⟩ + +/-- The initial approximate selector: least `k` with `Φ a ∩ ball (u k) 1` nonempty. -/ +noncomputable def baseFun (hu : DenseRange u) (hne : ∀ a, (Φ a).Nonempty) : α → ℕ := + fun a => firstIdx _ (base_exists hu hne a) + +omit [MeasurableSpace α] in +theorem baseFun_spec (hu : DenseRange u) (hne : ∀ a, (Φ a).Nonempty) (a : α) : + (Φ a ∩ ball (u (baseFun hu hne a)) 1).Nonempty := + firstIdx_spec (base_exists hu hne a) + +theorem baseFun_measurable (hu : DenseRange u) (hne : ∀ a, (Φ a).Nonempty) + (hΦ : ∀ U : Set Y, IsOpen U → MeasurableSet {a | (Φ a ∩ U).Nonempty}) : + Measurable (baseFun hu hne) := + measurable_firstIdx (base_exists hu hne) fun _ => hΦ _ isOpen_ball + +omit [MeasurableSpace α] in +/-- Refinement step, existence: if `Φ a` meets `ball (u (g a)) r`, then by density some +`u k` with `k` least comes within `r'` of a point of `Φ a ∩ ball (u (g a)) r`. -/ +theorem step_exists (hu : DenseRange u) {g : α → ℕ} {r : ℝ} + (hg : ∀ a, (Φ a ∩ ball (u (g a)) r).Nonempty) {r' : ℝ} (hr' : 0 < r') (a : α) : + ∃ k, (Φ a ∩ (ball (u k) r' ∩ ball (u (g a)) r)).Nonempty := by + obtain ⟨y, hyΦ, hyb⟩ := hg a + obtain ⟨k, hk⟩ := hu.exists_dist_lt y hr' + exact ⟨k, y, hyΦ, mem_ball.mpr hk, hyb⟩ + +/-- Refinement step, measurability of the test sets. This is the key point of the +whole formalization: since the previous selector `g` is countably valued, the set +splits over the fibers `{g = j}`, and on each fiber the test set is cut out by a +*fixed* open set `ball (u k) r' ∩ ball (u j) r`, so the hypothesis `hΦ` applies. -/ +theorem step_measurableSet + (hΦ : ∀ U : Set Y, IsOpen U → MeasurableSet {a | (Φ a ∩ U).Nonempty}) + {g : α → ℕ} (hgm : Measurable g) (r r' : ℝ) (k : ℕ) : + MeasurableSet {a | (Φ a ∩ (ball (u k) r' ∩ ball (u (g a)) r)).Nonempty} := by + have hset : {a | (Φ a ∩ (ball (u k) r' ∩ ball (u (g a)) r)).Nonempty} = + ⋃ j : ℕ, {a | g a = j} ∩ {a | (Φ a ∩ (ball (u k) r' ∩ ball (u j) r)).Nonempty} := by + ext a + simp only [mem_iUnion, mem_inter_iff, mem_ofPred_eq] + constructor + · exact fun h => ⟨g a, rfl, h⟩ + · rintro ⟨j, rfl, h⟩ + exact h + rw [hset] + exact MeasurableSet.iUnion fun j => + (hgm (measurableSet_singleton j)).inter (hΦ _ (isOpen_ball.inter isOpen_ball)) + +/-- The refinement step: the least index `k` such that `Φ a` meets +`ball (u k) r' ∩ ball (u (g a)) r`. -/ +noncomputable def stepFun (hu : DenseRange u) {g : α → ℕ} {r : ℝ} + (hg : ∀ a, (Φ a ∩ ball (u (g a)) r).Nonempty) {r' : ℝ} (hr' : 0 < r') : α → ℕ := + fun a => firstIdx _ (step_exists hu hg hr' a) + +omit [MeasurableSpace α] in +theorem stepFun_spec (hu : DenseRange u) {g : α → ℕ} {r : ℝ} + (hg : ∀ a, (Φ a ∩ ball (u (g a)) r).Nonempty) {r' : ℝ} (hr' : 0 < r') (a : α) : + (Φ a ∩ (ball (u (stepFun hu hg hr' a)) r' ∩ ball (u (g a)) r)).Nonempty := + firstIdx_spec (step_exists hu hg hr' a) + +theorem stepFun_measurable (hu : DenseRange u) + (hΦ : ∀ U : Set Y, IsOpen U → MeasurableSet {a | (Φ a ∩ U).Nonempty}) + {g : α → ℕ} {r : ℝ} (hg : ∀ a, (Φ a ∩ ball (u (g a)) r).Nonempty) + {r' : ℝ} (hr' : 0 < r') (hgm : Measurable g) : + Measurable (stepFun hu hg hr') := + measurable_firstIdx (step_exists hu hg hr') fun k => step_measurableSet hΦ hgm r r' k + +/-- The full approximation scheme: at stage `n`, a measurable, countably-`u`-valued +selector index `gₙ : α → ℕ` such that `Φ a` meets `ball (u (gₙ a)) ((1/2)^n)`. -/ +noncomputable def approx (hu : DenseRange u) (hne : ∀ a, (Φ a).Nonempty) + (hΦ : ∀ U : Set Y, IsOpen U → MeasurableSet {a | (Φ a ∩ U).Nonempty}) : + (n : ℕ) → + {g : α → ℕ // Measurable g ∧ ∀ a, (Φ a ∩ ball (u (g a)) ((1 / 2 : ℝ) ^ n)).Nonempty} + | 0 => + ⟨baseFun hu hne, baseFun_measurable hu hne hΦ, fun a => by + simpa using baseFun_spec hu hne a⟩ + | n + 1 => + ⟨stepFun hu (approx hu hne hΦ n).2.2 (pow_pos one_half_pos (n + 1)), + stepFun_measurable hu hΦ (approx hu hne hΦ n).2.2 (pow_pos one_half_pos (n + 1)) + (approx hu hne hΦ n).2.1, + fun a => + Exists.imp (fun _ hy => ⟨hy.1, hy.2.1⟩) + (stepFun_spec hu (approx hu hne hΦ n).2.2 (pow_pos one_half_pos (n + 1)) a)⟩ + +/-- Successive stages of the scheme select points close both to `Φ a` and to the +previous stage. -/ +theorem approx_succ_spec (hu : DenseRange u) (hne : ∀ a, (Φ a).Nonempty) + (hΦ : ∀ U : Set Y, IsOpen U → MeasurableSet {a | (Φ a ∩ U).Nonempty}) + (n : ℕ) (a : α) : + (Φ a ∩ (ball (u ((approx hu hne hΦ (n + 1)).1 a)) ((1 / 2 : ℝ) ^ (n + 1)) ∩ + ball (u ((approx hu hne hΦ n).1 a)) ((1 / 2 : ℝ) ^ n))).Nonempty := + stepFun_spec hu (approx hu hne hΦ n).2.2 (pow_pos one_half_pos (n + 1)) a + +/-- The `n`-th approximate selection `α → Y`: the dense sequence composed with the +`n`-th selector index. -/ +noncomputable def approxFun (hu : DenseRange u) (hne : ∀ a, (Φ a).Nonempty) + (hΦ : ∀ U : Set Y, IsOpen U → MeasurableSet {a | (Φ a ∩ U).Nonempty}) + (n : ℕ) (a : α) : Y := + u ((approx hu hne hΦ n).1 a) + +theorem approxFun_close (hu : DenseRange u) (hne : ∀ a, (Φ a).Nonempty) + (hΦ : ∀ U : Set Y, IsOpen U → MeasurableSet {a | (Φ a ∩ U).Nonempty}) + (n : ℕ) (a : α) : + (Φ a ∩ ball (approxFun hu hne hΦ n a) ((1 / 2 : ℝ) ^ n)).Nonempty := + (approx hu hne hΦ n).2.2 a + +theorem approxFun_dist_succ (hu : DenseRange u) (hne : ∀ a, (Φ a).Nonempty) + (hΦ : ∀ U : Set Y, IsOpen U → MeasurableSet {a | (Φ a ∩ U).Nonempty}) + (n : ℕ) (a : α) : + dist (approxFun hu hne hΦ n a) (approxFun hu hne hΦ (n + 1) a) ≤ + (3 / 2 : ℝ) * (1 / 2) ^ n := by + obtain ⟨y, hyΦ, hy1, hy2⟩ := approx_succ_spec hu hne hΦ n a + calc dist (approxFun hu hne hΦ n a) (approxFun hu hne hΦ (n + 1) a) ≤ + dist y (approxFun hu hne hΦ n a) + dist y (approxFun hu hne hΦ (n + 1) a) := + dist_triangle_left _ _ _ + _ ≤ (1 / 2 : ℝ) ^ n + (1 / 2) ^ (n + 1) := + add_le_add (mem_ball.mp hy2).le (mem_ball.mp hy1).le + _ = (3 / 2 : ℝ) * (1 / 2) ^ n := by rw [pow_succ]; ring + +theorem approxFun_measurable [MeasurableSpace Y] (hu : DenseRange u) + (hne : ∀ a, (Φ a).Nonempty) + (hΦ : ∀ U : Set Y, IsOpen U → MeasurableSet {a | (Φ a ∩ U).Nonempty}) (n : ℕ) : + Measurable (approxFun hu hne hΦ n) := + (Measurable.of_discrete (f := u)).comp (approx hu hne hΦ n).2.1 + +section Limit + +variable [MeasurableSpace Y] [BorelSpace Y] + +/-- Main construction, given a dense sequence: the approximations form a uniformly +Cauchy sequence; the pointwise limit is a measurable selection of `Φ`. -/ +theorem exists_selection_of_denseRange [CompleteSpace Y] + (hu : DenseRange u) (hne : ∀ a, (Φ a).Nonempty) (hclosed : ∀ a, IsClosed (Φ a)) + (hΦ : ∀ U : Set Y, IsOpen U → MeasurableSet {a | (Φ a ∩ U).Nonempty}) : + ∃ f : α → Y, Measurable f ∧ ∀ a, f a ∈ Φ a := by + have hcauchy : ∀ a, CauchySeq fun n => approxFun hu hne hΦ n a := fun a => + cauchySeq_of_le_geometric (1 / 2) (3 / 2) (by norm_num) + (fun n => approxFun_dist_succ hu hne hΦ n a) + choose f hf using fun a => cauchySeq_tendsto_of_complete (hcauchy a) + refine ⟨f, ?_, ?_⟩ + · exact measurable_of_tendsto_metrizable (fun n => approxFun_measurable hu hne hΦ n) + (tendsto_pi_nhds.mpr hf) + · intro a + rw [← (hclosed a).closure_eq, Metric.mem_closure_iff] + intro ε hε + have h1 : ∀ᶠ n in atTop, dist (approxFun hu hne hΦ n a) (f a) < ε / 2 := by + obtain ⟨N, hN⟩ := Metric.tendsto_atTop.mp (hf a) (ε / 2) (half_pos hε) + exact eventually_atTop.mpr ⟨N, hN⟩ + have h2 : ∀ᶠ n : ℕ in atTop, (1 / 2 : ℝ) ^ n < ε / 2 := + (tendsto_pow_atTop_nhds_zero_of_lt_one (by norm_num) (by norm_num)).eventually_lt_const + (half_pos hε) + obtain ⟨n, hn1, hn2⟩ := (h1.and h2).exists + obtain ⟨y, hyΦ, hyb⟩ := approxFun_close hu hne hΦ n a + refine ⟨y, hyΦ, ?_⟩ + calc dist (f a) y ≤ + dist (f a) (approxFun hu hne hΦ n a) + dist (approxFun hu hne hΦ n a) y := + dist_triangle _ _ _ + _ < ε / 2 + ε / 2 := + add_lt_add (by rw [dist_comm]; exact hn1) ((mem_ball'.mp hyb).trans hn2) + _ = ε := by ring + +end Limit + +end MeasurableSelection + +/-- **The Kuratowski–Ryll-Nardzewski measurable selection theorem** (single-selection +form): a multifunction `Φ` from a measurable space into a complete separable metric +space, with nonempty closed values, such that `{a | (Φ a ∩ U).Nonempty}` is measurable +for every open `U`, admits a Borel-measurable selection. -/ +theorem exists_measurable_selection {α : Type*} [MeasurableSpace α] {Y : Type*} + [MetricSpace Y] [SeparableSpace Y] [CompleteSpace Y] [MeasurableSpace Y] + [BorelSpace Y] {Φ : α → Set Y} (hne : ∀ a, (Φ a).Nonempty) + (hclosed : ∀ a, IsClosed (Φ a)) + (hmeas : ∀ U : Set Y, IsOpen U → MeasurableSet {a | (Φ a ∩ U).Nonempty}) : + ∃ f : α → Y, Measurable f ∧ ∀ a, f a ∈ Φ a := by + rcases isEmpty_or_nonempty α with hα | hα + · haveI := hα + exact ⟨fun a => (hne a).some, measurable_of_empty _, fun a => (hne a).some_mem⟩ + · obtain ⟨a₀⟩ := hα + haveI : Nonempty Y := ⟨(hne a₀).some⟩ + obtain ⟨u, hu⟩ := TopologicalSpace.exists_dense_seq Y + exact MeasurableSelection.exists_selection_of_denseRange hu hne hclosed hmeas diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ProbabilityMeasurePolish.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ProbabilityMeasurePolish.lean new file mode 100644 index 0000000000..e8c9c7610b --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ProbabilityMeasurePolish.lean @@ -0,0 +1,795 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + The space of probability measures on a Polish space is Polish + + Blueprint: BLUEPRINT.md §3W (wall W1). Mathlib (2025) provides the + Lévy-Prokhorov metric, its identification with the topology of weak + convergence on separable spaces, and Prokhorov's theorem + (`isCompact_closure_of_isTightMeasureSet`); what is missing — and + supplied here — is completeness (Node A + C1) of the Lévy-Prokhorov + metric. Separability (Node B) and the `PolishSpace` assembly follow. +-/ +import Mathlib.MeasureTheory.Measure.LevyProkhorovMetric +import Mathlib.MeasureTheory.Measure.Tight +import Mathlib.MeasureTheory.Measure.Prokhorov +import Mathlib.MeasureTheory.PiSystem +import Mathlib.MeasureTheory.Measure.GiryMonad + +open MeasureTheory Topology TopologicalSpace Metric Filter Set +open scoped ENNReal NNReal Classical + +noncomputable section + +variable {Ω : Type*} [MetricSpace Ω] [SeparableSpace Ω] [CompleteSpace Ω] + [MeasurableSpace Ω] [BorelSpace Ω] + +/-! ## Node A: Lévy-Prokhorov Cauchy sequences are uniformly tight -/ + +omit [SeparableSpace Ω] [CompleteSpace Ω] in +/-- A1, heads: any single probability measure puts mass `≥ 1 - ε` on a + finite union of `η`-balls centered in a countable dense sequence. -/ +theorem exists_range_measure_ball_compl_lt + (μ : Measure Ω) [IsProbabilityMeasure μ] {D : ℕ → Ω} (hD : DenseRange D) + {η : ℝ} (hη : 0 < η) {ε : ℝ≥0∞} (hε : 0 < ε) : + ∃ M : ℕ, μ ((⋃ j ∈ Finset.range M, ball (D j) η)ᶜ) < ε := by + have hcover : (⋃ j, ball (D j) η) = univ := by + refine eq_univ_iff_forall.mpr fun x => ?_ + obtain ⟨j, hj⟩ := Metric.denseRange_iff.mp hD x η hη + exact mem_iUnion.mpr ⟨j, by simpa [Metric.mem_ball, dist_comm] using hj⟩ + have hanti : Antitone fun M => (⋃ j ∈ Finset.range M, ball (D j) η)ᶜ := by + intro M M' hMM' + apply compl_subset_compl.mpr + refine biUnion_subset_biUnion_left ?_ + intro j hj + simp only [Finset.coe_range, mem_Iio] at hj ⊢ + omega + have hinter : (⋂ M, (⋃ j ∈ Finset.range M, ball (D j) η)ᶜ) = ∅ := by + rw [← compl_iUnion, + show (⋃ M, ⋃ j ∈ Finset.range M, ball (D j) η) = ⋃ j, ball (D j) η by + ext x + simp only [mem_iUnion, Finset.mem_range] + exact ⟨fun ⟨_, j, _, hx⟩ => ⟨j, hx⟩, fun ⟨j, hx⟩ => ⟨j + 1, j, by omega, hx⟩⟩, + hcover, compl_univ] + have htendsto : Tendsto (fun M => μ ((⋃ j ∈ Finset.range M, ball (D j) η)ᶜ)) + atTop (𝓝 0) := by + have h := tendsto_measure_iInter_atTop + (μ := μ) (s := fun M => (⋃ j ∈ Finset.range M, ball (D j) η)ᶜ) + (fun M => ((isOpen_biUnion fun j _ => + isOpen_ball).isClosed_compl.measurableSet).nullMeasurableSet) + hanti ⟨0, measure_ne_top μ _⟩ + rwa [hinter, measure_empty] at h + exact (htendsto.eventually_lt_const hε).exists + +omit [CompleteSpace Ω] in +/-- A1: for a Lévy-Prokhorov Cauchy sequence of probability measures on a + Polish space, all measures simultaneously put mass `≥ 1 - δ` on one + common finite union of `η`-balls. Heads are covered by density and + continuity from below; tails are transferred from `u N` along the + Lévy-Prokhorov inequality. -/ +theorem cauchySeq_exists_finset_measure_ball_compl_le + (u : ℕ → LevyProkhorov (ProbabilityMeasure Ω)) (hu : CauchySeq u) + {η δ : ℝ} (hη : 0 < η) (hδ : 0 < δ) : + ∃ F : Finset Ω, ∀ n, + ((u n).toMeasure : Measure Ω) ((⋃ x ∈ F, ball x η)ᶜ) + ≤ ENNReal.ofReal δ := by + rcases isEmpty_or_nonempty Ω with hΩ | hΩ + · exfalso + have h1 : ((u 0).toMeasure : Measure Ω) univ = 1 := measure_univ + rw [Set.univ_eq_empty_iff.mpr hΩ, measure_empty] at h1 + exact zero_ne_one h1 + set c : ℝ := min (δ / 2) (η / 2) with hc + have hcpos : 0 < c := lt_min (by linarith) (by linarith) + obtain ⟨N, hN⟩ := Metric.cauchySeq_iff'.mp hu c hcpos + obtain ⟨D, hD⟩ := exists_dense_seq Ω + have hhead : ∀ i : ℕ, ∃ M : ℕ, + ((u i).toMeasure : Measure Ω) + ((⋃ j ∈ Finset.range M, ball (D j) (η / 2))ᶜ) + < ENNReal.ofReal (δ / 2) := by + intro i + refine exists_range_measure_ball_compl_lt _ hD (by linarith) ?_ + rw [ENNReal.ofReal_pos] + linarith + choose M hM using hhead + set Mstar : ℕ := (Finset.range (N + 1)).sup M with hMstar + refine ⟨(Finset.range Mstar).image D, fun n => ?_⟩ + set B : Set Ω := ⋃ x ∈ (Finset.range Mstar).image D, ball x (η / 2) with hB + have hhead_le : ∀ i ≤ N, + ((u i).toMeasure : Measure Ω) (Bᶜ) ≤ ENNReal.ofReal (δ / 2) := by + intro i hi + refine le_trans (measure_mono (compl_subset_compl.mpr ?_)) (hM i).le + intro y hy + simp only [mem_iUnion, Finset.mem_range, exists_prop] at hy + obtain ⟨j, hj, hyj⟩ := hy + have hjM : j < Mstar := + lt_of_lt_of_le hj (Finset.le_sup (Finset.mem_range.mpr (by omega))) + simp only [hB, mem_iUnion, exists_prop] + exact ⟨D j, Finset.mem_image_of_mem D (Finset.mem_range.mpr hjM), hyj⟩ + set A : Set Ω := (⋃ x ∈ (Finset.range Mstar).image D, ball x η)ᶜ with hA + have hAmble : MeasurableSet A := + (isOpen_biUnion fun x _ => isOpen_ball).isClosed_compl.measurableSet + have hAB : A ⊆ Bᶜ := by + apply compl_subset_compl.mpr + exact iUnion₂_mono fun x _ => ball_subset_ball (by linarith) + rcases le_or_gt n N with hn | hn + · calc ((u n).toMeasure : Measure Ω) A + ≤ ((u n).toMeasure : Measure Ω) (Bᶜ) := measure_mono hAB + _ ≤ ENNReal.ofReal (δ / 2) := hhead_le n hn + _ ≤ ENNReal.ofReal δ := ENNReal.ofReal_le_ofReal (by linarith) + · have hdist : dist (u n) (u N) < c := hN n hn.le + have hedist : levyProkhorovEDist + ((u N).toMeasure : Measure Ω) ((u n).toMeasure : Measure Ω) + < ENNReal.ofReal c := by + rw [levyProkhorovEDist_comm] + exact (ENNReal.lt_ofReal_iff_toReal_lt + (levyProkhorovEDist_ne_top _ _)).mpr hdist + have key := right_measure_le_of_levyProkhorovEDist_lt hedist hAmble + have hthick : thickening (ENNReal.ofReal c).toReal A ⊆ Bᶜ := by + rw [ENNReal.toReal_ofReal hcpos.le] + intro y hy + obtain ⟨z, hzA, hyz⟩ := Metric.mem_thickening_iff.mp hy + intro hyB + simp only [hB, mem_iUnion, exists_prop] at hyB + obtain ⟨x, hxF, hyx⟩ := hyB + apply hzA + simp only [mem_iUnion, exists_prop] + refine ⟨x, hxF, ?_⟩ + have h1 : dist z x ≤ dist z y + dist y x := dist_triangle z y x + have h2 : dist z y < c := by rwa [dist_comm] at hyz + have h3 : dist y x < η / 2 := hyx + have h4 : c ≤ η / 2 := min_le_right _ _ + exact Metric.mem_ball.mpr (by linarith) + calc ((u n).toMeasure : Measure Ω) A + ≤ ((u N).toMeasure : Measure Ω) + (thickening (ENNReal.ofReal c).toReal A) + ENNReal.ofReal c := key + _ ≤ ((u N).toMeasure : Measure Ω) (Bᶜ) + ENNReal.ofReal c := + add_le_add + (measure_mono (μ := ((u N).toMeasure : Measure Ω)) hthick) le_rfl + _ ≤ ENNReal.ofReal (δ / 2) + ENNReal.ofReal (δ / 2) := + add_le_add (hhead_le N le_rfl) + (ENNReal.ofReal_le_ofReal (min_le_left _ _)) + _ = ENNReal.ofReal δ := by + rw [← ENNReal.ofReal_add (by linarith) (by linarith)] + norm_num + +/-- A2 (**Node A**): a Lévy-Prokhorov Cauchy sequence of probability + measures on a Polish space is uniformly tight: the compact set is an + intersection of finite unions of closed balls at scales `2⁻ʲ`. -/ +theorem isTightMeasureSet_of_cauchySeq + (u : ℕ → LevyProkhorov (ProbabilityMeasure Ω)) (hu : CauchySeq u) : + IsTightMeasureSet {((u n).toMeasure : Measure Ω) | n : ℕ} := by + rw [isTightMeasureSet_iff_exists_isCompact_measure_compl_le] + intro ε hε + obtain ⟨e, he, heε⟩ : ∃ e : ℝ, 0 < e ∧ ENNReal.ofReal e ≤ ε := by + rcases eq_or_ne ε ∞ with rfl | hεtop + · exact ⟨1, one_pos, le_top⟩ + · exact ⟨ε.toReal, ENNReal.toReal_pos hε.ne' hεtop, + (ENNReal.ofReal_toReal hεtop).le⟩ + have hlayer : ∀ j : ℕ, ∃ F : Finset Ω, ∀ n, + ((u n).toMeasure : Measure Ω) + ((⋃ x ∈ F, ball x ((1 / 2 : ℝ) ^ j))ᶜ) + ≤ ENNReal.ofReal (e * (1 / 2 : ℝ) ^ (j + 1)) := by + intro j + refine cauchySeq_exists_finset_measure_ball_compl_le u hu ?_ ?_ + · positivity + · positivity + choose F hF using hlayer + set K : Set Ω := ⋂ j, ⋃ x ∈ F j, closedBall x ((1 / 2 : ℝ) ^ j) with hK + have hKclosed : IsClosed K := by + refine isClosed_iInter fun j => ?_ + exact (F j).finite_toSet.isClosed_biUnion fun x _ => isClosed_closedBall + have hKtb : TotallyBounded K := by + rw [Metric.totallyBounded_iff] + intro ρ hρ + obtain ⟨j, hj⟩ := exists_pow_lt_of_lt_one hρ (by norm_num : (1 / 2 : ℝ) < 1) + refine ⟨F j, (F j).finite_toSet, ?_⟩ + intro y hy + have hyj := mem_iInter.mp hy j + simp only [mem_iUnion, exists_prop] at hyj ⊢ + obtain ⟨x, hxF, hyx⟩ := hyj + exact ⟨x, hxF, Metric.mem_ball.mpr + (lt_of_le_of_lt (Metric.mem_closedBall.mp hyx) hj)⟩ + have hKcompact : IsCompact K := hKtb.isCompact_of_isClosed hKclosed + refine ⟨K, hKcompact, ?_⟩ + rintro μ ⟨n, rfl⟩ + have hlayer_le : ∀ j : ℕ, + ((u n).toMeasure : Measure Ω) + ((⋃ x ∈ F j, closedBall x ((1 / 2 : ℝ) ^ j))ᶜ) + ≤ ENNReal.ofReal (e * (1 / 2 : ℝ) ^ (j + 1)) := by + intro j + refine le_trans (measure_mono (compl_subset_compl.mpr ?_)) (hF j n) + exact iUnion₂_mono fun x _ => ball_subset_closedBall + have hgeom : (∑' j : ℕ, ENNReal.ofReal (e * (1 / 2 : ℝ) ^ (j + 1))) + = ENNReal.ofReal e := by + have hterm : ∀ j : ℕ, ENNReal.ofReal (e * (1 / 2 : ℝ) ^ (j + 1)) + = ENNReal.ofReal e * (2 : ℝ≥0∞)⁻¹ ^ (j + 1) := by + intro j + rw [ENNReal.ofReal_mul he.le, ENNReal.ofReal_pow (by norm_num)] + congr 2 + rw [show (1 / 2 : ℝ) = (2 : ℝ)⁻¹ by norm_num, + ENNReal.ofReal_inv_of_pos (by norm_num)] + norm_num + calc (∑' j : ℕ, ENNReal.ofReal (e * (1 / 2 : ℝ) ^ (j + 1))) + = ∑' j : ℕ, ENNReal.ofReal e * (2 : ℝ≥0∞)⁻¹ ^ (j + 1) := by + exact tsum_congr hterm + _ = ENNReal.ofReal e * ∑' j : ℕ, (2 : ℝ≥0∞)⁻¹ ^ (j + 1) := + ENNReal.tsum_mul_left + _ = ENNReal.ofReal e * ((2 : ℝ≥0∞)⁻¹ * (1 - 2⁻¹)⁻¹) := by + congr 1 + rw [show (∑' j : ℕ, (2 : ℝ≥0∞)⁻¹ ^ (j + 1)) + = ∑' j : ℕ, (2 : ℝ≥0∞)⁻¹ * (2 : ℝ≥0∞)⁻¹ ^ j by + exact tsum_congr fun j => by rw [pow_succ, mul_comm]] + rw [ENNReal.tsum_mul_left, ENNReal.tsum_geometric] + _ = ENNReal.ofReal e := by + rw [ENNReal.one_sub_inv_two, inv_inv, + ENNReal.inv_mul_cancel (by norm_num) (by norm_num), mul_one] + calc ((u n).toMeasure : Measure Ω) (Kᶜ) + = ((u n).toMeasure : Measure Ω) + (⋃ j, (⋃ x ∈ F j, closedBall x ((1 / 2 : ℝ) ^ j))ᶜ) := by + rw [hK, compl_iInter] + _ ≤ ∑' j : ℕ, ((u n).toMeasure : Measure Ω) + ((⋃ x ∈ F j, closedBall x ((1 / 2 : ℝ) ^ j))ᶜ) := + measure_iUnion_le _ + _ ≤ ∑' j : ℕ, ENNReal.ofReal (e * (1 / 2 : ℝ) ^ (j + 1)) := + ENNReal.tsum_le_tsum hlayer_le + _ = ENNReal.ofReal e := hgeom + _ ≤ ε := heε + +/-! ## Node C1: completeness of the Lévy-Prokhorov metric -/ + +/-- **Completeness of the Lévy-Prokhorov metric** on probability measures + over a Polish space: Cauchy sequences are uniformly tight (Node A), + Prokhorov's theorem gives a weakly convergent subsequence, and the + Lévy-Prokhorov topology agrees with the weak topology. -/ +instance : CompleteSpace (LevyProkhorov (ProbabilityMeasure Ω)) := by + refine Metric.complete_of_cauchySeq_tendsto fun u hu => ?_ + have htight := isTightMeasureSet_of_cauchySeq u hu + have hS : IsTightMeasureSet + {((μ : ProbabilityMeasure Ω) : Measure Ω) | + μ ∈ Set.range fun n => (u n).toMeasure} := by + have hset : {((μ : ProbabilityMeasure Ω) : Measure Ω) | + μ ∈ Set.range fun n => (u n).toMeasure} + = {((u n).toMeasure : Measure Ω) | n : ℕ} := by + ext m + constructor + · rintro ⟨μ, ⟨n, rfl⟩, rfl⟩ + exact ⟨n, rfl⟩ + · rintro ⟨n, rfl⟩ + exact ⟨(u n).toMeasure, ⟨n, rfl⟩, rfl⟩ + rw [hset] + exact htight + have hcpt : IsCompact (closure (Set.range fun n => (u n).toMeasure)) := + isCompact_closure_of_isTightMeasureSet hS + have hmem : ∀ n, (u n).toMeasure + ∈ closure (Set.range fun n => (u n).toMeasure) := + fun n => subset_closure ⟨n, rfl⟩ + obtain ⟨p, -, φ, hφmono, hφtendsto⟩ := hcpt.tendsto_subseq hmem + refine ⟨LevyProkhorov.ofMeasure p, ?_⟩ + have hcont : Continuous (LevyProkhorov.ofMeasure : + ProbabilityMeasure Ω → LevyProkhorov (ProbabilityMeasure Ω)) := + LevyProkhorov.continuous_ofMeasure_probabilityMeasure + have hsub : Tendsto (fun j => u (φ j)) atTop + (𝓝 (LevyProkhorov.ofMeasure p)) := by + have h := (hcont.tendsto p).comp hφtendsto + exact h + exact tendsto_nhds_of_cauchySeq_of_subseq hu hφmono.tendsto_atTop hsub + +/-! ## Node B: separability of the Lévy-Prokhorov metric + +The countable dense family consists of normalized mixtures of Dirac +measures with natural-number weights, at points of a countable dense +sequence. -/ + +/-- A normalized finite mixture of Dirac measures with natural weights; + falls back to `dirac x₀` when all weights vanish. -/ +def diracMix (x₀ : Ω) {N : ℕ} (x : Fin N → Ω) (a : Fin N → ℕ) : Measure Ω := + if (∑ i, a i) = 0 then Measure.dirac x₀ + else (∑ i, (a i : ℝ≥0∞))⁻¹ • ∑ i, (a i : ℝ≥0∞) • Measure.dirac (x i) + +omit [MetricSpace Ω] [SeparableSpace Ω] [CompleteSpace Ω] [BorelSpace Ω] in +theorem diracMix_sum_ne_zero (x₀ : Ω) {N : ℕ} (x : Fin N → Ω) (a : Fin N → ℕ) + (h : (∑ i, a i) ≠ 0) : + diracMix x₀ x a + = (∑ i, (a i : ℝ≥0∞))⁻¹ • ∑ i, (a i : ℝ≥0∞) • Measure.dirac (x i) := by + rw [diracMix, if_neg h] + +instance diracMix_isProbabilityMeasure (x₀ : Ω) {N : ℕ} + (x : Fin N → Ω) (a : Fin N → ℕ) : + IsProbabilityMeasure (diracMix x₀ x a) := by + rw [diracMix] + split + · infer_instance + · rename_i h + constructor + have hsum : (∑ i, (a i : ℝ≥0∞)) ≠ 0 := by + rw [← Nat.cast_sum] + exact_mod_cast h + have htop : (∑ i, (a i : ℝ≥0∞)) ≠ ∞ := by + rw [← Nat.cast_sum] + exact ENNReal.natCast_ne_top _ + rw [Measure.smul_apply, Measure.coe_finsetSum, Finset.sum_apply] + simp only [Measure.smul_apply, smul_eq_mul] + rw [show (∑ i, (a i : ℝ≥0∞) * Measure.dirac (x i) univ) + = ∑ i, (a i : ℝ≥0∞) by + refine Finset.sum_congr rfl fun i _ => ?_ + rw [measure_univ, mul_one]] + exact ENNReal.inv_mul_cancel hsum htop + +omit [MetricSpace Ω] [SeparableSpace Ω] [CompleteSpace Ω] [BorelSpace Ω] in +/-- Lower bound for a Dirac mixture on a measurable set: the normalized + weight of the atoms lying in the set, with any upper bound `m` on the + total weight. -/ +theorem le_diracMix_apply (x₀ : Ω) {N : ℕ} (x : Fin N → Ω) (a : Fin N → ℕ) + {m : ℕ} (hm : (∑ i, a i) ≤ m) (E : Set Ω) : + (m : ℝ≥0∞)⁻¹ * ∑ i ∈ Finset.univ.filter (fun i => x i ∈ E), (a i : ℝ≥0∞) + ≤ diracMix x₀ x a E := by + rcases eq_or_ne (∑ i, a i) 0 with hzero | hne + · have hall : ∀ i ∈ Finset.univ.filter (fun i => x i ∈ E), (a i : ℝ≥0∞) = 0 := by + intro i _ + have := Finset.sum_eq_zero_iff.mp hzero i (Finset.mem_univ i) + exact_mod_cast this + rw [Finset.sum_eq_zero hall, mul_zero] + exact zero_le + · rw [diracMix_sum_ne_zero x₀ x a hne] + have hstep : ∑ i ∈ Finset.univ.filter (fun i => x i ∈ E), (a i : ℝ≥0∞) + ≤ ∑ i, (a i : ℝ≥0∞) * Measure.dirac (x i) E := by + calc ∑ i ∈ Finset.univ.filter (fun i => x i ∈ E), (a i : ℝ≥0∞) + = ∑ i ∈ Finset.univ.filter (fun i => x i ∈ E), + (a i : ℝ≥0∞) * Measure.dirac (x i) E := by + refine Finset.sum_congr rfl fun i hi => ?_ + rw [Measure.dirac_apply_of_mem (Finset.mem_filter.mp hi).2, mul_one] + _ ≤ ∑ i, (a i : ℝ≥0∞) * Measure.dirac (x i) E := + Finset.sum_le_sum_of_subset_of_nonneg + (Finset.filter_subset _ _) (fun _ _ _ => zero_le) + have hinv : (m : ℝ≥0∞)⁻¹ ≤ (∑ i, (a i : ℝ≥0∞))⁻¹ := by + refine ENNReal.inv_le_inv.mpr ?_ + rw [← Nat.cast_sum] + exact_mod_cast hm + calc (m : ℝ≥0∞)⁻¹ * ∑ i ∈ Finset.univ.filter (fun i => x i ∈ E), (a i : ℝ≥0∞) + ≤ (∑ i, (a i : ℝ≥0∞))⁻¹ * ∑ i, (a i : ℝ≥0∞) * Measure.dirac (x i) E := + mul_le_mul' hinv hstep + _ = ((∑ i, (a i : ℝ≥0∞))⁻¹ • ∑ i, (a i : ℝ≥0∞) • Measure.dirac (x i)) E := by + rw [Measure.smul_apply, Measure.coe_finsetSum, Finset.sum_apply] + simp only [Measure.smul_apply, smul_eq_mul] + +omit [MetricSpace Ω] [SeparableSpace Ω] [CompleteSpace Ω] [BorelSpace Ω] in +/-- A probability measure exhausts any countable measurable cover: + some finite subfamily captures all but `ε` of the mass. -/ +theorem exists_measure_compl_partial_iUnion_lt + (μ : Measure Ω) [IsProbabilityMeasure μ] {s : ℕ → Set Ω} + (hs : ∀ n, MeasurableSet (s n)) (hcover : (⋃ n, s n) = univ) + {ε : ℝ≥0∞} (hε : 0 < ε) : + ∃ N : ℕ, μ ((⋃ j ∈ Finset.range N, s j)ᶜ) < ε := by + have hanti : Antitone fun M => (⋃ j ∈ Finset.range M, s j)ᶜ := by + intro M M' hMM' + apply compl_subset_compl.mpr + refine biUnion_subset_biUnion_left ?_ + intro j hj + simp only [Finset.coe_range, mem_Iio] at hj ⊢ + omega + have hinter : (⋂ M, (⋃ j ∈ Finset.range M, s j)ᶜ) = ∅ := by + rw [← compl_iUnion, + show (⋃ M, ⋃ j ∈ Finset.range M, s j) = ⋃ j, s j by + ext x + simp only [mem_iUnion, Finset.mem_range] + exact ⟨fun ⟨_, j, _, hx⟩ => ⟨j, hx⟩, fun ⟨j, hx⟩ => ⟨j + 1, j, by omega, hx⟩⟩, + hcover, compl_univ] + have htendsto : Tendsto (fun M => μ ((⋃ j ∈ Finset.range M, s j)ᶜ)) + atTop (𝓝 0) := by + have h := tendsto_measure_iInter_atTop + (μ := μ) (s := fun M => (⋃ j ∈ Finset.range M, s j)ᶜ) + (fun M => ((MeasurableSet.biUnion (Finset.range M).countable_toSet + fun j _ => hs j).compl).nullMeasurableSet) + hanti ⟨0, measure_ne_top μ _⟩ + rwa [hinter, measure_empty] at h + exact (htendsto.eventually_lt_const hε).exists + +omit [CompleteSpace Ω] in +/-- B1+B2: every probability measure on a Polish space is within `3ε` in + Lévy-Prokhorov distance of a normalized natural-weight Dirac mixture + at points of any dense sequence. -/ +theorem exists_diracMix_levyProkhorovDist_le + (μ : ProbabilityMeasure Ω) {D : ℕ → Ω} (hD : DenseRange D) + {ε : ℝ} (hε : 0 < ε) : + ∃ (N : ℕ) (a : Fin N → ℕ) (j : Fin N → ℕ), + levyProkhorovDist (μ : Measure Ω) + (diracMix (D 0) (fun i => D (j i)) a) ≤ 3 * ε := by + -- measurable partition with small diameters + obtain ⟨A, hAmble, hAbdd, hAdiam, hAcover, hAdisj⟩ := + SeparableSpace.exists_measurable_partition_diam_le (Ω := Ω) hε + -- finite head capturing all but ε of the mass + obtain ⟨N, hN⟩ := exists_measure_compl_partial_iUnion_lt + (μ : Measure Ω) hAmble hAcover (ε := ENNReal.ofReal ε) + (by rw [ENNReal.ofReal_pos]; exact hε) + -- atoms: dense points near each nonempty cell + have hsel : ∀ n : ℕ, ∃ k : ℕ, + (A n).Nonempty → ∃ p ∈ A n, dist (D k) p < ε := by + intro n + by_cases h : (A n).Nonempty + · obtain ⟨p, hp⟩ := h + obtain ⟨k, hk⟩ := Metric.denseRange_iff.mp hD p ε hε + exact ⟨k, fun _ => ⟨p, hp, by rwa [dist_comm] at hk⟩⟩ + · exact ⟨0, fun hne => absurd hne h⟩ + choose j hj using hsel + -- weights: floors of the rescaled masses, common denominator m + set m : ℕ := ⌈(N : ℝ) / ε⌉₊ + 1 with hm + have hmpos : 0 < m := Nat.succ_pos _ + have hmposR : (0 : ℝ) < m := by exact_mod_cast hmpos + set a : Fin N → ℕ := + fun i => ⌊((μ : Measure Ω) (A i)).toReal * m⌋₊ with ha + refine ⟨N, a, fun i => j i, ?_⟩ + set ν : Measure Ω := diracMix (D 0) (fun i : Fin N => D (j i)) a with hν + -- total weight is at most m + have hsum_le : (∑ i, a i) ≤ m := by + have hpart : (∑ n ∈ Finset.range N, (μ : Measure Ω) (A n)) ≤ 1 := by + rw [← measure_biUnion_finset + (fun i _ k _ hik => hAdisj hik) (fun n _ => hAmble n)] + exact prob_le_one + have hreal : (∑ n ∈ Finset.range N, ((μ : Measure Ω) (A n)).toReal) ≤ 1 := by + rw [← ENNReal.toReal_sum (fun n _ => measure_ne_top _ _)] + calc (∑ n ∈ Finset.range N, (μ : Measure Ω) (A n)).toReal + ≤ (1 : ℝ≥0∞).toReal := ENNReal.toReal_mono ENNReal.one_ne_top hpart + _ = 1 := ENNReal.toReal_one + have hcast : ((∑ i, a i : ℕ) : ℝ) ≤ m := by + push_cast + calc (∑ i : Fin N, (⌊((μ : Measure Ω) (A i)).toReal * m⌋₊ : ℝ)) + ≤ ∑ i : Fin N, ((μ : Measure Ω) (A i)).toReal * m := + Finset.sum_le_sum fun i _ => Nat.floor_le (by positivity) + _ = (∑ i : Fin N, ((μ : Measure Ω) (A i)).toReal) * m := by + rw [← Finset.sum_mul] + _ ≤ 1 * m := by + have hsum_range : + (∑ i : Fin N, ((μ : Measure Ω) (A i)).toReal) + = ∑ n ∈ Finset.range N, ((μ : Measure Ω) (A n)).toReal := + Fin.sum_univ_eq_sum_range + (fun n => ((μ : Measure Ω) (A n)).toReal) N + rw [hsum_range] + nlinarith [hreal] + _ = m := one_mul _ + exact_mod_cast hcast + -- per-cell mass bound by weights + have hterm : ∀ i : Fin N, (μ : Measure Ω) (A i) + ≤ ((a i : ℝ≥0∞) + 1) * (m : ℝ≥0∞)⁻¹ := by + intro i + have h1 : ((μ : Measure Ω) (A i)).toReal < ((a i : ℝ) + 1) / m := by + rw [lt_div_iff₀ hmposR] + exact_mod_cast Nat.lt_floor_add_one (((μ : Measure Ω) (A i)).toReal * m) + calc (μ : Measure Ω) (A i) + = ENNReal.ofReal (((μ : Measure Ω) (A i)).toReal) := + (ENNReal.ofReal_toReal (measure_ne_top _ _)).symm + _ ≤ ENNReal.ofReal (((a i : ℝ) + 1) / m) := + ENNReal.ofReal_le_ofReal h1.le + _ = ((a i : ℝ≥0∞) + 1) * (m : ℝ≥0∞)⁻¹ := by + rw [div_eq_mul_inv, ENNReal.ofReal_mul (by positivity), + ENNReal.ofReal_inv_of_pos hmposR] + congr 1 + · rw [show ((a i : ℝ) + 1) = (((a i + 1 : ℕ)) : ℝ) by push_cast; ring, + ENNReal.ofReal_natCast] + push_cast + ring + · rw [ENNReal.ofReal_natCast] + -- floors budget: N/m ≤ ε + have hNm : (N : ℝ≥0∞) * (m : ℝ≥0∞)⁻¹ ≤ ENNReal.ofReal ε := by + have hreal : (N : ℝ) / m ≤ ε := by + rw [div_le_iff₀ hmposR] + have hceil : (N : ℝ) / ε ≤ (⌈(N : ℝ) / ε⌉₊ : ℝ) := Nat.le_ceil _ + have hmge : ((⌈(N : ℝ) / ε⌉₊ : ℝ)) + 1 ≤ m := by + rw [hm]; push_cast; linarith + have hNe : ((N : ℝ) / ε) * ε = N := div_mul_cancel₀ _ hε.ne' + nlinarith + calc (N : ℝ≥0∞) * (m : ℝ≥0∞)⁻¹ + = ENNReal.ofReal ((N : ℝ) / m) := by + rw [div_eq_mul_inv, ENNReal.ofReal_mul (by positivity), + ENNReal.ofReal_inv_of_pos hmposR, ENNReal.ofReal_natCast, + ENNReal.ofReal_natCast] + _ ≤ ENNReal.ofReal ε := ENNReal.ofReal_le_ofReal hreal + -- the one-sided Lévy-Prokhorov estimate + refine levyProkhorovDist_le_of_forall_le (μ : Measure Ω) ν + (by positivity) (fun ε' B hε' hB => ?_) + have hεε' : 2 * ε < ε' := by linarith + set S : Finset (Fin N) := + Finset.univ.filter (fun i => (A (i : ℕ) ∩ B).Nonempty) with hS + -- atoms of cells meeting B land in the thickening + have hatoms : ∀ i ∈ S, D (j (i : ℕ)) ∈ thickening ε' B := by + intro i hiS + obtain ⟨b, hbA, hbB⟩ := (Finset.mem_filter.mp hiS).2 + obtain ⟨p, hpA, hpd⟩ := hj (i : ℕ) ⟨b, hbA⟩ + refine Metric.mem_thickening_iff.mpr ⟨b, hbB, ?_⟩ + have hdiam : dist p b ≤ ε := + le_trans (Metric.dist_le_diam_of_mem (hAbdd _) hpA hbA) (hAdiam _) + calc dist (D (j (i : ℕ))) b ≤ dist (D (j (i : ℕ))) p + dist p b := + dist_triangle _ _ _ + _ < ε + ε := by linarith + _ < ε' := by linarith + -- decompose μ B along the partition head + have hsplit : (μ : Measure Ω) B + ≤ (∑ i ∈ S, (μ : Measure Ω) (A (i : ℕ))) + ENNReal.ofReal ε := by + have hsubset : B ⊆ (⋃ i : Fin N, (A (i : ℕ) ∩ B)) + ∪ (⋃ n ∈ Finset.range N, A n)ᶜ := by + intro pt hpt + by_cases hin : pt ∈ ⋃ n ∈ Finset.range N, A n + · left + simp only [mem_iUnion, Finset.mem_range, exists_prop] at hin + obtain ⟨n, hnN, hptn⟩ := hin + exact mem_iUnion.mpr ⟨⟨n, hnN⟩, hptn, hpt⟩ + · right + exact hin + calc (μ : Measure Ω) B + ≤ (μ : Measure Ω) ((⋃ i : Fin N, (A (i : ℕ) ∩ B)) + ∪ (⋃ n ∈ Finset.range N, A n)ᶜ) := measure_mono hsubset + _ ≤ (μ : Measure Ω) (⋃ i : Fin N, (A (i : ℕ) ∩ B)) + + (μ : Measure Ω) ((⋃ n ∈ Finset.range N, A n)ᶜ) := + measure_union_le _ _ + _ ≤ (∑ i : Fin N, (μ : Measure Ω) (A (i : ℕ) ∩ B)) + ENNReal.ofReal ε := + add_le_add (measure_iUnion_fintype_le _ _) hN.le + _ ≤ (∑ i ∈ S, (μ : Measure Ω) (A (i : ℕ))) + ENNReal.ofReal ε := by + refine add_le_add ?_ le_rfl + rw [show (∑ i : Fin N, (μ : Measure Ω) (A (i : ℕ) ∩ B)) + = ∑ i ∈ S, (μ : Measure Ω) (A (i : ℕ) ∩ B) from + (Finset.sum_subset (Finset.filter_subset _ _) fun i _ hiS => by + rw [Finset.mem_filter, not_and] at hiS + rw [Set.not_nonempty_iff_eq_empty.mp + (hiS (Finset.mem_univ i)), measure_empty]).symm] + exact Finset.sum_le_sum fun i _ => + measure_mono inter_subset_left + -- cell masses against the mixture on the thickening + have hmass : (∑ i ∈ S, (μ : Measure Ω) (A (i : ℕ))) + ≤ ν (thickening ε' B) + ENNReal.ofReal ε := by + calc (∑ i ∈ S, (μ : Measure Ω) (A (i : ℕ))) + ≤ ∑ i ∈ S, ((a i : ℝ≥0∞) + 1) * (m : ℝ≥0∞)⁻¹ := + Finset.sum_le_sum fun i _ => hterm i + _ = (∑ i ∈ S, (a i : ℝ≥0∞)) * (m : ℝ≥0∞)⁻¹ + + (S.card : ℝ≥0∞) * (m : ℝ≥0∞)⁻¹ := by + rw [← Finset.sum_mul, ← add_mul] + congr 1 + rw [Finset.sum_add_distrib] + simp + _ ≤ (m : ℝ≥0∞)⁻¹ * (∑ i ∈ Finset.univ.filter + (fun i : Fin N => D (j (i : ℕ)) ∈ thickening ε' B), (a i : ℝ≥0∞)) + + (N : ℝ≥0∞) * (m : ℝ≥0∞)⁻¹ := by + refine add_le_add ?_ ?_ + · rw [mul_comm] + refine mul_le_mul' le_rfl ?_ + refine Finset.sum_le_sum_of_subset_of_nonneg ?_ + (fun _ _ _ => zero_le) + intro i hiS + rw [Finset.mem_filter] + exact ⟨Finset.mem_univ i, hatoms i hiS⟩ + · refine mul_le_mul' ?_ le_rfl + have hcard : S.card ≤ N := by + calc S.card ≤ (Finset.univ : Finset (Fin N)).card := + Finset.card_le_card (Finset.subset_univ S) + _ = N := by simp + exact_mod_cast hcard + _ ≤ ν (thickening ε' B) + ENNReal.ofReal ε := by + refine add_le_add ?_ hNm + exact le_diracMix_apply (D 0) _ a hsum_le _ + -- assemble + calc (μ : Measure Ω) B + ≤ (∑ i ∈ S, (μ : Measure Ω) (A (i : ℕ))) + ENNReal.ofReal ε := hsplit + _ ≤ (ν (thickening ε' B) + ENNReal.ofReal ε) + ENNReal.ofReal ε := + add_le_add hmass le_rfl + _ = ν (thickening ε' B) + ENNReal.ofReal (ε + ε) := by + rw [add_assoc, ENNReal.ofReal_add hε.le hε.le] + _ ≤ ν (thickening ε' B) + ENNReal.ofReal ε' := + add_le_add le_rfl (ENNReal.ofReal_le_ofReal (by linarith)) + +/-! ## Node B → C2: separability and the Polish instance for the LP space -/ + +instance : SeparableSpace (LevyProkhorov (ProbabilityMeasure Ω)) := by + rcases isEmpty_or_nonempty Ω with hΩ | hΩ + · haveI : IsEmpty (ProbabilityMeasure Ω) := by + constructor + intro μ + have h1 : (μ : Measure Ω) univ = 1 := measure_univ + rw [Set.univ_eq_empty_iff.mpr hΩ, measure_empty] at h1 + exact zero_ne_one h1 + haveI : IsEmpty (LevyProkhorov (ProbabilityMeasure Ω)) := + ⟨fun x => IsEmpty.elim ‹_› x.toMeasure⟩ + exact ⟨⟨∅, countable_empty, by + rw [dense_iff_closure_eq, closure_empty] + exact (Set.univ_eq_empty_iff.mpr ‹_›).symm⟩⟩ + · obtain ⟨D, hD⟩ := exists_dense_seq Ω + set Φ : (Σ N : ℕ, (Fin N → ℕ) × (Fin N → ℕ)) + → LevyProkhorov (ProbabilityMeasure Ω) := + fun p => LevyProkhorov.ofMeasure + (⟨diracMix (D 0) (fun i => D (p.2.2 i)) p.2.1, inferInstance⟩ : + ProbabilityMeasure Ω) with hΦ + refine ⟨⟨Set.range Φ, countable_range Φ, ?_⟩⟩ + have hdr : DenseRange Φ := by + rw [Metric.denseRange_iff] + intro x r hr + obtain ⟨N, a, j, hle⟩ := exists_diracMix_levyProkhorovDist_le + (x.toMeasure) hD (ε := r / 4) (by linarith) + refine ⟨⟨N, a, j⟩, ?_⟩ + have hdist_eq : dist (Φ ⟨N, a, j⟩) x + = levyProkhorovDist + (diracMix (D 0) (fun i => D (j i)) a) + ((x.toMeasure : ProbabilityMeasure Ω) : Measure Ω) := rfl + rw [dist_comm, hdist_eq, levyProkhorovDist_comm] + calc levyProkhorovDist + ((x.toMeasure : ProbabilityMeasure Ω) : Measure Ω) + (diracMix (D 0) (fun i => D (j i)) a) ≤ 3 * (r / 4) := hle + _ < r := by linarith + exact hdr + +instance : SecondCountableTopology (LevyProkhorov (ProbabilityMeasure Ω)) := + UniformSpace.secondCountable_of_separable _ + +/-- C2: the Lévy-Prokhorov space of probability measures over a Polish + space is Polish (complete + separable metric). -/ +instance : PolishSpace (LevyProkhorov (ProbabilityMeasure Ω)) := by + infer_instance + +/-! ## C3: transfer along the homeomorphism -/ + +/-- **W1, final form**: the space of probability measures on a Polish + space, with the topology of weak convergence, is Polish. -/ +instance ProbabilityMeasure.instPolishSpace + {X : Type*} [TopologicalSpace X] [PolishSpace X] + [MeasurableSpace X] [BorelSpace X] : + PolishSpace (ProbabilityMeasure X) := by + letI := TopologicalSpace.upgradeIsCompletelyMetrizable X + exact (LevyProkhorov.probabilityMeasureHomeomorph + (Ω := X)).isClosedEmbedding.polishSpace + +/-! ## W2: the Giry σ-algebra is contained in the Borel σ-algebra of the + weak topology + +The evaluation maps `γ ↦ γ s` are Borel on `ProbabilityMeasure Ω`: +continuous test integrals give closed sets (outer approximation), and a +π-λ induction extends to all Borel sets. Consequently the coercion to +`Measure Ω` (with its Giry σ-algebra) is Borel-measurable — this is what +lets `ProbabilityMeasure Ω` act as a parameter space for kernels. -/ + +omit [SeparableSpace Ω] [CompleteSpace Ω] in +/-- Integration of a bounded continuous test function is continuous in the + measure, for the topology of weak convergence. -/ +theorem probabilityMeasure_continuous_lintegral (f : BoundedContinuousFunction Ω ℝ≥0) : + Continuous fun γ : ProbabilityMeasure Ω => + ∫⁻ x, (f x : ℝ≥0∞) ∂(γ : Measure Ω) := by + have heq : (fun γ : ProbabilityMeasure Ω => + ∫⁻ x, (f x : ℝ≥0∞) ∂(γ : Measure Ω)) + = fun γ => ((γ.toFiniteMeasure.testAgainstNN f : ℝ≥0) : ℝ≥0∞) := by + funext γ + rw [FiniteMeasure.testAgainstNN_coe_eq] + rfl + rw [heq] + exact ENNReal.continuous_coe.comp + ((FiniteMeasure.continuous_testAgainstNN_eval f).comp + (ProbabilityMeasure.toFiniteMeasure_isEmbedding Ω).continuous) + +omit [SeparableSpace Ω] [CompleteSpace Ω] in +/-- The measure of a closed set is a Borel function of the measure. -/ +theorem probabilityMeasure_borel_measurable_apply_isClosed + {F : Set Ω} (hF : IsClosed F) : + @Measurable (ProbabilityMeasure Ω) ℝ≥0∞ + (borel (ProbabilityMeasure Ω)) inferInstance + (fun γ => (γ : Measure Ω) F) := by + letI : MeasurableSpace (ProbabilityMeasure Ω) := borel _ + haveI : BorelSpace (ProbabilityMeasure Ω) := ⟨rfl⟩ + have hlim : Tendsto + (fun n => fun γ : ProbabilityMeasure Ω => + ∫⁻ x, (hF.apprSeq n x : ℝ≥0∞) ∂(γ : Measure Ω)) + atTop (𝓝 fun γ => (γ : Measure Ω) F) := by + rw [tendsto_pi_nhds] + intro γ + exact HasOuterApproxClosed.tendsto_lintegral_apprSeq hF (γ : Measure Ω) + exact measurable_of_tendsto_metrizable + (fun n => (probabilityMeasure_continuous_lintegral (hF.apprSeq n)).measurable) + hlim + +omit [SeparableSpace Ω] [CompleteSpace Ω] in +/-- The measure of any Borel set is a Borel function of the measure + (π-λ induction from the closed sets). -/ +theorem probabilityMeasure_borel_measurable_apply + {s : Set Ω} (hs : MeasurableSet s) : + @Measurable (ProbabilityMeasure Ω) ℝ≥0∞ + (borel (ProbabilityMeasure Ω)) inferInstance + (fun γ => (γ : Measure Ω) s) := by + letI : MeasurableSpace (ProbabilityMeasure Ω) := borel _ + haveI : BorelSpace (ProbabilityMeasure Ω) := ⟨rfl⟩ + induction s, hs using MeasurableSpace.induction_on_inter + (m := (inferInstance : MeasurableSpace Ω)) + (s := {t : Set Ω | IsClosed t}) + ((BorelSpace.measurable_eq (α := Ω)).trans borel_eq_generateFrom_isClosed) + isPiSystem_isClosed with + | empty => + simp only [measure_empty] + exact measurable_const + | basic t ht => + exact probabilityMeasure_borel_measurable_apply_isClosed ht + | compl t htm iht => + have heq : (fun γ : ProbabilityMeasure Ω => (γ : Measure Ω) tᶜ) + = fun γ : ProbabilityMeasure Ω => 1 - (γ : Measure Ω) t := by + funext γ + rw [prob_compl_eq_one_sub htm] + rw [heq] + exact measurable_const.sub iht + | iUnion f hdisj hfm ihf => + have heq : (fun γ : ProbabilityMeasure Ω => (γ : Measure Ω) (⋃ n, f n)) + = fun γ : ProbabilityMeasure Ω => ∑' n, (γ : Measure Ω) (f n) := by + funext γ + exact measure_iUnion hdisj hfm + rw [heq] + exact Measurable.tsum ihf + +omit [SeparableSpace Ω] [CompleteSpace Ω] in +/-- **W2**: the coercion from probability measures (Borel σ-algebra of the + weak topology) to measures (Giry σ-algebra) is measurable. -/ +theorem probabilityMeasure_borel_measurable_toMeasure : + @Measurable (ProbabilityMeasure Ω) (Measure Ω) + (borel (ProbabilityMeasure Ω)) inferInstance + ((↑) : ProbabilityMeasure Ω → Measure Ω) := by + letI : MeasurableSpace (ProbabilityMeasure Ω) := borel _ + exact Measure.measurable_measure.mpr + fun s hs => probabilityMeasure_borel_measurable_apply hs + +end + +/-! ## The Giry-valued equalizer + +Companion to W2: for measurable families of probability measures, the set +where two families agree is measurable. This is what makes the feasibility +correspondences of the Bellman recursion Borel. -/ + +noncomputable section + +/-- The π-system generated by a countable collection of sets is countable: + every element of `generatePiSystem S` is the intersection `⋂₀ T` of a + finite subcollection `T ⊆ S`. -/ +theorem countable_generatePiSystem {α : Type*} {S : Set (Set α)} + (hS : S.Countable) : (generatePiSystem S).Countable := by + refine ((countable_ofPred_finite_subset hS).image fun T => ⋂₀ T).mono + fun t ht => ?_ + induction ht with + | base h_s => + exact ⟨{_}, ⟨finite_singleton _, singleton_subset_iff.mpr h_s⟩, + sInter_singleton _⟩ + | inter _ _ _ ih_s ih_u => + obtain ⟨T₁, ⟨hT₁fin, hT₁sub⟩, rfl⟩ := ih_s + obtain ⟨T₂, ⟨hT₂fin, hT₂sub⟩, rfl⟩ := ih_u + exact ⟨T₁ ∪ T₂, ⟨hT₁fin.union hT₂fin, union_subset hT₁sub hT₂sub⟩, + sInter_union T₁ T₂⟩ + +/-- **Giry-valued equalizer.** If `F G : α → Measure W` are measurable + families of probability measures on a Polish space `W`, then + `{a | F a = G a}` is measurable: two probability measures coincide as + soon as they agree on the countable π-system generated by a countable + topological basis (`ext_of_generate_finite`), so the equalizer is a + countable intersection of measurable `ℝ≥0∞`-equalizers. -/ +theorem measurableSet_eq_measure {α : Type*} [MeasurableSpace α] {W : Type*} + [TopologicalSpace W] [PolishSpace W] [MeasurableSpace W] [BorelSpace W] + {F G : α → Measure W} (hF : Measurable F) (hG : Measurable G) + (hFfin : ∀ a, IsProbabilityMeasure (F a)) + (hGfin : ∀ a, IsProbabilityMeasure (G a)) : + MeasurableSet {a | F a = G a} := by + have hCcnt : (generatePiSystem (countableBasis W)).Countable := + countable_generatePiSystem (countable_countableBasis W) + have hCpi : IsPiSystem (generatePiSystem (countableBasis W)) := + isPiSystem_generatePiSystem _ + have hCgen : ‹MeasurableSpace W› = + MeasurableSpace.generateFrom (generatePiSystem (countableBasis W)) := by + rw [generateFrom_generatePiSystem_eq, + ← (isBasis_countableBasis W).borel_eq_generateFrom] + exact ‹BorelSpace W›.measurable_eq + have hCmeas : ∀ s ∈ generatePiSystem (countableBasis W), MeasurableSet s := + fun s hs => generatePiSystem_measurableSet + (fun _ hu => (isOpen_of_mem_countableBasis hu).measurableSet) s hs + have hset : {a | F a = G a} = + ⋂ s ∈ generatePiSystem (countableBasis W), {a | F a s = G a s} := by + ext a + simp only [mem_ofPred_eq, mem_iInter] + refine ⟨fun h s _ => by rw [h], fun h => ?_⟩ + haveI := hFfin a + exact ext_of_generate_finite _ hCgen hCpi h + (by rw [(hFfin a).measure_univ, (hGfin a).measure_univ]) + rw [hset] + exact MeasurableSet.biInter hCcnt fun s hs => + measurableSet_eq_fun ((Measure.measurable_coe (hCmeas s hs)).comp hF) + ((Measure.measurable_coe (hCmeas s hs)).comp hG) + +end diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Tree.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Tree.lean new file mode 100644 index 0000000000..0c0fd6e020 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Tree.lean @@ -0,0 +1,319 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Jankov-von Neumann Uniformization — Full Proof + + Reference: Kechris, Classical Descriptive Set Theory, §2 + Theorem 18.1. + + The infrastructure is generic: domain X (Polish), codomain ℕ → ℕ. + The leftmost branch operates only on the codomain. +-/ +import Mathlib.Topology.MetricSpace.Polish +import Mathlib.Topology.MetricSpace.PiNat +import Mathlib.MeasureTheory.Constructions.Polish.Basic +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSigmaAlgebra + +open Set Topology MeasureTheory +open scoped Classical + +noncomputable section + +variable {X : Type*} [TopologicalSpace X] + +/-! ## Part I: Fibers (generic domain X, codomain ℕᴺ) -/ + +def closedFiberG (F : Set (X × (ℕ → ℕ))) (x : X) : Set (ℕ → ℕ) := + { y | (x, y) ∈ F } + +omit [TopologicalSpace X] in +theorem closedFiberG_nonempty_iff (F : Set (X × (ℕ → ℕ))) (x : X) : + (closedFiberG F x).Nonempty ↔ x ∈ Prod.fst '' F := by + constructor + · rintro ⟨y, hy⟩; exact ⟨(x, y), hy, rfl⟩ + · rintro ⟨⟨x', y⟩, hm, hx⟩; simp at hx; exact ⟨y, hx ▸ hm⟩ + +theorem isClosed_closedFiberG {F : Set (X × (ℕ → ℕ))} (hF : IsClosed F) (x : X) : + IsClosed (closedFiberG F x) := + hF.preimage (Continuous.prodMk continuous_const continuous_id) + +/-! ## Part II: Leftmost branch (generic domain) -/ + +def fiberRestNG (F : Set (X × (ℕ → ℕ))) (x : X) (f : ℕ → ℕ) (n : ℕ) : Set (ℕ → ℕ) := + { y | (x, y) ∈ F ∧ ∀ i < n, y i = f i } + +omit [TopologicalSpace X] in +theorem fiberRestNG_zero (F : Set (X × (ℕ → ℕ))) (x : X) (f : ℕ → ℕ) : + fiberRestNG F x f 0 = closedFiberG F x := by + ext y; simp [fiberRestNG, closedFiberG] + +omit [TopologicalSpace X] in +theorem exists_extNG {F : Set (X × (ℕ → ℕ))} {x : X} {f : ℕ → ℕ} {n : ℕ} + (hne : (fiberRestNG F x f n).Nonempty) : + ∃ k, (fiberRestNG F x (Function.update f n k) (n + 1)).Nonempty := by + obtain ⟨y, hy_mem, hy_ext⟩ := hne + refine ⟨y n, y, hy_mem, fun i hi => ?_⟩ + rcases Nat.lt_succ_iff_lt_or_eq.mp hi with h | h + · rw [Function.update_of_ne (by omega)]; exact hy_ext i h + · subst h; simp [Function.update_self] + +def leftmostAuxG (F : Set (X × (ℕ → ℕ))) (x : X) + (h₀ : (closedFiberG F x).Nonempty) : + (n : ℕ) → { f : ℕ → ℕ // (fiberRestNG F x f n).Nonempty } + | 0 => ⟨fun _ => 0, fiberRestNG_zero F x _ ▸ h₀⟩ + | n + 1 => + let ⟨f, hf⟩ := leftmostAuxG F x h₀ n + ⟨Function.update f n (Nat.find (exists_extNG hf)), + Nat.find_spec (exists_extNG hf)⟩ + +def leftmostBranchG (F : Set (X × (ℕ → ℕ))) (x : X) + (h₀ : (closedFiberG F x).Nonempty) (n : ℕ) : ℕ := + Nat.find (exists_extNG (leftmostAuxG F x h₀ n).2) + +omit [TopologicalSpace X] in +theorem leftmostAuxG_eq (F : Set (X × (ℕ → ℕ))) (x : X) + (h₀ : (closedFiberG F x).Nonempty) : + ∀ n i, i < n → (leftmostAuxG F x h₀ n).val i = leftmostBranchG F x h₀ i := by + intro n; induction n with + | zero => intro i hi; omega + | succ n ih => + intro i hi + simp only [leftmostAuxG, leftmostBranchG] + rcases Nat.lt_succ_iff_lt_or_eq.mp hi with h | h + · rw [Function.update_of_ne (by omega)]; exact ih i h + · subst h; simp [Function.update_self] + +def leftmostWitnessG (F : Set (X × (ℕ → ℕ))) (x : X) + (h₀ : (closedFiberG F x).Nonempty) (n : ℕ) : ℕ → ℕ := + (leftmostAuxG F x h₀ n).2.some + +omit [TopologicalSpace X] in +theorem leftmostWitnessG_mem (F : Set (X × (ℕ → ℕ))) (x : X) (h₀ n) : + leftmostWitnessG F x h₀ n ∈ closedFiberG F x := + ((leftmostAuxG F x h₀ n).2.some_mem).1 + +omit [TopologicalSpace X] in +theorem leftmostWitnessG_agrees (F : Set (X × (ℕ → ℕ))) (x : X) (h₀ n i) (hi : i < n) : + leftmostWitnessG F x h₀ n i = leftmostBranchG F x h₀ i := by + have := ((leftmostAuxG F x h₀ n).2.some_mem).2 i hi + rw [leftmostAuxG_eq F x h₀ n i hi] at this; exact this + +theorem leftmostBranchG_mem + {F : Set (X × (ℕ → ℕ))} (hF : IsClosed F) (x : X) + (h₀ : (closedFiberG F x).Nonempty) : + (x, leftmostBranchG F x h₀) ∈ F := + (isClosed_closedFiberG hF x).mem_of_tendsto + (tendsto_pi_nhds.mpr fun i => by + rw [congr_fun (nhds_discrete ℕ) _] + exact Filter.tendsto_pure.mpr (Filter.eventually_atTop.mpr + ⟨i + 1, fun n hn => leftmostWitnessG_agrees F x h₀ n i (by omega)⟩)) + (Filter.Eventually.of_forall (leftmostWitnessG_mem F x h₀)) + +omit [TopologicalSpace X] in +theorem leftmostBranchG_least (F : Set (X × (ℕ → ℕ))) (x : X) + (h₀ : (closedFiberG F x).Nonempty) (n k : ℕ) + (hk : k < leftmostBranchG F x h₀ n) : + ¬(fiberRestNG F x (Function.update (leftmostAuxG F x h₀ n).val n k) (n + 1)).Nonempty := + Nat.find_min (exists_extNG (leftmostAuxG F x h₀ n).2) hk + +/-! ## Part III: Fiber-cylinder projections (generic domain) -/ + +def projFiberCylNG (F : Set (X × (ℕ → ℕ))) (f : ℕ → ℕ) (n : ℕ) : Set X := + { x | (fiberRestNG F x f n).Nonempty } + +theorem analyticSet_projFiberCylNG [PolishSpace X] + {F : Set (X × (ℕ → ℕ))} (hF : IsClosed F) (f : ℕ → ℕ) (n : ℕ) : + AnalyticSet (projFiberCylNG F f n) := by + have : projFiberCylNG F f n = + Prod.fst '' (F ∩ (univ ×ˢ ⋂ (i : Fin n), { y : ℕ → ℕ | y i = f i })) := by + ext x; simp only [projFiberCylNG, fiberRestNG, mem_ofPred_eq, mem_image, Prod.exists, + mem_inter_iff, mem_prod, mem_univ, true_and, mem_iInter] + constructor + · rintro ⟨y, h1, h2⟩; exact ⟨x, y, ⟨h1, fun ⟨i, hi⟩ => h2 i hi⟩, rfl⟩ + · rintro ⟨_, y, ⟨h1, h2⟩, rfl⟩; exact ⟨y, h1, fun i hi => h2 ⟨i, hi⟩⟩ + rw [this] + exact (hF.inter (IsClosed.prod isClosed_univ (isClosed_iInter fun (i : Fin n) => + isClosed_eq (continuous_apply (i : ℕ)) continuous_const)) + ).analyticSet.image_of_continuous continuous_fst + +/-! ## Part IV: Closed uniformizer (generic domain) -/ + +def closedUniformizerG (F : Set (X × (ℕ → ℕ))) (_hF : IsClosed F) + (hne : F.Nonempty) : X → (ℕ → ℕ) := + fun x => if h : (closedFiberG F x).Nonempty then leftmostBranchG F x h + else hne.some.2 + +theorem closedUniformizerG_selection + {F : Set (X × (ℕ → ℕ))} (hF : IsClosed F) (hne : F.Nonempty) + {x : X} (hx : x ∈ Prod.fst '' F) : + (x, closedUniformizerG F hF hne x) ∈ F := by + simp only [closedUniformizerG, dif_pos ((closedFiberG_nonempty_iff F x).mpr hx)] + exact leftmostBranchG_mem hF x _ + +theorem closedUniformizerG_cylinder_eq [PolishSpace X] + {F : Set (X × (ℕ → ℕ))} (hF : IsClosed F) (hne : F.Nonempty) + (f : ℕ → ℕ) (n : ℕ) : + { x | ∀ i < n, closedUniformizerG F hF hne x i = f i } = + (projFiberCylNG F f n ∩ + ⋂ (m : Fin n), ⋂ (j : Fin (f m)), + (projFiberCylNG F (Function.update f m j) (↑m + 1))ᶜ) ∪ + ((Prod.fst '' F)ᶜ ∩ { _x | ∀ i < n, hne.some.2 i = f i }) := by + ext x + simp only [mem_ofPred_eq, mem_union, mem_inter_iff, mem_iInter, mem_compl_iff, + projFiberCylNG, fiberRestNG, mem_ofPred_eq] + constructor + · intro hx + by_cases hcf : (closedFiberG F x).Nonempty + · left + have hx' : ∀ i < n, leftmostBranchG F x hcf i = f i := by + intro i hi; have := hx i hi + simp only [closedUniformizerG, dif_pos hcf] at this; exact this + constructor + · have := (leftmostAuxG F x hcf n).2; rw [fiberRestNG] at this + obtain ⟨y, hy_mem, hy_ext⟩ := this + exact ⟨y, hy_mem, fun i hi => + (hy_ext i hi).trans ((leftmostAuxG_eq F x hcf n i hi).trans (hx' i hi))⟩ + · intro ⟨m, hm⟩ ⟨j, hj⟩ hmem + apply leftmostBranchG_least F x hcf m j (by rw [hx' m hm]; exact hj) + obtain ⟨y, hy_mem, hy_ext⟩ := hmem + refine ⟨y, hy_mem, fun i hi => ?_⟩ + have hye := hy_ext i hi + rcases Nat.lt_succ_iff_lt_or_eq.mp hi with h | h + · rw [Function.update_of_ne (show (i : ℕ) ≠ m from by omega)] at hye ⊢ + rwa [leftmostAuxG_eq F x hcf m i h, hx' i (by omega)] + · subst h; rwa [Function.update_self] at hye ⊢ + · right + exact ⟨fun h => hcf ((closedFiberG_nonempty_iff F x).mpr h), + fun i hi => by have := hx i hi; simp [closedUniformizerG, dif_neg hcf] at this; exact this⟩ + · rintro (⟨hproj, hmin⟩ | ⟨hnotproj, hdef⟩) + · intro i hi + simp only [closedUniformizerG] + split + · next hcf => + suffices key : ∀ j < n, leftmostBranchG F x hcf j = f j from key i hi + intro j hj + induction j using Nat.strongRecOn with + | _ j IH => + apply le_antisymm + · apply Nat.find_min' + obtain ⟨y, hy_mem, hy_ext⟩ := hproj + exact ⟨y, hy_mem, fun k hk => by + rcases Nat.lt_succ_iff_lt_or_eq.mp hk with hlt | heq + · rw [Function.update_of_ne (by omega), + leftmostAuxG_eq F x hcf j k hlt, IH k hlt (by omega)] + exact hy_ext k (by omega) + · rw [heq, Function.update_self]; exact hy_ext _ (by omega)⟩ + · by_contra hlt; rw [not_le] at hlt + have hspec := Nat.find_spec (exists_extNG (leftmostAuxG F x hcf j).2) + obtain ⟨y', hy'_mem, hy'_ext⟩ := hspec + have hmemN : x ∈ projFiberCylNG F + (Function.update f j (leftmostBranchG F x hcf j)) (j + 1) := + ⟨y', hy'_mem, fun k hk => by + have hye := hy'_ext k hk + rcases Nat.lt_succ_iff_lt_or_eq.mp hk with hlt' | heq + · rw [Function.update_of_ne (by omega)] at hye ⊢ + rw [leftmostAuxG_eq F x hcf j k hlt', IH k hlt' (by omega)] at hye + exact hye + · rw [heq, Function.update_self] at hye ⊢; exact hye⟩ + exact absurd hmemN (hmin ⟨j, hj⟩ ⟨leftmostBranchG F x hcf j, hlt⟩) + · next hncf => + exfalso; apply hncf + obtain ⟨y, hy_mem, _⟩ := hproj; exact ⟨y, hy_mem⟩ + · intro i hi + simp only [closedUniformizerG, dif_neg (by + intro h; exact hnotproj ((closedFiberG_nonempty_iff F x).mp h))] + exact hdef i hi + +theorem closedUniformizerG_cylinder_measurable [PolishSpace X] + {F : Set (X × (ℕ → ℕ))} (hF : IsClosed F) (hne : F.Nonempty) + (f : ℕ → ℕ) (n : ℕ) : + @MeasurableSet _ (analyticMeasurableSpace X) + { x | ∀ i < n, closedUniformizerG F hF hne x i = f i } := by + rw [closedUniformizerG_cylinder_eq hF hne f n] + apply MeasurableSet.union + · apply MeasurableSet.inter + · exact (analyticSet_projFiberCylNG hF f n).mem_analyticMeasurableSpace + · exact MeasurableSet.iInter fun m => + MeasurableSet.iInter fun j => + (analyticSet_projFiberCylNG hF _ _).compl_mem_analyticMeasurableSpace + · apply MeasurableSet.inter + · exact (hF.analyticSet.image_of_continuous continuous_fst).compl_mem_analyticMeasurableSpace + · by_cases h : ∀ i < n, hne.some.2 i = f i + · have : {x : X | ∀ i < n, hne.some.2 i = f i} = univ := by + ext; simp only [mem_ofPred_eq, mem_univ, iff_true]; exact fun _ hh => h _ hh + rw [this]; exact @MeasurableSet.univ _ (analyticMeasurableSpace X) + · have : {x : X | ∀ i < n, hne.some.2 i = f i} = ∅ := by + ext; simp only [mem_ofPred_eq, mem_empty_iff_false, iff_false] + exact fun h' => h (fun i hi => h' i hi) + rw [this]; exact @MeasurableSet.empty _ (analyticMeasurableSpace X) + +/-! ## Part V: σ(Σ₁¹)-measurability (generic domain) -/ + +theorem closedUniformizerG_analyticallyMeasurable [PolishSpace X] + {F : Set (X × (ℕ → ℕ))} (hF : IsClosed F) (hne : F.Nonempty) : + AnalyticallyMeasurable (closedUniformizerG F hF hne) := by + have hgen : borel (ℕ → ℕ) = MeasurableSpace.generateFrom + { s | ∃ (x : ℕ → ℕ) (n : ℕ), s = PiNat.cylinder x n } := + (PiNat.isTopologicalBasis_cylinders (E := fun _ => ℕ)).borel_eq_generateFrom + rw [AnalyticallyMeasurable, hgen] + intro s hs + induction hs with + | basic s hs => + obtain ⟨f, n, rfl⟩ := hs + have : closedUniformizerG F hF hne ⁻¹' PiNat.cylinder f n = + {x | ∀ i < n, closedUniformizerG F hF hne x i = f i} := by + ext x; simp only [mem_preimage, PiNat.mem_cylinder_iff, mem_ofPred_eq] + rw [this]; exact closedUniformizerG_cylinder_measurable hF hne f n + | empty => exact @MeasurableSet.empty _ (analyticMeasurableSpace X) + | compl _ _ ih => exact ih.compl + | iUnion _ _ ih => rw [preimage_iUnion]; exact .iUnion ih + +/-! ## Part VI: JVN for closed sets (generic domain) -/ + +theorem jvn_closedG [PolishSpace X] + {F : Set (X × (ℕ → ℕ))} (hF : IsClosed F) (hne : F.Nonempty) : + ∃ (φ : X → (ℕ → ℕ)), AnalyticallyMeasurable φ ∧ + ∀ x ∈ Prod.fst '' F, (x, φ x) ∈ F := + ⟨closedUniformizerG F hF hne, + closedUniformizerG_analyticallyMeasurable hF hne, + fun _ hx => closedUniformizerG_selection hF hne hx⟩ + +/-! ## Part VII: JVN for analytic sets in general Polish spaces -/ + +/-- **Jankov–von Neumann Uniformization Theorem** (Kechris 18.1). + +For P analytic in X × Y (Polish spaces), there exists a σ(Σ₁¹)-measurable +function φ : X → Y uniformizing P on its projection. -/ +theorem jankov_von_neumann + {X Y : Type*} [TopologicalSpace X] [TopologicalSpace Y] + [PolishSpace X] [PolishSpace Y] + (P : Set (X × Y)) (hP : AnalyticSet P) (hne : P.Nonempty) : + ∃ (φ : X → Y), AnalyticallyMeasurable φ ∧ + ∀ x ∈ Prod.fst '' P, (x, φ x) ∈ P := by + rw [AnalyticSet] at hP + rcases hP with rfl | ⟨π, hπ_cont, hπ_range⟩ + · exact absurd hne (by simp) + -- F = {(x, z) ∈ X × ℕᴺ | fst(π(z)) = x} is closed + let F : Set (X × (ℕ → ℕ)) := { p | Prod.fst (π p.2) = p.1 } + have hF_closed : IsClosed F := + isClosed_eq (hπ_cont.fst.comp continuous_snd) continuous_fst + have hF_ne : F.Nonempty := by + obtain ⟨⟨x, y⟩, hxy⟩ := hne + obtain ⟨z, hz⟩ := (hπ_range ▸ hxy : (x, y) ∈ range π) + exact ⟨(x, z), show Prod.fst (π z) = x from congr_arg Prod.fst hz⟩ + -- Apply generalized jvn_closed: get ψ : X → ℕᴺ + obtain ⟨ψ, hψ_meas, hψ_sel⟩ := jvn_closedG hF_closed hF_ne + -- φ(x) = snd(π(ψ(x))) + refine ⟨fun x => Prod.snd (π (ψ x)), + hψ_meas.comp_continuous (hπ_cont.snd.comp continuous_id), fun x hx => ?_⟩ + have hx_projF : x ∈ Prod.fst '' F := by + obtain ⟨⟨a, b⟩, hab, rfl⟩ := hx + obtain ⟨z, hz⟩ := (hπ_range ▸ hab : (a, b) ∈ range π) + exact ⟨(a, z), show Prod.fst (π z) = a from congr_arg Prod.fst hz, rfl⟩ + have hfst : Prod.fst (π (ψ x)) = x := hψ_sel x hx_projF + rw [show (x, Prod.snd (π (ψ x))) = π (ψ x) from Prod.ext hfst.symm rfl, ← hπ_range] + exact mem_range_self _ + +end diff --git a/LeanPool/BicausalOT/BicausalOT/Existence.lean b/LeanPool/BicausalOT/BicausalOT/Existence.lean new file mode 100644 index 0000000000..d1e6b683f5 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/Existence.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Step 5: Existence of optimal coupling ✓ FULLY VERIFIED + Uses Mathlib's LowerSemicontinuousOn.exists_isMinOn (no axiom needed). +-/ +import LeanPool.BicausalOT.BicausalOT.Defs +import Mathlib.Topology.Semicontinuity.Basic + +open MeasureTheory ProbabilityTheory Set ENNReal + +noncomputable section + +variable {X₀ X₁ Y₀ Y₁ : Type*} +variable [MeasurableSpace X₀] [MeasurableSpace X₁] +variable [MeasurableSpace Y₀] [MeasurableSpace Y₁] +variable (c₁ : (X₀ × Y₀) × (X₁ × Y₁) → ENNReal) + +theorem optimal_kernel_exists_pointwise + [TopologicalSpace (Measure (X₁ × Y₁))] + (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) + (z₀ : X₀ × Y₀) + (h_ne : (FeasibleSet₀ κ_μ κ_ν z₀).Nonempty) + (h_compact : IsCompact (FeasibleSet₀ κ_μ κ_ν z₀ : + Set (Measure (X₁ × Y₁)))) + (h_lsc : LowerSemicontinuousOn + (fun γ : Measure (X₁ × Y₁) => ∫⁻ z₁, c₁ (z₀, z₁) ∂γ) + (FeasibleSet₀ κ_μ κ_ν z₀)) : + ∃ γ_star ∈ FeasibleSet₀ κ_μ κ_ν z₀, + ∀ γ ∈ FeasibleSet₀ κ_μ κ_ν z₀, + ∫⁻ z₁, c₁ (z₀, z₁) ∂γ_star ≤ ∫⁻ z₁, c₁ (z₀, z₁) ∂γ := by + obtain ⟨a, ha_mem, ha_min⟩ := h_lsc.exists_isMinOn h_ne h_compact + exact ⟨a, ha_mem, fun γ hγ => ha_min hγ⟩ + +end diff --git a/LeanPool/BicausalOT/BicausalOT/FeasNonempty.lean b/LeanPool/BicausalOT/BicausalOT/FeasNonempty.lean new file mode 100644 index 0000000000..84de7ca497 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/FeasNonempty.lean @@ -0,0 +1,165 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + FRONT F1 — nonemptiness of feasible sets via product couplings. + + Draft for integration into BicausalOT. The independent (product) + coupling witnesses nonemptiness of `CouplingSet₀`, `FeasibleSet₀` and + `MultiPeriod.Feas` whenever the marginals / conditional marginals are + probability measures. This makes the hypotheses `h_Gamma_ne` + (T=1, `bellman_value_eq`) and `hne` (`bellman_value_eq_multi`) + redundant; `CouplingSet₀.measure_univ` additionally kills `h_prob`. + + Integration targets: general lemmas → Defs.lean (or a small new file), + `Feas.nonempty` + `bellman_value_eq_multi'` → MultiPeriod.lean, + `bellman_value_eq'` → ValueRepresentation.lean. + See note_FeasNonempty.md for the recommendation. +-/ +import LeanPool.BicausalOT.BicausalOT.MultiPeriod +import LeanPool.BicausalOT.BicausalOT.ValueRepresentation +import Mathlib.MeasureTheory.Measure.Prod + +open MeasureTheory Set ENNReal + +noncomputable section + +/-! ### General marginal lemmas for product measures + +Mathlib's `Measure.map_fst_prod : (μ.prod ν).map Prod.fst = (ν univ) • μ` +(and symmetrically `Measure.map_snd_prod`) carry a total-mass scalar; for +probability factors the scalar is `1` and disappears. -/ + +/-- The first marginal of a product measure is the first factor, when the + second factor is a probability measure. -/ +theorem MeasureTheory.Measure.map_fst_prod_of_isProbabilityMeasure + {A B : Type*} [MeasurableSpace A] [MeasurableSpace B] + (μ : Measure A) (ν : Measure B) [IsProbabilityMeasure ν] : + (μ.prod ν).map Prod.fst = μ := by + rw [Measure.map_fst_prod, measure_univ, one_smul] + +/-- The second marginal of a product measure is the second factor, when + the first factor is a probability measure. -/ +theorem MeasureTheory.Measure.map_snd_prod_of_isProbabilityMeasure + {A B : Type*} [MeasurableSpace A] [MeasurableSpace B] + (μ : Measure A) (ν : Measure B) [IsProbabilityMeasure μ] [SFinite ν] : + (μ.prod ν).map Prod.snd = ν := by + rw [Measure.map_snd_prod, measure_univ, one_smul] + +/-! ### T=1: `CouplingSet₀` and `FeasibleSet₀` are nonempty -/ + +section OneStep + +variable {X₀ X₁ Y₀ Y₁ : Type*} +variable [MeasurableSpace X₀] [MeasurableSpace X₁] +variable [MeasurableSpace Y₀] [MeasurableSpace Y₁] + +/-- The independent coupling `μ₀.prod ν₀` witnesses nonemptiness of the + coupling set of two probability measures. -/ +theorem CouplingSet₀.nonempty (μ₀ : Measure X₀) (ν₀ : Measure Y₀) + [IsProbabilityMeasure μ₀] [IsProbabilityMeasure ν₀] : + (CouplingSet₀ μ₀ ν₀).Nonempty := + ⟨μ₀.prod ν₀, + Measure.map_fst_prod_of_isProbabilityMeasure μ₀ ν₀, + Measure.map_snd_prod_of_isProbabilityMeasure μ₀ ν₀⟩ + +omit [MeasurableSpace X₀] [MeasurableSpace Y₀] in +/-- The product of the conditional marginals witnesses nonemptiness of + the one-step feasible set, for probability kernels. -/ +theorem FeasibleSet₀.nonempty + (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) + (hκμ : ∀ x, IsProbabilityMeasure (κ_μ x)) + (hκν : ∀ y, IsProbabilityMeasure (κ_ν y)) + (z₀ : X₀ × Y₀) : + (FeasibleSet₀ κ_μ κ_ν z₀).Nonempty := by + haveI := hκμ z₀.1 + haveI := hκν z₀.2 + exact ⟨(κ_μ z₀.1).prod (κ_ν z₀.2), + Measure.map_fst_prod_of_isProbabilityMeasure _ _, + Measure.map_snd_prod_of_isProbabilityMeasure _ _⟩ + +/-- Any coupling of probability marginals has total mass one. Makes the + hypothesis `h_prob` of `bellman_value_leq` / `bellman_value_eq` + redundant. -/ +theorem CouplingSet₀.measure_univ + {μ₀ : Measure X₀} {ν₀ : Measure Y₀} [hμ₀ : IsProbabilityMeasure μ₀] + {γ₀ : Measure (X₀ × Y₀)} (hγ₀ : γ₀ ∈ CouplingSet₀ μ₀ ν₀) : + γ₀ Set.univ = 1 := by + have h1 : (γ₀.map Prod.fst) Set.univ = 1 := by + rw [hγ₀.1]; exact hμ₀.measure_univ + rwa [Measure.map_apply measurable_fst MeasurableSet.univ, + Set.preimage_univ] at h1 + +variable (c₀ : X₀ × Y₀ → ENNReal) (c₁ : (X₀ × Y₀) × (X₁ × Y₁) → ENNReal) + +/-- **T=1 Bellman value representation, probability-kernel form.** + `bellman_value_eq` with both side conditions discharged: the + nonemptiness hypothesis `h_Gamma_ne` follows from the kernels being + probability-valued (`FeasibleSet₀.nonempty`), and the mass bound + `h_prob` from the probability marginals (`CouplingSet₀.measure_univ`). -/ +theorem bellman_value_eq' + (μ₀ : Measure X₀) [IsProbabilityMeasure μ₀] + (ν₀ : Measure Y₀) [IsProbabilityMeasure ν₀] + (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) + (hκμ : ∀ x, IsProbabilityMeasure (κ_μ x)) + (hκν : ∀ y, IsProbabilityMeasure (κ_ν y)) : + ⨅ (γ₀ : Measure (X₀ × Y₀)) (γ₁ : X₀ × Y₀ → Measure (X₁ × Y₁)) + (_ : γ₀ ∈ CouplingSet₀ μ₀ ν₀) + (_ : ∀ z₀, γ₁ z₀ ∈ FeasibleSet₀ κ_μ κ_ν z₀), + totalCost c₀ c₁ γ₀ γ₁ + = ⨅ (γ₀ : Measure (X₀ × Y₀)) (_ : γ₀ ∈ CouplingSet₀ μ₀ ν₀), + ∫⁻ z₀, V₀ c₀ c₁ κ_μ κ_ν z₀ ∂γ₀ := + bellman_value_eq c₀ c₁ μ₀ ν₀ κ_μ κ_ν + (FeasibleSet₀.nonempty κ_μ κ_ν hκμ hκν) + (fun _ hγ₀ => le_of_eq (CouplingSet₀.measure_univ hγ₀)) + +end OneStep + +/-! ### Multi-period: `Feas` is nonempty -/ + +namespace MultiPeriod + +variable {X Y : ℕ → Type*} +variable [∀ n, MeasurableSpace (X n)] [∀ n, MeasurableSpace (Y n)] +variable (κμ : (t : ℕ) → XHist X t → Measure (X (t + 1))) +variable (κν : (t : ℕ) → YHist Y t → Measure (Y (t + 1))) + +/-- F1 main lemma: every one-step feasible set is nonempty when the + conditional marginals are probability measures. The witness is the + conditionally independent (product) coupling. -/ +theorem Feas.nonempty + (hκμ : ∀ t x, IsProbabilityMeasure (κμ t x)) + (hκν : ∀ t y, IsProbabilityMeasure (κν t y)) + (t : ℕ) (h : PairHist X Y t) : + (Feas κμ κν t h).Nonempty := by + haveI := hκμ t (projX t h) + haveI := hκν t (projY t h) + exact ⟨(κμ t (projX t h)).prod (κν t (projY t h)), + Measure.map_fst_prod_of_isProbabilityMeasure _ _, + Measure.map_snd_prod_of_isProbabilityMeasure _ _⟩ + +variable (c : (t : ℕ) → PairHist X Y t → ℝ≥0∞) + +/-- **Multi-period Bellman value representation, probability-kernel + form.** `bellman_value_eq_multi` with the nonemptiness hypothesis + `hne` replaced by the probability hypothesis on the `Y`-side kernel + (the `X`-side one was already assumed): nonemptiness of every `Feas` + fiber follows via `Feas.nonempty`. -/ +theorem bellman_value_eq_multi' (T : ℕ) + (μ₀ : Measure (X 0)) [IsProbabilityMeasure μ₀] + (ν₀ : Measure (Y 0)) [IsProbabilityMeasure ν₀] + (hκμ : ∀ t x, IsProbabilityMeasure (κμ t x)) + (hκν : ∀ t y, IsProbabilityMeasure (κν t y)) : + ⨅ (γ₀ : Measure (X 0 × Y 0)) (γ : Strat X Y) + (_ : γ₀ ∈ CouplingSet₀ μ₀ ν₀) + (_ : ∀ t h, γ t h ∈ Feas κμ κν t h), + ∫⁻ h₀, costGo c γ T 0 h₀ ∂γ₀ + = ⨅ (γ₀ : Measure (X 0 × Y 0)) (_ : γ₀ ∈ CouplingSet₀ μ₀ ν₀), + ∫⁻ h₀, VGo c κμ κν T 0 h₀ ∂γ₀ := + bellman_value_eq_multi κμ κν c T μ₀ ν₀ hκμ (Feas.nonempty κμ κν hκμ hκν) + +end MultiPeriod + +end diff --git a/LeanPool/BicausalOT/BicausalOT/LowerBound.lean b/LeanPool/BicausalOT/BicausalOT/LowerBound.lean new file mode 100644 index 0000000000..bd687ba2b4 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/LowerBound.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Step 2: Bellman Lower Bound ✓ FULLY VERIFIED +-/ +import LeanPool.BicausalOT.BicausalOT.Defs + +open MeasureTheory ProbabilityTheory Set ENNReal + +noncomputable section + +variable {X₀ X₁ Y₀ Y₁ : Type*} +variable [MeasurableSpace X₀] [MeasurableSpace X₁] +variable [MeasurableSpace Y₀] [MeasurableSpace Y₁] +variable (c₀ : X₀ × Y₀ → ENNReal) (c₁ : (X₀ × Y₀) × (X₁ × Y₁) → ENNReal) + +theorem V₀_le_cost_pointwise + (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) + (z₀ : X₀ × Y₀) (γ : Measure (X₁ × Y₁)) + (hγ : γ ∈ FeasibleSet₀ κ_μ κ_ν z₀) : + V₀ c₀ c₁ κ_μ κ_ν z₀ ≤ c₀ z₀ + ∫⁻ z₁, c₁ (z₀, z₁) ∂γ := by + unfold V₀; gcongr; exact iInf₂_le γ hγ + +theorem bellman_lower_bound + (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) + (π : Measure ((X₀ × X₁) × (Y₀ × Y₁))) + (kd : KernelDecomp π) + (h_feas : ∀ᵐ z₀ ∂kd.γ₀, kd.γ₁ z₀ ∈ FeasibleSet₀ κ_μ κ_ν z₀) : + ∫⁻ z₀, V₀ c₀ c₁ κ_μ κ_ν z₀ ∂kd.γ₀ + ≤ totalCost c₀ c₁ kd.γ₀ kd.γ₁ := by + unfold totalCost; apply lintegral_mono_ae + filter_upwards [h_feas] with z₀ hz₀ + exact V₀_le_cost_pointwise c₀ c₁ κ_μ κ_ν z₀ (kd.γ₁ z₀) hz₀ + +end diff --git a/LeanPool/BicausalOT/BicausalOT/LscBellman.lean b/LeanPool/BicausalOT/BicausalOT/LscBellman.lean new file mode 100644 index 0000000000..502a97f681 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/LscBellman.lean @@ -0,0 +1,736 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Phase 5: exact Borel-measurable optimal strategies — the Feller/lsc model + (Bertsekas–Shreve Chapter 8.3, lower semicontinuous model analogue) + + Blueprint: BLUEPRINT.md §4F. Under kernels weakly continuous in the + history (Feller, taken as `ProbabilityMeasure`-valued primitives) and + lower semicontinuous stage costs: + · the Bellman value functions are genuinely lower semicontinuous + (`lowerSemicontinuous_VGo` — Berge backward induction over the + sequentially upper hemicontinuous, compact-valued feasibility + correspondence, with the jointly lsc integral pairing of + LscIntegral.lean); + · the exact argmin correspondence is nonempty, closed-valued and + weakly measurable (`argminSet_*` — the constrained-value comparison + `stageMin C ≤ stageMin univ` over an Fσ decomposition of opens); + · Kuratowski–Ryll-Nardzewski selection yields a strategy that is + EXACTLY optimal at every stage and plain-Borel measurable + (`exists_optimal_measurable_strategy`), and the Bellman value is + ATTAINED: `costGo = VGo` (`bellman_value_attained_measurable`) — + the ε = 0, plain-Borel upgrade of Phases 2 and 4 under stronger + hypotheses (twin track: neither result dominates the other). +-/ +import LeanPool.BicausalOT.BicausalOT.MeasurableStrategy +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsUHC +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LscIntegral +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.MeasurableSelection + +open MeasureTheory Set Filter Topology +open scoped ENNReal + +noncomputable section + +/-! ## KRN on the Polish space of probability measures -/ + +/-- Kuratowski–Ryll-Nardzewski selection with `WeakP` targets: the Polish + wrapper of `exists_measurable_selection` (the metric upgrade keeps the + topology, hence the Borel structure — the §3W C3 pattern). -/ +theorem WeakP.exists_measurable_selection {α : Type*} [MeasurableSpace α] + {W : Type*} [MeasurableSpace W] [TopologicalSpace W] [PolishSpace W] + [BorelSpace W] + {Φ : α → Set (WeakP W)} (hne : ∀ a, (Φ a).Nonempty) + (hclosed : ∀ a, IsClosed (Φ a)) + (hmeas : ∀ U : Set (WeakP W), IsOpen U → + MeasurableSet {a | (Φ a ∩ U).Nonempty}) : + ∃ f : α → WeakP W, Measurable f ∧ ∀ a, f a ∈ Φ a := by + letI := TopologicalSpace.upgradeIsCompletelyMetrizable (WeakP W) + exact _root_.exists_measurable_selection hne hclosed hmeas + +namespace MultiPeriod + +variable {X Y : ℕ → Type*} + [∀ n, TopologicalSpace (X n)] [∀ n, PolishSpace (X n)] + [∀ n, MeasurableSpace (X n)] [∀ n, BorelSpace (X n)] + [∀ n, TopologicalSpace (Y n)] [∀ n, PolishSpace (Y n)] + [∀ n, MeasurableSpace (Y n)] [∀ n, BorelSpace (Y n)] + +variable (κμP : (t : ℕ) → XHist X t → ProbabilityMeasure (X (t + 1))) +variable (κνP : (t : ℕ) → YHist Y t → ProbabilityMeasure (Y (t + 1))) +variable (c : (t : ℕ) → PairHist X Y t → ℝ≥0∞) + +/-! ## The feasibility fibers: compact and nonempty -/ + +/-- Fibers of the feasibility graph at probability kernels are compact in + the weak topology (couplings of fixed marginals are compact). -/ +theorem isCompact_feasGraph_fiber (t : ℕ) (h : PairHist X Y t) : + IsCompact {γ : WeakP (X (t + 1) × Y (t + 1)) | + (h, γ) ∈ FeasGraph (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t} := + isCompact_probabilityMeasure_marginals + (κμP t (projX t h) : Measure (X (t + 1))) + (κνP t (projY t h) : Measure (Y (t + 1))) + +omit [∀ n, TopologicalSpace (X n)] [∀ n, PolishSpace (X n)] + [∀ n, BorelSpace (X n)] [∀ n, TopologicalSpace (Y n)] + [∀ n, PolishSpace (Y n)] [∀ n, BorelSpace (Y n)] in +/-- Fibers of the feasibility graph at probability kernels are nonempty + (product coupling, F1). -/ +theorem feasGraph_fiber_nonempty' (t : ℕ) (h : PairHist X Y t) : + ∃ γ : WeakP (X (t + 1) × Y (t + 1)), + (h, γ) ∈ FeasGraph (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t := + feasGraph_fiber_nonempty _ _ (fun _ _ => inferInstance) + (Feas.nonempty _ _ (fun _ _ => inferInstance) (fun _ _ => inferInstance)) + t h + +/-! ## The constrained one-step value -/ + +/-- Constrained one-step value: the infimum of a stage objective over the + feasible fiber intersected with a constraint set. `C = univ` recovers + the one-step Bellman infimum. -/ +def stageMin (t : ℕ) + (F : PairHist X Y t × WeakP (X (t + 1) × Y (t + 1)) → ℝ≥0∞) + (C : Set (WeakP (X (t + 1) × Y (t + 1)))) (h : PairHist X Y t) : ℝ≥0∞ := + ⨅ (γ : WeakP (X (t + 1) × Y (t + 1))) + (_ : (h, γ) ∈ FeasGraph (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t ∧ γ ∈ C), F (h, γ) + +omit [∀ n, TopologicalSpace (X n)] [∀ n, PolishSpace (X n)] + [∀ n, BorelSpace (X n)] [∀ n, TopologicalSpace (Y n)] + [∀ n, PolishSpace (Y n)] [∀ n, BorelSpace (Y n)] in +/-- The one-step Bellman recursion through the unconstrained + `stageMin`. -/ +theorem VGo_succ_eq_stageMin (k t : ℕ) (h : PairHist X Y t) : + VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) (k + 1) t h + = c t h + stageMin κμP κνP t + (fun p => ∫⁻ z, VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) k (t + 1) (p.1, z) + ∂p.2.toMeasure) univ h := by + rw [VGo_succ_eq_weakP _ _ c (fun _ _ => inferInstance) k t h] + congr 1 + simp only [stageMin, Set.mem_univ, and_true] + +/-! ## Berge minimum: the constrained value is lower semicontinuous -/ + +/-- **Berge minimum (parametrized).** In the Feller model, the constrained + one-step value against a jointly lower semicontinuous objective and a + closed constraint set is lower semicontinuous in the history: + minimizers along a convergent sequence of histories have convergent + marginals, hence are tight; Prokhorov extracts a convergent + subsequence whose limit is feasible, constrained, and no worse. -/ +theorem lowerSemicontinuous_stageMin + (hκμ_cont : ∀ t, Continuous (κμP t)) + (hκν_cont : ∀ t, Continuous (κνP t)) (t : ℕ) + {F : PairHist X Y t × WeakP (X (t + 1) × Y (t + 1)) → ℝ≥0∞} + (hF : LowerSemicontinuous F) + {C : Set (WeakP (X (t + 1) × Y (t + 1)))} (hC : IsClosed C) : + LowerSemicontinuous (stageMin κμP κνP t F C) := by + rw [lowerSemicontinuous_iff_isClosed_preimage] + intro y + rcases eq_or_ne y ⊤ with rfl | hy + · rw [Set.Iic_top, Set.preimage_univ] + exact isClosed_univ + refine IsSeqClosed.isClosed fun hs h hmem hlim => ?_ + simp only [Set.mem_preimage, Set.mem_Iic] at hmem ⊢ + -- select minimizers along the sequence + have hsel : ∀ n, ∃ γ : WeakP (X (t + 1) × Y (t + 1)), + ((hs n, γ) ∈ FeasGraph (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t ∧ γ ∈ C) ∧ + F (hs n, γ) ≤ y := by + intro n + have hfibne : ∃ γ, (hs n, γ) ∈ FeasGraph + (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t ∧ γ ∈ C := by + by_contra hempty + have htop : stageMin κμP κνP t F C (hs n) = ⊤ := + iInf_eq_top.mpr fun γ => iInf_eq_top.mpr fun hcond => + absurd hcond (not_exists.mp hempty γ) + have := hmem n + rw [htop] at this + exact hy (top_le_iff.mp this) + obtain ⟨γ₀, hγ₀⟩ := hfibne + have hcomp : IsCompact ({γ : WeakP (X (t + 1) × Y (t + 1)) | + (hs n, γ) ∈ FeasGraph (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t} ∩ C) := + (isCompact_feasGraph_fiber κμP κνP t (hs n)).inter_right hC + have hne' : ({γ : WeakP (X (t + 1) × Y (t + 1)) | + (hs n, γ) ∈ FeasGraph (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t} ∩ C).Nonempty := + ⟨γ₀, hγ₀.1, hγ₀.2⟩ + obtain ⟨γn, hγn_mem, hγn_min⟩ := + LowerSemicontinuousOn.exists_isMinOn hne' hcomp + ((hF.comp (Continuous.prodMk continuous_const continuous_id) + ).lowerSemicontinuousOn _) + refine ⟨γn, ⟨hγn_mem.1, hγn_mem.2⟩, ?_⟩ + refine le_trans (le_trans ?_ (le_refl (stageMin κμP κνP t F C (hs n)))) + (hmem n) + exact le_iInf₂ fun γ' hγ' => isMinOn_iff.mp hγn_min γ' ⟨hγ'.1, hγ'.2⟩ + choose γs hγs_cond hγs_le using hsel + -- marginal convergence via Feller continuity of the kernels + have hμ : Tendsto (fun n => κμP t (projX t (hs n))) atTop + (𝓝 (κμP t (projX t h))) := + (((hκμ_cont t).comp (continuous_projX t)).tendsto h).comp hlim + have hν : Tendsto (fun n => κνP t (projY t (hs n))) atTop + (𝓝 (κνP t (projY t h))) := + (((hκν_cont t).comp (continuous_projY t)).tendsto h).comp hlim + -- upper hemicontinuity: extract a convergent subsequence of couplings + obtain ⟨γlim, hlfst, hlsnd, φ, hφmono, hφt⟩ := + exists_tendsto_subseq_couplings hμ hν + (fun n => (hγs_cond n).1.1) (fun n => (hγs_cond n).1.2) + have hγlim_C : γlim ∈ C := + hC.mem_of_tendsto hφt (Eventually.of_forall fun k => (hγs_cond (φ k)).2) + have hγlim_fib : (h, γlim) ∈ FeasGraph + (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t := ⟨hlfst, hlsnd⟩ + -- the limit is no worse: closed sublevel set of the jointly lsc F + have hFy : F (h, γlim) ≤ y := by + have hclosed_sub := (lowerSemicontinuous_iff_isClosed_preimage.mp hF) y + have hpairs : Tendsto (fun k => (hs (φ k), γs (φ k))) atTop + (𝓝 (h, γlim)) := + (hlim.comp hφmono.tendsto_atTop).prodMk_nhds hφt + exact hclosed_sub.mem_of_tendsto hpairs + (Eventually.of_forall fun k => hγs_le (φ k)) + exact le_trans (iInf₂_le γlim ⟨hγlim_fib, hγlim_C⟩) hFy + +/-! ## The Bellman value functions are lower semicontinuous -/ + +/-- **Phase 5, V1 (BS 8.3 analogue).** For Feller kernels and lower + semicontinuous stage costs, every Bellman value function is lower + semicontinuous on the history space (backward induction; the + integrand is jointly lsc by the integral pairing, the infimum by the + Berge minimum). -/ +theorem lowerSemicontinuous_VGo + (hκμ_cont : ∀ t, Continuous (κμP t)) + (hκν_cont : ∀ t, Continuous (κνP t)) + (hc : ∀ t, LowerSemicontinuous (c t)) : + ∀ k t : ℕ, LowerSemicontinuous + (VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) k t) := by + intro k + induction k with + | zero => exact fun t => hc t + | succ k ih => + intro t + have heq : VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) (k + 1) t + = fun h => c t h + stageMin κμP κνP t + (fun p => ∫⁻ z, VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) k (t + 1) (p.1, z) + ∂p.2.toMeasure) univ h := + funext fun h => VGo_succ_eq_stageMin κμP κνP c k t h + rw [heq] + have hFk : LowerSemicontinuous + (fun p : PairHist X Y t × WeakP (X (t + 1) × Y (t + 1)) => + ∫⁻ z, VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) k (t + 1) (p.1, z) + ∂p.2.toMeasure) := by + have hf : LowerSemicontinuous + (fun q : PairHist X Y t × (X (t + 1) × Y (t + 1)) => + VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) k (t + 1) + (q.1, q.2)) := ih (t + 1) + exact lowerSemicontinuous_lintegral_prodMk hf + exact (hc t).add + (lowerSemicontinuous_stageMin κμP κνP hκμ_cont hκν_cont t hFk + isClosed_univ) + +/-! ## The exact argmin correspondence -/ + +/-- The exact argmin correspondence: feasible one-step plans attaining + the one-step Bellman infimum. -/ +def argminSet (t : ℕ) + (F : PairHist X Y t × WeakP (X (t + 1) × Y (t + 1)) → ℝ≥0∞) + (h : PairHist X Y t) : Set (WeakP (X (t + 1) × Y (t + 1))) := + {γ | (h, γ) ∈ FeasGraph (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t ∧ + F (h, γ) ≤ stageMin κμP κνP t F univ h} + +/-- The argmin correspondence has nonempty values: the objective attains + its infimum on the nonempty compact fiber. -/ +theorem argminSet_nonempty (t : ℕ) + {F : PairHist X Y t × WeakP (X (t + 1) × Y (t + 1)) → ℝ≥0∞} + (hF : LowerSemicontinuous F) (h : PairHist X Y t) : + (argminSet κμP κνP t F h).Nonempty := by + obtain ⟨γ₀, hγ₀⟩ := feasGraph_fiber_nonempty' κμP κνP t h + obtain ⟨γ, hγmem, hγmin⟩ := LowerSemicontinuousOn.exists_isMinOn + ⟨γ₀, hγ₀⟩ (isCompact_feasGraph_fiber κμP κνP t h) + ((hF.comp (Continuous.prodMk continuous_const continuous_id) + ).lowerSemicontinuousOn _) + refine ⟨γ, hγmem, ?_⟩ + exact le_iInf₂ fun γ' hγ' => isMinOn_iff.mp hγmin γ' hγ'.1 + +/-- The argmin correspondence has closed values. -/ +theorem isClosed_argminSet (t : ℕ) + {F : PairHist X Y t × WeakP (X (t + 1) × Y (t + 1)) → ℝ≥0∞} + (hF : LowerSemicontinuous F) (h : PairHist X Y t) : + IsClosed (argminSet κμP κνP t F h) := by + have h1 : IsClosed {γ : WeakP (X (t + 1) × Y (t + 1)) | + (h, γ) ∈ FeasGraph (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t} := + (isCompact_feasGraph_fiber κμP κνP t h).isClosed + have h2 : IsClosed {γ : WeakP (X (t + 1) × Y (t + 1)) | + F (h, γ) ≤ stageMin κμP κνP t F univ h} := + (lowerSemicontinuous_iff_isClosed_preimage.mp + (hF.comp (Continuous.prodMk continuous_const continuous_id))) _ + exact h1.inter h2 + +/-- **M1: the argmin hit-set identity.** Hitting a closed constraint set + with an exact minimizer is equivalent to the constrained fiber being + nonempty and the constrained value not exceeding the unconstrained + one (attainment on the compact constrained fiber). -/ +theorem argminSet_hit_eq (t : ℕ) + {F : PairHist X Y t × WeakP (X (t + 1) × Y (t + 1)) → ℝ≥0∞} + (hF : LowerSemicontinuous F) + {C : Set (WeakP (X (t + 1) × Y (t + 1)))} (hC : IsClosed C) : + {h | (argminSet κμP κνP t F h ∩ C).Nonempty} + = {h | ({γ | (h, γ) ∈ FeasGraph + (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t} ∩ C).Nonempty} + ∩ {h | stageMin κμP κνP t F C h ≤ stageMin κμP κνP t F univ h} := by + ext h + simp only [Set.mem_ofPred_eq, Set.mem_inter_iff] + constructor + · rintro ⟨γ, ⟨hfib, hopt⟩, hγC⟩ + exact ⟨⟨γ, hfib, hγC⟩, le_trans (iInf₂_le γ ⟨hfib, hγC⟩) hopt⟩ + · rintro ⟨⟨γ₀, hγ₀fib, hγ₀C⟩, hle⟩ + have hcomp : IsCompact ({γ : WeakP (X (t + 1) × Y (t + 1)) | + (h, γ) ∈ FeasGraph (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t} ∩ C) := + (isCompact_feasGraph_fiber κμP κνP t h).inter_right hC + have hne' : ({γ : WeakP (X (t + 1) × Y (t + 1)) | + (h, γ) ∈ FeasGraph (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t} ∩ C).Nonempty := + ⟨γ₀, hγ₀fib, hγ₀C⟩ + obtain ⟨γ, hγmem, hγmin⟩ := LowerSemicontinuousOn.exists_isMinOn + hne' hcomp + ((hF.comp (Continuous.prodMk continuous_const continuous_id) + ).lowerSemicontinuousOn _) + refine ⟨γ, ⟨hγmem.1, le_trans ?_ hle⟩, hγmem.2⟩ + exact le_iInf₂ fun γ' hγ' => isMinOn_iff.mp hγmin γ' ⟨hγ'.1, hγ'.2⟩ + +/-- The constrained-fiber hit-set against a closed target is Borel: + transport the closed couplings hit-set (U4) along the continuous + marginal map of the Feller model. -/ +theorem measurableSet_feasGraph_fiber_hit + (hκμ_cont : ∀ t, Continuous (κμP t)) + (hκν_cont : ∀ t, Continuous (κνP t)) (t : ℕ) + {C : Set (WeakP (X (t + 1) × Y (t + 1)))} (hC : IsClosed C) : + MeasurableSet {h : PairHist X Y t | + ({γ | (h, γ) ∈ FeasGraph (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t} ∩ C).Nonempty} := by + have hm : Continuous (fun h : PairHist X Y t => + (κμP t (projX t h), κνP t (projY t h))) := + ((hκμ_cont t).comp (continuous_projX t)).prodMk + ((hκν_cont t).comp (continuous_projY t)) + have hhit : IsClosed {p : ProbabilityMeasure (X (t + 1)) + × ProbabilityMeasure (Y (t + 1)) | + ∃ γ : ProbabilityMeasure ((X (t + 1)) × (Y (t + 1))), γ ∈ C ∧ + (γ : Measure ((X (t + 1)) × (Y (t + 1)))).map Prod.fst + = (p.1 : Measure (X (t + 1))) ∧ + (γ : Measure ((X (t + 1)) × (Y (t + 1)))).map Prod.snd + = (p.2 : Measure (Y (t + 1)))} := + isClosed_couplings_hit hC + have hset : {h : PairHist X Y t | + ({γ | (h, γ) ∈ FeasGraph (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t} ∩ C).Nonempty} + = (fun h : PairHist X Y t => + (κμP t (projX t h), κνP t (projY t h))) ⁻¹' + {p : ProbabilityMeasure (X (t + 1)) + × ProbabilityMeasure (Y (t + 1)) | + ∃ γ : ProbabilityMeasure ((X (t + 1)) × (Y (t + 1))), γ ∈ C ∧ + (γ : Measure ((X (t + 1)) × (Y (t + 1)))).map Prod.fst + = (p.1 : Measure (X (t + 1))) ∧ + (γ : Measure ((X (t + 1)) × (Y (t + 1)))).map Prod.snd + = (p.2 : Measure (Y (t + 1)))} := by + ext h + simp only [Set.mem_ofPred_eq, Set.mem_preimage] + constructor + · rintro ⟨γ, hfib, hγC⟩ + exact ⟨γ, hγC, hfib.1, hfib.2⟩ + · rintro ⟨γ, hγC, hfst, hsnd⟩ + exact ⟨γ, ⟨hfst, hsnd⟩, hγC⟩ + rw [hset] + exact (hhit.preimage hm).measurableSet + +/-- **M2: the argmin correspondence is weakly measurable.** Hit-sets of + open sets are Borel: decompose the open set into countably many + closed sets; on each, compare the constrained and unconstrained + values (both lower semicontinuous, hence Borel). -/ +theorem measurableSet_argminSet_hit + (hκμ_cont : ∀ t, Continuous (κμP t)) + (hκν_cont : ∀ t, Continuous (κνP t)) (t : ℕ) + {F : PairHist X Y t × WeakP (X (t + 1) × Y (t + 1)) → ℝ≥0∞} + (hF : LowerSemicontinuous F) + {U : Set (WeakP (X (t + 1) × Y (t + 1)))} (hU : IsOpen U) : + MeasurableSet {h | (argminSet κμP κνP t F h ∩ U).Nonempty} := by + obtain ⟨C, hCclosed, hUeq⟩ := hU.exists_iUnion_isClosed_of_pseudoMetrizable + have hsplit : {h | (argminSet κμP κνP t F h ∩ U).Nonempty} + = ⋃ n, {h | (argminSet κμP κνP t F h ∩ C n).Nonempty} := by + rw [hUeq] + ext h + simp only [Set.mem_ofPred_eq, Set.mem_iUnion] + constructor + · rintro ⟨γ, hγa, hγU⟩ + obtain ⟨n, hγn⟩ := Set.mem_iUnion.mp hγU + exact ⟨n, γ, hγa, hγn⟩ + · rintro ⟨n, γ, hγa, hγn⟩ + exact ⟨γ, hγa, Set.mem_iUnion.mpr ⟨n, hγn⟩⟩ + rw [hsplit] + refine MeasurableSet.iUnion fun n => ?_ + rw [argminSet_hit_eq κμP κνP t hF (hCclosed n)] + exact (measurableSet_feasGraph_fiber_hit κμP κνP hκμ_cont hκν_cont t + (hCclosed n)).inter + (measurableSet_le + (lowerSemicontinuous_stageMin κμP κνP hκμ_cont hκν_cont t hF + (hCclosed n)).measurable + (lowerSemicontinuous_stageMin κμP κνP hκμ_cont hκν_cont t hF + isClosed_univ).measurable) + +/-! ## Main theorem: exact optimal measurable strategies -/ + +/-- **Phase 5 main theorem (BS 8.3 analogue).** In the Feller/lsc model + there is a strategy that is pointwise feasible, EXACTLY optimal at + every stage (time-consistent depth, ε = 0), and plain-Borel + measurable: each stage factors through a `Measurable` map into the + Polish space of probability measures — strictly stronger + measurability than Phase 4's σ(Σ¹₁), under strictly stronger + hypotheses. -/ +theorem exists_optimal_measurable_strategy (T : ℕ) + (hκμ_cont : ∀ t, Continuous (κμP t)) + (hκν_cont : ∀ t, Continuous (κνP t)) + (hc : ∀ t, LowerSemicontinuous (c t)) : + ∃ γopt : Strat X Y, + (∀ t h, γopt t h ∈ Feas (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t h) ∧ + (∀ t (h : PairHist X Y t), + ∫⁻ z, VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) (T - t - 1) (t + 1) + (h, z) ∂(γopt t h) + ≤ ⨅ (γm : Measure (X (t + 1) × Y (t + 1))) + (_ : γm ∈ Feas (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t h), + ∫⁻ z, VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) (T - t - 1) + (t + 1) (h, z) ∂γm) ∧ + (∀ t, ∃ φ : PairHist X Y t → WeakP (X (t + 1) × Y (t + 1)), + Measurable φ ∧ ∀ h, γopt t h = (φ h).toMeasure) := by + have key : ∀ t : ℕ, ∃ φ : PairHist X Y t → WeakP (X (t + 1) × Y (t + 1)), + Measurable φ ∧ ∀ h, φ h ∈ argminSet κμP κνP t + (fun p => ∫⁻ z, VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) (T - t - 1) (t + 1) + (p.1, z) ∂p.2.toMeasure) h := by + intro t + have hF : LowerSemicontinuous + (fun p : PairHist X Y t × WeakP (X (t + 1) × Y (t + 1)) => + ∫⁻ z, VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) (T - t - 1) (t + 1) + (p.1, z) ∂p.2.toMeasure) := by + have hf : LowerSemicontinuous + (fun q : PairHist X Y t × (X (t + 1) × Y (t + 1)) => + VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) (T - t - 1) + (t + 1) (q.1, q.2)) := + lowerSemicontinuous_VGo κμP κνP c hκμ_cont hκν_cont hc + (T - t - 1) (t + 1) + exact lowerSemicontinuous_lintegral_prodMk hf + exact WeakP.exists_measurable_selection + (fun h => argminSet_nonempty κμP κνP t hF h) + (fun h => isClosed_argminSet κμP κνP t hF h) + (fun U hU => measurableSet_argminSet_hit κμP κνP hκμ_cont hκν_cont + t hF hU) + choose φ hφmeas hφmem using key + refine ⟨fun t h => (φ t h).toMeasure, + fun t h => (hφmem t h).1, + fun t h => ?_, + fun t => ⟨φ t, hφmeas t, fun h => rfl⟩⟩ + rw [iInf_feas_eq_iInf_feasGraph _ _ (fun _ _ => inferInstance) t h] + refine le_trans ((hφmem t h).2) ?_ + exact le_iInf₂ fun γ hγ => iInf₂_le γ ⟨hγ, Set.mem_univ γ⟩ + +/-! ## Exact optimality: the Bellman value is attained -/ + +omit [∀ n, TopologicalSpace (X n)] [∀ n, PolishSpace (X n)] + [∀ n, BorelSpace (X n)] [∀ n, TopologicalSpace (Y n)] + [∀ n, PolishSpace (Y n)] [∀ n, BorelSpace (Y n)] in +/-- A stage-wise exactly optimal feasible strategy attains the Bellman + value: `costGo = VGo` at time-consistent depths (the ε = 0 instance + of L2 + L4; no new induction). Stated for arbitrary Markov kernels — + Feller is not needed once the strategy exists. -/ +theorem costGo_eq_VGo_of_optimal + {κμ : (t : ℕ) → XHist X t → Measure (X (t + 1))} + {κν : (t : ℕ) → YHist Y t → Measure (Y (t + 1))} (T : ℕ) + (hκμ_prob : ∀ t x, IsProbabilityMeasure (κμ t x)) + (γ : Strat X Y) (hmem : ∀ t h, γ t h ∈ Feas κμ κν t h) + (hopt : ∀ t (h : PairHist X Y t), + ∫⁻ z, VGo c κμ κν (T - t - 1) (t + 1) (h, z) ∂(γ t h) + ≤ ⨅ (γm : Measure (X (t + 1) × Y (t + 1))) + (_ : γm ∈ Feas κμ κν t h), + ∫⁻ z, VGo c κμ κν (T - t - 1) (t + 1) (h, z) ∂γm) : + ∀ (k t : ℕ), t + k = T → ∀ h : PairHist X Y t, + costGo c γ k t h = VGo c κμ κν k t h := by + intro k t htk h + refine le_antisymm ?_ (VGo_le_costGo κμ κν c γ hmem k t h) + have hle := costGo_le_VGo_add κμ κν c T hκμ_prob γ hmem (ε := 0) + (fun t h => by simpa using hopt t h) k t htk h + simpa using hle + +/-- **Attainment corollary.** In the Feller/lsc model the Bellman value + is attained by a plain-Borel measurable strategy, pointwise in the + initial history — hence also after integration against any initial + coupling: the strategy infimum of `bellman_value_eq_multi` is a + minimum. -/ +theorem bellman_value_attained_measurable (T : ℕ) + (hκμ_cont : ∀ t, Continuous (κμP t)) + (hκν_cont : ∀ t, Continuous (κνP t)) + (hc : ∀ t, LowerSemicontinuous (c t)) : + ∃ γopt : Strat X Y, + (∀ t h, γopt t h ∈ Feas (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t h) ∧ + (∀ t, ∃ φ : PairHist X Y t → WeakP (X (t + 1) × Y (t + 1)), + Measurable φ ∧ ∀ h, γopt t h = (φ h).toMeasure) ∧ + ∀ h₀ : PairHist X Y 0, + costGo c γopt T 0 h₀ + = VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) T 0 h₀ := by + obtain ⟨γopt, hmem, hopt, hφ⟩ := + exists_optimal_measurable_strategy κμP κνP c T hκμ_cont hκν_cont hc + exact ⟨γopt, hmem, hφ, + fun h₀ => costGo_eq_VGo_of_optimal c T (fun _ _ => inferInstance) + γopt hmem hopt T 0 (by omega) h₀⟩ + +/-! ## Attainment of the OUTER infimum: an optimal initial coupling + +`bellman_value_attained_measurable` turns the INNER (strategy) infimum of +`bellman_value_eq_multi` into a minimum, pointwise in the initial history. +What is left is the OUTER infimum, over the initial couplings +`γ₀ ∈ CouplingSet₀ μ₀ ν₀`. In the Feller/lsc model it is attained too, by +exactly the Weierstrass argument that `lowerSemicontinuous_stageMin` runs +stagewise: + +* reindexed over the Polish space `WeakP (X 0 × Y 0)` of probability + measures on the initial history space, `CouplingSet₀ μ₀ ν₀` is COMPACT + (`isCompact_probabilityMeasure_marginals`: tightness of the marginals + + Prokhorov + closedness of the marginal constraints) and NONEMPTY (the + independent coupling `μ₀.prod ν₀`); +* `VGo c κμ κν T 0` is lower semicontinuous on `PairHist X Y 0` — which + *is* `X 0 × Y 0` — by `lowerSemicontinuous_VGo`, so + `γ₀ ↦ ∫⁻ h₀, VGo c κμ κν T 0 h₀ ∂γ₀` is lower semicontinuous for the weak + topology (`lowerSemicontinuous_lintegral_probabilityMeasure`); +* `LowerSemicontinuousOn.exists_isMinOn` concludes. + +Combined with `bellman_value_attained_measurable`, the FULL two-level +infimum of `bellman_value_eq_multi` becomes a MINIMUM, attained at an +explicit pair `(γ₀*, γopt)` — `bellman_value_attained_multi`. + +Note on types: `PairHist X Y 0` is *definitionally* `X 0 × Y 0`, and its +recursive topology / σ-algebra are definitionally the product ones. That is +what lets the value function `VGo c κμ κν T 0` be read as a function on +`X 0 × Y 0` and integrated against a `Measure (X 0 × Y 0)`, exactly as +`bellman_value_eq_multi` already does. -/ + +omit [∀ n, TopologicalSpace (X n)] [∀ n, PolishSpace (X n)] + [∀ n, BorelSpace (X n)] [∀ n, TopologicalSpace (Y n)] + [∀ n, PolishSpace (Y n)] [∀ n, BorelSpace (Y n)] in +/-- **Reindexing bridge for the initial couplings.** The infimum over + `CouplingSet₀ μ₀ ν₀ ⊆ Measure (X 0 × Y 0)` equals the infimum over the + Polish space `WeakP (X 0 × Y 0)` of probability measures satisfying the + same marginal constraints: legitimate because a coupling of probability + marginals is itself a probability measure (`CouplingSet₀.measure_univ`). + The `CouplingSet₀` analogue of `iInf_feas_eq_iInf_feasGraph`. -/ +theorem iInf_couplingSet₀_eq_iInf_weakP + (μ₀ : Measure (X 0)) [IsProbabilityMeasure μ₀] (ν₀ : Measure (Y 0)) + (f : X 0 × Y 0 → ℝ≥0∞) : + (⨅ (γ₀ : Measure (X 0 × Y 0)) (_ : γ₀ ∈ CouplingSet₀ μ₀ ν₀), + ∫⁻ h₀, f h₀ ∂γ₀) + = ⨅ (γ : WeakP (X 0 × Y 0)) (_ : γ.toMeasure ∈ CouplingSet₀ μ₀ ν₀), + ∫⁻ h₀, f h₀ ∂γ.toMeasure := by + refine le_antisymm (le_iInf₂ fun γ hγ => iInf₂_le γ.toMeasure hγ) ?_ + refine le_iInf₂ fun γm hγm => ?_ + haveI hpm : IsProbabilityMeasure γm := ⟨CouplingSet₀.measure_univ hγm⟩ + exact iInf₂_le + (show WeakP (X 0 × Y 0) from + (⟨γm, hpm⟩ : ProbabilityMeasure (X 0 × Y 0))) hγm + +/-- The initial coupling set, reindexed over `WeakP (X 0 × Y 0)`, is compact + in the topology of weak convergence: couplings of two fixed marginals on + Borel Polish spaces form a compact set + (`isCompact_probabilityMeasure_marginals`, which is unconditional in the + two target measures). -/ +theorem isCompact_couplingSet₀_weakP + (μ₀ : Measure (X 0)) (ν₀ : Measure (Y 0)) : + IsCompact {γ : WeakP (X 0 × Y 0) | γ.toMeasure ∈ CouplingSet₀ μ₀ ν₀} := + isCompact_probabilityMeasure_marginals μ₀ ν₀ + +omit [∀ n, TopologicalSpace (X n)] [∀ n, PolishSpace (X n)] + [∀ n, BorelSpace (X n)] [∀ n, TopologicalSpace (Y n)] + [∀ n, BorelSpace (Y n)] in +/-- The initial coupling set, reindexed over `WeakP (X 0 × Y 0)`, is + nonempty: the independent coupling `μ₀.prod ν₀` is a probability measure + with the prescribed marginals (F1). -/ +theorem couplingSet₀_weakP_nonempty + (μ₀ : Measure (X 0)) [IsProbabilityMeasure μ₀] + (ν₀ : Measure (Y 0)) [IsProbabilityMeasure ν₀] : + {γ : WeakP (X 0 × Y 0) | γ.toMeasure ∈ CouplingSet₀ μ₀ ν₀}.Nonempty := + ⟨show WeakP (X 0 × Y 0) from + (⟨μ₀.prod ν₀, inferInstance⟩ : ProbabilityMeasure (X 0 × Y 0)), + Measure.map_fst_prod_of_isProbabilityMeasure μ₀ ν₀, + Measure.map_snd_prod_of_isProbabilityMeasure μ₀ ν₀⟩ + +/-- **The integrated Bellman value is lower semicontinuous in the initial + coupling.** In the Feller/lsc model `VGo c κμ κν T 0` is lower + semicontinuous on the initial history space (`lowerSemicontinuous_VGo` + at `t = 0`, where `PairHist X Y 0` is definitionally `X 0 × Y 0`), and + integration against a probability measure preserves lower + semicontinuity for the weak topology + (`lowerSemicontinuous_lintegral_probabilityMeasure`). -/ +theorem lowerSemicontinuous_lintegral_VGo (T : ℕ) + (hκμ_cont : ∀ t, Continuous (κμP t)) + (hκν_cont : ∀ t, Continuous (κνP t)) + (hc : ∀ t, LowerSemicontinuous (c t)) : + LowerSemicontinuous (fun γ : WeakP (X 0 × Y 0) => + ∫⁻ h₀, VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) T 0 h₀ + ∂γ.toMeasure) := by + have hlsc : LowerSemicontinuous + (fun h₀ : X 0 × Y 0 => + VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) T 0 h₀) := + lowerSemicontinuous_VGo κμP κνP c hκμ_cont hκν_cont hc T 0 + exact lowerSemicontinuous_lintegral_probabilityMeasure hlsc + +/-- **Attainment of the OUTER infimum (Phase 5, initial-coupling half).** + In the Feller/lsc model there is an initial coupling `γ₀*` of `μ₀` and + `ν₀` minimising the integrated Bellman value: a lower semicontinuous + function on a nonempty compact set attains its infimum + (`LowerSemicontinuousOn.exists_isMinOn`), applied here to the weakly + compact set of couplings. This is the `γ₀`-side companion of + `bellman_value_attained_measurable`. -/ +theorem exists_optimal_initial_coupling (T : ℕ) + (μ₀ : Measure (X 0)) [IsProbabilityMeasure μ₀] + (ν₀ : Measure (Y 0)) [IsProbabilityMeasure ν₀] + (hκμ_cont : ∀ t, Continuous (κμP t)) + (hκν_cont : ∀ t, Continuous (κνP t)) + (hc : ∀ t, LowerSemicontinuous (c t)) : + ∃ γ₀ : Measure (X 0 × Y 0), γ₀ ∈ CouplingSet₀ μ₀ ν₀ ∧ + IsProbabilityMeasure γ₀ ∧ + ∫⁻ h₀, VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) T 0 h₀ ∂γ₀ + = ⨅ (γ₀' : Measure (X 0 × Y 0)) (_ : γ₀' ∈ CouplingSet₀ μ₀ ν₀), + ∫⁻ h₀, VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) T 0 h₀ ∂γ₀' := by + obtain ⟨γstar, hmem, hmin⟩ := + LowerSemicontinuousOn.exists_isMinOn + (couplingSet₀_weakP_nonempty (X := X) (Y := Y) μ₀ ν₀) + (isCompact_couplingSet₀_weakP (X := X) (Y := Y) μ₀ ν₀) + ((lowerSemicontinuous_lintegral_VGo κμP κνP c T hκμ_cont hκν_cont + hc).lowerSemicontinuousOn _) + refine ⟨γstar.toMeasure, hmem, inferInstance, ?_⟩ + have hbridge : + (⨅ (γ₀' : Measure (X 0 × Y 0)) (_ : γ₀' ∈ CouplingSet₀ μ₀ ν₀), + ∫⁻ h₀, VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) T 0 h₀ ∂γ₀') + = ⨅ (γ : WeakP (X 0 × Y 0)) + (_ : γ.toMeasure ∈ CouplingSet₀ μ₀ ν₀), + ∫⁻ h₀, VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) T 0 h₀ + ∂γ.toMeasure := + iInf_couplingSet₀_eq_iInf_weakP (X := X) (Y := Y) μ₀ ν₀ _ + rw [hbridge] + exact le_antisymm (le_iInf₂ fun γ hγ => isMinOn_iff.mp hmin γ hγ) + (iInf₂_le γstar hmem) + +/-! ## The full two-level infimum is a minimum -/ + +/-- **Phase 5, full attainment.** In the Feller/lsc model the two-level + infimum of `bellman_value_eq_multi` — over initial couplings AND over + pointwise feasible strategies — is a MINIMUM: it is attained at an + explicit pair `(γ₀*, γopt)` consisting of a weakly optimal initial + coupling (`exists_optimal_initial_coupling`) and a stagewise exactly + optimal, plain-Borel measurable strategy + (`bellman_value_attained_measurable`). The two halves are independent: + the strategy attains the value pointwise in `h₀`, hence after + integration against *any* initial coupling, and the coupling then + minimises what is left. -/ +theorem bellman_value_attained_multi (T : ℕ) + (μ₀ : Measure (X 0)) [IsProbabilityMeasure μ₀] + (ν₀ : Measure (Y 0)) [IsProbabilityMeasure ν₀] + (hκμ_cont : ∀ t, Continuous (κμP t)) + (hκν_cont : ∀ t, Continuous (κνP t)) + (hc : ∀ t, LowerSemicontinuous (c t)) : + ∃ (γ₀ : Measure (X 0 × Y 0)) (γopt : Strat X Y), + γ₀ ∈ CouplingSet₀ μ₀ ν₀ ∧ + IsProbabilityMeasure γ₀ ∧ + (∀ t h, γopt t h ∈ Feas (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t h) ∧ + (∀ t, ∃ φ : PairHist X Y t → WeakP (X (t + 1) × Y (t + 1)), + Measurable φ ∧ ∀ h, γopt t h = (φ h).toMeasure) ∧ + ∫⁻ h₀, costGo c γopt T 0 h₀ ∂γ₀ + = ⨅ (γ₀' : Measure (X 0 × Y 0)) (γ : Strat X Y) + (_ : γ₀' ∈ CouplingSet₀ μ₀ ν₀) + (_ : ∀ t h, γ t h ∈ Feas + (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t h), + ∫⁻ h₀, costGo c γ T 0 h₀ ∂γ₀' := by + obtain ⟨γopt, hfeas, hφ, hcost⟩ := + bellman_value_attained_measurable κμP κνP c T hκμ_cont hκν_cont hc + obtain ⟨γ₀, hγ₀mem, hγ₀prob, hγ₀min⟩ := + exists_optimal_initial_coupling κμP κνP c T μ₀ ν₀ hκμ_cont hκν_cont hc + refine ⟨γ₀, γopt, hγ₀mem, hγ₀prob, hfeas, hφ, ?_⟩ + have hmulti := + bellman_value_eq_multi' (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) c T μ₀ ν₀ + (fun _ _ => inferInstance) (fun _ _ => inferInstance) + calc ∫⁻ h₀, costGo c γopt T 0 h₀ ∂γ₀ + = ∫⁻ h₀, VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) T 0 h₀ ∂γ₀ := + lintegral_congr fun h₀ => hcost h₀ + _ = ⨅ (γ₀' : Measure (X 0 × Y 0)) (_ : γ₀' ∈ CouplingSet₀ μ₀ ν₀), + ∫⁻ h₀, VGo c (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) T 0 h₀ ∂γ₀' := + hγ₀min + _ = ⨅ (γ₀' : Measure (X 0 × Y 0)) (γ : Strat X Y) + (_ : γ₀' ∈ CouplingSet₀ μ₀ ν₀) + (_ : ∀ t h, γ t h ∈ Feas + (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t h), + ∫⁻ h₀, costGo c γ T 0 h₀ ∂γ₀' := hmulti.symm + +/-- **Phase 5, full attainment — competitor form.** Unfolding the infimum + of `bellman_value_attained_multi`: the exhibited pair `(γ₀*, γopt)` is + feasible, its strategy half is plain-Borel measurable, and no feasible + competitor `(γ₀', γ)` does better. This is the statement "the + `T`-period bicausal optimal transport problem has an optimal solution" + in the Feller/lsc model. -/ +theorem exists_minimizing_pair_multi (T : ℕ) + (μ₀ : Measure (X 0)) [IsProbabilityMeasure μ₀] + (ν₀ : Measure (Y 0)) [IsProbabilityMeasure ν₀] + (hκμ_cont : ∀ t, Continuous (κμP t)) + (hκν_cont : ∀ t, Continuous (κνP t)) + (hc : ∀ t, LowerSemicontinuous (c t)) : + ∃ (γ₀ : Measure (X 0 × Y 0)) (γopt : Strat X Y), + γ₀ ∈ CouplingSet₀ μ₀ ν₀ ∧ + (∀ t h, γopt t h ∈ Feas (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t h) ∧ + (∀ t, ∃ φ : PairHist X Y t → WeakP (X (t + 1) × Y (t + 1)), + Measurable φ ∧ ∀ h, γopt t h = (φ h).toMeasure) ∧ + ∀ (γ₀' : Measure (X 0 × Y 0)) (γ : Strat X Y), + γ₀' ∈ CouplingSet₀ μ₀ ν₀ → + (∀ t h, γ t h ∈ Feas (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t h) → + ∫⁻ h₀, costGo c γopt T 0 h₀ ∂γ₀ + ≤ ∫⁻ h₀, costGo c γ T 0 h₀ ∂γ₀' := by + obtain ⟨γ₀, γopt, hγ₀mem, -, hfeas, hφ, hval⟩ := + bellman_value_attained_multi κμP κνP c T μ₀ ν₀ hκμ_cont hκν_cont hc + refine ⟨γ₀, γopt, hγ₀mem, hfeas, hφ, fun γ₀' γ hmem' hfeas' => ?_⟩ + rw [hval] + exact iInf_le_of_le γ₀' (iInf_le_of_le γ + (iInf_le_of_le hmem' (iInf_le _ hfeas'))) +end MultiPeriod + +end diff --git a/LeanPool/BicausalOT/BicausalOT/MeasurableFeasibleStrategy.lean b/LeanPool/BicausalOT/BicausalOT/MeasurableFeasibleStrategy.lean new file mode 100644 index 0000000000..3844b4854f --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/MeasurableFeasibleStrategy.lean @@ -0,0 +1,146 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Measurable feasible strategies in the Borel model (front E3-D) + + Blueprint: BLUEPRINT.md §4F File 4; design_krn.md §4.2. Without any + continuity (Feller) or cost hypotheses, plain-Borel-measurable + bicausal Markov strategies exist: the feasibility correspondence has + compact (closed) nonempty values, and its hit-sets against open sets + are Borel — the open set decomposes into countably many closed sets + (Fσ), each closed hit-set of the couplings correspondence is closed + in the weak topology (U4), and it pulls back along the marginal-pair + map, which is measurable under the honest hypothesis that the kernels + are weak-Borel measurable (`WeakP`-valued measurability; Giry + measurability would NOT suffice — that is the open PR3 direction). + Kuratowski–Ryll-Nardzewski then selects measurably. +-/ +import LeanPool.BicausalOT.BicausalOT.LscBellman + +open MeasureTheory Set Filter Topology +open scoped ENNReal + +noncomputable section + +namespace MultiPeriod + +variable {X Y : ℕ → Type*} + [∀ n, TopologicalSpace (X n)] [∀ n, PolishSpace (X n)] + [∀ n, MeasurableSpace (X n)] [∀ n, BorelSpace (X n)] + [∀ n, TopologicalSpace (Y n)] [∀ n, PolishSpace (Y n)] + [∀ n, MeasurableSpace (Y n)] [∀ n, BorelSpace (Y n)] + +variable (κμP : (t : ℕ) → XHist X t → ProbabilityMeasure (X (t + 1))) +variable (κνP : (t : ℕ) → YHist Y t → ProbabilityMeasure (Y (t + 1))) + +/-- Hit-sets of the feasibility fibers against open sets are Borel, for + weak-Borel measurable kernels: Fσ decomposition of the open set and + transport of the closed couplings hit-sets (U4) along the measurable + marginal-pair map. -/ +theorem measurableSet_feasGraph_fiber_hit_of_measurable + (hκμ_measW : ∀ t, @Measurable (XHist X t) (WeakP (X (t + 1))) + _ _ (κμP t)) + (hκν_measW : ∀ t, @Measurable (YHist Y t) (WeakP (Y (t + 1))) + _ _ (κνP t)) (t : ℕ) + {U : Set (WeakP (X (t + 1) × Y (t + 1)))} (hU : IsOpen U) : + MeasurableSet {h : PairHist X Y t | + ({γ | (h, γ) ∈ FeasGraph (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t} ∩ U).Nonempty} := by + obtain ⟨C, hCclosed, hUeq⟩ := hU.exists_iUnion_isClosed_of_pseudoMetrizable + have hsplit : {h : PairHist X Y t | + ({γ | (h, γ) ∈ FeasGraph (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t} ∩ U).Nonempty} + = ⋃ n, {h : PairHist X Y t | + ({γ | (h, γ) ∈ FeasGraph (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t} ∩ C n).Nonempty} := by + rw [hUeq] + ext h + simp only [Set.mem_ofPred_eq, Set.mem_iUnion] + constructor + · rintro ⟨γ, hγfib, hγU⟩ + obtain ⟨n, hγn⟩ := Set.mem_iUnion.mp hγU + exact ⟨n, γ, hγfib, hγn⟩ + · rintro ⟨n, γ, hγfib, hγn⟩ + exact ⟨γ, hγfib, Set.mem_iUnion.mpr ⟨n, hγn⟩⟩ + rw [hsplit] + refine MeasurableSet.iUnion fun n => ?_ + -- the marginal-pair map is measurable into the WeakP product + have hm : @Measurable (PairHist X Y t) + (WeakP (X (t + 1)) × WeakP (Y (t + 1))) _ _ + (fun h => (κμP t (projX t h), κνP t (projY t h))) := + ((hκμ_measW t).comp (measurable_projX t)).prodMk + ((hκν_measW t).comp (measurable_projY t)) + -- the closed couplings hit-set is Borel in the WeakP product + have hhit : IsClosed {p : ProbabilityMeasure (X (t + 1)) + × ProbabilityMeasure (Y (t + 1)) | + ∃ γ : ProbabilityMeasure ((X (t + 1)) × (Y (t + 1))), γ ∈ C n ∧ + (γ : Measure ((X (t + 1)) × (Y (t + 1)))).map Prod.fst + = (p.1 : Measure (X (t + 1))) ∧ + (γ : Measure ((X (t + 1)) × (Y (t + 1)))).map Prod.snd + = (p.2 : Measure (Y (t + 1)))} := + isClosed_couplings_hit (hCclosed n) + have hhitW : IsClosed {p : WeakP (X (t + 1)) × WeakP (Y (t + 1)) | + ∃ γ : ProbabilityMeasure ((X (t + 1)) × (Y (t + 1))), γ ∈ C n ∧ + (γ : Measure ((X (t + 1)) × (Y (t + 1)))).map Prod.fst + = p.1.toMeasure ∧ + (γ : Measure ((X (t + 1)) × (Y (t + 1)))).map Prod.snd + = p.2.toMeasure} := hhit + have hhitmeas := hhitW.measurableSet + have hset : {h : PairHist X Y t | + ({γ | (h, γ) ∈ FeasGraph (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t} ∩ C n).Nonempty} + = (fun h : PairHist X Y t => + ((κμP t (projX t h), κνP t (projY t h)) + : WeakP (X (t + 1)) × WeakP (Y (t + 1)))) ⁻¹' + {p : WeakP (X (t + 1)) × WeakP (Y (t + 1)) | + ∃ γ : ProbabilityMeasure ((X (t + 1)) × (Y (t + 1))), γ ∈ C n ∧ + (γ : Measure ((X (t + 1)) × (Y (t + 1)))).map Prod.fst + = p.1.toMeasure ∧ + (γ : Measure ((X (t + 1)) × (Y (t + 1)))).map Prod.snd + = p.2.toMeasure} := by + ext h + simp only [Set.mem_ofPred_eq, Set.mem_preimage] + constructor + · rintro ⟨γ, hγfib, hγC⟩ + exact ⟨γ, hγC, hγfib.1, hγfib.2⟩ + · rintro ⟨γ, hγC, hfst, hsnd⟩ + exact ⟨γ, ⟨hfst, hsnd⟩, hγC⟩ + rw [hset] + exact hm hhitmeas + +/-- **Measurable feasible strategies exist (E3-D).** In the Borel model — + weak-Borel measurable probability kernels, no continuity and no cost + hypotheses — there is a strategy that is pointwise feasible and + plain-Borel measurable at every stage: measurable bicausal Markov + strategies exist. -/ +theorem exists_measurable_feasible_strategy + (hκμ_measW : ∀ t, @Measurable (XHist X t) (WeakP (X (t + 1))) + _ _ (κμP t)) + (hκν_measW : ∀ t, @Measurable (YHist Y t) (WeakP (Y (t + 1))) + _ _ (κνP t)) : + ∃ γfeas : Strat X Y, + (∀ t h, γfeas t h ∈ Feas (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t h) ∧ + (∀ t, ∃ φ : PairHist X Y t → WeakP (X (t + 1) × Y (t + 1)), + Measurable φ ∧ ∀ h, γfeas t h = (φ h).toMeasure) := by + have key : ∀ t : ℕ, ∃ φ : PairHist X Y t → WeakP (X (t + 1) × Y (t + 1)), + Measurable φ ∧ ∀ h, (h, φ h) ∈ FeasGraph + (fun t x => (κμP t x : Measure (X (t + 1)))) + (fun t y => (κνP t y : Measure (Y (t + 1)))) t := by + intro t + exact WeakP.exists_measurable_selection + (fun h => feasGraph_fiber_nonempty' κμP κνP t h) + (fun h => (isCompact_feasGraph_fiber κμP κνP t h).isClosed) + (fun U hU => measurableSet_feasGraph_fiber_hit_of_measurable + κμP κνP hκμ_measW hκν_measW t hU) + choose φ hφmeas hφmem using key + exact ⟨fun t h => (φ t h).toMeasure, + fun t h => hφmem t h, + fun t => ⟨φ t, hφmeas t, fun h => rfl⟩⟩ + +end MultiPeriod + +end diff --git a/LeanPool/BicausalOT/BicausalOT/MeasurableStrategy.lean b/LeanPool/BicausalOT/BicausalOT/MeasurableStrategy.lean new file mode 100644 index 0000000000..7c4935f5ff --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/MeasurableStrategy.lean @@ -0,0 +1,202 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Phase 4: ε-optimal analytically measurable strategies + (Bertsekas–Shreve Proposition 7.50 analogue, multi-period bicausal OT) + + Blueprint: BLUEPRINT.md §4 + docs/design_phase4.md. Architecture: for + each stage `t`, the abstract selection theorem + `exists_eps_optimal_selector` (EpsOptimalSelection.lean) is applied to + the feasibility graph `FeasGraph` (Borel, hence analytic, by the Giry + equalizer — Phase 3) and the integrated tail value + `(h, γ) ↦ ∫⁻ z, VGo (T−t−1) (t+1) (h,z) ∂γ` (lower semianalytic by + BS 7.48 applied to the evaluation kernel, with the integrand lower + semianalytic by Phase 3). This upgrades the pointwise-choice strategy + of `exists_eps_strategy` (L3) to one that is σ(Σ¹₁)-measurable at + every stage, and the Bellman value representation restricts to such + strategies without changing its value. +-/ +import LeanPool.BicausalOT.BicausalOT.SemianalyticValue +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.EpsOptimalSelection + +open MeasureTheory Set ENNReal + +noncomputable section + +namespace MultiPeriod + +variable {X Y : ℕ → Type*} + [∀ n, TopologicalSpace (X n)] [∀ n, PolishSpace (X n)] + [∀ n, MeasurableSpace (X n)] [∀ n, BorelSpace (X n)] + [∀ n, TopologicalSpace (Y n)] [∀ n, PolishSpace (Y n)] + [∀ n, MeasurableSpace (Y n)] [∀ n, BorelSpace (Y n)] + +variable (κμ : (t : ℕ) → XHist X t → Measure (X (t + 1))) +variable (κν : (t : ℕ) → YHist Y t → Measure (Y (t + 1))) +variable (c : (t : ℕ) → PairHist X Y t → ℝ≥0∞) + +/-! ## Fibers of the feasibility graph -/ + +omit [∀ n, TopologicalSpace (X n)] [∀ n, PolishSpace (X n)] + [∀ n, BorelSpace (X n)] [∀ n, TopologicalSpace (Y n)] + [∀ n, PolishSpace (Y n)] [∀ n, BorelSpace (Y n)] in +/-- Fibers of the feasibility graph are nonempty when the one-step + feasible sets are: feasible plans of probability marginals are + probability measures (L0). -/ +theorem feasGraph_fiber_nonempty + (hκμ_prob : ∀ t x, IsProbabilityMeasure (κμ t x)) + (hne : ∀ t (h : PairHist X Y t), (Feas κμ κν t h).Nonempty) + (t : ℕ) (h : PairHist X Y t) : + ∃ γ : WeakP (X (t + 1) × Y (t + 1)), (h, γ) ∈ FeasGraph κμ κν t := by + obtain ⟨γm, hγm⟩ := hne t h + haveI hpm : IsProbabilityMeasure γm := + ⟨Feas.measure_univ κμ κν hκμ_prob hγm⟩ + exact ⟨show WeakP (X (t + 1) × Y (t + 1)) from + (⟨γm, hpm⟩ : ProbabilityMeasure (X (t + 1) × Y (t + 1))), hγm⟩ + +/-! ## The stage objective is lower semianalytic (BS 7.48) -/ + +/-- The integrated tail value is lower semianalytic on the product of the + history space with the space of probability measures: BS 7.48 applied + to the evaluation kernel `(h, γ) ↦ γ` + (`lintegral_weakP_lowerSemianalytic`), with the integrand lower + semianalytic by Phase 3. -/ +theorem stageF_lowerSemianalytic + (hκμ_meas : ∀ t, Measurable (κμ t)) + (hκν_meas : ∀ t, Measurable (κν t)) + (hκμ_prob : ∀ t x, IsProbabilityMeasure (κμ t x)) + (hκν_prob : ∀ t y, IsProbabilityMeasure (κν t y)) + (hc : ∀ t, IsLowerSemianalytic (c t)) (k t : ℕ) : + IsLowerSemianalytic + (fun p : PairHist X Y t × WeakP (X (t + 1) × Y (t + 1)) => + ∫⁻ z, VGo c κμ κν k (t + 1) (p.1, z) ∂p.2.toMeasure) := + lintegral_weakP_lowerSemianalytic t + (VGo_isLowerSemianalytic κμ κν c hκμ_meas hκν_meas hκμ_prob + hκν_prob hc k (t + 1)) + +/-! ## Main theorem: measurable ε-optimal strategies -/ + +/-- **Phase 4 (BS Proposition 7.50 analogue).** For Borel Markov kernels + and lower semianalytic stage costs, the ε-optimal strategy of + `exists_eps_strategy` can be chosen σ(Σ¹₁)-measurable at every stage: + each `γε t` factors through an `AnalyticallyMeasurable` map into the + Polish space of probability measures. -/ +theorem exists_eps_strategy_analyticallyMeasurable (T : ℕ) + (hκμ_meas : ∀ t, Measurable (κμ t)) + (hκν_meas : ∀ t, Measurable (κν t)) + (hκμ_prob : ∀ t x, IsProbabilityMeasure (κμ t x)) + (hκν_prob : ∀ t y, IsProbabilityMeasure (κν t y)) + (hc : ∀ t, IsLowerSemianalytic (c t)) + (hne : ∀ t (h : PairHist X Y t), (Feas κμ κν t h).Nonempty) + {ε : ℝ≥0∞} (hε : 0 < ε) : + ∃ γε : Strat X Y, + (∀ t h, γε t h ∈ Feas κμ κν t h) ∧ + (∀ t (h : PairHist X Y t), + ∫⁻ z, VGo c κμ κν (T - t - 1) (t + 1) (h, z) ∂(γε t h) + ≤ (⨅ (γm : Measure (X (t + 1) × Y (t + 1))) + (_ : γm ∈ Feas κμ κν t h), + ∫⁻ z, VGo c κμ κν (T - t - 1) (t + 1) (h, z) ∂γm) + ε) ∧ + (∀ t, ∃ φ : PairHist X Y t → WeakP (X (t + 1) × Y (t + 1)), + AnalyticallyMeasurable φ ∧ ∀ h, γε t h = (φ h).toMeasure) := by + have key : ∀ t : ℕ, + ∃ φ : PairHist X Y t → WeakP (X (t + 1) × Y (t + 1)), + AnalyticallyMeasurable φ ∧ + (∀ h, (h, φ h) ∈ FeasGraph κμ κν t) ∧ + ∀ h, (∫⁻ z, VGo c κμ κν (T - t - 1) (t + 1) (h, z) ∂(φ h).toMeasure) + ≤ (⨅ (γ : WeakP (X (t + 1) × Y (t + 1))) + (_ : (h, γ) ∈ FeasGraph κμ κν t), + ∫⁻ z, VGo c κμ κν (T - t - 1) (t + 1) (h, z) ∂γ.toMeasure) + + ε := + fun t => exists_eps_optimal_selector + ((measurableSet_feasGraph κμ κν hκμ_meas hκν_meas hκμ_prob + hκν_prob t).analyticSet) + (stageF_lowerSemianalytic κμ κν c hκμ_meas hκν_meas hκμ_prob + hκν_prob hc (T - t - 1) t) + (feasGraph_fiber_nonempty κμ κν hκμ_prob hne t) hε + choose φ hφmeas hφmem hφopt using key + refine ⟨fun t h => (φ t h).toMeasure, + fun t h => hφmem t h, + fun t h => ?_, + fun t => ⟨φ t, hφmeas t, fun h => rfl⟩⟩ + rw [iInf_feas_eq_iInf_feasGraph κμ κν hκμ_prob t h] + exact hφopt t h + +/-! ## Corollary: measurability is free in the Bellman value -/ + +/-- **Corollary (Phase 4).** The multi-period Bellman value + representation holds with the strategy infimum restricted to + strategies that are σ(Σ¹₁)-measurable at every stage — measurability + costs nothing in the value. Upper bound via the measurable ε-optimal + strategy and L4; lower bound inherited from `bellman_value_eq_multi`. -/ +theorem bellman_value_eq_multi_measurable (T : ℕ) + (μ₀ : Measure (X 0)) [IsProbabilityMeasure μ₀] + (ν₀ : Measure (Y 0)) [IsProbabilityMeasure ν₀] + (hκμ_meas : ∀ t, Measurable (κμ t)) + (hκν_meas : ∀ t, Measurable (κν t)) + (hκμ_prob : ∀ t x, IsProbabilityMeasure (κμ t x)) + (hκν_prob : ∀ t y, IsProbabilityMeasure (κν t y)) + (hc : ∀ t, IsLowerSemianalytic (c t)) + (hne : ∀ t (h : PairHist X Y t), (Feas κμ κν t h).Nonempty) : + ⨅ (γ₀ : Measure (X 0 × Y 0)) (γ : Strat X Y) + (_ : γ₀ ∈ CouplingSet₀ μ₀ ν₀) + (_ : ∀ t h, γ t h ∈ Feas κμ κν t h) + (_ : ∀ t, ∃ φ : PairHist X Y t → WeakP (X (t + 1) × Y (t + 1)), + AnalyticallyMeasurable φ ∧ ∀ h, γ t h = (φ h).toMeasure), + ∫⁻ h₀, costGo c γ T 0 h₀ ∂γ₀ + = ⨅ (γ₀ : Measure (X 0 × Y 0)) (_ : γ₀ ∈ CouplingSet₀ μ₀ ν₀), + ∫⁻ h₀, VGo c κμ κν T 0 h₀ ∂γ₀ := by + refine le_antisymm ?_ ?_ + · -- upper bound via measurable ε-optimal strategies + refine le_iInf fun γ₀ => le_iInf fun h₀mem => ?_ + have hγ₀mass : γ₀ Set.univ = 1 := by + have h1 : (γ₀.map Prod.fst) Set.univ = 1 := by + rw [h₀mem.1]; exact measure_univ + rwa [Measure.map_apply measurable_fst MeasurableSet.univ, + Set.preimage_univ] at h1 + rcases Nat.eq_zero_or_pos T with rfl | hT + · -- T = 0: cost and value both reduce to the stage-0 cost + obtain ⟨γ1, hmem1, -, hφ1⟩ := + exists_eps_strategy_analyticallyMeasurable κμ κν c 0 hκμ_meas + hκν_meas hκμ_prob hκν_prob hc hne (ε := 1) zero_lt_one + refine le_trans (iInf_le_of_le γ₀ (iInf_le_of_le γ1 + (iInf_le_of_le h₀mem (iInf_le_of_le hmem1 (iInf_le _ hφ1))))) ?_ + exact le_of_eq rfl + · refine ENNReal.le_of_forall_pos_le_add fun ε hε _ => ?_ + set δ : ℝ≥0∞ := (ε : ℝ≥0∞) / T with hδ + have hδpos : 0 < δ := + ENNReal.div_pos (by exact_mod_cast hε.ne') (by finiteness) + obtain ⟨γε, hmem, hopt, hφ⟩ := + exists_eps_strategy_analyticallyMeasurable κμ κν c T hκμ_meas + hκν_meas hκμ_prob hκν_prob hc hne hδpos + have hbound : ∀ h₀ : PairHist X Y 0, + costGo c γε T 0 h₀ ≤ VGo c κμ κν T 0 h₀ + (T : ℝ≥0∞) * δ := + fun h₀ => costGo_le_VGo_add κμ κν c T hκμ_prob γε hmem hopt T 0 + (by omega) h₀ + have hTδ : (T : ℝ≥0∞) * δ = (ε : ℝ≥0∞) := by + rw [hδ] + exact ENNReal.mul_div_cancel (by exact_mod_cast hT.ne') + (by finiteness) + refine le_trans (iInf_le_of_le γ₀ (iInf_le_of_le γε + (iInf_le_of_le h₀mem (iInf_le_of_le hmem (iInf_le _ hφ))))) ?_ + calc ∫⁻ h₀, costGo c γε T 0 h₀ ∂γ₀ + ≤ ∫⁻ h₀, (VGo c κμ κν T 0 h₀ + (T : ℝ≥0∞) * δ) ∂γ₀ := + lintegral_mono hbound + _ = ∫⁻ h₀, VGo c κμ κν T 0 h₀ ∂γ₀ + (T : ℝ≥0∞) * δ := by + have hsplit := lintegral_add_right (μ := γ₀) + (fun h₀ : X 0 × Y 0 => VGo c κμ κν T 0 h₀) + (g := fun _ : X 0 × Y 0 => (T : ℝ≥0∞) * δ) measurable_const + rw [hsplit, lintegral_const, hγ₀mass, mul_one] + _ = ∫⁻ h₀, VGo c κμ κν T 0 h₀ ∂γ₀ + (ε : ℝ≥0∞) := by rw [hTδ] + · -- lower bound: restricting the infimum can only increase it + rw [← bellman_value_eq_multi κμ κν c T μ₀ ν₀ hκμ_prob hne] + refine le_iInf fun γ₀ => le_iInf fun γ => le_iInf fun h₀mem => + le_iInf fun hfeas => le_iInf fun _ => ?_ + exact iInf_le_of_le γ₀ (iInf_le_of_le γ (iInf_le_of_le h₀mem + (iInf_le _ hfeas))) + +end MultiPeriod + +end diff --git a/LeanPool/BicausalOT/BicausalOT/MultiPeriod.lean b/LeanPool/BicausalOT/BicausalOT/MultiPeriod.lean new file mode 100644 index 0000000000..070dc499c3 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/MultiPeriod.lean @@ -0,0 +1,260 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Multi-period Bicausal OT — general finite horizon T + + Blueprint: BLUEPRINT.md §2 (Phase 1–2). Design: nested-product + histories, time-to-go recursion, arbitrary function strategies. + Target theorem: `bellman_value_eq_multi`. +-/ +import LeanPool.BicausalOT.BicausalOT.Defs +import LeanPool.BicausalOT.BicausalOT.UpperBound +import Mathlib.MeasureTheory.Integral.Lebesgue.Add + +open MeasureTheory Set ENNReal + +noncomputable section + +namespace MultiPeriod + +variable (X Y : ℕ → Type*) + +/-- D1: pair-history up to time `t`, as nested products. Appending one + step is literally pairing `(h, z)`. -/ +def PairHist : ℕ → Type _ + | 0 => X 0 × Y 0 + | t + 1 => PairHist t × (X (t + 1) × Y (t + 1)) + +/-- D2: X-side history. -/ +def XHist : ℕ → Type _ + | 0 => X 0 + | t + 1 => XHist t × X (t + 1) + +/-- D2: Y-side history. -/ +def YHist : ℕ → Type _ + | 0 => Y 0 + | t + 1 => YHist t × Y (t + 1) + +variable {X Y} + +/-- D3: X-side projection of a pair-history. -/ +def projX : (t : ℕ) → PairHist X Y t → XHist X t + | 0, h => h.1 + | t + 1, hz => (projX t hz.1, hz.2.1) + +/-- D3: Y-side projection of a pair-history. -/ +def projY : (t : ℕ) → PairHist X Y t → YHist Y t + | 0, h => h.2 + | t + 1, hz => (projY t hz.1, hz.2.2) + +variable [∀ n, MeasurableSpace (X n)] [∀ n, MeasurableSpace (Y n)] + +variable (κμ : (t : ℕ) → XHist X t → Measure (X (t + 1))) +variable (κν : (t : ℕ) → YHist Y t → Measure (Y (t + 1))) +variable (c : (t : ℕ) → PairHist X Y t → ℝ≥0∞) + +/-- D5: one-step feasible couplings after history `h`: couplings of the + conditional marginals. -/ +def Feas (t : ℕ) (h : PairHist X Y t) : + Set (Measure (X (t + 1) × Y (t + 1))) := + {γ | γ.map Prod.fst = κμ t (projX t h) ∧ γ.map Prod.snd = κν t (projY t h)} + +/-- D6: a strategy is an arbitrary family of one-step transition plans + (no measurability imposed; mirrors the T=1 design). -/ +def Strat (X Y : ℕ → Type*) + [∀ n, MeasurableSpace (X n)] [∀ n, MeasurableSpace (Y n)] : Type _ := + (t : ℕ) → PairHist X Y t → Measure (X (t + 1) × Y (t + 1)) + +variable {κμ κν} + +/-- D7: cost-to-go with `k` remaining periods, starting at time `t`. -/ +def costGo (γ : Strat X Y) : (k : ℕ) → (t : ℕ) → PairHist X Y t → ℝ≥0∞ + | 0, t, h => c t h + | k + 1, t, h => c t h + ∫⁻ z, costGo γ k (t + 1) (h, z) ∂(γ t h) + +/-- D8: Bellman value with `k` remaining periods. -/ +def VGo (κμ : (t : ℕ) → XHist X t → Measure (X (t + 1))) + (κν : (t : ℕ) → YHist Y t → Measure (Y (t + 1))) : + (k : ℕ) → (t : ℕ) → PairHist X Y t → ℝ≥0∞ + | 0, t, h => c t h + | k + 1, t, h => c t h + + ⨅ (γm : Measure (X (t + 1) × Y (t + 1))) (_ : γm ∈ Feas κμ κν t h), + ∫⁻ z, VGo κμ κν k (t + 1) (h, z) ∂γm + +variable (κμ κν) + +/-- L0: feasible one-step plans are probability measures when the + conditional marginals are. -/ +theorem Feas.measure_univ + (hκμ : ∀ t x, IsProbabilityMeasure (κμ t x)) + {t : ℕ} {h : PairHist X Y t} + {γm : Measure (X (t + 1) × Y (t + 1))} (hγ : γm ∈ Feas κμ κν t h) : + γm Set.univ = 1 := by + have h1 : (γm.map Prod.fst) Set.univ = 1 := by + rw [hγ.1] + exact (hκμ t (projX t h)).measure_univ + rwa [Measure.map_apply measurable_fst MeasurableSet.univ, + Set.preimage_univ] at h1 + +/-- L1: pointwise Bellman bound at any feasible one-step plan. -/ +theorem VGo_le_pointwise {t k : ℕ} {h : PairHist X Y t} + {γm : Measure (X (t + 1) × Y (t + 1))} (hγ : γm ∈ Feas κμ κν t h) : + VGo c κμ κν (k + 1) t h + ≤ c t h + ∫⁻ z, VGo c κμ κν k (t + 1) (h, z) ∂γm := by + show c t h + _ ≤ _ + gcongr + exact iInf₂_le γm hγ + +/-- L2: the Bellman value bounds the cost of every feasible strategy, + pointwise in the history. Backward induction on the time to go. -/ +theorem VGo_le_costGo (γ : Strat X Y) + (hfeas : ∀ t h, γ t h ∈ Feas κμ κν t h) : + ∀ (k t : ℕ) (h : PairHist X Y t), + VGo c κμ κν k t h ≤ costGo c γ k t h + | 0, _, _ => le_of_eq rfl + | k + 1, t, h => by + refine le_trans (VGo_le_pointwise κμ κν c (hfeas t h)) ?_ + show c t h + _ ≤ c t h + _ + gcongr with z + exact VGo_le_costGo γ hfeas k (t + 1) (h, z) + +/-- L3: an ε-optimal strategy for a fixed horizon `T`: at each stage the + chosen plan is ε-optimal for the time-consistent depth `T - t - 1` + (the only depth at which `costGo _ T 0` ever evaluates it). -/ +theorem exists_eps_strategy (T : ℕ) + (hne : ∀ t (h : PairHist X Y t), (Feas κμ κν t h).Nonempty) + {ε : ℝ≥0∞} (hε : 0 < ε) : + ∃ γε : Strat X Y, + (∀ t h, γε t h ∈ Feas κμ κν t h) ∧ + ∀ t (h : PairHist X Y t), + ∫⁻ z, VGo c κμ κν (T - t - 1) (t + 1) (h, z) ∂(γε t h) + ≤ (⨅ (γm : Measure (X (t + 1) × Y (t + 1))) + (_ : γm ∈ Feas κμ κν t h), + ∫⁻ z, VGo c κμ κν (T - t - 1) (t + 1) (h, z) ∂γm) + ε := by + have key : ∀ t (h : PairHist X Y t), + ∃ γm ∈ Feas κμ κν t h, + ∫⁻ z, VGo c κμ κν (T - t - 1) (t + 1) (h, z) ∂γm + ≤ (⨅ (γm' : Measure (X (t + 1) × Y (t + 1))) + (_ : γm' ∈ Feas κμ κν t h), + ∫⁻ z, VGo c κμ κν (T - t - 1) (t + 1) (h, z) ∂γm') + ε := + fun t h => eps_optimal_element (Feas κμ κν t h) (hne t h) + (fun γm => ∫⁻ z, VGo c κμ κν (T - t - 1) (t + 1) (h, z) ∂γm) ε hε + choose γε hmem hopt using key + exact ⟨γε, hmem, hopt⟩ + +/-- L4: over `k` remaining periods (with `t + k = T`), the ε-optimal + strategy overshoots the Bellman value by at most `k·ε`. -/ +theorem costGo_le_VGo_add (T : ℕ) + (hκμ : ∀ t x, IsProbabilityMeasure (κμ t x)) + (γε : Strat X Y) (hmem : ∀ t h, γε t h ∈ Feas κμ κν t h) + {ε : ℝ≥0∞} + (hopt : ∀ t (h : PairHist X Y t), + ∫⁻ z, VGo c κμ κν (T - t - 1) (t + 1) (h, z) ∂(γε t h) + ≤ (⨅ (γm : Measure (X (t + 1) × Y (t + 1))) + (_ : γm ∈ Feas κμ κν t h), + ∫⁻ z, VGo c κμ κν (T - t - 1) (t + 1) (h, z) ∂γm) + ε) : + ∀ (k t : ℕ), t + k = T → ∀ h : PairHist X Y t, + costGo c γε k t h ≤ VGo c κμ κν k t h + (k : ℝ≥0∞) * ε + | 0, t, _, h => by simp [costGo, VGo] + | k + 1, t, htk, h => by + have hdepth : T - t - 1 = k := by omega + have hmass : (γε t h) Set.univ = 1 := + Feas.measure_univ κμ κν hκμ (hmem t h) + calc costGo c γε (k + 1) t h + = c t h + ∫⁻ z, costGo c γε k (t + 1) (h, z) ∂(γε t h) := rfl + _ ≤ c t h + ∫⁻ z, (VGo c κμ κν k (t + 1) (h, z) + (k : ℝ≥0∞) * ε) + ∂(γε t h) := by + gcongr with z + exact costGo_le_VGo_add T hκμ γε hmem hopt k (t + 1) (by omega) (h, z) + _ = c t h + (∫⁻ z, VGo c κμ κν k (t + 1) (h, z) ∂(γε t h) + + (k : ℝ≥0∞) * ε) := by + rw [lintegral_add_right _ measurable_const, lintegral_const, + hmass, mul_one] + _ ≤ c t h + (((⨅ (γm : Measure (X (t + 1) × Y (t + 1))) + (_ : γm ∈ Feas κμ κν t h), + ∫⁻ z, VGo c κμ κν k (t + 1) (h, z) ∂γm) + ε) + + (k : ℝ≥0∞) * ε) := by + gcongr + have hstep := hopt t h + rw [hdepth] at hstep + exact hstep + _ = VGo c κμ κν (k + 1) t h + ((k : ℕ) + 1 : ℝ≥0∞) * ε := by + show c t h + _ = (c t h + _) + _ + ring + _ = VGo c κμ κν (k + 1) t h + ((k + 1 : ℕ) : ℝ≥0∞) * ε := by + push_cast + ring + +/-- Main theorem (Phase 2): multi-period Bellman value representation. + The infimum of the total cost over initial couplings and pointwise + feasible strategies equals the infimum over initial couplings of the + integrated Bellman value. -/ +theorem bellman_value_eq_multi (T : ℕ) + (μ₀ : Measure (X 0)) [IsProbabilityMeasure μ₀] + (ν₀ : Measure (Y 0)) [IsProbabilityMeasure ν₀] + (hκμ : ∀ t x, IsProbabilityMeasure (κμ t x)) + (hne : ∀ t (h : PairHist X Y t), (Feas κμ κν t h).Nonempty) : + ⨅ (γ₀ : Measure (X 0 × Y 0)) (γ : Strat X Y) + (_ : γ₀ ∈ CouplingSet₀ μ₀ ν₀) + (_ : ∀ t h, γ t h ∈ Feas κμ κν t h), + ∫⁻ h₀, costGo c γ T 0 h₀ ∂γ₀ + = ⨅ (γ₀ : Measure (X 0 × Y 0)) (_ : γ₀ ∈ CouplingSet₀ μ₀ ν₀), + ∫⁻ h₀, VGo c κμ κν T 0 h₀ ∂γ₀ := by + refine le_antisymm ?_ ?_ + · -- upper bound via ε-optimal strategies + refine le_iInf fun γ₀ => le_iInf fun h₀mem => ?_ + have hγ₀mass : γ₀ Set.univ = 1 := by + have h1 : (γ₀.map Prod.fst) Set.univ = 1 := by + rw [h₀mem.1]; exact measure_univ + rwa [Measure.map_apply measurable_fst MeasurableSet.univ, + Set.preimage_univ] at h1 + rcases Nat.eq_zero_or_pos T with rfl | hT + · -- T = 0: cost and value both reduce to the stage-0 cost + refine le_trans (iInf_le_of_le γ₀ (iInf_le_of_le + (fun t h => (hne t h).choose) (iInf_le_of_le h₀mem + (iInf_le _ fun t h => (hne t h).choose_spec)))) ?_ + exact le_of_eq rfl + · refine ENNReal.le_of_forall_pos_le_add fun ε hε _ => ?_ + set δ : ℝ≥0∞ := (ε : ℝ≥0∞) / T with hδ + have hδpos : 0 < δ := + ENNReal.div_pos (by exact_mod_cast hε.ne') (by finiteness) + obtain ⟨γε, hmem, hopt⟩ := exists_eps_strategy κμ κν c T hne hδpos + have hbound : ∀ h₀ : PairHist X Y 0, + costGo c γε T 0 h₀ ≤ VGo c κμ κν T 0 h₀ + (T : ℝ≥0∞) * δ := + fun h₀ => costGo_le_VGo_add κμ κν c T hκμ γε hmem hopt T 0 + (by omega) h₀ + have hTδ : (T : ℝ≥0∞) * δ = (ε : ℝ≥0∞) := by + rw [hδ] + exact ENNReal.mul_div_cancel (by exact_mod_cast hT.ne') + (by finiteness) + calc ⨅ (γ₀' : Measure (X 0 × Y 0)) (γ : Strat X Y) + (_ : γ₀' ∈ CouplingSet₀ μ₀ ν₀) + (_ : ∀ t h, γ t h ∈ Feas κμ κν t h), + ∫⁻ h₀, costGo c γ T 0 h₀ ∂γ₀' + ≤ ∫⁻ h₀, costGo c γε T 0 h₀ ∂γ₀ := by + refine le_trans (iInf_le_of_le γ₀ (iInf_le_of_le γε + (iInf_le_of_le h₀mem (iInf_le _ hmem)))) ?_ + exact le_refl _ + _ ≤ ∫⁻ h₀, (VGo c κμ κν T 0 h₀ + (T : ℝ≥0∞) * δ) ∂γ₀ := + lintegral_mono hbound + _ = ∫⁻ h₀, VGo c κμ κν T 0 h₀ ∂γ₀ + (T : ℝ≥0∞) * δ := by + have hsplit := lintegral_add_right (μ := γ₀) + (fun h₀ : X 0 × Y 0 => VGo c κμ κν T 0 h₀) + (g := fun _ : X 0 × Y 0 => (T : ℝ≥0∞) * δ) measurable_const + rw [hsplit, lintegral_const, hγ₀mass, mul_one] + _ = ∫⁻ h₀, VGo c κμ κν T 0 h₀ ∂γ₀ + (ε : ℝ≥0∞) := by rw [hTδ] + · -- lower bound: integrate L2 + refine le_iInf fun γ₀ => le_iInf fun γ => le_iInf fun h₀mem => + le_iInf fun hfeas => ?_ + calc ⨅ (γ₀' : Measure (X 0 × Y 0)) (_ : γ₀' ∈ CouplingSet₀ μ₀ ν₀), + ∫⁻ h₀, VGo c κμ κν T 0 h₀ ∂γ₀' + ≤ ∫⁻ h₀, VGo c κμ κν T 0 h₀ ∂γ₀ := iInf₂_le γ₀ h₀mem + _ ≤ ∫⁻ h₀, costGo c γ T 0 h₀ ∂γ₀ := + lintegral_mono fun h₀ => VGo_le_costGo κμ κν c γ hfeas T 0 h₀ + +end MultiPeriod + +end diff --git a/LeanPool/BicausalOT/BicausalOT/MultiPeriodTopology.lean b/LeanPool/BicausalOT/BicausalOT/MultiPeriodTopology.lean new file mode 100644 index 0000000000..e3a7d568e8 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/MultiPeriodTopology.lean @@ -0,0 +1,205 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Multi-period Bicausal OT — history-space topology and measurability + + Blueprint: BLUEPRINT.md §3 (Phase 3 prerequisite D1). Recursive + `TopologicalSpace` / `PolishSpace` / `MeasurableSpace` / `BorelSpace` + instances for the nested-product history spaces `PairHist`, `XHist`, + `YHist` of `BicausalOT.MultiPeriod`, plus continuity and measurability + of the projections `projX`, `projY`. + + Design: every instance is defined by structural recursion on the time + index; at each successor level it is *definitionally* the binary-product + instance over the previous level (via `inferInstanceAs` on the product + type), so all binary-product API applies definitionally to histories. +-/ +import LeanPool.BicausalOT.BicausalOT.MultiPeriod +import Mathlib.Topology.MetricSpace.Polish +import Mathlib.MeasureTheory.Constructions.BorelSpace.Basic + +open MeasureTheory + +noncomputable section + +namespace MultiPeriod + +variable (X Y : ℕ → Type*) + +/-! ### Topological structure + +The product topology on histories, by recursion on the time index. -/ + +section Topology + +variable [∀ n, TopologicalSpace (X n)] [∀ n, TopologicalSpace (Y n)] + +/-- Recursive product topology on pair-histories: at each successor level + this is definitionally the product topology over the previous level. -/ +instance instTopologicalSpacePairHist : ∀ t, TopologicalSpace (PairHist X Y t) + | 0 => inferInstanceAs (TopologicalSpace (X 0 × Y 0)) + | t + 1 => + letI := instTopologicalSpacePairHist t + inferInstanceAs + (TopologicalSpace (PairHist X Y t × (X (t + 1) × Y (t + 1)))) + +/-- Recursive product topology on X-side histories. -/ +instance instTopologicalSpaceXHist : ∀ t, TopologicalSpace (XHist X t) + | 0 => inferInstanceAs (TopologicalSpace (X 0)) + | t + 1 => + letI := instTopologicalSpaceXHist t + inferInstanceAs (TopologicalSpace (XHist X t × X (t + 1))) + +/-- Recursive product topology on Y-side histories. -/ +instance instTopologicalSpaceYHist : ∀ t, TopologicalSpace (YHist Y t) + | 0 => inferInstanceAs (TopologicalSpace (Y 0)) + | t + 1 => + letI := instTopologicalSpaceYHist t + inferInstanceAs (TopologicalSpace (YHist Y t × Y (t + 1))) + +variable {X Y} + +/-- The X-side projection of a pair-history is continuous. -/ +theorem continuous_projX : ∀ t, Continuous (projX (X := X) (Y := Y) t) + | 0 => continuous_fst + | t + 1 => + ((continuous_projX t).comp continuous_fst).prodMk + (continuous_fst.comp continuous_snd) + +/-- The Y-side projection of a pair-history is continuous. -/ +theorem continuous_projY : ∀ t, Continuous (projY (X := X) (Y := Y) t) + | 0 => continuous_snd + | t + 1 => + ((continuous_projY t).comp continuous_fst).prodMk + (continuous_snd.comp continuous_snd) + +end Topology + +/-! ### Polish structure + +Histories of Polish coordinates are Polish (binary products of Polish +spaces are Polish). -/ + +section Polish + +variable [∀ n, TopologicalSpace (X n)] [∀ n, PolishSpace (X n)] +variable [∀ n, TopologicalSpace (Y n)] [∀ n, PolishSpace (Y n)] + +/-- Pair-histories of Polish coordinates are Polish. -/ +instance instPolishSpacePairHist : ∀ t, PolishSpace (PairHist X Y t) + | 0 => inferInstanceAs (PolishSpace (X 0 × Y 0)) + | t + 1 => + letI := instPolishSpacePairHist t + inferInstanceAs (PolishSpace (PairHist X Y t × (X (t + 1) × Y (t + 1)))) + +/-- X-side histories of Polish coordinates are Polish. -/ +instance instPolishSpaceXHist : ∀ t, PolishSpace (XHist X t) + | 0 => inferInstanceAs (PolishSpace (X 0)) + | t + 1 => + letI := instPolishSpaceXHist t + inferInstanceAs (PolishSpace (XHist X t × X (t + 1))) + +/-- Y-side histories of Polish coordinates are Polish. -/ +instance instPolishSpaceYHist : ∀ t, PolishSpace (YHist Y t) + | 0 => inferInstanceAs (PolishSpace (Y 0)) + | t + 1 => + letI := instPolishSpaceYHist t + inferInstanceAs (PolishSpace (YHist Y t × Y (t + 1))) + +end Polish + +/-! ### Measurable structure + +The product σ-algebra on histories, by recursion on the time index. This +needs only the coordinate σ-algebras (no topology). -/ + +section Measurable + +variable [∀ n, MeasurableSpace (X n)] [∀ n, MeasurableSpace (Y n)] + +/-- Recursive product σ-algebra on pair-histories: at each successor level + this is definitionally the product σ-algebra over the previous level. -/ +instance instMeasurableSpacePairHist : ∀ t, MeasurableSpace (PairHist X Y t) + | 0 => inferInstanceAs (MeasurableSpace (X 0 × Y 0)) + | t + 1 => + letI := instMeasurableSpacePairHist t + inferInstanceAs + (MeasurableSpace (PairHist X Y t × (X (t + 1) × Y (t + 1)))) + +/-- Recursive product σ-algebra on X-side histories. -/ +instance instMeasurableSpaceXHist : ∀ t, MeasurableSpace (XHist X t) + | 0 => inferInstanceAs (MeasurableSpace (X 0)) + | t + 1 => + letI := instMeasurableSpaceXHist t + inferInstanceAs (MeasurableSpace (XHist X t × X (t + 1))) + +/-- Recursive product σ-algebra on Y-side histories. -/ +instance instMeasurableSpaceYHist : ∀ t, MeasurableSpace (YHist Y t) + | 0 => inferInstanceAs (MeasurableSpace (Y 0)) + | t + 1 => + letI := instMeasurableSpaceYHist t + inferInstanceAs (MeasurableSpace (YHist Y t × Y (t + 1))) + +variable {X Y} + +/-- The X-side projection of a pair-history is measurable. -/ +theorem measurable_projX : ∀ t, Measurable (projX (X := X) (Y := Y) t) + | 0 => measurable_fst + | t + 1 => + ((measurable_projX t).comp measurable_fst).prodMk + (measurable_fst.comp measurable_snd) + +/-- The Y-side projection of a pair-history is measurable. -/ +theorem measurable_projY : ∀ t, Measurable (projY (X := X) (Y := Y) t) + | 0 => measurable_snd + | t + 1 => + ((measurable_projY t).comp measurable_fst).prodMk + (measurable_snd.comp measurable_snd) + +end Measurable + +/-! ### Borel structure + +The recursive product σ-algebra is the Borel σ-algebra of the recursive +product topology: binary products of Borel spaces are Borel when one +factor is second countable, and Polishness supplies second countability +at every level. -/ + +section Borel + +variable [∀ n, TopologicalSpace (X n)] [∀ n, PolishSpace (X n)] +variable [∀ n, MeasurableSpace (X n)] [∀ n, BorelSpace (X n)] +variable [∀ n, TopologicalSpace (Y n)] [∀ n, PolishSpace (Y n)] +variable [∀ n, MeasurableSpace (Y n)] [∀ n, BorelSpace (Y n)] + +/-- Pair-histories of Polish Borel coordinates are Borel: the recursive + product σ-algebra coincides with the Borel σ-algebra of the recursive + product topology. -/ +instance instBorelSpacePairHist : ∀ t, BorelSpace (PairHist X Y t) + | 0 => inferInstanceAs (BorelSpace (X 0 × Y 0)) + | t + 1 => + letI := instBorelSpacePairHist t + inferInstanceAs (BorelSpace (PairHist X Y t × (X (t + 1) × Y (t + 1)))) + +/-- X-side histories of Polish Borel coordinates are Borel. -/ +instance instBorelSpaceXHist : ∀ t, BorelSpace (XHist X t) + | 0 => inferInstanceAs (BorelSpace (X 0)) + | t + 1 => + letI := instBorelSpaceXHist t + inferInstanceAs (BorelSpace (XHist X t × X (t + 1))) + +/-- Y-side histories of Polish Borel coordinates are Borel. -/ +instance instBorelSpaceYHist : ∀ t, BorelSpace (YHist Y t) + | 0 => inferInstanceAs (BorelSpace (Y 0)) + | t + 1 => + letI := instBorelSpaceYHist t + inferInstanceAs (BorelSpace (YHist Y t × Y (t + 1))) + +end Borel + +end MultiPeriod + +end diff --git a/LeanPool/BicausalOT/BicausalOT/Proposition1.lean b/LeanPool/BicausalOT/BicausalOT/Proposition1.lean new file mode 100644 index 0000000000..4b679285ea --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/Proposition1.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Proposition 1: Bicausal ⟺ Kernel Decomposition ✓ FULLY VERIFIED +-/ +import LeanPool.BicausalOT.BicausalOT.Defs + +open MeasureTheory ProbabilityTheory Set ENNReal + +noncomputable section + +variable {X₀ X₁ Y₀ Y₁ : Type*} +variable [MeasurableSpace X₀] [MeasurableSpace X₁] +variable [MeasurableSpace Y₀] [MeasurableSpace Y₁] + +theorem kernel_decomp_implies_bicausal + (μ₀ : Measure X₀) (ν₀ : Measure Y₀) + (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) + (π : Measure ((X₀ × X₁) × (Y₀ × Y₁))) + (kd : KernelDecomp π) + (h_coupling : kd.γ₀ ∈ CouplingSet₀ μ₀ ν₀) + (h_feas : ∀ᵐ z₀ ∂kd.γ₀, kd.γ₁ z₀ ∈ FeasibleSet₀ κ_μ κ_ν z₀) : + IsBicausal₂ μ₀ ν₀ κ_μ κ_ν π := + ⟨kd, h_coupling, h_feas⟩ + +theorem bicausal_implies_decomp + (μ₀ : Measure X₀) (ν₀ : Measure Y₀) + (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) + (π : Measure ((X₀ × X₁) × (Y₀ × Y₁))) + (hbc : IsBicausal₂ μ₀ ν₀ κ_μ κ_ν π) : + ∃ (kd : KernelDecomp π), + kd.γ₀ ∈ CouplingSet₀ μ₀ ν₀ ∧ + ∀ᵐ z₀ ∂kd.γ₀, kd.γ₁ z₀ ∈ FeasibleSet₀ κ_μ κ_ν z₀ := by + obtain ⟨kd, h_coupling, h_feas⟩ := hbc + exact ⟨kd, h_coupling, h_feas⟩ + +end diff --git a/LeanPool/BicausalOT/BicausalOT/SemianalyticValue.lean b/LeanPool/BicausalOT/BicausalOT/SemianalyticValue.lean new file mode 100644 index 0000000000..e7d2dae986 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/SemianalyticValue.lean @@ -0,0 +1,223 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Phase 3: lower semianalyticity of the Bellman value functions + (Bertsekas–Shreve Proposition 8.2 analogue, multi-period bicausal OT) + + Blueprint: BLUEPRINT.md §3 + battle log 2026-07-04. Architecture: + the one-step infimum in `VGo` is reindexed over the Polish space + `WeakP W` of probability measures (W1); the feasibility correspondence + is Borel via the Giry-valued equalizer (`measurableSet_eq_measure`) and + W2 (`probabilityMeasure_borel_measurable_toMeasure`); the integrand is + lower semianalytic by BS 7.48 (`lintegral_lowerSemianalytic`) applied + to the evaluation kernel `(h, γ) ↦ γ`; the fiber infimum is lower + semianalytic by BS 7.47 (`IsLowerSemianalytic.iInf_fiber`); the stage + cost is added back via `IsLowerSemianalytic.add`. Induction on the + time to go. +-/ +import LeanPool.BicausalOT.BicausalOT.MultiPeriodTopology +import LeanPool.BicausalOT.BicausalOT.FeasNonempty +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LsaAlgebra +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish + +open MeasureTheory Set ENNReal + +noncomputable section + +/-! ## The Polish space of probability measures with its Borel σ-algebra + +`ProbabilityMeasure W` carries Mathlib's Giry-subtype σ-algebra, which is +not the Borel σ-algebra of the weak topology; the type synonym `WeakP` +installs the Borel structure (Polish by W1). -/ + +/-- Probability measures on `W`, considered with the topology of weak + convergence and its Borel σ-algebra. -/ +def WeakP (W : Type*) [MeasurableSpace W] : Type _ := ProbabilityMeasure W + +namespace WeakP + +variable {W : Type*} [MeasurableSpace W] [TopologicalSpace W] + [OpensMeasurableSpace W] + +instance : TopologicalSpace (WeakP W) := + inferInstanceAs (TopologicalSpace (ProbabilityMeasure W)) + +instance : MeasurableSpace (WeakP W) := borel (WeakP W) + +instance : BorelSpace (WeakP W) := ⟨rfl⟩ + +instance [PolishSpace W] [BorelSpace W] : PolishSpace (WeakP W) := + ProbabilityMeasure.instPolishSpace (X := W) + +/-- The underlying measure. -/ +def toMeasure (γ : WeakP W) : Measure W := + ProbabilityMeasure.toMeasure γ + +instance (γ : WeakP W) : IsProbabilityMeasure γ.toMeasure := + (γ : ProbabilityMeasure W).prop + +/-- **W2, packaged**: the underlying-measure map is measurable from the + Borel σ-algebra of the weak topology to the Giry σ-algebra. -/ +theorem measurable_toMeasure [PolishSpace W] [BorelSpace W] : + Measurable (toMeasure : WeakP W → Measure W) := by + letI := TopologicalSpace.upgradeIsCompletelyMetrizable W + exact probabilityMeasure_borel_measurable_toMeasure (Ω := W) + +end WeakP + +namespace MultiPeriod + +variable {X Y : ℕ → Type*} + [∀ n, TopologicalSpace (X n)] [∀ n, PolishSpace (X n)] + [∀ n, MeasurableSpace (X n)] [∀ n, BorelSpace (X n)] + [∀ n, TopologicalSpace (Y n)] [∀ n, PolishSpace (Y n)] + [∀ n, MeasurableSpace (Y n)] [∀ n, BorelSpace (Y n)] + +variable (κμ : (t : ℕ) → XHist X t → Measure (X (t + 1))) +variable (κν : (t : ℕ) → YHist Y t → Measure (Y (t + 1))) +variable (c : (t : ℕ) → PairHist X Y t → ℝ≥0∞) + +/-- The feasibility correspondence, as a subset of the product of the + history space with the Polish space of probability measures. -/ +def FeasGraph (t : ℕ) : + Set (PairHist X Y t × WeakP (X (t + 1) × Y (t + 1))) := + {p | p.2.toMeasure ∈ Feas κμ κν t p.1} + +/-- The feasibility correspondence is Borel: each marginal constraint is + the equalizer of two measurable `Measure`-valued maps. -/ +theorem measurableSet_feasGraph + (hκμ_meas : ∀ t, Measurable (κμ t)) + (hκν_meas : ∀ t, Measurable (κν t)) + (hκμ_prob : ∀ t x, IsProbabilityMeasure (κμ t x)) + (hκν_prob : ∀ t y, IsProbabilityMeasure (κν t y)) (t : ℕ) : + MeasurableSet (FeasGraph κμ κν t) := by + have h1 : MeasurableSet {p : PairHist X Y t × WeakP (X (t + 1) × Y (t + 1)) | + p.2.toMeasure.map Prod.fst = κμ t (projX t p.1)} := by + refine measurableSet_eq_measure ?_ ?_ ?_ ?_ + · exact (Measure.measurable_map _ measurable_fst).comp + (WeakP.measurable_toMeasure.comp measurable_snd) + · exact (hκμ_meas t).comp ((measurable_projX t).comp measurable_fst) + · intro p + exact Measure.isProbabilityMeasure_map measurable_fst.aemeasurable + · intro p + exact hκμ_prob t _ + have h2 : MeasurableSet {p : PairHist X Y t × WeakP (X (t + 1) × Y (t + 1)) | + p.2.toMeasure.map Prod.snd = κν t (projY t p.1)} := by + refine measurableSet_eq_measure ?_ ?_ ?_ ?_ + · exact (Measure.measurable_map _ measurable_snd).comp + (WeakP.measurable_toMeasure.comp measurable_snd) + · exact (hκν_meas t).comp ((measurable_projY t).comp measurable_fst) + · intro p + exact Measure.isProbabilityMeasure_map measurable_snd.aemeasurable + · intro p + exact hκν_prob t _ + exact h1.inter h2 + +/-- BS 7.48 for the evaluation kernel `(h, γ) ↦ γ`: integrating a lower + semianalytic function of the extended history against the second + coordinate is lower semianalytic on the product of the history space + with the space of probability measures. -/ +theorem lintegral_weakP_lowerSemianalytic (t : ℕ) + {f : PairHist X Y (t + 1) → ℝ≥0∞} (hf : IsLowerSemianalytic f) : + IsLowerSemianalytic + (fun p : PairHist X Y t × WeakP (X (t + 1) × Y (t + 1)) => + ∫⁻ z, f (p.1, z) ∂p.2.toMeasure) := by + have hf' : IsLowerSemianalytic + (fun q : (PairHist X Y t × WeakP (X (t + 1) × Y (t + 1))) + × (X (t + 1) × Y (t + 1)) => f (q.1.1, q.2)) := by + have hcomp : (fun q : (PairHist X Y t × WeakP (X (t + 1) × Y (t + 1))) + × (X (t + 1) × Y (t + 1)) => f (q.1.1, q.2)) + = f ∘ (fun q => (q.1.1, q.2)) := rfl + rw [hcomp] + exact hf.comp_continuous + ((continuous_fst.comp continuous_fst).prodMk continuous_snd) + exact lintegral_lowerSemianalytic hf' + (WeakP.measurable_toMeasure.comp measurable_snd) + (fun p => inferInstance) + +omit [∀ n, TopologicalSpace (X n)] [∀ n, PolishSpace (X n)] + [∀ n, BorelSpace (X n)] [∀ n, TopologicalSpace (Y n)] + [∀ n, PolishSpace (Y n)] [∀ n, BorelSpace (Y n)] in +/-- The one-step feasible infimum reindexed over the fibers of the + feasibility graph (any integrand): legitimate because feasible + one-step plans are probability measures. -/ +theorem iInf_feas_eq_iInf_feasGraph + (hκμ_prob : ∀ t x, IsProbabilityMeasure (κμ t x)) + (t : ℕ) (h : PairHist X Y t) (f : X (t + 1) × Y (t + 1) → ℝ≥0∞) : + (⨅ (γm : Measure (X (t + 1) × Y (t + 1))) (_ : γm ∈ Feas κμ κν t h), + ∫⁻ z, f z ∂γm) + = ⨅ (γ : WeakP (X (t + 1) × Y (t + 1))) + (_ : (h, γ) ∈ FeasGraph κμ κν t), + ∫⁻ z, f z ∂γ.toMeasure := by + apply le_antisymm + · exact le_iInf₂ fun γ hγ => iInf₂_le γ.toMeasure hγ + · refine le_iInf₂ fun γm hγm => ?_ + haveI hpm : IsProbabilityMeasure γm := + ⟨Feas.measure_univ κμ κν hκμ_prob hγm⟩ + exact iInf₂_le + (show WeakP (X (t + 1) × Y (t + 1)) from + (⟨γm, hpm⟩ : ProbabilityMeasure (X (t + 1) × Y (t + 1)))) hγm + +omit [∀ n, TopologicalSpace (X n)] [∀ n, PolishSpace (X n)] + [∀ n, BorelSpace (X n)] [∀ n, TopologicalSpace (Y n)] + [∀ n, PolishSpace (Y n)] [∀ n, BorelSpace (Y n)] in +/-- The one-step infimum of `VGo` reindexed over the Polish space of + probability measures: legitimate because feasible one-step plans are + probability measures (Markov kernels). -/ +theorem VGo_succ_eq_weakP + (hκμ_prob : ∀ t x, IsProbabilityMeasure (κμ t x)) (k t : ℕ) + (h : PairHist X Y t) : + VGo c κμ κν (k + 1) t h + = c t h + ⨅ (γ : WeakP (X (t + 1) × Y (t + 1))) + (_ : (h, γ) ∈ FeasGraph κμ κν t), + ∫⁻ z, VGo c κμ κν k (t + 1) (h, z) ∂γ.toMeasure := by + show c t h + _ = c t h + _ + congr 1 + exact iInf_feas_eq_iInf_feasGraph κμ κν hκμ_prob t h _ + +/-- **Phase 3 (BS Proposition 8.2 analogue).** For Borel Markov kernels + and lower semianalytic stage costs, every Bellman value function + `VGo k t` is lower semianalytic on the history space. -/ +theorem VGo_isLowerSemianalytic + (hκμ_meas : ∀ t, Measurable (κμ t)) + (hκν_meas : ∀ t, Measurable (κν t)) + (hκμ_prob : ∀ t x, IsProbabilityMeasure (κμ t x)) + (hκν_prob : ∀ t y, IsProbabilityMeasure (κν t y)) + (hc : ∀ t, IsLowerSemianalytic (c t)) : + ∀ k t : ℕ, IsLowerSemianalytic (VGo c κμ κν k t) := by + intro k + induction k with + | zero => exact fun t => hc t + | succ k ih => + intro t + -- the integrand on the product with the measure space + have hintegrand : IsLowerSemianalytic + (fun p : PairHist X Y t × WeakP (X (t + 1) × Y (t + 1)) => + ∫⁻ z, VGo c κμ κν k (t + 1) (p.1, z) ∂p.2.toMeasure) := + lintegral_weakP_lowerSemianalytic t (ih (t + 1)) + -- fiber infimum over the Borel (hence analytic) feasibility graph + have hfiber : IsLowerSemianalytic + (fun h : PairHist X Y t => + ⨅ (γ : WeakP (X (t + 1) × Y (t + 1))) + (_ : (h, γ) ∈ FeasGraph κμ κν t), + ∫⁻ z, VGo c κμ κν k (t + 1) (h, z) ∂γ.toMeasure) := + IsLowerSemianalytic.iInf_fiber + ((measurableSet_feasGraph κμ κν hκμ_meas hκν_meas + hκμ_prob hκν_prob t).analyticSet) + hintegrand + -- reassemble VGo (k+1) + have heq : VGo c κμ κν (k + 1) t + = fun h => c t h + ⨅ (γ : WeakP (X (t + 1) × Y (t + 1))) + (_ : (h, γ) ∈ FeasGraph κμ κν t), + ∫⁻ z, VGo c κμ κν k (t + 1) (h, z) ∂γ.toMeasure := + funext fun h => VGo_succ_eq_weakP κμ κν c hκμ_prob k t h + rw [heq] + exact (hc t).add hfiber + +end MultiPeriod + +end diff --git a/LeanPool/BicausalOT/BicausalOT/UpperBound.lean b/LeanPool/BicausalOT/BicausalOT/UpperBound.lean new file mode 100644 index 0000000000..85c2da46e2 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/UpperBound.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Step 3: Upper Bound via ε-optimal selection +-/ +import LeanPool.BicausalOT.BicausalOT.Defs +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.JankovVonNeumann + +open MeasureTheory ProbabilityTheory Set ENNReal + +noncomputable section + +variable {X₀ X₁ Y₀ Y₁ : Type*} +variable [MeasurableSpace X₀] [MeasurableSpace X₁] +variable [MeasurableSpace Y₀] [MeasurableSpace Y₁] +variable (c₀ : X₀ × Y₀ → ENNReal) (c₁ : (X₀ × Y₀) × (X₁ × Y₁) → ENNReal) + +theorem eps_optimal_element + {α : Type*} (S : Set α) (h_ne : S.Nonempty) + (f : α → ENNReal) (ε : ENNReal) (hε : 0 < ε) : + ∃ a ∈ S, f a ≤ (⨅ (x : α) (_ : x ∈ S), f x) + ε := by + by_contra h + simp only [not_exists, not_and, not_le] at h + obtain ⟨a, ha⟩ := h_ne + have hlt := h a ha + have : (⨅ (x : α) (_ : x ∈ S), f x) + ε ≤ ⨅ (x : α) (_ : x ∈ S), f x := + le_iInf fun x => le_iInf fun hx => le_of_lt (h x hx) + by_cases htop : (⨅ (x : α) (_ : x ∈ S), f x) = ⊤ + · simp [htop] at hlt + · exact absurd this (not_le.mpr (ENNReal.lt_add_right htop hε.ne')) + +theorem eps_optimal_kernel_bound + (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) + (h_ne : ∀ z₀ : X₀ × Y₀, (FeasibleSet₀ κ_μ κ_ν z₀).Nonempty) + (ε : ENNReal) (hε : 0 < ε) : + ∃ (γ₁ : X₀ × Y₀ → Measure (X₁ × Y₁)), + (∀ z₀, γ₁ z₀ ∈ FeasibleSet₀ κ_μ κ_ν z₀) ∧ + ∀ z₀, ∫⁻ z₁, c₁ (z₀, z₁) ∂(γ₁ z₀) + ≤ (⨅ (m : Measure (X₁ × Y₁)) (_ : m ∈ FeasibleSet₀ κ_μ κ_ν z₀), + ∫⁻ z₁, c₁ (z₀, z₁) ∂m) + ε := by + obtain ⟨sel, h_feas, h_opt⟩ := + eps_optimal_selection (FeasibleSet₀ κ_μ κ_ν) h_ne + (fun z₀ γ => ∫⁻ z₁, c₁ (z₀, z₁) ∂γ) ε hε + exact ⟨sel, h_feas, h_opt⟩ + +theorem totalCost_le_V₀_plus_eps + (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) + (γ₀ : Measure (X₀ × Y₀)) + (γ₁ : X₀ × Y₀ → Measure (X₁ × Y₁)) + (ε : ENNReal) + (h_opt : ∀ z₀, ∫⁻ z₁, c₁ (z₀, z₁) ∂(γ₁ z₀) + ≤ (⨅ (m : Measure (X₁ × Y₁)) (_ : m ∈ FeasibleSet₀ κ_μ κ_ν z₀), + ∫⁻ z₁, c₁ (z₀, z₁) ∂m) + ε) : + totalCost c₀ c₁ γ₀ γ₁ + ≤ ∫⁻ z₀, (V₀ c₀ c₁ κ_μ κ_ν z₀ + ε) ∂γ₀ := by + unfold totalCost; apply lintegral_mono; intro z₀ + show c₀ z₀ + ∫⁻ z₁, c₁ (z₀, z₁) ∂(γ₁ z₀) ≤ V₀ c₀ c₁ κ_μ κ_ν z₀ + ε + have h := h_opt z₀ + have hV : V₀ c₀ c₁ κ_μ κ_ν z₀ = c₀ z₀ + + ⨅ (m : Measure (X₁ × Y₁)) (_ : m ∈ FeasibleSet₀ κ_μ κ_ν z₀), + ∫⁻ z₁, c₁ (z₀, z₁) ∂m := rfl + rw [hV] + calc c₀ z₀ + ∫⁻ z₁, c₁ (z₀, z₁) ∂(γ₁ z₀) + ≤ c₀ z₀ + ((⨅ (m : Measure (X₁ × Y₁)) (_ : m ∈ FeasibleSet₀ κ_μ κ_ν z₀), + ∫⁻ z₁, c₁ (z₀, z₁) ∂m) + ε) := by gcongr + _ = c₀ z₀ + (⨅ (m : Measure (X₁ × Y₁)) (_ : m ∈ FeasibleSet₀ κ_μ κ_ν z₀), + ∫⁻ z₁, c₁ (z₀, z₁) ∂m) + ε := by rw [← add_assoc] + +end diff --git a/LeanPool/BicausalOT/BicausalOT/ValueRepresentation.lean b/LeanPool/BicausalOT/BicausalOT/ValueRepresentation.lean new file mode 100644 index 0000000000..ce7a8a4fb9 --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/ValueRepresentation.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +/- + Step 4: Value Representation (equality) ✓ FULLY VERIFIED + Combines lower and upper bounds. +-/ +import LeanPool.BicausalOT.BicausalOT.Defs +import LeanPool.BicausalOT.BicausalOT.LowerBound +import LeanPool.BicausalOT.BicausalOT.UpperBound +import Mathlib.MeasureTheory.Integral.Lebesgue.Add + +open MeasureTheory ProbabilityTheory Set ENNReal + +noncomputable section + +variable {X₀ X₁ Y₀ Y₁ : Type*} +variable [MeasurableSpace X₀] [MeasurableSpace X₁] +variable [MeasurableSpace Y₀] [MeasurableSpace Y₁] +variable (c₀ : X₀ × Y₀ → ENNReal) (c₁ : (X₀ × Y₀) × (X₁ × Y₁) → ENNReal) + +theorem bellman_value_geq + (μ₀ : Measure X₀) (ν₀ : Measure Y₀) + (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) : + ⨅ (γ₀ : Measure (X₀ × Y₀)) (_ : γ₀ ∈ CouplingSet₀ μ₀ ν₀), + ∫⁻ z₀, V₀ c₀ c₁ κ_μ κ_ν z₀ ∂γ₀ + ≤ ⨅ (γ₀ : Measure (X₀ × Y₀)) (γ₁ : X₀ × Y₀ → Measure (X₁ × Y₁)) + (_ : γ₀ ∈ CouplingSet₀ μ₀ ν₀) + (_ : ∀ z₀, γ₁ z₀ ∈ FeasibleSet₀ κ_μ κ_ν z₀), + totalCost c₀ c₁ γ₀ γ₁ := by + apply le_iInf; intro γ₀; apply le_iInf; intro γ₁ + apply le_iInf; intro h_coup; apply le_iInf; intro h_feas + calc ⨅ (γ₀' : Measure (X₀ × Y₀)) (_ : γ₀' ∈ CouplingSet₀ μ₀ ν₀), + ∫⁻ z₀, V₀ c₀ c₁ κ_μ κ_ν z₀ ∂γ₀' + ≤ ∫⁻ z₀, V₀ c₀ c₁ κ_μ κ_ν z₀ ∂γ₀ := iInf₂_le γ₀ h_coup + _ ≤ totalCost c₀ c₁ γ₀ γ₁ := by + unfold totalCost; apply lintegral_mono; intro z₀ + exact V₀_le_cost_pointwise c₀ c₁ κ_μ κ_ν z₀ (γ₁ z₀) (h_feas z₀) + +theorem bellman_value_leq_aux + {μ₀ : Measure X₀} {ν₀ : Measure Y₀} + (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) + (h_Gamma_ne : ∀ z₀, (FeasibleSet₀ κ_μ κ_ν z₀).Nonempty) + (γ₀ : Measure (X₀ × Y₀)) + (h_coup : γ₀ ∈ CouplingSet₀ μ₀ ν₀) + (ε : ENNReal) (hε : 0 < ε) : + ⨅ (γ₀' : Measure (X₀ × Y₀)) (γ₁ : X₀ × Y₀ → Measure (X₁ × Y₁)) + (_ : γ₀' ∈ CouplingSet₀ μ₀ ν₀) + (_ : ∀ z₀, γ₁ z₀ ∈ FeasibleSet₀ κ_μ κ_ν z₀), + totalCost c₀ c₁ γ₀' γ₁ + ≤ ∫⁻ z₀, (V₀ c₀ c₁ κ_μ κ_ν z₀ + ε) ∂γ₀ := by + obtain ⟨γ₁_sel, hγ₁_feas, hγ₁_opt⟩ := + eps_optimal_kernel_bound c₁ κ_μ κ_ν h_Gamma_ne ε hε + calc ⨅ (γ₀' : Measure (X₀ × Y₀)) (γ₁ : X₀ × Y₀ → Measure (X₁ × Y₁)) + (_ : γ₀' ∈ CouplingSet₀ μ₀ ν₀) + (_ : ∀ z₀, γ₁ z₀ ∈ FeasibleSet₀ κ_μ κ_ν z₀), + totalCost c₀ c₁ γ₀' γ₁ + ≤ totalCost c₀ c₁ γ₀ γ₁_sel := by + apply iInf_le_of_le γ₀; apply iInf_le_of_le γ₁_sel + apply iInf_le_of_le h_coup; exact iInf_le _ hγ₁_feas + _ ≤ ∫⁻ z₀, (V₀ c₀ c₁ κ_μ κ_ν z₀ + ε) ∂γ₀ := + totalCost_le_V₀_plus_eps c₀ c₁ κ_μ κ_ν γ₀ γ₁_sel ε hγ₁_opt + +theorem bellman_value_leq + (μ₀ : Measure X₀) [IsProbabilityMeasure μ₀] + (ν₀ : Measure Y₀) [IsProbabilityMeasure ν₀] + (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) + (h_Gamma_ne : ∀ z₀, (FeasibleSet₀ κ_μ κ_ν z₀).Nonempty) + (h_prob : ∀ γ₀ ∈ CouplingSet₀ μ₀ ν₀, γ₀ Set.univ ≤ 1) : + ⨅ (γ₀ : Measure (X₀ × Y₀)) (γ₁ : X₀ × Y₀ → Measure (X₁ × Y₁)) + (_ : γ₀ ∈ CouplingSet₀ μ₀ ν₀) + (_ : ∀ z₀, γ₁ z₀ ∈ FeasibleSet₀ κ_μ κ_ν z₀), + totalCost c₀ c₁ γ₀ γ₁ + ≤ ⨅ (γ₀ : Measure (X₀ × Y₀)) (_ : γ₀ ∈ CouplingSet₀ μ₀ ν₀), + ∫⁻ z₀, V₀ c₀ c₁ κ_μ κ_ν z₀ ∂γ₀ := by + apply le_iInf; intro γ₀; apply le_iInf; intro h_coup + apply ENNReal.le_of_forall_pos_le_add + intro ε hε _ + obtain ⟨γ₁_sel, hγ₁_feas, hγ₁_opt⟩ := + eps_optimal_kernel_bound c₁ κ_μ κ_ν h_Gamma_ne ε (by positivity) + calc ⨅ (γ₀' : Measure (X₀ × Y₀)) (γ₁ : X₀ × Y₀ → Measure (X₁ × Y₁)) + (_ : γ₀' ∈ CouplingSet₀ μ₀ ν₀) + (_ : ∀ z₀, γ₁ z₀ ∈ FeasibleSet₀ κ_μ κ_ν z₀), + totalCost c₀ c₁ γ₀' γ₁ + ≤ totalCost c₀ c₁ γ₀ γ₁_sel := by + apply iInf_le_of_le γ₀; apply iInf_le_of_le γ₁_sel + apply iInf_le_of_le h_coup; exact iInf_le _ hγ₁_feas + _ ≤ ∫⁻ z₀, (V₀ c₀ c₁ κ_μ κ_ν z₀ + ↑ε) ∂γ₀ := + totalCost_le_V₀_plus_eps c₀ c₁ κ_μ κ_ν γ₀ γ₁_sel ↑ε hγ₁_opt + _ = ∫⁻ z₀, V₀ c₀ c₁ κ_μ κ_ν z₀ ∂γ₀ + ↑ε * γ₀ Set.univ := by + rw [lintegral_add_right _ measurable_const, lintegral_const] + _ ≤ ∫⁻ z₀, V₀ c₀ c₁ κ_μ κ_ν z₀ ∂γ₀ + ↑ε := by + gcongr + calc ↑ε * γ₀ Set.univ ≤ ↑ε * 1 := by + gcongr; exact h_prob γ₀ h_coup + _ = ↑ε := mul_one _ + +/-- **Main Theorem**: Bellman value representation (equality). -/ +theorem bellman_value_eq + (μ₀ : Measure X₀) [IsProbabilityMeasure μ₀] + (ν₀ : Measure Y₀) [IsProbabilityMeasure ν₀] + (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) + (h_Gamma_ne : ∀ z₀, (FeasibleSet₀ κ_μ κ_ν z₀).Nonempty) + (h_prob : ∀ γ₀ ∈ CouplingSet₀ μ₀ ν₀, γ₀ Set.univ ≤ 1) : + ⨅ (γ₀ : Measure (X₀ × Y₀)) (γ₁ : X₀ × Y₀ → Measure (X₁ × Y₁)) + (_ : γ₀ ∈ CouplingSet₀ μ₀ ν₀) + (_ : ∀ z₀, γ₁ z₀ ∈ FeasibleSet₀ κ_μ κ_ν z₀), + totalCost c₀ c₁ γ₀ γ₁ + = ⨅ (γ₀ : Measure (X₀ × Y₀)) (_ : γ₀ ∈ CouplingSet₀ μ₀ ν₀), + ∫⁻ z₀, V₀ c₀ c₁ κ_μ κ_ν z₀ ∂γ₀ := + le_antisymm + (bellman_value_leq c₀ c₁ μ₀ ν₀ κ_μ κ_ν h_Gamma_ne h_prob) + (bellman_value_geq c₀ c₁ μ₀ ν₀ κ_μ κ_ν) + +end diff --git a/LeanPool/BicausalOT/Solution.lean b/LeanPool/BicausalOT/Solution.lean new file mode 100644 index 0000000000..c5ba7c9470 --- /dev/null +++ b/LeanPool/BicausalOT/Solution.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.MeasurableSelection + +/-! +# Solution file: the Kuratowski–Ryll-Nardzewski measurable selection theorem + +This module supplies a declaration whose type is exactly the type stated in `Challenge`, +together with its proof. + +The proof itself lives in `BicausalOT/DescriptiveSetTheory/MeasurableSelection.lean`, +which imports Mathlib only. It is the classical Kuratowski–Ryll-Nardzewski argument: + +* fix a dense sequence `u : ℕ → Y` (`TopologicalSpace.exists_dense_seq`); +* build measurable, countably-`u`-valued approximate selectors `fₙ = u ∘ gₙ`, with + `gₙ a` the *least* index `k` for which `Φ a` meets `ball (u k) ((1/2)^n)` and also the + previous stage's ball — measurability of the least-index operation is + `MeasurableSelection.measurable_firstIdx`; +* the key measurability step, `MeasurableSelection.step_measurableSet`, splits the test + set over the countably many measurable fibres `{gₙ = j}`, on each of which the test set + is cut out by the *fixed* open set `ball (u k) r' ∩ ball (u j) r`, so the weak + measurability hypothesis applies directly; +* the resulting sequence is uniformly Cauchy (`dist (fₙ a) (fₙ₊₁ a) ≤ (3/2)·(1/2)ⁿ`), its + pointwise limit is measurable by `measurable_of_tendsto_metrizable`, and it lands in + `Φ a` because `Φ a` is closed. + +The declaration below restates that theorem inside the `MeasurableSelection` namespace so +that its name matches the `Challenge` declaration named in `comparator.json`; the root +`exists_measurable_selection` it delegates to is the audited declaration of the library, +and is one of the theorems covered by the repository's `#print axioms` audit +(`AxiomAudit.lean` and `BicausalOT/AxiomsAudit.lean`), which reports only +`[propext, Classical.choice, Quot.sound]`. +-/ + +open TopologicalSpace + +namespace MeasurableSelection + +/-- **The Kuratowski–Ryll-Nardzewski measurable selection theorem** (Kechris, +*Classical Descriptive Set Theory*, Theorem 12.13; Srivastava, *A Course on Borel Sets*, +Theorem 5.2.1). + +Let `α` be an arbitrary measurable space and `Y` a Polish space, presented as a complete +separable metric space carrying its Borel σ-algebra. Let `Φ : α → Set Y` have nonempty +closed values and be weakly measurable, i.e. `{a | Φ a ∩ U ≠ ∅}` is measurable for every +open `U ⊆ Y`. Then `Φ` has a Borel-measurable selection: there exists a measurable +`f : α → Y` with `f a ∈ Φ a` for every `a`. -/ +theorem exists_measurable_selection {α : Type*} [MeasurableSpace α] {Y : Type*} + [MetricSpace Y] [SeparableSpace Y] [CompleteSpace Y] [MeasurableSpace Y] + [BorelSpace Y] {Φ : α → Set Y} (hne : ∀ a, (Φ a).Nonempty) + (hclosed : ∀ a, IsClosed (Φ a)) + (hmeas : ∀ U : Set Y, IsOpen U → MeasurableSet {a | (Φ a ∩ U).Nonempty}) : + ∃ f : α → Y, Measurable f ∧ ∀ a, f a ∈ Φ a := + _root_.exists_measurable_selection hne hclosed hmeas + +end MeasurableSelection diff --git a/LeanPool/BicausalOT/SolutionCapacitability.lean b/LeanPool/BicausalOT/SolutionCapacitability.lean new file mode 100644 index 0000000000..f39a852e81 --- /dev/null +++ b/LeanPool/BicausalOT/SolutionCapacitability.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +import Mathlib +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability + +/-! +# Solution file: Choquet capacitability for analytic sets, and universal measurability + +This module supplies declarations whose types are exactly the two types stated in +`ChallengeCapacitability`, together with their proofs. + +The proofs themselves live in `BicausalOT/DescriptiveSetTheory/Capacitability.lean`. That +file imports Mathlib together with `BicausalOT.DescriptiveSetTheory.AnalyticSet`, which +declares nothing at all: it is a comment block, one Mathlib import +(`Mathlib.MeasureTheory.Constructions.Polish.Basic`) and an `open MeasureTheory`. So the +Lean content behind the two registered results is Mathlib alone. + +`import Mathlib` is present here so that this module elaborates the statement in the +same environment as its Challenge file, which imports Mathlib and nothing else. The +repository import below declares no name that Mathlib also declares, so it cannot +change how the statement elaborates; the Mathlib import only guarantees that it cannot. + +## The argument + +For `A` analytic and nonempty, `A = range π` with `π : ℕᴺ → X` continuous. The Souslin +scheme is `G_s := closure (π '' N_s)` over the cylinders `N_s` of Baire space. For a bound +`β : ℕ → ℕ` write `Σ(β) = {σ | ∀ i, σ i ≤ β i}`, which is compact, and + +* `capW π β n = ⋃ {G_s : s ≤ β on the first n coordinates}` — a *closed*, decreasing family + of approximations (`isClosed_capW`, `capW_antitone`); +* `cap_exists_bound` — the measure-free recursion: for any monotone `m : Set X → ℝ≥0∞` that + is continuous along increasing unions, `c < m (𝒜(G))` yields a bound `β` with + `c < m (capW π β n)` for every `n`. It is built one coordinate at a time (`capAux`, + `capBound`, `capAux_eq`) and mirrors the `leftmostAuxG` pattern of `Tree.lean`. This is + where the analytic-set structure is consumed, and it is already stated abstractly in `m`; +* `iInter_capW_subset` — the core topological lemma, `⋂ n, capW π β n ⊆ π '' Σ(β)`, proved + by a subsequence extraction inside the compact `Σ(β)` (clip an approximating branch + coordinatewise by `β`, extract a convergent subsequence, use continuity of `π`). This is + what supplies compactness of the witness; +* the endgame is measure-specific: `Directed.measure_iInter` turns + `μ (⋂ n, capW π β n)` into `⨅ n, μ (capW π β n)`, which needs the `capW π β n` to be + null-measurable (they are closed) and needs `μ` finite. This step is the reason + `IsFiniteMeasure` appears in the statement, and the reason the registered theorem is the + measure instance rather than the abstract capacity theorem — see + `fidelity.divergences` in `formalization-capacitability.yaml`. + +Universal measurability follows from capacitability in a dozen lines: choose compacts +`K k ⊆ A` with `μ A ≤ μ (K k) + 1/(k+1)`, note `⋃ k, K k` is Borel, contained in `A`, and of +full measure, then compare `A` with a measurable hull to see that `A \ ⋃ k, K k` is null. + +The declarations below restate the two library theorems inside the `Capacitability` +namespace so that their names match the `ChallengeCapacitability` declarations named in +`comparator-capacitability.json`; the library theorems they delegate to, +`MeasureTheory.AnalyticSet.measure_eq_iSup_isCompact` and +`MeasureTheory.AnalyticSet.nullMeasurableSet`, are both covered by the repository's +`#print axioms` audit (`BicausalOT/AxiomsAudit.lean`, lines 41–42, which runs during +`lake build`; the first is additionally in the standalone `AxiomAudit.lean`), and both +report only `[propext, Classical.choice, Quot.sound]`. +-/ + +open MeasureTheory + +namespace Capacitability + +/-- **Choquet capacitability, measure case** (Kechris, *Classical Descriptive Set Theory*, +Theorem 30.13 instantiated at the capacity `γ = μ*` of Example 30.B.1; Bertsekas–Shreve, +*Stochastic Optimal Control: The Discrete Time Case*, Proposition 7.42). + +For a finite Borel measure `μ` on a Polish space `X`, the outer measure of an analytic set +`A ⊆ X` is the supremum of the measures of the compact subsets of `A`. `A` is not assumed +measurable. -/ +theorem analyticSet_measure_eq_iSup_isCompact + {X : Type*} [TopologicalSpace X] [PolishSpace X] + [MeasurableSpace X] [BorelSpace X] + {A : Set X} (hA : AnalyticSet A) + (μ : Measure X) [IsFiniteMeasure μ] : + μ A = ⨆ (K : Set X) (_ : IsCompact K) (_ : K ⊆ A), μ K := + _root_.MeasureTheory.AnalyticSet.measure_eq_iSup_isCompact hA μ + +/-- **Analytic sets are universally measurable** (Lusin; Kechris, *Classical Descriptive Set +Theory*, Exercise 30.11 combined with Theorem 30.13; Bertsekas–Shreve, *Stochastic Optimal +Control: The Discrete Time Case*, Corollary 7.42.1 of Proposition 7.42). + +An analytic subset of a Polish space is null-measurable with respect to every finite Borel +measure: it differs from a Borel set by a null set. -/ +theorem analyticSet_nullMeasurableSet + {X : Type*} [TopologicalSpace X] [PolishSpace X] + [MeasurableSpace X] [BorelSpace X] + {A : Set X} (hA : AnalyticSet A) + (μ : Measure X) [IsFiniteMeasure μ] : + NullMeasurableSet A μ := + _root_.MeasureTheory.AnalyticSet.nullMeasurableSet hA μ + +end Capacitability diff --git a/LeanPool/BicausalOT/SolutionJvN.lean b/LeanPool/BicausalOT/SolutionJvN.lean new file mode 100644 index 0000000000..c122752ea4 --- /dev/null +++ b/LeanPool/BicausalOT/SolutionJvN.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +import Mathlib +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree + +/-! +# Solution file: the Jankov–von Neumann uniformization theorem + +This module supplies a declaration whose type is exactly the type stated in +`ChallengeJvN`, together with its proof. + +`import Mathlib` is present so that this module elaborates the statement in the same +environment as `ChallengeJvN`, which imports Mathlib and nothing else; +`BicausalOT.DescriptiveSetTheory.Tree` itself imports only three Mathlib files +(`Mathlib.Topology.MetricSpace.Polish`, `Mathlib.Topology.MetricSpace.PiNat`, +`Mathlib.MeasureTheory.Constructions.Polish.Basic`) and the repository's +`BicausalOT.DescriptiveSetTheory.AnalyticSigmaAlgebra`. Nothing in Mathlib at the pinned +revision declares any of the names used below, so the extra import cannot change how the +statement elaborates; it only guarantees that it cannot. + +## Relation to the library statement + +The library declaration is `jankov_von_neumann` in +`BicausalOT/DescriptiveSetTheory/Tree.lean`, in the root namespace. It states the same +theorem using two abbreviations from +`BicausalOT/DescriptiveSetTheory/AnalyticSigmaAlgebra.lean`: + +``` +@[reducible] +def analyticMeasurableSpace (X : Type*) [TopologicalSpace X] : MeasurableSpace X := + MeasurableSpace.generateFrom { s : Set X | AnalyticSet s } + +def AnalyticallyMeasurable {Y : Type*} [TopologicalSpace Y] (f : X → Y) : Prop := + @Measurable X Y (analyticMeasurableSpace X) (borel Y) f +``` + +Both unfold in one step to Mathlib constants and to nothing else, so the type registered +here — which writes them out — is definitionally equal to the library's, and the +delegation below typechecks by that unfolding alone. This is why the accompanying +`comparator-jvn.json` lists no `definition_names`: the statement of record mentions only +Mathlib notions, and no bespoke definition has to be replicated or trusted. + +## The proof being delegated to + +`Tree.lean` is a formalization of Kechris's own proof of 18.1: + +* the analytic `P` is `∅` or the range of a continuous `π : (ℕ → ℕ) → X × Y`; the empty + case is excluded by `hne`; +* `F = {(x, z) | Prod.fst (π z) = x} ⊆ X × (ℕ → ℕ)` is closed, being an equalizer of two + continuous maps, and is nonempty; +* `closedUniformizerG` uniformizes a closed `F ⊆ X × (ℕ → ℕ)` by the **leftmost branch** + of the section tree (`leftmostBranchG`, built from `leftmostAuxG`/`leftmostWitnessG`), + and `closedUniformizerG_selection` is the selection property; +* `closedUniformizerG_cylinder_measurable` is the measurability core. By + `closedUniformizerG_cylinder_eq`, the preimage of the basic cylinder over `f ↾ n` is the + union of two pieces: the set of `x` whose fiber meets that cylinder while meeting no + cylinder over an earlier extension `Function.update f m j` (`m < n`, `j < f m`) — this + is the leftmost-branch minimality condition — and an off-projection piece + `(Prod.fst '' F)ᶜ ∩ {x | ∀ i < n, hne.some.2 i = f i}` on which the uniformizer takes + its default value. Every constituent is analytic or the complement of an analytic set + (`analyticSet_projFiberCylNG`; and `Prod.fst '' F` is analytic as a continuous image of + the closed `F`), and the intersections are countable, so the whole lies in `σ(Σ¹₁)`. + Induction over the cylinder basis (`PiNat.isTopologicalBasis_cylinders`) then gives + `closedUniformizerG_analyticallyMeasurable`, and `jvn_closedG` packages the closed case; +* finally `φ x = Prod.snd (π (ψ x))`, which is `σ(Σ¹₁)`-measurable because `π` and + `Prod.snd` are continuous (`AnalyticallyMeasurable.comp_continuous`). + +Unlike Kechris, the Lean development never reduces the domain to `ℕ → ℕ`: the whole tree +construction is generic in a Polish domain `X`, so the Borel-isomorphism invariance of +`σ(Σ¹₁)` that Kechris invokes at the start of his proof is never needed. + +The declaration below restates the library theorem inside the `Uniformization` namespace +so that its name matches the `ChallengeJvN` declaration named in `comparator-jvn.json`; +the root `jankov_von_neumann` it delegates to is the audited declaration of the library. +It is the first of the four headline declarations checked by `AxiomAudit.lean` at the +repository root, and is checked again during the build by `BicausalOT/AxiomsAudit.lean` +(line 35); both report only `[propext, Classical.choice, Quot.sound]`. +-/ + +namespace Uniformization + +/-- **The Jankov–von Neumann uniformization theorem** (Kechris, *Classical Descriptive +Set Theory*, Theorem 18.1; Bertsekas–Shreve, *Stochastic Optimal Control*, Definitions +7.19–7.20 for the `σ(Σ¹₁)` notions). + +Let `X` and `Y` be Polish spaces and let `P ⊆ X × Y` be analytic and nonempty. Then +there is a `σ(Σ¹₁)`-measurable `φ : X → Y` uniformizing `P` on its projection: preimages +under `φ` of Borel subsets of `Y` lie in the σ-algebra generated by the analytic subsets +of `X`, and `(x, φ x) ∈ P` for every `x ∈ Prod.fst '' P`. + +Both σ-algebras in the measurability clause are written out explicitly, so the statement +mentions only Mathlib notions: `MeasurableSpace.generateFrom {s | MeasureTheory.AnalyticSet s}` +is the analytic σ-algebra `σ(Σ¹₁)` of `X`, and `borel Y` is the Borel σ-algebra of `Y`. -/ +theorem jankov_von_neumann {X Y : Type*} [TopologicalSpace X] [TopologicalSpace Y] + [PolishSpace X] [PolishSpace Y] (P : Set (X × Y)) + (hP : MeasureTheory.AnalyticSet P) (hne : P.Nonempty) : + ∃ φ : X → Y, + @Measurable X Y + (MeasurableSpace.generateFrom {s : Set X | MeasureTheory.AnalyticSet s}) (borel Y) φ ∧ + ∀ x ∈ Prod.fst '' P, (x, φ x) ∈ P := + _root_.jankov_von_neumann P hP hne + +end Uniformization diff --git a/LeanPool/BicausalOT/SolutionPolish.lean b/LeanPool/BicausalOT/SolutionPolish.lean new file mode 100644 index 0000000000..c0da34047a --- /dev/null +++ b/LeanPool/BicausalOT/SolutionPolish.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +import Mathlib +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish + +/-! +# Solution file: the space of probability measures on a Polish space is Polish + +This module supplies a declaration whose type is exactly the type stated in +`ChallengePolish`, together with its proof. + +The proof itself lives in `BicausalOT/DescriptiveSetTheory/ProbabilityMeasurePolish.lean`, +which imports Mathlib modules only (`LevyProkhorovMetric`, `Tight`, `Prokhorov`, +`PiSystem`, `GiryMonad`) and nothing else from this repository. Mathlib already supplies +the Lévy–Prokhorov metric, its identification with the topology of weak convergence on a +separable space, and Prokhorov's theorem; what it does not supply, at the pinned revision, +is completeness or separability of that metric. Both are proved there, and the Polish +structure is then transported: + +* **Node A** (`isTightMeasureSet_of_cauchySeq`): a Lévy–Prokhorov Cauchy sequence of + probability measures is uniformly tight. Heads are covered by a countable dense + sequence and continuity from below; tails are transferred between members of the + sequence along the Lévy–Prokhorov inequality; the compact witness is an intersection + over `j` of finite unions of closed balls of radius `2⁻ʲ`, closed and totally bounded, + hence compact by completeness of the base space. +* **Node C1** (`instance : CompleteSpace (LevyProkhorov (ProbabilityMeasure Ω))`): + Prokhorov's theorem (Mathlib's `isCompact_closure_of_isTightMeasureSet`) turns that + tightness into a convergent subsequence, and a Cauchy sequence with a convergent + subsequence converges. +* **Node B** (`exists_diracMix_levyProkhorovDist_le`, `instance : SeparableSpace + (LevyProkhorov (ProbabilityMeasure Ω))`): normalized natural-weight mixtures of Dirac + measures at points of a countable dense sequence are dense in Lévy–Prokhorov distance, + which gives a countable dense subset. +* **Node C2/C3**: complete plus separable metric gives `PolishSpace (LevyProkhorov + (ProbabilityMeasure Ω))`, and Mathlib's homeomorphism + `LevyProkhorov.probabilityMeasureHomeomorph` transports it to `ProbabilityMeasure X` + after upgrading a Polish `X` to a complete separable metric space with + `TopologicalSpace.upgradeIsCompletelyMetrizable`. + +`import Mathlib` is present here so that this module elaborates the statement in the +same environment as `ChallengePolish`, which imports Mathlib and nothing else. The +repository import below declares no name that Mathlib also declares, so it cannot +change how the statement elaborates; the Mathlib import only guarantees that it cannot. + +The declaration below restates the resulting instance as a `theorem` inside the +`ProbabilityMeasurePolish` namespace, so that its name matches the `ChallengePolish` +declaration named in `comparator-polish.json`. Restating an `instance` as a `theorem` +loses nothing here: `PolishSpace` is a `Prop`-valued class, so the instance is a proof of +a proposition and the theorem is a proof of the same proposition. The root +`ProbabilityMeasure.instPolishSpace` it delegates to is the audited declaration of the +library, and is one of the declarations covered by the repository's `#print axioms` audit +(`AxiomAudit.lean` and `BicausalOT/AxiomsAudit.lean`), which reports only +`[propext, Classical.choice, Quot.sound]`. +-/ + +open MeasureTheory + +namespace ProbabilityMeasurePolish + +/-- **The space of probability measures on a Polish space is Polish** (Parthasarathy, +*Probability Measures on Metric Spaces*, Chapter II §6, "The Weak Topology in the Space of +Measures"). + +Let `X` be a Polish space carrying its Borel σ-algebra. Then `ProbabilityMeasure X`, the +space of Borel probability measures on `X` with the topology of weak convergence, is again +Polish: the topology is second countable and admits a complete compatible metric. -/ +theorem polishSpace_probabilityMeasure {X : Type*} [TopologicalSpace X] [PolishSpace X] + [MeasurableSpace X] [BorelSpace X] : + PolishSpace (ProbabilityMeasure X) := + _root_.ProbabilityMeasure.instPolishSpace (X := X) + +end ProbabilityMeasurePolish diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index 95e0c8ad83..b18425b1e5 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -9966,3 +9966,35 @@ projects: msc: - '90C35' - '05C21' + - slug: bicausalot-palomar + title: BicausalOT + summary: Develops measurable selection, descriptive set theory, and the Bellman representation + for bicausal optimal transport over finite horizons. It includes Kuratowski–Ryll-Nardzewski + selection, Jankov–von Neumann uniformization, Choquet capacitability, Polish probability-measure + spaces, and measurable optimal strategies. + branch: probability + entry_module: LeanPool.BicausalOT + authors: + - KT. Wu + source: + url: https://github.com/maxwellapexlab/bicausalot-palomar + github_repo: maxwellapexlab/bicausalot-palomar + commit: 3fe500ff64a75d7ab71b474d0c656d5471f62992 + license: Apache-2.0 + status: verified + main_declarations: + - MeasurableSelection.exists_measurable_selection + main_results: + - declaration: MeasurableSelection.exists_measurable_selection + informal: A weakly measurable multifunction from an arbitrary measurable space to a Polish + space with nonempty closed values admits an everywhere-defined Borel-measurable selector. + tags: + - probability + msc: + - 28B20 + - 54C65 + - 54H05 + - 03E15 + - 28A20 + - 68V20 + provenance: AI From cdd96b2ec90c1430787b4013bab3df84c85cff6a Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 18:56:29 +0000 Subject: [PATCH 2/6] Complete bicausal optimal transport port and local verification --- LeanPool.lean | 36 +++++++++++++ LeanPool/BicausalOT/BicausalOT.lean | 6 +++ LeanPool/BicausalOT/BicausalOT/Basic.lean | 6 +++ .../BicausalOT/BicausalOT/BicausalOT.lean | 8 ++- LeanPool/BicausalOT/BicausalOT/Defs.lean | 20 +++++++- .../DescriptiveSetTheory/AnalyticSet.lean | 6 +++ .../AnalyticSigmaAlgebra.lean | 6 +++ .../DescriptiveSetTheory/Capacitability.lean | 12 +++-- .../CouplingsCompact.lean | 50 ++++++++++--------- .../DescriptiveSetTheory/CouplingsUHC.lean | 14 +++--- .../EpsOptimalSelection.lean | 20 ++++---- .../JankovVonNeumann.lean | 14 +++++- .../DescriptiveSetTheory/KernelIntegral.lean | 10 ++-- .../DescriptiveSetTheory/LintegralLsc.lean | 11 +++- .../LowerSemianalytic.lean | 41 +++++++++------ .../DescriptiveSetTheory/LsaAlgebra.lean | 8 ++- .../DescriptiveSetTheory/LscIntegral.lean | 8 +-- .../MeasurableSelection.lean | 18 ++++--- .../ProbabilityMeasurePolish.lean | 29 ++++++----- .../BicausalOT/DescriptiveSetTheory/Tree.lean | 35 +++++++++---- LeanPool/BicausalOT/BicausalOT/Existence.lean | 7 +++ .../BicausalOT/BicausalOT/FeasNonempty.lean | 22 ++++---- .../BicausalOT/BicausalOT/LowerBound.lean | 7 +++ .../BicausalOT/BicausalOT/LscBellman.lean | 8 +-- .../MeasurableFeasibleStrategy.lean | 6 +++ .../BicausalOT/MeasurableStrategy.lean | 8 +-- .../BicausalOT/BicausalOT/MultiPeriod.lean | 14 ++++-- .../BicausalOT/MultiPeriodTopology.lean | 30 +++++------ .../BicausalOT/BicausalOT/Proposition1.lean | 8 ++- .../BicausalOT/SemianalyticValue.lean | 20 ++++---- .../BicausalOT/BicausalOT/UpperBound.lean | 9 +++- .../BicausalOT/ValueRepresentation.lean | 13 +++-- .../BicausalOT/SolutionCapacitability.lean | 3 +- LeanPool/BicausalOT/SolutionJvN.lean | 4 +- LeanPool/BicausalOT/SolutionPolish.lean | 2 +- 35 files changed, 366 insertions(+), 153 deletions(-) diff --git a/LeanPool.lean b/LeanPool.lean index 9bde6b445e..27495ab603 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -224,6 +224,42 @@ import LeanPool.BannaiBannaiStanton import LeanPool.BannaiBannaiStanton.BoundOnDistanceSet import LeanPool.Basic import LeanPool.BicausalOT +import LeanPool.BicausalOT.BicausalOT +import LeanPool.BicausalOT.BicausalOT.Basic +import LeanPool.BicausalOT.BicausalOT.BicausalOT +import LeanPool.BicausalOT.BicausalOT.Defs +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSigmaAlgebra +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsCompact +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsUHC +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.EpsOptimalSelection +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.JankovVonNeumann +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LintegralLsc +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LowerSemianalytic +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LsaAlgebra +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LscIntegral +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.MeasurableSelection +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish +import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree +import LeanPool.BicausalOT.BicausalOT.Existence +import LeanPool.BicausalOT.BicausalOT.FeasNonempty +import LeanPool.BicausalOT.BicausalOT.LowerBound +import LeanPool.BicausalOT.BicausalOT.LscBellman +import LeanPool.BicausalOT.BicausalOT.MeasurableFeasibleStrategy +import LeanPool.BicausalOT.BicausalOT.MeasurableStrategy +import LeanPool.BicausalOT.BicausalOT.MultiPeriod +import LeanPool.BicausalOT.BicausalOT.MultiPeriodTopology +import LeanPool.BicausalOT.BicausalOT.Proposition1 +import LeanPool.BicausalOT.BicausalOT.SemianalyticValue +import LeanPool.BicausalOT.BicausalOT.UpperBound +import LeanPool.BicausalOT.BicausalOT.ValueRepresentation +import LeanPool.BicausalOT.Solution +import LeanPool.BicausalOT.SolutionCapacitability +import LeanPool.BicausalOT.SolutionJvN +import LeanPool.BicausalOT.SolutionPolish import LeanPool.Biswal import LeanPool.Biswal.Theorem1 import LeanPool.Biswal.Theorem23 diff --git a/LeanPool/BicausalOT/BicausalOT.lean b/LeanPool/BicausalOT/BicausalOT.lean index b4c8fde94a..c58e55b015 100644 --- a/LeanPool/BicausalOT/BicausalOT.lean +++ b/LeanPool/BicausalOT/BicausalOT.lean @@ -6,3 +6,9 @@ Authors: KT. Wu -- This module serves as the root of the `BicausalOT` library. -- Import modules here that should be built as part of the library. import LeanPool.BicausalOT.BicausalOT.Basic + +/-! +# BicausalOT + +Supporting results for bicausal optimal transport and measurable selection. +-/ diff --git a/LeanPool/BicausalOT/BicausalOT/Basic.lean b/LeanPool/BicausalOT/BicausalOT/Basic.lean index 66711f29b6..9316b34bc4 100644 --- a/LeanPool/BicausalOT/BicausalOT/Basic.lean +++ b/LeanPool/BicausalOT/BicausalOT/Basic.lean @@ -31,3 +31,9 @@ import LeanPool.BicausalOT.BicausalOT.SemianalyticValue import LeanPool.BicausalOT.BicausalOT.MeasurableStrategy import LeanPool.BicausalOT.BicausalOT.LscBellman import LeanPool.BicausalOT.BicausalOT.MeasurableFeasibleStrategy + +/-! +# Basic + +Supporting results for bicausal optimal transport and measurable selection. +-/ diff --git a/LeanPool/BicausalOT/BicausalOT/BicausalOT.lean b/LeanPool/BicausalOT/BicausalOT/BicausalOT.lean index f5f711ea52..30c16bbdbb 100644 --- a/LeanPool/BicausalOT/BicausalOT/BicausalOT.lean +++ b/LeanPool/BicausalOT/BicausalOT/BicausalOT.lean @@ -11,7 +11,7 @@ Authors: KT. Wu Structure: Defs.lean — definitions - Proposition1.lean — bicausal ⟺ kernel decomposition + Proposition1.lean — bicausal ↔ kernel decomposition LowerBound.lean — Step 2: ∫V₀ ≤ totalCost UpperBound.lean — Step 3: ε-optimal construction ValueRepresentation.lean — Step 4: equality (main theorem) @@ -35,3 +35,9 @@ import LeanPool.BicausalOT.BicausalOT.LowerBound import LeanPool.BicausalOT.BicausalOT.UpperBound import LeanPool.BicausalOT.BicausalOT.ValueRepresentation import LeanPool.BicausalOT.BicausalOT.Existence + +/-! +# BicausalOT + +Supporting results for bicausal optimal transport and measurable selection. +-/ diff --git a/LeanPool/BicausalOT/BicausalOT/Defs.lean b/LeanPool/BicausalOT/BicausalOT/Defs.lean index 1ffdf8e30e..ddddf40a5d 100644 --- a/LeanPool/BicausalOT/BicausalOT/Defs.lean +++ b/LeanPool/BicausalOT/BicausalOT/Defs.lean @@ -7,10 +7,20 @@ Authors: KT. Wu Bicausal OT — Definitions Couplings, feasible sets, kernel decomposition, bicausality, Bellman value. -/ -import Mathlib.MeasureTheory.Measure.MeasureSpace +import Mathlib.Algebra.Order.Module.Field +import Mathlib.Data.EReal.Inv +import Mathlib.Tactic.Measurability +import Mathlib.Topology.Algebra.InfiniteSum.Order +import Mathlib.Topology.MetricSpace.Bounded import Mathlib.MeasureTheory.Measure.Prod import Mathlib.Probability.Kernel.Basic +/-! +# Defs + +Supporting results for bicausal optimal transport and measurable selection. +-/ + open MeasureTheory ProbabilityTheory Set ENNReal noncomputable section @@ -19,24 +29,30 @@ variable {X₀ X₁ Y₀ Y₁ : Type*} variable [MeasurableSpace X₀] [MeasurableSpace X₁] variable [MeasurableSpace Y₀] [MeasurableSpace Y₁] +/-- The measures coupling the two initial marginals. -/ def CouplingSet₀ (μ₀ : Measure X₀) (ν₀ : Measure Y₀) : Set (Measure (X₀ × Y₀)) := { γ | γ.map Prod.fst = μ₀ ∧ γ.map Prod.snd = ν₀ } +/-- The measures coupling the next-step conditional marginals at a given initial pair. -/ def FeasibleSet₀ (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) (z₀ : X₀ × Y₀) : Set (Measure (X₁ × Y₁)) := { γ | γ.map Prod.fst = κ_μ z₀.1 ∧ γ.map Prod.snd = κ_ν z₀.2 } +/-- An initial coupling and a measurable conditional kernel disintegrating a two-step plan. -/ structure KernelDecomp (π : Measure ((X₀ × X₁) × (Y₀ × Y₁))) where + /-- The initial coupling in the decomposition. -/ γ₀ : Measure (X₀ × Y₀) + /-- The conditional coupling kernel for the second time step. -/ γ₁ : X₀ × Y₀ → Measure (X₁ × Y₁) γ₁_measurable : Measurable γ₁ decomp : ∀ ⦃s : Set ((X₀ × X₁) × (Y₀ × Y₁))⦄, MeasurableSet s → π s = ∫⁻ z₀, (γ₁ z₀) {z₁ | ((z₀.1, z₁.1), (z₀.2, z₁.2)) ∈ s} ∂γ₀ +/-- A two-step plan admits a kernel decomposition with the prescribed marginals at each step. -/ def IsBicausal₂ (μ₀ : Measure X₀) (ν₀ : Measure Y₀) (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) @@ -47,11 +63,13 @@ def IsBicausal₂ variable (c₀ : X₀ × Y₀ → ENNReal) (c₁ : (X₀ × Y₀) × (X₁ × Y₁) → ENNReal) +/-- The initial cost plus the infimum of conditional continuation costs over feasible couplings. -/ def V₀ (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) (z₀ : X₀ × Y₀) : ENNReal := c₀ z₀ + ⨅ (γ : Measure (X₁ × Y₁)) (_ : γ ∈ FeasibleSet₀ κ_μ κ_ν z₀), ∫⁻ z₁, c₁ (z₀, z₁) ∂γ +/-- The expected sum of the initial and continuation costs under the decomposed plan. -/ def totalCost (kd_γ₀ : Measure (X₀ × Y₀)) (kd_γ₁ : X₀ × Y₀ → Measure (X₁ × Y₁)) : ENNReal := ∫⁻ z₀, (c₀ z₀ + ∫⁻ z₁, c₁ (z₀, z₁) ∂(kd_γ₁ z₀)) ∂kd_γ₀ diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSet.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSet.lean index a6cac2abdd..8060c788a7 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSet.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSet.lean @@ -21,5 +21,11 @@ Authors: KT. Wu -/ import Mathlib.MeasureTheory.Constructions.Polish.Basic +/-! +# AnalyticSet + +Supporting results for bicausal optimal transport and measurable selection. +-/ + -- Re-export for downstream modules open MeasureTheory diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSigmaAlgebra.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSigmaAlgebra.lean index 20c89e1d95..13ebdc0a1f 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSigmaAlgebra.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSigmaAlgebra.lean @@ -12,6 +12,12 @@ Authors: KT. Wu -/ import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet +/-! +# AnalyticSigmaAlgebra + +Supporting results for bicausal optimal transport and measurable selection. +-/ + open MeasureTheory Set noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Capacitability.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Capacitability.lean index d13ba58274..7164f1b299 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Capacitability.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Capacitability.lean @@ -29,12 +29,14 @@ import Mathlib.Probability.Kernel.MeasurableLIntegral import Mathlib.Tactic.Finiteness import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet +/-! ## Part I: Bounded branch sets in Baire space -/ + open Set Topology MeasureTheory Filter -open scoped Classical ENNReal +open scoped ENNReal noncomputable section -/-! ## Part I: Bounded branch sets in Baire space -/ + /-- Branches bounded by `β` everywhere: the compact set Σ(β). -/ def capBelow (β : ℕ → ℕ) : Set (ℕ → ℕ) := {σ | ∀ i, σ i ≤ β i} @@ -101,7 +103,7 @@ def capSeqs (β : ℕ → ℕ) (n : ℕ) : Set (ℕ → ℕ) := theorem capTrunc_mem_capSeqs {β : ℕ → ℕ} {n : ℕ} {σ : ℕ → ℕ} (h : σ ∈ capBelowN β n) : capTrunc σ n ∈ capSeqs β n := by refine ⟨fun i hi => ?_, fun i hi => ?_⟩ - · simp only [capTrunc, if_pos hi]; exact h i hi + · simp only [capTrunc, ite_eq_left hi]; exact h i hi · have hn : ¬ i < n := by omega simp [capTrunc, hn] @@ -152,7 +154,7 @@ theorem capScheme_congr (π : (ℕ → ℕ) → Z) {f g : ℕ → ℕ} {n : ℕ} theorem capScheme_trunc (π : (ℕ → ℕ) → Z) (σ : ℕ → ℕ) (n : ℕ) : capScheme π (capTrunc σ n) n = capScheme π σ n := - capScheme_congr π fun i hi => by simp [capTrunc, if_pos hi] + capScheme_congr π fun i hi => by simp [capTrunc, ite_eq_left hi] /-- The n-th bounded approximation: finite union of scheme pieces with prefix bounded by `β`. Closed. -/ @@ -185,7 +187,7 @@ theorem capW_congr (π : (ℕ → ℕ) → Z) {β β' : ℕ → ℕ} {n : ℕ} theorem iInter_capW_subset {Z : Type*} [TopologicalSpace Z] [PolishSpace Z] {π : (ℕ → ℕ) → Z} (hπ : Continuous π) (β : ℕ → ℕ) : (⋂ n, capW π β n) ⊆ π '' capBelow β := by - letI := TopologicalSpace.upgradeIsCompletelyMetrizable Z + let := TopologicalSpace.upgradeIsCompletelyMetrizable Z intro y hy -- for each n, obtain a normalized bounded prefix sₙ with y ∈ closure (π '' N_{sₙ,n}) have hsel : ∀ n : ℕ, ∃ s ∈ capSeqs β n, y ∈ capScheme π s n := by diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsCompact.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsCompact.lean index f258615078..9f431088b6 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsCompact.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsCompact.lean @@ -38,14 +38,18 @@ Authors: KT. Wu front F2's draft_FeasClosed.lean (scratch files cannot import each other); keep a single copy when integrating both fronts. -/ -import Mathlib +import Mathlib.MeasureTheory.Measure.FiniteMeasureProd +import Mathlib.MeasureTheory.Measure.Prokhorov +import Mathlib.Tactic + +/-! ## Translation between `ProbabilityMeasure.map` and `Measure.map` constraints +(verbatim copy of front F2's lemma — dedupe at integration) -/ open MeasureTheory Topology noncomputable section -/-! ## Translation between `ProbabilityMeasure.map` and `Measure.map` constraints -(verbatim copy of front F2's lemma — dedupe at integration) -/ + section Translation @@ -54,8 +58,8 @@ variable {Ω Ω' : Type*} [MeasurableSpace Ω] [MeasurableSpace Ω'] /-- A marginal-type constraint on a `ProbabilityMeasure` can be stated equivalently via `ProbabilityMeasure.map` or via `Measure.map` on the underlying measures. -/ theorem probabilityMeasure_map_eq_iff (γ : ProbabilityMeasure Ω) (μ : ProbabilityMeasure Ω') - {f : Ω → Ω'} (hf : Measurable f) : - γ.map hf.aemeasurable = μ ↔ (γ : Measure Ω).map f = (μ : Measure Ω') := by + (f : Ω → Ω') : + γ.map f = μ ↔ (γ : Measure Ω).map f = (μ : Measure Ω') := by constructor · rintro rfl rfl @@ -80,12 +84,12 @@ convergence. -/ theorem isClosed_probabilityMeasure_couplings (mu : ProbabilityMeasure A) (nu : ProbabilityMeasure B) : IsClosed {γ : ProbabilityMeasure (A × B) | - γ.map measurable_fst.aemeasurable = mu ∧ γ.map measurable_snd.aemeasurable = nu} := by + γ.map Prod.fst = mu ∧ γ.map Prod.snd = nu} := by have hfst : IsClosed {γ : ProbabilityMeasure (A × B) | - γ.map measurable_fst.aemeasurable = mu} := + γ.map Prod.fst = mu} := isClosed_singleton.preimage (ProbabilityMeasure.continuous_map continuous_fst) have hsnd : IsClosed {γ : ProbabilityMeasure (A × B) | - γ.map measurable_snd.aemeasurable = nu} := + γ.map Prod.snd = nu} := isClosed_singleton.preimage (ProbabilityMeasure.continuous_map continuous_snd) exact hfst.inter hsnd @@ -100,11 +104,11 @@ theorem probabilityMeasure_couplings_toMeasure_eq (γ : Measure (A × B)).map Prod.fst = (mu : Measure A) ∧ (γ : Measure (A × B)).map Prod.snd = (nu : Measure B)} = {γ : ProbabilityMeasure (A × B) | - γ.map measurable_fst.aemeasurable = mu ∧ - γ.map measurable_snd.aemeasurable = nu} := by + γ.map Prod.fst = mu ∧ + γ.map Prod.snd = nu} := by ext γ - exact and_congr (probabilityMeasure_map_eq_iff γ mu measurable_fst).symm - (probabilityMeasure_map_eq_iff γ nu measurable_snd).symm + exact and_congr (probabilityMeasure_map_eq_iff γ mu Prod.fst).symm + (probabilityMeasure_map_eq_iff γ nu Prod.snd).symm /-! ## Tightness of coupling sets (front F3, new) -/ @@ -145,12 +149,12 @@ theorem isTightMeasureSet_probabilityMeasure_couplings (mu : ProbabilityMeasure A) (nu : ProbabilityMeasure B) : IsTightMeasureSet {((γ : ProbabilityMeasure (A × B)) : Measure (A × B)) | γ ∈ {γ' : ProbabilityMeasure (A × B) | - γ'.map measurable_fst.aemeasurable = mu ∧ - γ'.map measurable_snd.aemeasurable = nu}} := by + γ'.map Prod.fst = mu ∧ + γ'.map Prod.snd = nu}} := by refine (isTightMeasureSet_couplings mu nu).subset ?_ rintro x ⟨γ, ⟨h₁, h₂⟩, rfl⟩ - exact ⟨(probabilityMeasure_map_eq_iff γ mu measurable_fst).1 h₁, - (probabilityMeasure_map_eq_iff γ nu measurable_snd).1 h₂⟩ + exact ⟨(probabilityMeasure_map_eq_iff γ mu Prod.fst).1 h₁, + (probabilityMeasure_map_eq_iff γ nu Prod.snd).1 h₂⟩ /-! ## Compactness of coupling sets (front F3, main results) -/ @@ -162,9 +166,9 @@ equals its closure. -/ theorem isCompact_probabilityMeasure_couplings (mu : ProbabilityMeasure A) (nu : ProbabilityMeasure B) : IsCompact {γ : ProbabilityMeasure (A × B) | - γ.map measurable_fst.aemeasurable = mu ∧ γ.map measurable_snd.aemeasurable = nu} := by + γ.map Prod.fst = mu ∧ γ.map Prod.snd = nu} := by have hcompact : IsCompact (closure {γ : ProbabilityMeasure (A × B) | - γ.map measurable_fst.aemeasurable = mu ∧ γ.map measurable_snd.aemeasurable = nu}) := + γ.map Prod.fst = mu ∧ γ.map Prod.snd = nu}) := isCompact_closure_of_isTightMeasureSet (isTightMeasureSet_probabilityMeasure_couplings mu nu) rwa [(isClosed_probabilityMeasure_couplings mu nu).closure_eq] at hcompact @@ -197,8 +201,7 @@ theorem isCompact_probabilityMeasure_marginals (m : Measure A) (n : Measure B) : ext γ simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false, iff_false, not_and] intro _ h2 - exact hn (h2 ▸ (γ : Measure (A × B)).isProbabilityMeasure_map - measurable_snd.aemeasurable) + exact hn (h2 ▸ (inferInstance : IsProbabilityMeasure ((γ : Measure (A × B)).map Prod.snd))) rw [hempty] exact isCompact_empty · have hempty : {γ : ProbabilityMeasure (A × B) | @@ -207,8 +210,7 @@ theorem isCompact_probabilityMeasure_marginals (m : Measure A) (n : Measure B) : ext γ simp only [Set.mem_ofPred_eq, Set.mem_empty_iff_false, iff_false, not_and] intro h1 _ - exact hm (h1 ▸ (γ : Measure (A × B)).isProbabilityMeasure_map - measurable_fst.aemeasurable) + exact hm (h1 ▸ (inferInstance : IsProbabilityMeasure ((γ : Measure (A × B)).map Prod.fst))) rw [hempty] exact isCompact_empty @@ -223,8 +225,8 @@ coupling set — the Existence-upgrade prize. -/ theorem probabilityMeasure_couplings_nonempty (mu : ProbabilityMeasure A) (nu : ProbabilityMeasure B) : {γ : ProbabilityMeasure (A × B) | - γ.map measurable_fst.aemeasurable = mu ∧ - γ.map measurable_snd.aemeasurable = nu}.Nonempty := + γ.map Prod.fst = mu ∧ + γ.map Prod.snd = nu}.Nonempty := ⟨mu.prod nu, ProbabilityMeasure.map_fst_prod mu nu, ProbabilityMeasure.map_snd_prod mu nu⟩ end Couplings diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsUHC.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsUHC.lean index af66b95b10..8a17f30efe 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsUHC.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsUHC.lean @@ -23,11 +23,13 @@ Authors: KT. Wu import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsCompact import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish +/-! ## U1: convergent sequences of probability measures are tight -/ + open MeasureTheory Set Filter Topology noncomputable section -/-! ## U1: convergent sequences of probability measures are tight -/ + /-- A convergent sequence of probability measures on a Polish space is a tight family (converse Prokhorov on the compact closure of its range). -/ @@ -40,7 +42,7 @@ theorem isTightMeasureSet_range_of_tendsto {Ω : Type*} have hclos : IsCompact (closure (Set.range γs)) := hins.of_isClosed_subset isClosed_closure (closure_minimal (Set.subset_insert γ (Set.range γs)) hins.isClosed) - letI := TopologicalSpace.upgradeIsCompletelyMetrizable Ω + let := TopologicalSpace.upgradeIsCompletelyMetrizable Ω have htight := isTightMeasureSet_of_isCompact_closure hclos have hset : {((μ : ProbabilityMeasure Ω) : Measure Ω) | μ ∈ Set.range γs} = {((γs n : ProbabilityMeasure Ω) : Measure Ω) | n : ℕ} := by @@ -124,21 +126,21 @@ theorem exists_tendsto_subseq_couplings hcomp.tendsto_subseq (fun n => subset_closure (Set.mem_range_self n)) -- identify the marginals of the limit by continuity of the pushforward have hfst' : (γ : Measure (A × B)).map Prod.fst = (μ : Measure A) := by - refine (probabilityMeasure_map_eq_iff γ μ measurable_fst).mp ?_ + refine (probabilityMeasure_map_eq_iff γ μ Prod.fst).mp ?_ refine tendsto_nhds_unique ?_ (hμ.comp hφmono.tendsto_atTop) have hc := MeasureTheory.ProbabilityMeasure.continuous_map (Ω := A × B) (Ω' := A) continuous_fst have := (hc.tendsto γ).comp hφt refine (tendsto_congr fun k => ?_).mp this - exact (probabilityMeasure_map_eq_iff _ _ measurable_fst).mpr (hfst (φ k)) + exact (probabilityMeasure_map_eq_iff _ _ Prod.fst).mpr (hfst (φ k)) have hsnd' : (γ : Measure (A × B)).map Prod.snd = (ν : Measure B) := by - refine (probabilityMeasure_map_eq_iff γ ν measurable_snd).mp ?_ + refine (probabilityMeasure_map_eq_iff γ ν Prod.snd).mp ?_ refine tendsto_nhds_unique ?_ (hν.comp hφmono.tendsto_atTop) have hc := MeasureTheory.ProbabilityMeasure.continuous_map (Ω := A × B) (Ω' := B) continuous_snd have := (hc.tendsto γ).comp hφt refine (tendsto_congr fun k => ?_).mp this - exact (probabilityMeasure_map_eq_iff _ _ measurable_snd).mpr (hsnd (φ k)) + exact (probabilityMeasure_map_eq_iff _ _ Prod.snd).mpr (hsnd (φ k)) exact ⟨γ, hfst', hsnd', φ, hφmono, hφt⟩ /-! ## U4: hit-sets of closed targets are closed -/ diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/EpsOptimalSelection.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/EpsOptimalSelection.lean index ef11864f1d..f4064228b9 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/EpsOptimalSelection.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/EpsOptimalSelection.lean @@ -26,14 +26,15 @@ import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral import Mathlib.MeasureTheory.MeasurableSpace.Constructions +/-! ## Fiber infimum approximation -/ + open MeasureTheory Set ENNReal -open scoped Classical noncomputable section variable {H E : Type*} [TopologicalSpace H] [TopologicalSpace E] -/-! ## Fiber infimum approximation -/ + omit [TopologicalSpace H] [TopologicalSpace E] in /-- Any value strictly above the fiber infimum is beaten by some element @@ -52,7 +53,7 @@ theorem iInf_fiber_lt {Γ : Set (H × E)} {F : H × E → ℝ≥0∞} {h : H} /-- A σ(Σ¹₁)-measurable everywhere-feasible selector exists as soon as the graph is analytic, nonempty, and has nonempty fibers (Jankov–von Neumann). -/ -theorem exists_fallback_selector [PolishSpace H] [PolishSpace E] +theorem exists_fallback_selector [PolishSpace H] {Γ : Set (H × E)} (hΓ : AnalyticSet Γ) (hΓne : Γ.Nonempty) (hfib : ∀ h : H, ∃ e : E, (h, e) ∈ Γ) : ∃ φ : H → E, AnalyticallyMeasurable φ ∧ ∀ h, (h, φ h) ∈ Γ := by @@ -94,8 +95,8 @@ theorem AnalyticallyMeasurable.find (hp : ∀ m, @MeasurableSet H (analyticMeasurableSpace H) {h | p m h}) (hex : ∀ h, ∃ m, p m h) : AnalyticallyMeasurable (fun h => ψ (Nat.find (hex h)) h) := by - letI : MeasurableSpace H := analyticMeasurableSpace H - letI : MeasurableSpace E := borel E + let : MeasurableSpace H := analyticMeasurableSpace H + let : MeasurableSpace E := borel E exact Measurable.find hψ hp hex /-! ## Band bookkeeping in ℝ≥0∞ -/ @@ -137,6 +138,7 @@ end EpsOptimalSelection /-! ## The main theorem: BS Proposition 7.50, ε-optimal half -/ open EpsOptimalSelection in +open scoped Classical in /-- **ε-optimal analytically measurable selection** (Bertsekas–Shreve, Proposition 7.50 analogue, ε-optimal half, in `ℝ≥0∞`). If `Γ ⊆ H × E` is analytic with nonempty fibers (H, E Polish) and `F` is lower @@ -159,9 +161,9 @@ theorem exists_eps_optimal_selector [PolishSpace H] [PolishSpace E] ∀ h, F (h, φ h) ≤ (⨅ (e : E) (_ : (h, e) ∈ Γ), F (h, e)) + ε := by rcases isEmpty_or_nonempty H with hH | hH · -- degenerate domain: everything is vacuous - haveI := hH - letI : MeasurableSpace H := analyticMeasurableSpace H - letI : MeasurableSpace E := borel E + have := hH + let : MeasurableSpace H := analyticMeasurableSpace H + let : MeasurableSpace E := borel E exact ⟨fun h => isEmptyElim h, measurable_of_empty _, fun h => isEmptyElim h, fun h => isEmptyElim h⟩ · obtain ⟨h₀⟩ := hH @@ -198,7 +200,7 @@ theorem exists_eps_optimal_selector [PolishSpace H] [PolishSpace E] | zero => have hset : {h : H | bandPred ε' 0 (g h)} = {h : H | g h < ⊤}ᶜ := by ext h - show g h = ∞ ↔ ¬ g h < ⊤ + change g h = ∞ ↔ ¬ g h < ⊤ simp [lt_top_iff_ne_top] rw [hset] exact (hg ⊤).compl_mem_analyticMeasurableSpace diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/JankovVonNeumann.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/JankovVonNeumann.lean index 59e9e94e40..ae2af1edeb 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/JankovVonNeumann.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/JankovVonNeumann.lean @@ -14,9 +14,19 @@ Authors: KT. Wu call site (UpperBound.lean uses `_`), we drop it and prove the rest. -/ import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet -import Mathlib.MeasureTheory.Measure.MeasureSpace +import Mathlib.Algebra.Order.Module.Field +import Mathlib.Data.EReal.Inv +import Mathlib.Tactic.Measurability +import Mathlib.Topology.Algebra.InfiniteSum.Order +import Mathlib.Topology.MetricSpace.Bounded import Mathlib.MeasureTheory.Measure.Prod +/-! +# JankovVonNeumann + +Supporting results for bicausal optimal transport and measurable selection. +-/ + open MeasureTheory Set ENNReal noncomputable section @@ -38,7 +48,7 @@ private theorem eps_optimal_element' /-- ε-optimal selection: for each a, choose m ∈ S(a) with f(a,m) ≤ inf + ε. -/ theorem eps_optimal_selection - {α β : Type*} [MeasurableSpace α] [MeasurableSpace β] + {α β : Type*} [MeasurableSpace β] (S : α → Set (Measure β)) (h_ne : ∀ a, (S a).Nonempty) (f : α → Measure β → ENNReal) diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/KernelIntegral.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/KernelIntegral.lean index 890fd41e5c..e3041b5b99 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/KernelIntegral.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/KernelIntegral.lean @@ -27,12 +27,14 @@ import Mathlib.MeasureTheory.Measure.Lebesgue.Basic import Mathlib.Probability.Kernel.Composition.Prod import Mathlib.MeasureTheory.Integral.Lebesgue.Sub +/-! ## Binary closure properties of analytic sets -/ + open Set Topology MeasureTheory ProbabilityTheory Filter -open scoped Classical ENNReal +open scoped ENNReal noncomputable section -/-! ## Binary closure properties of analytic sets -/ + theorem MeasureTheory.AnalyticSet.inter' {W : Type*} [TopologicalSpace W] [T2Space W] @@ -292,7 +294,7 @@ theorem lintegral_lowerSemianalytic IsLowerSemianalytic (fun x => ∫⁻ y, f (x, y) ∂(κ x)) := by -- kernel packaging set κK : Kernel X Y := ⟨κ, hκ⟩ with hκK - haveI : IsMarkovKernel κK := ⟨fun a => hκp a⟩ + have : IsMarkovKernel κK := ⟨fun a => hκp a⟩ -- transported epigraph pieces Eₙ ⊆ X × (Y × ℝ) set E : ℕ → Set (X × (Y × ℝ)) := fun n => (Homeomorph.prodAssoc X Y ℝ).symm ⁻¹' @@ -317,7 +319,7 @@ theorem lintegral_lowerSemianalytic exact ⟨h1, mem_univ _, h2⟩ -- the Lebesgue factors set lam : ℕ → Measure ℝ := fun n => volume.restrict (Icc (0 : ℝ) n) with hlam - haveI hlam_fin : ∀ n, IsFiniteMeasure (lam n) := fun n => by + have hlam_fin : ∀ n, IsFiniteMeasure (lam n) := fun n => by rw [hlam]; infer_instance -- truncated integrals set a : ℕ → X → ℝ≥0∞ := diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LintegralLsc.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LintegralLsc.lean index 479f56704c..d3840013c1 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LintegralLsc.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LintegralLsc.lean @@ -37,7 +37,16 @@ We upgrade it to lower semicontinuous `ℝ≥0∞`-valued integrands in three st `γs → γ` with `∫⁻ f ∂(γs n) ≤ y < ∫⁻ f ∂γ`, contradicting step 2 combined with the portmanteau inequality along `γs`. -/ -import Mathlib +import Mathlib.Algebra.Order.Ring.Star +import Mathlib.MeasureTheory.Measure.LevyProkhorovMetric +import Mathlib.Order.CompletePartialOrder +import Mathlib.Tactic + +/-! +# LintegralLsc + +Supporting results for BicausalOT. +-/ open MeasureTheory Filter Set Topology open scoped ENNReal diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LowerSemianalytic.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LowerSemianalytic.lean index b99b6a4e2a..221621dfa1 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LowerSemianalytic.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LowerSemianalytic.lean @@ -9,9 +9,26 @@ Authors: KT. Wu Reference: Bertsekas–Shreve, Definition 7.21, Lemma 7.30, Props 7.47–7.48 -/ import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet -import Mathlib.MeasureTheory.Measure.MeasureSpace +import Mathlib.Algebra.Order.Module.Field +import Mathlib.Data.EReal.Inv +import Mathlib.Tactic.Measurability +import Mathlib.Topology.Algebra.InfiniteSum.Order +import Mathlib.Topology.MetricSpace.Bounded import Mathlib.MeasureTheory.Measure.Prod +/-! ### On BS Prop 7.48 (integration of lower semianalytic functions) + +An earlier draft stated Bertsekas–Shreve Prop 7.48 as an `axiom` +(`lintegral_lowerSemianalytic`). It is now a fully verified THEOREM — +see `BicausalOT.DescriptiveSetTheory.KernelIntegral`. The missing +ingredient, Choquet's capacitability theorem for analytic sets +(μ(A) = sup{μ(K) | K compact ⊆ A}, not available in Mathlib), is proved +from scratch in `BicausalOT.DescriptiveSetTheory.Capacitability` +(`MeasureTheory.AnalyticSet.measure_eq_iSup_isCompact`), together with +universal measurability (`MeasureTheory.AnalyticSet.nullMeasurableSet`) +and the parametrized kernel version +(`MeasureTheory.AnalyticSet.kernel_section_gt`). -/ + open MeasureTheory Set ENNReal noncomputable section @@ -38,7 +55,7 @@ theorem LowerSemicontinuous.isLowerSemianalytic Proof: {x | inf < c} = projₓ({(x,y) ∈ D | f(x,y) < c}). Intersection of two analytic sets is analytic; projection preserves analytic. -/ theorem IsLowerSemianalytic.iInf_fiber - {Y : Type*} [TopologicalSpace Y] [PolishSpace X] [PolishSpace Y] + {Y : Type*} [TopologicalSpace Y] [PolishSpace Y] [T2Space X] {D : Set (X × Y)} (hD : AnalyticSet D) {f : X × Y → ENNReal} (hf : IsLowerSemianalytic (X := X × Y) f) : @@ -61,21 +78,15 @@ theorem IsLowerSemianalytic.iInf_fiber have h1 := hD have h2 := hf c rw [show D ∩ {p | f p < c} = ⋂ (i : Fin 2), - (![D, {p | f p < c}]) i from by ext x; simp [Fin.forall_fin_two, Matrix.cons_val_zero, Matrix.cons_val_one]] - exact AnalyticSet.iInter (fun i => by fin_cases i <;> simp [Matrix.cons_val_zero, Matrix.cons_val_one] <;> assumption) + (![D, {p | f p < c}]) i from by ext x; simp [Fin.forall_fin_two, Matrix.cons_val_zero, + Matrix.cons_val_one]] + apply AnalyticSet.iInter + intro i + fin_cases i + · exact h1 + · exact h2 exact h_inter.image_of_continuous continuous_fst -/-! ### On BS Prop 7.48 (integration of lower semianalytic functions) -An earlier draft stated Bertsekas–Shreve Prop 7.48 as an `axiom` -(`lintegral_lowerSemianalytic`). It is now a fully verified THEOREM — -see `BicausalOT.DescriptiveSetTheory.KernelIntegral`. The missing -ingredient, Choquet's capacitability theorem for analytic sets -(μ(A) = sup{μ(K) | K compact ⊆ A}, not available in Mathlib), is proved -from scratch in `BicausalOT.DescriptiveSetTheory.Capacitability` -(`MeasureTheory.AnalyticSet.measure_eq_iSup_isCompact`), together with -universal measurability (`MeasureTheory.AnalyticSet.nullMeasurableSet`) -and the parametrized kernel version -(`MeasureTheory.AnalyticSet.kernel_section_gt`). -/ end diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LsaAlgebra.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LsaAlgebra.lean index f02c7f89e6..33c15ab660 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LsaAlgebra.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LsaAlgebra.lean @@ -13,6 +13,12 @@ Authors: KT. Wu -/ import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral +/-! +# LsaAlgebra + +Supporting results for bicausal optimal transport and measurable selection. +-/ + open Set MeasureTheory open scoped ENNReal @@ -28,7 +34,7 @@ theorem IsLowerSemianalytic.add [T2Space X] {f g : X → ℝ≥0∞} (hf : IsLowerSemianalytic f) (hg : IsLowerSemianalytic g) : IsLowerSemianalytic (fun x => f x + g x) := by intro c - show AnalyticSet {x | f x + g x < c} + change AnalyticSet {x | f x + g x < c} have hdecomp : {x | f x + g x < c} = ⋃ q : ℚ, ({x | f x < (Real.toNNReal q : ℝ≥0∞)} ∩ {x | g x < c - (Real.toNNReal q : ℝ≥0∞)}) := by diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LscIntegral.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LscIntegral.lean index e0c5c9121e..bc1f6f48cf 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LscIntegral.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LscIntegral.lean @@ -25,6 +25,8 @@ Authors: KT. Wu -/ import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LintegralLsc +/-! ## J1: joint continuity of the pairing -/ + open MeasureTheory Set Filter Topology open scoped ENNReal @@ -34,14 +36,14 @@ variable {H W : Type*} [TopologicalSpace H] [PolishSpace H] [MeasurableSpace H] [BorelSpace H] [TopologicalSpace W] [PolishSpace W] [MeasurableSpace W] [BorelSpace W] -/-! ## J1: joint continuity of the pairing -/ + /-- **Joint continuity of the pairing** `(x, γ) ↦ γ.map (Prod.mk x)` from `H × P(W)` to `P(H × W)` (weak topologies, Polish spaces). -/ theorem continuous_probabilityMeasure_map_prodMk : Continuous (fun p : H × ProbabilityMeasure W => ProbabilityMeasure.map p.2 - (measurable_prodMk_left (x := p.1)).aemeasurable) := by + (Prod.mk p.1)) := by refine SeqContinuous.continuous fun ps p hps => ?_ have hx : Tendsto (fun n => (ps n).1) atTop (𝓝 p.1) := (continuous_fst.tendsto p).comp hps @@ -96,7 +98,7 @@ theorem lowerSemicontinuous_lintegral_prodMk ∫⁻ q, f q ∂(γ : Measure (H × W))) ∘ (fun p : H × ProbabilityMeasure W => ProbabilityMeasure.map p.2 - (measurable_prodMk_left (x := p.1)).aemeasurable) := by + (Prod.mk p.1)) := by funext p simp only [Function.comp_apply, ProbabilityMeasure.toMeasure_map] rw [lintegral_map hf.measurable measurable_prodMk_left] diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/MeasurableSelection.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/MeasurableSelection.lean index db2cc6dabd..931a19d196 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/MeasurableSelection.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/MeasurableSelection.lean @@ -26,13 +26,19 @@ open-set measurability hypothesis applies directly. The limit `f = lim fₙ` is measurable as a pointwise limit of measurable functions into a metrizable space, and `f a ∈ Φ a` because `Φ a` is closed. -/ -import Mathlib +import Mathlib.Algebra.Order.Ring.Star +import Mathlib.Algebra.Order.Star.Real +import Mathlib.Analysis.Normed.Order.Lattice +import Mathlib.MeasureTheory.Constructions.BorelSpace.Metrizable +import Mathlib.Tactic + +/-! ### Least-index choice over `ℕ`, classical-decidability wrapper -/ open Metric Set Filter Topology TopologicalSpace namespace MeasurableSelection -/-! ### Least-index choice over `ℕ`, classical-decidability wrapper -/ + /-- The least `n : ℕ` satisfying `p`, with classical decidability baked in (so that it can be used in `noncomputable` constructions without carrying instances around). -/ @@ -40,12 +46,12 @@ noncomputable def firstIdx (p : ℕ → Prop) (h : ∃ n, p n) : ℕ := @Nat.find p (Classical.decPred p) h theorem firstIdx_spec {p : ℕ → Prop} (h : ∃ n, p n) : p (firstIdx p h) := by - letI := Classical.decPred p + let := Classical.decPred p exact Nat.find_spec h theorem firstIdx_eq_iff {p : ℕ → Prop} (h : ∃ n, p n) {k : ℕ} : firstIdx p h = k ↔ p k ∧ ∀ j < k, ¬p j := by - letI := Classical.decPred p + let := Classical.decPred p exact Nat.find_eq_iff h variable {α : Type*} [MeasurableSpace α] @@ -252,9 +258,9 @@ theorem exists_measurable_selection {α : Type*} [MeasurableSpace α] {Y : Type* (hmeas : ∀ U : Set Y, IsOpen U → MeasurableSet {a | (Φ a ∩ U).Nonempty}) : ∃ f : α → Y, Measurable f ∧ ∀ a, f a ∈ Φ a := by rcases isEmpty_or_nonempty α with hα | hα - · haveI := hα + · have := hα exact ⟨fun a => (hne a).some, measurable_of_empty _, fun a => (hne a).some_mem⟩ · obtain ⟨a₀⟩ := hα - haveI : Nonempty Y := ⟨(hne a₀).some⟩ + have : Nonempty Y := ⟨(hne a₀).some⟩ obtain ⟨u, hu⟩ := TopologicalSpace.exists_dense_seq Y exact MeasurableSelection.exists_selection_of_denseRange hu hne hclosed hmeas diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ProbabilityMeasurePolish.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ProbabilityMeasurePolish.lean index e8c9c7610b..feeb621aba 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ProbabilityMeasurePolish.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ProbabilityMeasurePolish.lean @@ -19,15 +19,17 @@ import Mathlib.MeasureTheory.Measure.Prokhorov import Mathlib.MeasureTheory.PiSystem import Mathlib.MeasureTheory.Measure.GiryMonad +/-! ## Node A: Lévy-Prokhorov Cauchy sequences are uniformly tight -/ + open MeasureTheory Topology TopologicalSpace Metric Filter Set -open scoped ENNReal NNReal Classical +open scoped ENNReal NNReal noncomputable section variable {Ω : Type*} [MetricSpace Ω] [SeparableSpace Ω] [CompleteSpace Ω] [MeasurableSpace Ω] [BorelSpace Ω] -/-! ## Node A: Lévy-Prokhorov Cauchy sequences are uniformly tight -/ + omit [SeparableSpace Ω] [CompleteSpace Ω] in /-- A1, heads: any single probability measure puts mass `≥ 1 - ε` on a @@ -65,6 +67,7 @@ theorem exists_range_measure_ball_compl_lt exact (htendsto.eventually_lt_const hε).exists omit [CompleteSpace Ω] in +open scoped Classical in /-- A1: for a Lévy-Prokhorov Cauchy sequence of probability measures on a Polish space, all measures simultaneously put mass `≥ 1 - δ` on one common finite union of `η`-balls. Heads are covered by density and @@ -294,7 +297,7 @@ theorem diracMix_sum_ne_zero (x₀ : Ω) {N : ℕ} (x : Fin N → Ω) (a : Fin N (h : (∑ i, a i) ≠ 0) : diracMix x₀ x a = (∑ i, (a i : ℝ≥0∞))⁻¹ • ∑ i, (a i : ℝ≥0∞) • Measure.dirac (x i) := by - rw [diracMix, if_neg h] + rw [diracMix, ite_eq_right h] instance diracMix_isProbabilityMeasure (x₀ : Ω) {N : ℕ} (x : Fin N → Ω) (a : Fin N → ℕ) : @@ -319,6 +322,7 @@ instance diracMix_isProbabilityMeasure (x₀ : Ω) {N : ℕ} exact ENNReal.inv_mul_cancel hsum htop omit [MetricSpace Ω] [SeparableSpace Ω] [CompleteSpace Ω] [BorelSpace Ω] in +open scoped Classical in /-- Lower bound for a Dirac mixture on a measurable set: the normalized weight of the atoms lying in the set, with any upper bound `m` on the total weight. -/ @@ -388,6 +392,7 @@ theorem exists_measure_compl_partial_iUnion_lt exact (htendsto.eventually_lt_const hε).exists omit [CompleteSpace Ω] in +open scoped Classical in /-- B1+B2: every probability measure on a Polish space is within `3ε` in Lévy-Prokhorov distance of a normalized natural-weight Dirac mixture at points of any dense sequence. -/ @@ -581,13 +586,13 @@ theorem exists_diracMix_levyProkhorovDist_le instance : SeparableSpace (LevyProkhorov (ProbabilityMeasure Ω)) := by rcases isEmpty_or_nonempty Ω with hΩ | hΩ - · haveI : IsEmpty (ProbabilityMeasure Ω) := by + · have : IsEmpty (ProbabilityMeasure Ω) := by constructor intro μ have h1 : (μ : Measure Ω) univ = 1 := measure_univ rw [Set.univ_eq_empty_iff.mpr hΩ, measure_empty] at h1 exact zero_ne_one h1 - haveI : IsEmpty (LevyProkhorov (ProbabilityMeasure Ω)) := + have : IsEmpty (LevyProkhorov (ProbabilityMeasure Ω)) := ⟨fun x => IsEmpty.elim ‹_› x.toMeasure⟩ exact ⟨⟨∅, countable_empty, by rw [dense_iff_closure_eq, closure_empty] @@ -632,7 +637,7 @@ instance ProbabilityMeasure.instPolishSpace {X : Type*} [TopologicalSpace X] [PolishSpace X] [MeasurableSpace X] [BorelSpace X] : PolishSpace (ProbabilityMeasure X) := by - letI := TopologicalSpace.upgradeIsCompletelyMetrizable X + let := TopologicalSpace.upgradeIsCompletelyMetrizable X exact (LevyProkhorov.probabilityMeasureHomeomorph (Ω := X)).isClosedEmbedding.polishSpace @@ -669,8 +674,8 @@ theorem probabilityMeasure_borel_measurable_apply_isClosed @Measurable (ProbabilityMeasure Ω) ℝ≥0∞ (borel (ProbabilityMeasure Ω)) inferInstance (fun γ => (γ : Measure Ω) F) := by - letI : MeasurableSpace (ProbabilityMeasure Ω) := borel _ - haveI : BorelSpace (ProbabilityMeasure Ω) := ⟨rfl⟩ + let : MeasurableSpace (ProbabilityMeasure Ω) := borel _ + have : BorelSpace (ProbabilityMeasure Ω) := ⟨rfl⟩ have hlim : Tendsto (fun n => fun γ : ProbabilityMeasure Ω => ∫⁻ x, (hF.apprSeq n x : ℝ≥0∞) ∂(γ : Measure Ω)) @@ -690,8 +695,8 @@ theorem probabilityMeasure_borel_measurable_apply @Measurable (ProbabilityMeasure Ω) ℝ≥0∞ (borel (ProbabilityMeasure Ω)) inferInstance (fun γ => (γ : Measure Ω) s) := by - letI : MeasurableSpace (ProbabilityMeasure Ω) := borel _ - haveI : BorelSpace (ProbabilityMeasure Ω) := ⟨rfl⟩ + let : MeasurableSpace (ProbabilityMeasure Ω) := borel _ + have : BorelSpace (ProbabilityMeasure Ω) := ⟨rfl⟩ induction s, hs using MeasurableSpace.induction_on_inter (m := (inferInstance : MeasurableSpace Ω)) (s := {t : Set Ω | IsClosed t}) @@ -724,7 +729,7 @@ theorem probabilityMeasure_borel_measurable_toMeasure : @Measurable (ProbabilityMeasure Ω) (Measure Ω) (borel (ProbabilityMeasure Ω)) inferInstance ((↑) : ProbabilityMeasure Ω → Measure Ω) := by - letI : MeasurableSpace (ProbabilityMeasure Ω) := borel _ + let : MeasurableSpace (ProbabilityMeasure Ω) := borel _ exact Measure.measurable_measure.mpr fun s hs => probabilityMeasure_borel_measurable_apply hs @@ -784,7 +789,7 @@ theorem measurableSet_eq_measure {α : Type*} [MeasurableSpace α] {W : Type*} ext a simp only [mem_ofPred_eq, mem_iInter] refine ⟨fun h s _ => by rw [h], fun h => ?_⟩ - haveI := hFfin a + have := hFfin a exact ext_of_generate_finite _ hCgen hCpi h (by rw [(hFfin a).measure_univ, (hGfin a).measure_univ]) rw [hset] diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Tree.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Tree.lean index 0c0fd6e020..465988f346 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Tree.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Tree.lean @@ -16,15 +16,17 @@ import Mathlib.Topology.MetricSpace.PiNat import Mathlib.MeasureTheory.Constructions.Polish.Basic import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSigmaAlgebra +/-! ## Part I: Fibers (generic domain X, codomain ℕᴺ) -/ + open Set Topology MeasureTheory -open scoped Classical noncomputable section variable {X : Type*} [TopologicalSpace X] -/-! ## Part I: Fibers (generic domain X, codomain ℕᴺ) -/ + +/-- The fiber of a subset of the product with Baire space over the given point. -/ def closedFiberG (F : Set (X × (ℕ → ℕ))) (x : X) : Set (ℕ → ℕ) := { y | (x, y) ∈ F } @@ -33,7 +35,7 @@ theorem closedFiberG_nonempty_iff (F : Set (X × (ℕ → ℕ))) (x : X) : (closedFiberG F x).Nonempty ↔ x ∈ Prod.fst '' F := by constructor · rintro ⟨y, hy⟩; exact ⟨(x, y), hy, rfl⟩ - · rintro ⟨⟨x', y⟩, hm, hx⟩; simp at hx; exact ⟨y, hx ▸ hm⟩ + · rintro ⟨⟨x', y⟩, hm, rfl⟩; exact ⟨y, hm⟩ theorem isClosed_closedFiberG {F : Set (X × (ℕ → ℕ))} (hF : IsClosed F) (x : X) : IsClosed (closedFiberG F x) := @@ -41,6 +43,7 @@ theorem isClosed_closedFiberG {F : Set (X × (ℕ → ℕ))} (hF : IsClosed F) ( /-! ## Part II: Leftmost branch (generic domain) -/ +/-- The fiber restricted to sequences agreeing with a prescribed prefix. -/ def fiberRestNG (F : Set (X × (ℕ → ℕ))) (x : X) (f : ℕ → ℕ) (n : ℕ) : Set (ℕ → ℕ) := { y | (x, y) ∈ F ∧ ∀ i < n, y i = f i } @@ -59,6 +62,8 @@ theorem exists_extNG {F : Set (X × (ℕ → ℕ))} {x : X} {f : ℕ → ℕ} {n · rw [Function.update_of_ne (by omega)]; exact hy_ext i h · subst h; simp [Function.update_self] +open scoped Classical in +/-- Recursively choose the smallest extendible next coordinate in each nonempty fiber. -/ def leftmostAuxG (F : Set (X × (ℕ → ℕ))) (x : X) (h₀ : (closedFiberG F x).Nonempty) : (n : ℕ) → { f : ℕ → ℕ // (fiberRestNG F x f n).Nonempty } @@ -68,6 +73,8 @@ def leftmostAuxG (F : Set (X × (ℕ → ℕ))) (x : X) ⟨Function.update f n (Nat.find (exists_extNG hf)), Nat.find_spec (exists_extNG hf)⟩ +open scoped Classical in +/-- The sequence obtained by choosing the smallest extendible coordinate at every step. -/ def leftmostBranchG (F : Set (X × (ℕ → ℕ))) (x : X) (h₀ : (closedFiberG F x).Nonempty) (n : ℕ) : ℕ := Nat.find (exists_extNG (leftmostAuxG F x h₀ n).2) @@ -85,6 +92,7 @@ theorem leftmostAuxG_eq (F : Set (X × (ℕ → ℕ))) (x : X) · rw [Function.update_of_ne (by omega)]; exact ih i h · subst h; simp [Function.update_self] +/-- Choose a fiber element extending the specified finite prefix of the leftmost branch. -/ def leftmostWitnessG (F : Set (X × (ℕ → ℕ))) (x : X) (h₀ : (closedFiberG F x).Nonempty) (n : ℕ) : ℕ → ℕ := (leftmostAuxG F x h₀ n).2.some @@ -112,6 +120,7 @@ theorem leftmostBranchG_mem (Filter.Eventually.of_forall (leftmostWitnessG_mem F x h₀)) omit [TopologicalSpace X] in +open scoped Classical in theorem leftmostBranchG_least (F : Set (X × (ℕ → ℕ))) (x : X) (h₀ : (closedFiberG F x).Nonempty) (n k : ℕ) (hk : k < leftmostBranchG F x h₀ n) : @@ -120,6 +129,7 @@ theorem leftmostBranchG_least (F : Set (X × (ℕ → ℕ))) (x : X) /-! ## Part III: Fiber-cylinder projections (generic domain) -/ +/-- The domain points whose fibers meet a prescribed finite cylinder. -/ def projFiberCylNG (F : Set (X × (ℕ → ℕ))) (f : ℕ → ℕ) (n : ℕ) : Set X := { x | (fiberRestNG F x f n).Nonempty } @@ -140,6 +150,8 @@ theorem analyticSet_projFiberCylNG [PolishSpace X] /-! ## Part IV: Closed uniformizer (generic domain) -/ +open scoped Classical in +/-- Select the leftmost branch in a nonempty fiber, with a fixed fallback outside the projection. -/ def closedUniformizerG (F : Set (X × (ℕ → ℕ))) (_hF : IsClosed F) (hne : F.Nonempty) : X → (ℕ → ℕ) := fun x => if h : (closedFiberG F x).Nonempty then leftmostBranchG F x h @@ -149,10 +161,11 @@ theorem closedUniformizerG_selection {F : Set (X × (ℕ → ℕ))} (hF : IsClosed F) (hne : F.Nonempty) {x : X} (hx : x ∈ Prod.fst '' F) : (x, closedUniformizerG F hF hne x) ∈ F := by - simp only [closedUniformizerG, dif_pos ((closedFiberG_nonempty_iff F x).mpr hx)] + simp only [closedUniformizerG, dite_eq_left ((closedFiberG_nonempty_iff F x).mpr hx)] exact leftmostBranchG_mem hF x _ -theorem closedUniformizerG_cylinder_eq [PolishSpace X] +open scoped Classical in +theorem closedUniformizerG_cylinder_eq {F : Set (X × (ℕ → ℕ))} (hF : IsClosed F) (hne : F.Nonempty) (f : ℕ → ℕ) (n : ℕ) : { x | ∀ i < n, closedUniformizerG F hF hne x i = f i } = @@ -169,7 +182,7 @@ theorem closedUniformizerG_cylinder_eq [PolishSpace X] · left have hx' : ∀ i < n, leftmostBranchG F x hcf i = f i := by intro i hi; have := hx i hi - simp only [closedUniformizerG, dif_pos hcf] at this; exact this + simp only [closedUniformizerG, dite_eq_left hcf] at this; exact this constructor · have := (leftmostAuxG F x hcf n).2; rw [fiberRestNG] at this obtain ⟨y, hy_mem, hy_ext⟩ := this @@ -185,8 +198,10 @@ theorem closedUniformizerG_cylinder_eq [PolishSpace X] rwa [leftmostAuxG_eq F x hcf m i h, hx' i (by omega)] · subst h; rwa [Function.update_self] at hye ⊢ · right - exact ⟨fun h => hcf ((closedFiberG_nonempty_iff F x).mpr h), - fun i hi => by have := hx i hi; simp [closedUniformizerG, dif_neg hcf] at this; exact this⟩ + refine ⟨fun h => hcf ((closedFiberG_nonempty_iff F x).mpr h), ?_⟩ + intro i hi + have hvalue := hx i hi + simpa only [closedUniformizerG, dite_eq_right hcf] using hvalue · rintro (⟨hproj, hmin⟩ | ⟨hnotproj, hdef⟩) · intro i hi simp only [closedUniformizerG] @@ -222,7 +237,7 @@ theorem closedUniformizerG_cylinder_eq [PolishSpace X] exfalso; apply hncf obtain ⟨y, hy_mem, _⟩ := hproj; exact ⟨y, hy_mem⟩ · intro i hi - simp only [closedUniformizerG, dif_neg (by + simp only [closedUniformizerG, dite_eq_right (by intro h; exact hnotproj ((closedFiberG_nonempty_iff F x).mp h))] exact hdef i hi @@ -288,7 +303,7 @@ For P analytic in X × Y (Polish spaces), there exists a σ(Σ₁¹)-measurable function φ : X → Y uniformizing P on its projection. -/ theorem jankov_von_neumann {X Y : Type*} [TopologicalSpace X] [TopologicalSpace Y] - [PolishSpace X] [PolishSpace Y] + [PolishSpace X] (P : Set (X × Y)) (hP : AnalyticSet P) (hne : P.Nonempty) : ∃ (φ : X → Y), AnalyticallyMeasurable φ ∧ ∀ x ∈ Prod.fst '' P, (x, φ x) ∈ P := by diff --git a/LeanPool/BicausalOT/BicausalOT/Existence.lean b/LeanPool/BicausalOT/BicausalOT/Existence.lean index d1e6b683f5..cdcfd55d69 100644 --- a/LeanPool/BicausalOT/BicausalOT/Existence.lean +++ b/LeanPool/BicausalOT/BicausalOT/Existence.lean @@ -10,6 +10,12 @@ Authors: KT. Wu import LeanPool.BicausalOT.BicausalOT.Defs import Mathlib.Topology.Semicontinuity.Basic +/-! +# Existence + +Supporting results for bicausal optimal transport and measurable selection. +-/ + open MeasureTheory ProbabilityTheory Set ENNReal noncomputable section @@ -19,6 +25,7 @@ variable [MeasurableSpace X₀] [MeasurableSpace X₁] variable [MeasurableSpace Y₀] [MeasurableSpace Y₁] variable (c₁ : (X₀ × Y₀) × (X₁ × Y₁) → ENNReal) +omit [MeasurableSpace X₀] [MeasurableSpace Y₀] in theorem optimal_kernel_exists_pointwise [TopologicalSpace (Measure (X₁ × Y₁))] (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) diff --git a/LeanPool/BicausalOT/BicausalOT/FeasNonempty.lean b/LeanPool/BicausalOT/BicausalOT/FeasNonempty.lean index 84de7ca497..2fe0f2015e 100644 --- a/LeanPool/BicausalOT/BicausalOT/FeasNonempty.lean +++ b/LeanPool/BicausalOT/BicausalOT/FeasNonempty.lean @@ -22,16 +22,18 @@ import LeanPool.BicausalOT.BicausalOT.MultiPeriod import LeanPool.BicausalOT.BicausalOT.ValueRepresentation import Mathlib.MeasureTheory.Measure.Prod -open MeasureTheory Set ENNReal - -noncomputable section - /-! ### General marginal lemmas for product measures Mathlib's `Measure.map_fst_prod : (μ.prod ν).map Prod.fst = (ν univ) • μ` (and symmetrically `Measure.map_snd_prod`) carry a total-mass scalar; for probability factors the scalar is `1` and disappears. -/ +open MeasureTheory Set ENNReal + +noncomputable section + + + /-- The first marginal of a product measure is the first factor, when the second factor is a probability measure. -/ theorem MeasureTheory.Measure.map_fst_prod_of_isProbabilityMeasure @@ -74,8 +76,8 @@ theorem FeasibleSet₀.nonempty (hκν : ∀ y, IsProbabilityMeasure (κ_ν y)) (z₀ : X₀ × Y₀) : (FeasibleSet₀ κ_μ κ_ν z₀).Nonempty := by - haveI := hκμ z₀.1 - haveI := hκν z₀.2 + have := hκμ z₀.1 + have := hκν z₀.2 exact ⟨(κ_μ z₀.1).prod (κ_ν z₀.2), Measure.map_fst_prod_of_isProbabilityMeasure _ _, Measure.map_snd_prod_of_isProbabilityMeasure _ _⟩ @@ -101,7 +103,7 @@ variable (c₀ : X₀ × Y₀ → ENNReal) (c₁ : (X₀ × Y₀) × (X₁ × Y `h_prob` from the probability marginals (`CouplingSet₀.measure_univ`). -/ theorem bellman_value_eq' (μ₀ : Measure X₀) [IsProbabilityMeasure μ₀] - (ν₀ : Measure Y₀) [IsProbabilityMeasure ν₀] + (ν₀ : Measure Y₀) (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) (hκμ : ∀ x, IsProbabilityMeasure (κ_μ x)) (hκν : ∀ y, IsProbabilityMeasure (κ_ν y)) : @@ -134,8 +136,8 @@ theorem Feas.nonempty (hκν : ∀ t y, IsProbabilityMeasure (κν t y)) (t : ℕ) (h : PairHist X Y t) : (Feas κμ κν t h).Nonempty := by - haveI := hκμ t (projX t h) - haveI := hκν t (projY t h) + have := hκμ t (projX t h) + have := hκν t (projY t h) exact ⟨(κμ t (projX t h)).prod (κν t (projY t h)), Measure.map_fst_prod_of_isProbabilityMeasure _ _, Measure.map_snd_prod_of_isProbabilityMeasure _ _⟩ @@ -149,7 +151,7 @@ variable (c : (t : ℕ) → PairHist X Y t → ℝ≥0∞) fiber follows via `Feas.nonempty`. -/ theorem bellman_value_eq_multi' (T : ℕ) (μ₀ : Measure (X 0)) [IsProbabilityMeasure μ₀] - (ν₀ : Measure (Y 0)) [IsProbabilityMeasure ν₀] + (ν₀ : Measure (Y 0)) (hκμ : ∀ t x, IsProbabilityMeasure (κμ t x)) (hκν : ∀ t y, IsProbabilityMeasure (κν t y)) : ⨅ (γ₀ : Measure (X 0 × Y 0)) (γ : Strat X Y) diff --git a/LeanPool/BicausalOT/BicausalOT/LowerBound.lean b/LeanPool/BicausalOT/BicausalOT/LowerBound.lean index bd687ba2b4..eeee52744f 100644 --- a/LeanPool/BicausalOT/BicausalOT/LowerBound.lean +++ b/LeanPool/BicausalOT/BicausalOT/LowerBound.lean @@ -8,6 +8,12 @@ Authors: KT. Wu -/ import LeanPool.BicausalOT.BicausalOT.Defs +/-! +# LowerBound + +Supporting results for bicausal optimal transport and measurable selection. +-/ + open MeasureTheory ProbabilityTheory Set ENNReal noncomputable section @@ -17,6 +23,7 @@ variable [MeasurableSpace X₀] [MeasurableSpace X₁] variable [MeasurableSpace Y₀] [MeasurableSpace Y₁] variable (c₀ : X₀ × Y₀ → ENNReal) (c₁ : (X₀ × Y₀) × (X₁ × Y₁) → ENNReal) +omit [MeasurableSpace X₀] [MeasurableSpace Y₀] in theorem V₀_le_cost_pointwise (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) (z₀ : X₀ × Y₀) (γ : Measure (X₁ × Y₁)) diff --git a/LeanPool/BicausalOT/BicausalOT/LscBellman.lean b/LeanPool/BicausalOT/BicausalOT/LscBellman.lean index 502a97f681..1b207562b8 100644 --- a/LeanPool/BicausalOT/BicausalOT/LscBellman.lean +++ b/LeanPool/BicausalOT/BicausalOT/LscBellman.lean @@ -30,12 +30,14 @@ import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsUHC import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LscIntegral import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.MeasurableSelection +/-! ## KRN on the Polish space of probability measures -/ + open MeasureTheory Set Filter Topology open scoped ENNReal noncomputable section -/-! ## KRN on the Polish space of probability measures -/ + /-- Kuratowski–Ryll-Nardzewski selection with `WeakP` targets: the Polish wrapper of `exists_measurable_selection` (the metric upgrade keeps the @@ -48,7 +50,7 @@ theorem WeakP.exists_measurable_selection {α : Type*} [MeasurableSpace α] (hmeas : ∀ U : Set (WeakP W), IsOpen U → MeasurableSet {a | (Φ a ∩ U).Nonempty}) : ∃ f : α → WeakP W, Measurable f ∧ ∀ a, f a ∈ Φ a := by - letI := TopologicalSpace.upgradeIsCompletelyMetrizable (WeakP W) + let := TopologicalSpace.upgradeIsCompletelyMetrizable (WeakP W) exact _root_.exists_measurable_selection hne hclosed hmeas namespace MultiPeriod @@ -552,7 +554,7 @@ theorem iInf_couplingSet₀_eq_iInf_weakP ∫⁻ h₀, f h₀ ∂γ.toMeasure := by refine le_antisymm (le_iInf₂ fun γ hγ => iInf₂_le γ.toMeasure hγ) ?_ refine le_iInf₂ fun γm hγm => ?_ - haveI hpm : IsProbabilityMeasure γm := ⟨CouplingSet₀.measure_univ hγm⟩ + have hpm : IsProbabilityMeasure γm := ⟨CouplingSet₀.measure_univ hγm⟩ exact iInf₂_le (show WeakP (X 0 × Y 0) from (⟨γm, hpm⟩ : ProbabilityMeasure (X 0 × Y 0))) hγm diff --git a/LeanPool/BicausalOT/BicausalOT/MeasurableFeasibleStrategy.lean b/LeanPool/BicausalOT/BicausalOT/MeasurableFeasibleStrategy.lean index 3844b4854f..2d79fdb86c 100644 --- a/LeanPool/BicausalOT/BicausalOT/MeasurableFeasibleStrategy.lean +++ b/LeanPool/BicausalOT/BicausalOT/MeasurableFeasibleStrategy.lean @@ -20,6 +20,12 @@ Authors: KT. Wu -/ import LeanPool.BicausalOT.BicausalOT.LscBellman +/-! +# MeasurableFeasibleStrategy + +Supporting results for bicausal optimal transport and measurable selection. +-/ + open MeasureTheory Set Filter Topology open scoped ENNReal diff --git a/LeanPool/BicausalOT/BicausalOT/MeasurableStrategy.lean b/LeanPool/BicausalOT/BicausalOT/MeasurableStrategy.lean index 7c4935f5ff..d3784e9caa 100644 --- a/LeanPool/BicausalOT/BicausalOT/MeasurableStrategy.lean +++ b/LeanPool/BicausalOT/BicausalOT/MeasurableStrategy.lean @@ -22,6 +22,8 @@ Authors: KT. Wu import LeanPool.BicausalOT.BicausalOT.SemianalyticValue import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.EpsOptimalSelection +/-! ## Fibers of the feasibility graph -/ + open MeasureTheory Set ENNReal noncomputable section @@ -38,7 +40,7 @@ variable (κμ : (t : ℕ) → XHist X t → Measure (X (t + 1))) variable (κν : (t : ℕ) → YHist Y t → Measure (Y (t + 1))) variable (c : (t : ℕ) → PairHist X Y t → ℝ≥0∞) -/-! ## Fibers of the feasibility graph -/ + omit [∀ n, TopologicalSpace (X n)] [∀ n, PolishSpace (X n)] [∀ n, BorelSpace (X n)] [∀ n, TopologicalSpace (Y n)] @@ -52,7 +54,7 @@ theorem feasGraph_fiber_nonempty (t : ℕ) (h : PairHist X Y t) : ∃ γ : WeakP (X (t + 1) × Y (t + 1)), (h, γ) ∈ FeasGraph κμ κν t := by obtain ⟨γm, hγm⟩ := hne t h - haveI hpm : IsProbabilityMeasure γm := + have hpm : IsProbabilityMeasure γm := ⟨Feas.measure_univ κμ κν hκμ_prob hγm⟩ exact ⟨show WeakP (X (t + 1) × Y (t + 1)) from (⟨γm, hpm⟩ : ProbabilityMeasure (X (t + 1) × Y (t + 1))), hγm⟩ @@ -133,7 +135,7 @@ theorem exists_eps_strategy_analyticallyMeasurable (T : ℕ) strategy and L4; lower bound inherited from `bellman_value_eq_multi`. -/ theorem bellman_value_eq_multi_measurable (T : ℕ) (μ₀ : Measure (X 0)) [IsProbabilityMeasure μ₀] - (ν₀ : Measure (Y 0)) [IsProbabilityMeasure ν₀] + (ν₀ : Measure (Y 0)) (hκμ_meas : ∀ t, Measurable (κμ t)) (hκν_meas : ∀ t, Measurable (κν t)) (hκμ_prob : ∀ t x, IsProbabilityMeasure (κμ t x)) diff --git a/LeanPool/BicausalOT/BicausalOT/MultiPeriod.lean b/LeanPool/BicausalOT/BicausalOT/MultiPeriod.lean index 070dc499c3..aaad9f1693 100644 --- a/LeanPool/BicausalOT/BicausalOT/MultiPeriod.lean +++ b/LeanPool/BicausalOT/BicausalOT/MultiPeriod.lean @@ -14,6 +14,12 @@ import LeanPool.BicausalOT.BicausalOT.Defs import LeanPool.BicausalOT.BicausalOT.UpperBound import Mathlib.MeasureTheory.Integral.Lebesgue.Add +/-! +# MultiPeriod + +Supporting results for bicausal optimal transport and measurable selection. +-/ + open MeasureTheory Set ENNReal noncomputable section @@ -104,7 +110,7 @@ theorem VGo_le_pointwise {t k : ℕ} {h : PairHist X Y t} {γm : Measure (X (t + 1) × Y (t + 1))} (hγ : γm ∈ Feas κμ κν t h) : VGo c κμ κν (k + 1) t h ≤ c t h + ∫⁻ z, VGo c κμ κν k (t + 1) (h, z) ∂γm := by - show c t h + _ ≤ _ + change c t h + _ ≤ _ gcongr exact iInf₂_le γm hγ @@ -117,7 +123,7 @@ theorem VGo_le_costGo (γ : Strat X Y) | 0, _, _ => le_of_eq rfl | k + 1, t, h => by refine le_trans (VGo_le_pointwise κμ κν c (hfeas t h)) ?_ - show c t h + _ ≤ c t h + _ + change c t h + _ ≤ c t h + _ gcongr with z exact VGo_le_costGo γ hfeas k (t + 1) (h, z) @@ -182,7 +188,7 @@ theorem costGo_le_VGo_add (T : ℕ) rw [hdepth] at hstep exact hstep _ = VGo c κμ κν (k + 1) t h + ((k : ℕ) + 1 : ℝ≥0∞) * ε := by - show c t h + _ = (c t h + _) + _ + change c t h + _ = (c t h + _) + _ ring _ = VGo c κμ κν (k + 1) t h + ((k + 1 : ℕ) : ℝ≥0∞) * ε := by push_cast @@ -194,7 +200,7 @@ theorem costGo_le_VGo_add (T : ℕ) integrated Bellman value. -/ theorem bellman_value_eq_multi (T : ℕ) (μ₀ : Measure (X 0)) [IsProbabilityMeasure μ₀] - (ν₀ : Measure (Y 0)) [IsProbabilityMeasure ν₀] + (ν₀ : Measure (Y 0)) (hκμ : ∀ t x, IsProbabilityMeasure (κμ t x)) (hne : ∀ t (h : PairHist X Y t), (Feas κμ κν t h).Nonempty) : ⨅ (γ₀ : Measure (X 0 × Y 0)) (γ : Strat X Y) diff --git a/LeanPool/BicausalOT/BicausalOT/MultiPeriodTopology.lean b/LeanPool/BicausalOT/BicausalOT/MultiPeriodTopology.lean index e3a7d568e8..f5af9cb714 100644 --- a/LeanPool/BicausalOT/BicausalOT/MultiPeriodTopology.lean +++ b/LeanPool/BicausalOT/BicausalOT/MultiPeriodTopology.lean @@ -21,6 +21,10 @@ import LeanPool.BicausalOT.BicausalOT.MultiPeriod import Mathlib.Topology.MetricSpace.Polish import Mathlib.MeasureTheory.Constructions.BorelSpace.Basic +/-! ### Topological structure + +The product topology on histories, by recursion on the time index. -/ + open MeasureTheory noncomputable section @@ -29,9 +33,7 @@ namespace MultiPeriod variable (X Y : ℕ → Type*) -/-! ### Topological structure -The product topology on histories, by recursion on the time index. -/ section Topology @@ -42,7 +44,7 @@ variable [∀ n, TopologicalSpace (X n)] [∀ n, TopologicalSpace (Y n)] instance instTopologicalSpacePairHist : ∀ t, TopologicalSpace (PairHist X Y t) | 0 => inferInstanceAs (TopologicalSpace (X 0 × Y 0)) | t + 1 => - letI := instTopologicalSpacePairHist t + let := instTopologicalSpacePairHist t inferInstanceAs (TopologicalSpace (PairHist X Y t × (X (t + 1) × Y (t + 1)))) @@ -50,14 +52,14 @@ instance instTopologicalSpacePairHist : ∀ t, TopologicalSpace (PairHist X Y t) instance instTopologicalSpaceXHist : ∀ t, TopologicalSpace (XHist X t) | 0 => inferInstanceAs (TopologicalSpace (X 0)) | t + 1 => - letI := instTopologicalSpaceXHist t + let := instTopologicalSpaceXHist t inferInstanceAs (TopologicalSpace (XHist X t × X (t + 1))) /-- Recursive product topology on Y-side histories. -/ instance instTopologicalSpaceYHist : ∀ t, TopologicalSpace (YHist Y t) | 0 => inferInstanceAs (TopologicalSpace (Y 0)) | t + 1 => - letI := instTopologicalSpaceYHist t + let := instTopologicalSpaceYHist t inferInstanceAs (TopologicalSpace (YHist Y t × Y (t + 1))) variable {X Y} @@ -92,21 +94,21 @@ variable [∀ n, TopologicalSpace (Y n)] [∀ n, PolishSpace (Y n)] instance instPolishSpacePairHist : ∀ t, PolishSpace (PairHist X Y t) | 0 => inferInstanceAs (PolishSpace (X 0 × Y 0)) | t + 1 => - letI := instPolishSpacePairHist t + let := instPolishSpacePairHist t inferInstanceAs (PolishSpace (PairHist X Y t × (X (t + 1) × Y (t + 1)))) /-- X-side histories of Polish coordinates are Polish. -/ instance instPolishSpaceXHist : ∀ t, PolishSpace (XHist X t) | 0 => inferInstanceAs (PolishSpace (X 0)) | t + 1 => - letI := instPolishSpaceXHist t + let := instPolishSpaceXHist t inferInstanceAs (PolishSpace (XHist X t × X (t + 1))) /-- Y-side histories of Polish coordinates are Polish. -/ instance instPolishSpaceYHist : ∀ t, PolishSpace (YHist Y t) | 0 => inferInstanceAs (PolishSpace (Y 0)) | t + 1 => - letI := instPolishSpaceYHist t + let := instPolishSpaceYHist t inferInstanceAs (PolishSpace (YHist Y t × Y (t + 1))) end Polish @@ -125,7 +127,7 @@ variable [∀ n, MeasurableSpace (X n)] [∀ n, MeasurableSpace (Y n)] instance instMeasurableSpacePairHist : ∀ t, MeasurableSpace (PairHist X Y t) | 0 => inferInstanceAs (MeasurableSpace (X 0 × Y 0)) | t + 1 => - letI := instMeasurableSpacePairHist t + let := instMeasurableSpacePairHist t inferInstanceAs (MeasurableSpace (PairHist X Y t × (X (t + 1) × Y (t + 1)))) @@ -133,14 +135,14 @@ instance instMeasurableSpacePairHist : ∀ t, MeasurableSpace (PairHist X Y t) instance instMeasurableSpaceXHist : ∀ t, MeasurableSpace (XHist X t) | 0 => inferInstanceAs (MeasurableSpace (X 0)) | t + 1 => - letI := instMeasurableSpaceXHist t + let := instMeasurableSpaceXHist t inferInstanceAs (MeasurableSpace (XHist X t × X (t + 1))) /-- Recursive product σ-algebra on Y-side histories. -/ instance instMeasurableSpaceYHist : ∀ t, MeasurableSpace (YHist Y t) | 0 => inferInstanceAs (MeasurableSpace (Y 0)) | t + 1 => - letI := instMeasurableSpaceYHist t + let := instMeasurableSpaceYHist t inferInstanceAs (MeasurableSpace (YHist Y t × Y (t + 1))) variable {X Y} @@ -181,21 +183,21 @@ variable [∀ n, MeasurableSpace (Y n)] [∀ n, BorelSpace (Y n)] instance instBorelSpacePairHist : ∀ t, BorelSpace (PairHist X Y t) | 0 => inferInstanceAs (BorelSpace (X 0 × Y 0)) | t + 1 => - letI := instBorelSpacePairHist t + let := instBorelSpacePairHist t inferInstanceAs (BorelSpace (PairHist X Y t × (X (t + 1) × Y (t + 1)))) /-- X-side histories of Polish Borel coordinates are Borel. -/ instance instBorelSpaceXHist : ∀ t, BorelSpace (XHist X t) | 0 => inferInstanceAs (BorelSpace (X 0)) | t + 1 => - letI := instBorelSpaceXHist t + let := instBorelSpaceXHist t inferInstanceAs (BorelSpace (XHist X t × X (t + 1))) /-- Y-side histories of Polish Borel coordinates are Borel. -/ instance instBorelSpaceYHist : ∀ t, BorelSpace (YHist Y t) | 0 => inferInstanceAs (BorelSpace (Y 0)) | t + 1 => - letI := instBorelSpaceYHist t + let := instBorelSpaceYHist t inferInstanceAs (BorelSpace (YHist Y t × Y (t + 1))) end Borel diff --git a/LeanPool/BicausalOT/BicausalOT/Proposition1.lean b/LeanPool/BicausalOT/BicausalOT/Proposition1.lean index 4b679285ea..36d44314f6 100644 --- a/LeanPool/BicausalOT/BicausalOT/Proposition1.lean +++ b/LeanPool/BicausalOT/BicausalOT/Proposition1.lean @@ -4,10 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: KT. Wu -/ /- - Proposition 1: Bicausal ⟺ Kernel Decomposition ✓ FULLY VERIFIED + Proposition 1: Bicausal ↔ Kernel Decomposition ✓ FULLY VERIFIED -/ import LeanPool.BicausalOT.BicausalOT.Defs +/-! +# Proposition1 + +Supporting results for bicausal optimal transport and measurable selection. +-/ + open MeasureTheory ProbabilityTheory Set ENNReal noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/SemianalyticValue.lean b/LeanPool/BicausalOT/BicausalOT/SemianalyticValue.lean index e7d2dae986..f1882a71f0 100644 --- a/LeanPool/BicausalOT/BicausalOT/SemianalyticValue.lean +++ b/LeanPool/BicausalOT/BicausalOT/SemianalyticValue.lean @@ -24,16 +24,18 @@ import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LsaAlgebra import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish -open MeasureTheory Set ENNReal - -noncomputable section - /-! ## The Polish space of probability measures with its Borel σ-algebra `ProbabilityMeasure W` carries Mathlib's Giry-subtype σ-algebra, which is not the Borel σ-algebra of the weak topology; the type synonym `WeakP` installs the Borel structure (Polish by W1). -/ +open MeasureTheory Set ENNReal + +noncomputable section + + + /-- Probability measures on `W`, considered with the topology of weak convergence and its Borel σ-algebra. -/ def WeakP (W : Type*) [MeasurableSpace W] : Type _ := ProbabilityMeasure W @@ -64,7 +66,7 @@ instance (γ : WeakP W) : IsProbabilityMeasure γ.toMeasure := Borel σ-algebra of the weak topology to the Giry σ-algebra. -/ theorem measurable_toMeasure [PolishSpace W] [BorelSpace W] : Measurable (toMeasure : WeakP W → Measure W) := by - letI := TopologicalSpace.upgradeIsCompletelyMetrizable W + let := TopologicalSpace.upgradeIsCompletelyMetrizable W exact probabilityMeasure_borel_measurable_toMeasure (Ω := W) end WeakP @@ -102,7 +104,7 @@ theorem measurableSet_feasGraph (WeakP.measurable_toMeasure.comp measurable_snd) · exact (hκμ_meas t).comp ((measurable_projX t).comp measurable_fst) · intro p - exact Measure.isProbabilityMeasure_map measurable_fst.aemeasurable + infer_instance · intro p exact hκμ_prob t _ have h2 : MeasurableSet {p : PairHist X Y t × WeakP (X (t + 1) × Y (t + 1)) | @@ -112,7 +114,7 @@ theorem measurableSet_feasGraph (WeakP.measurable_toMeasure.comp measurable_snd) · exact (hκν_meas t).comp ((measurable_projY t).comp measurable_fst) · intro p - exact Measure.isProbabilityMeasure_map measurable_snd.aemeasurable + infer_instance · intro p exact hκν_prob t _ exact h1.inter h2 @@ -156,7 +158,7 @@ theorem iInf_feas_eq_iInf_feasGraph apply le_antisymm · exact le_iInf₂ fun γ hγ => iInf₂_le γ.toMeasure hγ · refine le_iInf₂ fun γm hγm => ?_ - haveI hpm : IsProbabilityMeasure γm := + have hpm : IsProbabilityMeasure γm := ⟨Feas.measure_univ κμ κν hκμ_prob hγm⟩ exact iInf₂_le (show WeakP (X (t + 1) × Y (t + 1)) from @@ -175,7 +177,7 @@ theorem VGo_succ_eq_weakP = c t h + ⨅ (γ : WeakP (X (t + 1) × Y (t + 1))) (_ : (h, γ) ∈ FeasGraph κμ κν t), ∫⁻ z, VGo c κμ κν k (t + 1) (h, z) ∂γ.toMeasure := by - show c t h + _ = c t h + _ + change c t h + _ = c t h + _ congr 1 exact iInf_feas_eq_iInf_feasGraph κμ κν hκμ_prob t h _ diff --git a/LeanPool/BicausalOT/BicausalOT/UpperBound.lean b/LeanPool/BicausalOT/BicausalOT/UpperBound.lean index 85c2da46e2..b75275cf02 100644 --- a/LeanPool/BicausalOT/BicausalOT/UpperBound.lean +++ b/LeanPool/BicausalOT/BicausalOT/UpperBound.lean @@ -9,6 +9,12 @@ Authors: KT. Wu import LeanPool.BicausalOT.BicausalOT.Defs import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.JankovVonNeumann +/-! +# UpperBound + +Supporting results for bicausal optimal transport and measurable selection. +-/ + open MeasureTheory ProbabilityTheory Set ENNReal noncomputable section @@ -32,6 +38,7 @@ theorem eps_optimal_element · simp [htop] at hlt · exact absurd this (not_le.mpr (ENNReal.lt_add_right htop hε.ne')) +omit [MeasurableSpace X₀] [MeasurableSpace Y₀] in theorem eps_optimal_kernel_bound (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) (h_ne : ∀ z₀ : X₀ × Y₀, (FeasibleSet₀ κ_μ κ_ν z₀).Nonempty) @@ -57,7 +64,7 @@ theorem totalCost_le_V₀_plus_eps totalCost c₀ c₁ γ₀ γ₁ ≤ ∫⁻ z₀, (V₀ c₀ c₁ κ_μ κ_ν z₀ + ε) ∂γ₀ := by unfold totalCost; apply lintegral_mono; intro z₀ - show c₀ z₀ + ∫⁻ z₁, c₁ (z₀, z₁) ∂(γ₁ z₀) ≤ V₀ c₀ c₁ κ_μ κ_ν z₀ + ε + change c₀ z₀ + ∫⁻ z₁, c₁ (z₀, z₁) ∂(γ₁ z₀) ≤ V₀ c₀ c₁ κ_μ κ_ν z₀ + ε have h := h_opt z₀ have hV : V₀ c₀ c₁ κ_μ κ_ν z₀ = c₀ z₀ + ⨅ (m : Measure (X₁ × Y₁)) (_ : m ∈ FeasibleSet₀ κ_μ κ_ν z₀), diff --git a/LeanPool/BicausalOT/BicausalOT/ValueRepresentation.lean b/LeanPool/BicausalOT/BicausalOT/ValueRepresentation.lean index ce7a8a4fb9..296a15a39d 100644 --- a/LeanPool/BicausalOT/BicausalOT/ValueRepresentation.lean +++ b/LeanPool/BicausalOT/BicausalOT/ValueRepresentation.lean @@ -12,6 +12,12 @@ import LeanPool.BicausalOT.BicausalOT.LowerBound import LeanPool.BicausalOT.BicausalOT.UpperBound import Mathlib.MeasureTheory.Integral.Lebesgue.Add +/-! +# ValueRepresentation + +Supporting results for bicausal optimal transport and measurable selection. +-/ + open MeasureTheory ProbabilityTheory Set ENNReal noncomputable section @@ -64,8 +70,8 @@ theorem bellman_value_leq_aux totalCost_le_V₀_plus_eps c₀ c₁ κ_μ κ_ν γ₀ γ₁_sel ε hγ₁_opt theorem bellman_value_leq - (μ₀ : Measure X₀) [IsProbabilityMeasure μ₀] - (ν₀ : Measure Y₀) [IsProbabilityMeasure ν₀] + (μ₀ : Measure X₀) + (ν₀ : Measure Y₀) (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) (h_Gamma_ne : ∀ z₀, (FeasibleSet₀ κ_μ κ_ν z₀).Nonempty) (h_prob : ∀ γ₀ ∈ CouplingSet₀ μ₀ ν₀, γ₀ Set.univ ≤ 1) : @@ -99,8 +105,7 @@ theorem bellman_value_leq /-- **Main Theorem**: Bellman value representation (equality). -/ theorem bellman_value_eq - (μ₀ : Measure X₀) [IsProbabilityMeasure μ₀] - (ν₀ : Measure Y₀) [IsProbabilityMeasure ν₀] + (μ₀ : Measure X₀) (ν₀ : Measure Y₀) (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁) (h_Gamma_ne : ∀ z₀, (FeasibleSet₀ κ_μ κ_ν z₀).Nonempty) (h_prob : ∀ γ₀ ∈ CouplingSet₀ μ₀ ν₀, γ₀ Set.univ ≤ 1) : diff --git a/LeanPool/BicausalOT/SolutionCapacitability.lean b/LeanPool/BicausalOT/SolutionCapacitability.lean index f39a852e81..98d735d55a 100644 --- a/LeanPool/BicausalOT/SolutionCapacitability.lean +++ b/LeanPool/BicausalOT/SolutionCapacitability.lean @@ -3,7 +3,8 @@ Copyright (c) 2026 KT. Wu. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: KT. Wu -/ -import Mathlib +import Mathlib.Order.CompletePartialOrder +import Mathlib.Tactic import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability /-! diff --git a/LeanPool/BicausalOT/SolutionJvN.lean b/LeanPool/BicausalOT/SolutionJvN.lean index c122752ea4..a31c570014 100644 --- a/LeanPool/BicausalOT/SolutionJvN.lean +++ b/LeanPool/BicausalOT/SolutionJvN.lean @@ -3,7 +3,7 @@ Copyright (c) 2026 KT. Wu. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: KT. Wu -/ -import Mathlib +import Mathlib.Tactic import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree /-! @@ -95,7 +95,7 @@ Both σ-algebras in the measurability clause are written out explicitly, so the mentions only Mathlib notions: `MeasurableSpace.generateFrom {s | MeasureTheory.AnalyticSet s}` is the analytic σ-algebra `σ(Σ¹₁)` of `X`, and `borel Y` is the Borel σ-algebra of `Y`. -/ theorem jankov_von_neumann {X Y : Type*} [TopologicalSpace X] [TopologicalSpace Y] - [PolishSpace X] [PolishSpace Y] (P : Set (X × Y)) + [PolishSpace X] (P : Set (X × Y)) (hP : MeasureTheory.AnalyticSet P) (hne : P.Nonempty) : ∃ φ : X → Y, @Measurable X Y diff --git a/LeanPool/BicausalOT/SolutionPolish.lean b/LeanPool/BicausalOT/SolutionPolish.lean index c0da34047a..85b8c511da 100644 --- a/LeanPool/BicausalOT/SolutionPolish.lean +++ b/LeanPool/BicausalOT/SolutionPolish.lean @@ -3,7 +3,7 @@ Copyright (c) 2026 KT. Wu. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: KT. Wu -/ -import Mathlib +import Mathlib.Tactic import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish /-! From 14aa8ed095846f73989587b9643c80fb25b87f8a Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 20:09:52 +0000 Subject: [PATCH 3/6] Extract partition weight bound from probability approximation proof --- .../ProbabilityMeasurePolish.lean | 63 +++++++++++-------- 1 file changed, 36 insertions(+), 27 deletions(-) diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ProbabilityMeasurePolish.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ProbabilityMeasurePolish.lean index feeb621aba..8f522b77b5 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ProbabilityMeasurePolish.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ProbabilityMeasurePolish.lean @@ -391,6 +391,40 @@ theorem exists_measure_compl_partial_iUnion_lt rwa [hinter, measure_empty] at h exact (htendsto.eventually_lt_const hε).exists +omit [CompleteSpace Ω] in +omit [MetricSpace Ω] [SeparableSpace Ω] [BorelSpace Ω] [CompleteSpace Ω] in +open scoped Classical in +private theorem sum_floor_partition_mass_le (μ : ProbabilityMeasure Ω) + {A : ℕ → Set Ω} (hAmble : ∀ n, MeasurableSet (A n)) + (hAdisj : Pairwise (fun i j => Disjoint (A i) (A j))) (N m : ℕ) : + (∑ i : Fin N, ⌊((μ : Measure Ω) (A i)).toReal * m⌋₊) ≤ m := by + have hpart : (∑ n ∈ Finset.range N, (μ : Measure Ω) (A n)) ≤ 1 := by + rw [← measure_biUnion_finset + (fun i _ k _ hik => hAdisj hik) (fun n _ => hAmble n)] + exact prob_le_one + have hreal : (∑ n ∈ Finset.range N, ((μ : Measure Ω) (A n)).toReal) ≤ 1 := by + rw [← ENNReal.toReal_sum (fun n _ => measure_ne_top _ _)] + calc (∑ n ∈ Finset.range N, (μ : Measure Ω) (A n)).toReal + ≤ (1 : ℝ≥0∞).toReal := ENNReal.toReal_mono ENNReal.one_ne_top hpart + _ = 1 := ENNReal.toReal_one + have hcast : ((∑ i : Fin N, ⌊((μ : Measure Ω) (A i)).toReal * m⌋₊ : ℕ) : ℝ) ≤ m := by + push_cast + calc (∑ i : Fin N, (⌊((μ : Measure Ω) (A i)).toReal * m⌋₊ : ℝ)) + ≤ ∑ i : Fin N, ((μ : Measure Ω) (A i)).toReal * m := + Finset.sum_le_sum fun i _ => Nat.floor_le (by positivity) + _ = (∑ i : Fin N, ((μ : Measure Ω) (A i)).toReal) * m := by + rw [← Finset.sum_mul] + _ ≤ 1 * m := by + have hsum_range : + (∑ i : Fin N, ((μ : Measure Ω) (A i)).toReal) + = ∑ n ∈ Finset.range N, ((μ : Measure Ω) (A n)).toReal := + Fin.sum_univ_eq_sum_range + (fun n => ((μ : Measure Ω) (A n)).toReal) N + rw [hsum_range] + nlinarith [hreal] + _ = m := one_mul _ + exact_mod_cast hcast + omit [CompleteSpace Ω] in open scoped Classical in /-- B1+B2: every probability measure on a Polish space is within `3ε` in @@ -428,33 +462,8 @@ theorem exists_diracMix_levyProkhorovDist_le refine ⟨N, a, fun i => j i, ?_⟩ set ν : Measure Ω := diracMix (D 0) (fun i : Fin N => D (j i)) a with hν -- total weight is at most m - have hsum_le : (∑ i, a i) ≤ m := by - have hpart : (∑ n ∈ Finset.range N, (μ : Measure Ω) (A n)) ≤ 1 := by - rw [← measure_biUnion_finset - (fun i _ k _ hik => hAdisj hik) (fun n _ => hAmble n)] - exact prob_le_one - have hreal : (∑ n ∈ Finset.range N, ((μ : Measure Ω) (A n)).toReal) ≤ 1 := by - rw [← ENNReal.toReal_sum (fun n _ => measure_ne_top _ _)] - calc (∑ n ∈ Finset.range N, (μ : Measure Ω) (A n)).toReal - ≤ (1 : ℝ≥0∞).toReal := ENNReal.toReal_mono ENNReal.one_ne_top hpart - _ = 1 := ENNReal.toReal_one - have hcast : ((∑ i, a i : ℕ) : ℝ) ≤ m := by - push_cast - calc (∑ i : Fin N, (⌊((μ : Measure Ω) (A i)).toReal * m⌋₊ : ℝ)) - ≤ ∑ i : Fin N, ((μ : Measure Ω) (A i)).toReal * m := - Finset.sum_le_sum fun i _ => Nat.floor_le (by positivity) - _ = (∑ i : Fin N, ((μ : Measure Ω) (A i)).toReal) * m := by - rw [← Finset.sum_mul] - _ ≤ 1 * m := by - have hsum_range : - (∑ i : Fin N, ((μ : Measure Ω) (A i)).toReal) - = ∑ n ∈ Finset.range N, ((μ : Measure Ω) (A n)).toReal := - Fin.sum_univ_eq_sum_range - (fun n => ((μ : Measure Ω) (A n)).toReal) N - rw [hsum_range] - nlinarith [hreal] - _ = m := one_mul _ - exact_mod_cast hcast + have hsum_le : (∑ i, a i) ≤ m := + sum_floor_partition_mass_le μ hAmble hAdisj N m -- per-cell mass bound by weights have hterm : ∀ i : Fin N, (μ : Measure Ω) (A i) ≤ ((a i : ℝ≥0∞) + 1) * (m : ℝ≥0∞)⁻¹ := by From 2437f51377f8de7b19663ef2a02d0f39912e5591 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 08:40:24 +0000 Subject: [PATCH 4/6] Migrate bicausal transport to public modules --- LeanPool/BicausalOT.lean | 77 ++++++++++--------- LeanPool/BicausalOT/BicausalOT.lean | 7 +- LeanPool/BicausalOT/BicausalOT/Basic.lean | 59 +++++++------- .../BicausalOT/BicausalOT/BicausalOT.lean | 17 ++-- LeanPool/BicausalOT/BicausalOT/Defs.lean | 19 +++-- .../BicausalOT/DescriptiveSetTheory.lean | 35 +++++---- .../DescriptiveSetTheory/AnalyticSet.lean | 7 +- .../AnalyticSigmaAlgebra.lean | 7 +- .../DescriptiveSetTheory/Capacitability.lean | 17 ++-- .../CouplingsCompact.lean | 11 ++- .../DescriptiveSetTheory/CouplingsUHC.lean | 9 ++- .../EpsOptimalSelection.lean | 11 ++- .../JankovVonNeumann.lean | 19 +++-- .../DescriptiveSetTheory/KernelIntegral.lean | 17 ++-- .../DescriptiveSetTheory/LintegralLsc.lean | 13 +++- .../LowerSemianalytic.lean | 19 +++-- .../DescriptiveSetTheory/LsaAlgebra.lean | 7 +- .../DescriptiveSetTheory/LscIntegral.lean | 8 +- .../MeasurableSelection.lean | 15 ++-- .../ProbabilityMeasurePolish.lean | 21 +++-- .../BicausalOT/DescriptiveSetTheory/Tree.lean | 13 +++- LeanPool/BicausalOT/BicausalOT/Existence.lean | 9 ++- .../BicausalOT/BicausalOT/FeasNonempty.lean | 11 ++- .../BicausalOT/BicausalOT/LowerBound.lean | 7 +- .../BicausalOT/BicausalOT/LscBellman.lean | 13 +++- .../MeasurableFeasibleStrategy.lean | 7 +- .../BicausalOT/MeasurableStrategy.lean | 9 ++- .../BicausalOT/BicausalOT/MultiPeriod.lean | 11 ++- .../BicausalOT/MultiPeriodTopology.lean | 11 ++- .../BicausalOT/BicausalOT/Proposition1.lean | 7 +- .../BicausalOT/SemianalyticValue.lean | 15 ++-- .../BicausalOT/BicausalOT/UpperBound.lean | 9 ++- .../BicausalOT/ValueRepresentation.lean | 13 +++- LeanPool/BicausalOT/Solution.lean | 7 +- .../BicausalOT/SolutionCapacitability.lean | 11 ++- LeanPool/BicausalOT/SolutionJvN.lean | 9 ++- LeanPool/BicausalOT/SolutionPolish.lean | 9 ++- 37 files changed, 376 insertions(+), 190 deletions(-) diff --git a/LeanPool/BicausalOT.lean b/LeanPool/BicausalOT.lean index 73aaf4a444..0fe51b908a 100644 --- a/LeanPool/BicausalOT.lean +++ b/LeanPool/BicausalOT.lean @@ -4,42 +4,45 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: KT. Wu -/ -import LeanPool.BicausalOT.BicausalOT -import LeanPool.BicausalOT.BicausalOT.Basic -import LeanPool.BicausalOT.BicausalOT.BicausalOT -import LeanPool.BicausalOT.BicausalOT.Defs -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSigmaAlgebra -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsCompact -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsUHC -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.EpsOptimalSelection -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.JankovVonNeumann -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LintegralLsc -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LowerSemianalytic -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LsaAlgebra -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LscIntegral -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.MeasurableSelection -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree -import LeanPool.BicausalOT.BicausalOT.Existence -import LeanPool.BicausalOT.BicausalOT.FeasNonempty -import LeanPool.BicausalOT.BicausalOT.LowerBound -import LeanPool.BicausalOT.BicausalOT.LscBellman -import LeanPool.BicausalOT.BicausalOT.MeasurableFeasibleStrategy -import LeanPool.BicausalOT.BicausalOT.MeasurableStrategy -import LeanPool.BicausalOT.BicausalOT.MultiPeriod -import LeanPool.BicausalOT.BicausalOT.MultiPeriodTopology -import LeanPool.BicausalOT.BicausalOT.Proposition1 -import LeanPool.BicausalOT.BicausalOT.SemianalyticValue -import LeanPool.BicausalOT.BicausalOT.UpperBound -import LeanPool.BicausalOT.BicausalOT.ValueRepresentation -import LeanPool.BicausalOT.Solution -import LeanPool.BicausalOT.SolutionCapacitability -import LeanPool.BicausalOT.SolutionJvN -import LeanPool.BicausalOT.SolutionPolish +module + +public import LeanPool.BicausalOT.BicausalOT +public import LeanPool.BicausalOT.BicausalOT.Basic +public import LeanPool.BicausalOT.BicausalOT.BicausalOT +public import LeanPool.BicausalOT.BicausalOT.Defs +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSigmaAlgebra +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsCompact +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsUHC +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.EpsOptimalSelection +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.JankovVonNeumann +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LintegralLsc +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LowerSemianalytic +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LsaAlgebra +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LscIntegral +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.MeasurableSelection +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree +public import LeanPool.BicausalOT.BicausalOT.Existence +public import LeanPool.BicausalOT.BicausalOT.FeasNonempty +public import LeanPool.BicausalOT.BicausalOT.LowerBound +public import LeanPool.BicausalOT.BicausalOT.LscBellman +public import LeanPool.BicausalOT.BicausalOT.MeasurableFeasibleStrategy +public import LeanPool.BicausalOT.BicausalOT.MeasurableStrategy +public import LeanPool.BicausalOT.BicausalOT.MultiPeriod +public import LeanPool.BicausalOT.BicausalOT.MultiPeriodTopology +public import LeanPool.BicausalOT.BicausalOT.Proposition1 +public import LeanPool.BicausalOT.BicausalOT.SemianalyticValue +public import LeanPool.BicausalOT.BicausalOT.UpperBound +public import LeanPool.BicausalOT.BicausalOT.ValueRepresentation +public import LeanPool.BicausalOT.Solution +public import LeanPool.BicausalOT.SolutionCapacitability +public import LeanPool.BicausalOT.SolutionJvN +public import LeanPool.BicausalOT.SolutionPolish + /-! # BicausalOT @@ -51,3 +54,5 @@ Main declarations: `MeasurableSelection.exists_measurable_selection` Tags: probability MSC: 28B20, 54C65, 54H05, 03E15, 28A20, 68V20 -/ + +@[expose] public section diff --git a/LeanPool/BicausalOT/BicausalOT.lean b/LeanPool/BicausalOT/BicausalOT.lean index c58e55b015..553b543925 100644 --- a/LeanPool/BicausalOT/BicausalOT.lean +++ b/LeanPool/BicausalOT/BicausalOT.lean @@ -5,10 +5,15 @@ Authors: KT. Wu -/ -- This module serves as the root of the `BicausalOT` library. -- Import modules here that should be built as part of the library. -import LeanPool.BicausalOT.BicausalOT.Basic +module + +public import LeanPool.BicausalOT.BicausalOT.Basic + /-! # BicausalOT Supporting results for bicausal optimal transport and measurable selection. -/ + +@[expose] public section diff --git a/LeanPool/BicausalOT/BicausalOT/Basic.lean b/LeanPool/BicausalOT/BicausalOT/Basic.lean index 9316b34bc4..29990f5992 100644 --- a/LeanPool/BicausalOT/BicausalOT/Basic.lean +++ b/LeanPool/BicausalOT/BicausalOT/Basic.lean @@ -4,36 +4,41 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: KT. Wu -/ -- Re-export all modules -import LeanPool.BicausalOT.BicausalOT.Defs -import LeanPool.BicausalOT.BicausalOT.Proposition1 -import LeanPool.BicausalOT.BicausalOT.LowerBound -import LeanPool.BicausalOT.BicausalOT.UpperBound -import LeanPool.BicausalOT.BicausalOT.ValueRepresentation -import LeanPool.BicausalOT.BicausalOT.Existence -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LowerSemianalytic -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.JankovVonNeumann -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LsaAlgebra -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsCompact -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LintegralLsc -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.MeasurableSelection -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.EpsOptimalSelection -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsUHC -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LscIntegral -import LeanPool.BicausalOT.BicausalOT.MultiPeriod -import LeanPool.BicausalOT.BicausalOT.MultiPeriodTopology -import LeanPool.BicausalOT.BicausalOT.FeasNonempty -import LeanPool.BicausalOT.BicausalOT.SemianalyticValue -import LeanPool.BicausalOT.BicausalOT.MeasurableStrategy -import LeanPool.BicausalOT.BicausalOT.LscBellman -import LeanPool.BicausalOT.BicausalOT.MeasurableFeasibleStrategy +module + +public import LeanPool.BicausalOT.BicausalOT.Defs +public import LeanPool.BicausalOT.BicausalOT.Proposition1 +public import LeanPool.BicausalOT.BicausalOT.LowerBound +public import LeanPool.BicausalOT.BicausalOT.UpperBound +public import LeanPool.BicausalOT.BicausalOT.ValueRepresentation +public import LeanPool.BicausalOT.BicausalOT.Existence +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LowerSemianalytic +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.JankovVonNeumann +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LsaAlgebra +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsCompact +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LintegralLsc +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.MeasurableSelection +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.EpsOptimalSelection +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsUHC +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LscIntegral +public import LeanPool.BicausalOT.BicausalOT.MultiPeriod +public import LeanPool.BicausalOT.BicausalOT.MultiPeriodTopology +public import LeanPool.BicausalOT.BicausalOT.FeasNonempty +public import LeanPool.BicausalOT.BicausalOT.SemianalyticValue +public import LeanPool.BicausalOT.BicausalOT.MeasurableStrategy +public import LeanPool.BicausalOT.BicausalOT.LscBellman +public import LeanPool.BicausalOT.BicausalOT.MeasurableFeasibleStrategy + /-! # Basic Supporting results for bicausal optimal transport and measurable selection. -/ + +@[expose] public section diff --git a/LeanPool/BicausalOT/BicausalOT/BicausalOT.lean b/LeanPool/BicausalOT/BicausalOT/BicausalOT.lean index 30c16bbdbb..9dc8c20078 100644 --- a/LeanPool/BicausalOT/BicausalOT/BicausalOT.lean +++ b/LeanPool/BicausalOT/BicausalOT/BicausalOT.lean @@ -29,15 +29,20 @@ Authors: KT. Wu (machine-checked: every audited theorem depends only on [propext, Classical.choice, Quot.sound]) -/ -import LeanPool.BicausalOT.BicausalOT.Defs -import LeanPool.BicausalOT.BicausalOT.Proposition1 -import LeanPool.BicausalOT.BicausalOT.LowerBound -import LeanPool.BicausalOT.BicausalOT.UpperBound -import LeanPool.BicausalOT.BicausalOT.ValueRepresentation -import LeanPool.BicausalOT.BicausalOT.Existence +module + +public import LeanPool.BicausalOT.BicausalOT.Defs +public import LeanPool.BicausalOT.BicausalOT.Proposition1 +public import LeanPool.BicausalOT.BicausalOT.LowerBound +public import LeanPool.BicausalOT.BicausalOT.UpperBound +public import LeanPool.BicausalOT.BicausalOT.ValueRepresentation +public import LeanPool.BicausalOT.BicausalOT.Existence + /-! # BicausalOT Supporting results for bicausal optimal transport and measurable selection. -/ + +@[expose] public section diff --git a/LeanPool/BicausalOT/BicausalOT/Defs.lean b/LeanPool/BicausalOT/BicausalOT/Defs.lean index ddddf40a5d..9adcb21479 100644 --- a/LeanPool/BicausalOT/BicausalOT/Defs.lean +++ b/LeanPool/BicausalOT/BicausalOT/Defs.lean @@ -7,13 +7,16 @@ Authors: KT. Wu Bicausal OT — Definitions Couplings, feasible sets, kernel decomposition, bicausality, Bellman value. -/ -import Mathlib.Algebra.Order.Module.Field -import Mathlib.Data.EReal.Inv -import Mathlib.Tactic.Measurability -import Mathlib.Topology.Algebra.InfiniteSum.Order -import Mathlib.Topology.MetricSpace.Bounded -import Mathlib.MeasureTheory.Measure.Prod -import Mathlib.Probability.Kernel.Basic +module + +public import Mathlib.Algebra.Order.Module.Field +public import Mathlib.Data.EReal.Inv +public import Mathlib.Tactic.Measurability +public import Mathlib.Topology.Algebra.InfiniteSum.Order +public import Mathlib.Topology.MetricSpace.Bounded +public import Mathlib.MeasureTheory.Measure.Prod +public import Mathlib.Probability.Kernel.Basic + /-! # Defs @@ -21,6 +24,8 @@ import Mathlib.Probability.Kernel.Basic Supporting results for bicausal optimal transport and measurable selection. -/ +@[expose] public section + open MeasureTheory ProbabilityTheory Set ENNReal noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory.lean index f274d8b2fa..a4d8fff083 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory.lean @@ -4,24 +4,29 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: KT. Wu -/ -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSigmaAlgebra -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsCompact -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsUHC -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.EpsOptimalSelection -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.JankovVonNeumann -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LintegralLsc -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LowerSemianalytic -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LsaAlgebra -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LscIntegral -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.MeasurableSelection -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree +module + +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSigmaAlgebra +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsCompact +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsUHC +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.EpsOptimalSelection +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.JankovVonNeumann +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LintegralLsc +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LowerSemianalytic +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LsaAlgebra +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LscIntegral +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.MeasurableSelection +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree + /-! # DescriptiveSetTheory Supporting modules for BicausalOT. -/ + +@[expose] public section diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSet.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSet.lean index 8060c788a7..b7508f420e 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSet.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSet.lean @@ -19,7 +19,10 @@ Authors: KT. Wu NO sorry needed — everything is already in Mathlib. -/ -import Mathlib.MeasureTheory.Constructions.Polish.Basic +module + +public import Mathlib.MeasureTheory.Constructions.Polish.Basic + /-! # AnalyticSet @@ -27,5 +30,7 @@ import Mathlib.MeasureTheory.Constructions.Polish.Basic Supporting results for bicausal optimal transport and measurable selection. -/ +@[expose] public section + -- Re-export for downstream modules open MeasureTheory diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSigmaAlgebra.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSigmaAlgebra.lean index 13ebdc0a1f..771884bda3 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSigmaAlgebra.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/AnalyticSigmaAlgebra.lean @@ -10,7 +10,10 @@ Authors: KT. Wu - Kechris, Classical Descriptive Set Theory, §18 - Bertsekas–Shreve, Definition 7.19–7.20 -/ -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet +module + +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet + /-! # AnalyticSigmaAlgebra @@ -18,6 +21,8 @@ import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet Supporting results for bicausal optimal transport and measurable selection. -/ +@[expose] public section + open MeasureTheory Set noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Capacitability.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Capacitability.lean index 7164f1b299..a4c9f00bc0 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Capacitability.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Capacitability.lean @@ -22,15 +22,20 @@ Authors: KT. Wu is a recursion along increasing unions (continuity from below of outer measures), mirroring the `leftmostAuxG` pattern of Tree.lean. -/ -import Mathlib.Topology.MetricSpace.Polish -import Mathlib.Topology.MetricSpace.PiNat -import Mathlib.MeasureTheory.Constructions.Polish.Basic -import Mathlib.Probability.Kernel.MeasurableLIntegral -import Mathlib.Tactic.Finiteness -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet +module + +public import Mathlib.Topology.MetricSpace.Polish +public import Mathlib.Topology.MetricSpace.PiNat +public import Mathlib.MeasureTheory.Constructions.Polish.Basic +public import Mathlib.Probability.Kernel.MeasurableLIntegral +public import Mathlib.Tactic.Finiteness +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet + /-! ## Part I: Bounded branch sets in Baire space -/ +@[expose] public section + open Set Topology MeasureTheory Filter open scoped ENNReal diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsCompact.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsCompact.lean index 9f431088b6..1396d5b374 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsCompact.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsCompact.lean @@ -38,13 +38,18 @@ Authors: KT. Wu front F2's draft_FeasClosed.lean (scratch files cannot import each other); keep a single copy when integrating both fronts. -/ -import Mathlib.MeasureTheory.Measure.FiniteMeasureProd -import Mathlib.MeasureTheory.Measure.Prokhorov -import Mathlib.Tactic +module + +public import Mathlib.MeasureTheory.Measure.FiniteMeasureProd +public import Mathlib.MeasureTheory.Measure.Prokhorov +public import Mathlib.Tactic + /-! ## Translation between `ProbabilityMeasure.map` and `Measure.map` constraints (verbatim copy of front F2's lemma — dedupe at integration) -/ +@[expose] public section + open MeasureTheory Topology noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsUHC.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsUHC.lean index 8a17f30efe..e9073d329e 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsUHC.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsUHC.lean @@ -20,11 +20,16 @@ Authors: KT. Wu extract convergent subsequences whose marginals are identified by continuity of the pushforward (U3). -/ -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsCompact -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish +module + +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsCompact +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish + /-! ## U1: convergent sequences of probability measures are tight -/ +@[expose] public section + open MeasureTheory Set Filter Topology noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/EpsOptimalSelection.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/EpsOptimalSelection.lean index f4064228b9..67a955031c 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/EpsOptimalSelection.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/EpsOptimalSelection.lean @@ -22,12 +22,17 @@ Authors: KT. Wu comparing F with g. The countably many selectors are glued with Mathlib's `Measurable.find` instantiated at `analyticMeasurableSpace`. -/ -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral -import Mathlib.MeasureTheory.MeasurableSpace.Constructions +module + +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral +public import Mathlib.MeasureTheory.MeasurableSpace.Constructions + /-! ## Fiber infimum approximation -/ +@[expose] public section + open MeasureTheory Set ENNReal noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/JankovVonNeumann.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/JankovVonNeumann.lean index ae2af1edeb..a85bdd87c1 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/JankovVonNeumann.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/JankovVonNeumann.lean @@ -13,13 +13,16 @@ Authors: KT. Wu measurability unprovable. Since `Measurable sel` is discarded at the call site (UpperBound.lean uses `_`), we drop it and prove the rest. -/ -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet -import Mathlib.Algebra.Order.Module.Field -import Mathlib.Data.EReal.Inv -import Mathlib.Tactic.Measurability -import Mathlib.Topology.Algebra.InfiniteSum.Order -import Mathlib.Topology.MetricSpace.Bounded -import Mathlib.MeasureTheory.Measure.Prod +module + +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet +public import Mathlib.Algebra.Order.Module.Field +public import Mathlib.Data.EReal.Inv +public import Mathlib.Tactic.Measurability +public import Mathlib.Topology.Algebra.InfiniteSum.Order +public import Mathlib.Topology.MetricSpace.Bounded +public import Mathlib.MeasureTheory.Measure.Prod + /-! # JankovVonNeumann @@ -27,6 +30,8 @@ import Mathlib.MeasureTheory.Measure.Prod Supporting results for bicausal optimal transport and measurable selection. -/ +@[expose] public section + open MeasureTheory Set ENNReal noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/KernelIntegral.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/KernelIntegral.lean index e3041b5b99..990bbf1a52 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/KernelIntegral.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/KernelIntegral.lean @@ -20,15 +20,20 @@ Authors: KT. Wu x ↦ (κ x ⊗ λ)((E_n)_x) is upper semianalytic. 4. Truncation limit n → ∞ and countable rational bookkeeping. -/ -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LowerSemianalytic -import Mathlib.MeasureTheory.Measure.Prod -import Mathlib.MeasureTheory.Measure.Lebesgue.Basic -import Mathlib.Probability.Kernel.Composition.Prod -import Mathlib.MeasureTheory.Integral.Lebesgue.Sub +module + +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LowerSemianalytic +public import Mathlib.MeasureTheory.Measure.Prod +public import Mathlib.MeasureTheory.Measure.Lebesgue.Basic +public import Mathlib.Probability.Kernel.Composition.Prod +public import Mathlib.MeasureTheory.Integral.Lebesgue.Sub + /-! ## Binary closure properties of analytic sets -/ +@[expose] public section + open Set Topology MeasureTheory ProbabilityTheory Filter open scoped ENNReal diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LintegralLsc.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LintegralLsc.lean index d3840013c1..c378fdc420 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LintegralLsc.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LintegralLsc.lean @@ -37,10 +37,13 @@ We upgrade it to lower semicontinuous `ℝ≥0∞`-valued integrands in three st `γs → γ` with `∫⁻ f ∂(γs n) ≤ y < ∫⁻ f ∂γ`, contradicting step 2 combined with the portmanteau inequality along `γs`. -/ -import Mathlib.Algebra.Order.Ring.Star -import Mathlib.MeasureTheory.Measure.LevyProkhorovMetric -import Mathlib.Order.CompletePartialOrder -import Mathlib.Tactic +module + +public import Mathlib.Algebra.Order.Ring.Star +public import Mathlib.MeasureTheory.Measure.LevyProkhorovMetric +public import Mathlib.Order.CompletePartialOrder +public import Mathlib.Tactic + /-! # LintegralLsc @@ -48,6 +51,8 @@ import Mathlib.Tactic Supporting results for BicausalOT. -/ +@[expose] public section + open MeasureTheory Filter Set Topology open scoped ENNReal diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LowerSemianalytic.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LowerSemianalytic.lean index 221621dfa1..369b3e6701 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LowerSemianalytic.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LowerSemianalytic.lean @@ -8,13 +8,16 @@ Authors: KT. Wu Reference: Bertsekas–Shreve, Definition 7.21, Lemma 7.30, Props 7.47–7.48 -/ -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet -import Mathlib.Algebra.Order.Module.Field -import Mathlib.Data.EReal.Inv -import Mathlib.Tactic.Measurability -import Mathlib.Topology.Algebra.InfiniteSum.Order -import Mathlib.Topology.MetricSpace.Bounded -import Mathlib.MeasureTheory.Measure.Prod +module + +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSet +public import Mathlib.Algebra.Order.Module.Field +public import Mathlib.Data.EReal.Inv +public import Mathlib.Tactic.Measurability +public import Mathlib.Topology.Algebra.InfiniteSum.Order +public import Mathlib.Topology.MetricSpace.Bounded +public import Mathlib.MeasureTheory.Measure.Prod + /-! ### On BS Prop 7.48 (integration of lower semianalytic functions) @@ -29,6 +32,8 @@ universal measurability (`MeasureTheory.AnalyticSet.nullMeasurableSet`) and the parametrized kernel version (`MeasureTheory.AnalyticSet.kernel_section_gt`). -/ +@[expose] public section + open MeasureTheory Set ENNReal noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LsaAlgebra.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LsaAlgebra.lean index 33c15ab660..e9e9b2cd6b 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LsaAlgebra.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LsaAlgebra.lean @@ -11,7 +11,10 @@ Authors: KT. Wu Reference: Bertsekas–Shreve, Lemma 7.30 -/ -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral +module + +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral + /-! # LsaAlgebra @@ -19,6 +22,8 @@ import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral Supporting results for bicausal optimal transport and measurable selection. -/ +@[expose] public section + open Set MeasureTheory open scoped ENNReal diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LscIntegral.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LscIntegral.lean index bc1f6f48cf..935f94fd92 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LscIntegral.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LscIntegral.lean @@ -23,10 +23,16 @@ Authors: KT. Wu liminf γₙ O ≥ γ O ≥ γ K > r by the open portmanteau applied to γₙ → γ. No tightness and no equicontinuity are needed. -/ -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LintegralLsc +module + +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LintegralLsc +public import Mathlib.MeasureTheory.Measure.RegularityCompacts + /-! ## J1: joint continuity of the pairing -/ +@[expose] public section + open MeasureTheory Set Filter Topology open scoped ENNReal diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/MeasurableSelection.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/MeasurableSelection.lean index 931a19d196..4f7f10aa41 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/MeasurableSelection.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/MeasurableSelection.lean @@ -26,14 +26,19 @@ open-set measurability hypothesis applies directly. The limit `f = lim fₙ` is measurable as a pointwise limit of measurable functions into a metrizable space, and `f a ∈ Φ a` because `Φ a` is closed. -/ -import Mathlib.Algebra.Order.Ring.Star -import Mathlib.Algebra.Order.Star.Real -import Mathlib.Analysis.Normed.Order.Lattice -import Mathlib.MeasureTheory.Constructions.BorelSpace.Metrizable -import Mathlib.Tactic +module + +public import Mathlib.Algebra.Order.Ring.Star +public import Mathlib.Algebra.Order.Star.Real +public import Mathlib.Analysis.Normed.Order.Lattice +public import Mathlib.MeasureTheory.Constructions.BorelSpace.Metrizable +public import Mathlib.Tactic + /-! ### Least-index choice over `ℕ`, classical-decidability wrapper -/ +@[expose] public section + open Metric Set Filter Topology TopologicalSpace namespace MeasurableSelection diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ProbabilityMeasurePolish.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ProbabilityMeasurePolish.lean index 8f522b77b5..658d58fc28 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ProbabilityMeasurePolish.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ProbabilityMeasurePolish.lean @@ -13,14 +13,19 @@ Authors: KT. Wu supplied here — is completeness (Node A + C1) of the Lévy-Prokhorov metric. Separability (Node B) and the `PolishSpace` assembly follow. -/ -import Mathlib.MeasureTheory.Measure.LevyProkhorovMetric -import Mathlib.MeasureTheory.Measure.Tight -import Mathlib.MeasureTheory.Measure.Prokhorov -import Mathlib.MeasureTheory.PiSystem -import Mathlib.MeasureTheory.Measure.GiryMonad +module + +public import Mathlib.MeasureTheory.Measure.LevyProkhorovMetric +public import Mathlib.MeasureTheory.Measure.Tight +public import Mathlib.MeasureTheory.Measure.Prokhorov +public import Mathlib.MeasureTheory.PiSystem +public import Mathlib.MeasureTheory.Measure.GiryMonad + /-! ## Node A: Lévy-Prokhorov Cauchy sequences are uniformly tight -/ +@[expose] public section + open MeasureTheory Topology TopologicalSpace Metric Filter Set open scoped ENNReal NNReal @@ -759,11 +764,11 @@ theorem countable_generatePiSystem {α : Type*} {S : Set (Set α)} (hS : S.Countable) : (generatePiSystem S).Countable := by refine ((countable_ofPred_finite_subset hS).image fun T => ⋂₀ T).mono fun t ht => ?_ - induction ht with - | base h_s => + induction ht using generatePiSystem_induction with + | base _ h_s => exact ⟨{_}, ⟨finite_singleton _, singleton_subset_iff.mpr h_s⟩, sInter_singleton _⟩ - | inter _ _ _ ih_s ih_u => + | inter _ _ _ _ _ ih_s ih_u => obtain ⟨T₁, ⟨hT₁fin, hT₁sub⟩, rfl⟩ := ih_s obtain ⟨T₂, ⟨hT₂fin, hT₂sub⟩, rfl⟩ := ih_u exact ⟨T₁ ∪ T₂, ⟨hT₁fin.union hT₂fin, union_subset hT₁sub hT₂sub⟩, diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Tree.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Tree.lean index 465988f346..4aad90daf1 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Tree.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Tree.lean @@ -11,13 +11,18 @@ Authors: KT. Wu The infrastructure is generic: domain X (Polish), codomain ℕ → ℕ. The leftmost branch operates only on the codomain. -/ -import Mathlib.Topology.MetricSpace.Polish -import Mathlib.Topology.MetricSpace.PiNat -import Mathlib.MeasureTheory.Constructions.Polish.Basic -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSigmaAlgebra +module + +public import Mathlib.Topology.MetricSpace.Polish +public import Mathlib.Topology.MetricSpace.PiNat +public import Mathlib.MeasureTheory.Constructions.Polish.Basic +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSigmaAlgebra + /-! ## Part I: Fibers (generic domain X, codomain ℕᴺ) -/ +@[expose] public section + open Set Topology MeasureTheory noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/Existence.lean b/LeanPool/BicausalOT/BicausalOT/Existence.lean index cdcfd55d69..9b5b3d68f6 100644 --- a/LeanPool/BicausalOT/BicausalOT/Existence.lean +++ b/LeanPool/BicausalOT/BicausalOT/Existence.lean @@ -7,8 +7,11 @@ Authors: KT. Wu Step 5: Existence of optimal coupling ✓ FULLY VERIFIED Uses Mathlib's LowerSemicontinuousOn.exists_isMinOn (no axiom needed). -/ -import LeanPool.BicausalOT.BicausalOT.Defs -import Mathlib.Topology.Semicontinuity.Basic +module + +public import LeanPool.BicausalOT.BicausalOT.Defs +public import Mathlib.Topology.Semicontinuity.Basic + /-! # Existence @@ -16,6 +19,8 @@ import Mathlib.Topology.Semicontinuity.Basic Supporting results for bicausal optimal transport and measurable selection. -/ +@[expose] public section + open MeasureTheory ProbabilityTheory Set ENNReal noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/FeasNonempty.lean b/LeanPool/BicausalOT/BicausalOT/FeasNonempty.lean index 2fe0f2015e..d0d88311d9 100644 --- a/LeanPool/BicausalOT/BicausalOT/FeasNonempty.lean +++ b/LeanPool/BicausalOT/BicausalOT/FeasNonempty.lean @@ -18,9 +18,12 @@ Authors: KT. Wu `bellman_value_eq'` → ValueRepresentation.lean. See note_FeasNonempty.md for the recommendation. -/ -import LeanPool.BicausalOT.BicausalOT.MultiPeriod -import LeanPool.BicausalOT.BicausalOT.ValueRepresentation -import Mathlib.MeasureTheory.Measure.Prod +module + +public import LeanPool.BicausalOT.BicausalOT.MultiPeriod +public import LeanPool.BicausalOT.BicausalOT.ValueRepresentation +public import Mathlib.MeasureTheory.Measure.Prod + /-! ### General marginal lemmas for product measures @@ -28,6 +31,8 @@ Mathlib's `Measure.map_fst_prod : (μ.prod ν).map Prod.fst = (ν univ) • μ` (and symmetrically `Measure.map_snd_prod`) carry a total-mass scalar; for probability factors the scalar is `1` and disappears. -/ +@[expose] public section + open MeasureTheory Set ENNReal noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/LowerBound.lean b/LeanPool/BicausalOT/BicausalOT/LowerBound.lean index eeee52744f..b7718729cd 100644 --- a/LeanPool/BicausalOT/BicausalOT/LowerBound.lean +++ b/LeanPool/BicausalOT/BicausalOT/LowerBound.lean @@ -6,7 +6,10 @@ Authors: KT. Wu /- Step 2: Bellman Lower Bound ✓ FULLY VERIFIED -/ -import LeanPool.BicausalOT.BicausalOT.Defs +module + +public import LeanPool.BicausalOT.BicausalOT.Defs + /-! # LowerBound @@ -14,6 +17,8 @@ import LeanPool.BicausalOT.BicausalOT.Defs Supporting results for bicausal optimal transport and measurable selection. -/ +@[expose] public section + open MeasureTheory ProbabilityTheory Set ENNReal noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/LscBellman.lean b/LeanPool/BicausalOT/BicausalOT/LscBellman.lean index 1b207562b8..6ef552c07c 100644 --- a/LeanPool/BicausalOT/BicausalOT/LscBellman.lean +++ b/LeanPool/BicausalOT/BicausalOT/LscBellman.lean @@ -25,13 +25,18 @@ Authors: KT. Wu the ε = 0, plain-Borel upgrade of Phases 2 and 4 under stronger hypotheses (twin track: neither result dominates the other). -/ -import LeanPool.BicausalOT.BicausalOT.MeasurableStrategy -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsUHC -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LscIntegral -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.MeasurableSelection +module + +public import LeanPool.BicausalOT.BicausalOT.MeasurableStrategy +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsUHC +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LscIntegral +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.MeasurableSelection + /-! ## KRN on the Polish space of probability measures -/ +@[expose] public section + open MeasureTheory Set Filter Topology open scoped ENNReal diff --git a/LeanPool/BicausalOT/BicausalOT/MeasurableFeasibleStrategy.lean b/LeanPool/BicausalOT/BicausalOT/MeasurableFeasibleStrategy.lean index 2d79fdb86c..0ab174655f 100644 --- a/LeanPool/BicausalOT/BicausalOT/MeasurableFeasibleStrategy.lean +++ b/LeanPool/BicausalOT/BicausalOT/MeasurableFeasibleStrategy.lean @@ -18,7 +18,10 @@ Authors: KT. Wu measurability would NOT suffice — that is the open PR3 direction). Kuratowski–Ryll-Nardzewski then selects measurably. -/ -import LeanPool.BicausalOT.BicausalOT.LscBellman +module + +public import LeanPool.BicausalOT.BicausalOT.LscBellman + /-! # MeasurableFeasibleStrategy @@ -26,6 +29,8 @@ import LeanPool.BicausalOT.BicausalOT.LscBellman Supporting results for bicausal optimal transport and measurable selection. -/ +@[expose] public section + open MeasureTheory Set Filter Topology open scoped ENNReal diff --git a/LeanPool/BicausalOT/BicausalOT/MeasurableStrategy.lean b/LeanPool/BicausalOT/BicausalOT/MeasurableStrategy.lean index d3784e9caa..75ae5bfc7f 100644 --- a/LeanPool/BicausalOT/BicausalOT/MeasurableStrategy.lean +++ b/LeanPool/BicausalOT/BicausalOT/MeasurableStrategy.lean @@ -19,11 +19,16 @@ Authors: KT. Wu every stage, and the Bellman value representation restricts to such strategies without changing its value. -/ -import LeanPool.BicausalOT.BicausalOT.SemianalyticValue -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.EpsOptimalSelection +module + +public import LeanPool.BicausalOT.BicausalOT.SemianalyticValue +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.EpsOptimalSelection + /-! ## Fibers of the feasibility graph -/ +@[expose] public section + open MeasureTheory Set ENNReal noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/MultiPeriod.lean b/LeanPool/BicausalOT/BicausalOT/MultiPeriod.lean index aaad9f1693..e3bf57abce 100644 --- a/LeanPool/BicausalOT/BicausalOT/MultiPeriod.lean +++ b/LeanPool/BicausalOT/BicausalOT/MultiPeriod.lean @@ -10,9 +10,12 @@ Authors: KT. Wu histories, time-to-go recursion, arbitrary function strategies. Target theorem: `bellman_value_eq_multi`. -/ -import LeanPool.BicausalOT.BicausalOT.Defs -import LeanPool.BicausalOT.BicausalOT.UpperBound -import Mathlib.MeasureTheory.Integral.Lebesgue.Add +module + +public import LeanPool.BicausalOT.BicausalOT.Defs +public import LeanPool.BicausalOT.BicausalOT.UpperBound +public import Mathlib.MeasureTheory.Integral.Lebesgue.Add + /-! # MultiPeriod @@ -20,6 +23,8 @@ import Mathlib.MeasureTheory.Integral.Lebesgue.Add Supporting results for bicausal optimal transport and measurable selection. -/ +@[expose] public section + open MeasureTheory Set ENNReal noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/MultiPeriodTopology.lean b/LeanPool/BicausalOT/BicausalOT/MultiPeriodTopology.lean index f5af9cb714..30c2229459 100644 --- a/LeanPool/BicausalOT/BicausalOT/MultiPeriodTopology.lean +++ b/LeanPool/BicausalOT/BicausalOT/MultiPeriodTopology.lean @@ -17,14 +17,19 @@ Authors: KT. Wu instance over the previous level (via `inferInstanceAs` on the product type), so all binary-product API applies definitionally to histories. -/ -import LeanPool.BicausalOT.BicausalOT.MultiPeriod -import Mathlib.Topology.MetricSpace.Polish -import Mathlib.MeasureTheory.Constructions.BorelSpace.Basic +module + +public import LeanPool.BicausalOT.BicausalOT.MultiPeriod +public import Mathlib.Topology.MetricSpace.Polish +public import Mathlib.MeasureTheory.Constructions.BorelSpace.Basic + /-! ### Topological structure The product topology on histories, by recursion on the time index. -/ +@[expose] public section + open MeasureTheory noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/Proposition1.lean b/LeanPool/BicausalOT/BicausalOT/Proposition1.lean index 36d44314f6..f029947adc 100644 --- a/LeanPool/BicausalOT/BicausalOT/Proposition1.lean +++ b/LeanPool/BicausalOT/BicausalOT/Proposition1.lean @@ -6,7 +6,10 @@ Authors: KT. Wu /- Proposition 1: Bicausal ↔ Kernel Decomposition ✓ FULLY VERIFIED -/ -import LeanPool.BicausalOT.BicausalOT.Defs +module + +public import LeanPool.BicausalOT.BicausalOT.Defs + /-! # Proposition1 @@ -14,6 +17,8 @@ import LeanPool.BicausalOT.BicausalOT.Defs Supporting results for bicausal optimal transport and measurable selection. -/ +@[expose] public section + open MeasureTheory ProbabilityTheory Set ENNReal noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/SemianalyticValue.lean b/LeanPool/BicausalOT/BicausalOT/SemianalyticValue.lean index f1882a71f0..dfc6410565 100644 --- a/LeanPool/BicausalOT/BicausalOT/SemianalyticValue.lean +++ b/LeanPool/BicausalOT/BicausalOT/SemianalyticValue.lean @@ -18,11 +18,14 @@ Authors: KT. Wu cost is added back via `IsLowerSemianalytic.add`. Induction on the time to go. -/ -import LeanPool.BicausalOT.BicausalOT.MultiPeriodTopology -import LeanPool.BicausalOT.BicausalOT.FeasNonempty -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LsaAlgebra -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish +module + +public import LeanPool.BicausalOT.BicausalOT.MultiPeriodTopology +public import LeanPool.BicausalOT.BicausalOT.FeasNonempty +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LsaAlgebra +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish + /-! ## The Polish space of probability measures with its Borel σ-algebra @@ -30,6 +33,8 @@ import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePol not the Borel σ-algebra of the weak topology; the type synonym `WeakP` installs the Borel structure (Polish by W1). -/ +@[expose] public section + open MeasureTheory Set ENNReal noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/UpperBound.lean b/LeanPool/BicausalOT/BicausalOT/UpperBound.lean index b75275cf02..82fd0ef830 100644 --- a/LeanPool/BicausalOT/BicausalOT/UpperBound.lean +++ b/LeanPool/BicausalOT/BicausalOT/UpperBound.lean @@ -6,8 +6,11 @@ Authors: KT. Wu /- Step 3: Upper Bound via ε-optimal selection -/ -import LeanPool.BicausalOT.BicausalOT.Defs -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.JankovVonNeumann +module + +public import LeanPool.BicausalOT.BicausalOT.Defs +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.JankovVonNeumann + /-! # UpperBound @@ -15,6 +18,8 @@ import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.JankovVonNeumann Supporting results for bicausal optimal transport and measurable selection. -/ +@[expose] public section + open MeasureTheory ProbabilityTheory Set ENNReal noncomputable section diff --git a/LeanPool/BicausalOT/BicausalOT/ValueRepresentation.lean b/LeanPool/BicausalOT/BicausalOT/ValueRepresentation.lean index 296a15a39d..0c1fab747e 100644 --- a/LeanPool/BicausalOT/BicausalOT/ValueRepresentation.lean +++ b/LeanPool/BicausalOT/BicausalOT/ValueRepresentation.lean @@ -7,10 +7,13 @@ Authors: KT. Wu Step 4: Value Representation (equality) ✓ FULLY VERIFIED Combines lower and upper bounds. -/ -import LeanPool.BicausalOT.BicausalOT.Defs -import LeanPool.BicausalOT.BicausalOT.LowerBound -import LeanPool.BicausalOT.BicausalOT.UpperBound -import Mathlib.MeasureTheory.Integral.Lebesgue.Add +module + +public import LeanPool.BicausalOT.BicausalOT.Defs +public import LeanPool.BicausalOT.BicausalOT.LowerBound +public import LeanPool.BicausalOT.BicausalOT.UpperBound +public import Mathlib.MeasureTheory.Integral.Lebesgue.Add + /-! # ValueRepresentation @@ -18,6 +21,8 @@ import Mathlib.MeasureTheory.Integral.Lebesgue.Add Supporting results for bicausal optimal transport and measurable selection. -/ +@[expose] public section + open MeasureTheory ProbabilityTheory Set ENNReal noncomputable section diff --git a/LeanPool/BicausalOT/Solution.lean b/LeanPool/BicausalOT/Solution.lean index c5ba7c9470..354d6e834e 100644 --- a/LeanPool/BicausalOT/Solution.lean +++ b/LeanPool/BicausalOT/Solution.lean @@ -3,7 +3,10 @@ Copyright (c) 2026 KT. Wu. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: KT. Wu -/ -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.MeasurableSelection +module + +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.MeasurableSelection + /-! # Solution file: the Kuratowski–Ryll-Nardzewski measurable selection theorem @@ -35,6 +38,8 @@ and is one of the theorems covered by the repository's `#print axioms` audit `[propext, Classical.choice, Quot.sound]`. -/ +@[expose] public section + open TopologicalSpace namespace MeasurableSelection diff --git a/LeanPool/BicausalOT/SolutionCapacitability.lean b/LeanPool/BicausalOT/SolutionCapacitability.lean index 98d735d55a..8051164dcc 100644 --- a/LeanPool/BicausalOT/SolutionCapacitability.lean +++ b/LeanPool/BicausalOT/SolutionCapacitability.lean @@ -3,9 +3,12 @@ Copyright (c) 2026 KT. Wu. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: KT. Wu -/ -import Mathlib.Order.CompletePartialOrder -import Mathlib.Tactic -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability +module + +public import Mathlib.Order.CompletePartialOrder +public import Mathlib.Tactic +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability + /-! # Solution file: Choquet capacitability for analytic sets, and universal measurability @@ -62,6 +65,8 @@ namespace so that their names match the `ChallengeCapacitability` declarations n report only `[propext, Classical.choice, Quot.sound]`. -/ +@[expose] public section + open MeasureTheory namespace Capacitability diff --git a/LeanPool/BicausalOT/SolutionJvN.lean b/LeanPool/BicausalOT/SolutionJvN.lean index a31c570014..c6d462296e 100644 --- a/LeanPool/BicausalOT/SolutionJvN.lean +++ b/LeanPool/BicausalOT/SolutionJvN.lean @@ -3,8 +3,11 @@ Copyright (c) 2026 KT. Wu. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: KT. Wu -/ -import Mathlib.Tactic -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree +module + +public import Mathlib.Tactic +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Tree + /-! # Solution file: the Jankov–von Neumann uniformization theorem @@ -80,6 +83,8 @@ repository root, and is checked again during the build by `BicausalOT/AxiomsAudi (line 35); both report only `[propext, Classical.choice, Quot.sound]`. -/ +@[expose] public section + namespace Uniformization /-- **The Jankov–von Neumann uniformization theorem** (Kechris, *Classical Descriptive diff --git a/LeanPool/BicausalOT/SolutionPolish.lean b/LeanPool/BicausalOT/SolutionPolish.lean index 85b8c511da..ad7eda71ba 100644 --- a/LeanPool/BicausalOT/SolutionPolish.lean +++ b/LeanPool/BicausalOT/SolutionPolish.lean @@ -3,8 +3,11 @@ Copyright (c) 2026 KT. Wu. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: KT. Wu -/ -import Mathlib.Tactic -import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish +module + +public import Mathlib.Tactic +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ProbabilityMeasurePolish + /-! # Solution file: the space of probability measures on a Polish space is Polish @@ -56,6 +59,8 @@ library, and is one of the declarations covered by the repository's `#print axio `[propext, Classical.choice, Quot.sound]`. -/ +@[expose] public section + open MeasureTheory namespace ProbabilityMeasurePolish From 5dae6d0643ab9b6fd4e3a86c1590092b3a79c914 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 18:38:28 +0000 Subject: [PATCH 5/6] Clarify coupling-strategy scope and kernel-section citation --- LeanPool/BicausalOT.lean | 18 +++++++++++++++++- .../DescriptiveSetTheory/Capacitability.lean | 8 +++++--- LeanPool/BicausalOT/BicausalOT/LscBellman.lean | 6 +++--- .../BicausalOT/BicausalOT/Proposition1.lean | 6 +++++- LeanPool/projects.yml | 11 ++++++----- 5 files changed, 36 insertions(+), 13 deletions(-) diff --git a/LeanPool/BicausalOT.lean b/LeanPool/BicausalOT.lean index 0fe51b908a..d9d68317e8 100644 --- a/LeanPool/BicausalOT.lean +++ b/LeanPool/BicausalOT.lean @@ -45,7 +45,7 @@ public import LeanPool.BicausalOT.SolutionPolish /-! -# BicausalOT +# BicausalOT: measurable selection and coupling strategies Source: url:https://github.com/maxwellapexlab/bicausalot-palomar Authors: KT. Wu @@ -55,4 +55,20 @@ Tags: probability MSC: 28B20, 54C65, 54H05, 03E15, 28A20, 68V20 -/ +/-! ## Scope + +The Bellman identities compare nested strategy costs with Bellman recursions over locally +feasible one-step couplings. The development does not establish equivalence with minimization +over bicausal measures on a path space. Exact Borel measurable strategies and optimal initial +couplings are obtained for weakly continuous probability kernels and nonnegative extended-real +lower semicontinuous costs on Polish Borel spaces; see +`MultiPeriod.bellman_value_attained_multi`. + +The basic analytic-set capacitability and universal measurability results overlap with +`LeanPool.FormalLearningTheory.PureMath.ChoquetCapacity` and +`LeanPool.FormalLearningTheory.PureMath.AnalyticMeasurability`. This development also proves +analytic superlevel sets for finite-kernel sections, measurable selection, and coupling-strategy +results. Its local Souslin-scheme construction supports the kernel-section proof. +-/ + @[expose] public section diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Capacitability.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Capacitability.lean index a4c9f00bc0..5f97f5afe6 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Capacitability.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/Capacitability.lean @@ -560,10 +560,12 @@ theorem cap_measurable_layer exact MeasurableSet.iInter fun i => (measurable_pi_apply (i : ℕ)) (measurableSet_singleton (b i)) -/-- **Parametrized Choquet capacitability** (kernel key lemma; BS Prop 7.46): - for `A` analytic in `X × Y` and a finite Borel kernel `κ`, the function +/-- **Analytic superlevel sets for finite-kernel sections.** + For `A` analytic in `X × Y` and a finite Borel kernel `κ`, the function `x ↦ κ x (A_x)` is upper semianalytic: its strict superlevel sets are - analytic. -/ + analytic. This parametrized finite-kernel variant is proved below. For the + related probability-measure statement, see Bertsekas–Shreve, *Stochastic + Optimal Control: The Discrete-Time Case*, Corollary 7.43.1, p. 170. -/ theorem MeasureTheory.AnalyticSet.kernel_section_gt {A : Set (X × Y)} (hA : AnalyticSet A) (κ : Kernel X Y) [IsFiniteKernel κ] (c : ℝ≥0∞) : diff --git a/LeanPool/BicausalOT/BicausalOT/LscBellman.lean b/LeanPool/BicausalOT/BicausalOT/LscBellman.lean index 6ef552c07c..bf13b5a412 100644 --- a/LeanPool/BicausalOT/BicausalOT/LscBellman.lean +++ b/LeanPool/BicausalOT/BicausalOT/LscBellman.lean @@ -711,9 +711,9 @@ theorem bellman_value_attained_multi (T : ℕ) /-- **Phase 5, full attainment — competitor form.** Unfolding the infimum of `bellman_value_attained_multi`: the exhibited pair `(γ₀*, γopt)` is feasible, its strategy half is plain-Borel measurable, and no feasible - competitor `(γ₀', γ)` does better. This is the statement "the - `T`-period bicausal optimal transport problem has an optimal solution" - in the Feller/lsc model. -/ + competitor `(γ₀', γ)` does better. This proves existence of an optimal + initial coupling and locally feasible strategy in the Feller/lsc model. + Equivalence with minimization over bicausal path laws is not proved here. -/ theorem exists_minimizing_pair_multi (T : ℕ) (μ₀ : Measure (X 0)) [IsProbabilityMeasure μ₀] (ν₀ : Measure (Y 0)) [IsProbabilityMeasure ν₀] diff --git a/LeanPool/BicausalOT/BicausalOT/Proposition1.lean b/LeanPool/BicausalOT/BicausalOT/Proposition1.lean index f029947adc..723d243465 100644 --- a/LeanPool/BicausalOT/BicausalOT/Proposition1.lean +++ b/LeanPool/BicausalOT/BicausalOT/Proposition1.lean @@ -4,7 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: KT. Wu -/ /- - Proposition 1: Bicausal ↔ Kernel Decomposition ✓ FULLY VERIFIED + Two-step kernel-decomposition interface. + + IsBicausal₂ is defined by the existence of a KernelDecomp with the required + marginals. The implications below package and unpack that definition; they + do not establish equivalence with a conditional-independence definition. -/ module diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index 31999c49b6..2fa40f2863 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -10110,11 +10110,12 @@ projects: - '90C35' - '05C21' - slug: bicausalot-palomar - title: BicausalOT - summary: Develops measurable selection, descriptive set theory, and the Bellman representation - for bicausal optimal transport over finite horizons. It includes Kuratowski–Ryll-Nardzewski - selection, Jankov–von Neumann uniformization, Choquet capacitability, Polish probability-measure - spaces, and measurable optimal strategies. + title: "BicausalOT: measurable selection and coupling strategies" + summary: Develops Kuratowski–Ryll-Nardzewski selection, Jankov–von Neumann uniformization, + and finite-horizon Bellman identities for locally feasible coupling strategies. Exact Borel + measurable optimal strategies and initial couplings are obtained on Polish Borel spaces + for weakly continuous probability kernels and nonnegative extended-real lower semicontinuous + costs. Equivalence with optimization over bicausal path laws is not established. branch: probability entry_module: LeanPool.BicausalOT authors: From df93934dd1b962482863a1401478dfb7d408685c Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sat, 26 Sep 2026 04:27:42 +0000 Subject: [PATCH 6/6] refactor(BicausalOT): share truncation and epsilon-optimal lemmas --- LeanPool.lean | 1 + .../CouplingsCompact.lean | 30 +++++++------------ .../ENNRealTruncation.lean | 30 +++++++++++++++++++ .../JankovVonNeumann.lean | 4 +-- .../DescriptiveSetTheory/KernelIntegral.lean | 12 +------- .../DescriptiveSetTheory/LintegralLsc.lean | 17 ++--------- .../BicausalOT/BicausalOT/UpperBound.lean | 14 --------- 7 files changed, 46 insertions(+), 62 deletions(-) create mode 100644 LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ENNRealTruncation.lean diff --git a/LeanPool.lean b/LeanPool.lean index e91a746b01..ce580d134c 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -292,6 +292,7 @@ public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.AnalyticSigmaA public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsCompact public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.CouplingsUHC +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ENNRealTruncation public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.EpsOptimalSelection public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.JankovVonNeumann public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.KernelIntegral diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsCompact.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsCompact.lean index 1396d5b374..cd843e1441 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsCompact.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/CouplingsCompact.lean @@ -18,25 +18,18 @@ Authors: KT. Wu via the marginal equations (`Set.compl_prod_eq_union`, `Measure.map_apply measurable_fst`); (ii) Prokhorov (`isCompact_closure_of_isTightMeasureSet`) gives compactness of the - closure; (iii) the set is CLOSED (front F2's - `isClosed_probabilityMeasure_couplings`, reproduced below), so it equals + closure; (iii) the set is CLOSED + (`isClosed_probabilityMeasure_couplings` below), so it equals its closure. - As in F2, the `Measure.map`-level reformulations matching the shape of + The `Measure.map`-level reformulations matching the shape of the repository's marginal constraints (`CouplingSet₀` in Defs.lean, `MultiPeriod.Feas`) are provided, including the unconditional plain- `Measure`-target version (empty when a target is not a probability measure — and the empty set is compact). - Bonus: nonemptiness via the product coupling - (`ProbabilityMeasure.prod`, `ProbabilityMeasure.map_fst_prod`) — NOTE - this may duplicate front F1's deliverable; dedupe at integration. - - DEDUPE NOTE FOR THE INTEGRATOR: the section "Translation" and the - theorems `isClosed_probabilityMeasure_couplings`, - `probabilityMeasure_couplings_toMeasure_eq` are copied VERBATIM from - front F2's draft_FeasClosed.lean (scratch files cannot import each - other); keep a single copy when integrating both fronts. + Nonemptiness follows from the product coupling + (`ProbabilityMeasure.prod`, `ProbabilityMeasure.map_fst_prod`). -/ module @@ -45,8 +38,7 @@ public import Mathlib.MeasureTheory.Measure.Prokhorov public import Mathlib.Tactic -/-! ## Translation between `ProbabilityMeasure.map` and `Measure.map` constraints -(verbatim copy of front F2's lemma — dedupe at integration) -/ +/-! ## Translation between `ProbabilityMeasure.map` and `Measure.map` constraints -/ @[expose] public section @@ -75,7 +67,7 @@ theorem probabilityMeasure_map_eq_iff (γ : ProbabilityMeasure Ω) (μ : Probabi end Translation -/-! ## Closedness of coupling sets (front F2, reproduced) -/ +/-! ## Closedness of coupling sets -/ section Couplings @@ -83,8 +75,7 @@ variable {A B : Type*} [TopologicalSpace A] [PolishSpace A] [MeasurableSpace A] [BorelSpace A] [TopologicalSpace B] [PolishSpace B] [MeasurableSpace B] [BorelSpace B] -/-- **F2, `ProbabilityMeasure` level** (verbatim copy — dedupe at integration). On Borel -Polish spaces, the set of couplings of `mu` and `nu` is closed in the topology of weak +/-- On Borel Polish spaces, the set of couplings of `mu` and `nu` is closed in the topology of weak convergence. -/ theorem isClosed_probabilityMeasure_couplings (mu : ProbabilityMeasure A) (nu : ProbabilityMeasure B) : @@ -102,7 +93,7 @@ omit [TopologicalSpace A] [PolishSpace A] [BorelSpace A] [TopologicalSpace B] [PolishSpace B] [BorelSpace B] in /-- The coupling set stated with `Measure.map` constraints on the underlying measures (the shape used by `CouplingSet₀` and `MultiPeriod.Feas`) coincides with the coupling -set stated via `ProbabilityMeasure.map` (verbatim copy of F2 — dedupe at integration). -/ +set stated via `ProbabilityMeasure.map`. -/ theorem probabilityMeasure_couplings_toMeasure_eq (mu : ProbabilityMeasure A) (nu : ProbabilityMeasure B) : {γ : ProbabilityMeasure (A × B) | @@ -219,8 +210,7 @@ theorem isCompact_probabilityMeasure_marginals (m : Measure A) (n : Measure B) : rw [hempty] exact isCompact_empty -/-! ## Bonus: nonemptiness via the product coupling -(NOTE: front F1 owns nonemptiness — dedupe at integration if F1 delivers) -/ +/-! ## Nonemptiness via the product coupling -/ omit [TopologicalSpace A] [PolishSpace A] [BorelSpace A] [TopologicalSpace B] [PolishSpace B] [BorelSpace B] in diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ENNRealTruncation.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ENNRealTruncation.lean new file mode 100644 index 0000000000..0a6ad82d9c --- /dev/null +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/ENNRealTruncation.lean @@ -0,0 +1,30 @@ +/- +Copyright (c) 2026 KT. Wu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: KT. Wu +-/ +module + +public import Mathlib.Basic.ENNReal.Operations + +/-! +# Truncations of extended nonnegative real numbers + +The kernel integration and lower semicontinuity arguments use the same truncation limit. +-/ + +public section + +open scoped ENNReal + +/-- Every extended nonnegative real is the supremum of its natural-number truncations. -/ +theorem ennreal_iSup_min_natCast (a : ℝ≥0∞) : ⨆ n : ℕ, min a (n : ℝ≥0∞) = a := by + refine le_antisymm (iSup_le fun n => min_le_left _ _) ?_ + rcases eq_or_ne a ∞ with rfl | ha + · have hmin : ∀ n : ℕ, min (∞ : ℝ≥0∞) (n : ℝ≥0∞) = (n : ℝ≥0∞) := + fun n => min_eq_right le_top + calc (∞ : ℝ≥0∞) = ⨆ n : ℕ, (n : ℝ≥0∞) := ENNReal.iSup_natCast.symm + _ ≤ ⨆ n : ℕ, min (∞ : ℝ≥0∞) (n : ℝ≥0∞) := + iSup_mono fun n => (hmin n).symm.le + · obtain ⟨n, hn⟩ := ENNReal.exists_nat_gt ha + exact le_iSup_of_le n (by simp [min_eq_left hn.le]) diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/JankovVonNeumann.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/JankovVonNeumann.lean index a85bdd87c1..17447fcc4e 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/JankovVonNeumann.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/JankovVonNeumann.lean @@ -37,7 +37,7 @@ open MeasureTheory Set ENNReal noncomputable section /-- Pointwise ε-optimal element in a nonempty set. -/ -private theorem eps_optimal_element' +theorem eps_optimal_element {α : Type*} (S : Set α) (h_ne : S.Nonempty) (f : α → ENNReal) (ε : ENNReal) (hε : 0 < ε) : ∃ a ∈ S, f a ≤ (⨅ (x : α) (_ : x ∈ S), f x) + ε := by @@ -62,7 +62,7 @@ theorem eps_optimal_selection (∀ a, sel a ∈ S a) ∧ (∀ a, f a (sel a) ≤ (⨅ (m : Measure β) (_ : m ∈ S a), f a m) + ε) := by have key : ∀ a, ∃ m ∈ S a, f a m ≤ (⨅ (m : Measure β) (_ : m ∈ S a), f a m) + ε := - fun a => eps_optimal_element' (S a) (h_ne a) (f a) ε hε + fun a => eps_optimal_element (S a) (h_ne a) (f a) ε hε choose sel hsel_mem hsel_opt using key exact ⟨sel, hsel_mem, hsel_opt⟩ diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/KernelIntegral.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/KernelIntegral.lean index 990bbf1a52..c4cd73b635 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/KernelIntegral.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/KernelIntegral.lean @@ -23,6 +23,7 @@ Authors: KT. Wu module public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.Capacitability +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ENNRealTruncation public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.LowerSemianalytic public import Mathlib.MeasureTheory.Measure.Prod public import Mathlib.MeasureTheory.Measure.Lebesgue.Basic @@ -99,17 +100,6 @@ theorem ennreal_le_iff_forall_lt_add_inv {a q : ℝ≥0∞} (hq : q ≠ ∞) : le_of_lt (lt_of_le_of_lt (ENNReal.inv_le_inv.mpr le_self_add) hk) exact absurd (h k) (not_lt.mpr (le_trans (by gcongr) hεa.le)) -theorem ennreal_iSup_min_natCast (a : ℝ≥0∞) : ⨆ n : ℕ, min a (n : ℝ≥0∞) = a := by - refine le_antisymm (iSup_le fun n => min_le_left _ _) ?_ - rcases eq_or_ne a ∞ with rfl | ha - · have hmin : ∀ n : ℕ, min (∞ : ℝ≥0∞) (n : ℝ≥0∞) = (n : ℝ≥0∞) := - fun n => min_eq_right le_top - calc (∞ : ℝ≥0∞) = ⨆ n : ℕ, (n : ℝ≥0∞) := ENNReal.iSup_natCast.symm - _ ≤ ⨆ n : ℕ, min (∞ : ℝ≥0∞) (n : ℝ≥0∞) := - iSup_mono fun n => (hmin n).symm.le - · obtain ⟨n, hn⟩ := ENNReal.exists_nat_gt ha - exact le_iSup_of_le n (by simp [min_eq_left hn.le]) - /-! ## AEMeasurability from analytic sublevel sets Combines the universal measurability of analytic sets (Part VI of diff --git a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LintegralLsc.lean b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LintegralLsc.lean index c378fdc420..4198fc8a55 100644 --- a/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LintegralLsc.lean +++ b/LeanPool/BicausalOT/BicausalOT/DescriptiveSetTheory/LintegralLsc.lean @@ -39,6 +39,7 @@ We upgrade it to lower semicontinuous `ℝ≥0∞`-valued integrands in three st -/ module +public import LeanPool.BicausalOT.BicausalOT.DescriptiveSetTheory.ENNRealTruncation public import Mathlib.Algebra.Order.Ring.Star public import Mathlib.MeasureTheory.Measure.LevyProkhorovMetric public import Mathlib.Order.CompletePartialOrder @@ -56,20 +57,6 @@ Supporting results for BicausalOT. open MeasureTheory Filter Set Topology open scoped ENNReal -/-- Every `a : ℝ≥0∞` is the supremum of its truncations `min a n`. -(A copy of `ennreal_iSup_min_natCast` from `BicausalOT.DescriptiveSetTheory.KernelIntegral`; -kept `private` so that this draft stays self-contained over Mathlib and can be -deduplicated on integration.) -/ -private lemma ennreal_iSup_min_natCast' (a : ℝ≥0∞) : ⨆ n : ℕ, min a (n : ℝ≥0∞) = a := by - refine le_antisymm (iSup_le fun n => min_le_left _ _) ?_ - rcases eq_or_ne a ∞ with rfl | ha - · have hmin : ∀ n : ℕ, min (∞ : ℝ≥0∞) (n : ℝ≥0∞) = (n : ℝ≥0∞) := fun n => - min_eq_right le_top - simp only [hmin] - exact ENNReal.iSup_natCast.ge - · obtain ⟨n, hn⟩ := ENNReal.exists_nat_gt ha - exact le_iSup_of_le n (min_eq_left hn.le).ge - section SequentialBound variable {W : Type*} [MeasurableSpace W] [TopologicalSpace W] [OpensMeasurableSpace W] @@ -146,7 +133,7 @@ theorem LowerSemicontinuous.lintegral_le_liminf = ⨆ n : ℕ, ∫⁻ x, min (f x) (n : ℝ≥0∞) ∂μ := by rw [← lintegral_iSup (fun n => hf.measurable.min measurable_const) (fun n m hnm x => min_le_min le_rfl (by exact_mod_cast hnm))] - exact lintegral_congr fun x => (ennreal_iSup_min_natCast' (f x)).symm + exact lintegral_congr fun x => (ennreal_iSup_min_natCast (f x)).symm _ ≤ atTop.liminf fun i => ∫⁻ x, f x ∂(μs i) := iSup_le h_bound end SequentialBound diff --git a/LeanPool/BicausalOT/BicausalOT/UpperBound.lean b/LeanPool/BicausalOT/BicausalOT/UpperBound.lean index 82fd0ef830..555ef349a5 100644 --- a/LeanPool/BicausalOT/BicausalOT/UpperBound.lean +++ b/LeanPool/BicausalOT/BicausalOT/UpperBound.lean @@ -29,20 +29,6 @@ variable [MeasurableSpace X₀] [MeasurableSpace X₁] variable [MeasurableSpace Y₀] [MeasurableSpace Y₁] variable (c₀ : X₀ × Y₀ → ENNReal) (c₁ : (X₀ × Y₀) × (X₁ × Y₁) → ENNReal) -theorem eps_optimal_element - {α : Type*} (S : Set α) (h_ne : S.Nonempty) - (f : α → ENNReal) (ε : ENNReal) (hε : 0 < ε) : - ∃ a ∈ S, f a ≤ (⨅ (x : α) (_ : x ∈ S), f x) + ε := by - by_contra h - simp only [not_exists, not_and, not_le] at h - obtain ⟨a, ha⟩ := h_ne - have hlt := h a ha - have : (⨅ (x : α) (_ : x ∈ S), f x) + ε ≤ ⨅ (x : α) (_ : x ∈ S), f x := - le_iInf fun x => le_iInf fun hx => le_of_lt (h x hx) - by_cases htop : (⨅ (x : α) (_ : x ∈ S), f x) = ⊤ - · simp [htop] at hlt - · exact absurd this (not_le.mpr (ENNReal.lt_add_right htop hε.ne')) - omit [MeasurableSpace X₀] [MeasurableSpace Y₀] in theorem eps_optimal_kernel_bound (κ_μ : X₀ → Measure X₁) (κ_ν : Y₀ → Measure Y₁)