From 718ea048500df32930b93c460ae4555a6e3abe3e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ga=C3=ABtan=20Serr=C3=A9?= Date: Wed, 23 Sep 2026 15:04:04 +0200 Subject: [PATCH 1/9] Nested loops --- RandomDo/Monad/Notation.lean | 5 ++ Test/Gaps.lean | 20 ------- Test/Loops.lean | 102 +++++++++++++++++++++++++++++++++-- 3 files changed, 104 insertions(+), 23 deletions(-) diff --git a/RandomDo/Monad/Notation.lean b/RandomDo/Monad/Notation.lean index 2d2542b..b68e245 100644 --- a/RandomDo/Monad/Notation.lean +++ b/RandomDo/Monad/Notation.lean @@ -260,6 +260,11 @@ def rdoForDecl := leading_parser dec.continueWithUnit mkBindApp σ γ forIn rest +/-- Infer the `ControlInfo` of an `rdo` loop as that of the core `for` loop with the same body. -/ +@[doElem_control_info rdoFor] def controlInfoRDoFor : ControlInfoHandler := fun stx => do + let `(rdoFor| for $_:rdoForDecl,* rdo $body) := stx | throwUnsupportedSyntax + inferControlInfoElem (← `(doElem| for _ in #[()] do $body)) + end LoopElab end RDo diff --git a/Test/Gaps.lean b/Test/Gaps.lean index 39aeb1c..832647c 100644 --- a/Test/Gaps.lean +++ b/Test/Gaps.lean @@ -18,26 +18,6 @@ open MeasureTheory ProbabilityTheory namespace Test.Gaps -/-! ## Nested loops - -TODO: register a `ControlInfo` inference handler for `RDo.rdoFor`, mirroring the rule core states -inline for `doFor` in `Lean/Elab/Do/InferControlInfo.lean`. --/ - -/-- -error: No `ControlInfo` inference handler found for `RDo.rdoFor` in syntax - for y in ys rdo - s := s + x * y -Register a handler with `@[doElem_control_info RDo.rdoFor]`. --/ -#guard_msgs (whitespace := lax) in -def nestedLoops (xs ys : List ℕ) : IdM ℕ := rdo - let mut s := 0 - for x in xs rdo - for y in ys rdo - s := s + x * y - return s - /-! ## Unbounded and conditional iteration TODO: `while`, `repeat` and `repeat … until` all expand to `for _ in Loop.mk do …`, which reaches diff --git a/Test/Loops.lean b/Test/Loops.lean index ff77c85..062c6b4 100644 --- a/Test/Loops.lean +++ b/Test/Loops.lean @@ -10,9 +10,9 @@ set_option linter.style.header false `rdo` has its own `for … rdo …` parser, expander and elaborator, mirroring core's but emitting `MeasurableSpaceForIn.forIn`. Instances exist for `List`, `Array` and `Vector`. -There is no test for a loop nested inside another: `rdoFor` has no registered `ControlInfo` -inference handler, so the outer loop cannot work out what the inner one does to the control flow, -and such a program is rejected before elaboration. +A loop can sit under another construct, including another loop: the enclosing one learns what the +loop does to the control flow from the `ControlInfo` handler of `rdoFor`, which is that of core's +`for` loop with the same body. -/ open MeasureTheory ProbabilityTheory @@ -139,6 +139,102 @@ noncomputable def countHeads (n : ℕ) : Measure ℕ := rdo c := c + 1 return c +/-! ## Loops under other constructs -/ + +/-- A loop nested inside another, reassigning a variable of the enclosing block. -/ +def nestedLoops (xs ys : List ℕ) : IdM ℕ := rdo + let mut s := 0 + for x in xs rdo + for y in ys rdo + s := s + x * y + return s + +example : IdM.run (nestedLoops [1, 2] [3, 4]) = 21 := rfl + +example : IdM.run (nestedLoops [1, 2] []) = 0 := rfl + +/-- `break` in the inner loop leaves the inner loop only. -/ +def innerBreak (xs ys : List ℕ) : IdM ℕ := rdo + let mut s := 0 + for x in xs rdo + for y in ys rdo + if y = 0 then + break + s := s + x * y + return s + +example : IdM.run (innerBreak [1, 2] [3, 0, 5]) = 9 := rfl + +/-- `continue` in the inner loop skips to the next inner iteration. -/ +def innerContinue (xs ys : List ℕ) : IdM ℕ := rdo + let mut s := 0 + for x in xs rdo + for y in ys rdo + if y = 0 then + continue + s := s + x * y + return s + +example : IdM.run (innerContinue [1, 2] [3, 0, 5]) = 24 := rfl + +/-- An early `return` in the inner loop leaves the whole program. -/ +def firstProductOver (xs ys : List ℕ) (limit : ℕ) : IdM ℕ := rdo + for x in xs rdo + for y in ys rdo + if x * y > limit then + return x * y + return 0 + +example : IdM.run (firstProductOver [1, 2, 3] [1, 2] 3) = 4 := rfl + +example : IdM.run (firstProductOver [1, 2] [1, 2] 10) = 0 := rfl + +/-- An inner loop over several collections, which the expander rewrites first. -/ +def nestedZip (xs ys zs : List ℕ) : IdM ℕ := rdo + let mut s := 0 + for x in xs rdo + for y in ys, z in zs rdo + s := s + x * y * z + return s + +example : IdM.run (nestedZip [1, 2] [1, 2] [3, 4]) = 33 := rfl + +/-- A loop in a branch of an `if`. -/ +def sumIf (b : Bool) (xs : List ℕ) : IdM ℕ := rdo + let mut s := 0 + if b then + for x in xs rdo + s := s + x + return s + +example : IdM.run (sumIf true [1, 2, 3]) = 6 := rfl + +example : IdM.run (sumIf false [1, 2, 3]) = 0 := rfl + +/-- A loop in an arm of a `match`. -/ +def sumHead (xss : List (List ℕ)) : IdM ℕ := rdo + let mut s := 0 + match xss with + | [] => pure () + | xs :: _ => + for x in xs rdo + s := s + x + return s + +example : IdM.run (sumHead [[1, 2], [10]]) = 3 := rfl + +example : IdM.run (sumHead []) = 0 := rfl + +/-- Nested loops whose body binds monadically, at `Measure`. -/ +noncomputable def countPairsOfHeads (n : ℕ) : Measure ℕ := rdo + let mut c := 0 + for _ in List.range n rdo + for _ in List.range n rdo + let b ← fairCoin + if b then + c := c + 1 + return c + end Test.Loops end From 1b9f9b24d9613e84c215682987fd209bed8d96cd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ga=C3=ABtan=20Serr=C3=A9?= Date: Wed, 23 Sep 2026 16:56:31 +0200 Subject: [PATCH 2/9] While loop (no measure) --- RandomDo/Monad/Instances.lean | 5 ++ RandomDo/Monad/Notation.lean | 11 ++++ Test/Gaps.lean | 30 ++++++++-- Test/Loops.lean | 102 +++++++++++++++++++++++++++++++++- 4 files changed, 141 insertions(+), 7 deletions(-) diff --git a/RandomDo/Monad/Instances.lean b/RandomDo/Monad/Instances.lean index fd064d9..a7d8c7d 100644 --- a/RandomDo/Monad/Instances.lean +++ b/RandomDo/Monad/Instances.lean @@ -29,6 +29,11 @@ instance {m : Type u → Type v} [Monad m] : mPure := pure mBind := bind +/-- The unbounded loop behind `while … rdo`, at a core monad, is core's loop over `Lean.Loop`. -/ +instance {m : Type u → Type v} [Monad m] : + MeasurableSpaceForIn (Monad.toMeasurableSpaceMonad m) Lean.Loop Unit where + forIn xs b f := ForIn.forIn (m := m) xs b f + /-- A measurable space monad for pseudo random number generation. -/ abbrev PseudoRandomM := Monad.toMeasurableSpaceMonad Rand diff --git a/RandomDo/Monad/Notation.lean b/RandomDo/Monad/Notation.lean index b68e245..7bd48ec 100644 --- a/RandomDo/Monad/Notation.lean +++ b/RandomDo/Monad/Notation.lean @@ -260,6 +260,17 @@ def rdoForDecl := leading_parser dec.continueWithUnit mkBindApp σ γ forIn rest +/-- parser for `rdo` while loops -/ +@[doElem_parser] def rdoWhile := leading_parser + "while " >> withForbidden "rdo" doIfCond >> " rdo " >> doSeq + +/-- Define expander for `while` loops in `rdo` notation. As in core, `while c rdo body` is a loop +over `Loop.mk` that runs `body` while `c` holds and breaks otherwise. -/ +@[macro rdoWhile] def expandRDoWhile : Macro + | `(rdoWhile| while%$tk $cond:doIfCond rdo $body) => + `(doElem| for%$tk _ in Lean.Loop.mk rdo if $cond:doIfCond then $body else break) + | _ => Macro.throwUnsupported + /-- Infer the `ControlInfo` of an `rdo` loop as that of the core `for` loop with the same body. -/ @[doElem_control_info rdoFor] def controlInfoRDoFor : ControlInfoHandler := fun stx => do let `(rdoFor| for $_:rdoForDecl,* rdo $body) := stx | throwUnsupportedSyntax diff --git a/Test/Gaps.lean b/Test/Gaps.lean index 832647c..fd459d7 100644 --- a/Test/Gaps.lean +++ b/Test/Gaps.lean @@ -20,11 +20,29 @@ namespace Test.Gaps /-! ## Unbounded and conditional iteration -TODO: `while`, `repeat` and `repeat … until` all expand to `for _ in Loop.mk do …`, which reaches -core's `doFor` and so asks for a `ForIn` instance. Supporting them needs the macros re-pointed at -`rdoFor` and, at `Measure`, a denotation for an iteration that need not terminate. +`while … rdo` is a loop over `Lean.Loop`, which has an instance at the core monads only. +TODO: at `Measure`, a denotation for an iteration that need not terminate: the least fixed point of +its unfolding, where the runs that never stop carry no mass. And `repeat` and `repeat … until`, +which still expand to core's `for _ in Loop.mk do …`, need `rdo` counterparts. -/ +/-- +error: failed to synthesize instance of type class + MeasurableSpaceForIn Measure Lean.Loop ?α + +Hint: Type class instance resolution failures can be inspected with the `set_option trace.Meta.synthInstance true` command. +-/ +#guard_msgs in +noncomputable def whileAtMeasure : Measure ℕ := rdo + let mut n := 0 + let mut go := true + while go rdo + let b ← fairCoin + n := n + 1 + if b then + go := false + return n + /-- error: failed to synthesize instance of type class ForIn IdM Lean.Loop ?α @@ -32,10 +50,12 @@ error: failed to synthesize instance of type class Hint: Type class instance resolution failures can be inspected with the `set_option trace.Meta.synthInstance true` command. -/ #guard_msgs in -def whileLoop : IdM ℕ := rdo +def repeatLoop : IdM ℕ := rdo let mut i := 0 - while i < 3 do + repeat i := i + 1 + if 3 ≤ i then + break return i /-! ## Exceptions diff --git a/Test/Loops.lean b/Test/Loops.lean index 062c6b4..f261e9b 100644 --- a/Test/Loops.lean +++ b/Test/Loops.lean @@ -1,14 +1,18 @@ module public import Test.Common +meta import Test.Common +public import Std.Tactic.Do set_option linter.style.header false +set_option linter.hashCommand false /-! -# `rdo`: `for` loops over a single collection +# `rdo`: `for` and `while` loops `rdo` has its own `for … rdo …` parser, expander and elaborator, mirroring core's but emitting -`MeasurableSpaceForIn.forIn`. Instances exist for `List`, `Array` and `Vector`. +`MeasurableSpaceForIn.forIn`. Instances exist for `List`, `Array` and `Vector`, and for `Lean.Loop`, +which `while … rdo` loops over, at the core monads. A loop can sit under another construct, including another loop: the enclosing one learns what the loop does to the control flow from the `ControlInfo` handler of `rdoFor`, which is that of core's @@ -235,6 +239,100 @@ noncomputable def countPairsOfHeads (n : ℕ) : Measure ℕ := rdo c := c + 1 return c +/-! ## `while` loops + +`while c rdo body` is a loop over `Lean.Loop`, as in core. At a core monad it is core's loop, which +the kernel cannot unfold, so these programs are checked with `#guard` rather than `rfl`, and proved +through `mvcgen`. There is no instance at `Measure` yet. +-/ + +/-- A `while` loop, counting down from `n`. -/ +def countdown (n : ℕ) : IdM ℕ := rdo + let mut i := n + let mut steps := 0 + while 0 < i rdo + i := i - 1 + steps := steps + 1 + return steps + +#guard IdM.run (countdown 5) = 5 + +#guard IdM.run (countdown 0) = 0 + +open Std.Do in +set_option mvcgen.warning false in +theorem countdown_eq (n : ℕ) : IdM.run (countdown n) = n := by + generalize h : IdM.run (countdown n) = r + apply Id.of_wp_run_eq h + simp only [countdown, MeasurableSpaceForIn.forIn, MeasurableSpaceBind.mBind, + MeasurableSpacePure.mPure] + dsimp only [IdM, Monad.toMeasurableSpaceMonad] + mvcgen invariants + · fun st => ⟨st.1⟩ + · ⇓ c => match c with + | .inl st => ⌜st.1 + st.2 = n⌝ + | .inr st => ⌜st.2 = n⌝ + all_goals simp_all <;> omega + +/-- `break` out of a `while` loop. -/ +def halveUntilOdd (n : ℕ) : IdM ℕ := rdo + let mut k := n + while 0 < k rdo + if k % 2 = 1 then + break + k := k / 2 + return k + +#guard IdM.run (halveUntilOdd 24) = 3 + +#guard IdM.run (halveUntilOdd 0) = 0 + +/-- An early `return` out of a `while` loop. -/ +def firstSquareAbove (n : ℕ) : IdM ℕ := rdo + let mut k := 0 + while true rdo + if k * k > n then + return k + k := k + 1 + return 0 + +#guard IdM.run (firstSquareAbove 10) = 4 + +/-- `while let`, consuming a list one element at a time. -/ +def sumByPopping (xs : List ℕ) : IdM ℕ := rdo + let mut rest := xs + let mut s := 0 + while let x :: xs' := rest rdo + s := s + x + rest := xs' + return s + +#guard IdM.run (sumByPopping [1, 2, 3]) = 6 + +/-- `while h : c`, which hands the body a proof of the condition. -/ +def countdownWithProof (n : ℕ) : IdM ℕ := rdo + let mut i := n + let mut steps := 0 + while h : 0 < i rdo + have : i - 1 < i := Nat.sub_lt h Nat.one_pos + i := i - 1 + steps := steps + 1 + return steps + +#guard IdM.run (countdownWithProof 4) = 4 + +/-- A `while` loop nested inside a `for` loop. -/ +def sumOfLogs (xs : List ℕ) : IdM ℕ := rdo + let mut s := 0 + for x in xs rdo + let mut k := x + while 1 < k rdo + k := k / 2 + s := s + 1 + return s + +#guard IdM.run (sumOfLogs [1, 2, 8]) = 4 + end Test.Loops end From 386bf788910a3de8486750294d257708be7cc213 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ga=C3=ABtan=20Serr=C3=A9?= Date: Thu, 24 Sep 2026 17:19:40 +0200 Subject: [PATCH 3/9] `MeasurableSpaceMonadWhile` --- RandomDo.lean | 3 ++ RandomDo/Monad/Instances.lean | 5 --- RandomDo/Monad/While.lean | 77 +++++++++++++++++++++++++++++++++++ Test/Computable.lean | 13 ++++++ Test/Gaps.lean | 23 +---------- Test/Loops.lean | 35 ++++++---------- Test/Polymorphic.lean | 17 ++++++-- 7 files changed, 122 insertions(+), 51 deletions(-) create mode 100644 RandomDo/Monad/While.lean diff --git a/RandomDo.lean b/RandomDo.lean index b2d4043..e20e74e 100644 --- a/RandomDo.lean +++ b/RandomDo.lean @@ -1,11 +1,14 @@ module -- shake: keep-all --deprecated_module: ignore public import RandomDo.ForMathlib.MeasureTheory.MeasurableSpace.Embedding +public import RandomDo.ForMathlib.MeasureTheory.Measure.GiryMonad +public import RandomDo.ForMathlib.Probability.Distributions.Bernoulli public import RandomDo.Measurable public import RandomDo.Monad.ForInInstances public import RandomDo.Monad.Instances public import RandomDo.Monad.MeasurableSpace public import RandomDo.Monad.Notation +public import RandomDo.Monad.While public import RandomDo.NumLean.Binomial public import RandomDo.NumLean.Distributions public import RandomDo.NumLean.PCG64 diff --git a/RandomDo/Monad/Instances.lean b/RandomDo/Monad/Instances.lean index a7d8c7d..fd064d9 100644 --- a/RandomDo/Monad/Instances.lean +++ b/RandomDo/Monad/Instances.lean @@ -29,11 +29,6 @@ instance {m : Type u → Type v} [Monad m] : mPure := pure mBind := bind -/-- The unbounded loop behind `while … rdo`, at a core monad, is core's loop over `Lean.Loop`. -/ -instance {m : Type u → Type v} [Monad m] : - MeasurableSpaceForIn (Monad.toMeasurableSpaceMonad m) Lean.Loop Unit where - forIn xs b f := ForIn.forIn (m := m) xs b f - /-- A measurable space monad for pseudo random number generation. -/ abbrev PseudoRandomM := Monad.toMeasurableSpaceMonad Rand diff --git a/RandomDo/Monad/While.lean b/RandomDo/Monad/While.lean new file mode 100644 index 0000000..87a0f71 --- /dev/null +++ b/RandomDo/Monad/While.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Gaëtan Serré. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gaëtan Serré +-/ +module + +public import RandomDo.Monad.Instances +import RandomDo.Monad.Notation +public import Mathlib.Probability.Distributions.Bernoulli + +/-! +# `while` loops + +`while c rdo body` is a loop over `Lean.Loop`, which runs `body` for as long as `c` holds. Each step +of the loop returns a `ForInStep`: `yield b` to carry on from the state `b`, `done b` to stop there. +Such a loop need not terminate, so its meaning depends on the monad, which provides it through the +class `MeasurableSpaceMonadWhile`. + +## Main definitions + +* `MeasurableSpaceMonadWhile`: a measurable space monad with an unbounded loop. Its instances: + - at a core monad, core's loop over `Lean.Loop`; + - at `Measure`, the least fixed point of "one step, then stop or run the loop again": the sum + over `n` of the runs that stop at the `n + 1`-th step. The runs that never stop carry no mass. +* `MeasurableSpaceMonad.loopExit f n b`: the runs of the loop whose step is `f` that, from `b`, stop + at the `n + 1`-th step, in any measurable space monad with a zero. +* The instance of `MeasurableSpaceForIn m Lean.Loop Unit`, for any `MeasurableSpaceMonadWhile m`: + `while … rdo` runs the loop of the monad. + +## Implementation notes + +The while loop could instead be a field of `MeasurableSpaceMonad` itself. Every program over an +arbitrary measurable space monad could then use `while` with no further hypothesis, as it uses +`for`, at the price of asking every measurable space monad for its own implementation of the loop. + +## References + +* Dexter Kozen, *Semantics of probabilistic programs*, 1981. +-/ + +@[expose] public section + +universe u v + +open MeasureTheory MeasurableSpacePure MeasurableSpaceBind + +/-- A measurable space monad with an unbounded loop, the one behind `while … rdo`. -/ +class MeasurableSpaceMonadWhile (m : (α : Type u) → [MeasurableSpace α] → Type v) where + /-- Run the step `f` from `b`, then from each state it carries on with, until it stops. -/ + loop {β : Type u} [MeasurableSpace β] (f : β → m (ForInStep β)) (b : β) : m β + +/-- At a core monad, the loop is core's loop over `Lean.Loop`. -/ +instance {m : Type u → Type v} [Monad m] : + MeasurableSpaceMonadWhile (Monad.toMeasurableSpaceMonad m) where + loop f b := ForIn.forIn (m := m) Lean.Loop.mk b fun _ ↦ f + +variable {m : (α : Type u) → [MeasurableSpace α] → Type v} [MeasurableSpaceMonad m] + {β : Type u} [MeasurableSpace β] [Zero (m β)] + +/-- The runs of the loop whose step is `f` that, from `b`, stop at the `n + 1`-th step. A run that +does not stop there contributes `0`. -/ +def MeasurableSpaceMonad.loopExit (f : β → m (ForInStep β)) : ℕ → β → m β + -- One step from `b`: keep the runs that stop there, drop the ones that carry on. + | 0, b => f b >>=ₘ fun s ↦ ForInStep.casesOn (motive := fun _ ↦ m β) s mPure fun _ ↦ 0 + -- One step from `b`: drop the runs that stop there, keep those that stop `n + 1` steps later. + | n + 1, b => f b >>=ₘ fun s ↦ + ForInStep.casesOn (motive := fun _ ↦ m β) s (fun _ ↦ 0) (loopExit f n) + +/-- At `Measure`, the loop is the least fixed point of "one step, then stop or run the loop again": +the sum over `n` of the runs that stop at the `n + 1`-th step. -/ +noncomputable instance : MeasurableSpaceMonadWhile Measure where + loop f b := Measure.sum fun n ↦ MeasurableSpaceMonad.loopExit f n b + +/-- The unbounded loop behind `while … rdo` is the loop of the monad. -/ +instance [MeasurableSpaceMonadWhile m] : MeasurableSpaceForIn m Lean.Loop Unit where + forIn _ b f := MeasurableSpaceMonadWhile.loop (f ()) b diff --git a/Test/Computable.lean b/Test/Computable.lean index 0b7752b..a1e128c 100644 --- a/Test/Computable.lean +++ b/Test/Computable.lean @@ -59,4 +59,17 @@ def ex1 : Measure ℝ := rdo run_cmd logComputable (ex1Computable) +@[computable] +noncomputable +def flipsUntilHeads : Measure ℕ := rdo + let mut n := 0 + while true rdo + let heads ← fairCoin + n := n + 1 + if heads then + break + return n + +run_cmd logComputable (flipsUntilHeadsComputable) + end Test.Computable diff --git a/Test/Gaps.lean b/Test/Gaps.lean index fd459d7..b5a0a6e 100644 --- a/Test/Gaps.lean +++ b/Test/Gaps.lean @@ -20,29 +20,10 @@ namespace Test.Gaps /-! ## Unbounded and conditional iteration -`while … rdo` is a loop over `Lean.Loop`, which has an instance at the core monads only. -TODO: at `Measure`, a denotation for an iteration that need not terminate: the least fixed point of -its unfolding, where the runs that never stop carry no mass. And `repeat` and `repeat … until`, -which still expand to core's `for _ in Loop.mk do …`, need `rdo` counterparts. +`while … rdo` is supported. TODO: `repeat` and `repeat … until`, which still expand to core's +`for _ in Loop.mk do …`, need `rdo` counterparts. -/ -/-- -error: failed to synthesize instance of type class - MeasurableSpaceForIn Measure Lean.Loop ?α - -Hint: Type class instance resolution failures can be inspected with the `set_option trace.Meta.synthInstance true` command. --/ -#guard_msgs in -noncomputable def whileAtMeasure : Measure ℕ := rdo - let mut n := 0 - let mut go := true - while go rdo - let b ← fairCoin - n := n + 1 - if b then - go := false - return n - /-- error: failed to synthesize instance of type class ForIn IdM Lean.Loop ?α diff --git a/Test/Loops.lean b/Test/Loops.lean index f261e9b..84e6ae9 100644 --- a/Test/Loops.lean +++ b/Test/Loops.lean @@ -12,7 +12,7 @@ set_option linter.hashCommand false `rdo` has its own `for … rdo …` parser, expander and elaborator, mirroring core's but emitting `MeasurableSpaceForIn.forIn`. Instances exist for `List`, `Array` and `Vector`, and for `Lean.Loop`, -which `while … rdo` loops over, at the core monads. +which `while … rdo` loops over. A loop can sit under another construct, including another loop: the enclosing one learns what the loop does to the control flow from the `ControlInfo` handler of `rdoFor`, which is that of core's @@ -239,12 +239,7 @@ noncomputable def countPairsOfHeads (n : ℕ) : Measure ℕ := rdo c := c + 1 return c -/-! ## `while` loops - -`while c rdo body` is a loop over `Lean.Loop`, as in core. At a core monad it is core's loop, which -the kernel cannot unfold, so these programs are checked with `#guard` rather than `rfl`, and proved -through `mvcgen`. There is no instance at `Measure` yet. --/ +/-! ## `while` loops -/ /-- A `while` loop, counting down from `n`. -/ def countdown (n : ℕ) : IdM ℕ := rdo @@ -259,21 +254,6 @@ def countdown (n : ℕ) : IdM ℕ := rdo #guard IdM.run (countdown 0) = 0 -open Std.Do in -set_option mvcgen.warning false in -theorem countdown_eq (n : ℕ) : IdM.run (countdown n) = n := by - generalize h : IdM.run (countdown n) = r - apply Id.of_wp_run_eq h - simp only [countdown, MeasurableSpaceForIn.forIn, MeasurableSpaceBind.mBind, - MeasurableSpacePure.mPure] - dsimp only [IdM, Monad.toMeasurableSpaceMonad] - mvcgen invariants - · fun st => ⟨st.1⟩ - · ⇓ c => match c with - | .inl st => ⌜st.1 + st.2 = n⌝ - | .inr st => ⌜st.2 = n⌝ - all_goals simp_all <;> omega - /-- `break` out of a `while` loop. -/ def halveUntilOdd (n : ℕ) : IdM ℕ := rdo let mut k := n @@ -333,6 +313,17 @@ def sumOfLogs (xs : List ℕ) : IdM ℕ := rdo #guard IdM.run (sumOfLogs [1, 2, 8]) = 4 +/-- A `while` loop at `Measure`: flip a fair coin until it lands heads, counting the flips. -/ +noncomputable def flipsUntilHeads : Measure ℕ := rdo + let mut n := 0 + let mut go := true + while go rdo + let b ← fairCoin + n := n + 1 + if b then + go := false + return n + end Test.Loops end diff --git a/Test/Polymorphic.lean b/Test/Polymorphic.lean index 566bf7d..5631185 100644 --- a/Test/Polymorphic.lean +++ b/Test/Polymorphic.lean @@ -10,9 +10,9 @@ set_option linter.style.header false # Polymorphic `rdo` programs The programs of `Test.Computable`, written once over an arbitrary `MeasurableSpaceMonad` `m` and -drawing through `HasGaussian` and `HasBernoulli`. Read at `m := Measure`, each one is a probability -measure, checked by `is_markov`, and is the program of `Test.IsMarkov` when there is one. Run at -`m := RandM`, it samples. +drawing through `HasGaussian` and `HasBernoulli`. Read at `m := Measure`, each one without a `while` +loop is a probability measure, checked by `is_markov`, and is the program of `Test.IsMarkov` when +there is one. Run at `m := RandM`, it samples. -/ @[expose] public section @@ -114,6 +114,17 @@ example : IsProbabilityMeasure (ex1 (m := Measure) (R := ℝ) (V := NNReal)) := run_cmd logPolymorphic (ex1 (m := RandM) (R := Float) (V := Float)) +def flipsUntilHeads [HasBernoulli m R] [MeasurableSpaceMonadWhile m] (p : R) : m ℕ := rdo + let mut n := 0 + while true rdo + let heads ← coin (m := m) p + n := n + 1 + if heads then + break + return n + +run_cmd logPolymorphic (flipsUntilHeads (m := RandM) (0.5 : Float)) + end Test.Polymorphic end From 07111bd9337f46e03c2771633ada06d7b7bb12af Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ga=C3=ABtan=20Serr=C3=A9?= Date: Thu, 24 Sep 2026 17:21:03 +0200 Subject: [PATCH 4/9] Bind lemmas --- .../MeasureTheory/Measure/GiryMonad.lean | 29 +++++++++++++++++ .../Probability/Distributions/Bernoulli.lean | 31 +++++++++++++++++++ 2 files changed, 60 insertions(+) create mode 100644 RandomDo/ForMathlib/MeasureTheory/Measure/GiryMonad.lean create mode 100644 RandomDo/ForMathlib/Probability/Distributions/Bernoulli.lean diff --git a/RandomDo/ForMathlib/MeasureTheory/Measure/GiryMonad.lean b/RandomDo/ForMathlib/MeasureTheory/Measure/GiryMonad.lean new file mode 100644 index 0000000..c76fedd --- /dev/null +++ b/RandomDo/ForMathlib/MeasureTheory/Measure/GiryMonad.lean @@ -0,0 +1,29 @@ +/- +Copyright (c) 2026 Gaëtan Serré. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gaëtan Serré +-/ +module + +public import Mathlib.MeasureTheory.Measure.GiryMonad + +/-! +# The bind of a sum of two measures + +-/ + +@[expose] public section + +open MeasureTheory + +namespace MeasureTheory.Measure + +variable {α β : Type*} [MeasurableSpace α] [MeasurableSpace β] + +theorem bind_add {μ ν : Measure α} {f : α → Measure β} (hf : AEMeasurable f (μ + ν)) : + (μ + ν).bind f = μ.bind f + ν.bind f := by + obtain ⟨hμ, hν⟩ := aemeasurable_add_measure_iff.1 hf + ext s hs + rw [add_apply, bind_apply hs hf, bind_apply hs hμ, bind_apply hs hν, lintegral_add_measure] + +end MeasureTheory.Measure diff --git a/RandomDo/ForMathlib/Probability/Distributions/Bernoulli.lean b/RandomDo/ForMathlib/Probability/Distributions/Bernoulli.lean new file mode 100644 index 0000000..ef00da8 --- /dev/null +++ b/RandomDo/ForMathlib/Probability/Distributions/Bernoulli.lean @@ -0,0 +1,31 @@ +/- +Copyright (c) 2026 Gaëtan Serré. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gaëtan Serré +-/ +module + +public import Mathlib.Probability.Distributions.Bernoulli +public import RandomDo.ForMathlib.MeasureTheory.Measure.GiryMonad + +/-! +# Binding a Bernoulli distribution + +-/ + +@[expose] public section + +open MeasureTheory Measure unitInterval +open scoped ENNReal + +namespace ProbabilityTheory + +variable {X Y : Type*} [MeasurableSpace X] [MeasurableSpace Y] + +lemma bernoulliMeasure_bind (x y : X) (p : I) {g : X → Measure Y} (hg : Measurable g) : + Ber(x, y, p).bind g = (toNNReal p : ℝ≥0∞) • g x + (toNNReal (σ p) : ℝ≥0∞) • g y := by + rw [bernoulliMeasure_def, bind_add hg.aemeasurable, bind_smul, bind_smul, dirac_bind hg, + dirac_bind hg] + rfl + +end ProbabilityTheory From 6aa7f12d42f96c66d7ef0ddf99f93f8b02f5a81b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ga=C3=ABtan=20Serr=C3=A9?= Date: Mon, 28 Sep 2026 15:18:49 +0200 Subject: [PATCH 5/9] Lemmas on while loops --- RandomDo/Monad/While.lean | 195 +++++++++++++++++++++++++++ RandomDo/Tactic/IsMarkov/Elab.lean | 14 ++ RandomDo/Tactic/IsMarkov/Lemmas.lean | 43 +++++- Test/IsMarkov.lean | 43 +++++- Test/Polymorphic.lean | 6 +- 5 files changed, 296 insertions(+), 5 deletions(-) diff --git a/RandomDo/Monad/While.lean b/RandomDo/Monad/While.lean index 87a0f71..2e17be3 100644 --- a/RandomDo/Monad/While.lean +++ b/RandomDo/Monad/While.lean @@ -6,6 +6,7 @@ Authors: Gaëtan Serré module public import RandomDo.Monad.Instances +public import RandomDo.Tactic.IsMarkov.Defs import RandomDo.Monad.Notation public import Mathlib.Probability.Distributions.Bernoulli @@ -25,15 +26,29 @@ class `MeasurableSpaceMonadWhile`. over `n` of the runs that stop at the `n + 1`-th step. The runs that never stop carry no mass. * `MeasurableSpaceMonad.loopExit f n b`: the runs of the loop whose step is `f` that, from `b`, stop at the `n + 1`-th step, in any measurable space monad with a zero. +* `MeasurableSpaceMonad.loopRun f n b`: the runs of that loop that, from `b`, are still going after + `n` steps. * The instance of `MeasurableSpaceForIn m Lean.Loop Unit`, for any `MeasurableSpaceMonadWhile m`: `while … rdo` runs the loop of the monad. +## Main results + +* `MeasurableSpaceMonadWhile.measure_loop_univ_le_one`: at `Measure`, a loop whose step has mass at + most `1` has mass at most `1`. +* `MeasurableSpaceMonadWhile.isProbabilityMeasure_loop_iff`: at `Measure`, a loop whose step is a + Markov kernel is a probability measure exactly when the mass of its runs still going after `n` + steps tends to `0`. + ## Implementation notes The while loop could instead be a field of `MeasurableSpaceMonad` itself. Every program over an arbitrary measurable space monad could then use `while` with no further hypothesis, as it uses `for`, at the price of asking every measurable space monad for its own implementation of the loop. +The loop at `Measure` is not defined by `partial_fixpoint`, which also gives the least fixed point, +because it needs the step to be monotone in the loop, over every family `β → Measure β`: this fails +for `Measure.bind`, which is `0` as soon as its continuation is not measurable. + ## References * Dexter Kozen, *Semantics of probabilistic programs*, 1981. @@ -67,6 +82,15 @@ def MeasurableSpaceMonad.loopExit (f : β → m (ForInStep β)) : ℕ → β → | n + 1, b => f b >>=ₘ fun s ↦ ForInStep.casesOn (motive := fun _ ↦ m β) s (fun _ ↦ 0) (loopExit f n) +/-- The runs of the loop whose step is `f` that, from `b`, have not stopped after `n` steps, at the +state they are in. A run that has stopped contributes `0`. -/ +def MeasurableSpaceMonad.loopRun (f : β → m (ForInStep β)) : ℕ → β → m β + -- No step yet: the run is at `b`. + | 0, b => mPure b + -- One step from `b`: drop the runs that stop there, keep those still going `n` steps later. + | n + 1, b => f b >>=ₘ fun s ↦ + ForInStep.casesOn (motive := fun _ ↦ m β) s (fun _ ↦ 0) (loopRun f n) + /-- At `Measure`, the loop is the least fixed point of "one step, then stop or run the loop again": the sum over `n` of the runs that stop at the `n + 1`-th step. -/ noncomputable instance : MeasurableSpaceMonadWhile Measure where @@ -75,3 +99,174 @@ noncomputable instance : MeasurableSpaceMonadWhile Measure where /-- The unbounded loop behind `while … rdo` is the loop of the monad. -/ instance [MeasurableSpaceMonadWhile m] : MeasurableSpaceForIn m Lean.Loop Unit where forIn _ b f := MeasurableSpaceMonadWhile.loop (f ()) b + +section Measure + +open scoped ENNReal Topology +open Filter + +variable {σ : Type u} [MeasurableSpace σ] + +private lemma loopExit_zero (f : σ → Measure (ForInStep σ)) (b : σ) : + MeasurableSpaceMonad.loopExit f 0 b = + (f b).bind fun t ↦ ForInStep.casesOn (motive := fun _ ↦ Measure σ) t Measure.dirac + fun _ ↦ 0 := rfl + +private lemma loopExit_succ (f : σ → Measure (ForInStep σ)) (n : ℕ) (b : σ) : + MeasurableSpaceMonad.loopExit f (n + 1) b = + (f b).bind fun t ↦ ForInStep.casesOn (motive := fun _ ↦ Measure σ) t (fun _ ↦ 0) + (MeasurableSpaceMonad.loopExit f n) := rfl + +/-- A `while` loop is a sub-probability measure: the runs that stop at the different steps are +disjoint, so their masses add up to at most `1`. -/ +lemma MeasurableSpaceMonadWhile.measure_loop_univ_le_one {f : σ → Measure (ForInStep σ)} + (hf : ∀ s, f s Set.univ ≤ 1) (b : σ) : + MeasurableSpaceMonadWhile.loop f b Set.univ ≤ 1 := by + /- The runs that stop at the steps `2, …, n + 1` are one step, followed by the runs that stop at + the steps `1, …, n`. -/ + have tail : ∀ n b, ∑ k ∈ Finset.range n, MeasurableSpaceMonad.loopExit f (k + 1) b Set.univ ≤ + ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) + (fun b' ↦ ∑ k ∈ Finset.range n, MeasurableSpaceMonad.loopExit f k b' Set.univ) ∂f b := by + intro n + induction n with + | zero => simp + | succ n ih => + intro b + rw [Finset.sum_range_succ, loopExit_succ] + -- Bound each of the two terms by an integral against the first step. + refine (add_le_add (ih b) (Measure.bind_apply_le _ MeasurableSet.univ)).trans ?_ + -- Merge the two integrals. + refine (le_lintegral_add _ _).trans (le_of_eq ?_) + -- The merged integrand is the one of the statement. + refine lintegral_congr fun t ↦ ?_ + cases t <;> simp [Finset.sum_range_succ] + -- The runs that stop within `n` steps have mass at most `1`. + have partialSum : ∀ n b, ∑ k ∈ Finset.range n, + MeasurableSpaceMonad.loopExit f k b Set.univ ≤ 1 := by + intro n + induction n with + | zero => simp + | succ n ih => + intro b + rw [Finset.sum_range_succ', loopExit_zero] + -- Bound each of the two terms by an integral against the first step. + refine (add_le_add (tail n b) (Measure.bind_apply_le _ MeasurableSet.univ)).trans ?_ + -- Merge the two integrals. + refine (le_lintegral_add _ _).trans ?_ + -- The integral of `1` against the first step is its mass, at most `1`. + refine le_trans ?_ (lintegral_one.trans_le (hf b)) + -- The merged integrand is at most `1`. + refine lintegral_mono fun t ↦ ?_ + cases t <;> simp [ih] + change Measure.sum (fun n ↦ MeasurableSpaceMonad.loopExit f n b) Set.univ ≤ 1 + rw [Measure.sum_apply _ MeasurableSet.univ, ENNReal.tsum_eq_iSup_nat] + exact iSup_le fun n ↦ partialSum n b + +private lemma loopRun_zero (f : σ → Measure (ForInStep σ)) (b : σ) : + MeasurableSpaceMonad.loopRun f 0 b = Measure.dirac b := rfl + +private lemma loopRun_succ (f : σ → Measure (ForInStep σ)) (n : ℕ) (b : σ) : + MeasurableSpaceMonad.loopRun f (n + 1) b = + (f b).bind fun t ↦ ForInStep.casesOn (motive := fun _ ↦ Measure σ) t (fun _ ↦ 0) + (MeasurableSpaceMonad.loopRun f n) := rfl + +private lemma measurable_casesOn {γ : Type*} [MeasurableSpace γ] {d y : σ → γ} + (hd : Measurable d) (hy : Measurable y) : + Measurable fun t : ForInStep σ ↦ ForInStep.casesOn (motive := fun _ ↦ γ) t d y := + fun _ hs ↦ ⟨hy hs, hd hs⟩ + +/-- Binding a case analysis on the outcome of a step, evaluated on the whole space. -/ +private lemma bind_casesOn_apply_univ (μ : Measure (ForInStep σ)) {d y : σ → Measure σ} + (hd : Measurable d) (hy : Measurable y) : + μ.bind (fun t ↦ ForInStep.casesOn (motive := fun _ ↦ Measure σ) t d y) Set.univ = + ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun s ↦ d s Set.univ) + (fun s ↦ y s Set.univ) ∂μ := by + rw [Measure.bind_apply MeasurableSet.univ (measurable_casesOn hd hy).aemeasurable] + exact lintegral_congr fun t ↦ by cases t <;> rfl + +private lemma measurable_loopExit {f : σ → Measure (ForInStep σ)} (hf : Measurable f) : + ∀ n, Measurable (MeasurableSpaceMonad.loopExit f n) + | 0 => (Measure.measurable_bind' + (measurable_casesOn Measure.measurable_dirac measurable_const)).comp hf + | n + 1 => (Measure.measurable_bind' + (measurable_casesOn measurable_const (measurable_loopExit hf n))).comp hf + +private lemma measurable_loopRun {f : σ → Measure (ForInStep σ)} (hf : Measurable f) : + ∀ n, Measurable (MeasurableSpaceMonad.loopRun f n) + | 0 => Measure.measurable_dirac + | n + 1 => (Measure.measurable_bind' + (measurable_casesOn measurable_const (measurable_loopRun hf n))).comp hf + +/-- The runs still going after `n` steps are those that stop at the next step, and those still going +after it. -/ +private lemma loopRun_apply_univ (f : σ → Measure (ForInStep σ)) [hf : IsMarkov f] (n : ℕ) + (b : σ) : + MeasurableSpaceMonad.loopRun f n b Set.univ = + MeasurableSpaceMonad.loopExit f n b Set.univ + + MeasurableSpaceMonad.loopRun f (n + 1) b Set.univ := by + induction n generalizing b with + | zero => + have := hf.isProbabilityMeasure b + rw [loopExit_zero, loopRun_succ, + bind_casesOn_apply_univ _ Measure.measurable_dirac measurable_const, + bind_casesOn_apply_univ _ measurable_const (measurable_loopRun hf.measurable 0)] + simp only [loopRun_zero, measure_univ, Measure.coe_zero, Pi.zero_apply] + -- Merge the two integrals: the integrand is `1` whether the step stops or not. + rw [← lintegral_add_left (measurable_casesOn measurable_const measurable_const)] + calc (1 : ℝ≥0∞) = ∫⁻ _, 1 ∂f b := by simp + _ = _ := lintegral_congr fun t ↦ by cases t <;> simp + | succ n ih => + have hExit : Measurable fun s ↦ MeasurableSpaceMonad.loopExit f n s Set.univ := + (Measure.measurable_coe MeasurableSet.univ).comp (measurable_loopExit hf.measurable n) + rw [loopRun_succ f n b, loopExit_succ, loopRun_succ f (n + 1) b, + bind_casesOn_apply_univ _ measurable_const (measurable_loopRun hf.measurable n), + bind_casesOn_apply_univ _ measurable_const (measurable_loopExit hf.measurable n), + bind_casesOn_apply_univ _ measurable_const (measurable_loopRun hf.measurable (n + 1))] + simp only [Measure.coe_zero, Pi.zero_apply] + -- Merge the two integrals, and use the statement for `n` from the state the step carries on. + rw [← lintegral_add_left (measurable_casesOn measurable_const hExit)] + exact lintegral_congr fun t ↦ by cases t <;> simp [ih] + +/-- The runs that stop within `n` steps and the runs still going after `n` steps have a total mass +of `1`. -/ +private lemma sum_loopExit_add_loopRun (f : σ → Measure (ForInStep σ)) [IsMarkov f] (n : ℕ) + (b : σ) : + ∑ k ∈ Finset.range n, MeasurableSpaceMonad.loopExit f k b Set.univ + + MeasurableSpaceMonad.loopRun f n b Set.univ = 1 := by + induction n with + | zero => simp [loopRun_zero] + | succ n ih => rw [Finset.sum_range_succ, add_assoc, ← loopRun_apply_univ, ih] + +/-- A `while` loop whose step is a Markov kernel is a probability measure exactly when it stops +almost surely: when the runs still going after `n` steps have a mass that tends to `0`. -/ +theorem MeasurableSpaceMonadWhile.isProbabilityMeasure_loop_iff (f : σ → Measure (ForInStep σ)) + [hf : IsMarkov f] (b : σ) : + IsProbabilityMeasure (MeasurableSpaceMonadWhile.loop f b) ↔ + Tendsto (fun n ↦ MeasurableSpaceMonad.loopRun f n b Set.univ) atTop (𝓝 0) := by + -- The runs that stop within `n` steps have a mass that tends to the mass of the loop. + have hExit : Tendsto (fun n ↦ ∑ k ∈ Finset.range n, MeasurableSpaceMonad.loopExit f k b Set.univ) + atTop (𝓝 (MeasurableSpaceMonadWhile.loop f b Set.univ)) := by + change Tendsto _ _ (𝓝 (Measure.sum (fun n ↦ MeasurableSpaceMonad.loopExit f n b) Set.univ)) + rw [Measure.sum_apply _ MeasurableSet.univ] + exact ENNReal.tendsto_nat_tsum _ + -- So the runs still going after `n` steps have a mass that tends to `1` minus it. + have hRun : Tendsto (fun n ↦ MeasurableSpaceMonad.loopRun f n b Set.univ) atTop + (𝓝 (1 - MeasurableSpaceMonadWhile.loop f b Set.univ)) := by + have h n : MeasurableSpaceMonad.loopRun f n b Set.univ = + 1 - ∑ k ∈ Finset.range n, MeasurableSpaceMonad.loopExit f k b Set.univ := by + have hsum := sum_loopExit_add_loopRun f n b + refine ENNReal.eq_sub_of_add_eq ?_ ((add_comm _ _).trans hsum) + exact ne_top_of_le_ne_top ENNReal.one_ne_top (hsum ▸ le_self_add) + simp_rw [h] + exact ENNReal.Tendsto.sub tendsto_const_nhds hExit (Or.inl ENNReal.one_ne_top) + rw [isProbabilityMeasure_iff] + constructor + · intro h + simpa [h] using hRun + · intro h + refine le_antisymm ?_ (tsub_eq_zero_iff_le.1 (tendsto_nhds_unique hRun h)) + refine measure_loop_univ_le_one (fun s ↦ ?_) b + have := hf.isProbabilityMeasure s + simp + +end Measure diff --git a/RandomDo/Tactic/IsMarkov/Elab.lean b/RandomDo/Tactic/IsMarkov/Elab.lean index fa013d8..70f52df 100644 --- a/RandomDo/Tactic/IsMarkov/Elab.lean +++ b/RandomDo/Tactic/IsMarkov/Elab.lean @@ -50,6 +50,8 @@ inductive Shape along, one for a fixed collection and one for a collection read off the parameter, so that the three collections `rdo` supports share a single branch below. -/ | forIn (fixed varying : Name) + /-- `while c rdo body`: a loop over `Lean.Loop`, which need not terminate. -/ + | forInLoop /-- `Break.runK r (fun _ ↦ κ) η`: the case analysis an `rdo` block performs after a loop that returns early. -/ | breakRunK @@ -68,6 +70,7 @@ instance : ToString Shape where | .ite => "ite" | .dite .. => "dite" | .forIn .. => "forIn" + | .forInLoop => "forInLoop" | .breakRunK => "breakRunK" | .const => "const" | .leaf => "leaf" @@ -104,6 +107,7 @@ def shapeOf (κ : Expr) : MetaM Shape := do | .const ``List _ => return .forIn ``IsMarkov.forInList ``IsMarkov.forInList_comp | .const ``Array _ => return .forIn ``IsMarkov.forInArray ``IsMarkov.forInArray_comp | .const ``Vector _ => return .forIn ``IsMarkov.forInVector ``IsMarkov.forInVector_comp + | .const ``Lean.Loop _ => return .forInLoop | _ => return .leaf else if head.isConstOf ``Break.runK then return .breakRunK @@ -265,6 +269,16 @@ partial def isMarkovCore (g : MVarId) (fuel : Nat) : MetaM (List MVarId) := g.wi else trace[is_markov] "neither `forIn` lemma applies, handed back" return [g] + | .forInLoop => + /- `while c rdo body`: a measurability goal for the initial state, an `IsMarkov` goal for the + step of the loop, jointly in the parameter and in the state, and the termination of the loop. + We recurse into the second, and leave the other two to the user. -/ + let gs ← g.applyConst ``IsMarkov.forInLoop + match gs with + | [g_measurable, g_step, g_term] => + return (← isMarkovCore g_step fuel) ++ [g_measurable, g_term] + | _ => + throwError "is_markov: expected three goals after the `forInLoop` step, got {gs.length}" | .breakRunK => let gs ← g.applyConst ``IsMarkov.breakRunK match gs with diff --git a/RandomDo/Tactic/IsMarkov/Lemmas.lean b/RandomDo/Tactic/IsMarkov/Lemmas.lean index 38cc0d0..91931d8 100644 --- a/RandomDo/Tactic/IsMarkov/Lemmas.lean +++ b/RandomDo/Tactic/IsMarkov/Lemmas.lean @@ -7,6 +7,7 @@ module public import RandomDo.Monad.Instances public import RandomDo.Monad.ForInInstances +public import RandomDo.Monad.While public import RandomDo.Measurable public import RandomDo.Tactic.IsMarkov.ForInStep public import Mathlib.MeasureTheory.Measure.ProbabilityMeasure @@ -49,13 +50,17 @@ complex program to the Markov property/measurability of its underlying mathemati * `forIn_nil`, `forIn_cons`: A `for` loop over a list, unrolled one element at a time. * `breakRunK`: The case analysis a program performs after a loop that returns early, on the `Option` slot holding the returned value, is Markovian as soon as both of its branches are. +* `forInLoop`: A `while` loop, whose initial state depends measurably on the parameter and whose + step is Markovian in the parameter and in the state, is measurable in the parameter. It is + Markovian as soon as it stops almost surely, i.e. as soon as its runs still going after `n` steps + have a mass that tends to `0`, which is left as a hypothesis. -/ @[expose] public section open MeasureTheory ProbabilityTheory Function open MeasurableSpacePure -open scoped ENNReal +open scoped ENNReal Topology namespace IsMarkov @@ -396,4 +401,40 @@ lemma breakRunK {o : α → Option γ} (ho : Measurable o) | none => simpa [Break.runK] using h_break.isProbabilityMeasure a | some r => simpa [Break.runK] using h_success.isProbabilityMeasure (a, r) +section While + +/-- The runs of a `while` loop that stop at the `n + 1`-th step are measurable jointly in the +parameter and in the starting state, as soon as the step is Markovian in both. -/ +private lemma measurable_loopExit {f : γ → σ → Measure (ForInStep σ)} + (hf : IsMarkov fun p : γ × σ ↦ f p.1 p.2) (n : ℕ) : + Measurable fun p : γ × σ ↦ MeasurableSpaceMonad.loopExit (f p.1) n p.2 := by + induction n with + | zero => + simp only [MeasurableSpaceMonad.loopExit, mBind_def, mPure_def] + exact measurable_bind hf (ForInStep.measurable_CasesOn (done := fun _ b ↦ Measure.dirac b) + (yield := fun _ _ ↦ 0) (by fun_prop) measurable_const) + | succ n ih => + simp only [MeasurableSpaceMonad.loopExit, mBind_def] + exact measurable_bind hf (ForInStep.measurable_CasesOn (done := fun _ _ ↦ 0) + (yield := fun (p : γ × σ) b ↦ MeasurableSpaceMonad.loopExit (f p.1) n b) measurable_const + (ih.comp (measurable_fst.fst.prodMk measurable_snd))) + +lemma forInLoop {b : γ → σ} {f : γ → Unit → σ → Measure (ForInStep σ)} (hb : Measurable b) + (hf : IsMarkov fun p : γ × σ ↦ f p.1 () p.2) + (hterm : ∀ c, Filter.Tendsto + (fun n ↦ MeasurableSpaceMonad.loopRun (f c ()) n (b c) Set.univ) Filter.atTop (𝓝 0)) : + IsMarkov fun c ↦ MeasurableSpaceForIn.forIn (m := Measure) Lean.Loop.mk (b c) (f c) := by + refine ⟨?_, fun c ↦ ?_⟩ + · change Measurable fun c ↦ Measure.sum fun n ↦ MeasurableSpaceMonad.loopExit (f c ()) n (b c) + refine Measure.measurable_of_measurable_coe _ fun s hs ↦ ?_ + simp_rw [Measure.sum_apply _ hs] + exact Measurable.tsum fun n ↦ (Measure.measurable_coe hs).comp + ((measurable_loopExit (f := fun c ↦ f c ()) hf n).comp (measurable_id.prodMk hb)) + -- For a fixed parameter, the step is a Markov kernel in the state. + · have : IsMarkov (f c ()) := + hf.comp (g := fun s ↦ (c, s)) (measurable_const.prodMk measurable_id) + exact (MeasurableSpaceMonadWhile.isProbabilityMeasure_loop_iff (f c ()) (b c)).2 (hterm c) + +end While + end IsMarkov diff --git a/Test/IsMarkov.lean b/Test/IsMarkov.lean index a63e188..5bb33e4 100644 --- a/Test/IsMarkov.lean +++ b/Test/IsMarkov.lean @@ -11,7 +11,7 @@ set_option linter.style.header false node. There is one test here per construct it recognises. -/ -open MeasureTheory ProbabilityTheory +open MeasureTheory ProbabilityTheory MeasurableSpacePure @[expose] public section @@ -93,6 +93,47 @@ noncomputable def overList (xs : List ℝ) : Measure ℝ := rdo example : IsMarkov overList := by is_markov +/-! ## `while`, whose termination is handed back + +`is_markov` proves the measurability of a `while` loop, and hands back its termination: the loop is +a probability measure exactly when the mass of its runs still going after `n` steps tends to `0`. +Each test takes that as a hypothesis, which closes the only goal left. -/ + +noncomputable def untilHeads : Measure ℕ := rdo + let mut n := 0 + while true rdo + let heads ← fairCoin + n := n + 1 + if heads then + break + return n + +example (h : ∀ _ : Unit, Filter.Tendsto (fun k ↦ MeasurableSpaceMonad.loopRun (m := Measure) + (fun n : ℕ ↦ fairCoin >>=ₘ fun heads ↦ + if heads then mPure (ForInStep.done (n + 1)) else mPure (ForInStep.yield (n + 1))) + k 0 Set.univ) Filter.atTop (nhds 0)) : + IsProbabilityMeasure untilHeads := by + is_markov + exact h + +/-- A `while` loop whose condition reads the parameter. -/ +noncomputable def climbFrom (k : ℕ) : Measure ℕ := rdo + let mut n := k + while n < k + 3 rdo + let heads ← fairCoin + if heads then + n := n + 1 + return n + +example (h : ∀ k, Filter.Tendsto (fun j ↦ MeasurableSpaceMonad.loopRun (m := Measure) + (fun n : ℕ ↦ if n < k + 3 then + fairCoin >>=ₘ fun heads ↦ + if heads then mPure (ForInStep.yield (n + 1)) else mPure (ForInStep.yield n) + else mPure (ForInStep.done n)) j k Set.univ) Filter.atTop (nhds 0)) : + IsMarkov climbFrom := by + is_markov + exact h + /-! ## Looking through definitions, and the `fuel` argument -/ noncomputable def layerOne : Measure ℝ := sumTwo diff --git a/Test/Polymorphic.lean b/Test/Polymorphic.lean index 5631185..4f417ee 100644 --- a/Test/Polymorphic.lean +++ b/Test/Polymorphic.lean @@ -114,16 +114,16 @@ example : IsProbabilityMeasure (ex1 (m := Measure) (R := ℝ) (V := NNReal)) := run_cmd logPolymorphic (ex1 (m := RandM) (R := Float) (V := Float)) -def flipsUntilHeads [HasBernoulli m R] [MeasurableSpaceMonadWhile m] (p : R) : m ℕ := rdo +def flipsUntilHeads [HasBernoulli m R] [MeasurableSpaceMonadWhile m] : m ℕ := rdo let mut n := 0 while true rdo - let heads ← coin (m := m) p + let heads ← coin (m := m) (0.5 : R) n := n + 1 if heads then break return n -run_cmd logPolymorphic (flipsUntilHeads (m := RandM) (0.5 : Float)) +run_cmd logPolymorphic (flipsUntilHeads (m := RandM) (R := Float)) end Test.Polymorphic From ae7d0d18087a972c7697f5c87a7bba5b6bdb1c17 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ga=C3=ABtan=20Serr=C3=A9?= Date: Wed, 30 Sep 2026 12:40:44 +0200 Subject: [PATCH 6/9] Variant rules for termination --- RandomDo.lean | 2 + .../Algebra/Notation/Indicator.lean | 26 + .../MeasureTheory/Measure/GiryMonad.lean | 12 +- .../Probability/Distributions/Bernoulli.lean | 14 + RandomDo/Monad/While.lean | 176 ++-- RandomDo/Tactic/IsMarkov/ForInStep.lean | 23 + RandomDo/Tactic/IsMarkov/Lemmas.lean | 20 +- RandomDo/Tactic/IsMarkov/Termination.lean | 842 ++++++++++++++++++ Test/IsMarkov.lean | 218 ++++- 9 files changed, 1227 insertions(+), 106 deletions(-) create mode 100644 RandomDo/ForMathlib/Algebra/Notation/Indicator.lean create mode 100644 RandomDo/Tactic/IsMarkov/Termination.lean diff --git a/RandomDo.lean b/RandomDo.lean index e20e74e..3d974f0 100644 --- a/RandomDo.lean +++ b/RandomDo.lean @@ -1,5 +1,6 @@ module -- shake: keep-all --deprecated_module: ignore +public import RandomDo.ForMathlib.Algebra.Notation.Indicator public import RandomDo.ForMathlib.MeasureTheory.MeasurableSpace.Embedding public import RandomDo.ForMathlib.MeasureTheory.Measure.GiryMonad public import RandomDo.ForMathlib.Probability.Distributions.Bernoulli @@ -26,3 +27,4 @@ public import RandomDo.Tactic.IsMarkov.Deriving public import RandomDo.Tactic.IsMarkov.Elab public import RandomDo.Tactic.IsMarkov.ForInStep public import RandomDo.Tactic.IsMarkov.Lemmas +public import RandomDo.Tactic.IsMarkov.Termination diff --git a/RandomDo/ForMathlib/Algebra/Notation/Indicator.lean b/RandomDo/ForMathlib/Algebra/Notation/Indicator.lean new file mode 100644 index 0000000..9354bbc --- /dev/null +++ b/RandomDo/ForMathlib/Algebra/Notation/Indicator.lean @@ -0,0 +1,26 @@ +/- +Copyright (c) 2026 Gaëtan Serré. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gaëtan Serré +-/ +module + +public import Mathlib.Algebra.Notation.Indicator + +/-! +# The indicator of a set given by a predicate + +-/ + +@[expose] public section + +namespace Set + +variable {α M : Type*} [Zero M] + +@[simp] +lemma indicator_setOf_apply (p : α → Prop) (f : α → M) (a : α) [Decidable (p a)] : + {x | p x}.indicator f a = if p a then f a else 0 := by + simp [indicator_apply] + +end Set diff --git a/RandomDo/ForMathlib/MeasureTheory/Measure/GiryMonad.lean b/RandomDo/ForMathlib/MeasureTheory/Measure/GiryMonad.lean index c76fedd..e586aa6 100644 --- a/RandomDo/ForMathlib/MeasureTheory/Measure/GiryMonad.lean +++ b/RandomDo/ForMathlib/MeasureTheory/Measure/GiryMonad.lean @@ -8,7 +8,7 @@ module public import Mathlib.MeasureTheory.Measure.GiryMonad /-! -# The bind of a sum of two measures +# The bind of a sum of two measures, and of a Dirac mass -/ @@ -26,4 +26,14 @@ theorem bind_add {μ ν : Measure α} {f : α → Measure β} (hf : AEMeasurable ext s hs rw [add_apply, bind_apply hs hf, bind_apply hs hμ, bind_apply hs hν, lintegral_add_measure] +/-- Binding a Dirac mass at a point of a space whose points are measurable: the continuation needs +no measurability. -/ +@[simp] +theorem dirac_bind' [MeasurableSingletonClass α] (a : α) (f : α → Measure β) : + (dirac a).bind f = f a := by + rw [Measure.bind, map_congr (ae_eq_dirac f)] + change (map (fun _ ↦ f a) (dirac a)).join = f a + rw [map_const] + simp + end MeasureTheory.Measure diff --git a/RandomDo/ForMathlib/Probability/Distributions/Bernoulli.lean b/RandomDo/ForMathlib/Probability/Distributions/Bernoulli.lean index ef00da8..ec9706a 100644 --- a/RandomDo/ForMathlib/Probability/Distributions/Bernoulli.lean +++ b/RandomDo/ForMathlib/Probability/Distributions/Bernoulli.lean @@ -28,4 +28,18 @@ lemma bernoulliMeasure_bind (x y : X) (p : I) {g : X → Measure Y} (hg : Measur dirac_bind hg] rfl +/-- Binding a Bernoulli distribution on a space whose points are measurable: the continuation needs +no measurability, and the two weights are real numbers, so that `simp` can use it and `norm_num` +can compute with the result. -/ +@[simp] +lemma bernoulliMeasure_bind' [MeasurableSingletonClass X] (x y : X) (p : I) (g : X → Measure Y) : + Ber(x, y, p).bind g = ENNReal.ofReal p • g x + ENNReal.ofReal (1 - p) • g y := by + have h (q : I) : ((toNNReal q : NNReal) : ℝ≥0∞) = ENNReal.ofReal q := by + rw [ENNReal.ofReal, Real.toNNReal_of_nonneg q.2.1] + rfl + rw [bernoulliMeasure_def, bind_add ((aemeasurable_dirac.smul_measure _).add_measure + (aemeasurable_dirac.smul_measure _)), bind_smul, bind_smul, dirac_bind', dirac_bind'] + change (toNNReal p : ℝ≥0∞) • g x + (toNNReal (σ p) : ℝ≥0∞) • g y = _ + rw [h, h, coe_symm_eq] + end ProbabilityTheory diff --git a/RandomDo/Monad/While.lean b/RandomDo/Monad/While.lean index 2e17be3..641ddb8 100644 --- a/RandomDo/Monad/While.lean +++ b/RandomDo/Monad/While.lean @@ -13,41 +13,20 @@ public import Mathlib.Probability.Distributions.Bernoulli /-! # `while` loops -`while c rdo body` is a loop over `Lean.Loop`, which runs `body` for as long as `c` holds. Each step -of the loop returns a `ForInStep`: `yield b` to carry on from the state `b`, `done b` to stop there. -Such a loop need not terminate, so its meaning depends on the monad, which provides it through the -class `MeasurableSpaceMonadWhile`. - -## Main definitions - -* `MeasurableSpaceMonadWhile`: a measurable space monad with an unbounded loop. Its instances: - - at a core monad, core's loop over `Lean.Loop`; - - at `Measure`, the least fixed point of "one step, then stop or run the loop again": the sum - over `n` of the runs that stop at the `n + 1`-th step. The runs that never stop carry no mass. -* `MeasurableSpaceMonad.loopExit f n b`: the runs of the loop whose step is `f` that, from `b`, stop - at the `n + 1`-th step, in any measurable space monad with a zero. -* `MeasurableSpaceMonad.loopRun f n b`: the runs of that loop that, from `b`, are still going after - `n` steps. -* The instance of `MeasurableSpaceForIn m Lean.Loop Unit`, for any `MeasurableSpaceMonadWhile m`: - `while … rdo` runs the loop of the monad. - -## Main results - -* `MeasurableSpaceMonadWhile.measure_loop_univ_le_one`: at `Measure`, a loop whose step has mass at - most `1` has mass at most `1`. -* `MeasurableSpaceMonadWhile.isProbabilityMeasure_loop_iff`: at `Measure`, a loop whose step is a - Markov kernel is a probability measure exactly when the mass of its runs still going after `n` - steps tends to `0`. +`while c rdo body` runs `body` for as long as `c` holds, each step returning `yield b` to carry on +from `b` or `done b` to stop there. Such a loop need not terminate, so each monad gives its own +meaning to it through the class `MeasurableSpaceMonadWhile`: core's loop at a core monad, and at +`Measure` the least fixed point of "one step, then stop or run the loop again", the sum over `n` of +the runs that stop at the `n + 1`-th step (`loopExit`). The runs that never stop carry no mass, and +the loop is a probability measure exactly when the runs still going after `n` steps (`loopRun`) have +a mass that tends to `0` (`Terminates`). ## Implementation notes -The while loop could instead be a field of `MeasurableSpaceMonad` itself. Every program over an -arbitrary measurable space monad could then use `while` with no further hypothesis, as it uses -`for`, at the price of asking every measurable space monad for its own implementation of the loop. - -The loop at `Measure` is not defined by `partial_fixpoint`, which also gives the least fixed point, -because it needs the step to be monotone in the loop, over every family `β → Measure β`: this fails -for `Measure.bind`, which is `0` as soon as its continuation is not measurable. +The loop could instead be a field of `MeasurableSpaceMonad`, at the price of asking every measurable +space monad for its own implementation. It is not defined by `partial_fixpoint`, which needs the +step to be monotone in the loop over every family `β → Measure β`: this fails for `Measure.bind`, +which is `0` as soon as its continuation is not measurable. ## References @@ -65,17 +44,21 @@ class MeasurableSpaceMonadWhile (m : (α : Type u) → [MeasurableSpace α] → /-- Run the step `f` from `b`, then from each state it carries on with, until it stops. -/ loop {β : Type u} [MeasurableSpace β] (f : β → m (ForInStep β)) (b : β) : m β +namespace MeasurableSpaceMonadWhile + /-- At a core monad, the loop is core's loop over `Lean.Loop`. -/ instance {m : Type u → Type v} [Monad m] : MeasurableSpaceMonadWhile (Monad.toMeasurableSpaceMonad m) where loop f b := ForIn.forIn (m := m) Lean.Loop.mk b fun _ ↦ f +section Runs + variable {m : (α : Type u) → [MeasurableSpace α] → Type v} [MeasurableSpaceMonad m] {β : Type u} [MeasurableSpace β] [Zero (m β)] /-- The runs of the loop whose step is `f` that, from `b`, stop at the `n + 1`-th step. A run that does not stop there contributes `0`. -/ -def MeasurableSpaceMonad.loopExit (f : β → m (ForInStep β)) : ℕ → β → m β +def loopExit (f : β → m (ForInStep β)) : ℕ → β → m β -- One step from `b`: keep the runs that stop there, drop the ones that carry on. | 0, b => f b >>=ₘ fun s ↦ ForInStep.casesOn (motive := fun _ ↦ m β) s mPure fun _ ↦ 0 -- One step from `b`: drop the runs that stop there, keep those that stop `n + 1` steps later. @@ -84,21 +67,24 @@ def MeasurableSpaceMonad.loopExit (f : β → m (ForInStep β)) : ℕ → β → /-- The runs of the loop whose step is `f` that, from `b`, have not stopped after `n` steps, at the state they are in. A run that has stopped contributes `0`. -/ -def MeasurableSpaceMonad.loopRun (f : β → m (ForInStep β)) : ℕ → β → m β +def loopRun (f : β → m (ForInStep β)) : ℕ → β → m β -- No step yet: the run is at `b`. | 0, b => mPure b -- One step from `b`: drop the runs that stop there, keep those still going `n` steps later. | n + 1, b => f b >>=ₘ fun s ↦ ForInStep.casesOn (motive := fun _ ↦ m β) s (fun _ ↦ 0) (loopRun f n) +end Runs + /-- At `Measure`, the loop is the least fixed point of "one step, then stop or run the loop again": the sum over `n` of the runs that stop at the `n + 1`-th step. -/ noncomputable instance : MeasurableSpaceMonadWhile Measure where - loop f b := Measure.sum fun n ↦ MeasurableSpaceMonad.loopExit f n b + loop f b := Measure.sum fun n ↦ loopExit f n b /-- The unbounded loop behind `while … rdo` is the loop of the monad. -/ -instance [MeasurableSpaceMonadWhile m] : MeasurableSpaceForIn m Lean.Loop Unit where - forIn _ b f := MeasurableSpaceMonadWhile.loop (f ()) b +instance {m : (α : Type u) → [MeasurableSpace α] → Type v} [MeasurableSpaceMonadWhile m] : + MeasurableSpaceForIn m Lean.Loop Unit where + forIn _ b f := loop (f ()) b section Measure @@ -108,25 +94,22 @@ open Filter variable {σ : Type u} [MeasurableSpace σ] private lemma loopExit_zero (f : σ → Measure (ForInStep σ)) (b : σ) : - MeasurableSpaceMonad.loopExit f 0 b = - (f b).bind fun t ↦ ForInStep.casesOn (motive := fun _ ↦ Measure σ) t Measure.dirac - fun _ ↦ 0 := rfl + loopExit f 0 b = (f b).bind fun t ↦ + ForInStep.casesOn (motive := fun _ ↦ Measure σ) t Measure.dirac fun _ ↦ 0 := rfl private lemma loopExit_succ (f : σ → Measure (ForInStep σ)) (n : ℕ) (b : σ) : - MeasurableSpaceMonad.loopExit f (n + 1) b = - (f b).bind fun t ↦ ForInStep.casesOn (motive := fun _ ↦ Measure σ) t (fun _ ↦ 0) - (MeasurableSpaceMonad.loopExit f n) := rfl + loopExit f (n + 1) b = (f b).bind fun t ↦ + ForInStep.casesOn (motive := fun _ ↦ Measure σ) t (fun _ ↦ 0) (loopExit f n) := rfl /-- A `while` loop is a sub-probability measure: the runs that stop at the different steps are disjoint, so their masses add up to at most `1`. -/ -lemma MeasurableSpaceMonadWhile.measure_loop_univ_le_one {f : σ → Measure (ForInStep σ)} - (hf : ∀ s, f s Set.univ ≤ 1) (b : σ) : - MeasurableSpaceMonadWhile.loop f b Set.univ ≤ 1 := by +lemma measure_loop_univ_le_one {f : σ → Measure (ForInStep σ)} (hf : ∀ s, f s Set.univ ≤ 1) + (b : σ) : loop f b Set.univ ≤ 1 := by /- The runs that stop at the steps `2, …, n + 1` are one step, followed by the runs that stop at the steps `1, …, n`. -/ - have tail : ∀ n b, ∑ k ∈ Finset.range n, MeasurableSpaceMonad.loopExit f (k + 1) b Set.univ ≤ + have tail : ∀ n b, ∑ k ∈ Finset.range n, loopExit f (k + 1) b Set.univ ≤ ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) - (fun b' ↦ ∑ k ∈ Finset.range n, MeasurableSpaceMonad.loopExit f k b' Set.univ) ∂f b := by + (fun b' ↦ ∑ k ∈ Finset.range n, loopExit f k b' Set.univ) ∂f b := by intro n induction n with | zero => simp @@ -141,8 +124,7 @@ lemma MeasurableSpaceMonadWhile.measure_loop_univ_le_one {f : σ → Measure (Fo refine lintegral_congr fun t ↦ ?_ cases t <;> simp [Finset.sum_range_succ] -- The runs that stop within `n` steps have mass at most `1`. - have partialSum : ∀ n b, ∑ k ∈ Finset.range n, - MeasurableSpaceMonad.loopExit f k b Set.univ ≤ 1 := by + have partialSum : ∀ n b, ∑ k ∈ Finset.range n, loopExit f k b Set.univ ≤ 1 := by intro n induction n with | zero => simp @@ -158,17 +140,16 @@ lemma MeasurableSpaceMonadWhile.measure_loop_univ_le_one {f : σ → Measure (Fo -- The merged integrand is at most `1`. refine lintegral_mono fun t ↦ ?_ cases t <;> simp [ih] - change Measure.sum (fun n ↦ MeasurableSpaceMonad.loopExit f n b) Set.univ ≤ 1 + change Measure.sum (fun n ↦ loopExit f n b) Set.univ ≤ 1 rw [Measure.sum_apply _ MeasurableSet.univ, ENNReal.tsum_eq_iSup_nat] exact iSup_le fun n ↦ partialSum n b private lemma loopRun_zero (f : σ → Measure (ForInStep σ)) (b : σ) : - MeasurableSpaceMonad.loopRun f 0 b = Measure.dirac b := rfl + loopRun f 0 b = Measure.dirac b := rfl private lemma loopRun_succ (f : σ → Measure (ForInStep σ)) (n : ℕ) (b : σ) : - MeasurableSpaceMonad.loopRun f (n + 1) b = - (f b).bind fun t ↦ ForInStep.casesOn (motive := fun _ ↦ Measure σ) t (fun _ ↦ 0) - (MeasurableSpaceMonad.loopRun f n) := rfl + loopRun f (n + 1) b = (f b).bind fun t ↦ + ForInStep.casesOn (motive := fun _ ↦ Measure σ) t (fun _ ↦ 0) (loopRun f n) := rfl private lemma measurable_casesOn {γ : Type*} [MeasurableSpace γ] {d y : σ → γ} (hd : Measurable d) (hy : Measurable y) : @@ -185,25 +166,50 @@ private lemma bind_casesOn_apply_univ (μ : Measure (ForInStep σ)) {d y : σ exact lintegral_congr fun t ↦ by cases t <;> rfl private lemma measurable_loopExit {f : σ → Measure (ForInStep σ)} (hf : Measurable f) : - ∀ n, Measurable (MeasurableSpaceMonad.loopExit f n) + ∀ n, Measurable (loopExit f n) | 0 => (Measure.measurable_bind' (measurable_casesOn Measure.measurable_dirac measurable_const)).comp hf | n + 1 => (Measure.measurable_bind' (measurable_casesOn measurable_const (measurable_loopExit hf n))).comp hf -private lemma measurable_loopRun {f : σ → Measure (ForInStep σ)} (hf : Measurable f) : - ∀ n, Measurable (MeasurableSpaceMonad.loopRun f n) +lemma measurable_loopRun {f : σ → Measure (ForInStep σ)} (hf : Measurable f) : + ∀ n, Measurable (loopRun f n) | 0 => Measure.measurable_dirac | n + 1 => (Measure.measurable_bind' (measurable_casesOn measurable_const (measurable_loopRun hf n))).comp hf +/-- No step yet: the run is at its starting state, with mass `1`. -/ +@[simp] +lemma loopRun_zero_apply_univ (f : σ → Measure (ForInStep σ)) (b : σ) : + loopRun f 0 b Set.univ = 1 := by + simp [loopRun_zero] + +/-- The runs still going after `n + 1` steps: one step, then, from the state it carries on with, the +runs still going after `n` steps. -/ +lemma loopRun_succ_apply_univ {f : σ → Measure (ForInStep σ)} (hf : Measurable f) (n : ℕ) + (b : σ) : + loopRun f (n + 1) b Set.univ = + ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) + (fun s ↦ loopRun f n s Set.univ) ∂f b := by + rw [loopRun_succ, bind_casesOn_apply_univ _ measurable_const (measurable_loopRun hf n)] + simp + +/-- The runs still going after `n` steps have mass at most `1`. -/ +lemma loopRun_apply_univ_le_one (f : σ → Measure (ForInStep σ)) [hf : IsMarkov f] (n : ℕ) + (b : σ) : loopRun f n b Set.univ ≤ 1 := by + induction n generalizing b with + | zero => simp [loopRun_zero] + | succ n ih => + have := hf.isProbabilityMeasure b + rw [loopRun_succ_apply_univ hf.measurable] + calc _ ≤ ∫⁻ _, 1 ∂f b := lintegral_mono fun t ↦ by cases t <;> simp [ih] + _ = 1 := by simp + /-- The runs still going after `n` steps are those that stop at the next step, and those still going after it. -/ private lemma loopRun_apply_univ (f : σ → Measure (ForInStep σ)) [hf : IsMarkov f] (n : ℕ) (b : σ) : - MeasurableSpaceMonad.loopRun f n b Set.univ = - MeasurableSpaceMonad.loopExit f n b Set.univ + - MeasurableSpaceMonad.loopRun f (n + 1) b Set.univ := by + loopRun f n b Set.univ = loopExit f n b Set.univ + loopRun f (n + 1) b Set.univ := by induction n generalizing b with | zero => have := hf.isProbabilityMeasure b @@ -216,12 +222,13 @@ private lemma loopRun_apply_univ (f : σ → Measure (ForInStep σ)) [hf : IsMar calc (1 : ℝ≥0∞) = ∫⁻ _, 1 ∂f b := by simp _ = _ := lintegral_congr fun t ↦ by cases t <;> simp | succ n ih => - have hExit : Measurable fun s ↦ MeasurableSpaceMonad.loopExit f n s Set.univ := + have hExit : Measurable fun s ↦ loopExit f n s Set.univ := (Measure.measurable_coe MeasurableSet.univ).comp (measurable_loopExit hf.measurable n) rw [loopRun_succ f n b, loopExit_succ, loopRun_succ f (n + 1) b, bind_casesOn_apply_univ _ measurable_const (measurable_loopRun hf.measurable n), bind_casesOn_apply_univ _ measurable_const (measurable_loopExit hf.measurable n), - bind_casesOn_apply_univ _ measurable_const (measurable_loopRun hf.measurable (n + 1))] + bind_casesOn_apply_univ _ measurable_const + (measurable_loopRun hf.measurable (n + 1))] simp only [Measure.coe_zero, Pi.zero_apply] -- Merge the two integrals, and use the statement for `n` from the state the step carries on. rw [← lintegral_add_left (measurable_casesOn measurable_const hExit)] @@ -231,35 +238,46 @@ private lemma loopRun_apply_univ (f : σ → Measure (ForInStep σ)) [hf : IsMar of `1`. -/ private lemma sum_loopExit_add_loopRun (f : σ → Measure (ForInStep σ)) [IsMarkov f] (n : ℕ) (b : σ) : - ∑ k ∈ Finset.range n, MeasurableSpaceMonad.loopExit f k b Set.univ + - MeasurableSpaceMonad.loopRun f n b Set.univ = 1 := by + ∑ k ∈ Finset.range n, loopExit f k b Set.univ + loopRun f n b Set.univ = 1 := by induction n with | zero => simp [loopRun_zero] | succ n ih => rw [Finset.sum_range_succ, add_assoc, ← loopRun_apply_univ, ih] +/-- The runs still going after `n` steps have a mass that decreases with `n`. -/ +lemma antitone_loopRun_apply_univ (f : σ → Measure (ForInStep σ)) [IsMarkov f] (b : σ) : + Antitone fun n ↦ loopRun f n b Set.univ := + antitone_nat_of_succ_le fun n ↦ (loopRun_apply_univ f n b).symm ▸ le_add_self + +/-- The loop whose step is `f` stops almost surely from `b`: its runs still going after `n` steps +have a mass that tends to `0`. -/ +def Terminates (f : σ → Measure (ForInStep σ)) (b : σ) : Prop := + Tendsto (fun n ↦ loopRun f n b Set.univ) atTop (𝓝 0) + +/-- The expected number of steps of the loop whose step is `f`, from `b`: the sum over `n` of the +probability that it is still going after `n` steps. -/ +noncomputable def expectedSteps (f : σ → Measure (ForInStep σ)) (b : σ) : ℝ≥0∞ := + ∑' n, loopRun f n b Set.univ + /-- A `while` loop whose step is a Markov kernel is a probability measure exactly when it stops -almost surely: when the runs still going after `n` steps have a mass that tends to `0`. -/ -theorem MeasurableSpaceMonadWhile.isProbabilityMeasure_loop_iff (f : σ → Measure (ForInStep σ)) - [hf : IsMarkov f] (b : σ) : - IsProbabilityMeasure (MeasurableSpaceMonadWhile.loop f b) ↔ - Tendsto (fun n ↦ MeasurableSpaceMonad.loopRun f n b Set.univ) atTop (𝓝 0) := by +almost surely. -/ +theorem isProbabilityMeasure_loop_iff (f : σ → Measure (ForInStep σ)) [hf : IsMarkov f] + (b : σ) : IsProbabilityMeasure (loop f b) ↔ Terminates f b := by -- The runs that stop within `n` steps have a mass that tends to the mass of the loop. - have hExit : Tendsto (fun n ↦ ∑ k ∈ Finset.range n, MeasurableSpaceMonad.loopExit f k b Set.univ) - atTop (𝓝 (MeasurableSpaceMonadWhile.loop f b Set.univ)) := by - change Tendsto _ _ (𝓝 (Measure.sum (fun n ↦ MeasurableSpaceMonad.loopExit f n b) Set.univ)) + have hExit : Tendsto (fun n ↦ ∑ k ∈ Finset.range n, loopExit f k b Set.univ) atTop + (𝓝 (loop f b Set.univ)) := by + change Tendsto _ _ (𝓝 (Measure.sum (fun n ↦ loopExit f n b) Set.univ)) rw [Measure.sum_apply _ MeasurableSet.univ] exact ENNReal.tendsto_nat_tsum _ -- So the runs still going after `n` steps have a mass that tends to `1` minus it. - have hRun : Tendsto (fun n ↦ MeasurableSpaceMonad.loopRun f n b Set.univ) atTop - (𝓝 (1 - MeasurableSpaceMonadWhile.loop f b Set.univ)) := by - have h n : MeasurableSpaceMonad.loopRun f n b Set.univ = - 1 - ∑ k ∈ Finset.range n, MeasurableSpaceMonad.loopExit f k b Set.univ := by + have hRun : Tendsto (fun n ↦ loopRun f n b Set.univ) atTop (𝓝 (1 - loop f b Set.univ)) := by + have h n : loopRun f n b Set.univ = + 1 - ∑ k ∈ Finset.range n, loopExit f k b Set.univ := by have hsum := sum_loopExit_add_loopRun f n b refine ENNReal.eq_sub_of_add_eq ?_ ((add_comm _ _).trans hsum) exact ne_top_of_le_ne_top ENNReal.one_ne_top (hsum ▸ le_self_add) simp_rw [h] exact ENNReal.Tendsto.sub tendsto_const_nhds hExit (Or.inl ENNReal.one_ne_top) - rw [isProbabilityMeasure_iff] + rw [isProbabilityMeasure_iff, Terminates] constructor · intro h simpa [h] using hRun @@ -270,3 +288,5 @@ theorem MeasurableSpaceMonadWhile.isProbabilityMeasure_loop_iff (f : σ → Meas simp end Measure + +end MeasurableSpaceMonadWhile diff --git a/RandomDo/Tactic/IsMarkov/ForInStep.lean b/RandomDo/Tactic/IsMarkov/ForInStep.lean index 6351f45..9884ba3 100644 --- a/RandomDo/Tactic/IsMarkov/ForInStep.lean +++ b/RandomDo/Tactic/IsMarkov/ForInStep.lean @@ -22,6 +22,8 @@ largest one making both `ForInStep.yield` and `ForInStep.done` measurable. ## Main results * `measurable_yield`, `measurable_run`, `measurable_isDone`: the maps relating `ForInStep β` to `β` and to `Bool` are measurable. +* The points of `ForInStep β` are measurable as soon as those of `β` are, and `ForInStep.yield` is a + measurable embedding. * `measurable_CasesOn`: a case analysis on a `ForInStep`, measurable in each of its two branches, is measurable. * `IsMarkov.forInStepCasesOn`: the same statement for the Markov property. @@ -57,6 +59,27 @@ lemma measurable_yield : Measurable (ForInStep.yield : β → ForInStep β) := f @[fun_prop] lemma measurable_run : Measurable (ForInStep.run : ForInStep β → β) := fun _ hs => ⟨hs, hs⟩ +/-- The points of `ForInStep β` are measurable as soon as those of `β` are. -/ +instance [MeasurableSingletonClass β] : MeasurableSingletonClass (ForInStep β) where + measurableSet_singleton t := by + -- A singleton's preimages under `yield` and `done` are a singleton and the empty set. + constructor <;> cases t <;> change MeasurableSet (_ ⁻¹' _) <;> simp [Set.preimage] + +lemma measurableEmbedding_yield : MeasurableEmbedding (ForInStep.yield : β → ForInStep β) where + injective _ _ h := ForInStep.yield.inj h + measurable := measurable_yield + measurableSet_image' S hS := by + refine ⟨?_, ?_⟩ + · change MeasurableSet (ForInStep.yield ⁻¹' _) + rwa [Set.preimage_image_eq _ fun _ _ h ↦ ForInStep.yield.inj h] + · change MeasurableSet (ForInStep.done ⁻¹' _) + convert MeasurableSet.empty (α := β) + ext; simp + +instance [Countable β] : Countable (ForInStep β) := + Function.Injective.countable (f := fun t : ForInStep β ↦ (t.isDone, t.run)) <| by + rintro (_ | _) (_ | _) h <;> simp_all + @[fun_prop] lemma measurable_isDone : Measurable (ForInStep.isDone : ForInStep β → Bool) := by intro s _ diff --git a/RandomDo/Tactic/IsMarkov/Lemmas.lean b/RandomDo/Tactic/IsMarkov/Lemmas.lean index 91931d8..2fce5bc 100644 --- a/RandomDo/Tactic/IsMarkov/Lemmas.lean +++ b/RandomDo/Tactic/IsMarkov/Lemmas.lean @@ -52,8 +52,7 @@ complex program to the Markov property/measurability of its underlying mathemati slot holding the returned value, is Markovian as soon as both of its branches are. * `forInLoop`: A `while` loop, whose initial state depends measurably on the parameter and whose step is Markovian in the parameter and in the state, is measurable in the parameter. It is - Markovian as soon as it stops almost surely, i.e. as soon as its runs still going after `n` steps - have a mass that tends to `0`, which is left as a hypothesis. + Markovian as soon as it stops almost surely, which is left as a hypothesis. -/ @[expose] public section @@ -403,29 +402,30 @@ lemma breakRunK {o : α → Option γ} (ho : Measurable o) section While +open MeasurableSpaceMonadWhile + /-- The runs of a `while` loop that stop at the `n + 1`-th step are measurable jointly in the parameter and in the starting state, as soon as the step is Markovian in both. -/ private lemma measurable_loopExit {f : γ → σ → Measure (ForInStep σ)} (hf : IsMarkov fun p : γ × σ ↦ f p.1 p.2) (n : ℕ) : - Measurable fun p : γ × σ ↦ MeasurableSpaceMonad.loopExit (f p.1) n p.2 := by + Measurable fun p : γ × σ ↦ loopExit (f p.1) n p.2 := by induction n with | zero => - simp only [MeasurableSpaceMonad.loopExit, mBind_def, mPure_def] + simp only [loopExit, mBind_def, mPure_def] exact measurable_bind hf (ForInStep.measurable_CasesOn (done := fun _ b ↦ Measure.dirac b) (yield := fun _ _ ↦ 0) (by fun_prop) measurable_const) | succ n ih => - simp only [MeasurableSpaceMonad.loopExit, mBind_def] + simp only [loopExit, mBind_def] exact measurable_bind hf (ForInStep.measurable_CasesOn (done := fun _ _ ↦ 0) - (yield := fun (p : γ × σ) b ↦ MeasurableSpaceMonad.loopExit (f p.1) n b) measurable_const + (yield := fun (p : γ × σ) b ↦ loopExit (f p.1) n b) measurable_const (ih.comp (measurable_fst.fst.prodMk measurable_snd))) lemma forInLoop {b : γ → σ} {f : γ → Unit → σ → Measure (ForInStep σ)} (hb : Measurable b) (hf : IsMarkov fun p : γ × σ ↦ f p.1 () p.2) - (hterm : ∀ c, Filter.Tendsto - (fun n ↦ MeasurableSpaceMonad.loopRun (f c ()) n (b c) Set.univ) Filter.atTop (𝓝 0)) : + (hterm : ∀ c, Terminates (f c ()) (b c)) : IsMarkov fun c ↦ MeasurableSpaceForIn.forIn (m := Measure) Lean.Loop.mk (b c) (f c) := by refine ⟨?_, fun c ↦ ?_⟩ - · change Measurable fun c ↦ Measure.sum fun n ↦ MeasurableSpaceMonad.loopExit (f c ()) n (b c) + · change Measurable fun c ↦ Measure.sum fun n ↦ loopExit (f c ()) n (b c) refine Measure.measurable_of_measurable_coe _ fun s hs ↦ ?_ simp_rw [Measure.sum_apply _ hs] exact Measurable.tsum fun n ↦ (Measure.measurable_coe hs).comp @@ -433,7 +433,7 @@ lemma forInLoop {b : γ → σ} {f : γ → Unit → σ → Measure (ForInStep -- For a fixed parameter, the step is a Markov kernel in the state. · have : IsMarkov (f c ()) := hf.comp (g := fun s ↦ (c, s)) (measurable_const.prodMk measurable_id) - exact (MeasurableSpaceMonadWhile.isProbabilityMeasure_loop_iff (f c ()) (b c)).2 (hterm c) + exact (isProbabilityMeasure_loop_iff (f c ()) (b c)).2 (hterm c) end While diff --git a/RandomDo/Tactic/IsMarkov/Termination.lean b/RandomDo/Tactic/IsMarkov/Termination.lean new file mode 100644 index 0000000..451922e --- /dev/null +++ b/RandomDo/Tactic/IsMarkov/Termination.lean @@ -0,0 +1,842 @@ +/- +Copyright (c) 2026 Gaëtan Serré. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gaëtan Serré +-/ +module + +public import RandomDo.Monad.While +public import RandomDo.Tactic.IsMarkov.Elab +public import RandomDo.ForMathlib.Algebra.Notation.Indicator +public import Mathlib.MeasureTheory.Function.Floor + +/-! +# Termination of `while` loops + +`is_markov` hands back the termination of a `while` loop as a goal `Terminates f b`. This file +implements proof rules of the literature for it, each under the name of its authors and with the +hypotheses of its paper, translated as described in the implementation notes. + +## Main results + +* `Terminates.mcIverMorgan_variantRule`, `Terminates.mcIverMorgan_variantRule_of_finite`: the + variant rule for loops of McIver and Morgan (2005, Lemmas 7.5.1 and 2.7.1). +* `Terminates.mcIverMorgan_variantRule_of_antitone`: its form with a variant that cannot increase + (McIver and Morgan 2005, p. 56). +* `Terminates.mcIverMorganKaminskiKatoen`: the new variant rule for loops of McIver, Morgan, + Kaminski and Katoen (POPL 2018, Theorem 4.1). +* `Terminates.majumdarSathiyanarayana_variantRule`: the variant rule of McIver and Morgan, as + presented by Majumdar and Sathiyanarayana for probabilistic transition systems (POPL 2025, Proof + Rule 3.1). +* `Terminates.majumdarSathiyanarayana_martingaleRule`: the martingale rule of Majumdar and + Sathiyanarayana (POPL 2025, Proof Rule 3.2). +* `bournezGarnier`: the Lyapunov ranking functions of Bournez and Garnier (RTA 2005, Theorem 2), + which give almost-sure termination with a bound on the expected number of steps. + +## Implementation notes + +The rules are stated for the two program models of their papers. +* A loop `while G do body` of pGCL is `whileStep G body`, whose body is a Markov kernel. The weakest + pre-expectation `wp.body.E` at `s` is the integral of `E` against `body s`, which for a predicate + `P` is the probability `body s {s' | P s'}`. +* A probabilistic transition system (a control flow graph, a probabilistic program) is the system + whose states are the `ForInStep σ`: the successor of `yield s` is drawn from `f s`, and the states + `done s` are terminal. Every `rdo` loop is of this form. + +The programs have no demonic nondeterminism, one step of a transition system is one iteration of the +loop, and "every successor" is "almost every successor". The papers state these rules for discrete +probabilistic choice (countable state spaces or discrete distributions); the rules here hold for any +measurable state space and any Markov kernel, and their measurability conditions, which a discrete +state space satisfies, have default proofs. + +## References + +* Annabelle McIver, Carroll Morgan, *Abstraction, Refinement and Proof for Probabilistic Systems*, + 2005. +* Annabelle McIver, Carroll Morgan, Benjamin Lucien Kaminski, Joost-Pieter Katoen, *A New Proof Rule + for Almost-Sure Termination*, POPL 2018. +* Rupak Majumdar, V. R. Sathiyanarayana, *Sound and Complete Proof Rules for Probabilistic + Termination*, POPL 2025. +* Olivier Bournez, Florent Garnier, *Proving Positive Almost-Sure Termination*, RTA 2005. +* Luis María Ferrer Fioriti, Holger Hermanns, *Probabilistic Termination: Soundness, Completeness, + and Compositionality*, POPL 2015. +-/ + +@[expose] public section + +open MeasureTheory Filter +open scoped ENNReal NNReal Topology + +/- The probabilities in the rules are read in `ℝ` through `ENNReal.toReal`: pushing it through the +sums of finite probabilities lets `norm_num` compute them. -/ +attribute [simp] ENNReal.toReal_add + +namespace MeasurableSpaceMonadWhile + +universe u + +variable {σ : Type u} [MeasurableSpace σ] {f : σ → Measure (ForInStep σ)} {b : σ} + +/-! ### Geometric decay on an invariant -/ + +private lemma loopRun_add_apply_univ_le [hf : IsMarkov f] {I : σ → Prop} + (hI : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run) {M : ℕ} {c : ℝ≥0∞} (hc : c ≠ ∞) + (h : ∀ s, I s → loopRun f M s Set.univ ≤ c) (n : ℕ) : + ∀ b, I b → loopRun f (n + M) b Set.univ ≤ c * loopRun f n b Set.univ := by + induction n with + | zero => exact fun b hb ↦ by simpa using h b hb + | succ n ih => + intro b hb + rw [Nat.add_right_comm, loopRun_succ_apply_univ hf.measurable, + loopRun_succ_apply_univ hf.measurable, ← lintegral_const_mul' _ _ hc] + refine lintegral_mono_ae ?_ + filter_upwards [hI b hb] with t ht + cases t with + | done _ => simp + | yield s => simpa using ih s (by simpa using ht) + +private lemma loopRun_mul_apply_univ_le [IsMarkov f] {I : σ → Prop} + (hI : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run) {N : ℕ} {c : ℝ≥0∞} (hc : c ≠ ∞) + (h : ∀ s, I s → loopRun f N s Set.univ ≤ c) (k : ℕ) : + ∀ b, I b → loopRun f (N * k) b Set.univ ≤ c ^ k := by + induction k with + | zero => simp + | succ k ih => + intro b hb + rw [Nat.mul_succ, pow_succ'] + exact (loopRun_add_apply_univ_le hI hc h _ b hb).trans (by gcongr; exact ih b hb) + +/-- From a state of an invariant, a loop stops almost surely as soon as, from every state of the +invariant, the runs still going after `N` steps have a mass at most some `c < 1`. -/ +private lemma terminates_of_loopRun_le [IsMarkov f] (I : σ → Prop) + (hI : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run) (N : ℕ) {c : ℝ≥0∞} (hc : c < 1) + (h : ∀ s, I s → loopRun f N s Set.univ ≤ c) (hb : I b) : Terminates f b := by + have lim := tendsto_atTop_iInf (antitone_loopRun_apply_univ f b) + suffices ⨅ n, loopRun f n b Set.univ = 0 by rwa [this] at lim + refine le_antisymm ?_ bot_le + refine ge_of_tendsto' (ENNReal.tendsto_pow_atTop_nhds_zero_of_lt_one hc) fun k ↦ ?_ + exact (iInf_le _ (N * k)).trans + (loopRun_mul_apply_univ_le hI (hc.trans ENNReal.one_lt_top).ne h k b hb) + +/-- The common core of the variant rules: from a state of an invariant, a loop stops almost surely +if a natural number `V`, bounded by `N` on the invariant, is decreased or the loop stopped with +probability at least `ε > 0` by every step from the invariant. -/ +private lemma terminates_of_variant [hf : IsMarkov f] (I : σ → Prop) + (hI : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run) (V : σ → ℕ) (hV : Measurable V) (N : ℕ) + (hN : ∀ s, I s → V s ≤ N) (ε : ℝ≥0∞) (hε : ε ≠ 0) + (h : ∀ s, I s → ε ≤ f s {t | t.isDone ∨ V t.run < V s}) (hb : I b) : Terminates f b := by + -- From a state of `I` whose variant is `< n`, the runs still going after `n` steps have a mass + -- at most `1 - εⁿ`. + have key : ∀ n s, I s → V s < n → loopRun f n s Set.univ ≤ 1 - ε ^ n := by + intro n + induction n with + | zero => exact fun s _ hs ↦ absurd hs (Nat.not_lt_zero _) + | succ n ih => + intro s hIs hs + set S := {t : ForInStep σ | t.isDone ∨ V t.run < V s} + have hS : MeasurableSet S := + (ForInStep.measurable_isDone (measurableSet_singleton true)).union + ((hV.comp ForInStep.measurable_run) measurableSet_Iio) + have := hf.isProbabilityMeasure s + have hε1 : ε ≤ 1 := (h s hIs).trans prob_le_one + rw [loopRun_succ_apply_univ hf.measurable] + calc _ ≤ ∫⁻ t, 1 - S.indicator (fun _ ↦ ε ^ n) t ∂f s := by + refine lintegral_mono_ae ?_ + filter_upwards [hI s hIs] with t ht + cases t with + | done s' => simp + | yield s' => + have hIs' : I s' := by simpa using ht + by_cases hlt : V s' < V s + · simpa [S, hlt] using ih s' hIs' (hlt.trans_le (Nat.lt_succ_iff.1 hs)) + · simpa [S, hlt] using loopRun_apply_univ_le_one f n s' + _ = 1 - ε ^ n * f s S := by + rw [lintegral_sub (measurable_const.indicator hS), lintegral_indicator_const hS] + · simp + · rw [lintegral_indicator_const hS] + exact ENNReal.mul_ne_top + (ENNReal.pow_ne_top (ne_top_of_le_ne_top ENNReal.one_ne_top hε1)) (measure_ne_top _ _) + · exact Eventually.of_forall fun t ↦ + Set.indicator_le (fun _ _ ↦ pow_le_one₀ bot_le hε1) t + _ ≤ 1 - ε ^ (n + 1) := tsub_le_tsub_left (by rw [pow_succ]; gcongr; exact h s hIs) 1 + refine terminates_of_loopRun_le I hI (N + 1) (c := 1 - ε ^ (N + 1)) ?_ + (fun s hs ↦ key _ s hs (Nat.lt_succ_of_le (hN s hs))) hb + exact ENNReal.sub_lt_self ENNReal.one_ne_top one_ne_zero (pow_ne_zero _ hε) + +/-! ### Stopping a loop on a set, and the probability of reaching it -/ + +/-- The loop whose step is `f`, stopped as soon as its state is in `A`. -/ +private noncomputable def stopOn (A : Set σ) (f : σ → Measure (ForInStep σ)) (s : σ) : + Measure (ForInStep σ) := + open Classical in if s ∈ A then Measure.dirac (ForInStep.done s) else f s + +private lemma isMarkov_stopOn [hf : IsMarkov f] {A : Set σ} (hA : MeasurableSet A) : + IsMarkov (stopOn A f) := by + classical + refine ⟨?_, fun s ↦ ?_⟩ + · exact Measurable.ite hA (Measure.measurable_dirac.comp ForInStep.measurable_done) hf.measurable + · unfold stopOn + split_ifs + · infer_instance + · exact hf.isProbabilityMeasure s + +private lemma stopOn_of_mem {A : Set σ} {s : σ} (h : s ∈ A) : + stopOn A f s = Measure.dirac (ForInStep.done s) := by + classical + simp [stopOn, h] + +private lemma stopOn_of_notMem {A : Set σ} {s : σ} (h : s ∉ A) : stopOn A f s = f s := by + classical + simp [stopOn, h] + +/-- Under the Dirac mass at a stop, every run has stopped. -/ +private lemma ae_dirac_done (P : σ → Prop) (s : σ) : + ∀ᵐ t ∂Measure.dirac (ForInStep.done s), ¬t.isDone → P t.run := by + have h0 : Measure.dirac (ForInStep.done s) (ForInStep.isDone ⁻¹' {false}) = 0 := by + rw [Measure.dirac_apply' _ (ForInStep.measurable_isDone (measurableSet_singleton false))] + simp + refine measure_mono_null (fun t ht ↦ ?_) h0 + simp only [Set.mem_preimage, Set.mem_singleton_iff] + cases hdone : t.isDone + · rfl + · exact absurd (fun h ↦ absurd hdone h) ht + +/-- The stopped loop keeps the invariants of the loop. -/ +private lemma ae_stopOn {A : Set σ} {I : σ → Prop} + (h : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run) : + ∀ s, I s → ∀ᵐ t ∂stopOn A f s, ¬t.isDone → I t.run := by + intro s hs + by_cases hA : s ∈ A + · rw [stopOn_of_mem hA] + exact ae_dirac_done I s + · rw [stopOn_of_notMem hA] + exact h s hs + +/-- The probability that the loop whose step is `f`, from `s`, is in `A` at one of its first `n + 1` +states while it has not stopped. -/ +private noncomputable def hitRun (f : σ → Measure (ForInStep σ)) (A : Set σ) : ℕ → σ → ℝ≥0∞ + | 0, s => A.indicator 1 s + | n + 1, s => open Classical in + if s ∈ A then 1 else ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) + (hitRun f A n) ∂f s + +private lemma measurable_casesOn' {γ : Type*} [MeasurableSpace γ] {d y : σ → γ} + (hd : Measurable d) (hy : Measurable y) : + Measurable fun t : ForInStep σ ↦ ForInStep.casesOn (motive := fun _ ↦ γ) t d y := + fun _ hs ↦ ⟨hy hs, hd hs⟩ + +private lemma measurable_hitRun (hf : Measurable f) {A : Set σ} (hA : MeasurableSet A) : + ∀ n, Measurable (hitRun f A n) + | 0 => measurable_const.indicator hA + | n + 1 => by + classical + exact Measurable.ite hA measurable_const ((Measure.measurable_lintegral + (measurable_casesOn' measurable_const (measurable_hitRun hf hA n))).comp hf) + +private lemma hitRun_le_one (A : Set σ) [hf : IsMarkov f] : ∀ n s, hitRun f A n s ≤ 1 + | 0, s => by simp only [hitRun]; exact Set.indicator_le_self' (fun _ _ ↦ zero_le_one) s + | n + 1, s => by + classical + simp only [hitRun] + split_ifs + · exact le_rfl + · have := hf.isProbabilityMeasure s + calc _ ≤ ∫⁻ _, 1 ∂f s := lintegral_mono fun t ↦ by + cases t <;> simp [hitRun_le_one A n] + _ = 1 := by simp + +/-- The runs still going after `n` steps either are still going in the loop stopped on `A`, or have +been in `A` before. -/ +private lemma loopRun_le_stopOn_add_hitRun [hf : IsMarkov f] {A : Set σ} (hA : MeasurableSet A) : + ∀ n b, loopRun f n b Set.univ ≤ loopRun (stopOn A f) n b Set.univ + hitRun f A n b + | 0, b => by simp + | n + 1, b => by + classical + have hfA := isMarkov_stopOn (f := f) hA + rw [loopRun_succ_apply_univ hf.measurable, loopRun_succ_apply_univ hfA.measurable] + by_cases hb : b ∈ A + · simp only [hitRun, hb, ite_true] + calc _ ≤ (1 : ℝ≥0∞) := (loopRun_succ_apply_univ hf.measurable n b).symm ▸ + loopRun_apply_univ_le_one f (n + 1) b + _ ≤ _ := le_add_self + · simp only [stopOn, hitRun, hb, ite_false] + have hRun : Measurable fun s ↦ loopRun (stopOn A f) n s Set.univ := + (Measure.measurable_coe MeasurableSet.univ).comp (measurable_loopRun hfA.measurable n) + rw [← lintegral_add_left (measurable_casesOn' measurable_const hRun)] + refine lintegral_mono fun t ↦ ?_ + cases t with + | done _ => simp + | yield s => simpa [stopOn] using loopRun_le_stopOn_add_hitRun hA n s + +/-- A loop stops almost surely if, for every `δ > 0`, it stops almost surely once stopped on some +set that it reaches with probability at most `δ`. -/ +private lemma terminates_of_stopOn [IsMarkov f] + (h : ∀ δ : ℝ≥0∞, 0 < δ → ∃ A, MeasurableSet A ∧ Terminates (stopOn A f) b ∧ + ∀ n, hitRun f A n b ≤ δ) : Terminates f b := by + have lim := tendsto_atTop_iInf (antitone_loopRun_apply_univ f b) + suffices ⨅ n, loopRun f n b Set.univ = 0 by rwa [this] at lim + refine le_antisymm (ENNReal.le_of_forall_pos_le_add fun δ hδ _ ↦ ?_) bot_le + obtain ⟨A, hA, hterm, hhit⟩ := h δ (by exact_mod_cast hδ) + have := isMarkov_stopOn (f := f) hA + -- The runs of the stopped loop still going tend to `0`. + refine ge_of_tendsto' (hterm.add_const (δ : ℝ≥0∞)) fun n ↦ ?_ + exact (iInf_le _ n).trans ((loopRun_le_stopOn_add_hitRun hA n b).trans + (by gcongr; exact hhit n)) + +/-- **Maximal inequality**, for a nonnegative supermartingale `W` on an invariant: the probability +of reaching a set on which `W ≥ r` is at most `W / r`. -/ +private lemma mul_hitRun_le_of_supermartingale [hf : IsMarkov f] (I : σ → Prop) + (hI : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run) (W : σ → ℝ≥0∞) (hW : Measurable W) + (hsuper : ∀ s, I s → + ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) W ∂f s ≤ W s) + {A : Set σ} (r : ℝ≥0∞) (hA : ∀ s ∈ A, r ≤ W s) (hAm : MeasurableSet A) : + ∀ n s, I s → r * hitRun f A n s ≤ W s + | 0, s, _ => by + classical + simp only [hitRun, Set.indicator_apply, Pi.one_apply] + split_ifs with h + · simpa using hA s h + · simp + | n + 1, s, hs => by + classical + simp only [hitRun] + split_ifs with h + · simpa using hA s h + · rw [← lintegral_const_mul _ (measurable_casesOn' measurable_const + (measurable_hitRun hf.measurable hAm n))] + refine le_trans (lintegral_mono_ae ?_) (hsuper s hs) + filter_upwards [hI s hs] with t ht + cases t with + | done _ => simp + | yield s' => + have := mul_hitRun_le_of_supermartingale I hI W hW hsuper r hA hAm n s' (by simpa using ht) + simpa using this + + +/-- **Maximal inequality**, for a submartingale `Z ≤ H` that vanishes on `A`: from a state of the +invariant, `Z` plus `H` times the probability of reaching `A` is at most `H`. -/ +private lemma add_mul_hitRun_le_of_submartingale [hf : IsMarkov f] (I : σ → Prop) + (hI : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run) (Z : σ → ℝ≥0∞) (H : ℝ≥0∞) + (hZH : ∀ s, Z s ≤ H) {A : Set σ} (hAm : MeasurableSet A) (hZA : ∀ s ∈ A, Z s = 0) + (hsub : ∀ s, I s → s ∉ A → + Z s ≤ ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ H) Z ∂f s) : + ∀ n s, I s → Z s + H * hitRun f A n s ≤ H + | 0, s, _ => by + classical + simp only [hitRun, Set.indicator_apply, Pi.one_apply] + split_ifs with h + · simp [hZA s h] + · simpa using hZH s + | n + 1, s, hs => by + classical + simp only [hitRun] + split_ifs with h + · simp [hZA s h] + · have := hf.isProbabilityMeasure s + have hmeas : Measurable fun t : ForInStep σ ↦ + H * ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) (hitRun f A n) := + measurable_const.mul (measurable_casesOn' measurable_const + (measurable_hitRun hf.measurable hAm n)) + rw [← lintegral_const_mul _ (measurable_casesOn' measurable_const + (measurable_hitRun hf.measurable hAm n))] + calc _ ≤ ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ H) Z ∂f s + + ∫⁻ t, H * ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) + (hitRun f A n) ∂f s := by gcongr; exact hsub s hs h + _ = ∫⁻ t, (ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ H) Z + + H * ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) + (hitRun f A n)) ∂f s := (lintegral_add_right _ hmeas).symm + _ ≤ ∫⁻ _, H ∂f s := by + refine lintegral_mono_ae ?_ + filter_upwards [hI s hs] with t ht + cases t with + | done _ => simp + | yield s' => + have := add_mul_hitRun_le_of_submartingale I hI Z H hZH hAm hZA hsub n s' + (by simpa using ht) + simpa using this + _ = H := by simp + +/-! ### The loop `while G do body` -/ + +/-- The step of the loop `while G do body`, whose body is a family `body` of measures on the +states: from a state satisfying `G`, run the body and carry on; from any other state, stop. -/ +noncomputable def whileStep (G : σ → Prop) (body : σ → Measure σ) (s : σ) : + Measure (ForInStep σ) := + open Classical in if G s then (body s).map ForInStep.yield else Measure.dirac (ForInStep.done s) + +lemma isMarkov_whileStep {G : σ → Prop} (hG : MeasurableSet {s | G s}) {body : σ → Measure σ} + [hbody : IsMarkov body] : IsMarkov (whileStep G body) := by + classical + refine ⟨Measurable.ite hG ((Measure.measurable_map _ ForInStep.measurable_yield).comp + hbody.measurable) (Measure.measurable_dirac.comp ForInStep.measurable_done), fun s ↦ ?_⟩ + unfold whileStep + split_ifs + · have := hbody.isProbabilityMeasure s + exact Measure.isProbabilityMeasure_map ForInStep.measurable_yield.aemeasurable + · infer_instance + + +section whileStep + +variable {G : σ → Prop} {body : σ → Measure σ} {s : σ} + +private lemma whileStep_of_pos (h : G s) : whileStep G body s = (body s).map ForInStep.yield := by + classical + simp [whileStep, h] + +private lemma whileStep_of_neg (h : ¬G s) : + whileStep G body s = Measure.dirac (ForInStep.done s) := by + classical + simp [whileStep, h] + +/-- A predicate holding with probability `1`: its complement is null. -/ +private lemma measure_compl_eq_zero_of_one_le {μ : Measure σ} [IsProbabilityMeasure μ] + {P : σ → Prop} (hP : MeasurableSet {s | P s}) (h : 1 ≤ (μ {s | P s}).toReal) : + μ {s | P s}ᶜ = 0 := by + rw [measure_compl hP (measure_ne_top _ _), measure_univ] + exact tsub_eq_zero_of_le (by simpa using ENNReal.ofReal_le_of_le_toReal h) + +/-- A step from a state of an invariant `Inv` satisfying `G` carries on in `Inv`, almost surely. -/ +private lemma ae_whileStep {Inv : σ → Prop} (hInv : MeasurableSet {s | Inv s}) + (h : G s → 1 ≤ (body s {s' | Inv s'}).toReal) [IsMarkov body] : + ∀ᵐ t ∂whileStep G body s, ¬t.isDone → Inv t.run := by + by_cases hG : G s + · rw [whileStep_of_pos hG, ForInStep.measurableEmbedding_yield.ae_map_iff] + have := IsMarkov.isProbabilityMeasure (κ := body) s + filter_upwards [measure_eq_zero_iff_ae_notMem.1 (measure_compl_eq_zero_of_one_le hInv (h hG))] + with s' hs' + simpa using hs' + · rw [whileStep_of_neg hG] + exact ae_dirac_done Inv s + +end whileStep + +namespace Terminates + +/-- **Variant rule for loops** (McIver and Morgan 2005, Lemma 7.5.1, first stated as Lemma 2.7.1). + +For the loop `while G do body`, let `V` be an integer-valued function of the state and `Inv` a +predicate such that +1. there are integers `L` and `H` with `G ∧ Inv ⇛ L ≤ V < H`; +2. `[Inv]` is a strong invariant: `[G] ∗ [Inv] ⇛ wp.body.[Inv]`; +3. for some probability `ε > 0` and all integers `N`, `ε ∗ [G ∧ Inv ∧ (V = N)] ⇛ wp.body.[V < N]`. + +Then the loop terminates with probability `1` from every state satisfying `Inv`: `[Inv] ⇛ T`. + +The body is a Markov kernel, and `wp.body.[P]` at `s` is the probability `body s {s' | P s'}`. The +bound `ε ≤ 1`, implicit in "probability", is not needed. -/ +theorem mcIverMorgan_variantRule {G Inv : σ → Prop} {body : σ → Measure σ} + (V : σ → ℤ) (L H : ℤ) (ε : ℝ) (hε : 0 < ε) + (h1 : ∀ s, G s → Inv s → L ≤ V s ∧ V s < H) + (h2 : ∀ s, G s → Inv s → 1 ≤ (body s {s' | Inv s'}).toReal) + (h3 : ∀ N : ℤ, ∀ s, G s → Inv s → V s = N → ε ≤ (body s {s' | V s' < N}).toReal) + (hb : Inv b) (hG : MeasurableSet {s | G s} := by measurability) + (hInv : MeasurableSet {s | Inv s} := by measurability) (hV : Measurable V := by fun_prop) + (hbody : IsMarkov body := by is_markov) : Terminates (whileStep G body) b := by + classical + have := isMarkov_whileStep (body := body) hG + -- The variant shifted to `ℕ`, and set to `0` on the states where the loop stops. + let V' : σ → ℕ := fun s ↦ if G s then (V s - L + 1).toNat else 0 + have hV' : Measurable V' := + Measurable.ite hG ((Measurable.of_discrete (f := fun z : ℤ ↦ (z - L + 1).toNat)).comp hV) + measurable_const + refine terminates_of_variant Inv (fun s hs ↦ ae_whileStep hInv (h2 s · hs)) V' hV' + (H - L).toNat (fun s hs ↦ ?_) (min (ENNReal.ofReal ε) 1) + (lt_min (ENNReal.ofReal_pos.2 hε) one_pos).ne' (fun s hs ↦ ?_) hb + · simp only [V'] + split_ifs with hG + · have := h1 s hG hs + exact Int.toNat_le_toNat (by omega) + · exact Nat.zero_le _ + · by_cases hG : G s + · have := IsMarkov.isProbabilityMeasure (κ := body) s + rw [whileStep_of_pos hG, ForInStep.measurableEmbedding_yield.map_apply] + refine (min_le_left _ _).trans + ((ENNReal.ofReal_le_of_le_toReal (h3 (V s) s hG hs rfl)).trans ?_) + rw [← measure_inter_conull (measure_compl_eq_zero_of_one_le hInv (h2 s hG hs))] + refine measure_mono fun s' ⟨hlt, hInv'⟩ ↦ Or.inr ?_ + have := h1 s hG hs + simp only [Set.mem_ofPred_eq] at hlt hInv' + change V' s' < V' s + simp only [V', hG, ite_true] + split_ifs with hG' + · have := h1 s' hG' hInv' + omega + · omega + · rw [whileStep_of_neg hG, Measure.dirac_apply_of_mem (by simp)] + exact min_le_right _ _ + + +/-- **Variant rule for loops** (McIver and Morgan 2005, Lemma 2.7.1): the bounds on the variant are +only asked when the states satisfying `G ∧ Inv` are infinitely many, and `0 < ε ≤ 1`. -/ +theorem mcIverMorgan_variantRule_of_finite {G Inv : σ → Prop} {body : σ → Measure σ} + (V : σ → ℤ) (ε : ℝ) (hε : 0 < ε) (_hε1 : ε ≤ 1) + (h1 : ¬{s | G s ∧ Inv s}.Finite → ∃ L H : ℤ, ∀ s, G s → Inv s → L ≤ V s ∧ V s < H) + (h2 : ∀ s, G s → Inv s → 1 ≤ (body s {s' | Inv s'}).toReal) + (h3 : ∀ N : ℤ, ∀ s, G s → Inv s → V s = N → ε ≤ (body s {s' | V s' < N}).toReal) + (hb : Inv b) (hG : MeasurableSet {s | G s} := by measurability) + (hInv : MeasurableSet {s | Inv s} := by measurability) (hV : Measurable V := by fun_prop) + (hbody : IsMarkov body := by is_markov) : Terminates (whileStep G body) b := by + -- Over finitely many states, the variant takes finitely many values. + obtain ⟨L, H, hLH⟩ : ∃ L H : ℤ, ∀ s, G s → Inv s → L ≤ V s ∧ V s < H := by + by_cases hfin : {s | G s ∧ Inv s}.Finite + · obtain ⟨L, hL⟩ := (hfin.image V).bddBelow + obtain ⟨H, hH⟩ := (hfin.image V).bddAbove + exact ⟨L, H + 1, fun s hG hI ↦ ⟨hL ⟨s, ⟨hG, hI⟩, rfl⟩, + Int.lt_add_one_iff.2 (hH ⟨s, ⟨hG, hI⟩, rfl⟩)⟩⟩ + · exact h1 hfin + exact mcIverMorgan_variantRule V L H ε hε hLH h2 h3 hb hG hInv hV hbody + +/-- **Variant rule for loops, with a variant that cannot increase** (McIver and Morgan 2005, p. 56, +stated and derived there informally from Lemma 2.7.1). The variant is bounded below but not +necessarily above, it decreases with probability at least `ε > 0`, and it cannot increase: its +initial value bounds it above. -/ +theorem mcIverMorgan_variantRule_of_antitone {G Inv : σ → Prop} {body : σ → Measure σ} + (V : σ → ℤ) (L : ℤ) (ε : ℝ) (hε : 0 < ε) + (h1 : ∀ s, G s → Inv s → L ≤ V s) + (h2 : ∀ s, G s → Inv s → 1 ≤ (body s {s' | Inv s'}).toReal) + (h3 : ∀ N : ℤ, ∀ s, G s → Inv s → V s = N → ε ≤ (body s {s' | V s' < N}).toReal) + (h4 : ∀ N : ℤ, ∀ s, G s → Inv s → V s = N → 1 ≤ (body s {s' | V s' ≤ N}).toReal) + (hb : Inv b) (hG : MeasurableSet {s | G s} := by measurability) + (hInv : MeasurableSet {s | Inv s} := by measurability) (hV : Measurable V := by fun_prop) + (hbody : IsMarkov body := by is_markov) : Terminates (whileStep G body) b := by + have hle : MeasurableSet {s | V s ≤ V b} := hV measurableSet_Iic + refine mcIverMorgan_variantRule (Inv := fun s ↦ Inv s ∧ V s ≤ V b) V L (V b + 1) ε hε + (fun s hG hs ↦ ⟨h1 s hG hs.1, Int.lt_add_one_iff.2 hs.2⟩) (fun s hG hs ↦ ?_) + (fun N s hG hs ↦ h3 N s hG hs.1) ⟨hb, le_rfl⟩ hG (hInv.inter hle) hV hbody + -- The invariant is kept, and the variant does not increase, almost surely. + have := IsMarkov.isProbabilityMeasure (κ := body) s + refine le_trans ?_ (ENNReal.toReal_mono (measure_ne_top _ _) + (measure_mono (s := {s' | V s' ≤ V s} ∩ {s' | Inv s'}) fun s' ⟨hV', hI'⟩ ↦ + ⟨hI', hV'.trans hs.2⟩)) + rw [measure_inter_conull (measure_compl_eq_zero_of_one_le hInv (h2 s hG hs.1))] + exact h4 (V s) s hG hs.1 rfl + + +/-- **New variant rule for loops** (McIver, Morgan, Kaminski and Katoen, *A New Proof Rule for +Almost-Sure Termination*, POPL 2018, Theorem 4.1). + +For the loop `while G do body`, let `I` be a predicate, `V` a nonnegative real-valued function of +the state, not necessarily bounded, and `p` ("probability", valued in `(0, 1]`) and `d` +("decrease", valued in `ℝ>0`) fixed functions of the nonnegative reals, both antitone on strictly +positive arguments, such that +* (i) `I` is a standard invariant of the loop: `[G ∧ I] ≤ wp.body.[I]`; +* (ii) `G ∧ I ⇒ V > 0`; +* (iii) for every `R > 0`, `p(R) · [G ∧ I ∧ V = R] ≤ wp.body.[V ≤ R - d(R)]`; +* (iv) `V` is a super-martingale: for every `H > 0`, `[G ∧ I] · (H ⊖ V) ≤ wp.body.(H ⊖ V)`, where + `H ⊖ V = max (H - V) 0`. + +Then the loop terminates with probability `1` from every state satisfying `I`. + +The body is a Markov kernel, `wp.body.[P]` at `s` is the probability `body s {s' | P s'}`, and +`wp.body.(H ⊖ V)` is the integral of `H ⊖ V` against `body s`. -/ +theorem mcIverMorganKaminskiKatoen {G I : σ → Prop} {body : σ → Measure σ} + (V : σ → ℝ) (hV0 : ∀ s, 0 ≤ V s) (p d : ℝ → ℝ) + (hp : ∀ r, 0 ≤ r → 0 < p r ∧ p r ≤ 1) (hd : ∀ r, 0 ≤ r → 0 < d r) + (hp_anti : AntitoneOn p (Set.Ioi 0)) (hd_anti : AntitoneOn d (Set.Ioi 0)) + (h1 : ∀ s, G s → I s → 1 ≤ (body s {s' | I s'}).toReal) + (h2 : ∀ s, G s → I s → 0 < V s) + (h3 : ∀ R, 0 < R → ∀ s, G s → I s → V s = R → p R ≤ (body s {s' | V s' ≤ R - d R}).toReal) + (h4 : ∀ H, 0 < H → ∀ s, G s → I s → + ENNReal.ofReal (H - V s) ≤ ∫⁻ s', ENNReal.ofReal (H - V s') ∂body s) + (hb : I b) (hG : MeasurableSet {s | G s} := by measurability) + (hI : MeasurableSet {s | I s} := by measurability) (hV : Measurable V := by fun_prop) + (hbody : IsMarkov body := by is_markov) : Terminates (whileStep G body) b := by + classical + have := isMarkov_whileStep (body := body) hG + have hIf : ∀ s, I s → ∀ᵐ t ∂whileStep G body s, ¬t.isDone → I t.run := + fun s hs ↦ ae_whileStep hI (h1 s · hs) + refine terminates_of_stopOn fun δ hδ ↦ ?_ + -- A level `H` above `V b`, high enough for `V b / H ≤ δ`. + obtain ⟨H, hVH, hHδ⟩ : ∃ H : ℝ, V b < H ∧ ENNReal.ofReal (V b) / ENNReal.ofReal H ≤ δ := by + by_cases hδtop : δ = ⊤ + · exact ⟨V b + 1, by linarith, hδtop ▸ le_top⟩ + have hδ' : 0 < δ.toReal := ENNReal.toReal_pos hδ.ne' hδtop + have hq := div_nonneg (hV0 b) hδ'.le + have hH : 0 < V b + 1 + V b / δ.toReal := by linarith [hV0 b] + refine ⟨V b + 1 + V b / δ.toReal, by linarith, ?_⟩ + rw [← ENNReal.ofReal_div_of_pos hH] + calc ENNReal.ofReal (V b / (V b + 1 + V b / δ.toReal)) ≤ ENNReal.ofReal δ.toReal := by + refine ENNReal.ofReal_le_ofReal ((div_le_iff₀ hH).2 ?_) + have : δ.toReal * (V b / δ.toReal) = V b := by field_simp + nlinarith [hV0 b] + _ = δ := ENNReal.ofReal_toReal hδtop + have hH : 0 < H := (hV0 b).trans_lt hVH + set A := {s | H ≤ V s} + have hA : MeasurableSet A := hV measurableSet_Ici + refine ⟨A, hA, ?_, fun n ↦ ?_⟩ + · -- Below the level `H`, the variant `⌈V / d(H)⌉` decreases with probability at least `p(H)`. + have := isMarkov_stopOn (f := whileStep G body) hA + have hdH := hd H hH.le + let V' : σ → ℕ := fun s ↦ if G s ∧ V s < H then ⌈V s / d H⌉₊ else 0 + have hV' : Measurable V' := + Measurable.ite (hG.inter (hV measurableSet_Iio)) (Measurable.nat_ceil (hV.div_const (d H))) + measurable_const + refine terminates_of_variant I (ae_stopOn hIf) V' hV' ⌈H / d H⌉₊ (fun s _ ↦ ?_) + (min (ENNReal.ofReal (p H)) 1) (lt_min (ENNReal.ofReal_pos.2 (hp H hH.le).1) one_pos).ne' + (fun s hs ↦ ?_) hb + · simp only [V'] + split_ifs with h + · exact Nat.ceil_mono (div_le_div_of_nonneg_right h.2.le hdH.le) + · exact Nat.zero_le _ + · by_cases hsA : s ∈ A + · rw [stopOn_of_mem hsA, Measure.dirac_apply_of_mem (by simp)] + exact min_le_right _ _ + rw [stopOn_of_notMem hsA] + simp only [A, Set.mem_ofPred_eq, not_le] at hsA + by_cases hGs : G s + · have := IsMarkov.isProbabilityMeasure (κ := body) s + have hVs := h2 s hGs hs + rw [whileStep_of_pos hGs, ForInStep.measurableEmbedding_yield.map_apply] + refine (min_le_left _ _).trans ?_ + refine (ENNReal.ofReal_le_ofReal (hp_anti hVs hH hsA.le)).trans ?_ + refine (ENNReal.ofReal_le_of_le_toReal (h3 (V s) hVs s hGs hs rfl)).trans ?_ + refine measure_mono fun s' hs' ↦ Or.inr ?_ + simp only [Set.mem_ofPred_eq] at hs' + have hdle : d H ≤ d (V s) := hd_anti hVs hH hsA.le + change V' s' < V' s + have hV's : V' s = ⌈V s / d H⌉₊ := by simp [V', hGs, hsA] + rw [hV's, Nat.lt_ceil] + simp only [V'] + split_ifs with h' + · calc (⌈V s' / d H⌉₊ : ℝ) < V s' / d H + 1 := + Nat.ceil_lt_add_one (div_nonneg (hV0 s') hdH.le) + _ ≤ V s / d H := by + rw [div_add_one hdH.ne', div_le_div_iff_of_pos_right hdH] + linarith + · simpa using div_pos hVs hdH + · rw [whileStep_of_neg hGs, Measure.dirac_apply_of_mem (by simp)] + exact min_le_right _ _ + · -- The maximal inequality, for the submartingale `H ⊖ V`. + have hmax := add_mul_hitRun_le_of_submartingale (f := whileStep G body) I hIf + (fun s ↦ ENNReal.ofReal (H - V s)) (ENNReal.ofReal H) + (fun s ↦ ENNReal.ofReal_le_ofReal (by linarith [hV0 s])) hA + (fun s hs ↦ ENNReal.ofReal_eq_zero.2 (by simp only [A, Set.mem_ofPred_eq] at hs; linarith)) + (fun s hs hsA ↦ ?_) n b hb + · have hsub := ENNReal.le_sub_of_add_le_left ENNReal.ofReal_ne_top hmax + rw [← ENNReal.ofReal_sub _ (by linarith), sub_sub_cancel] at hsub + refine le_trans ?_ hHδ + rw [ENNReal.le_div_iff_mul_le (Or.inl (ENNReal.ofReal_pos.2 hH).ne') + (Or.inl ENNReal.ofReal_ne_top), mul_comm] + exact hsub + · have hZ : Measurable fun s ↦ ENNReal.ofReal (H - V s) := + ENNReal.measurable_ofReal.comp (measurable_const.sub hV) + by_cases hGs : G s + · rw [whileStep_of_pos hGs, ForInStep.measurableEmbedding_yield.lintegral_map] + exact h4 H hH s hGs hs + · rw [whileStep_of_neg hGs, lintegral_dirac' _ (measurable_casesOn' measurable_const hZ)] + exact ENNReal.ofReal_le_ofReal (by linarith [hV0 s]) + + +/-- **Variant rule for almost-sure termination** (McIver and Morgan 2005, in the form of Majumdar +and Sathiyanarayana, *Sound and Complete Proof Rules for Probabilistic Termination*, POPL 2025, +Proof Rule 3.1 and Lemma 3.1). + +The program is the transition system whose states are the `ForInStep σ`: the successor of a state +`yield s` is drawn from `f s`, and the states `done s` are terminal. To show that it terminates +almost surely from `yield b`, find +1. an inductive invariant `Inv` containing `yield b`; +2. a variant function `U : Inv → ℤ`; +3. bounds `Lo` and `Hi` such that `Lo ≤ U < Hi` on `Inv`; +4. an `ε > 0`, + +such that, for each state of `Inv`, +* (4.1) if it is terminal, `U = Lo`; +* (4.3) otherwise, the successors that decrease `U` have a total probability `> ε`. + +Every non-terminal state is probabilistic, so condition (4.2) on assignment and nondeterministic +states does not apply, and "every successor" is "almost every successor". -/ +theorem majumdarSathiyanarayana_variantRule (Inv : ForInStep σ → Prop) (U : ForInStep σ → ℤ) + (Lo Hi : ℤ) (ε : ℝ) (hε : 0 < ε) (hb : Inv (.yield b)) + (hInv : ∀ s, Inv (.yield s) → ∀ᵐ t ∂f s, Inv t) + (hbounds : ∀ t, Inv t → Lo ≤ U t ∧ U t < Hi) + (_hdone : ∀ s, Inv (.done s) → U (.done s) = Lo) + (hprog : ∀ s, Inv (.yield s) → ε < (f s {t | U t < U (.yield s)}).toReal) + (hU : Measurable U := by fun_prop) (hf : IsMarkov f := by is_markov) : Terminates f b := by + let V' : σ → ℕ := fun s ↦ (U (.yield s) - Lo).toNat + have hV' : Measurable V' := + (Measurable.of_discrete (f := fun z : ℤ ↦ (z - Lo).toNat)).comp + (hU.comp ForInStep.measurable_yield) + refine terminates_of_variant (fun s ↦ Inv (.yield s)) (fun s hs ↦ ?_) V' hV' (Hi - Lo).toNat + (fun s hs ↦ Int.toNat_le_toNat (by linarith [(hbounds _ hs).2])) (min (ENNReal.ofReal ε) 1) + (lt_min (ENNReal.ofReal_pos.2 hε) one_pos).ne' (fun s hs ↦ ?_) hb + · filter_upwards [hInv s hs] with t ht + cases t with + | done _ => simp + | yield _ => simpa using ht + · refine (min_le_left _ _).trans ((ENNReal.ofReal_le_of_le_toReal (hprog s hs).le).trans ?_) + rw [← measure_inter_conull (t := {t | Inv t}) + (by rw [Set.compl_ofPred]; exact ae_iff.1 (hInv s hs))] + refine measure_mono fun t ⟨hlt, ht⟩ ↦ ?_ + cases t with + | done _ => simp + | yield s' => + simp only [Set.mem_ofPred_eq] at hlt ht + have := (hbounds _ ht).1 + simp only [Set.mem_ofPred_eq, ForInStep.isDone_yield, Bool.false_eq_true, false_or, + ForInStep.run_yield, V'] + omega + +/-- **Martingale rule for almost-sure termination** (Majumdar and Sathiyanarayana, *Sound and +Complete Proof Rules for Probabilistic Termination*, POPL 2025, Proof Rule 3.2 and Lemma 3.2). + +The program is the transition system whose states are the `ForInStep σ`, as in +`majumdarSathiyanarayana_variantRule`. To show that it terminates almost surely from `yield b`, +find +1. an inductive invariant `Inv` containing `yield b`; +2. a supermartingale function `V : Inv → ℝ` that assigns `0` to the terminal states and, at every + other state of `Inv`, (2.1) is positive and (2.3) is at least the expected value of `V` after a + step; +3. a variant function `U : Inv → ℕ` that assigns `0` to the terminal states and satisfies, on each + sublevel set `V≤r = {σ ∈ Inv | V σ ≤ r}`, + (3.2.1) `U` is bounded on `V≤r`, and + (3.2.2) there is an `εᵣ > 0` such that from every non-terminal state of `V≤r`, the successors + that decrease `U` have a total probability `> εᵣ`. + +Every non-terminal state is probabilistic, so conditions (2.2) and (3.1) on assignment and +nondeterministic states do not apply, and "every successor" is "almost every successor". -/ +theorem majumdarSathiyanarayana_martingaleRule (Inv : ForInStep σ → Prop) (V : ForInStep σ → ℝ) + (U : ForInStep σ → ℕ) (hb : Inv (.yield b)) (hInv : ∀ s, Inv (.yield s) → ∀ᵐ t ∂f s, Inv t) + (hVdone : ∀ s, Inv (.done s) → V (.done s) = 0) + (hVpos : ∀ s, Inv (.yield s) → 0 < V (.yield s)) + (hVsuper : ∀ s, Inv (.yield s) → + ∫⁻ t, ENNReal.ofReal (V t) ∂f s ≤ ENNReal.ofReal (V (.yield s))) + (_hUdone : ∀ s, Inv (.done s) → U (.done s) = 0) + (hUbdd : ∀ r : ℝ, ∃ B : ℕ, ∀ t, Inv t → V t ≤ r → U t ≤ B) + (hUprog : ∀ r : ℝ, ∃ ε : ℝ, 0 < ε ∧ ∀ s, Inv (.yield s) → V (.yield s) ≤ r → + ε < (f s {t | U t < U (.yield s)}).toReal) + (hV : Measurable V := by fun_prop) (hU : Measurable U := by fun_prop) + (hf : IsMarkov f := by is_markov) : Terminates f b := by + classical + let I : σ → Prop := fun s ↦ Inv (.yield s) + have hI : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run := fun s hs ↦ by + filter_upwards [hInv s hs] with t ht + cases t with + | done _ => simp + | yield _ => simpa [I] using ht + have hVy : Measurable fun s ↦ V (.yield s) := hV.comp ForInStep.measurable_yield + refine terminates_of_stopOn fun δ hδ ↦ ?_ + -- A level `r` above `V b`, high enough for `V b / r ≤ δ`. + obtain ⟨r, hVr, hrδ⟩ : ∃ r : ℝ, V (.yield b) < r ∧ + ENNReal.ofReal (V (.yield b)) / ENNReal.ofReal r ≤ δ := by + have hV0 := (hVpos b hb).le + by_cases hδtop : δ = ⊤ + · exact ⟨V (.yield b) + 1, by linarith, hδtop ▸ le_top⟩ + have hδ' : 0 < δ.toReal := ENNReal.toReal_pos hδ.ne' hδtop + have hq := div_nonneg hV0 hδ'.le + have hr : 0 < V (.yield b) + 1 + V (.yield b) / δ.toReal := by linarith + refine ⟨V (.yield b) + 1 + V (.yield b) / δ.toReal, by linarith, ?_⟩ + rw [← ENNReal.ofReal_div_of_pos hr] + calc ENNReal.ofReal (V (.yield b) / (V (.yield b) + 1 + V (.yield b) / δ.toReal)) + ≤ ENNReal.ofReal δ.toReal := by + refine ENNReal.ofReal_le_ofReal ((div_le_iff₀ hr).2 ?_) + have : δ.toReal * (V (.yield b) / δ.toReal) = V (.yield b) := by field_simp + nlinarith + _ = δ := ENNReal.ofReal_toReal hδtop + have hr : 0 < r := (hVpos b hb).trans hVr + set A := {s | r < V (.yield s)} + have hA : MeasurableSet A := hVy measurableSet_Ioi + refine ⟨A, hA, ?_, fun n ↦ ?_⟩ + · -- Within the sublevel set `V ≤ r`, the variant `U` is bounded and decreases with probability + -- at least `εᵣ`. + have := isMarkov_stopOn (f := f) hA + obtain ⟨B, hB⟩ := hUbdd r + obtain ⟨ε, hε, hprog⟩ := hUprog r + let V' : σ → ℕ := fun s ↦ if s ∈ A then 0 else U (.yield s) + have hV' : Measurable V' := + Measurable.ite hA measurable_const (hU.comp ForInStep.measurable_yield) + refine terminates_of_variant I (ae_stopOn hI) V' hV' B (fun s hs ↦ ?_) + (min (ENNReal.ofReal ε) 1) (lt_min (ENNReal.ofReal_pos.2 hε) one_pos).ne' + (fun s hs ↦ ?_) hb + · simp only [V'] + split_ifs with hsA + · exact Nat.zero_le _ + · exact hB _ hs (by simpa [A] using hsA) + · by_cases hsA : s ∈ A + · rw [stopOn_of_mem hsA, Measure.dirac_apply_of_mem (by simp)] + exact min_le_right _ _ + rw [stopOn_of_notMem hsA] + refine (min_le_left _ _).trans ((ENNReal.ofReal_le_of_le_toReal + (hprog s hs (by simpa [A] using hsA)).le).trans ?_) + rw [← measure_inter_conull (t := {t | Inv t}) + (by rw [Set.compl_ofPred]; exact ae_iff.1 (hInv s hs))] + refine measure_mono fun t ⟨hlt, ht⟩ ↦ ?_ + cases t with + | done _ => simp + | yield s' => + simp only [Set.mem_ofPred_eq] at hlt + simp only [Set.mem_ofPred_eq, ForInStep.isDone_yield, Bool.false_eq_true, false_or, + ForInStep.run_yield] + have hV's : V' s = U (.yield s) := by simp [V', hsA] + rw [hV's] + refine lt_of_le_of_lt ?_ hlt + simp only [V'] + split_ifs + · exact Nat.zero_le _ + · exact le_rfl + · -- The maximal inequality, for the nonnegative supermartingale `V`. + have hsuper : ∀ s, I s → ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) + (fun s ↦ ENNReal.ofReal (V (.yield s))) ∂f s ≤ ENNReal.ofReal (V (.yield s)) := by + intro s hs + refine le_trans (le_of_eq (lintegral_congr_ae ?_)) (hVsuper s hs) + filter_upwards [hInv s hs] with t ht + cases t with + | done s' => simp [hVdone s' ht] + | yield s' => rfl + have hmax := mul_hitRun_le_of_supermartingale I hI (fun s ↦ ENNReal.ofReal (V (.yield s))) + (ENNReal.measurable_ofReal.comp hVy) hsuper (ENNReal.ofReal r) + (fun s hs ↦ ENNReal.ofReal_le_ofReal hs.le) hA n b hb + refine le_trans ?_ hrδ + rw [ENNReal.le_div_iff_mul_le (Or.inl (ENNReal.ofReal_pos.2 hr).ne') + (Or.inl ENNReal.ofReal_ne_top), mul_comm] + exact hmax + +end Terminates + +/-- **Lyapunov ranking functions** (Bournez and Garnier, *Proving positive almost-sure termination*, +RTA 2005, Theorem 2, in the form recalled by Ferrer Fioriti and Hermanns, *Probabilistic +Termination: Soundness, Completeness, and Compositionality*, POPL 2015, equation (1)). + +The program is the transition system whose states are the `ForInStep σ`, as in +`Terminates.majumdarSathiyanarayana_variantRule`. A map `v` from its states to the nonnegative +reals is a Lyapunov ranking function if there is an `ε > 0` such that +`v(s) ≥ Σ_{s'} P(s, s') v(s') + ε` at every state `s` where a step is enabled, that is at every +non-terminal state. Then the program terminates almost surely, and `v(s) / ε` bounds the expected +number of steps before termination (by Foster's theorem): it is positively almost surely +terminating. Bournez and Garnier take `v` real-valued and bounded below, which is the same up to a +shift. -/ +theorem bournezGarnier (v : ForInStep σ → ℝ≥0) (ε : ℝ≥0) (hε : 0 < ε) + (h : ∀ s, ∫⁻ t, (v t : ℝ≥0∞) ∂f s + ε ≤ v (.yield s)) (hf : IsMarkov f := by is_markov) : + Terminates f b ∧ expectedSteps f b ≤ v (.yield b) / ε := by + -- `ε` times the expected number of steps among the first `n` is at most `v`. + have key : ∀ n s, (ε : ℝ≥0∞) * ∑ k ∈ Finset.range n, loopRun f k s Set.univ ≤ v (.yield s) := by + intro n + induction n with + | zero => simp + | succ n ih => + intro s + have hmeas : ∀ k, Measurable fun s' ↦ loopRun f k s' Set.univ := fun k ↦ + (Measure.measurable_coe MeasurableSet.univ).comp (measurable_loopRun hf.measurable k) + have hsum : ∑ k ∈ Finset.range n, loopRun f (k + 1) s Set.univ = + ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) + (fun s' ↦ ∑ k ∈ Finset.range n, loopRun f k s' Set.univ) ∂f s := by + simp_rw [loopRun_succ_apply_univ hf.measurable] + rw [← lintegral_finsetSum _ fun k _ ↦ measurable_casesOn' measurable_const (hmeas k)] + exact lintegral_congr fun t ↦ by cases t <;> simp + rw [Finset.sum_range_succ', hsum, loopRun_zero_apply_univ, mul_add, mul_one, + ← lintegral_const_mul' _ _ ENNReal.coe_ne_top] + refine le_trans ?_ (h s) + refine add_le_add_left (lintegral_mono fun t ↦ ?_) _ + cases t with + | done _ => simp + | yield s' => simpa using ih s' + have hle : expectedSteps f b ≤ v (.yield b) / ε := by + rw [expectedSteps, ENNReal.tsum_eq_iSup_nat] + refine iSup_le fun n ↦ ?_ + rw [ENNReal.le_div_iff_mul_le (Or.inl (ENNReal.coe_ne_zero.2 hε.ne')) + (Or.inl ENNReal.coe_ne_top), mul_comm] + exact key n b + refine ⟨ENNReal.tendsto_atTop_zero_of_tsum_ne_top (ne_top_of_le_ne_top ?_ hle), hle⟩ + exact ENNReal.div_ne_top ENNReal.coe_ne_top (ENNReal.coe_ne_zero.2 hε.ne') + +end MeasurableSpaceMonadWhile diff --git a/Test/IsMarkov.lean b/Test/IsMarkov.lean index 5bb33e4..13bc4fb 100644 --- a/Test/IsMarkov.lean +++ b/Test/IsMarkov.lean @@ -11,7 +11,8 @@ set_option linter.style.header false node. There is one test here per construct it recognises. -/ -open MeasureTheory ProbabilityTheory MeasurableSpacePure +open scoped ENNReal +open MeasureTheory ProbabilityTheory MeasurableSpacePure MeasurableSpaceMonadWhile @[expose] public section @@ -95,9 +96,9 @@ example : IsMarkov overList := by is_markov /-! ## `while`, whose termination is handed back -`is_markov` proves the measurability of a `while` loop, and hands back its termination: the loop is -a probability measure exactly when the mass of its runs still going after `n` steps tends to `0`. -Each test takes that as a hypothesis, which closes the only goal left. -/ +`is_markov` proves that a `while` loop is Markovian up to its termination, which it hands back as a +goal `Terminates`. Each test closes it with a proof rule of the literature, from +`RandomDo.Tactic.IsMarkov.Termination`. -/ noncomputable def untilHeads : Measure ℕ := rdo let mut n := 0 @@ -108,13 +109,22 @@ noncomputable def untilHeads : Measure ℕ := rdo break return n -example (h : ∀ _ : Unit, Filter.Tendsto (fun k ↦ MeasurableSpaceMonad.loopRun (m := Measure) - (fun n : ℕ ↦ fairCoin >>=ₘ fun heads ↦ - if heads then mPure (ForInStep.done (n + 1)) else mPure (ForInStep.yield (n + 1))) - k 0 Set.univ) Filter.atTop (nhds 0)) : - IsProbabilityMeasure untilHeads := by +/-- The variant rule of McIver and Morgan, as stated by Majumdar and Sathiyanarayana: the variant is +`1` while the loop runs, `0` once it has stopped. -/ +example : IsProbabilityMeasure untilHeads := by is_markov - exact h + refine fun _ ↦ .majumdarSathiyanarayana_variantRule (fun _ ↦ True) + (fun t ↦ if t.isDone then 0 else 1) 0 2 (1 / 4) (by norm_num) trivial + (fun _ _ ↦ Filter.Eventually.of_forall fun _ ↦ trivial) (fun t _ ↦ by split_ifs <;> simp) + (fun _ _ ↦ by simp) fun n _ ↦ ?_ + norm_num [fairCoin] + +/-- The Lyapunov ranking function of Bournez and Garnier, `2` while the loop runs: the loop also +takes at most `2` steps in expectation. -/ +example : IsProbabilityMeasure untilHeads := by + is_markov + exact fun _ ↦ (bournezGarnier (fun t ↦ if t.isDone then 0 else 2) 1 one_pos fun n ↦ by + norm_num [fairCoin, ENNReal.ofReal_div_of_pos, ENNReal.inv_mul_cancel]).1 /-- A `while` loop whose condition reads the parameter. -/ noncomputable def climbFrom (k : ℕ) : Measure ℕ := rdo @@ -125,14 +135,188 @@ noncomputable def climbFrom (k : ℕ) : Measure ℕ := rdo n := n + 1 return n -example (h : ∀ k, Filter.Tendsto (fun j ↦ MeasurableSpaceMonad.loopRun (m := Measure) - (fun n : ℕ ↦ if n < k + 3 then - fairCoin >>=ₘ fun heads ↦ - if heads then mPure (ForInStep.yield (n + 1)) else mPure (ForInStep.yield n) - else mPure (ForInStep.done n)) j k Set.univ) Filter.atTop (nhds 0)) : - IsMarkov climbFrom := by +/-- The variant rule of McIver and Morgan (Lemma 2.7.1) on the loop `while n < k + 3 do body`: the +states where the loop runs are finitely many, so the variant `k + 3 - n` needs no bounds. -/ +example : IsMarkov climbFrom := by + is_markov + intro k + convert Terminates.mcIverMorgan_variantRule_of_finite (G := (· < k + 3)) (Inv := (k ≤ ·)) + (body := fun n ↦ fairCoin >>=ₘ fun heads ↦ if heads then mPure (n + 1) else mPure n) + (fun n ↦ (k : ℤ) + 3 - n) (1 / 2) (by norm_num) (by norm_num) + (fun h ↦ absurd ((Set.finite_Ico k (k + 3)).subset fun s hs ↦ ⟨hs.2, hs.1⟩) h) + (fun s _ hs ↦ ?_) (fun N s _ _ hN ↦ ?_) le_rfl using 1 + · funext n + by_cases h : n < k + 3 <;> simp [whileStep, h, fairCoin, Measure.map_add, Measure.map_smul, + ForInStep.measurable_yield] + · norm_num [fairCoin, hs, show k ≤ s + 1 by omega] + · subst hN + norm_num [fairCoin] + +/-- A deterministic countdown, whose counter is bounded only by its initial value. -/ +noncomputable def countdown (k : ℕ) : Measure ℕ := rdo + let mut i := k + while 0 < i rdo + i := i - 1 + return i + +/-- The variant rule of McIver and Morgan with a variant that cannot increase (p. 56): the counter +itself. -/ +example : IsMarkov countdown := by + is_markov + intro k + convert Terminates.mcIverMorgan_variantRule_of_antitone (b := k) (G := fun i : ℕ ↦ 0 < i) + (Inv := fun _ ↦ True) (body := fun i ↦ (mPure (i - 1) : Measure ℕ)) (fun i ↦ (i : ℤ)) 0 1 + one_pos (fun _ _ _ ↦ by positivity) (fun _ _ _ ↦ by simp) (fun N i hi _ hN ↦ ?_) + (fun N i hi _ hN ↦ ?_) trivial using 1 + · funext i + by_cases h : 0 < i <;> simp [whileStep, h, ForInStep.measurable_yield] + · subst hN + simp [hi] + · subst hN + simp + +/-- A `while` loop over two mutable variables: the flips until two heads. -/ +noncomputable def untilTwoHeads : Measure ℕ := rdo + let mut heads := 0 + let mut flips := 0 + while heads < 2 rdo + let b ← fairCoin + flips := flips + 1 + if b then + heads := heads + 1 + return flips + +/-- The variant rule of McIver and Morgan (Lemma 7.5.1), with the variant `2 - heads` between `1` +and `3`. -/ +example : IsProbabilityMeasure untilTwoHeads := by + is_markov + intro _ + convert Terminates.mcIverMorgan_variantRule (b := (0, 0)) (G := fun p : ℕ × ℕ ↦ p.1 < 2) + (Inv := fun _ ↦ True) (body := fun p ↦ fairCoin >>=ₘ fun b ↦ + if b then mPure (p.1 + 1, p.2 + 1) else mPure (p.1, p.2 + 1)) + (fun p ↦ 2 - (p.1 : ℤ)) 1 3 (1 / 2) (by norm_num) (fun p hp _ ↦ by omega) + (fun _ _ _ ↦ by norm_num [fairCoin]) (fun N p hp _ hN ↦ ?_) trivial using 1 + · funext p + by_cases h : p.1 < 2 <;> simp [whileStep, h, fairCoin, Measure.map_add, Measure.map_smul, + ForInStep.measurable_yield] + · subst hN + norm_num [fairCoin] + +/-- The symmetric random walk on the integers, stopped at `0`: it stops almost surely, but after an +infinite expected number of steps, and no bounded variant proves it. -/ +noncomputable def randomWalk (x : ℤ) : Measure ℤ := rdo + let mut y := x + while y ≠ 0 rdo + let b ← fairCoin + if b then + y := y + 1 + else + y := y - 1 + return y + +/-- The martingale rule of Majumdar and Sathiyanarayana, with `|y| + 1` as both the supermartingale +and the variant. -/ +example : IsMarkov randomWalk := by + is_markov + refine fun _ ↦ .majumdarSathiyanarayana_martingaleRule (fun _ ↦ True) + (fun t ↦ if t.isDone then 0 else (t.run.natAbs : ℝ) + 1) + (fun t ↦ if t.isDone then 0 else t.run.natAbs + 1) trivial + (fun _ _ ↦ Filter.Eventually.of_forall fun _ ↦ trivial) (fun _ _ ↦ by simp) + (fun _ _ ↦ by simp only [ForInStep.isDone_yield, Bool.false_eq_true, ↓reduceIte]; positivity) + (fun y _ ↦ ?_) (fun _ _ ↦ by simp) + (fun r ↦ ⟨⌈r⌉₊, fun t _ ht ↦ ?_⟩) (fun r ↦ ⟨1 / 4, by norm_num, fun y _ _ ↦ ?_⟩) + · -- `|y| + 1` is a martingale away from `0`: `|y + 1| + |y - 1| = 2 |y|`. + by_cases hy : y = 0 + · simp [hy] + have habs : |(y : ℝ) + 1| + |(y : ℝ) - 1| = 2 * |(y : ℝ)| := by + rcases lt_or_gt_of_ne hy with h | h + · have : (y : ℝ) ≤ -1 := by exact_mod_cast Int.le_sub_one_of_lt h + rw [abs_of_nonpos (by linarith), abs_of_neg (by linarith), abs_of_neg (by linarith)] + ring + · have : (1 : ℝ) ≤ y := by exact_mod_cast h + rw [abs_of_pos (by linarith), abs_of_nonneg (by linarith), abs_of_pos (by linarith)] + ring + have h2 : (2⁻¹ : ℝ≥0∞) = ENNReal.ofReal 2⁻¹ := by + rw [ENNReal.ofReal_inv_of_pos two_pos, ENNReal.ofReal_ofNat] + simp only [ne_eq, hy, not_false_eq_true, ↓reduceIte, fairCoin, one_div, mPure_def, mBind_def, + bernoulliMeasure_bind', Nat.ofNat_pos, ENNReal.ofReal_inv_of_pos, ENNReal.ofReal_ofNat, + Bool.false_eq_true, Nat.cast_natAbs, Int.cast_abs, lintegral_add_measure, + lintegral_smul_measure, lintegral_dirac, ForInStep.isDone_yield, ForInStep.run_yield, + Int.cast_add, Int.cast_one, smul_eq_mul, Int.cast_sub] + rw [show (1 : ℝ) - 2⁻¹ = 2⁻¹ by norm_num, h2, ← ENNReal.ofReal_mul (by norm_num), + ← ENNReal.ofReal_mul (by norm_num), ← ENNReal.ofReal_add (by positivity) (by positivity)] + exact ENNReal.ofReal_le_ofReal (by linarith) + · cases t with + | done _ => simp + | yield y => + simp only [ForInStep.isDone_yield, Bool.false_eq_true, ite_false, ForInStep.run_yield] at ht ⊢ + exact_mod_cast (show ((y.natAbs + 1 : ℕ) : ℝ) ≤ r by exact_mod_cast ht).trans (Nat.le_ceil r) + · -- The step towards `0` has probability `1 / 2`. + by_cases hy : y = 0 + · norm_num [hy] + rcases lt_or_gt_of_ne hy with h | h + · have h1 : (y + 1).natAbs < y.natAbs := by omega + have h2 : ¬(y - 1).natAbs < y.natAbs := by omega + norm_num [hy, fairCoin, h1, h2] + · have h1 : ¬(y + 1).natAbs < y.natAbs := by omega + have h2 : (y - 1).natAbs < y.natAbs := by omega + norm_num [hy, fairCoin, h1, h2] + +/-- The new variant rule of McIver, Morgan, Kaminski and Katoen, with the super-martingale `|y|`, +which decreases by `1` with probability `1 / 2`. -/ +example : IsMarkov randomWalk := by is_markov - exact h + intro x + -- Away from `0`, one of `y + 1` and `y - 1` is one closer to `0`, the other one further. + have habs : ∀ y : ℤ, y ≠ 0 → + (|(y : ℝ) + 1| = |(y : ℝ)| + 1 ∧ |(y : ℝ) - 1| = |(y : ℝ)| - 1) ∨ + (|(y : ℝ) + 1| = |(y : ℝ)| - 1 ∧ |(y : ℝ) - 1| = |(y : ℝ)| + 1) := by + intro y hy + rcases lt_or_gt_of_ne hy with h | h + · have : (y : ℝ) ≤ -1 := by exact_mod_cast Int.le_sub_one_of_lt h + right + rw [abs_of_nonpos (show (y : ℝ) + 1 ≤ 0 by linarith), + abs_of_neg (show (y : ℝ) - 1 < 0 by linarith), abs_of_neg (show (y : ℝ) < 0 by linarith)] + constructor <;> ring + · have : (1 : ℝ) ≤ y := by exact_mod_cast h + left + rw [abs_of_pos (show (0 : ℝ) < y + 1 by linarith), + abs_of_nonneg (show (0 : ℝ) ≤ y - 1 by linarith), abs_of_pos (show (0 : ℝ) < y by linarith)] + constructor <;> ring + -- `max (a, 0)` is at most the mean of `max (a - 1, 0)` and `max (a + 1, 0)`. + have hconv : ∀ a : ℝ, ENNReal.ofReal a ≤ + ENNReal.ofReal (1 / 2) * ENNReal.ofReal (a - 1) + + ENNReal.ofReal (1 / 2) * ENNReal.ofReal (a + 1) := by + intro a + rcases le_or_gt a 1 with h | h + · calc ENNReal.ofReal a ≤ ENNReal.ofReal (1 / 2 * (a + 1)) := + ENNReal.ofReal_le_ofReal (by linarith) + _ = ENNReal.ofReal (1 / 2) * ENNReal.ofReal (a + 1) := ENNReal.ofReal_mul (by norm_num) + _ ≤ _ := le_add_self + · rw [← ENNReal.ofReal_mul (by norm_num), ← ENNReal.ofReal_mul (by norm_num), + ← ENNReal.ofReal_add (by nlinarith) (by nlinarith)] + exact ENNReal.ofReal_le_ofReal (by linarith) + convert Terminates.mcIverMorganKaminskiKatoen (b := x) (G := fun y : ℤ ↦ y ≠ 0) + (I := fun _ ↦ True) (body := fun y ↦ fairCoin >>=ₘ fun b ↦ + if b then mPure (y + 1) else mPure (y - 1)) + (fun y ↦ |(y : ℝ)|) (fun _ ↦ abs_nonneg _) (fun _ ↦ 1 / 2) (fun _ ↦ 1) + (fun _ _ ↦ by norm_num) (fun _ _ ↦ one_pos) antitoneOn_const antitoneOn_const + (fun _ _ _ ↦ by norm_num [fairCoin]) (fun y hy _ ↦ by positivity) + (fun R _ y hy _ hR ↦ ?_) (fun H _ y hy _ ↦ ?_) trivial using 1 + · funext y + by_cases h : y = 0 <;> simp [whileStep, h, fairCoin, Measure.map_add, Measure.map_smul, + ForInStep.measurable_yield] + · -- The step towards `0` has probability `1 / 2`. + subst hR + have : ¬|(y : ℝ)| + 1 ≤ |(y : ℝ)| - 1 := by linarith + rcases habs y hy with ⟨h1, h2⟩ | ⟨h1, h2⟩ <;> norm_num [fairCoin, h1, h2, this] + · -- `H ⊖ |y|` is a submartingale away from `0`. + norm_num [fairCoin] + rcases habs y hy with ⟨h1, h2⟩ | ⟨h1, h2⟩ + · rw [h1, h2] + simpa [sub_sub, sub_add] using hconv (H - |(y : ℝ)|) + · rw [h1, h2, add_comm] + simpa [sub_sub, sub_add] using hconv (H - |(y : ℝ)|) /-! ## Looking through definitions, and the `fuel` argument -/ From 79f51f7eb4e369577f7df67c09b10beb0c3de136 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ga=C3=ABtan=20Serr=C3=A9?= Date: Wed, 30 Sep 2026 13:00:32 +0200 Subject: [PATCH 7/9] Less rules --- .../Probability/Distributions/Bernoulli.lean | 8 +- RandomDo/Monad/While.lean | 4 +- RandomDo/Tactic/IsMarkov/ForInStep.lean | 14 +- RandomDo/Tactic/IsMarkov/Termination.lean | 516 +++--------------- Test/IsMarkov.lean | 124 +---- 5 files changed, 110 insertions(+), 556 deletions(-) diff --git a/RandomDo/ForMathlib/Probability/Distributions/Bernoulli.lean b/RandomDo/ForMathlib/Probability/Distributions/Bernoulli.lean index ec9706a..22bd818 100644 --- a/RandomDo/ForMathlib/Probability/Distributions/Bernoulli.lean +++ b/RandomDo/ForMathlib/Probability/Distributions/Bernoulli.lean @@ -22,17 +22,11 @@ namespace ProbabilityTheory variable {X Y : Type*} [MeasurableSpace X] [MeasurableSpace Y] -lemma bernoulliMeasure_bind (x y : X) (p : I) {g : X → Measure Y} (hg : Measurable g) : - Ber(x, y, p).bind g = (toNNReal p : ℝ≥0∞) • g x + (toNNReal (σ p) : ℝ≥0∞) • g y := by - rw [bernoulliMeasure_def, bind_add hg.aemeasurable, bind_smul, bind_smul, dirac_bind hg, - dirac_bind hg] - rfl - /-- Binding a Bernoulli distribution on a space whose points are measurable: the continuation needs no measurability, and the two weights are real numbers, so that `simp` can use it and `norm_num` can compute with the result. -/ @[simp] -lemma bernoulliMeasure_bind' [MeasurableSingletonClass X] (x y : X) (p : I) (g : X → Measure Y) : +lemma bernoulliMeasure_bind [MeasurableSingletonClass X] (x y : X) (p : I) (g : X → Measure Y) : Ber(x, y, p).bind g = ENNReal.ofReal p • g x + ENNReal.ofReal (1 - p) • g y := by have h (q : I) : ((toNNReal q : NNReal) : ℝ≥0∞) = ENNReal.ofReal q := by rw [ENNReal.ofReal, Real.toNNReal_of_nonneg q.2.1] diff --git a/RandomDo/Monad/While.lean b/RandomDo/Monad/While.lean index 641ddb8..ca5afc2 100644 --- a/RandomDo/Monad/While.lean +++ b/RandomDo/Monad/While.lean @@ -8,7 +8,6 @@ module public import RandomDo.Monad.Instances public import RandomDo.Tactic.IsMarkov.Defs import RandomDo.Monad.Notation -public import Mathlib.Probability.Distributions.Bernoulli /-! # `while` loops @@ -151,7 +150,8 @@ private lemma loopRun_succ (f : σ → Measure (ForInStep σ)) (n : ℕ) (b : σ loopRun f (n + 1) b = (f b).bind fun t ↦ ForInStep.casesOn (motive := fun _ ↦ Measure σ) t (fun _ ↦ 0) (loopRun f n) := rfl -private lemma measurable_casesOn {γ : Type*} [MeasurableSpace γ] {d y : σ → γ} +/-- A case analysis on the outcome of a step is measurable as soon as its two branches are. -/ +lemma measurable_casesOn {γ : Type*} [MeasurableSpace γ] {d y : σ → γ} (hd : Measurable d) (hy : Measurable y) : Measurable fun t : ForInStep σ ↦ ForInStep.casesOn (motive := fun _ ↦ γ) t d y := fun _ hs ↦ ⟨hy hs, hd hs⟩ diff --git a/RandomDo/Tactic/IsMarkov/ForInStep.lean b/RandomDo/Tactic/IsMarkov/ForInStep.lean index 9884ba3..29c6357 100644 --- a/RandomDo/Tactic/IsMarkov/ForInStep.lean +++ b/RandomDo/Tactic/IsMarkov/ForInStep.lean @@ -22,8 +22,7 @@ largest one making both `ForInStep.yield` and `ForInStep.done` measurable. ## Main results * `measurable_yield`, `measurable_run`, `measurable_isDone`: the maps relating `ForInStep β` to `β` and to `Bool` are measurable. -* The points of `ForInStep β` are measurable as soon as those of `β` are, and `ForInStep.yield` is a - measurable embedding. +* The points of `ForInStep β` are measurable as soon as those of `β` are. * `measurable_CasesOn`: a case analysis on a `ForInStep`, measurable in each of its two branches, is measurable. * `IsMarkov.forInStepCasesOn`: the same statement for the Markov property. @@ -65,17 +64,6 @@ instance [MeasurableSingletonClass β] : MeasurableSingletonClass (ForInStep β) -- A singleton's preimages under `yield` and `done` are a singleton and the empty set. constructor <;> cases t <;> change MeasurableSet (_ ⁻¹' _) <;> simp [Set.preimage] -lemma measurableEmbedding_yield : MeasurableEmbedding (ForInStep.yield : β → ForInStep β) where - injective _ _ h := ForInStep.yield.inj h - measurable := measurable_yield - measurableSet_image' S hS := by - refine ⟨?_, ?_⟩ - · change MeasurableSet (ForInStep.yield ⁻¹' _) - rwa [Set.preimage_image_eq _ fun _ _ h ↦ ForInStep.yield.inj h] - · change MeasurableSet (ForInStep.done ⁻¹' _) - convert MeasurableSet.empty (α := β) - ext; simp - instance [Countable β] : Countable (ForInStep β) := Function.Injective.countable (f := fun t : ForInStep β ↦ (t.isDone, t.run)) <| by rintro (_ | _) (_ | _) h <;> simp_all diff --git a/RandomDo/Tactic/IsMarkov/Termination.lean b/RandomDo/Tactic/IsMarkov/Termination.lean index 451922e..5a8f2d3 100644 --- a/RandomDo/Tactic/IsMarkov/Termination.lean +++ b/RandomDo/Tactic/IsMarkov/Termination.lean @@ -7,54 +7,38 @@ module public import RandomDo.Monad.While public import RandomDo.Tactic.IsMarkov.Elab -public import RandomDo.ForMathlib.Algebra.Notation.Indicator -public import Mathlib.MeasureTheory.Function.Floor /-! # Termination of `while` loops `is_markov` hands back the termination of a `while` loop as a goal `Terminates f b`. This file implements proof rules of the literature for it, each under the name of its authors and with the -hypotheses of its paper, translated as described in the implementation notes. +hypotheses of its paper. ## Main results -* `Terminates.mcIverMorgan_variantRule`, `Terminates.mcIverMorgan_variantRule_of_finite`: the - variant rule for loops of McIver and Morgan (2005, Lemmas 7.5.1 and 2.7.1). -* `Terminates.mcIverMorgan_variantRule_of_antitone`: its form with a variant that cannot increase - (McIver and Morgan 2005, p. 56). -* `Terminates.mcIverMorganKaminskiKatoen`: the new variant rule for loops of McIver, Morgan, - Kaminski and Katoen (POPL 2018, Theorem 4.1). -* `Terminates.majumdarSathiyanarayana_variantRule`: the variant rule of McIver and Morgan, as - presented by Majumdar and Sathiyanarayana for probabilistic transition systems (POPL 2025, Proof - Rule 3.1). * `Terminates.majumdarSathiyanarayana_martingaleRule`: the martingale rule of Majumdar and - Sathiyanarayana (POPL 2025, Proof Rule 3.2). + Sathiyanarayana (POPL 2025, Proof Rule 3.2), sound and relatively complete for almost-sure + termination. +* `Terminates.majumdarSathiyanarayana_variantRule`: the variant rule of McIver and Morgan, as + presented by Majumdar and Sathiyanarayana (POPL 2025, Proof Rule 3.1), derived from the + martingale rule with the supermartingale `1`. * `bournezGarnier`: the Lyapunov ranking functions of Bournez and Garnier (RTA 2005, Theorem 2), which give almost-sure termination with a bound on the expected number of steps. ## Implementation notes -The rules are stated for the two program models of their papers. -* A loop `while G do body` of pGCL is `whileStep G body`, whose body is a Markov kernel. The weakest - pre-expectation `wp.body.E` at `s` is the integral of `E` against `body s`, which for a predicate - `P` is the probability `body s {s' | P s'}`. -* A probabilistic transition system (a control flow graph, a probabilistic program) is the system - whose states are the `ForInStep σ`: the successor of `yield s` is drawn from `f s`, and the states - `done s` are terminal. Every `rdo` loop is of this form. - -The programs have no demonic nondeterminism, one step of a transition system is one iteration of the -loop, and "every successor" is "almost every successor". The papers state these rules for discrete -probabilistic choice (countable state spaces or discrete distributions); the rules here hold for any -measurable state space and any Markov kernel, and their measurability conditions, which a discrete -state space satisfies, have default proofs. +The program is a probabilistic transition system whose states are the `ForInStep σ`: the successor +of `yield s` is drawn from `f s`, and the states `done s` are terminal. Every `rdo` loop is of this +form. It has no demonic nondeterminism, one step is one iteration of the loop, and "every successor" +is "almost every successor". The papers state these rules for discrete probabilistic choice; the +rules here hold for any measurable state space and any Markov kernel, and their measurability +conditions, which a discrete state space satisfies, have default proofs. ## References * Annabelle McIver, Carroll Morgan, *Abstraction, Refinement and Proof for Probabilistic Systems*, 2005. -* Annabelle McIver, Carroll Morgan, Benjamin Lucien Kaminski, Joost-Pieter Katoen, *A New Proof Rule - for Almost-Sure Termination*, POPL 2018. * Rupak Majumdar, V. R. Sathiyanarayana, *Sound and Complete Proof Rules for Probabilistic Termination*, POPL 2025. * Olivier Bournez, Florent Garnier, *Proving Positive Almost-Sure Termination*, RTA 2005. @@ -65,11 +49,7 @@ state space satisfies, have default proofs. @[expose] public section open MeasureTheory Filter -open scoped ENNReal NNReal Topology - -/- The probabilities in the rules are read in `ℝ` through `ENNReal.toReal`: pushing it through the -sums of finite probabilities lets `norm_num` compute them. -/ -attribute [simp] ENNReal.toReal_add +open scoped ENNReal NNReal namespace MeasurableSpaceMonadWhile @@ -118,9 +98,9 @@ private lemma terminates_of_loopRun_le [IsMarkov f] (I : σ → Prop) exact (iInf_le _ (N * k)).trans (loopRun_mul_apply_univ_le hI (hc.trans ENNReal.one_lt_top).ne h k b hb) -/-- The common core of the variant rules: from a state of an invariant, a loop stops almost surely -if a natural number `V`, bounded by `N` on the invariant, is decreased or the loop stopped with -probability at least `ε > 0` by every step from the invariant. -/ +/-- From a state of an invariant, a loop stops almost surely if a natural number `V`, bounded by `N` +on the invariant, is decreased or the loop stopped with probability at least `ε > 0` by every step +from the invariant. -/ private lemma terminates_of_variant [hf : IsMarkov f] (I : σ → Prop) (hI : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run) (V : σ → ℕ) (hV : Measurable V) (N : ℕ) (hN : ∀ s, I s → V s ≤ N) (ε : ℝ≥0∞) (hε : ε ≠ 0) @@ -189,26 +169,22 @@ private lemma stopOn_of_notMem {A : Set σ} {s : σ} (h : s ∉ A) : stopOn A f classical simp [stopOn, h] -/-- Under the Dirac mass at a stop, every run has stopped. -/ -private lemma ae_dirac_done (P : σ → Prop) (s : σ) : - ∀ᵐ t ∂Measure.dirac (ForInStep.done s), ¬t.isDone → P t.run := by - have h0 : Measure.dirac (ForInStep.done s) (ForInStep.isDone ⁻¹' {false}) = 0 := by - rw [Measure.dirac_apply' _ (ForInStep.measurable_isDone (measurableSet_singleton false))] - simp - refine measure_mono_null (fun t ht ↦ ?_) h0 - simp only [Set.mem_preimage, Set.mem_singleton_iff] - cases hdone : t.isDone - · rfl - · exact absurd (fun h ↦ absurd hdone h) ht - /-- The stopped loop keeps the invariants of the loop. -/ private lemma ae_stopOn {A : Set σ} {I : σ → Prop} (h : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run) : ∀ s, I s → ∀ᵐ t ∂stopOn A f s, ¬t.isDone → I t.run := by intro s hs by_cases hA : s ∈ A - · rw [stopOn_of_mem hA] - exact ae_dirac_done I s + · -- Under the Dirac mass at a stop, every run has stopped. + rw [stopOn_of_mem hA] + have h0 : Measure.dirac (ForInStep.done s) (ForInStep.isDone ⁻¹' {false}) = 0 := by + rw [Measure.dirac_apply' _ (ForInStep.measurable_isDone (measurableSet_singleton false))] + simp + refine measure_mono_null (fun t ht ↦ ?_) h0 + simp only [Set.mem_preimage, Set.mem_singleton_iff] + cases hdone : t.isDone + · rfl + · exact absurd (fun h ↦ absurd hdone h) ht · rw [stopOn_of_notMem hA] exact h s hs @@ -220,30 +196,13 @@ private noncomputable def hitRun (f : σ → Measure (ForInStep σ)) (A : Set σ if s ∈ A then 1 else ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) (hitRun f A n) ∂f s -private lemma measurable_casesOn' {γ : Type*} [MeasurableSpace γ] {d y : σ → γ} - (hd : Measurable d) (hy : Measurable y) : - Measurable fun t : ForInStep σ ↦ ForInStep.casesOn (motive := fun _ ↦ γ) t d y := - fun _ hs ↦ ⟨hy hs, hd hs⟩ - private lemma measurable_hitRun (hf : Measurable f) {A : Set σ} (hA : MeasurableSet A) : ∀ n, Measurable (hitRun f A n) | 0 => measurable_const.indicator hA | n + 1 => by classical exact Measurable.ite hA measurable_const ((Measure.measurable_lintegral - (measurable_casesOn' measurable_const (measurable_hitRun hf hA n))).comp hf) - -private lemma hitRun_le_one (A : Set σ) [hf : IsMarkov f] : ∀ n s, hitRun f A n s ≤ 1 - | 0, s => by simp only [hitRun]; exact Set.indicator_le_self' (fun _ _ ↦ zero_le_one) s - | n + 1, s => by - classical - simp only [hitRun] - split_ifs - · exact le_rfl - · have := hf.isProbabilityMeasure s - calc _ ≤ ∫⁻ _, 1 ∂f s := lintegral_mono fun t ↦ by - cases t <;> simp [hitRun_le_one A n] - _ = 1 := by simp + (measurable_casesOn measurable_const (measurable_hitRun hf hA n))).comp hf) /-- The runs still going after `n` steps either are still going in the loop stopped on `A`, or have been in `A` before. -/ @@ -262,7 +221,7 @@ private lemma loopRun_le_stopOn_add_hitRun [hf : IsMarkov f] {A : Set σ} (hA : · simp only [stopOn, hitRun, hb, ite_false] have hRun : Measurable fun s ↦ loopRun (stopOn A f) n s Set.univ := (Measure.measurable_coe MeasurableSet.univ).comp (measurable_loopRun hfA.measurable n) - rw [← lintegral_add_left (measurable_casesOn' measurable_const hRun)] + rw [← lintegral_add_left (measurable_casesOn measurable_const hRun)] refine lintegral_mono fun t ↦ ?_ cases t with | done _ => simp @@ -302,7 +261,7 @@ private lemma mul_hitRun_le_of_supermartingale [hf : IsMarkov f] (I : σ → Pro simp only [hitRun] split_ifs with h · simpa using hA s h - · rw [← lintegral_const_mul _ (measurable_casesOn' measurable_const + · rw [← lintegral_const_mul _ (measurable_casesOn measurable_const (measurable_hitRun hf.measurable hAm n))] refine le_trans (lintegral_mono_ae ?_) (hsuper s hs) filter_upwards [hI s hs] with t ht @@ -312,378 +271,15 @@ private lemma mul_hitRun_le_of_supermartingale [hf : IsMarkov f] (I : σ → Pro have := mul_hitRun_le_of_supermartingale I hI W hW hsuper r hA hAm n s' (by simpa using ht) simpa using this - -/-- **Maximal inequality**, for a submartingale `Z ≤ H` that vanishes on `A`: from a state of the -invariant, `Z` plus `H` times the probability of reaching `A` is at most `H`. -/ -private lemma add_mul_hitRun_le_of_submartingale [hf : IsMarkov f] (I : σ → Prop) - (hI : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run) (Z : σ → ℝ≥0∞) (H : ℝ≥0∞) - (hZH : ∀ s, Z s ≤ H) {A : Set σ} (hAm : MeasurableSet A) (hZA : ∀ s ∈ A, Z s = 0) - (hsub : ∀ s, I s → s ∉ A → - Z s ≤ ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ H) Z ∂f s) : - ∀ n s, I s → Z s + H * hitRun f A n s ≤ H - | 0, s, _ => by - classical - simp only [hitRun, Set.indicator_apply, Pi.one_apply] - split_ifs with h - · simp [hZA s h] - · simpa using hZH s - | n + 1, s, hs => by - classical - simp only [hitRun] - split_ifs with h - · simp [hZA s h] - · have := hf.isProbabilityMeasure s - have hmeas : Measurable fun t : ForInStep σ ↦ - H * ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) (hitRun f A n) := - measurable_const.mul (measurable_casesOn' measurable_const - (measurable_hitRun hf.measurable hAm n)) - rw [← lintegral_const_mul _ (measurable_casesOn' measurable_const - (measurable_hitRun hf.measurable hAm n))] - calc _ ≤ ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ H) Z ∂f s + - ∫⁻ t, H * ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) - (hitRun f A n) ∂f s := by gcongr; exact hsub s hs h - _ = ∫⁻ t, (ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ H) Z + - H * ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) - (hitRun f A n)) ∂f s := (lintegral_add_right _ hmeas).symm - _ ≤ ∫⁻ _, H ∂f s := by - refine lintegral_mono_ae ?_ - filter_upwards [hI s hs] with t ht - cases t with - | done _ => simp - | yield s' => - have := add_mul_hitRun_le_of_submartingale I hI Z H hZH hAm hZA hsub n s' - (by simpa using ht) - simpa using this - _ = H := by simp - -/-! ### The loop `while G do body` -/ - -/-- The step of the loop `while G do body`, whose body is a family `body` of measures on the -states: from a state satisfying `G`, run the body and carry on; from any other state, stop. -/ -noncomputable def whileStep (G : σ → Prop) (body : σ → Measure σ) (s : σ) : - Measure (ForInStep σ) := - open Classical in if G s then (body s).map ForInStep.yield else Measure.dirac (ForInStep.done s) - -lemma isMarkov_whileStep {G : σ → Prop} (hG : MeasurableSet {s | G s}) {body : σ → Measure σ} - [hbody : IsMarkov body] : IsMarkov (whileStep G body) := by - classical - refine ⟨Measurable.ite hG ((Measure.measurable_map _ ForInStep.measurable_yield).comp - hbody.measurable) (Measure.measurable_dirac.comp ForInStep.measurable_done), fun s ↦ ?_⟩ - unfold whileStep - split_ifs - · have := hbody.isProbabilityMeasure s - exact Measure.isProbabilityMeasure_map ForInStep.measurable_yield.aemeasurable - · infer_instance - - -section whileStep - -variable {G : σ → Prop} {body : σ → Measure σ} {s : σ} - -private lemma whileStep_of_pos (h : G s) : whileStep G body s = (body s).map ForInStep.yield := by - classical - simp [whileStep, h] - -private lemma whileStep_of_neg (h : ¬G s) : - whileStep G body s = Measure.dirac (ForInStep.done s) := by - classical - simp [whileStep, h] - -/-- A predicate holding with probability `1`: its complement is null. -/ -private lemma measure_compl_eq_zero_of_one_le {μ : Measure σ} [IsProbabilityMeasure μ] - {P : σ → Prop} (hP : MeasurableSet {s | P s}) (h : 1 ≤ (μ {s | P s}).toReal) : - μ {s | P s}ᶜ = 0 := by - rw [measure_compl hP (measure_ne_top _ _), measure_univ] - exact tsub_eq_zero_of_le (by simpa using ENNReal.ofReal_le_of_le_toReal h) - -/-- A step from a state of an invariant `Inv` satisfying `G` carries on in `Inv`, almost surely. -/ -private lemma ae_whileStep {Inv : σ → Prop} (hInv : MeasurableSet {s | Inv s}) - (h : G s → 1 ≤ (body s {s' | Inv s'}).toReal) [IsMarkov body] : - ∀ᵐ t ∂whileStep G body s, ¬t.isDone → Inv t.run := by - by_cases hG : G s - · rw [whileStep_of_pos hG, ForInStep.measurableEmbedding_yield.ae_map_iff] - have := IsMarkov.isProbabilityMeasure (κ := body) s - filter_upwards [measure_eq_zero_iff_ae_notMem.1 (measure_compl_eq_zero_of_one_le hInv (h hG))] - with s' hs' - simpa using hs' - · rw [whileStep_of_neg hG] - exact ae_dirac_done Inv s - -end whileStep - namespace Terminates -/-- **Variant rule for loops** (McIver and Morgan 2005, Lemma 7.5.1, first stated as Lemma 2.7.1). - -For the loop `while G do body`, let `V` be an integer-valued function of the state and `Inv` a -predicate such that -1. there are integers `L` and `H` with `G ∧ Inv ⇛ L ≤ V < H`; -2. `[Inv]` is a strong invariant: `[G] ∗ [Inv] ⇛ wp.body.[Inv]`; -3. for some probability `ε > 0` and all integers `N`, `ε ∗ [G ∧ Inv ∧ (V = N)] ⇛ wp.body.[V < N]`. - -Then the loop terminates with probability `1` from every state satisfying `Inv`: `[Inv] ⇛ T`. - -The body is a Markov kernel, and `wp.body.[P]` at `s` is the probability `body s {s' | P s'}`. The -bound `ε ≤ 1`, implicit in "probability", is not needed. -/ -theorem mcIverMorgan_variantRule {G Inv : σ → Prop} {body : σ → Measure σ} - (V : σ → ℤ) (L H : ℤ) (ε : ℝ) (hε : 0 < ε) - (h1 : ∀ s, G s → Inv s → L ≤ V s ∧ V s < H) - (h2 : ∀ s, G s → Inv s → 1 ≤ (body s {s' | Inv s'}).toReal) - (h3 : ∀ N : ℤ, ∀ s, G s → Inv s → V s = N → ε ≤ (body s {s' | V s' < N}).toReal) - (hb : Inv b) (hG : MeasurableSet {s | G s} := by measurability) - (hInv : MeasurableSet {s | Inv s} := by measurability) (hV : Measurable V := by fun_prop) - (hbody : IsMarkov body := by is_markov) : Terminates (whileStep G body) b := by - classical - have := isMarkov_whileStep (body := body) hG - -- The variant shifted to `ℕ`, and set to `0` on the states where the loop stops. - let V' : σ → ℕ := fun s ↦ if G s then (V s - L + 1).toNat else 0 - have hV' : Measurable V' := - Measurable.ite hG ((Measurable.of_discrete (f := fun z : ℤ ↦ (z - L + 1).toNat)).comp hV) - measurable_const - refine terminates_of_variant Inv (fun s hs ↦ ae_whileStep hInv (h2 s · hs)) V' hV' - (H - L).toNat (fun s hs ↦ ?_) (min (ENNReal.ofReal ε) 1) - (lt_min (ENNReal.ofReal_pos.2 hε) one_pos).ne' (fun s hs ↦ ?_) hb - · simp only [V'] - split_ifs with hG - · have := h1 s hG hs - exact Int.toNat_le_toNat (by omega) - · exact Nat.zero_le _ - · by_cases hG : G s - · have := IsMarkov.isProbabilityMeasure (κ := body) s - rw [whileStep_of_pos hG, ForInStep.measurableEmbedding_yield.map_apply] - refine (min_le_left _ _).trans - ((ENNReal.ofReal_le_of_le_toReal (h3 (V s) s hG hs rfl)).trans ?_) - rw [← measure_inter_conull (measure_compl_eq_zero_of_one_le hInv (h2 s hG hs))] - refine measure_mono fun s' ⟨hlt, hInv'⟩ ↦ Or.inr ?_ - have := h1 s hG hs - simp only [Set.mem_ofPred_eq] at hlt hInv' - change V' s' < V' s - simp only [V', hG, ite_true] - split_ifs with hG' - · have := h1 s' hG' hInv' - omega - · omega - · rw [whileStep_of_neg hG, Measure.dirac_apply_of_mem (by simp)] - exact min_le_right _ _ - - -/-- **Variant rule for loops** (McIver and Morgan 2005, Lemma 2.7.1): the bounds on the variant are -only asked when the states satisfying `G ∧ Inv` are infinitely many, and `0 < ε ≤ 1`. -/ -theorem mcIverMorgan_variantRule_of_finite {G Inv : σ → Prop} {body : σ → Measure σ} - (V : σ → ℤ) (ε : ℝ) (hε : 0 < ε) (_hε1 : ε ≤ 1) - (h1 : ¬{s | G s ∧ Inv s}.Finite → ∃ L H : ℤ, ∀ s, G s → Inv s → L ≤ V s ∧ V s < H) - (h2 : ∀ s, G s → Inv s → 1 ≤ (body s {s' | Inv s'}).toReal) - (h3 : ∀ N : ℤ, ∀ s, G s → Inv s → V s = N → ε ≤ (body s {s' | V s' < N}).toReal) - (hb : Inv b) (hG : MeasurableSet {s | G s} := by measurability) - (hInv : MeasurableSet {s | Inv s} := by measurability) (hV : Measurable V := by fun_prop) - (hbody : IsMarkov body := by is_markov) : Terminates (whileStep G body) b := by - -- Over finitely many states, the variant takes finitely many values. - obtain ⟨L, H, hLH⟩ : ∃ L H : ℤ, ∀ s, G s → Inv s → L ≤ V s ∧ V s < H := by - by_cases hfin : {s | G s ∧ Inv s}.Finite - · obtain ⟨L, hL⟩ := (hfin.image V).bddBelow - obtain ⟨H, hH⟩ := (hfin.image V).bddAbove - exact ⟨L, H + 1, fun s hG hI ↦ ⟨hL ⟨s, ⟨hG, hI⟩, rfl⟩, - Int.lt_add_one_iff.2 (hH ⟨s, ⟨hG, hI⟩, rfl⟩)⟩⟩ - · exact h1 hfin - exact mcIverMorgan_variantRule V L H ε hε hLH h2 h3 hb hG hInv hV hbody - -/-- **Variant rule for loops, with a variant that cannot increase** (McIver and Morgan 2005, p. 56, -stated and derived there informally from Lemma 2.7.1). The variant is bounded below but not -necessarily above, it decreases with probability at least `ε > 0`, and it cannot increase: its -initial value bounds it above. -/ -theorem mcIverMorgan_variantRule_of_antitone {G Inv : σ → Prop} {body : σ → Measure σ} - (V : σ → ℤ) (L : ℤ) (ε : ℝ) (hε : 0 < ε) - (h1 : ∀ s, G s → Inv s → L ≤ V s) - (h2 : ∀ s, G s → Inv s → 1 ≤ (body s {s' | Inv s'}).toReal) - (h3 : ∀ N : ℤ, ∀ s, G s → Inv s → V s = N → ε ≤ (body s {s' | V s' < N}).toReal) - (h4 : ∀ N : ℤ, ∀ s, G s → Inv s → V s = N → 1 ≤ (body s {s' | V s' ≤ N}).toReal) - (hb : Inv b) (hG : MeasurableSet {s | G s} := by measurability) - (hInv : MeasurableSet {s | Inv s} := by measurability) (hV : Measurable V := by fun_prop) - (hbody : IsMarkov body := by is_markov) : Terminates (whileStep G body) b := by - have hle : MeasurableSet {s | V s ≤ V b} := hV measurableSet_Iic - refine mcIverMorgan_variantRule (Inv := fun s ↦ Inv s ∧ V s ≤ V b) V L (V b + 1) ε hε - (fun s hG hs ↦ ⟨h1 s hG hs.1, Int.lt_add_one_iff.2 hs.2⟩) (fun s hG hs ↦ ?_) - (fun N s hG hs ↦ h3 N s hG hs.1) ⟨hb, le_rfl⟩ hG (hInv.inter hle) hV hbody - -- The invariant is kept, and the variant does not increase, almost surely. - have := IsMarkov.isProbabilityMeasure (κ := body) s - refine le_trans ?_ (ENNReal.toReal_mono (measure_ne_top _ _) - (measure_mono (s := {s' | V s' ≤ V s} ∩ {s' | Inv s'}) fun s' ⟨hV', hI'⟩ ↦ - ⟨hI', hV'.trans hs.2⟩)) - rw [measure_inter_conull (measure_compl_eq_zero_of_one_le hInv (h2 s hG hs.1))] - exact h4 (V s) s hG hs.1 rfl - - -/-- **New variant rule for loops** (McIver, Morgan, Kaminski and Katoen, *A New Proof Rule for -Almost-Sure Termination*, POPL 2018, Theorem 4.1). - -For the loop `while G do body`, let `I` be a predicate, `V` a nonnegative real-valued function of -the state, not necessarily bounded, and `p` ("probability", valued in `(0, 1]`) and `d` -("decrease", valued in `ℝ>0`) fixed functions of the nonnegative reals, both antitone on strictly -positive arguments, such that -* (i) `I` is a standard invariant of the loop: `[G ∧ I] ≤ wp.body.[I]`; -* (ii) `G ∧ I ⇒ V > 0`; -* (iii) for every `R > 0`, `p(R) · [G ∧ I ∧ V = R] ≤ wp.body.[V ≤ R - d(R)]`; -* (iv) `V` is a super-martingale: for every `H > 0`, `[G ∧ I] · (H ⊖ V) ≤ wp.body.(H ⊖ V)`, where - `H ⊖ V = max (H - V) 0`. - -Then the loop terminates with probability `1` from every state satisfying `I`. - -The body is a Markov kernel, `wp.body.[P]` at `s` is the probability `body s {s' | P s'}`, and -`wp.body.(H ⊖ V)` is the integral of `H ⊖ V` against `body s`. -/ -theorem mcIverMorganKaminskiKatoen {G I : σ → Prop} {body : σ → Measure σ} - (V : σ → ℝ) (hV0 : ∀ s, 0 ≤ V s) (p d : ℝ → ℝ) - (hp : ∀ r, 0 ≤ r → 0 < p r ∧ p r ≤ 1) (hd : ∀ r, 0 ≤ r → 0 < d r) - (hp_anti : AntitoneOn p (Set.Ioi 0)) (hd_anti : AntitoneOn d (Set.Ioi 0)) - (h1 : ∀ s, G s → I s → 1 ≤ (body s {s' | I s'}).toReal) - (h2 : ∀ s, G s → I s → 0 < V s) - (h3 : ∀ R, 0 < R → ∀ s, G s → I s → V s = R → p R ≤ (body s {s' | V s' ≤ R - d R}).toReal) - (h4 : ∀ H, 0 < H → ∀ s, G s → I s → - ENNReal.ofReal (H - V s) ≤ ∫⁻ s', ENNReal.ofReal (H - V s') ∂body s) - (hb : I b) (hG : MeasurableSet {s | G s} := by measurability) - (hI : MeasurableSet {s | I s} := by measurability) (hV : Measurable V := by fun_prop) - (hbody : IsMarkov body := by is_markov) : Terminates (whileStep G body) b := by - classical - have := isMarkov_whileStep (body := body) hG - have hIf : ∀ s, I s → ∀ᵐ t ∂whileStep G body s, ¬t.isDone → I t.run := - fun s hs ↦ ae_whileStep hI (h1 s · hs) - refine terminates_of_stopOn fun δ hδ ↦ ?_ - -- A level `H` above `V b`, high enough for `V b / H ≤ δ`. - obtain ⟨H, hVH, hHδ⟩ : ∃ H : ℝ, V b < H ∧ ENNReal.ofReal (V b) / ENNReal.ofReal H ≤ δ := by - by_cases hδtop : δ = ⊤ - · exact ⟨V b + 1, by linarith, hδtop ▸ le_top⟩ - have hδ' : 0 < δ.toReal := ENNReal.toReal_pos hδ.ne' hδtop - have hq := div_nonneg (hV0 b) hδ'.le - have hH : 0 < V b + 1 + V b / δ.toReal := by linarith [hV0 b] - refine ⟨V b + 1 + V b / δ.toReal, by linarith, ?_⟩ - rw [← ENNReal.ofReal_div_of_pos hH] - calc ENNReal.ofReal (V b / (V b + 1 + V b / δ.toReal)) ≤ ENNReal.ofReal δ.toReal := by - refine ENNReal.ofReal_le_ofReal ((div_le_iff₀ hH).2 ?_) - have : δ.toReal * (V b / δ.toReal) = V b := by field_simp - nlinarith [hV0 b] - _ = δ := ENNReal.ofReal_toReal hδtop - have hH : 0 < H := (hV0 b).trans_lt hVH - set A := {s | H ≤ V s} - have hA : MeasurableSet A := hV measurableSet_Ici - refine ⟨A, hA, ?_, fun n ↦ ?_⟩ - · -- Below the level `H`, the variant `⌈V / d(H)⌉` decreases with probability at least `p(H)`. - have := isMarkov_stopOn (f := whileStep G body) hA - have hdH := hd H hH.le - let V' : σ → ℕ := fun s ↦ if G s ∧ V s < H then ⌈V s / d H⌉₊ else 0 - have hV' : Measurable V' := - Measurable.ite (hG.inter (hV measurableSet_Iio)) (Measurable.nat_ceil (hV.div_const (d H))) - measurable_const - refine terminates_of_variant I (ae_stopOn hIf) V' hV' ⌈H / d H⌉₊ (fun s _ ↦ ?_) - (min (ENNReal.ofReal (p H)) 1) (lt_min (ENNReal.ofReal_pos.2 (hp H hH.le).1) one_pos).ne' - (fun s hs ↦ ?_) hb - · simp only [V'] - split_ifs with h - · exact Nat.ceil_mono (div_le_div_of_nonneg_right h.2.le hdH.le) - · exact Nat.zero_le _ - · by_cases hsA : s ∈ A - · rw [stopOn_of_mem hsA, Measure.dirac_apply_of_mem (by simp)] - exact min_le_right _ _ - rw [stopOn_of_notMem hsA] - simp only [A, Set.mem_ofPred_eq, not_le] at hsA - by_cases hGs : G s - · have := IsMarkov.isProbabilityMeasure (κ := body) s - have hVs := h2 s hGs hs - rw [whileStep_of_pos hGs, ForInStep.measurableEmbedding_yield.map_apply] - refine (min_le_left _ _).trans ?_ - refine (ENNReal.ofReal_le_ofReal (hp_anti hVs hH hsA.le)).trans ?_ - refine (ENNReal.ofReal_le_of_le_toReal (h3 (V s) hVs s hGs hs rfl)).trans ?_ - refine measure_mono fun s' hs' ↦ Or.inr ?_ - simp only [Set.mem_ofPred_eq] at hs' - have hdle : d H ≤ d (V s) := hd_anti hVs hH hsA.le - change V' s' < V' s - have hV's : V' s = ⌈V s / d H⌉₊ := by simp [V', hGs, hsA] - rw [hV's, Nat.lt_ceil] - simp only [V'] - split_ifs with h' - · calc (⌈V s' / d H⌉₊ : ℝ) < V s' / d H + 1 := - Nat.ceil_lt_add_one (div_nonneg (hV0 s') hdH.le) - _ ≤ V s / d H := by - rw [div_add_one hdH.ne', div_le_div_iff_of_pos_right hdH] - linarith - · simpa using div_pos hVs hdH - · rw [whileStep_of_neg hGs, Measure.dirac_apply_of_mem (by simp)] - exact min_le_right _ _ - · -- The maximal inequality, for the submartingale `H ⊖ V`. - have hmax := add_mul_hitRun_le_of_submartingale (f := whileStep G body) I hIf - (fun s ↦ ENNReal.ofReal (H - V s)) (ENNReal.ofReal H) - (fun s ↦ ENNReal.ofReal_le_ofReal (by linarith [hV0 s])) hA - (fun s hs ↦ ENNReal.ofReal_eq_zero.2 (by simp only [A, Set.mem_ofPred_eq] at hs; linarith)) - (fun s hs hsA ↦ ?_) n b hb - · have hsub := ENNReal.le_sub_of_add_le_left ENNReal.ofReal_ne_top hmax - rw [← ENNReal.ofReal_sub _ (by linarith), sub_sub_cancel] at hsub - refine le_trans ?_ hHδ - rw [ENNReal.le_div_iff_mul_le (Or.inl (ENNReal.ofReal_pos.2 hH).ne') - (Or.inl ENNReal.ofReal_ne_top), mul_comm] - exact hsub - · have hZ : Measurable fun s ↦ ENNReal.ofReal (H - V s) := - ENNReal.measurable_ofReal.comp (measurable_const.sub hV) - by_cases hGs : G s - · rw [whileStep_of_pos hGs, ForInStep.measurableEmbedding_yield.lintegral_map] - exact h4 H hH s hGs hs - · rw [whileStep_of_neg hGs, lintegral_dirac' _ (measurable_casesOn' measurable_const hZ)] - exact ENNReal.ofReal_le_ofReal (by linarith [hV0 s]) - - -/-- **Variant rule for almost-sure termination** (McIver and Morgan 2005, in the form of Majumdar -and Sathiyanarayana, *Sound and Complete Proof Rules for Probabilistic Termination*, POPL 2025, -Proof Rule 3.1 and Lemma 3.1). +/-- **Martingale rule for almost-sure termination** (Majumdar and Sathiyanarayana, *Sound and +Complete Proof Rules for Probabilistic Termination*, POPL 2025, Proof Rule 3.2 and Lemma 3.2). The program is the transition system whose states are the `ForInStep σ`: the successor of a state `yield s` is drawn from `f s`, and the states `done s` are terminal. To show that it terminates almost surely from `yield b`, find 1. an inductive invariant `Inv` containing `yield b`; -2. a variant function `U : Inv → ℤ`; -3. bounds `Lo` and `Hi` such that `Lo ≤ U < Hi` on `Inv`; -4. an `ε > 0`, - -such that, for each state of `Inv`, -* (4.1) if it is terminal, `U = Lo`; -* (4.3) otherwise, the successors that decrease `U` have a total probability `> ε`. - -Every non-terminal state is probabilistic, so condition (4.2) on assignment and nondeterministic -states does not apply, and "every successor" is "almost every successor". -/ -theorem majumdarSathiyanarayana_variantRule (Inv : ForInStep σ → Prop) (U : ForInStep σ → ℤ) - (Lo Hi : ℤ) (ε : ℝ) (hε : 0 < ε) (hb : Inv (.yield b)) - (hInv : ∀ s, Inv (.yield s) → ∀ᵐ t ∂f s, Inv t) - (hbounds : ∀ t, Inv t → Lo ≤ U t ∧ U t < Hi) - (_hdone : ∀ s, Inv (.done s) → U (.done s) = Lo) - (hprog : ∀ s, Inv (.yield s) → ε < (f s {t | U t < U (.yield s)}).toReal) - (hU : Measurable U := by fun_prop) (hf : IsMarkov f := by is_markov) : Terminates f b := by - let V' : σ → ℕ := fun s ↦ (U (.yield s) - Lo).toNat - have hV' : Measurable V' := - (Measurable.of_discrete (f := fun z : ℤ ↦ (z - Lo).toNat)).comp - (hU.comp ForInStep.measurable_yield) - refine terminates_of_variant (fun s ↦ Inv (.yield s)) (fun s hs ↦ ?_) V' hV' (Hi - Lo).toNat - (fun s hs ↦ Int.toNat_le_toNat (by linarith [(hbounds _ hs).2])) (min (ENNReal.ofReal ε) 1) - (lt_min (ENNReal.ofReal_pos.2 hε) one_pos).ne' (fun s hs ↦ ?_) hb - · filter_upwards [hInv s hs] with t ht - cases t with - | done _ => simp - | yield _ => simpa using ht - · refine (min_le_left _ _).trans ((ENNReal.ofReal_le_of_le_toReal (hprog s hs).le).trans ?_) - rw [← measure_inter_conull (t := {t | Inv t}) - (by rw [Set.compl_ofPred]; exact ae_iff.1 (hInv s hs))] - refine measure_mono fun t ⟨hlt, ht⟩ ↦ ?_ - cases t with - | done _ => simp - | yield s' => - simp only [Set.mem_ofPred_eq] at hlt ht - have := (hbounds _ ht).1 - simp only [Set.mem_ofPred_eq, ForInStep.isDone_yield, Bool.false_eq_true, false_or, - ForInStep.run_yield, V'] - omega - -/-- **Martingale rule for almost-sure termination** (Majumdar and Sathiyanarayana, *Sound and -Complete Proof Rules for Probabilistic Termination*, POPL 2025, Proof Rule 3.2 and Lemma 3.2). - -The program is the transition system whose states are the `ForInStep σ`, as in -`majumdarSathiyanarayana_variantRule`. To show that it terminates almost surely from `yield b`, -find -1. an inductive invariant `Inv` containing `yield b`; 2. a supermartingale function `V : Inv → ℝ` that assigns `0` to the terminal states and, at every other state of `Inv`, (2.1) is positive and (2.3) is at least the expected value of `V` after a step; @@ -791,6 +387,52 @@ theorem majumdarSathiyanarayana_martingaleRule (Inv : ForInStep σ → Prop) (V (Or.inl ENNReal.ofReal_ne_top), mul_comm] exact hmax +/-- **Variant rule for almost-sure termination** (McIver and Morgan 2005, in the form of Majumdar +and Sathiyanarayana, *Sound and Complete Proof Rules for Probabilistic Termination*, POPL 2025, +Proof Rule 3.1 and Lemma 3.1). + +The program is the transition system of `majumdarSathiyanarayana_martingaleRule`. To show that it +terminates almost surely from `yield b`, find +1. an inductive invariant `Inv` containing `yield b`; +2. a variant function `U : Inv → ℤ`; +3. bounds `Lo` and `Hi` such that `Lo ≤ U < Hi` on `Inv`; +4. an `ε > 0`, + +such that, for each state of `Inv`, +* (4.1) if it is terminal, `U = Lo`; +* (4.3) otherwise, the successors that decrease `U` have a total probability `> ε`. + +Every non-terminal state is probabilistic, so condition (4.2) on assignment and nondeterministic +states does not apply, and "every successor" is "almost every successor". This is the martingale +rule with the supermartingale `1` on the non-terminal states and the variant `U - Lo`. -/ +theorem majumdarSathiyanarayana_variantRule (Inv : ForInStep σ → Prop) (U : ForInStep σ → ℤ) + (Lo Hi : ℤ) (ε : ℝ) (hε : 0 < ε) (hb : Inv (.yield b)) + (hInv : ∀ s, Inv (.yield s) → ∀ᵐ t ∂f s, Inv t) + (hbounds : ∀ t, Inv t → Lo ≤ U t ∧ U t < Hi) + (hdone : ∀ s, Inv (.done s) → U (.done s) = Lo) + (hprog : ∀ s, Inv (.yield s) → ε < (f s {t | U t < U (.yield s)}).toReal) + (hU : Measurable U := by fun_prop) (hf : IsMarkov f := by is_markov) : Terminates f b := by + refine majumdarSathiyanarayana_martingaleRule Inv + (fun t ↦ if t.isDone then 0 else 1) (fun t ↦ (U t - Lo).toNat) hb hInv + (fun _ _ ↦ by simp) (fun _ _ ↦ by simp) (fun s _ ↦ ?_) (fun s hs ↦ by simp [hdone s hs]) + (fun _ ↦ ⟨(Hi - Lo).toNat, fun t ht _ ↦ by grind⟩) + (fun _ ↦ ⟨ε, hε, fun s hs _ ↦ (hprog s hs).trans_le ?_⟩) + (Measurable.ite (ForInStep.measurable_isDone (measurableSet_singleton true)) measurable_const + measurable_const) ((Measurable.of_discrete (f := fun z : ℤ ↦ (z - Lo).toNat)).comp hU) hf + · -- The constant `1` is a supermartingale, since a step has mass `1`. + have := hf.isProbabilityMeasure s + calc _ ≤ ∫⁻ _, 1 ∂f s := lintegral_mono fun t ↦ by split_ifs <;> simp + _ = _ := by simp + · -- Almost every successor is in `Inv`, where `U` decreases exactly when `U - Lo` does. + have := hf.isProbabilityMeasure s + refine ENNReal.toReal_mono (measure_ne_top _ _) ?_ + rw [← measure_inter_conull (t := {t | Inv t}) + (by rw [Set.compl_ofPred]; exact ae_iff.1 (hInv s hs))] + refine measure_mono fun t ⟨hlt, ht⟩ ↦ ?_ + have := (hbounds _ ht).1 + simp only [Set.mem_ofPred_eq] at hlt ⊢ + omega + end Terminates /-- **Lyapunov ranking functions** (Bournez and Garnier, *Proving positive almost-sure termination*, @@ -798,7 +440,7 @@ RTA 2005, Theorem 2, in the form recalled by Ferrer Fioriti and Hermanns, *Proba Termination: Soundness, Completeness, and Compositionality*, POPL 2015, equation (1)). The program is the transition system whose states are the `ForInStep σ`, as in -`Terminates.majumdarSathiyanarayana_variantRule`. A map `v` from its states to the nonnegative +`Terminates.majumdarSathiyanarayana_martingaleRule`. A map `v` from its states to the nonnegative reals is a Lyapunov ranking function if there is an `ε > 0` such that `v(s) ≥ Σ_{s'} P(s, s') v(s') + ε` at every state `s` where a step is enabled, that is at every non-terminal state. Then the program terminates almost surely, and `v(s) / ε` bounds the expected @@ -821,7 +463,7 @@ theorem bournezGarnier (v : ForInStep σ → ℝ≥0) (ε : ℝ≥0) (hε : 0 < ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) (fun s' ↦ ∑ k ∈ Finset.range n, loopRun f k s' Set.univ) ∂f s := by simp_rw [loopRun_succ_apply_univ hf.measurable] - rw [← lintegral_finsetSum _ fun k _ ↦ measurable_casesOn' measurable_const (hmeas k)] + rw [← lintegral_finsetSum _ fun k _ ↦ measurable_casesOn measurable_const (hmeas k)] exact lintegral_congr fun t ↦ by cases t <;> simp rw [Finset.sum_range_succ', hsum, loopRun_zero_apply_univ, mul_add, mul_one, ← lintegral_const_mul' _ _ ENNReal.coe_ne_top] diff --git a/Test/IsMarkov.lean b/Test/IsMarkov.lean index 13bc4fb..f53f66d 100644 --- a/Test/IsMarkov.lean +++ b/Test/IsMarkov.lean @@ -135,22 +135,17 @@ noncomputable def climbFrom (k : ℕ) : Measure ℕ := rdo n := n + 1 return n -/-- The variant rule of McIver and Morgan (Lemma 2.7.1) on the loop `while n < k + 3 do body`: the -states where the loop runs are finitely many, so the variant `k + 3 - n` needs no bounds. -/ +/-- The variant rule of McIver and Morgan, as stated by Majumdar and Sathiyanarayana: below the +invariant bound `k + 3`, the variant is `k + 4 - n` while the loop runs. -/ example : IsMarkov climbFrom := by is_markov - intro k - convert Terminates.mcIverMorgan_variantRule_of_finite (G := (· < k + 3)) (Inv := (k ≤ ·)) - (body := fun n ↦ fairCoin >>=ₘ fun heads ↦ if heads then mPure (n + 1) else mPure n) - (fun n ↦ (k : ℤ) + 3 - n) (1 / 2) (by norm_num) (by norm_num) - (fun h ↦ absurd ((Set.finite_Ico k (k + 3)).subset fun s hs ↦ ⟨hs.2, hs.1⟩) h) - (fun s _ hs ↦ ?_) (fun N s _ _ hN ↦ ?_) le_rfl using 1 - · funext n - by_cases h : n < k + 3 <;> simp [whileStep, h, fairCoin, Measure.map_add, Measure.map_smul, - ForInStep.measurable_yield] - · norm_num [fairCoin, hs, show k ≤ s + 1 by omega] - · subst hN - norm_num [fairCoin] + refine fun k ↦ .majumdarSathiyanarayana_variantRule (fun t ↦ t.run ≤ k + 3) + (fun t ↦ if t.isDone then 0 else (k : ℤ) + 4 - t.run) 0 (k + 5) (1 / 4) (by norm_num) + (by simp) (fun n (hn : n ≤ k + 3) ↦ ?_) (fun t ht ↦ by split_ifs <;> omega) + (fun _ _ ↦ by simp) (fun n (hn : n ≤ k + 3) ↦ ?_) + · rw [ae_iff] + by_cases h : n < k + 3 <;> simp [h, hn.not_gt, fairCoin] + · by_cases h : n < k + 3 <;> norm_num [h, fairCoin, show (n : ℤ) < k + 4 by omega] /-- A deterministic countdown, whose counter is bounded only by its initial value. -/ noncomputable def countdown (k : ℕ) : Measure ℕ := rdo @@ -159,21 +154,16 @@ noncomputable def countdown (k : ℕ) : Measure ℕ := rdo i := i - 1 return i -/-- The variant rule of McIver and Morgan with a variant that cannot increase (p. 56): the counter -itself. -/ +/-- The variant rule of McIver and Morgan, as stated by Majumdar and Sathiyanarayana: below the +invariant bound `k`, the variant is the counter plus one while the loop runs. -/ example : IsMarkov countdown := by is_markov - intro k - convert Terminates.mcIverMorgan_variantRule_of_antitone (b := k) (G := fun i : ℕ ↦ 0 < i) - (Inv := fun _ ↦ True) (body := fun i ↦ (mPure (i - 1) : Measure ℕ)) (fun i ↦ (i : ℤ)) 0 1 - one_pos (fun _ _ _ ↦ by positivity) (fun _ _ _ ↦ by simp) (fun N i hi _ hN ↦ ?_) - (fun N i hi _ hN ↦ ?_) trivial using 1 - · funext i - by_cases h : 0 < i <;> simp [whileStep, h, ForInStep.measurable_yield] - · subst hN - simp [hi] - · subst hN - simp + refine fun k ↦ .majumdarSathiyanarayana_variantRule (fun t ↦ t.run ≤ k) + (fun t ↦ if t.isDone then 0 else (t.run : ℤ) + 1) 0 (k + 2) (1 / 2) (by norm_num) le_rfl + (fun i (hi : i ≤ k) ↦ ?_) (fun t ht ↦ by split_ifs <;> omega) (fun _ _ ↦ by simp) + (fun i _ ↦ by by_cases h : 0 < i <;> norm_num [h]) + rw [ae_iff] + by_cases h : 0 < i <;> simp [h, hi.not_gt, show ¬k < i - 1 by omega] /-- A `while` loop over two mutable variables: the flips until two heads. -/ noncomputable def untilTwoHeads : Measure ℕ := rdo @@ -186,21 +176,17 @@ noncomputable def untilTwoHeads : Measure ℕ := rdo heads := heads + 1 return flips -/-- The variant rule of McIver and Morgan (Lemma 7.5.1), with the variant `2 - heads` between `1` -and `3`. -/ +/-- The variant rule of McIver and Morgan, as stated by Majumdar and Sathiyanarayana: below the +invariant bound `2` on the heads, the variant is `3 - heads` while the loop runs. -/ example : IsProbabilityMeasure untilTwoHeads := by is_markov - intro _ - convert Terminates.mcIverMorgan_variantRule (b := (0, 0)) (G := fun p : ℕ × ℕ ↦ p.1 < 2) - (Inv := fun _ ↦ True) (body := fun p ↦ fairCoin >>=ₘ fun b ↦ - if b then mPure (p.1 + 1, p.2 + 1) else mPure (p.1, p.2 + 1)) - (fun p ↦ 2 - (p.1 : ℤ)) 1 3 (1 / 2) (by norm_num) (fun p hp _ ↦ by omega) - (fun _ _ _ ↦ by norm_num [fairCoin]) (fun N p hp _ hN ↦ ?_) trivial using 1 - · funext p - by_cases h : p.1 < 2 <;> simp [whileStep, h, fairCoin, Measure.map_add, Measure.map_smul, - ForInStep.measurable_yield] - · subst hN - norm_num [fairCoin] + refine fun _ ↦ .majumdarSathiyanarayana_variantRule (fun t ↦ t.run.1 ≤ 2) + (fun t ↦ if t.isDone then 0 else 3 - (t.run.1 : ℤ)) 0 4 (1 / 4) (by norm_num) (by simp) + (fun p (hp : p.1 ≤ 2) ↦ ?_) (fun t ht ↦ by split_ifs <;> omega) (fun _ _ ↦ by simp) + (fun p (hp : p.1 ≤ 2) ↦ ?_) + · rw [ae_iff] + by_cases h : p.1 < 2 <;> simp [h, hp.not_gt, fairCoin] + · by_cases h : p.1 < 2 <;> norm_num [h, fairCoin, show p.1 < 3 by omega] /-- The symmetric random walk on the integers, stopped at `0`: it stops almost surely, but after an infinite expected number of steps, and no bounded variant proves it. -/ @@ -239,7 +225,7 @@ example : IsMarkov randomWalk := by have h2 : (2⁻¹ : ℝ≥0∞) = ENNReal.ofReal 2⁻¹ := by rw [ENNReal.ofReal_inv_of_pos two_pos, ENNReal.ofReal_ofNat] simp only [ne_eq, hy, not_false_eq_true, ↓reduceIte, fairCoin, one_div, mPure_def, mBind_def, - bernoulliMeasure_bind', Nat.ofNat_pos, ENNReal.ofReal_inv_of_pos, ENNReal.ofReal_ofNat, + bernoulliMeasure_bind, Nat.ofNat_pos, ENNReal.ofReal_inv_of_pos, ENNReal.ofReal_ofNat, Bool.false_eq_true, Nat.cast_natAbs, Int.cast_abs, lintegral_add_measure, lintegral_smul_measure, lintegral_dirac, ForInStep.isDone_yield, ForInStep.run_yield, Int.cast_add, Int.cast_one, smul_eq_mul, Int.cast_sub] @@ -262,62 +248,6 @@ example : IsMarkov randomWalk := by have h2 : (y - 1).natAbs < y.natAbs := by omega norm_num [hy, fairCoin, h1, h2] -/-- The new variant rule of McIver, Morgan, Kaminski and Katoen, with the super-martingale `|y|`, -which decreases by `1` with probability `1 / 2`. -/ -example : IsMarkov randomWalk := by - is_markov - intro x - -- Away from `0`, one of `y + 1` and `y - 1` is one closer to `0`, the other one further. - have habs : ∀ y : ℤ, y ≠ 0 → - (|(y : ℝ) + 1| = |(y : ℝ)| + 1 ∧ |(y : ℝ) - 1| = |(y : ℝ)| - 1) ∨ - (|(y : ℝ) + 1| = |(y : ℝ)| - 1 ∧ |(y : ℝ) - 1| = |(y : ℝ)| + 1) := by - intro y hy - rcases lt_or_gt_of_ne hy with h | h - · have : (y : ℝ) ≤ -1 := by exact_mod_cast Int.le_sub_one_of_lt h - right - rw [abs_of_nonpos (show (y : ℝ) + 1 ≤ 0 by linarith), - abs_of_neg (show (y : ℝ) - 1 < 0 by linarith), abs_of_neg (show (y : ℝ) < 0 by linarith)] - constructor <;> ring - · have : (1 : ℝ) ≤ y := by exact_mod_cast h - left - rw [abs_of_pos (show (0 : ℝ) < y + 1 by linarith), - abs_of_nonneg (show (0 : ℝ) ≤ y - 1 by linarith), abs_of_pos (show (0 : ℝ) < y by linarith)] - constructor <;> ring - -- `max (a, 0)` is at most the mean of `max (a - 1, 0)` and `max (a + 1, 0)`. - have hconv : ∀ a : ℝ, ENNReal.ofReal a ≤ - ENNReal.ofReal (1 / 2) * ENNReal.ofReal (a - 1) + - ENNReal.ofReal (1 / 2) * ENNReal.ofReal (a + 1) := by - intro a - rcases le_or_gt a 1 with h | h - · calc ENNReal.ofReal a ≤ ENNReal.ofReal (1 / 2 * (a + 1)) := - ENNReal.ofReal_le_ofReal (by linarith) - _ = ENNReal.ofReal (1 / 2) * ENNReal.ofReal (a + 1) := ENNReal.ofReal_mul (by norm_num) - _ ≤ _ := le_add_self - · rw [← ENNReal.ofReal_mul (by norm_num), ← ENNReal.ofReal_mul (by norm_num), - ← ENNReal.ofReal_add (by nlinarith) (by nlinarith)] - exact ENNReal.ofReal_le_ofReal (by linarith) - convert Terminates.mcIverMorganKaminskiKatoen (b := x) (G := fun y : ℤ ↦ y ≠ 0) - (I := fun _ ↦ True) (body := fun y ↦ fairCoin >>=ₘ fun b ↦ - if b then mPure (y + 1) else mPure (y - 1)) - (fun y ↦ |(y : ℝ)|) (fun _ ↦ abs_nonneg _) (fun _ ↦ 1 / 2) (fun _ ↦ 1) - (fun _ _ ↦ by norm_num) (fun _ _ ↦ one_pos) antitoneOn_const antitoneOn_const - (fun _ _ _ ↦ by norm_num [fairCoin]) (fun y hy _ ↦ by positivity) - (fun R _ y hy _ hR ↦ ?_) (fun H _ y hy _ ↦ ?_) trivial using 1 - · funext y - by_cases h : y = 0 <;> simp [whileStep, h, fairCoin, Measure.map_add, Measure.map_smul, - ForInStep.measurable_yield] - · -- The step towards `0` has probability `1 / 2`. - subst hR - have : ¬|(y : ℝ)| + 1 ≤ |(y : ℝ)| - 1 := by linarith - rcases habs y hy with ⟨h1, h2⟩ | ⟨h1, h2⟩ <;> norm_num [fairCoin, h1, h2, this] - · -- `H ⊖ |y|` is a submartingale away from `0`. - norm_num [fairCoin] - rcases habs y hy with ⟨h1, h2⟩ | ⟨h1, h2⟩ - · rw [h1, h2] - simpa [sub_sub, sub_add] using hconv (H - |(y : ℝ)|) - · rw [h1, h2, add_comm] - simpa [sub_sub, sub_add] using hconv (H - |(y : ℝ)|) - /-! ## Looking through definitions, and the `fuel` argument -/ noncomputable def layerOne : Measure ℝ := sumTwo From d591a175f207b7b8e0beea6e998ebeafa4f5b35b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ga=C3=ABtan=20Serr=C3=A9?= Date: Wed, 30 Sep 2026 16:42:09 +0200 Subject: [PATCH 8/9] LoopInvariant --- RandomDo.lean | 4 +- .../Algebra/Notation/Indicator.lean | 26 - RandomDo/Monad/While.lean | 34 +- RandomDo/Tactic/IsMarkov/Termination.lean | 484 ------------------ .../Tactic/IsMarkov/While/LoopInvariant.lean | 54 ++ .../Tactic/IsMarkov/While/Termination.lean | 196 +++++++ Test/IsMarkov.lean | 101 +--- 7 files changed, 287 insertions(+), 612 deletions(-) delete mode 100644 RandomDo/ForMathlib/Algebra/Notation/Indicator.lean delete mode 100644 RandomDo/Tactic/IsMarkov/Termination.lean create mode 100644 RandomDo/Tactic/IsMarkov/While/LoopInvariant.lean create mode 100644 RandomDo/Tactic/IsMarkov/While/Termination.lean diff --git a/RandomDo.lean b/RandomDo.lean index 3d974f0..4b38ac2 100644 --- a/RandomDo.lean +++ b/RandomDo.lean @@ -1,6 +1,5 @@ module -- shake: keep-all --deprecated_module: ignore -public import RandomDo.ForMathlib.Algebra.Notation.Indicator public import RandomDo.ForMathlib.MeasureTheory.MeasurableSpace.Embedding public import RandomDo.ForMathlib.MeasureTheory.Measure.GiryMonad public import RandomDo.ForMathlib.Probability.Distributions.Bernoulli @@ -27,4 +26,5 @@ public import RandomDo.Tactic.IsMarkov.Deriving public import RandomDo.Tactic.IsMarkov.Elab public import RandomDo.Tactic.IsMarkov.ForInStep public import RandomDo.Tactic.IsMarkov.Lemmas -public import RandomDo.Tactic.IsMarkov.Termination +public import RandomDo.Tactic.IsMarkov.While.LoopInvariant +public import RandomDo.Tactic.IsMarkov.While.Termination diff --git a/RandomDo/ForMathlib/Algebra/Notation/Indicator.lean b/RandomDo/ForMathlib/Algebra/Notation/Indicator.lean deleted file mode 100644 index 9354bbc..0000000 --- a/RandomDo/ForMathlib/Algebra/Notation/Indicator.lean +++ /dev/null @@ -1,26 +0,0 @@ -/- -Copyright (c) 2026 Gaëtan Serré. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gaëtan Serré --/ -module - -public import Mathlib.Algebra.Notation.Indicator - -/-! -# The indicator of a set given by a predicate - --/ - -@[expose] public section - -namespace Set - -variable {α M : Type*} [Zero M] - -@[simp] -lemma indicator_setOf_apply (p : α → Prop) (f : α → M) (a : α) [Decidable (p a)] : - {x | p x}.indicator f a = if p a then f a else 0 := by - simp [indicator_apply] - -end Set diff --git a/RandomDo/Monad/While.lean b/RandomDo/Monad/While.lean index ca5afc2..e75f67a 100644 --- a/RandomDo/Monad/While.lean +++ b/RandomDo/Monad/While.lean @@ -253,30 +253,28 @@ have a mass that tends to `0`. -/ def Terminates (f : σ → Measure (ForInStep σ)) (b : σ) : Prop := Tendsto (fun n ↦ loopRun f n b Set.univ) atTop (𝓝 0) -/-- The expected number of steps of the loop whose step is `f`, from `b`: the sum over `n` of the -probability that it is still going after `n` steps. -/ -noncomputable def expectedSteps (f : σ → Measure (ForInStep σ)) (b : σ) : ℝ≥0∞ := - ∑' n, loopRun f n b Set.univ - -/-- A `while` loop whose step is a Markov kernel is a probability measure exactly when it stops -almost surely. -/ -theorem isProbabilityMeasure_loop_iff (f : σ → Measure (ForInStep σ)) [hf : IsMarkov f] - (b : σ) : IsProbabilityMeasure (loop f b) ↔ Terminates f b := by +/-- The runs still going after `n` steps have a mass that tends to the probability that the loop +never stops: `1` minus the mass of the loop. -/ +lemma tendsto_loopRun_apply_univ (f : σ → Measure (ForInStep σ)) [IsMarkov f] (b : σ) : + Tendsto (fun n ↦ loopRun f n b Set.univ) atTop (𝓝 (1 - loop f b Set.univ)) := by -- The runs that stop within `n` steps have a mass that tends to the mass of the loop. have hExit : Tendsto (fun n ↦ ∑ k ∈ Finset.range n, loopExit f k b Set.univ) atTop (𝓝 (loop f b Set.univ)) := by change Tendsto _ _ (𝓝 (Measure.sum (fun n ↦ loopExit f n b) Set.univ)) rw [Measure.sum_apply _ MeasurableSet.univ] exact ENNReal.tendsto_nat_tsum _ - -- So the runs still going after `n` steps have a mass that tends to `1` minus it. - have hRun : Tendsto (fun n ↦ loopRun f n b Set.univ) atTop (𝓝 (1 - loop f b Set.univ)) := by - have h n : loopRun f n b Set.univ = - 1 - ∑ k ∈ Finset.range n, loopExit f k b Set.univ := by - have hsum := sum_loopExit_add_loopRun f n b - refine ENNReal.eq_sub_of_add_eq ?_ ((add_comm _ _).trans hsum) - exact ne_top_of_le_ne_top ENNReal.one_ne_top (hsum ▸ le_self_add) - simp_rw [h] - exact ENNReal.Tendsto.sub tendsto_const_nhds hExit (Or.inl ENNReal.one_ne_top) + have h n : loopRun f n b Set.univ = 1 - ∑ k ∈ Finset.range n, loopExit f k b Set.univ := by + have hsum := sum_loopExit_add_loopRun f n b + refine ENNReal.eq_sub_of_add_eq ?_ ((add_comm _ _).trans hsum) + exact ne_top_of_le_ne_top ENNReal.one_ne_top (hsum ▸ le_self_add) + simp_rw [h] + exact ENNReal.Tendsto.sub tendsto_const_nhds hExit (Or.inl ENNReal.one_ne_top) + +/-- A `while` loop whose step is a Markov kernel is a probability measure exactly when it stops +almost surely. -/ +theorem isProbabilityMeasure_loop_iff (f : σ → Measure (ForInStep σ)) [hf : IsMarkov f] + (b : σ) : IsProbabilityMeasure (loop f b) ↔ Terminates f b := by + have hRun := tendsto_loopRun_apply_univ f b rw [isProbabilityMeasure_iff, Terminates] constructor · intro h diff --git a/RandomDo/Tactic/IsMarkov/Termination.lean b/RandomDo/Tactic/IsMarkov/Termination.lean deleted file mode 100644 index 5a8f2d3..0000000 --- a/RandomDo/Tactic/IsMarkov/Termination.lean +++ /dev/null @@ -1,484 +0,0 @@ -/- -Copyright (c) 2026 Gaëtan Serré. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gaëtan Serré --/ -module - -public import RandomDo.Monad.While -public import RandomDo.Tactic.IsMarkov.Elab - -/-! -# Termination of `while` loops - -`is_markov` hands back the termination of a `while` loop as a goal `Terminates f b`. This file -implements proof rules of the literature for it, each under the name of its authors and with the -hypotheses of its paper. - -## Main results - -* `Terminates.majumdarSathiyanarayana_martingaleRule`: the martingale rule of Majumdar and - Sathiyanarayana (POPL 2025, Proof Rule 3.2), sound and relatively complete for almost-sure - termination. -* `Terminates.majumdarSathiyanarayana_variantRule`: the variant rule of McIver and Morgan, as - presented by Majumdar and Sathiyanarayana (POPL 2025, Proof Rule 3.1), derived from the - martingale rule with the supermartingale `1`. -* `bournezGarnier`: the Lyapunov ranking functions of Bournez and Garnier (RTA 2005, Theorem 2), - which give almost-sure termination with a bound on the expected number of steps. - -## Implementation notes - -The program is a probabilistic transition system whose states are the `ForInStep σ`: the successor -of `yield s` is drawn from `f s`, and the states `done s` are terminal. Every `rdo` loop is of this -form. It has no demonic nondeterminism, one step is one iteration of the loop, and "every successor" -is "almost every successor". The papers state these rules for discrete probabilistic choice; the -rules here hold for any measurable state space and any Markov kernel, and their measurability -conditions, which a discrete state space satisfies, have default proofs. - -## References - -* Annabelle McIver, Carroll Morgan, *Abstraction, Refinement and Proof for Probabilistic Systems*, - 2005. -* Rupak Majumdar, V. R. Sathiyanarayana, *Sound and Complete Proof Rules for Probabilistic - Termination*, POPL 2025. -* Olivier Bournez, Florent Garnier, *Proving Positive Almost-Sure Termination*, RTA 2005. -* Luis María Ferrer Fioriti, Holger Hermanns, *Probabilistic Termination: Soundness, Completeness, - and Compositionality*, POPL 2015. --/ - -@[expose] public section - -open MeasureTheory Filter -open scoped ENNReal NNReal - -namespace MeasurableSpaceMonadWhile - -universe u - -variable {σ : Type u} [MeasurableSpace σ] {f : σ → Measure (ForInStep σ)} {b : σ} - -/-! ### Geometric decay on an invariant -/ - -private lemma loopRun_add_apply_univ_le [hf : IsMarkov f] {I : σ → Prop} - (hI : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run) {M : ℕ} {c : ℝ≥0∞} (hc : c ≠ ∞) - (h : ∀ s, I s → loopRun f M s Set.univ ≤ c) (n : ℕ) : - ∀ b, I b → loopRun f (n + M) b Set.univ ≤ c * loopRun f n b Set.univ := by - induction n with - | zero => exact fun b hb ↦ by simpa using h b hb - | succ n ih => - intro b hb - rw [Nat.add_right_comm, loopRun_succ_apply_univ hf.measurable, - loopRun_succ_apply_univ hf.measurable, ← lintegral_const_mul' _ _ hc] - refine lintegral_mono_ae ?_ - filter_upwards [hI b hb] with t ht - cases t with - | done _ => simp - | yield s => simpa using ih s (by simpa using ht) - -private lemma loopRun_mul_apply_univ_le [IsMarkov f] {I : σ → Prop} - (hI : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run) {N : ℕ} {c : ℝ≥0∞} (hc : c ≠ ∞) - (h : ∀ s, I s → loopRun f N s Set.univ ≤ c) (k : ℕ) : - ∀ b, I b → loopRun f (N * k) b Set.univ ≤ c ^ k := by - induction k with - | zero => simp - | succ k ih => - intro b hb - rw [Nat.mul_succ, pow_succ'] - exact (loopRun_add_apply_univ_le hI hc h _ b hb).trans (by gcongr; exact ih b hb) - -/-- From a state of an invariant, a loop stops almost surely as soon as, from every state of the -invariant, the runs still going after `N` steps have a mass at most some `c < 1`. -/ -private lemma terminates_of_loopRun_le [IsMarkov f] (I : σ → Prop) - (hI : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run) (N : ℕ) {c : ℝ≥0∞} (hc : c < 1) - (h : ∀ s, I s → loopRun f N s Set.univ ≤ c) (hb : I b) : Terminates f b := by - have lim := tendsto_atTop_iInf (antitone_loopRun_apply_univ f b) - suffices ⨅ n, loopRun f n b Set.univ = 0 by rwa [this] at lim - refine le_antisymm ?_ bot_le - refine ge_of_tendsto' (ENNReal.tendsto_pow_atTop_nhds_zero_of_lt_one hc) fun k ↦ ?_ - exact (iInf_le _ (N * k)).trans - (loopRun_mul_apply_univ_le hI (hc.trans ENNReal.one_lt_top).ne h k b hb) - -/-- From a state of an invariant, a loop stops almost surely if a natural number `V`, bounded by `N` -on the invariant, is decreased or the loop stopped with probability at least `ε > 0` by every step -from the invariant. -/ -private lemma terminates_of_variant [hf : IsMarkov f] (I : σ → Prop) - (hI : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run) (V : σ → ℕ) (hV : Measurable V) (N : ℕ) - (hN : ∀ s, I s → V s ≤ N) (ε : ℝ≥0∞) (hε : ε ≠ 0) - (h : ∀ s, I s → ε ≤ f s {t | t.isDone ∨ V t.run < V s}) (hb : I b) : Terminates f b := by - -- From a state of `I` whose variant is `< n`, the runs still going after `n` steps have a mass - -- at most `1 - εⁿ`. - have key : ∀ n s, I s → V s < n → loopRun f n s Set.univ ≤ 1 - ε ^ n := by - intro n - induction n with - | zero => exact fun s _ hs ↦ absurd hs (Nat.not_lt_zero _) - | succ n ih => - intro s hIs hs - set S := {t : ForInStep σ | t.isDone ∨ V t.run < V s} - have hS : MeasurableSet S := - (ForInStep.measurable_isDone (measurableSet_singleton true)).union - ((hV.comp ForInStep.measurable_run) measurableSet_Iio) - have := hf.isProbabilityMeasure s - have hε1 : ε ≤ 1 := (h s hIs).trans prob_le_one - rw [loopRun_succ_apply_univ hf.measurable] - calc _ ≤ ∫⁻ t, 1 - S.indicator (fun _ ↦ ε ^ n) t ∂f s := by - refine lintegral_mono_ae ?_ - filter_upwards [hI s hIs] with t ht - cases t with - | done s' => simp - | yield s' => - have hIs' : I s' := by simpa using ht - by_cases hlt : V s' < V s - · simpa [S, hlt] using ih s' hIs' (hlt.trans_le (Nat.lt_succ_iff.1 hs)) - · simpa [S, hlt] using loopRun_apply_univ_le_one f n s' - _ = 1 - ε ^ n * f s S := by - rw [lintegral_sub (measurable_const.indicator hS), lintegral_indicator_const hS] - · simp - · rw [lintegral_indicator_const hS] - exact ENNReal.mul_ne_top - (ENNReal.pow_ne_top (ne_top_of_le_ne_top ENNReal.one_ne_top hε1)) (measure_ne_top _ _) - · exact Eventually.of_forall fun t ↦ - Set.indicator_le (fun _ _ ↦ pow_le_one₀ bot_le hε1) t - _ ≤ 1 - ε ^ (n + 1) := tsub_le_tsub_left (by rw [pow_succ]; gcongr; exact h s hIs) 1 - refine terminates_of_loopRun_le I hI (N + 1) (c := 1 - ε ^ (N + 1)) ?_ - (fun s hs ↦ key _ s hs (Nat.lt_succ_of_le (hN s hs))) hb - exact ENNReal.sub_lt_self ENNReal.one_ne_top one_ne_zero (pow_ne_zero _ hε) - -/-! ### Stopping a loop on a set, and the probability of reaching it -/ - -/-- The loop whose step is `f`, stopped as soon as its state is in `A`. -/ -private noncomputable def stopOn (A : Set σ) (f : σ → Measure (ForInStep σ)) (s : σ) : - Measure (ForInStep σ) := - open Classical in if s ∈ A then Measure.dirac (ForInStep.done s) else f s - -private lemma isMarkov_stopOn [hf : IsMarkov f] {A : Set σ} (hA : MeasurableSet A) : - IsMarkov (stopOn A f) := by - classical - refine ⟨?_, fun s ↦ ?_⟩ - · exact Measurable.ite hA (Measure.measurable_dirac.comp ForInStep.measurable_done) hf.measurable - · unfold stopOn - split_ifs - · infer_instance - · exact hf.isProbabilityMeasure s - -private lemma stopOn_of_mem {A : Set σ} {s : σ} (h : s ∈ A) : - stopOn A f s = Measure.dirac (ForInStep.done s) := by - classical - simp [stopOn, h] - -private lemma stopOn_of_notMem {A : Set σ} {s : σ} (h : s ∉ A) : stopOn A f s = f s := by - classical - simp [stopOn, h] - -/-- The stopped loop keeps the invariants of the loop. -/ -private lemma ae_stopOn {A : Set σ} {I : σ → Prop} - (h : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run) : - ∀ s, I s → ∀ᵐ t ∂stopOn A f s, ¬t.isDone → I t.run := by - intro s hs - by_cases hA : s ∈ A - · -- Under the Dirac mass at a stop, every run has stopped. - rw [stopOn_of_mem hA] - have h0 : Measure.dirac (ForInStep.done s) (ForInStep.isDone ⁻¹' {false}) = 0 := by - rw [Measure.dirac_apply' _ (ForInStep.measurable_isDone (measurableSet_singleton false))] - simp - refine measure_mono_null (fun t ht ↦ ?_) h0 - simp only [Set.mem_preimage, Set.mem_singleton_iff] - cases hdone : t.isDone - · rfl - · exact absurd (fun h ↦ absurd hdone h) ht - · rw [stopOn_of_notMem hA] - exact h s hs - -/-- The probability that the loop whose step is `f`, from `s`, is in `A` at one of its first `n + 1` -states while it has not stopped. -/ -private noncomputable def hitRun (f : σ → Measure (ForInStep σ)) (A : Set σ) : ℕ → σ → ℝ≥0∞ - | 0, s => A.indicator 1 s - | n + 1, s => open Classical in - if s ∈ A then 1 else ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) - (hitRun f A n) ∂f s - -private lemma measurable_hitRun (hf : Measurable f) {A : Set σ} (hA : MeasurableSet A) : - ∀ n, Measurable (hitRun f A n) - | 0 => measurable_const.indicator hA - | n + 1 => by - classical - exact Measurable.ite hA measurable_const ((Measure.measurable_lintegral - (measurable_casesOn measurable_const (measurable_hitRun hf hA n))).comp hf) - -/-- The runs still going after `n` steps either are still going in the loop stopped on `A`, or have -been in `A` before. -/ -private lemma loopRun_le_stopOn_add_hitRun [hf : IsMarkov f] {A : Set σ} (hA : MeasurableSet A) : - ∀ n b, loopRun f n b Set.univ ≤ loopRun (stopOn A f) n b Set.univ + hitRun f A n b - | 0, b => by simp - | n + 1, b => by - classical - have hfA := isMarkov_stopOn (f := f) hA - rw [loopRun_succ_apply_univ hf.measurable, loopRun_succ_apply_univ hfA.measurable] - by_cases hb : b ∈ A - · simp only [hitRun, hb, ite_true] - calc _ ≤ (1 : ℝ≥0∞) := (loopRun_succ_apply_univ hf.measurable n b).symm ▸ - loopRun_apply_univ_le_one f (n + 1) b - _ ≤ _ := le_add_self - · simp only [stopOn, hitRun, hb, ite_false] - have hRun : Measurable fun s ↦ loopRun (stopOn A f) n s Set.univ := - (Measure.measurable_coe MeasurableSet.univ).comp (measurable_loopRun hfA.measurable n) - rw [← lintegral_add_left (measurable_casesOn measurable_const hRun)] - refine lintegral_mono fun t ↦ ?_ - cases t with - | done _ => simp - | yield s => simpa [stopOn] using loopRun_le_stopOn_add_hitRun hA n s - -/-- A loop stops almost surely if, for every `δ > 0`, it stops almost surely once stopped on some -set that it reaches with probability at most `δ`. -/ -private lemma terminates_of_stopOn [IsMarkov f] - (h : ∀ δ : ℝ≥0∞, 0 < δ → ∃ A, MeasurableSet A ∧ Terminates (stopOn A f) b ∧ - ∀ n, hitRun f A n b ≤ δ) : Terminates f b := by - have lim := tendsto_atTop_iInf (antitone_loopRun_apply_univ f b) - suffices ⨅ n, loopRun f n b Set.univ = 0 by rwa [this] at lim - refine le_antisymm (ENNReal.le_of_forall_pos_le_add fun δ hδ _ ↦ ?_) bot_le - obtain ⟨A, hA, hterm, hhit⟩ := h δ (by exact_mod_cast hδ) - have := isMarkov_stopOn (f := f) hA - -- The runs of the stopped loop still going tend to `0`. - refine ge_of_tendsto' (hterm.add_const (δ : ℝ≥0∞)) fun n ↦ ?_ - exact (iInf_le _ n).trans ((loopRun_le_stopOn_add_hitRun hA n b).trans - (by gcongr; exact hhit n)) - -/-- **Maximal inequality**, for a nonnegative supermartingale `W` on an invariant: the probability -of reaching a set on which `W ≥ r` is at most `W / r`. -/ -private lemma mul_hitRun_le_of_supermartingale [hf : IsMarkov f] (I : σ → Prop) - (hI : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run) (W : σ → ℝ≥0∞) (hW : Measurable W) - (hsuper : ∀ s, I s → - ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) W ∂f s ≤ W s) - {A : Set σ} (r : ℝ≥0∞) (hA : ∀ s ∈ A, r ≤ W s) (hAm : MeasurableSet A) : - ∀ n s, I s → r * hitRun f A n s ≤ W s - | 0, s, _ => by - classical - simp only [hitRun, Set.indicator_apply, Pi.one_apply] - split_ifs with h - · simpa using hA s h - · simp - | n + 1, s, hs => by - classical - simp only [hitRun] - split_ifs with h - · simpa using hA s h - · rw [← lintegral_const_mul _ (measurable_casesOn measurable_const - (measurable_hitRun hf.measurable hAm n))] - refine le_trans (lintegral_mono_ae ?_) (hsuper s hs) - filter_upwards [hI s hs] with t ht - cases t with - | done _ => simp - | yield s' => - have := mul_hitRun_le_of_supermartingale I hI W hW hsuper r hA hAm n s' (by simpa using ht) - simpa using this - -namespace Terminates - -/-- **Martingale rule for almost-sure termination** (Majumdar and Sathiyanarayana, *Sound and -Complete Proof Rules for Probabilistic Termination*, POPL 2025, Proof Rule 3.2 and Lemma 3.2). - -The program is the transition system whose states are the `ForInStep σ`: the successor of a state -`yield s` is drawn from `f s`, and the states `done s` are terminal. To show that it terminates -almost surely from `yield b`, find -1. an inductive invariant `Inv` containing `yield b`; -2. a supermartingale function `V : Inv → ℝ` that assigns `0` to the terminal states and, at every - other state of `Inv`, (2.1) is positive and (2.3) is at least the expected value of `V` after a - step; -3. a variant function `U : Inv → ℕ` that assigns `0` to the terminal states and satisfies, on each - sublevel set `V≤r = {σ ∈ Inv | V σ ≤ r}`, - (3.2.1) `U` is bounded on `V≤r`, and - (3.2.2) there is an `εᵣ > 0` such that from every non-terminal state of `V≤r`, the successors - that decrease `U` have a total probability `> εᵣ`. - -Every non-terminal state is probabilistic, so conditions (2.2) and (3.1) on assignment and -nondeterministic states do not apply, and "every successor" is "almost every successor". -/ -theorem majumdarSathiyanarayana_martingaleRule (Inv : ForInStep σ → Prop) (V : ForInStep σ → ℝ) - (U : ForInStep σ → ℕ) (hb : Inv (.yield b)) (hInv : ∀ s, Inv (.yield s) → ∀ᵐ t ∂f s, Inv t) - (hVdone : ∀ s, Inv (.done s) → V (.done s) = 0) - (hVpos : ∀ s, Inv (.yield s) → 0 < V (.yield s)) - (hVsuper : ∀ s, Inv (.yield s) → - ∫⁻ t, ENNReal.ofReal (V t) ∂f s ≤ ENNReal.ofReal (V (.yield s))) - (_hUdone : ∀ s, Inv (.done s) → U (.done s) = 0) - (hUbdd : ∀ r : ℝ, ∃ B : ℕ, ∀ t, Inv t → V t ≤ r → U t ≤ B) - (hUprog : ∀ r : ℝ, ∃ ε : ℝ, 0 < ε ∧ ∀ s, Inv (.yield s) → V (.yield s) ≤ r → - ε < (f s {t | U t < U (.yield s)}).toReal) - (hV : Measurable V := by fun_prop) (hU : Measurable U := by fun_prop) - (hf : IsMarkov f := by is_markov) : Terminates f b := by - classical - let I : σ → Prop := fun s ↦ Inv (.yield s) - have hI : ∀ s, I s → ∀ᵐ t ∂f s, ¬t.isDone → I t.run := fun s hs ↦ by - filter_upwards [hInv s hs] with t ht - cases t with - | done _ => simp - | yield _ => simpa [I] using ht - have hVy : Measurable fun s ↦ V (.yield s) := hV.comp ForInStep.measurable_yield - refine terminates_of_stopOn fun δ hδ ↦ ?_ - -- A level `r` above `V b`, high enough for `V b / r ≤ δ`. - obtain ⟨r, hVr, hrδ⟩ : ∃ r : ℝ, V (.yield b) < r ∧ - ENNReal.ofReal (V (.yield b)) / ENNReal.ofReal r ≤ δ := by - have hV0 := (hVpos b hb).le - by_cases hδtop : δ = ⊤ - · exact ⟨V (.yield b) + 1, by linarith, hδtop ▸ le_top⟩ - have hδ' : 0 < δ.toReal := ENNReal.toReal_pos hδ.ne' hδtop - have hq := div_nonneg hV0 hδ'.le - have hr : 0 < V (.yield b) + 1 + V (.yield b) / δ.toReal := by linarith - refine ⟨V (.yield b) + 1 + V (.yield b) / δ.toReal, by linarith, ?_⟩ - rw [← ENNReal.ofReal_div_of_pos hr] - calc ENNReal.ofReal (V (.yield b) / (V (.yield b) + 1 + V (.yield b) / δ.toReal)) - ≤ ENNReal.ofReal δ.toReal := by - refine ENNReal.ofReal_le_ofReal ((div_le_iff₀ hr).2 ?_) - have : δ.toReal * (V (.yield b) / δ.toReal) = V (.yield b) := by field_simp - nlinarith - _ = δ := ENNReal.ofReal_toReal hδtop - have hr : 0 < r := (hVpos b hb).trans hVr - set A := {s | r < V (.yield s)} - have hA : MeasurableSet A := hVy measurableSet_Ioi - refine ⟨A, hA, ?_, fun n ↦ ?_⟩ - · -- Within the sublevel set `V ≤ r`, the variant `U` is bounded and decreases with probability - -- at least `εᵣ`. - have := isMarkov_stopOn (f := f) hA - obtain ⟨B, hB⟩ := hUbdd r - obtain ⟨ε, hε, hprog⟩ := hUprog r - let V' : σ → ℕ := fun s ↦ if s ∈ A then 0 else U (.yield s) - have hV' : Measurable V' := - Measurable.ite hA measurable_const (hU.comp ForInStep.measurable_yield) - refine terminates_of_variant I (ae_stopOn hI) V' hV' B (fun s hs ↦ ?_) - (min (ENNReal.ofReal ε) 1) (lt_min (ENNReal.ofReal_pos.2 hε) one_pos).ne' - (fun s hs ↦ ?_) hb - · simp only [V'] - split_ifs with hsA - · exact Nat.zero_le _ - · exact hB _ hs (by simpa [A] using hsA) - · by_cases hsA : s ∈ A - · rw [stopOn_of_mem hsA, Measure.dirac_apply_of_mem (by simp)] - exact min_le_right _ _ - rw [stopOn_of_notMem hsA] - refine (min_le_left _ _).trans ((ENNReal.ofReal_le_of_le_toReal - (hprog s hs (by simpa [A] using hsA)).le).trans ?_) - rw [← measure_inter_conull (t := {t | Inv t}) - (by rw [Set.compl_ofPred]; exact ae_iff.1 (hInv s hs))] - refine measure_mono fun t ⟨hlt, ht⟩ ↦ ?_ - cases t with - | done _ => simp - | yield s' => - simp only [Set.mem_ofPred_eq] at hlt - simp only [Set.mem_ofPred_eq, ForInStep.isDone_yield, Bool.false_eq_true, false_or, - ForInStep.run_yield] - have hV's : V' s = U (.yield s) := by simp [V', hsA] - rw [hV's] - refine lt_of_le_of_lt ?_ hlt - simp only [V'] - split_ifs - · exact Nat.zero_le _ - · exact le_rfl - · -- The maximal inequality, for the nonnegative supermartingale `V`. - have hsuper : ∀ s, I s → ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) - (fun s ↦ ENNReal.ofReal (V (.yield s))) ∂f s ≤ ENNReal.ofReal (V (.yield s)) := by - intro s hs - refine le_trans (le_of_eq (lintegral_congr_ae ?_)) (hVsuper s hs) - filter_upwards [hInv s hs] with t ht - cases t with - | done s' => simp [hVdone s' ht] - | yield s' => rfl - have hmax := mul_hitRun_le_of_supermartingale I hI (fun s ↦ ENNReal.ofReal (V (.yield s))) - (ENNReal.measurable_ofReal.comp hVy) hsuper (ENNReal.ofReal r) - (fun s hs ↦ ENNReal.ofReal_le_ofReal hs.le) hA n b hb - refine le_trans ?_ hrδ - rw [ENNReal.le_div_iff_mul_le (Or.inl (ENNReal.ofReal_pos.2 hr).ne') - (Or.inl ENNReal.ofReal_ne_top), mul_comm] - exact hmax - -/-- **Variant rule for almost-sure termination** (McIver and Morgan 2005, in the form of Majumdar -and Sathiyanarayana, *Sound and Complete Proof Rules for Probabilistic Termination*, POPL 2025, -Proof Rule 3.1 and Lemma 3.1). - -The program is the transition system of `majumdarSathiyanarayana_martingaleRule`. To show that it -terminates almost surely from `yield b`, find -1. an inductive invariant `Inv` containing `yield b`; -2. a variant function `U : Inv → ℤ`; -3. bounds `Lo` and `Hi` such that `Lo ≤ U < Hi` on `Inv`; -4. an `ε > 0`, - -such that, for each state of `Inv`, -* (4.1) if it is terminal, `U = Lo`; -* (4.3) otherwise, the successors that decrease `U` have a total probability `> ε`. - -Every non-terminal state is probabilistic, so condition (4.2) on assignment and nondeterministic -states does not apply, and "every successor" is "almost every successor". This is the martingale -rule with the supermartingale `1` on the non-terminal states and the variant `U - Lo`. -/ -theorem majumdarSathiyanarayana_variantRule (Inv : ForInStep σ → Prop) (U : ForInStep σ → ℤ) - (Lo Hi : ℤ) (ε : ℝ) (hε : 0 < ε) (hb : Inv (.yield b)) - (hInv : ∀ s, Inv (.yield s) → ∀ᵐ t ∂f s, Inv t) - (hbounds : ∀ t, Inv t → Lo ≤ U t ∧ U t < Hi) - (hdone : ∀ s, Inv (.done s) → U (.done s) = Lo) - (hprog : ∀ s, Inv (.yield s) → ε < (f s {t | U t < U (.yield s)}).toReal) - (hU : Measurable U := by fun_prop) (hf : IsMarkov f := by is_markov) : Terminates f b := by - refine majumdarSathiyanarayana_martingaleRule Inv - (fun t ↦ if t.isDone then 0 else 1) (fun t ↦ (U t - Lo).toNat) hb hInv - (fun _ _ ↦ by simp) (fun _ _ ↦ by simp) (fun s _ ↦ ?_) (fun s hs ↦ by simp [hdone s hs]) - (fun _ ↦ ⟨(Hi - Lo).toNat, fun t ht _ ↦ by grind⟩) - (fun _ ↦ ⟨ε, hε, fun s hs _ ↦ (hprog s hs).trans_le ?_⟩) - (Measurable.ite (ForInStep.measurable_isDone (measurableSet_singleton true)) measurable_const - measurable_const) ((Measurable.of_discrete (f := fun z : ℤ ↦ (z - Lo).toNat)).comp hU) hf - · -- The constant `1` is a supermartingale, since a step has mass `1`. - have := hf.isProbabilityMeasure s - calc _ ≤ ∫⁻ _, 1 ∂f s := lintegral_mono fun t ↦ by split_ifs <;> simp - _ = _ := by simp - · -- Almost every successor is in `Inv`, where `U` decreases exactly when `U - Lo` does. - have := hf.isProbabilityMeasure s - refine ENNReal.toReal_mono (measure_ne_top _ _) ?_ - rw [← measure_inter_conull (t := {t | Inv t}) - (by rw [Set.compl_ofPred]; exact ae_iff.1 (hInv s hs))] - refine measure_mono fun t ⟨hlt, ht⟩ ↦ ?_ - have := (hbounds _ ht).1 - simp only [Set.mem_ofPred_eq] at hlt ⊢ - omega - -end Terminates - -/-- **Lyapunov ranking functions** (Bournez and Garnier, *Proving positive almost-sure termination*, -RTA 2005, Theorem 2, in the form recalled by Ferrer Fioriti and Hermanns, *Probabilistic -Termination: Soundness, Completeness, and Compositionality*, POPL 2015, equation (1)). - -The program is the transition system whose states are the `ForInStep σ`, as in -`Terminates.majumdarSathiyanarayana_martingaleRule`. A map `v` from its states to the nonnegative -reals is a Lyapunov ranking function if there is an `ε > 0` such that -`v(s) ≥ Σ_{s'} P(s, s') v(s') + ε` at every state `s` where a step is enabled, that is at every -non-terminal state. Then the program terminates almost surely, and `v(s) / ε` bounds the expected -number of steps before termination (by Foster's theorem): it is positively almost surely -terminating. Bournez and Garnier take `v` real-valued and bounded below, which is the same up to a -shift. -/ -theorem bournezGarnier (v : ForInStep σ → ℝ≥0) (ε : ℝ≥0) (hε : 0 < ε) - (h : ∀ s, ∫⁻ t, (v t : ℝ≥0∞) ∂f s + ε ≤ v (.yield s)) (hf : IsMarkov f := by is_markov) : - Terminates f b ∧ expectedSteps f b ≤ v (.yield b) / ε := by - -- `ε` times the expected number of steps among the first `n` is at most `v`. - have key : ∀ n s, (ε : ℝ≥0∞) * ∑ k ∈ Finset.range n, loopRun f k s Set.univ ≤ v (.yield s) := by - intro n - induction n with - | zero => simp - | succ n ih => - intro s - have hmeas : ∀ k, Measurable fun s' ↦ loopRun f k s' Set.univ := fun k ↦ - (Measure.measurable_coe MeasurableSet.univ).comp (measurable_loopRun hf.measurable k) - have hsum : ∑ k ∈ Finset.range n, loopRun f (k + 1) s Set.univ = - ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) - (fun s' ↦ ∑ k ∈ Finset.range n, loopRun f k s' Set.univ) ∂f s := by - simp_rw [loopRun_succ_apply_univ hf.measurable] - rw [← lintegral_finsetSum _ fun k _ ↦ measurable_casesOn measurable_const (hmeas k)] - exact lintegral_congr fun t ↦ by cases t <;> simp - rw [Finset.sum_range_succ', hsum, loopRun_zero_apply_univ, mul_add, mul_one, - ← lintegral_const_mul' _ _ ENNReal.coe_ne_top] - refine le_trans ?_ (h s) - refine add_le_add_left (lintegral_mono fun t ↦ ?_) _ - cases t with - | done _ => simp - | yield s' => simpa using ih s' - have hle : expectedSteps f b ≤ v (.yield b) / ε := by - rw [expectedSteps, ENNReal.tsum_eq_iSup_nat] - refine iSup_le fun n ↦ ?_ - rw [ENNReal.le_div_iff_mul_le (Or.inl (ENNReal.coe_ne_zero.2 hε.ne')) - (Or.inl ENNReal.coe_ne_top), mul_comm] - exact key n b - refine ⟨ENNReal.tendsto_atTop_zero_of_tsum_ne_top (ne_top_of_le_ne_top ?_ hle), hle⟩ - exact ENNReal.div_ne_top ENNReal.coe_ne_top (ENNReal.coe_ne_zero.2 hε.ne') - -end MeasurableSpaceMonadWhile diff --git a/RandomDo/Tactic/IsMarkov/While/LoopInvariant.lean b/RandomDo/Tactic/IsMarkov/While/LoopInvariant.lean new file mode 100644 index 0000000..c103b4e --- /dev/null +++ b/RandomDo/Tactic/IsMarkov/While/LoopInvariant.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Gaëtan Serré. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gaëtan Serré +-/ +module + +public import RandomDo.Monad.While + +/-! +# Invariants of `while` loops + +An invariant of a `while` loop is a property of the states it carries on from and one of the states +it stops at, kept by almost every step of the loop. + +## Main definitions + +* `LoopInvariant f`: an invariant of the loop whose step is `f`. +-/ + +@[expose] public section + +open MeasureTheory + +namespace MeasurableSpaceMonadWhile + +universe u + +variable {σ : Type u} [MeasurableSpace σ] {f : σ → Measure (ForInStep σ)} + +/-- An invariant of the loop whose step is `f`: a property `running` of the states the loop carries +on from, and a property `stopped` of the states it stops at, such that from a state satisfying +`running`, almost every step carries on from a state satisfying `running` or stops at a state +satisfying `stopped`. -/ +structure LoopInvariant (f : σ → Measure (ForInStep σ)) where + /-- The property of the states the loop carries on from. -/ + running : σ → Prop + /-- The property of the states the loop stops at. -/ + stopped : σ → Prop := fun _ ↦ True + /-- Almost every step from a state satisfying `running` stays in the invariant. -/ + step : ∀ s, running s → ∀ᵐ t ∂f s, ForInStep.casesOn (motive := fun _ ↦ Prop) t stopped running + +namespace LoopInvariant + +instance : CoeFun (LoopInvariant f) fun _ ↦ ForInStep σ → Prop where + coe I t := ForInStep.casesOn t I.stopped I.running + +/-- The invariant that always holds. -/ +instance : Top (LoopInvariant f) where + top := { running := fun _ ↦ True, step := fun _ _ ↦ .of_forall fun t ↦ by cases t <;> trivial } + +end LoopInvariant + +end MeasurableSpaceMonadWhile diff --git a/RandomDo/Tactic/IsMarkov/While/Termination.lean b/RandomDo/Tactic/IsMarkov/While/Termination.lean new file mode 100644 index 0000000..ea17d4b --- /dev/null +++ b/RandomDo/Tactic/IsMarkov/While/Termination.lean @@ -0,0 +1,196 @@ +/- +Copyright (c) 2026 Gaëtan Serré. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gaëtan Serré +-/ +module + +public import RandomDo.Tactic.IsMarkov.Elab +public import RandomDo.Tactic.IsMarkov.While.LoopInvariant + +/-! +# Termination of `while` loops + +`is_markov` hands back the termination of a `while` loop as a goal `Terminates f b`. This file +implements proof rules of the literature for it, each under the name of its authors and with the +hypotheses of its paper. + +## Main results + +* `Terminates.mcIverMorgan_zeroOneLaw`: the zero-one law of McIver and Morgan (2005, + Lemma 2.6.1). +* `Terminates.majumdarSathiyanarayana_variantRule`: the variant rule of McIver and Morgan, as + presented by Majumdar and Sathiyanarayana (POPL 2025, Proof Rule 3.1), derived from the zero-one + law as McIver and Morgan derive their variant rule (2005, Lemma 2.7.1). + +## Implementation notes + +The program is a probabilistic transition system whose states are the `ForInStep σ`: the successor +of `yield s` is drawn from `f s`, and the states `done s` are terminal. Every `rdo` loop is of this +form. It has no demonic nondeterminism, one step is one iteration of the loop, and "every successor" +is "almost every successor". The papers state these rules for discrete probabilistic choice; the +rules here hold for any measurable state space and any Markov kernel, and their measurability +conditions, which a discrete state space satisfies, have default proofs. + +## References + +* Annabelle McIver, Carroll Morgan, *Abstraction, Refinement and Proof for Probabilistic Systems*, + 2005. +* Rupak Majumdar, V. R. Sathiyanarayana, *Sound and Complete Proof Rules for Probabilistic +Termination*, POPL 2025. +-/ + +@[expose] public section + +open MeasureTheory Filter +open scoped ENNReal Topology + +namespace MeasurableSpaceMonadWhile + +universe u + +variable {σ : Type u} [MeasurableSpace σ] {f : σ → Measure (ForInStep σ)} {b : σ} + +namespace Terminates + +/-- **Zero-one law** (McIver and Morgan 2005, Lemma 2.6.1, stated informally there; its conditions +are formalised by (2.12) with `I = [Inv]`, footnote 27). + +The program is the transition system whose states are the `ForInStep σ`: the successor of a state +`yield s` is drawn from `f s`, and the states `done s` are terminal. Let `I` be an invariant, the +paper's `Inv`, with `I.running b`. If, from every non-terminal state of `I`, the program terminates +with probability at least some fixed `ε > 0`, then it terminates almost surely from `yield b`. The +probability of terminating from `s` is the mass of the loop `loop f s`. -/ +theorem mcIverMorgan_zeroOneLaw (I : LoopInvariant f) (ε : ℝ) (hε : 0 < ε) (hb : I.running b) + (hterm : ∀ s, I.running s → ε ≤ (loop f s Set.univ).toReal) + (hf : IsMarkov f := by is_markov) : Terminates f b := by + -- The probability `r s` that the loop never stops from `s`. + set r : σ → ℝ≥0∞ := fun s ↦ ⨅ n, loopRun f n s Set.univ + have hr s : Tendsto (fun n ↦ loopRun f n s Set.univ) atTop (𝓝 (r s)) := + tendsto_atTop_iInf (antitone_loopRun_apply_univ f s) + -- It is `1` minus the probability that the loop stops, so at most `1 - ε` on `I`. + have hrInv : ∀ s, I.running s → r s ≤ 1 - ENNReal.ofReal ε := fun s hs ↦ by + rw [tendsto_nhds_unique (hr s) (tendsto_loopRun_apply_univ f s)] + exact tsub_le_tsub_left (ENNReal.ofReal_le_of_le_toReal (hterm s hs)) 1 + -- The loop never stops from `s` when one step carries on and it never stops from there. + have hstep s : r s = ∫⁻ t, ForInStep.casesOn (motive := fun _ ↦ ℝ≥0∞) t (fun _ ↦ 0) r ∂f s := by + have := hf.isProbabilityMeasure s + refine tendsto_nhds_unique ((hr s).comp (tendsto_add_atTop_nat 1)) ?_ + simp_rw [Function.comp_def, loopRun_succ_apply_univ hf.measurable] + refine tendsto_lintegral_of_dominated_convergence 1 (fun n ↦ measurable_casesOn + measurable_const ((Measure.measurable_coe MeasurableSet.univ).comp + (measurable_loopRun hf.measurable n))) (fun n ↦ .of_forall fun t ↦ ?_) (by simp) + (.of_forall fun t ↦ ?_) + · cases t <;> simp [loopRun_apply_univ_le_one] + · cases t with + | done _ => exact tendsto_const_nhds + | yield s' => exact hr s' + -- So the loop never stops with probability at most `(1 - ε)` times that it goes on for `m` steps. + have key : ∀ m s, I.running s → r s ≤ (1 - ENNReal.ofReal ε) * loopRun f m s Set.univ := by + intro m + induction m with + | zero => exact fun s hs ↦ by simpa using hrInv s hs + | succ m ih => + intro s hs + rw [hstep s, loopRun_succ_apply_univ hf.measurable, + ← lintegral_const_mul' _ _ (ne_top_of_le_ne_top ENNReal.one_ne_top tsub_le_self)] + refine lintegral_mono_ae ?_ + filter_upwards [I.step s hs] with t ht + cases t with + | done _ => simp + | yield s' => simpa using ih s' ht + -- In the limit, `r b ≤ (1 - ε) r b`, so `r b = 0`. + have hle : r b ≤ (1 - ENNReal.ofReal ε) * r b := ge_of_tendsto' + (ENNReal.Tendsto.const_mul (hr b) (Or.inr (ne_top_of_le_ne_top ENNReal.one_ne_top + tsub_le_self))) fun m ↦ key m b hb + have hr0 : r b = 0 := by + by_contra h + have hrb : r b ≠ ∞ := ne_top_of_le_ne_top ENNReal.one_ne_top + ((iInf_le _ 0).trans (loopRun_apply_univ_le_one f 0 b)) + have hlt : 1 - ENNReal.ofReal ε < 1 := + ENNReal.sub_lt_self ENNReal.one_ne_top one_ne_zero (ENNReal.ofReal_pos.2 hε).ne' + exact (ENNReal.mul_lt_mul_left h hrb hlt).not_ge (by simpa using hle) + simpa [Terminates, hr0] using hr b + +/-- **Variant rule for almost-sure termination** (McIver and Morgan 2005, in the form of Majumdar +and Sathiyanarayana, *Sound and Complete Proof Rules for Probabilistic Termination*, POPL 2025, +Proof Rule 3.1 and Lemma 3.1). + +The program is the transition system of `mcIverMorgan_zeroOneLaw`. To show that it terminates +almost surely from `yield b`, find +1. an inductive invariant `Inv` containing `yield b`, here an invariant `I` with `I.running b`; +2. a variant function `U : Inv → ℤ`; +3. bounds `Lo` and `Hi` such that `Lo ≤ U < Hi` on `Inv`; +4. an `ε > 0`, + +such that, for each non-terminal state of `Inv`, (4.3) the successors that decrease `U` have a total +probability `> ε`. + +Every non-terminal state is probabilistic, so condition (4.2) on assignment and nondeterministic +states does not apply, and "every successor" is "almost every successor". Condition (4.1), `U = Lo` +on the terminal states, is not needed and is dropped: the rule of the paper follows by forgetting +it. Setting `U = Lo` on the terminal states still makes stopping count as decreasing `U`. + +As in McIver and Morgan's proof of their variant rule (Lemma 2.7.1), the program terminates within +`Hi - Lo` steps with probability at least `ε ^ (Hi - Lo)` from every state of `Inv`, and the +zero-one law concludes. -/ +theorem majumdarSathiyanarayana_variantRule (I : LoopInvariant f) (U : ForInStep σ → ℤ) + (Lo Hi : ℤ) (ε : ℝ) (hε : 0 < ε) (hb : I.running b) + (hbounds : ∀ t, I t → Lo ≤ U t ∧ U t < Hi) + (hprog : ∀ s, I.running s → ε < (f s {t | U t < U (.yield s)}).toReal) + (hU : Measurable U := by fun_prop) (hf : IsMarkov f := by is_markov) : Terminates f b := by + have hprog' s (hs : I.running s) : ENNReal.ofReal ε ≤ f s {t | U t < U (.yield s)} := + ENNReal.ofReal_le_of_le_toReal (hprog s hs).le + have hε1 s (hs : I.running s) : ENNReal.ofReal ε ≤ 1 := by + have := hf.isProbabilityMeasure s + exact (hprog' s hs).trans prob_le_one + -- From a state of `I` where `U - Lo < n`, the loop goes on for `n` steps with probability at + -- most `1 - εⁿ`. + have key : ∀ n s, I.running s → (U (.yield s) - Lo).toNat < n → + loopRun f n s Set.univ ≤ 1 - ENNReal.ofReal ε ^ n := by + intro n + induction n with + | zero => exact fun s _ hs ↦ absurd hs (Nat.not_lt_zero _) + | succ n ih => + intro s hs hUs + set S := {t : ForInStep σ | U t < U (.yield s)} + have hS : MeasurableSet S := hU measurableSet_Iio + have := hf.isProbabilityMeasure s + rw [loopRun_succ_apply_univ hf.measurable] + calc _ ≤ ∫⁻ t, 1 - S.indicator (fun _ ↦ ENNReal.ofReal ε ^ n) t ∂f s := by + refine lintegral_mono_ae ?_ + filter_upwards [I.step s hs] with t ht + cases t with + | done _ => simp + | yield s' => + by_cases hlt : U (.yield s') < U (.yield s) + · have := (hbounds (.yield s') ht).1 + simpa [S, hlt] using ih s' ht (by omega) + · simpa [S, hlt] using loopRun_apply_univ_le_one f n s' + _ = 1 - ENNReal.ofReal ε ^ n * f s S := by + rw [lintegral_sub (measurable_const.indicator hS), lintegral_indicator_const hS] + · simp + · rw [lintegral_indicator_const hS] + exact ENNReal.mul_ne_top (ENNReal.pow_ne_top ENNReal.ofReal_ne_top) (measure_ne_top _ _) + · exact .of_forall fun t ↦ + Set.indicator_le (fun _ _ ↦ pow_le_one₀ bot_le (hε1 s hs)) t + _ ≤ 1 - ENNReal.ofReal ε ^ (n + 1) := + tsub_le_tsub_left (by rw [pow_succ]; gcongr; exact hprog' s hs) 1 + -- So the loop stops with probability at least `ε ^ (Hi - Lo)` from every state of `I`. + refine mcIverMorgan_zeroOneLaw I (ε ^ (Hi - Lo).toNat) (pow_pos hε _) hb + (fun s hs ↦ ?_) hf + have hloop : loop f s Set.univ ≤ 1 := measure_loop_univ_le_one (fun s ↦ by + have := hf.isProbabilityMeasure s + exact prob_le_one) s + have hlim : 1 - loop f s Set.univ ≤ 1 - ENNReal.ofReal ε ^ (Hi - Lo).toNat := by + refine le_of_tendsto (tendsto_loopRun_apply_univ f s) (eventually_atTop.2 ⟨_, fun n hn ↦ + (antitone_loopRun_apply_univ f s hn).trans (key _ s hs ?_)⟩) + have := hbounds (.yield s) hs + omega + rw [ENNReal.sub_le_sub_iff_left (pow_le_one₀ bot_le (hε1 s hs)) ENNReal.one_ne_top, + ← ENNReal.ofReal_pow hε.le] at hlim + exact (ENNReal.ofReal_le_iff_le_toReal (ne_top_of_le_ne_top ENNReal.one_ne_top hloop)).1 hlim + +end Terminates + +end MeasurableSpaceMonadWhile diff --git a/Test/IsMarkov.lean b/Test/IsMarkov.lean index f53f66d..50a51df 100644 --- a/Test/IsMarkov.lean +++ b/Test/IsMarkov.lean @@ -98,7 +98,7 @@ example : IsMarkov overList := by is_markov `is_markov` proves that a `while` loop is Markovian up to its termination, which it hands back as a goal `Terminates`. Each test closes it with a proof rule of the literature, from -`RandomDo.Tactic.IsMarkov.Termination`. -/ +`RandomDo.Tactic.IsMarkov.While.Termination`. -/ noncomputable def untilHeads : Measure ℕ := rdo let mut n := 0 @@ -109,23 +109,15 @@ noncomputable def untilHeads : Measure ℕ := rdo break return n -/-- The variant rule of McIver and Morgan, as stated by Majumdar and Sathiyanarayana: the variant is -`1` while the loop runs, `0` once it has stopped. -/ +/-- The variant rule of McIver and Morgan, as stated by Majumdar and Sathiyanarayana: with the +invariant that always holds, the variant is `1` while the loop runs, `0` once it has stopped. -/ example : IsProbabilityMeasure untilHeads := by is_markov - refine fun _ ↦ .majumdarSathiyanarayana_variantRule (fun _ ↦ True) - (fun t ↦ if t.isDone then 0 else 1) 0 2 (1 / 4) (by norm_num) trivial - (fun _ _ ↦ Filter.Eventually.of_forall fun _ ↦ trivial) (fun t _ ↦ by split_ifs <;> simp) - (fun _ _ ↦ by simp) fun n _ ↦ ?_ + refine fun _ ↦ .majumdarSathiyanarayana_variantRule ⊤ (fun t ↦ if t.isDone then 0 else 1) 0 2 + (1 / 4) (by norm_num) trivial (fun t _ ↦ by split_ifs <;> simp) + fun n _ ↦ ?_ norm_num [fairCoin] -/-- The Lyapunov ranking function of Bournez and Garnier, `2` while the loop runs: the loop also -takes at most `2` steps in expectation. -/ -example : IsProbabilityMeasure untilHeads := by - is_markov - exact fun _ ↦ (bournezGarnier (fun t ↦ if t.isDone then 0 else 2) 1 one_pos fun n ↦ by - norm_num [fairCoin, ENNReal.ofReal_div_of_pos, ENNReal.inv_mul_cancel]).1 - /-- A `while` loop whose condition reads the parameter. -/ noncomputable def climbFrom (k : ℕ) : Measure ℕ := rdo let mut n := k @@ -139,12 +131,14 @@ noncomputable def climbFrom (k : ℕ) : Measure ℕ := rdo invariant bound `k + 3`, the variant is `k + 4 - n` while the loop runs. -/ example : IsMarkov climbFrom := by is_markov - refine fun k ↦ .majumdarSathiyanarayana_variantRule (fun t ↦ t.run ≤ k + 3) + refine fun k ↦ .majumdarSathiyanarayana_variantRule + { running := (· ≤ k + 3), step := fun n (hn : n ≤ k + 3) ↦ ?_ } (fun t ↦ if t.isDone then 0 else (k : ℤ) + 4 - t.run) 0 (k + 5) (1 / 4) (by norm_num) - (by simp) (fun n (hn : n ≤ k + 3) ↦ ?_) (fun t ht ↦ by split_ifs <;> omega) - (fun _ _ ↦ by simp) (fun n (hn : n ≤ k + 3) ↦ ?_) + (Nat.le_add_right k 3) (fun t ht ↦ by cases t <;> simp at ht ⊢ <;> omega) + (fun n (hn : n ≤ k + 3) ↦ ?_) · rw [ae_iff] by_cases h : n < k + 3 <;> simp [h, hn.not_gt, fairCoin] + omega · by_cases h : n < k + 3 <;> norm_num [h, fairCoin, show (n : ℤ) < k + 4 by omega] /-- A deterministic countdown, whose counter is bounded only by its initial value. -/ @@ -158,12 +152,14 @@ noncomputable def countdown (k : ℕ) : Measure ℕ := rdo invariant bound `k`, the variant is the counter plus one while the loop runs. -/ example : IsMarkov countdown := by is_markov - refine fun k ↦ .majumdarSathiyanarayana_variantRule (fun t ↦ t.run ≤ k) + refine fun k ↦ .majumdarSathiyanarayana_variantRule + { running := (· ≤ k), step := fun i (hi : i ≤ k) ↦ ?_ } (fun t ↦ if t.isDone then 0 else (t.run : ℤ) + 1) 0 (k + 2) (1 / 2) (by norm_num) le_rfl - (fun i (hi : i ≤ k) ↦ ?_) (fun t ht ↦ by split_ifs <;> omega) (fun _ _ ↦ by simp) + (fun t ht ↦ by cases t <;> simp at ht ⊢ <;> omega) (fun i _ ↦ by by_cases h : 0 < i <;> norm_num [h]) rw [ae_iff] - by_cases h : 0 < i <;> simp [h, hi.not_gt, show ¬k < i - 1 by omega] + by_cases h : 0 < i <;> simp [h] + omega /-- A `while` loop over two mutable variables: the flips until two heads. -/ noncomputable def untilTwoHeads : Measure ℕ := rdo @@ -180,74 +176,15 @@ noncomputable def untilTwoHeads : Measure ℕ := rdo invariant bound `2` on the heads, the variant is `3 - heads` while the loop runs. -/ example : IsProbabilityMeasure untilTwoHeads := by is_markov - refine fun _ ↦ .majumdarSathiyanarayana_variantRule (fun t ↦ t.run.1 ≤ 2) + refine fun _ ↦ .majumdarSathiyanarayana_variantRule + { running := fun p ↦ p.1 ≤ 2, step := fun p (hp : p.1 ≤ 2) ↦ ?_ } (fun t ↦ if t.isDone then 0 else 3 - (t.run.1 : ℤ)) 0 4 (1 / 4) (by norm_num) (by simp) - (fun p (hp : p.1 ≤ 2) ↦ ?_) (fun t ht ↦ by split_ifs <;> omega) (fun _ _ ↦ by simp) + (fun t ht ↦ by cases t <;> simp at ht ⊢; omega) (fun p (hp : p.1 ≤ 2) ↦ ?_) · rw [ae_iff] by_cases h : p.1 < 2 <;> simp [h, hp.not_gt, fairCoin] · by_cases h : p.1 < 2 <;> norm_num [h, fairCoin, show p.1 < 3 by omega] -/-- The symmetric random walk on the integers, stopped at `0`: it stops almost surely, but after an -infinite expected number of steps, and no bounded variant proves it. -/ -noncomputable def randomWalk (x : ℤ) : Measure ℤ := rdo - let mut y := x - while y ≠ 0 rdo - let b ← fairCoin - if b then - y := y + 1 - else - y := y - 1 - return y - -/-- The martingale rule of Majumdar and Sathiyanarayana, with `|y| + 1` as both the supermartingale -and the variant. -/ -example : IsMarkov randomWalk := by - is_markov - refine fun _ ↦ .majumdarSathiyanarayana_martingaleRule (fun _ ↦ True) - (fun t ↦ if t.isDone then 0 else (t.run.natAbs : ℝ) + 1) - (fun t ↦ if t.isDone then 0 else t.run.natAbs + 1) trivial - (fun _ _ ↦ Filter.Eventually.of_forall fun _ ↦ trivial) (fun _ _ ↦ by simp) - (fun _ _ ↦ by simp only [ForInStep.isDone_yield, Bool.false_eq_true, ↓reduceIte]; positivity) - (fun y _ ↦ ?_) (fun _ _ ↦ by simp) - (fun r ↦ ⟨⌈r⌉₊, fun t _ ht ↦ ?_⟩) (fun r ↦ ⟨1 / 4, by norm_num, fun y _ _ ↦ ?_⟩) - · -- `|y| + 1` is a martingale away from `0`: `|y + 1| + |y - 1| = 2 |y|`. - by_cases hy : y = 0 - · simp [hy] - have habs : |(y : ℝ) + 1| + |(y : ℝ) - 1| = 2 * |(y : ℝ)| := by - rcases lt_or_gt_of_ne hy with h | h - · have : (y : ℝ) ≤ -1 := by exact_mod_cast Int.le_sub_one_of_lt h - rw [abs_of_nonpos (by linarith), abs_of_neg (by linarith), abs_of_neg (by linarith)] - ring - · have : (1 : ℝ) ≤ y := by exact_mod_cast h - rw [abs_of_pos (by linarith), abs_of_nonneg (by linarith), abs_of_pos (by linarith)] - ring - have h2 : (2⁻¹ : ℝ≥0∞) = ENNReal.ofReal 2⁻¹ := by - rw [ENNReal.ofReal_inv_of_pos two_pos, ENNReal.ofReal_ofNat] - simp only [ne_eq, hy, not_false_eq_true, ↓reduceIte, fairCoin, one_div, mPure_def, mBind_def, - bernoulliMeasure_bind, Nat.ofNat_pos, ENNReal.ofReal_inv_of_pos, ENNReal.ofReal_ofNat, - Bool.false_eq_true, Nat.cast_natAbs, Int.cast_abs, lintegral_add_measure, - lintegral_smul_measure, lintegral_dirac, ForInStep.isDone_yield, ForInStep.run_yield, - Int.cast_add, Int.cast_one, smul_eq_mul, Int.cast_sub] - rw [show (1 : ℝ) - 2⁻¹ = 2⁻¹ by norm_num, h2, ← ENNReal.ofReal_mul (by norm_num), - ← ENNReal.ofReal_mul (by norm_num), ← ENNReal.ofReal_add (by positivity) (by positivity)] - exact ENNReal.ofReal_le_ofReal (by linarith) - · cases t with - | done _ => simp - | yield y => - simp only [ForInStep.isDone_yield, Bool.false_eq_true, ite_false, ForInStep.run_yield] at ht ⊢ - exact_mod_cast (show ((y.natAbs + 1 : ℕ) : ℝ) ≤ r by exact_mod_cast ht).trans (Nat.le_ceil r) - · -- The step towards `0` has probability `1 / 2`. - by_cases hy : y = 0 - · norm_num [hy] - rcases lt_or_gt_of_ne hy with h | h - · have h1 : (y + 1).natAbs < y.natAbs := by omega - have h2 : ¬(y - 1).natAbs < y.natAbs := by omega - norm_num [hy, fairCoin, h1, h2] - · have h1 : ¬(y + 1).natAbs < y.natAbs := by omega - have h2 : (y - 1).natAbs < y.natAbs := by omega - norm_num [hy, fairCoin, h1, h2] - /-! ## Looking through definitions, and the `fuel` argument -/ noncomputable def layerOne : Measure ℝ := sumTwo From 92d419925f022562f3abd2afbd3729549babd635 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ga=C3=ABtan=20Serr=C3=A9?= Date: Thu, 1 Oct 2026 17:54:20 +0200 Subject: [PATCH 9/9] WIP terminates --- RandomDo.lean | 1 + .../Tactic/IsMarkov/While/LoopInvariant.lean | 4 - RandomDo/Tactic/IsMarkov/While/Tactic.lean | 144 ++++++++++++++++++ .../Tactic/IsMarkov/While/Termination.lean | 24 +++ Test/IsMarkov.lean | 130 +++++++++++----- 5 files changed, 259 insertions(+), 44 deletions(-) create mode 100644 RandomDo/Tactic/IsMarkov/While/Tactic.lean diff --git a/RandomDo.lean b/RandomDo.lean index 4b38ac2..e781baa 100644 --- a/RandomDo.lean +++ b/RandomDo.lean @@ -27,4 +27,5 @@ public import RandomDo.Tactic.IsMarkov.Elab public import RandomDo.Tactic.IsMarkov.ForInStep public import RandomDo.Tactic.IsMarkov.Lemmas public import RandomDo.Tactic.IsMarkov.While.LoopInvariant +public import RandomDo.Tactic.IsMarkov.While.Tactic public import RandomDo.Tactic.IsMarkov.While.Termination diff --git a/RandomDo/Tactic/IsMarkov/While/LoopInvariant.lean b/RandomDo/Tactic/IsMarkov/While/LoopInvariant.lean index c103b4e..0321379 100644 --- a/RandomDo/Tactic/IsMarkov/While/LoopInvariant.lean +++ b/RandomDo/Tactic/IsMarkov/While/LoopInvariant.lean @@ -45,10 +45,6 @@ namespace LoopInvariant instance : CoeFun (LoopInvariant f) fun _ ↦ ForInStep σ → Prop where coe I t := ForInStep.casesOn t I.stopped I.running -/-- The invariant that always holds. -/ -instance : Top (LoopInvariant f) where - top := { running := fun _ ↦ True, step := fun _ _ ↦ .of_forall fun t ↦ by cases t <;> trivial } - end LoopInvariant end MeasurableSpaceMonadWhile diff --git a/RandomDo/Tactic/IsMarkov/While/Tactic.lean b/RandomDo/Tactic/IsMarkov/While/Tactic.lean new file mode 100644 index 0000000..8672815 --- /dev/null +++ b/RandomDo/Tactic/IsMarkov/While/Tactic.lean @@ -0,0 +1,144 @@ +/- +Copyright (c) 2026 Gaëtan Serré. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gaëtan Serré +-/ +module + +public import RandomDo.Tactic.IsMarkov.While.Termination + +/-! +# A tactic for the termination of `while` loops + +`terminates` proves the goal `Terminates f b` that `is_markov` hands back for a `while` loop, from +an invariant, a variant and a probability given on the states of the loop. It applies a rule of +`RandomDo.Tactic.IsMarkov.While.Termination`, unfolds the step of the loop on its successors, and +leaves the remaining conditions as goals about the states only. + +## Main declarations + +* `loop_step`: simplifies a goal about one step of a loop into conditions on its successors. +* `terminates`: proves the termination of a loop by one of the rules. +-/ + +public meta section + +open Lean + +/-- `loop_step [h₁, …]` simplifies a goal about one step of a loop: a property that almost every +successor of a state satisfies, the probability of a set of successors, or an arithmetic condition. +It evaluates the step on its successors, with the additional simp lemmas `h₁, …` for the +definitions of the program, splits on the conditions of the program, and tries to close the +resulting goals, which only mention the state. -/ +syntax (name := loopStep) "loop_step" (" [" term,* "]")? : tactic + +macro_rules + | `(tactic| loop_step $[[$ls,*]]?) => do + let ls : Array Term := (ls.map (·.getElems)).getD #[] + `(tactic| ( + try intro $(mkIdent `s) $(mkIdent `hs) + try simp only at * + try simp only [MeasureTheory.ae_iff] + try split_ifs + all_goals try norm_num [MeasureTheory.Measure.dirac_apply, Set.indicator_apply, + ENNReal.toReal_add, ENNReal.toReal_ofReal', ENNReal.mul_eq_top, $[$ls:term],*] at * + -- A measure followed by a deterministic successor is its image, and the probability of a set + -- under the image is at least the probability of its preimage. + all_goals try rw [MeasureTheory.Measure.bind_dirac_eq_map] + all_goals try refine le_trans ?_ (ENNReal.toReal_mono (MeasureTheory.measure_ne_top _ _) + (MeasureTheory.Measure.le_map_apply ?_ _)) + all_goals try fun_prop + all_goals try simp only [Set.preimage_ofPred_eq] at * + all_goals try split_ifs + all_goals try norm_num [ENNReal.toReal_add, ENNReal.toReal_ofReal', ENNReal.mul_eq_top] at * + all_goals repeat' apply And.intro + all_goals try first | done | trivial | assumption | omega | linarith | positivity)) + +/-- The invariant of `terminates`: the given property of the running states, whose stability is left +as the goal `step`, or the property that always holds. -/ +def invariant (P? : Option Term) : MacroM Term := + match P? with + | some P => `(({ running := $P, step := ?step } : MeasurableSpaceMonadWhile.LoopInvariant _)) + | none => `(({ running := fun _ ↦ True + step := fun _ _ ↦ Filter.Eventually.of_forall fun t ↦ by cases t <;> trivial } : + MeasurableSpaceMonadWhile.LoopInvariant _)) + +/-- `terminates` proves the termination of a `while` loop, the goal `Terminates f b` that +`is_markov` hands back (after `intro` of the parameters the loop depends on). + +* `terminates (prob := ε)` applies `Terminates.mcIverMorgan_immediateEscape`: every step stops with + probability at least `ε > 0`. +* `terminates (variant := U) (bound := N) (prob := ε)` applies + `Terminates.majumdarSathiyanarayana_variantRule`, with a variant `U : σ → ℕ` on the states, at + most `N`, decreased with probability at least `ε > 0` by every step that does not stop. Stopping + counts as decreasing `U`. +* `(invariant := P)`, before the other arguments, restricts both to the states satisfying + `P : σ → Prop`, which almost every step keeps. +* `[h₁, …]`, after the other arguments, are simp lemmas for the definitions of the program. + +The variant rule takes a variant `U'` on the states `ForInStep σ` of the transition system, with +`Lo ≤ U' < Hi`, and a probability `> ε` of decreasing it. `terminates` applies it to +`U' (done s) = 0` and `U' (yield s) = U s + 1`, between `Lo = 0` and `Hi = N + 2`, with `ε / 2`: +* A step from `yield s` that stops goes to some `done s'`, and counts as decreasing `U'` only if + `U' (done s') < U' (yield s)`. As `U` can be `0` on a running state (when the loop is about to + stop, as `countdown` at `0`), the terminal states need a value below all the values of `U`: + hence the shift of `U` by `1` on the running states, the terminal states taking `0`. A step to + `yield s'` still decreases `U'` exactly when it decreases `U`. +* On the invariant, `U s ≤ N`, so `0 ≤ U' ≤ N + 1`, and the strict upper bound of the rule is + `N + 2`: one for the shift, one for passing from `≤` to `<`. +* `(prob := ε)` asks for a probability at least `ε`, while the rule asks for one greater than its + constant: a probability `≥ ε` is `> ε / 2`. + +The conditions it cannot prove are left as goals about the states only. -/ +syntax (name := terminatesTac) "terminates" (atomic(" (" &"invariant") " := " term ")")? + (atomic(" (" &"variant") " := " term ")")? (atomic(" (" &"bound") " := " term ")")? + " (" &"prob" " := " term ")" (" [" term,* "]")? : tactic + +macro_rules + | `(tactic| terminates $[(invariant := $P?)]? (prob := $ε) $[[$ls,*]]?) => do + let ls : Array Term := (ls.map (·.getElems)).getD #[] + let I ← invariant P? + `(tactic| ( + intros + refine MeasurableSpaceMonadWhile.Terminates.mcIverMorgan_immediateEscape $I $ε ?pos + ?init ?stop + all_goals try loop_step [$[$ls:term],*])) + | `(tactic| terminates $[(invariant := $P?)]? (variant := $U) (bound := $N) (prob := $ε) + $[[$ls,*]]?) => do + let ls : Array Term := (ls.map (·.getElems)).getD #[] + let I ← invariant P? + let P ← P?.getDM `(fun _ ↦ True) + `(tactic| ( + intros + -- `U` shifted by `1` on the running states, below which the terminal states are `0`: see the + -- docstring for the bounds `0` and `N + 2` and for `ε / 2`. + refine MeasurableSpaceMonadWhile.Terminates.majumdarSathiyanarayana_variantRule $I + (fun t ↦ ForInStep.casesOn (motive := fun _ ↦ ℤ) t (fun _ ↦ 0) fun s ↦ (($U s : ℕ) : ℤ) + 1) + 0 ((($N : ℕ) : ℤ) + 2) ($ε / 2) (half_pos ?pos) ?init ?bounds + (fun $(mkIdent `s) $(mkIdent `hs) ↦ (half_lt_self ?pos).trans_le ?progress) ?measurable + -- The bound of the lifted variant, from the bound `U ≤ N` on the states of the invariant. + case' bounds => + intro t $(mkIdent `hs) + cases t with + | done _ => dsimp only; omega + | yield $(mkIdent `s) => + replace $(mkIdent `hs) : ($P) $(mkIdent `s) := $(mkIdent `hs) + try dsimp only at $(mkIdent `hs):ident ⊢ + refine (fun h : ($U) $(mkIdent `s) ≤ ($N) ↦ by (try simp only [] at h); omega) ?_ + try loop_step [$[$ls:term],*] + -- The measurability of the lifted variant, from the measurability of `U`. + case' measurable => first + | exact Measurable.of_discrete + | (refine MeasurableSpaceMonadWhile.measurable_casesOn measurable_const + (((Measurable.of_discrete (f := fun n : ℕ ↦ (n : ℤ))).comp ?_).add_const 1) + first | fun_prop | measurability | skip) + try case' step => try loop_step [$[$ls:term],*] + try case' init => try loop_step [$[$ls:term],*] + try case' pos => try loop_step [$[$ls:term],*] + try case' progress => try loop_step [$[$ls:term],*])) + | `(tactic| terminates $[(invariant := $_)]? (variant := $_) (prob := $_) $[[$_,*]]?) => + Macro.throwError "terminates: a variant needs a bound, given by `(bound := N)`" + | `(tactic| terminates $[(invariant := $_)]? (bound := $_) (prob := $_) $[[$_,*]]?) => + Macro.throwError "terminates: a bound needs a variant, given by `(variant := U)`" + +end diff --git a/RandomDo/Tactic/IsMarkov/While/Termination.lean b/RandomDo/Tactic/IsMarkov/While/Termination.lean index ea17d4b..1e70659 100644 --- a/RandomDo/Tactic/IsMarkov/While/Termination.lean +++ b/RandomDo/Tactic/IsMarkov/While/Termination.lean @@ -22,6 +22,9 @@ hypotheses of its paper. * `Terminates.majumdarSathiyanarayana_variantRule`: the variant rule of McIver and Morgan, as presented by Majumdar and Sathiyanarayana (POPL 2025, Proof Rule 3.1), derived from the zero-one law as McIver and Morgan derive their variant rule (2005, Lemma 2.7.1). +* `Terminates.mcIverMorgan_immediateEscape`: termination when every step stops with probability at + least some fixed `ε > 0`, the stronger condition McIver and Morgan remark after their zero-one law + (2005, p. 54). ## Implementation notes @@ -191,6 +194,27 @@ theorem majumdarSathiyanarayana_variantRule (I : LoopInvariant f) (U : ForInStep ← ENNReal.ofReal_pow hε.le] at hlim exact (ENNReal.ofReal_le_iff_le_toReal (ne_top_of_le_ne_top ENNReal.one_ne_top hloop)).1 hlim +/-- **Immediate escape** (McIver and Morgan 2005, p. 54: the stronger condition they remark after +the zero-one law, Lemma 2.6.1). + +If, from every non-terminal state of the invariant `I`, one step stops with probability at least +some fixed `ε > 0`, then the program terminates almost surely from `yield b`. This is the condition +of a rejection sampling loop, which stops as soon as its sample satisfies a property of probability +at least `ε`. It is the variant rule with the variant `1` on the non-terminal states and `0` on the +terminal ones. -/ +theorem mcIverMorgan_immediateEscape (I : LoopInvariant f) (ε : ℝ) (hε : 0 < ε) (hb : I.running b) + (hstop : ∀ s, I.running s → ε ≤ (f s {t | t.isDone}).toReal) + (hf : IsMarkov f := by is_markov) : Terminates f b := by + refine majumdarSathiyanarayana_variantRule I (fun t ↦ if t.isDone then 0 else 1) 0 2 (ε / 2) + (half_pos hε) hb (fun t _ ↦ by split_ifs <;> simp) (fun s hs ↦ ?_) + (Measurable.ite (ForInStep.measurable_isDone (measurableSet_singleton true)) + measurable_const measurable_const) hf + -- The successors that decrease the variant are the terminal ones. + refine (half_lt_self hε).trans_le ((hstop s hs).trans_eq ?_) + congr 2 + ext t + cases t <;> simp + end Terminates end MeasurableSpaceMonadWhile diff --git a/Test/IsMarkov.lean b/Test/IsMarkov.lean index 50a51df..32d1c16 100644 --- a/Test/IsMarkov.lean +++ b/Test/IsMarkov.lean @@ -12,7 +12,7 @@ node. There is one test here per construct it recognises. -/ open scoped ENNReal -open MeasureTheory ProbabilityTheory MeasurableSpacePure MeasurableSpaceMonadWhile +open MeasureTheory ProbabilityTheory MeasurableSpacePure @[expose] public section @@ -97,8 +97,8 @@ example : IsMarkov overList := by is_markov /-! ## `while`, whose termination is handed back `is_markov` proves that a `while` loop is Markovian up to its termination, which it hands back as a -goal `Terminates`. Each test closes it with a proof rule of the literature, from -`RandomDo.Tactic.IsMarkov.While.Termination`. -/ +goal `Terminates`. Each test closes it with `terminates`, which applies a proof rule of the +literature from `RandomDo.Tactic.IsMarkov.While.Termination`. -/ noncomputable def untilHeads : Measure ℕ := rdo let mut n := 0 @@ -109,14 +109,10 @@ noncomputable def untilHeads : Measure ℕ := rdo break return n -/-- The variant rule of McIver and Morgan, as stated by Majumdar and Sathiyanarayana: with the -invariant that always holds, the variant is `1` while the loop runs, `0` once it has stopped. -/ +/-- Immediate escape: every step stops with probability `1 / 2`. -/ example : IsProbabilityMeasure untilHeads := by is_markov - refine fun _ ↦ .majumdarSathiyanarayana_variantRule ⊤ (fun t ↦ if t.isDone then 0 else 1) 0 2 - (1 / 4) (by norm_num) trivial (fun t _ ↦ by split_ifs <;> simp) - fun n _ ↦ ?_ - norm_num [fairCoin] + terminates (prob := 1 / 2) [fairCoin] /-- A `while` loop whose condition reads the parameter. -/ noncomputable def climbFrom (k : ℕ) : Measure ℕ := rdo @@ -127,19 +123,13 @@ noncomputable def climbFrom (k : ℕ) : Measure ℕ := rdo n := n + 1 return n -/-- The variant rule of McIver and Morgan, as stated by Majumdar and Sathiyanarayana: below the -invariant bound `k + 3`, the variant is `k + 4 - n` while the loop runs. -/ +/-- The variant rule: below the invariant bound `k + 3`, the variant `k + 3 - n` decreases with +probability `1 / 2`. -/ example : IsMarkov climbFrom := by is_markov - refine fun k ↦ .majumdarSathiyanarayana_variantRule - { running := (· ≤ k + 3), step := fun n (hn : n ≤ k + 3) ↦ ?_ } - (fun t ↦ if t.isDone then 0 else (k : ℤ) + 4 - t.run) 0 (k + 5) (1 / 4) (by norm_num) - (Nat.le_add_right k 3) (fun t ht ↦ by cases t <;> simp at ht ⊢ <;> omega) - (fun n (hn : n ≤ k + 3) ↦ ?_) - · rw [ae_iff] - by_cases h : n < k + 3 <;> simp [h, hn.not_gt, fairCoin] - omega - · by_cases h : n < k + 3 <;> norm_num [h, fairCoin, show (n : ℤ) < k + 4 by omega] + intro k + terminates (invariant := (· ≤ k + 3)) (variant := (k + 3 - ·)) (bound := k + 3) (prob := 1 / 2) + [fairCoin] /-- A deterministic countdown, whose counter is bounded only by its initial value. -/ noncomputable def countdown (k : ℕ) : Measure ℕ := rdo @@ -148,18 +138,11 @@ noncomputable def countdown (k : ℕ) : Measure ℕ := rdo i := i - 1 return i -/-- The variant rule of McIver and Morgan, as stated by Majumdar and Sathiyanarayana: below the -invariant bound `k`, the variant is the counter plus one while the loop runs. -/ +/-- The variant rule: below the invariant bound `k`, the counter decreases at every step. -/ example : IsMarkov countdown := by is_markov - refine fun k ↦ .majumdarSathiyanarayana_variantRule - { running := (· ≤ k), step := fun i (hi : i ≤ k) ↦ ?_ } - (fun t ↦ if t.isDone then 0 else (t.run : ℤ) + 1) 0 (k + 2) (1 / 2) (by norm_num) le_rfl - (fun t ht ↦ by cases t <;> simp at ht ⊢ <;> omega) - (fun i _ ↦ by by_cases h : 0 < i <;> norm_num [h]) - rw [ae_iff] - by_cases h : 0 < i <;> simp [h] - omega + intro k + terminates (invariant := (· ≤ k)) (variant := id) (bound := k) (prob := 1) /-- A `while` loop over two mutable variables: the flips until two heads. -/ noncomputable def untilTwoHeads : Measure ℕ := rdo @@ -172,18 +155,85 @@ noncomputable def untilTwoHeads : Measure ℕ := rdo heads := heads + 1 return flips -/-- The variant rule of McIver and Morgan, as stated by Majumdar and Sathiyanarayana: below the -invariant bound `2` on the heads, the variant is `3 - heads` while the loop runs. -/ +/-- The variant rule, on the pairs `(heads, flips)`: below the invariant bound `2` on the heads, the +variant `2 - heads` decreases with probability `1 / 2`. -/ example : IsProbabilityMeasure untilTwoHeads := by is_markov - refine fun _ ↦ .majumdarSathiyanarayana_variantRule - { running := fun p ↦ p.1 ≤ 2, step := fun p (hp : p.1 ≤ 2) ↦ ?_ } - (fun t ↦ if t.isDone then 0 else 3 - (t.run.1 : ℤ)) 0 4 (1 / 4) (by norm_num) (by simp) - (fun t ht ↦ by cases t <;> simp at ht ⊢; omega) - (fun p (hp : p.1 ≤ 2) ↦ ?_) - · rw [ae_iff] - by_cases h : p.1 < 2 <;> simp [h, hp.not_gt, fairCoin] - · by_cases h : p.1 < 2 <;> norm_num [h, fairCoin, show p.1 < 3 by omega] + terminates (invariant := fun p ↦ p.1 ≤ 2) (variant := fun p ↦ 2 - p.1) (bound := 2) + (prob := 1 / 2) [fairCoin] + +/-- The flips of a coin of bias `p` until heads. -/ +noncomputable def geometric (p : unitInterval) : Measure ℕ := rdo + let mut n := 0 + while true rdo + let b ← bernoulliMeasure true false p + n := n + 1 + if b then + break + return n + +/-- Immediate escape, with a symbolic probability. -/ +example (p : unitInterval) (hp : 0 < (p : ℝ)) : IsProbabilityMeasure (geometric p) := by + is_markov + terminates (prob := p) + +/-- The gambler's ruin: a fair random walk stopped at `0` and at `N`. -/ +noncomputable def ruin (N x : ℕ) : Measure ℕ := rdo + let mut y := x + while 0 < y ∧ y < N rdo + let b ← fairCoin + if b then + y := y + 1 + else + y := y - 1 + return y + +/-- The variant rule, with the distance to the nearest barrier as the variant. -/ +example (N : ℕ) : IsMarkov (ruin N) := by + is_markov + terminates (variant := fun y ↦ min y (N - y)) (bound := N) (prob := 1 / 2) [fairCoin] + +/-- A die by rejection: three flips give a number below `8`, kept if it is below `6`. -/ +noncomputable def die : Measure ℕ := rdo + let mut r := 6 + while 6 ≤ r rdo + let a ← fairCoin + let b ← fairCoin + let c ← fairCoin + r := (if a then 4 else 0) + (if b then 2 else 0) + (if c then 1 else 0) + return r + +/-- The variant rule, with the variant `1` on the rejected numbers: a step keeps the number it draws +with probability `3 / 4`. -/ +example : IsProbabilityMeasure die := by + is_markov + terminates (variant := fun r ↦ if 6 ≤ r then 1 else 0) (bound := 1) (prob := 3 / 4) [fairCoin] + +/-- A Gaussian random walk, stopped once it leaves `(-1, 1)`. -/ +noncomputable def gaussianWalk (x : ℝ) : Measure ℝ := rdo + let mut y := x + while |y| < 1 rdo + let z ← gaussianReal 0 1 + y := y + z + return y + +/-- The variant rule, with the variant `1` inside `(-1, 1)`: a step leaves it with probability at +least `P(Z ≥ 2)`. The goals left are about the Gaussian distribution only. -/ +example : IsMarkov gaussianWalk := by + is_markov + intro x + terminates (variant := fun y ↦ if |y| < 1 then 1 else 0) (bound := 1) + (prob := (gaussianReal 0 1 (Set.Ici 2)).toReal) + · -- From `|s| < 1`, a step of at least `2` leaves `(-1, 1)`. + rename_i h + refine measure_mono fun a (ha : 2 ≤ a) ↦ ?_ + have := (abs_lt.1 h).1 + simp [show ¬|s + a| < 1 from fun h' ↦ by linarith [(abs_lt.1 h').2]] + · exact ENNReal.toReal_le_of_le_ofReal zero_le_one (by simp [prob_le_one]) + · refine ENNReal.toReal_pos (fun h ↦ ?_) (measure_ne_top _ _) + simpa using gaussianReal_absolutelyContinuous' 0 one_ne_zero h + · exact Measurable.ite (measurableSet_lt (by fun_prop) measurable_const) measurable_const + measurable_const /-! ## Looking through definitions, and the `fuel` argument -/