From 5909d1bae7648600e86ab49730835ce9d336ca95 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 17:07:14 -0500 Subject: [PATCH 01/17] feat(DataStructure/Memory): word-addressed memory oracle and named field arrays Memory.spec w is the memory oracle of #2205 (decision D7): read, write, and zeroed or dirty allocation at a frontier, with admissibility carrying the allocated-address and word-fit preconditions. Field arrays are WordRAM Blocks accessed by Block.get/Block.set programs over the oracle. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 2 + Complexity/DataStructure/Memory/Field.lean | 183 +++++++++++++++ Complexity/DataStructure/Memory/Spec.lean | 258 +++++++++++++++++++++ ComplexityTests/DataStructureMemory.lean | 117 ++++++++++ 4 files changed, 560 insertions(+) create mode 100644 Complexity/DataStructure/Memory/Field.lean create mode 100644 Complexity/DataStructure/Memory/Spec.lean create mode 100644 ComplexityTests/DataStructureMemory.lean diff --git a/Complexity.lean b/Complexity.lean index 7f9a77746d..00f4bf2faf 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -2873,6 +2873,8 @@ public import Complexity.DataStructure.HashFamily.WordRAM.DoubleTabulation public import Complexity.DataStructure.HashFamily.WordRAM.KWise public import Complexity.DataStructure.HashFamily.WordRAM.MultiplyShift public import Complexity.DataStructure.HashFamily.WordRAM.Tabulation +public import Complexity.DataStructure.Memory.Field +public import Complexity.DataStructure.Memory.Spec public import Complexity.DataStructure.ObliviousSequence public import Complexity.DataStructure.Online.Basic public import Complexity.DataStructure.OrderedSet.Basic diff --git a/Complexity/DataStructure/Memory/Field.lean b/Complexity/DataStructure/Memory/Field.lean new file mode 100644 index 0000000000..f065798d88 --- /dev/null +++ b/Complexity/DataStructure/Memory/Field.lean @@ -0,0 +1,183 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.WordRAM.ListArray +public import Complexity.DataStructure.Memory.Spec + +/-! +# Named field arrays over the memory oracle + +A field array is a `Cslib.WordRAM.Block`: a base address and a length. A data structure lays out +its storage as a structure whose fields are blocks (a struct of arrays) and accesses entry `i` of +a field `f` with the programs `f.get i` and `f.set i v` over `Memory.spec w`. Addresses are thus +named (`par.get v`) rather than computed by hand (`base + n + v`), while computed indices, pointer +chasing (`do let p ← next.get v; key.get p`) and reuse of a block across operations remain +ordinary programs. + +The lemmas here evaluate these programs, discharge their admissibility from `Block.Allocated`, +and describe their frame: a write to a field leaves every other address unchanged. +`Block.entries` reads the first `n` entries of a field as a list, which is how an abstraction +function usually sees an array. It realizes `Block.HoldsList`. + +## Main definitions + +* `Cslib.WordRAM.Block.get`, `Cslib.WordRAM.Block.set`: entry access through the oracle. +* `Cslib.WordRAM.Block.Allocated`: the block lies below the frontier. +* `Cslib.WordRAM.Block.entries`: the first `n` entries of a field in index order. +* `Cslib.DataStructure.Memory.allocBlock`, `Cslib.DataStructure.Memory.allocBlockDirty`: + allocate a field. + +## Main results + +* `Cslib.WordRAM.Block.runClient_get_bind`, `Cslib.WordRAM.Block.runClient_set_bind`: one-step + evaluation of field accesses. +* `Cslib.WordRAM.Block.Allocated.lt_frontier`, `Cslib.WordRAM.Block.Allocated.mono`: allocated + entries are admissible addresses, and stay allocated. +* `Cslib.WordRAM.Block.entries_succ`, `Cslib.WordRAM.Block.entries_congr`, + `Cslib.WordRAM.Block.entries_update_of_le`, `Cslib.WordRAM.Block.entries_update_of_not_owns`: + the list view under appends and writes. +* `Cslib.WordRAM.Block.holdsList_entries`: the list view realizes `Block.HoldsList`. +* `Cslib.DataStructure.Memory.runClient_allocBlock_bind`: allocation hands out a zeroed, + allocated block at the frontier. +-/ + +@[expose] public section + +namespace Cslib.WordRAM.Block + +open Cslib.DataStructure + +/-- Read entry `i` of the field `b` through the memory oracle. -/ +abbrev get (b : Block) (i : ℕ) : Memory.Prog ℕ := Memory.read (b.base + i) + +/-- Write `v` to entry `i` of the field `b` through the memory oracle. -/ +abbrev set (b : Block) (i v : ℕ) : Memory.Prog Unit := Memory.write (b.base + i) v + +/-- The block lies below the frontier, so all of its entries are allocated. -/ +def Allocated (b : Block) (s : Memory.State) : Prop := b.base + b.length ≤ s.frontier + +/-- An entry of an allocated block is an allocated address. -/ +theorem Allocated.lt_frontier {b : Block} {s : Memory.State} (h : b.Allocated s) {i : ℕ} + (hi : i < b.length) : b.base + i < s.frontier := by + unfold Allocated at h + omega + +/-- A block stays allocated as the frontier grows. -/ +theorem Allocated.mono {b : Block} {s s' : Memory.State} (h : b.Allocated s) + (hs : s.frontier ≤ s'.frontier) : b.Allocated s' := + le_trans h hs + +/-- A block owns the address of each of its entries. -/ +theorem owns_add {b : Block} {i : ℕ} (hi : i < b.length) : b.Owns (b.base + i) := + ⟨Nat.le_add_right _ _, Nat.add_lt_add_left hi _⟩ + +/-- Reading an entry returns the cell and leaves memory unchanged. -/ +@[simp] theorem runClient_get_bind {w : ℕ} {α : Type} (b : Block) (i : ℕ) (k : ℕ → Memory.Prog α) + (s : Memory.State) : + (Memory.spec w).runClient s (b.get i >>= k) = + let (v, s', os) := (Memory.spec w).runClient s (k (s.mem (b.base + i))) + (v, s', .read (b.base + i) :: os) := rfl + +/-- Writing an entry updates its cell. -/ +@[simp] theorem runClient_set_bind {w : ℕ} {α : Type} (b : Block) (i v : ℕ) + (k : Unit → Memory.Prog α) (s : Memory.State) : + (Memory.spec w).runClient s (b.set i v >>= k) = + let (r, s', os) := (Memory.spec w).runClient + ⟨Function.update s.mem (b.base + i) v, s.frontier⟩ (k ()) + (r, s', .write (b.base + i) v :: os) := rfl + +/-! ## The list of entries -/ + +/-- The first `n` entries of the field `b` in memory `m`, in index order. -/ +def entries (b : Block) (n : ℕ) (m : ℕ → ℕ) : List ℕ := + (List.range n).map fun i => m (b.base + i) + +@[simp] theorem length_entries (b : Block) (n : ℕ) (m : ℕ → ℕ) : (b.entries n m).length = n := by + simp [entries] + +@[simp] theorem entries_zero (b : Block) (m : ℕ → ℕ) : b.entries 0 m = [] := rfl + +/-- Entry `i` of the list view is the cell at `b.base + i`. -/ +@[simp] theorem getElem_entries (b : Block) (n : ℕ) (m : ℕ → ℕ) (i : ℕ) + (hi : i < (b.entries n m).length) : (b.entries n m)[i] = m (b.base + i) := by + simp [entries] + +/-- One more entry appends its cell. -/ +theorem entries_succ (b : Block) (n : ℕ) (m : ℕ → ℕ) : + b.entries (n + 1) m = b.entries n m ++ [m (b.base + n)] := by + simp [entries, List.range_succ] + +/-- The list view depends only on the cells of its entries. -/ +theorem entries_congr (b : Block) (n : ℕ) {m m' : ℕ → ℕ} + (h : ∀ i < n, m' (b.base + i) = m (b.base + i)) : b.entries n m' = b.entries n m := + List.map_congr_left fun i hi => h i (List.mem_range.mp hi) + +/-- Writing at or beyond entry `n` leaves the first `n` entries unchanged. -/ +theorem entries_update_of_le (b : Block) {n i : ℕ} (hi : n ≤ i) (m : ℕ → ℕ) (v : ℕ) : + b.entries n (Function.update m (b.base + i) v) = b.entries n m := + b.entries_congr n fun j hj => Function.update_of_ne (by omega) v m + +/-- Writing outside the block leaves every entry unchanged. -/ +theorem entries_update_of_not_owns (b : Block) {n : ℕ} (hn : n ≤ b.length) {a : ℕ} + (ha : ¬b.Owns a) (m : ℕ → ℕ) (v : ℕ) : + b.entries n (Function.update m a v) = b.entries n m := + b.entries_congr n fun j hj => + Function.update_of_ne (fun h => ha (by rw [← h]; exact owns_add (by omega))) v m + +/-- The list view of `n` entries realizes the list at the block's base. -/ +theorem holdsList_entries (b : Block) (n : ℕ) (m : ℕ → ℕ) : + HoldsList b.base (b.entries n m) m := fun i => by + simp [Block.read] + +end Cslib.WordRAM.Block + +namespace Cslib.DataStructure.Memory + +open Cslib.WordRAM + +/-- Allocate a zeroed field of `k` cells. -/ +def allocBlock (k : ℕ) : Prog Block := do + let base ← alloc k + pure ⟨base, k⟩ + +/-- Allocate a field of `k` cells without clearing it. -/ +def allocBlockDirty (k : ℕ) : Prog Block := do + let base ← allocDirty k + pure ⟨base, k⟩ + +/-- A zeroed allocation hands out the block at the frontier, clears it, and advances the +frontier past it. -/ +@[simp] theorem runClient_allocBlock_bind {w : ℕ} {α : Type} (k : ℕ) (next : Block → Prog α) + (s : State) : + (spec w).runClient s (allocBlock k >>= next) = + let (v, s', os) := (spec w).runClient + ⟨clear s.mem s.frontier k, s.frontier + k⟩ (next ⟨s.frontier, k⟩) + (v, s', .alloc k :: os) := rfl + +/-- A dirty allocation hands out the block at the frontier without changing memory. -/ +@[simp] theorem runClient_allocBlockDirty_bind {w : ℕ} {α : Type} (k : ℕ) + (next : Block → Prog α) (s : State) : + (spec w).runClient s (allocBlockDirty k >>= next) = + let (v, s', os) := (spec w).runClient ⟨s.mem, s.frontier + k⟩ (next ⟨s.frontier, k⟩) + (v, s', .allocDirty k :: os) := rfl + +/-- A freshly allocated block is allocated in the new state. -/ +theorem allocated_alloc (s : State) (k : ℕ) : + (Block.mk s.frontier k).Allocated ⟨clear s.mem s.frontier k, s.frontier + k⟩ := + le_rfl + +/-- A freshly allocated zeroed block holds zeros. -/ +theorem entries_alloc (s : State) (k : ℕ) {n : ℕ} (hn : n ≤ k) : + (Block.mk s.frontier k).entries n (clear s.mem s.frontier k) = List.replicate n 0 := by + refine List.ext_getElem (by simp) fun i hi _ => ?_ + simp only [Block.length_entries] at hi + simp only [Block.getElem_entries, List.getElem_replicate] + exact clear_of_owns (Block.owns_add (b := ⟨s.frontier, k⟩) (by simp only; omega)) + +end Cslib.DataStructure.Memory diff --git a/Complexity/DataStructure/Memory/Spec.lean b/Complexity/DataStructure/Memory/Spec.lean new file mode 100644 index 0000000000..3507072aee --- /dev/null +++ b/Complexity/DataStructure/Memory/Spec.lean @@ -0,0 +1,258 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.WordRAM.Heap +public import Complexity.DataStructure.StateTransition + +/-! +# Word-addressed memory as a state-transition specification + +`Memory.spec w` is a memory oracle: the interface through which a data-structure implementation +reaches storage. Its state is the contents of every cell together with an allocation frontier. +Every address below the frontier is allocated, and allocation hands out the block that starts at +the frontier. The operations read a cell, write a cell, and allocate a block, either zeroed +(`alloc`, charged per cell) or with its old contents (`allocDirty`, charged one unit). + +Admissibility carries the preconditions a word RAM needs. Accessed addresses must be allocated, +written values must fit a `w`-bit word, and the frontier after an allocation must fit. Under +these preconditions the frontier and every cell keep fitting a word (`WellFormed.step`), so an +allocated address fits too (`WellFormed.fits_of_lt_frontier`). + +An implementation over this interface is an ordinary `Memory.Prog` program. Its correctness and +its operation charges are proved against `step` and `charge`, without registers or instruction +counts. `charge` is the memory-level currency; executing such a program on the word RAM is a +separate step that exchanges it into instructions. Allocation never reuses addresses, as in +`Cslib.WordRAM.alloc`, so blocks allocated at different times are disjoint +(`Cslib.WordRAM.Block.disjoint_of_le`). A program reuses memory by keeping a block it allocated. + +## Main definitions + +* `Memory.State`, `Memory.Op`, `Memory.step`, `Memory.valid`: cells and frontier, operations + with their answers, the transition function and the admissibility preconditions. +* `Memory.spec`: the deterministic specification at word size `w`. +* `Memory.charge`: one unit per read, write and dirty allocation; `k + 1` for a zeroed block of + `k` cells. +* `Memory.Prog`, `Memory.read`, `Memory.write`, `Memory.alloc`, `Memory.allocDirty`: programs + over the oracle and its four one-call programs. +* `Memory.WellFormed`: the frontier and all cell contents fit a `w`-bit word. +* `Memory.State.init`: the word RAM's input convention as a memory state. + +## Main results + +* `Memory.WellFormed.step`, `Memory.WellFormed.run`: admissible operations preserve + well-formedness. +* `Memory.WellFormed.fits_of_lt_frontier`: allocated addresses fit a word. +* `Memory.frontier_le_step`, `Memory.frontier_le_run`: the frontier never decreases. +* `Memory.mem_step_of_lt_frontier`: an operation changes an allocated cell only by writing it. +* `Memory.wellFormed_init`: the input convention is well formed. +-/ + +@[expose] public section + +namespace Cslib.DataStructure.Memory + +open Cslib.WordRAM + +/-- Memory: the contents of every cell, and the frontier below which cells are allocated. -/ +@[ext] +structure State where + /-- The contents of the cell at each address. -/ + mem : ℕ → ℕ + /-- Every address below the frontier is allocated; the next block starts here. -/ + frontier : ℕ + +/-- Operations on memory. Addresses are words computed by the caller. -/ +inductive Op where + /-- Read the cell at an address. -/ + | read (addr : ℕ) + /-- Write a value to the cell at an address. -/ + | write (addr value : ℕ) + /-- Allocate `count` zeroed cells at the frontier and return their base address. -/ + | alloc (count : ℕ) + /-- Allocate `count` cells at the frontier without clearing them and return their base + address. -/ + | allocDirty (count : ℕ) + deriving DecidableEq + +/-- The answer type of each operation: a read and an allocation return a word. -/ +abbrev Op.Result : Op → Type + | .read _ => ℕ + | .write _ _ => Unit + | .alloc _ => ℕ + | .allocDirty _ => ℕ + +/-- The transition of each operation. An allocation returns the old frontier. -/ +def step (s : State) : (o : Op) → State × o.Result + | .read a => (s, s.mem a) + | .write a v => (⟨Function.update s.mem a v, s.frontier⟩, ()) + | .alloc k => (⟨clear s.mem s.frontier k, s.frontier + k⟩, s.frontier) + | .allocDirty k => (⟨s.mem, s.frontier + k⟩, s.frontier) + +/-- Admissibility at word size `w`: accessed addresses are allocated, written values fit a word, +and an allocation leaves a fitting frontier. -/ +def valid (w : ℕ) (s : State) : Op → Prop + | .read a => a < s.frontier + | .write a v => a < s.frontier ∧ Fits w v + | .alloc k => Fits w (s.frontier + k) + | .allocDirty k => Fits w (s.frontier + k) + +instance (w : ℕ) (s : State) (o : Op) : Decidable (valid w s o) := by + cases o <;> unfold valid <;> infer_instance + +/-- Word-addressed memory at word size `w`. -/ +abbrev spec (w : ℕ) : StateTransitionSpec := + StateTransitionSpec.ofFn (State := State) (Op := Op) (Result := Op.Result) step (valid w) + +/-- The memory-level currency: one unit per read, write and dirty allocation, and `k + 1` units +for a zeroed block of `k` cells. -/ +def charge (_ : State) : Op → ℕ + | .alloc k => k + 1 + | _ => 1 + +/-- Programs over the memory oracle. They are the clients of `Memory.spec w` at every word size. -/ +abbrev Prog (α : Type) : Type := PFunctor.FreeM ⟨Op, Op.Result⟩ α + +/-- Read the cell at address `a`. -/ +abbrev read (a : ℕ) : Prog ℕ := PFunctor.FreeM.lift (P := ⟨Op, Op.Result⟩) (.read a) + +/-- Write `v` to the cell at address `a`. -/ +abbrev write (a v : ℕ) : Prog Unit := PFunctor.FreeM.lift (P := ⟨Op, Op.Result⟩) (.write a v) + +/-- Allocate `k` zeroed cells and return their base address. -/ +abbrev alloc (k : ℕ) : Prog ℕ := PFunctor.FreeM.lift (P := ⟨Op, Op.Result⟩) (.alloc k) + +/-- Allocate `k` cells without clearing them and return their base address. -/ +abbrev allocDirty (k : ℕ) : Prog ℕ := + PFunctor.FreeM.lift (P := ⟨Op, Op.Result⟩) (.allocDirty k) + +@[simp] theorem step_read (s : State) (a : ℕ) : step s (.read a) = (s, s.mem a) := rfl + +@[simp] theorem step_write (s : State) (a v : ℕ) : + step s (.write a v) = (⟨Function.update s.mem a v, s.frontier⟩, ()) := rfl + +@[simp] theorem step_alloc (s : State) (k : ℕ) : + step s (.alloc k) = (⟨clear s.mem s.frontier k, s.frontier + k⟩, s.frontier) := rfl + +@[simp] theorem step_allocDirty (s : State) (k : ℕ) : + step s (.allocDirty k) = (⟨s.mem, s.frontier + k⟩, s.frontier) := rfl + +@[simp] theorem valid_read (w : ℕ) (s : State) (a : ℕ) : valid w s (.read a) ↔ a < s.frontier := + Iff.rfl + +@[simp] theorem valid_write (w : ℕ) (s : State) (a v : ℕ) : + valid w s (.write a v) ↔ a < s.frontier ∧ Fits w v := Iff.rfl + +@[simp] theorem valid_alloc (w : ℕ) (s : State) (k : ℕ) : + valid w s (.alloc k) ↔ Fits w (s.frontier + k) := Iff.rfl + +@[simp] theorem valid_allocDirty (w : ℕ) (s : State) (k : ℕ) : + valid w s (.allocDirty k) ↔ Fits w (s.frontier + k) := Iff.rfl + +@[simp] theorem charge_read (s : State) (a : ℕ) : charge s (.read a) = 1 := rfl + +@[simp] theorem charge_write (s : State) (a v : ℕ) : charge s (.write a v) = 1 := rfl + +@[simp] theorem charge_alloc (s : State) (k : ℕ) : charge s (.alloc k) = k + 1 := rfl + +@[simp] theorem charge_allocDirty (s : State) (k : ℕ) : charge s (.allocDirty k) = 1 := rfl + +/-- Admissibility of a concrete history is decidable. -/ +instance decidableValidHistory (w : ℕ) (s : State) (os : List Op) : + Decidable ((spec w).ValidHistory s os) := by + induction os generalizing s with + | nil => exact isTrue trivial + | cons o os ih => + exact decidable_of_iff (valid w s o ∧ (spec w).ValidHistory (step s o).1 os) Iff.rfl + +/-! ## Frontier and frame -/ + +/-- No operation lowers the frontier. -/ +theorem frontier_le_step (s : State) (o : Op) : s.frontier ≤ (step s o).1.frontier := by + cases o <;> simp + +/-- No sequence of operations lowers the frontier. -/ +theorem frontier_le_run {w : ℕ} (s : State) (os : List Op) : + s.frontier ≤ ((spec w).run s os).1.frontier := by + induction os generalizing s with + | nil => exact le_rfl + | cons o os ih => exact (frontier_le_step s o).trans (ih _) + +/-- An operation changes an allocated cell only by writing to it. Allocation clears cells at or +above the frontier only. -/ +theorem mem_step_of_lt_frontier (s : State) (o : Op) {a : ℕ} (ha : a < s.frontier) + (hw : ∀ v, o ≠ .write a v) : (step s o).1.mem a = s.mem a := by + cases o with + | read => rfl + | write b v => + have hab : a ≠ b := fun h => hw v (h ▸ rfl) + exact Function.update_of_ne hab v s.mem + | alloc k => exact clear_of_not_owns (by simp only [Block.Owns]; omega) + | allocDirty => rfl + +/-! ## Word fit -/ + +/-- The frontier and every cell fit a `w`-bit word. Admissible operations preserve this. -/ +structure WellFormed (w : ℕ) (s : State) : Prop where + /-- The frontier fits a word, hence so does every allocated address. -/ + frontier_fits : Fits w s.frontier + /-- Every cell holds a word. -/ + mem_fits : ∀ a, Fits w (s.mem a) + +/-- Allocated addresses fit a word. -/ +theorem WellFormed.fits_of_lt_frontier {w : ℕ} {s : State} (h : WellFormed w s) {a : ℕ} + (ha : a < s.frontier) : Fits w a := + h.frontier_fits.of_le ha.le + +/-- Admissible operations preserve well-formedness. -/ +theorem WellFormed.step {w : ℕ} {s : State} (h : WellFormed w s) {o : Op} (hv : valid w s o) : + WellFormed w (Memory.step s o).1 := by + cases o with + | read => exact h + | write a v => + refine ⟨h.frontier_fits, fun b => ?_⟩ + by_cases hb : b = a + · subst hb + simpa using hv.2 + · simpa [Function.update_of_ne hb] using h.mem_fits b + | alloc k => + refine ⟨hv, fun b => ?_⟩ + simp only [step_alloc, clear] + split + · exact fits_zero w + · exact h.mem_fits b + | allocDirty k => exact ⟨hv, h.mem_fits⟩ + +/-- Admissible histories preserve well-formedness. -/ +theorem WellFormed.run {w : ℕ} {s : State} (h : WellFormed w s) {os : List Op} + (hv : (spec w).ValidHistory s os) : WellFormed w ((spec w).run s os).1 := by + induction os generalizing s with + | nil => exact h + | cons o os ih => exact ih (h.step hv.1) hv.2 + +/-! ## The input convention -/ + +/-- The word RAM's input convention (`Cslib.WordRAM.Data.init`) as a memory state: the input +length at address `0`, the input words at addresses `1, …, n`, and everything up to the input +allocated. -/ +def State.init (input : List ℕ) : State := + ⟨(Data.init (r := 0) input).mem, input.length + 1⟩ + +/-- The input convention is well formed when the input and its frontier fit a word. -/ +theorem wellFormed_init {w : ℕ} {input : List ℕ} (hin : InputFits w input) + (hf : Fits w (input.length + 1)) : WellFormed w (State.init input) := by + refine ⟨hf, fun a => ?_⟩ + change Fits w (if a = 0 then input.length else input.getD (a - 1) 0) + split + · exact hin.1 + · rw [List.getD_eq_getElem?_getD] + cases hi : input[a - 1]? with + | none => exact fits_zero w + | some v => exact hin.2 v (List.mem_of_getElem? hi) + +end Cslib.DataStructure.Memory diff --git a/ComplexityTests/DataStructureMemory.lean b/ComplexityTests/DataStructureMemory.lean new file mode 100644 index 0000000000..01791c6332 --- /dev/null +++ b/ComplexityTests/DataStructureMemory.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: local-only (test driver) + +public import Complexity.DataStructure.Memory.Field + +/-! +# Memory-oracle programs: named fields, pointer chasing and block reuse + +A singly linked list is stored as a struct of arrays with a `key` field and a `next` field; +pointers are indices, with `0` as null. The tests allocate the layout, build a two-node list, +chase pointers to sum the keys, and reuse one scratch block across two rounds. They check the +answers, the operation histories and charges, admissibility at an 8-bit word size, and two +rejected operations: a read above the frontier and a write of an oversized value. +-/ + +@[expose] public section + +namespace ComplexityTests.DataStructureMemory + +open Cslib.WordRAM Cslib.DataStructure Cslib.DataStructure.Memory + +/-- A linked-list node store as a struct of arrays. -/ +structure Nodes where + /-- The key of each node. -/ + key : Block + /-- The successor of each node, as an index; `0` is null. -/ + next : Block + +/-- Allocate both fields for `n` nodes. -/ +def Nodes.alloc (n : ℕ) : Prog Nodes := do + let key ← allocBlock n + let next ← allocBlock n + pure ⟨key, next⟩ + +/-- Follow at most `fuel` successors from node `v`, summing keys. Every address is computed from +an answer: the next node is read from memory. -/ +def Nodes.sumFrom (L : Nodes) : ℕ → ℕ → Prog ℕ + | 0, _ => pure 0 + | fuel + 1, v => do + let k ← L.key.get v + let nxt ← L.next.get v + if nxt = 0 then pure k else do + let rest ← L.sumFrom fuel nxt + pure (k + rest) + +/-- Build the list `1 → 2` with keys `5` and `7` (node `0` is reserved as null), then sum it. -/ +def linkedSum : Prog ℕ := do + let L ← Nodes.alloc 3 + L.key.set 1 5 + L.key.set 2 7 + L.next.set 1 2 + L.sumFrom 3 1 + +/-- The empty memory with nothing allocated. -/ +def empty : State := ⟨fun _ => 0, 0⟩ + +example : (spec 8).clientResult empty linkedSum = 12 := by decide + +/-- The history: two zeroed allocations, three writes and four reads by pointer chasing. -/ +example : (spec 8).clientHistory empty linkedSum = + [.alloc 3, .alloc 3, .write 1 5, .write 2 7, .write 4 2, + .read 1, .read 4, .read 2, .read 5] := by decide + +/-- The two zeroed allocations of three cells cost four each; seven unit operations follow. -/ +example : (spec 8).totalCost charge empty ((spec 8).clientHistory empty linkedSum) = 15 := by + decide + +/-- Every operation is admissible at an 8-bit word size. -/ +example : (spec 8).ValidHistory empty ((spec 8).clientHistory empty linkedSum) := by decide + +/-- One scratch block, allocated without clearing, is reused across two rounds. -/ +def reuse : Prog (ℕ × ℕ) := do + let scratch ← allocBlockDirty 1 + scratch.set 0 3 + let first ← scratch.get 0 + scratch.set 0 (first + 4) + let second ← scratch.get 0 + pure (first, second) + +example : (spec 8).clientResult empty reuse = (3, 7) := by decide + +example : ((spec 8).clientState empty reuse).frontier = 1 := by decide + +example : (spec 8).totalCost charge empty ((spec 8).clientHistory empty reuse) = 5 := by decide + +/-- A read above the frontier is rejected. -/ +example : ¬(spec 8).ValidHistory empty [.read 0] := by decide + +/-- A write of a value wider than the word is rejected, even at an allocated address. -/ +example : ¬(spec 8).ValidHistory ⟨fun _ => 0, 1⟩ [.write 0 256] := by decide + +/-- An allocation whose end does not fit the word is rejected. -/ +example : ¬(spec 8).ValidHistory empty [.alloc 256] := by decide + +/-- Well-formedness survives the pointer-chasing program. -/ +example : WellFormed 8 ((spec 8).clientState empty linkedSum) := by + have h : WellFormed 8 empty := ⟨by decide, fun _ => fits_zero 8⟩ + rw [← (spec 8).run_runClient] + exact h.run (by decide) + +/-- The input convention: the length at address `0`, the words from address `1`, and the +frontier just past them. -/ +example : (spec 8).clientResult (State.init [4, 9]) (do + let n ← read 0 + let x ← read 2 + pure (n, x)) = (2, 9) := by decide + +/-- The list view reads the live prefix of a field. -/ +example : (Block.mk 1 3).entries 2 (fun a => a * 10) = [10, 20] := by decide + +end ComplexityTests.DataStructureMemory From 412f614dacfeba6565117ed6b5eb8f586b7d0888 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 17:16:21 -0500 Subject: [PATCH 02/17] =?UTF-8?q?doc(bib):=20add=20Gu=C3=A9neau,=20Chargu?= =?UTF-8?q?=C3=A9raud=20and=20Pottier=20(ESOP=202018)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- references.bib | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/references.bib b/references.bib index e33942d5a5..0b4758dbf6 100644 --- a/references.bib +++ b/references.bib @@ -2303,6 +2303,18 @@ @inproceedings{Grover1996 doi = {10.1145/237814.237866} } +@inproceedings{GueneauChargueraudPottier2018, + author = {Gu{\'e}neau, Arma{\"e}l and Chargu{\'e}raud, Arthur and Pottier, Fran{\c{c}}ois}, + title = {A Fistful of Dollars: Formalizing Asymptotic Complexity Claims via Deductive + Program Verification}, + booktitle = {Programming Languages and Systems (ESOP 2018)}, + series = {Lecture Notes in Computer Science}, + pages = {533--560}, + publisher = {Springer}, + year = {2018}, + doi = {10.1007/978-3-319-89884-1_19} +} + @inproceedings{GuoKoppartySudan2013, author = {Guo, Alan and Kopparty, Swastik and Sudan, Madhu}, title = {New affine-invariant codes from lifting}, From 16a647fee63724bc26032a05d4bbf7a682232e1f Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 17:16:21 -0500 Subject: [PATCH 03/17] feat(DataStructure/StateTransition): refinements by abstraction functions with stacked potentials Refinement D E is a Module whose representation is an invariant plus an abstraction function (#2205 D2). Refinement.Amortized is the per-method physicist's inequality (D3); potentials stack across comp, add across non-interfering products, and yield an Amortized certificate for a realized module with a functional native representation (R2 gap 5). CostIsBigO is the exported asymptotic form (D6). Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 2 + .../StateTransition/Refinement.lean | 384 ++++++++++++++++++ .../Analysis/Asymptotics/CostBound.lean | 81 ++++ .../StateTransitionRefinement.lean | 143 +++++++ 4 files changed, 610 insertions(+) create mode 100644 Complexity/DataStructure/StateTransition/Refinement.lean create mode 100644 Complexity/Foundations/Analysis/Asymptotics/CostBound.lean create mode 100644 ComplexityTests/StateTransitionRefinement.lean diff --git a/Complexity.lean b/Complexity.lean index 7f9a77746d..9c6c1c30b9 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -2921,6 +2921,7 @@ public import Complexity.DataStructure.StateTransition.CostHoare public import Complexity.DataStructure.StateTransition.Hoare public import Complexity.DataStructure.StateTransition.Impl public import Complexity.DataStructure.StateTransition.Module +public import Complexity.DataStructure.StateTransition.Refinement public import Complexity.DataStructure.StateTransition.Resource public import Complexity.DataStructure.VanEmdeBoas.Basic public import Complexity.DataStructure.VanEmdeBoas.Elements @@ -2944,6 +2945,7 @@ public import Complexity.DataStructure.WordRAM.StateTransition public import Complexity.Foundations.Algebra.FiniteMagnitude public import Complexity.Foundations.Algebra.GeometricTail public import Complexity.Foundations.Algebra.Shear +public import Complexity.Foundations.Analysis.Asymptotics.CostBound public import Complexity.Foundations.Analysis.Asymptotics.Exponential public import Complexity.Foundations.Analysis.BernoulliInequality public import Complexity.Foundations.Analysis.ENNRealTsum diff --git a/Complexity/DataStructure/StateTransition/Refinement.lean b/Complexity/DataStructure/StateTransition/Refinement.lean new file mode 100644 index 0000000000..a70028a61c --- /dev/null +++ b/Complexity/DataStructure/StateTransition/Refinement.lean @@ -0,0 +1,384 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.DataStructure.StateTransition.Amortized +public import Complexity.DataStructure.StateTransition.CostHoare + +/-! +# Refinements by abstraction functions and stacked potentials + +A `Refinement D E` is a `Module D E` whose representation is single-valued: an implementation +invariant on lower states together with an abstraction function `abs : E.State → D.State`. Each +method, run from a lower state satisfying the invariant, must realize the specified step at the +abstract state, ending in a state satisfying the invariant. On deterministic specifications +(`Refinement.ofFn`) the obligation reads `D.stepFn (abs e) o = (abs e', a)`. + +A single-valued representation is what makes amortized costs compose. `Refinement.Amortized` +asks that every method satisfy the physicist's inequality +`lower cost + potential e' ≤ upper (abs e) o + potential e`, with a potential on lower states. +Composing two refinements adds their potentials, the upper one read through the lower +abstraction (`Refinement.Amortized.comp`). A relational representation would leave the +intermediate state existential, and the composed potential would not be a function of the lower +state. For the same reason an amortized refinement over a native implementation whose +representation is functional yields an `Amortized` certificate of the realized module +(`Refinement.Amortized.realize`). + +Products of refinements over one lower interface (`Refinement.prod`) need non-interference: the +methods of each side leave the other side's abstraction, invariant and potential unchanged. + +## Main definitions + +* `Refinement`: a module given by methods, an implementation invariant and an abstraction + function. +* `Refinement.ofFn`: the constructor for deterministic specifications. +* `Refinement.toModule`: the underlying relational module. +* `Refinement.id`, `Refinement.comp`, `Refinement.prod`: identity, composition, and products under + non-interference. +* `Refinement.Amortized`: per-method amortized cost refinement with a potential on lower states. +* `productCharge`: componentwise charges of a product specification. + +## Main results + +* `Refinement.simulates_demonic`, `Refinement.simulates_client`: whole adaptive clients run + through the abstraction function. +* `Refinement.comp_rep_iff`: composition agrees with `Module.comp` of the underlying modules. +* `Refinement.Amortized.demonic`, `Refinement.Amortized.client`: potentials telescope along + adaptive clients. +* `Refinement.Amortized.comp`: potentials stack across composition. +* `Refinement.Amortized.prod`: potentials add across non-interfering products. +* `Refinement.Amortized.realize`: an amortized certificate for the realized module. +* `Refinement.Amortized.id`: the identity refinement passes charges through. +* `Refinement.Amortized.chargeBound`, `Refinement.Amortized.of_chargeBound`: with zero + potential, the existing worst-case `Module.ChargeBound`. + +## References + +* [Cormen, Leiserson, Rivest and Stein, *Introduction to Algorithms*, Chapter 17][CLRS2009]. +-/ + +@[expose] public section + +namespace Cslib.DataStructure + +universe u v w x + +variable {D E F D₁ D₂ : StateTransitionSpec.{u, v, w}} {α : Type w} + +/-- A module whose representation is an implementation invariant `inv` together with an +abstraction function `abs`. From a lower state satisfying `inv`, every run of a method on an +admissible operation realizes a permitted step of the abstract state and preserves `inv`. -/ +structure Refinement (D E : StateTransitionSpec.{u, v, w}) where + /-- Bodies implementing the upper interface using lower-interface calls. -/ + methods : Methods D E + /-- The implementation invariant on lower states. -/ + inv : E.State → Prop + /-- The abstraction function from lower states to upper states. -/ + abs : E.State → D.State + /-- Each method is demonically admissible from a state satisfying the invariant. -/ + valid : ∀ {e} o, inv e → D.valid (abs e) o → E.DemonicValid e (methods o) + /-- Each method run realizes the specified step through `abs` and preserves `inv`. -/ + correct : ∀ {e} o {a e' tr}, inv e → D.valid (abs e) o → + E.ClientRun e (methods o) a e' tr → D.step (abs e) o (abs e') a ∧ inv e' + +namespace Refinement + +/-- The constructor for deterministic specifications: each method's history is admissible, and +`D.stepFn (abs e) o = (abs e', a)` for its final state `e'` and result `a`. -/ +abbrev ofFn {fD : (s : D.State) → (o : D.Op) → D.State × D.Result o} + {fE : (e : E.State) → (o : E.Op) → E.State × E.Result o} + [D.HasStepFn fD] [E.HasStepFn fE] + (methods : Methods D E) (inv : E.State → Prop) (abs : E.State → D.State) + (valid : ∀ {e} o, inv e → D.valid (abs e) o → + E.ValidHistory e (E.clientHistory e (methods o))) + (correct : ∀ {e} o, inv e → D.valid (abs e) o → + D.stepFn (abs e) o = (abs (E.clientState e (methods o)), E.clientResult e (methods o)) ∧ + inv (E.clientState e (methods o))) : + Refinement D E where + methods := methods + inv := inv + abs := abs + valid o hi hv := (E.demonicValid_iff_validHistory_runClient _ _).mpr (valid o hi hv) + correct {e} o {a e' tr} hi hv hrun := by + obtain ⟨_, rfl, rfl, _⟩ := (E.clientRun_iff_runClient e (methods o) a e' tr).mp hrun + obtain ⟨hstep, hi'⟩ := correct o hi hv + exact ⟨(D.step_iff_stepFn _ _ _ _).mpr hstep.symm, hi'⟩ + +variable (M : Refinement D E) + +/-- The underlying relational module: `s` is represented by `e` when `e` satisfies the invariant +and abstracts to `s`. -/ +def toModule : Module D E where + methods := M.methods + rep s e := M.inv e ∧ M.abs e = s + valid {_ _} o hr hv := by + obtain ⟨hi, rfl⟩ := hr + exact M.valid o hi hv + correct {_ _} o {_ _ _} hr hv hrun := by + obtain ⟨hi, rfl⟩ := hr + obtain ⟨hstep, hi'⟩ := M.correct o hi hv hrun + exact ⟨_, hstep, hi', rfl⟩ + +/-- Every run of a linked admissible client corresponds to a run of the client at the abstract +state, ending at the abstraction of the final lower state. -/ +theorem simulates_demonic (p : D.Client α) {e : E.State} (he : M.inv e) + (hv : D.DemonicValid (M.abs e) p) : + E.DemonicValid e (link M.methods p) ∧ + ∀ a e' tr_E, E.ClientRun e (link M.methods p) a e' tr_E → + M.inv e' ∧ ∃ tr_D, D.ClientRun (M.abs e) p a (M.abs e') tr_D := by + obtain ⟨hvE, hrun⟩ := M.toModule.simulates_demonic p ⟨he, rfl⟩ hv + refine ⟨hvE, fun a e' tr hr => ?_⟩ + obtain ⟨_, tr_D, hD, hi', rfl⟩ := hrun a e' tr hr + exact ⟨hi', tr_D, hD⟩ + +/-- On deterministic specifications, a linked client returns the specified result, and its final +lower state satisfies the invariant and abstracts to the specified final state. -/ +theorem simulates_client {fD : (s : D.State) → (o : D.Op) → D.State × D.Result o} + {fE : (e : E.State) → (o : E.Op) → E.State × E.Result o} + [D.HasStepFn fD] [E.HasStepFn fE] (p : D.Client α) {e : E.State} (he : M.inv e) + (hv : D.ValidHistory (M.abs e) (D.clientHistory (M.abs e) p)) : + E.ValidHistory e (E.clientHistory e (link M.methods p)) ∧ + E.clientResult e (link M.methods p) = D.clientResult (M.abs e) p ∧ + M.abs (E.clientState e (link M.methods p)) = D.clientState (M.abs e) p ∧ + M.inv (E.clientState e (link M.methods p)) := by + obtain ⟨hvE, hres, hi, hs⟩ := M.toModule.simulates_client p ⟨he, rfl⟩ hv + exact ⟨hvE, hres, hs, hi⟩ + +/-- The identity refinement: each operation calls itself, with no invariant. -/ +def id (D : StateTransitionSpec.{u, v, w}) : Refinement D D where + methods o := .liftBind o fun a => .pure a + inv _ := True + abs e := e + valid o _ hv := .liftBind o _ hv fun s' a _ => .pure s' a + correct {_} o {_ _ _} _ _ hrun := by + cases hrun with + | liftBind _ _ a _ hstep hrest => + cases hrest + exact ⟨hstep, trivial⟩ + +/-- Composition: the upper methods are linked through the lower ones, the invariants conjoin, +and the abstraction functions compose. -/ +def comp (M : Refinement D E) (N : Refinement E F) : Refinement D F where + methods o := link N.methods (M.methods o) + inv f := N.inv f ∧ M.inv (N.abs f) + abs f := M.abs (N.abs f) + valid o hi hv := (N.simulates_demonic (M.methods o) hi.1 (M.valid o hi.2 hv)).1 + correct {_} o {a f' tr} hi hv hrun := by + obtain ⟨hN', _, hE⟩ := + (N.simulates_demonic (M.methods o) hi.1 (M.valid o hi.2 hv)).2 a f' tr hrun + obtain ⟨hstep, hM'⟩ := M.correct o hi.2 hv hE + exact ⟨hstep, hN', hM'⟩ + +/-- Composing refinements represents the same states as composing their modules. -/ +theorem comp_rep_iff (M : Refinement D E) (N : Refinement E F) (s : D.State) (f : F.State) : + (M.comp N).toModule.rep s f ↔ (M.toModule.comp N.toModule).rep s f := by + constructor + · rintro ⟨⟨hN, hM⟩, rfl⟩ + exact ⟨_, ⟨hM, rfl⟩, hN, rfl⟩ + · rintro ⟨_, ⟨hM, rfl⟩, hN, rfl⟩ + exact ⟨⟨hN, hM⟩, rfl⟩ + +/-- Linking through a composition links through each refinement in turn. -/ +theorem link_comp (M : Refinement D E) (N : Refinement E F) (p : D.Client α) : + link (M.comp N).methods p = link N.methods (link M.methods p) := + (DataStructure.link_comp M.methods N.methods p).symm + +/-- Two refinements over one lower interface implement the product of their specifications, +provided the methods of each leave the other's abstraction and invariant unchanged. -/ +def prod (M₁ : Refinement D₁ E) (M₂ : Refinement D₂ E) + (frame₁ : ∀ {e} o {a e' tr}, M₁.inv e → M₂.inv e → D₁.valid (M₁.abs e) o → + E.ClientRun e (M₁.methods o) a e' tr → M₂.abs e' = M₂.abs e ∧ M₂.inv e') + (frame₂ : ∀ {e} o {a e' tr}, M₁.inv e → M₂.inv e → D₂.valid (M₂.abs e) o → + E.ClientRun e (M₂.methods o) a e' tr → M₁.abs e' = M₁.abs e ∧ M₁.inv e') : + Refinement (product D₁ D₂) E where + methods + | .inl o => M₁.methods o + | .inr o => M₂.methods o + inv e := M₁.inv e ∧ M₂.inv e + abs e := (M₁.abs e, M₂.abs e) + valid {_} o hi hv := by + cases o with + | inl o => exact M₁.valid o hi.1 hv + | inr o => exact M₂.valid o hi.2 hv + correct {_} o {_ _ _} hi hv hrun := by + cases o with + | inl o => + obtain ⟨hstep, hi₁⟩ := M₁.correct o hi.1 hv hrun + obtain ⟨habs, hi₂⟩ := frame₁ o hi.1 hi.2 hv hrun + exact ⟨⟨hstep, habs⟩, hi₁, hi₂⟩ + | inr o => + obtain ⟨hstep, hi₂⟩ := M₂.correct o hi.2 hv hrun + obtain ⟨habs, hi₁⟩ := frame₂ o hi.1 hi.2 hv hrun + exact ⟨⟨habs, hstep⟩, hi₁, hi₂⟩ + +/-! ## Amortized costs -/ + +/-- Amortized cost refinement: the lower charges of every method run, plus the potential after it, +are at most the upper charge of the operation plus the potential before it. Potentials are +natural numbers, hence nonnegative; a client bound subtracts nothing when the initial potential +is zero. -/ +def Amortized (lower : E.State → E.Op → ℕ) (upper : D.State → D.Op → ℕ) + (potential : E.State → ℕ) : Prop := + ∀ {e} o {a e' tr}, M.inv e → D.valid (M.abs e) o → E.ClientRun e (M.methods o) a e' tr → + E.totalCostTranscript lower e tr + potential e' ≤ upper (M.abs e) o + potential e + +variable {M} {lower : E.State → E.Op → ℕ} {upper : D.State → D.Op → ℕ} + {potential : E.State → ℕ} + +/-- The amortized inequality on a deterministic lower specification, along each method's +history. -/ +theorem Amortized.ofFn {fE : (e : E.State) → (o : E.Op) → E.State × E.Result o} + [E.HasStepFn fE] + (h : ∀ {e} o, M.inv e → D.valid (M.abs e) o → + E.totalCost lower e (E.clientHistory e (M.methods o)) + + potential (E.clientState e (M.methods o)) ≤ + upper (M.abs e) o + potential e) : + M.Amortized lower upper potential := by + intro e o a e' tr hi hv hrun + obtain ⟨_, _, rfl, rfl⟩ := (E.clientRun_iff_runClient e (M.methods o) a e' tr).mp hrun + rw [E.totalCostTranscript_canonicalTranscript] + exact h o hi hv + +/-- Potentials telescope along any run of a linked admissible client. -/ +theorem Amortized.demonic (A : M.Amortized lower upper potential) (p : D.Client α) + {e e' : E.State} {a : α} {tr_E : E.Transcript} (he : M.inv e) + (hv : D.DemonicValid (M.abs e) p) (hrun : E.ClientRun e (link M.methods p) a e' tr_E) : + M.inv e' ∧ ∃ tr_D, D.ClientRun (M.abs e) p a (M.abs e') tr_D ∧ + E.totalCostTranscript lower e tr_E + potential e' ≤ + D.totalCostTranscript upper (M.abs e) tr_D + potential e := by + induction p generalizing e tr_E with + | pure b => + cases hrun + exact ⟨he, [], .pure _ _, by simp⟩ + | liftBind o k ih => + obtain ⟨hv_o, hv_k⟩ := (D.demonicValid_liftBind_iff _ o k).mp hv + have heq : link M.methods (.liftBind o k) = + (M.methods o).bind (fun r => link M.methods (k r)) := rfl + rw [heq] at hrun + obtain ⟨res, e₁, tr₁, tr₂, hrun₁, hrun₂, rfl⟩ := E.clientRun_bind_iff.mp hrun + obtain ⟨hstep₁, he₁⟩ := M.correct o he hv_o hrun₁ + have hc₁ := A o he hv_o hrun₁ + obtain ⟨he₂, tr_D, hrun_D, hc₂⟩ := ih res he₁ (hv_k _ res hstep₁) hrun₂ + refine ⟨he₂, ⟨o, res, M.abs e₁⟩ :: tr_D, .liftBind o k res hv_o hstep₁ hrun_D, ?_⟩ + rw [E.totalCostTranscript_append lower hrun₁.validTranscript tr₂] + simp only [StateTransitionSpec.totalCostTranscript_cons] + omega + +/-- On deterministic specifications, the lower charges of a linked client plus the final +potential are at most the upper charges of its history plus the initial potential. -/ +theorem Amortized.client {fD : (s : D.State) → (o : D.Op) → D.State × D.Result o} + {fE : (e : E.State) → (o : E.Op) → E.State × E.Result o} + [D.HasStepFn fD] [E.HasStepFn fE] (A : M.Amortized lower upper potential) + (p : D.Client α) {e : E.State} (he : M.inv e) + (hv : D.ValidHistory (M.abs e) (D.clientHistory (M.abs e) p)) : + E.totalCost lower e (E.clientHistory e (link M.methods p)) + + potential (E.clientState e (link M.methods p)) ≤ + D.totalCost upper (M.abs e) (D.clientHistory (M.abs e) p) + potential e := by + have hvD := (D.demonicValid_iff_validHistory_runClient _ p).mpr hv + have hvE := (M.simulates_client p he hv).1 + obtain ⟨_, tr_D, hrun_D, hcost⟩ := A.demonic p he hvD (E.clientRun_canonical e _ hvE) + obtain ⟨_, _, _, rfl⟩ := (D.clientRun_iff_runClient _ p _ _ tr_D).mp hrun_D + simpa only [StateTransitionSpec.totalCostTranscript_canonicalTranscript] using hcost + +/-- **Potentials stack across composition.** If the upper refinement is amortized against the +middle charges and the lower refinement is amortized from the middle charges, the composite is +amortized with the sum of the upper potential, read through the lower abstraction, and the +lower potential. -/ +theorem Amortized.comp {N : Refinement E F} {lower : F.State → F.Op → ℕ} + {middle : E.State → E.Op → ℕ} {Φ : E.State → ℕ} {Ψ : F.State → ℕ} + (A : M.Amortized middle upper Φ) (B : N.Amortized lower middle Ψ) : + (M.comp N).Amortized lower upper (fun f => Φ (N.abs f) + Ψ f) := by + intro f o a f' tr hi hv hrun + obtain ⟨_, tr_E, hrun_E, hN⟩ := B.demonic (M.methods o) hi.1 (M.valid o hi.2 hv) hrun + have hM := A o hi.2 hv hrun_E + change F.totalCostTranscript lower f tr + (Φ (N.abs f') + Ψ f') ≤ + upper (M.abs (N.abs f)) o + (Φ (N.abs f) + Ψ f) + omega + +/-- Componentwise charges of a product specification. -/ +def productCharge (c₁ : D₁.State → D₁.Op → ℕ) (c₂ : D₂.State → D₂.Op → ℕ) : + (product D₁ D₂).State → (product D₁ D₂).Op → ℕ + | (s₁, _), .inl o => c₁ s₁ o + | (_, s₂), .inr o => c₂ s₂ o + +/-- **Potentials add across non-interfering products**, provided the methods of each side leave +the other side's potential unchanged. -/ +theorem Amortized.prod {M₁ : Refinement D₁ E} {M₂ : Refinement D₂ E} + {frame₁ : ∀ {e} o {a e' tr}, M₁.inv e → M₂.inv e → D₁.valid (M₁.abs e) o → + E.ClientRun e (M₁.methods o) a e' tr → M₂.abs e' = M₂.abs e ∧ M₂.inv e'} + {frame₂ : ∀ {e} o {a e' tr}, M₁.inv e → M₂.inv e → D₂.valid (M₂.abs e) o → + E.ClientRun e (M₂.methods o) a e' tr → M₁.abs e' = M₁.abs e ∧ M₁.inv e'} + {upper₁ : D₁.State → D₁.Op → ℕ} {upper₂ : D₂.State → D₂.Op → ℕ} + {Φ₁ Φ₂ : E.State → ℕ} + (A₁ : M₁.Amortized lower upper₁ Φ₁) (A₂ : M₂.Amortized lower upper₂ Φ₂) + (potential₁ : ∀ {e} o {a e' tr}, M₁.inv e → M₂.inv e → D₁.valid (M₁.abs e) o → + E.ClientRun e (M₁.methods o) a e' tr → Φ₂ e' = Φ₂ e) + (potential₂ : ∀ {e} o {a e' tr}, M₁.inv e → M₂.inv e → D₂.valid (M₂.abs e) o → + E.ClientRun e (M₂.methods o) a e' tr → Φ₁ e' = Φ₁ e) : + (M₁.prod M₂ frame₁ frame₂).Amortized lower (productCharge upper₁ upper₂) + (fun e => Φ₁ e + Φ₂ e) := by + intro e o a e' tr hi hv hrun + cases o with + | inl o => + have h := A₁ o hi.1 hv hrun + have hΦ := potential₁ o hi.1 hi.2 hv hrun + change E.totalCostTranscript lower e tr + (Φ₁ e' + Φ₂ e') ≤ + upper₁ (M₁.abs e) o + (Φ₁ e + Φ₂ e) + omega + | inr o => + have h := A₂ o hi.2 hv hrun + have hΦ := potential₂ o hi.1 hi.2 hv hrun + change E.totalCostTranscript lower e tr + (Φ₁ e' + Φ₂ e') ≤ + upper₂ (M₂.abs e) o + (Φ₁ e + Φ₂ e) + omega + +/-- **Potentials stack through a realization.** An amortized refinement over a native +implementation with an amortized certificate yields an amortized certificate of the realized +module, provided the native representation is functional: the represented lower state is +`absR c`. -/ +theorem Amortized.realize (A : M.Amortized lower upper potential) + {C τ : Type x} {exec : Execution E C τ} {R : StateTransitionImpl E exec} + {weight : τ → ℕ} {ψ : E.State → C → ℕ} (B : DataStructure.Amortized R weight ψ lower) + (absR : C → E.State) (hR : ∀ {e c}, R.rep e c → e = absR c) : + DataStructure.Amortized (M.toModule.realize R) (total weight) + (fun _ c => potential (absR c) + ψ (absR c) c) upper where + step {_ c o a c' ts} hr hv he := by + obtain ⟨e, ⟨hi, rfl⟩, hR₀⟩ := hr + obtain ⟨e', tr, hrun, hR', _, hcost⟩ := B.demonic hR₀ (M.valid o hi hv) he + obtain ⟨hstep, hi'⟩ := M.correct o hi hv hrun + have hc := A o hi hv hrun + refine ⟨M.abs e', hstep, ⟨e', ⟨hi', rfl⟩, hR'⟩, ?_⟩ + rw [← hR hR₀, ← hR hR'] + omega + +/-- The identity refinement passes each charge through unchanged. -/ +theorem Amortized.id (charge : D.State → D.Op → ℕ) : + (Refinement.id D).Amortized charge charge fun _ => 0 := by + intro e o a e' tr _ _ hrun + cases hrun with + | liftBind _ _ r _ _ hrest => + cases hrest + simp [Refinement.id] + +/-- With zero potential, an amortized refinement is a worst-case `Module.ChargeBound` of its +module. -/ +theorem Amortized.chargeBound (A : M.Amortized lower upper fun _ => 0) : + M.toModule.ChargeBound lower upper := by + rintro s e o a e' tr ⟨hi, rfl⟩ hv hrun + simpa using A o hi hv hrun + +/-- A worst-case `Module.ChargeBound` of the module is an amortized refinement with zero +potential. -/ +theorem Amortized.of_chargeBound (B : M.toModule.ChargeBound lower upper) : + M.Amortized lower upper fun _ => 0 := by + intro e o a e' tr hi hv hrun + simpa using B o ⟨hi, rfl⟩ hv hrun + +end Refinement + +end Cslib.DataStructure diff --git a/Complexity/Foundations/Analysis/Asymptotics/CostBound.lean b/Complexity/Foundations/Analysis/Asymptotics/CostBound.lean new file mode 100644 index 0000000000..d17a2b7965 --- /dev/null +++ b/Complexity/Foundations/Analysis/Asymptotics/CostBound.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Init +public import Mathlib.Analysis.Asymptotics.Ring + +/-! +# Asymptotic cost bounds + +`Cslib.CostIsBigO l g size cost` says that the cost of every input is bounded by one cost +function of its size, chosen before the input: some monotone, nonnegative `f` with `f =O[l] g` +satisfies `cost a ≤ f (size a)` for all `a`. This is the form of asymptotic cost specification +used by Guéneau, Charguéraud and Pottier [GueneauChargueraudPottier2018]. Because `f` is chosen +once, the statement is `∃ f, ∀ a`. Inductive reasoning with "`O(1) + O(1) = O(1)`" proves +`∀ a, ∃ c` instead, which is unsound as a cost claim. The filter makes multivariate bounds +explicit: for example, `atTop` on `ℕ × ℕ` for a bound in two size parameters. + +Exact constants are proved internally and exported in this form: `CostIsBigO.of_le_nat` turns an +exact natural-number bound into an asymptotic one. + +## Main definitions + +* `Cslib.CostIsBigO`: a cost bounded by a monotone, nonnegative function that is `O(g)` along a + filter. + +## Main results + +* `Cslib.CostIsBigO.of_le_nat`: export an exact monotone natural-number bound. +* `Cslib.CostIsBigO.mono`: a smaller cost has the same bound. +* `Cslib.CostIsBigO.trans_isBigO`: weaken the comparison function. + +## References + +* [A. Guéneau, A. Charguéraud and F. Pottier, *A Fistful of Dollars: Formalizing Asymptotic + Complexity Claims via Deductive Program Verification*][GueneauChargueraudPottier2018] +-/ + +@[expose] public section + +open Asymptotics + +namespace Cslib + +variable {α ι : Type*} [Preorder ι] + +/-- The cost of every input `a` is at most `f (size a)` for one monotone, nonnegative cost +function `f` with `f =O[l] g`. -/ +def CostIsBigO (l : Filter ι) (g : ι → ℝ) (size : α → ι) (cost : α → ℕ) : Prop := + ∃ f : ι → ℝ, Monotone f ∧ 0 ≤ f ∧ f =O[l] g ∧ ∀ a, (cost a : ℝ) ≤ f (size a) + +namespace CostIsBigO + +variable {l : Filter ι} {g : ι → ℝ} {size : α → ι} {cost : α → ℕ} + +/-- An exact monotone natural-number bound that is `O(g)` gives an asymptotic cost bound. -/ +theorem of_le_nat {F : ι → ℕ} (hF : Monotone F) (hO : (fun n => (F n : ℝ)) =O[l] g) + (h : ∀ a, cost a ≤ F (size a)) : CostIsBigO l g size cost := + ⟨fun n => F n, fun _ _ hab => Nat.cast_le.mpr (hF hab), fun _ => Nat.cast_nonneg _, hO, + fun a => Nat.cast_le.mpr (h a)⟩ + +/-- A cost below a bounded cost has the same bound. -/ +theorem mono {cost' : α → ℕ} (h : CostIsBigO l g size cost) (hle : ∀ a, cost' a ≤ cost a) : + CostIsBigO l g size cost' := by + obtain ⟨f, hf, hf0, hO, hb⟩ := h + exact ⟨f, hf, hf0, hO, fun a => (Nat.cast_le.mpr (hle a)).trans (hb a)⟩ + +/-- A cost that is `O(g)` is `O(g')` whenever `g =O[l] g'`. -/ +theorem trans_isBigO {g' : ι → ℝ} (h : CostIsBigO l g size cost) (hg : g =O[l] g') : + CostIsBigO l g' size cost := by + obtain ⟨f, hf, hf0, hO, hb⟩ := h + exact ⟨f, hf, hf0, hO.trans hg, hb⟩ + +end CostIsBigO + +end Cslib diff --git a/ComplexityTests/StateTransitionRefinement.lean b/ComplexityTests/StateTransitionRefinement.lean new file mode 100644 index 0000000000..7288b6efcc --- /dev/null +++ b/ComplexityTests/StateTransitionRefinement.lean @@ -0,0 +1,143 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: local-only (test driver) + +public import Complexity.DataStructure.Queue.Spec +public import Complexity.DataStructure.StateTransition.Refinement +public import Complexity.Foundations.Analysis.Asymptotics.CostBound + +/-! +# Amortized refinements with a nonzero potential + +A bag supports adding an element and clearing. It is implemented over the stack interface: +`add` pushes, and `clear` asks for the size and pops that many times. A clear can cost +arbitrarily many stack calls, but each element pays for its own pop when it is added, so with +the potential "one credit per stacked element" every bag operation costs at most two stack calls. +The tests check this per-operation certificate, telescope it along a concrete client, stack it +over the identity refinement, and export the linear bound as `CostIsBigO`. +-/ + +@[expose] public section + +namespace ComplexityTests.StateTransitionRefinement + +open Cslib Cslib.DataStructure Cslib.DataStructure.Queue + +/-- Bag operations. -/ +inductive BagOp where + | add (n : ℕ) + | clear + deriving DecidableEq + +/-- A bag with `clear`, recording its elements newest first. -/ +abbrev bag : StateTransitionSpec := + StateTransitionSpec.ofFn (State := List ℕ) (Op := BagOp) (Result := fun _ => Unit) + fun s o => match o with + | .add n => (n :: s, ()) + | .clear => ([], ()) + +/-- Pop `n` times. -/ +def popAll : ℕ → (stack ℕ).Client Unit + | 0 => pure () + | n + 1 => .liftBind .pop fun _ => popAll n + +/-- Bag operations as stack programs. -/ +def methods : Methods bag (stack ℕ) + | .add n => .liftBind (.push n) fun _ => .pure () + | .clear => .liftBind .size fun n => popAll n + +/-- Popping as many times as the stack is long empties it, one call per element. -/ +theorem runClient_popAll (s : List ℕ) : + (stack ℕ).runClient s (popAll s.length) = ((), [], List.replicate s.length .pop) := by + induction s with + | nil => rfl + | cons a s ih => + change (stack ℕ).runClient (a :: s) (.liftBind StackOp.pop fun _ => popAll s.length) = _ + rw [StateTransitionSpec.runClient_liftBind] + change (let (v, s', os) := (stack ℕ).runClient s (popAll s.length) + (v, s', StackOp.pop :: os)) = _ + rw [ih] + rfl + +/-- The stack holds the bag itself; there is no invariant. -/ +def refinement : Refinement bag (stack ℕ) := + Refinement.ofFn methods (fun _ => True) id + (fun _ _ _ => (stack ℕ).validHistory_of_forall_valid (fun _ _ => trivial) _ _) + (by + intro s o _ _ + cases o with + | add n => exact ⟨rfl, trivial⟩ + | clear => + refine ⟨?_, trivial⟩ + simp [methods, StateTransitionSpec.clientState, runClient_popAll]) + +/-- Two calls per `add`, one per `clear`. -/ +def bagCharge (_ : List ℕ) : BagOp → ℕ + | .add _ => 2 + | .clear => 1 + +/-- One credit per stacked element pays for its eventual pop. -/ +theorem amortized : refinement.Amortized (fun _ _ => 1) bagCharge List.length := by + apply Refinement.Amortized.ofFn + intro s o _ _ + cases o with + | add n => + simp [refinement, methods, bagCharge, StateTransitionSpec.clientState, + StateTransitionSpec.clientHistory] + omega + | clear => + simp [refinement, methods, bagCharge, StateTransitionSpec.clientState, + StateTransitionSpec.clientHistory, runClient_popAll, StateTransitionSpec.totalCost_const] + +/-- A client with one expensive clear. -/ +def client : bag.Client Unit := do + bag.call (.add 1) + bag.call (.add 2) + bag.call (.add 3) + bag.call .clear + bag.call (.add 4) + +/-- The clear costs four stack calls, yet the five bag operations stay within their nine +amortized units, with one credit left for the remaining element. -/ +example : (stack ℕ).totalCost (fun _ _ => 1) [] + ((stack ℕ).clientHistory [] (link refinement.methods client)) = 8 ∧ + bag.totalCost bagCharge [] (bag.clientHistory [] client) = 9 ∧ + ((stack ℕ).clientState [] (link refinement.methods client)).length = 1 := by + decide + +/-- The general telescoped bound from an empty stack. -/ +theorem client_bound (p : bag.Client Unit) : + (stack ℕ).totalCost (fun _ _ => 1) [] ((stack ℕ).clientHistory [] (link refinement.methods p)) + + ((stack ℕ).clientState [] (link refinement.methods p)).length ≤ + bag.totalCost bagCharge [] (bag.clientHistory [] p) := by + have h := amortized.client p (e := []) trivial + (bag.validHistory_of_forall_valid (fun _ _ => trivial) _ _) + exact h + +/-- Stacking over the identity refinement adds a zero potential. -/ +example : (refinement.comp (Refinement.id (stack ℕ))).Amortized (fun _ _ => 1) bagCharge + (fun s => s.length + 0) := + amortized.comp (Refinement.Amortized.id _) + +/-- The exported form: the stack calls of a bag client from an empty stack are `O(m)` in the +number `m` of bag operations, with the constant `2`. -/ +example : CostIsBigO Filter.atTop (fun m : ℕ => (m : ℝ)) + (fun p : bag.Client Unit => (bag.clientHistory [] p).length) + (fun p => (stack ℕ).totalCost (fun _ _ => 1) [] + ((stack ℕ).clientHistory [] (link refinement.methods p))) := by + refine CostIsBigO.of_le_nat (F := fun m => 2 * m) (fun _ _ h => Nat.mul_le_mul_left 2 h) + ?_ fun p => ?_ + · simpa using (Asymptotics.isBigO_refl (fun m : ℕ => (m : ℝ)) _).const_mul_left 2 + · have h := client_bound p + have hc : bag.totalCost bagCharge [] (bag.clientHistory [] p) ≤ + (bag.clientHistory [] p).length * 2 := + bag.totalCost_le_length_mul bagCharge 2 (fun _ o _ => by cases o <;> simp [bagCharge]) + (bag.validHistory_of_forall_valid (fun _ _ => trivial) _ _) + omega + +end ComplexityTests.StateTransitionRefinement From 2f12c49d3c05a6905a3484b2b0efa0591cda0021 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 17:23:20 -0500 Subject: [PATCH 04/17] feat(DataStructure/StateTransition): weaken and rescale amortized refinements Amortized.mono and Amortized.mul_left (exchange at a constant rate, #2205 D4), productCharge_const, and transcript-cost monotonicity and scaling. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../StateTransition/Refinement.lean | 60 ++++++++++++++++++- 1 file changed, 58 insertions(+), 2 deletions(-) diff --git a/Complexity/DataStructure/StateTransition/Refinement.lean b/Complexity/DataStructure/StateTransition/Refinement.lean index a70028a61c..ee80ab1581 100644 --- a/Complexity/DataStructure/StateTransition/Refinement.lean +++ b/Complexity/DataStructure/StateTransition/Refinement.lean @@ -43,6 +43,10 @@ methods of each side leave the other side's abstraction, invariant and potential * `Refinement.Amortized`: per-method amortized cost refinement with a potential on lower states. * `productCharge`: componentwise charges of a product specification. +The two transcript-cost lemmas `StateTransitionSpec.totalCostTranscript_mono` and +`StateTransitionSpec.totalCostTranscript_mul_left` sit here, beside their only clients, rather +than in the widely imported `StateTransition` module. + ## Main results * `Refinement.simulates_demonic`, `Refinement.simulates_client`: whole adaptive clients run @@ -54,6 +58,12 @@ methods of each side leave the other side's abstraction, invariant and potential * `Refinement.Amortized.prod`: potentials add across non-interfering products. * `Refinement.Amortized.realize`: an amortized certificate for the realized module. * `Refinement.Amortized.id`: the identity refinement passes charges through. +* `Refinement.Amortized.mono`, `Refinement.Amortized.mul_left`: weaken charges, and exchange + both currencies at a constant rate. +* `productCharge_const`: equal constant charges on a product. +* `StateTransitionSpec.totalCostTranscript_mono`, + `StateTransitionSpec.totalCostTranscript_mul_left`: monotonicity and scaling of transcript + costs. * `Refinement.Amortized.chargeBound`, `Refinement.Amortized.of_chargeBound`: with zero potential, the existing worst-case `Module.ChargeBound`. @@ -86,6 +96,25 @@ structure Refinement (D E : StateTransitionSpec.{u, v, w}) where correct : ∀ {e} o {a e' tr}, inv e → D.valid (abs e) o → E.ClientRun e (methods o) a e' tr → D.step (abs e) o (abs e') a ∧ inv e' +/-- Smaller charges total less along any transcript. -/ +theorem StateTransitionSpec.totalCostTranscript_mono {c c' : D.State → D.Op → ℕ} + (h : ∀ s o, c s o ≤ c' s o) (s : D.State) (tr : D.Transcript) : + D.totalCostTranscript c s tr ≤ D.totalCostTranscript c' s tr := by + induction tr generalizing s with + | nil => simp + | cons st tr ih => + simp only [StateTransitionSpec.totalCostTranscript_cons] + exact Nat.add_le_add (h _ _) (ih _) + +/-- Scaling every charge by `K` scales the total by `K`. -/ +theorem StateTransitionSpec.totalCostTranscript_mul_left (K : ℕ) (c : D.State → D.Op → ℕ) + (s : D.State) (tr : D.Transcript) : + D.totalCostTranscript (fun s o => K * c s o) s tr = K * D.totalCostTranscript c s tr := by + induction tr generalizing s with + | nil => simp + | cons st tr ih => + simp only [StateTransitionSpec.totalCostTranscript_cons, ih, Nat.mul_add] + namespace Refinement /-- The constructor for deterministic specifications: each method's history is admissible, and @@ -244,6 +273,27 @@ theorem Amortized.ofFn {fE : (e : E.State) → (o : E.Op) → E.State × E.Resul rw [E.totalCostTranscript_canonicalTranscript] exact h o hi hv +/-- Weaker charges: cheaper lower charges and dearer upper charges on admissible operations. -/ +theorem Amortized.mono (A : M.Amortized lower upper potential) + {lower' : E.State → E.Op → ℕ} {upper' : D.State → D.Op → ℕ} + (hlower : ∀ e o, lower' e o ≤ lower e o) + (hupper : ∀ s o, D.valid s o → upper s o ≤ upper' s o) : + M.Amortized lower' upper' potential := by + intro e o a e' tr hi hv hrun + have h := A o hi hv hrun + have hl := E.totalCostTranscript_mono hlower e tr + have hu := hupper _ o hv + omega + +/-- **Exchange at a constant rate.** Scaling both currencies and the potential by `K` preserves +the amortized inequality. -/ +theorem Amortized.mul_left (A : M.Amortized lower upper potential) (K : ℕ) : + M.Amortized (fun e o => K * lower e o) (fun s o => K * upper s o) + (fun e => K * potential e) := by + intro e o a e' tr hi hv hrun + rw [E.totalCostTranscript_mul_left, ← Nat.mul_add, ← Nat.mul_add] + exact Nat.mul_le_mul_left K (A o hi hv hrun) + /-- Potentials telescope along any run of a linked admissible client. -/ theorem Amortized.demonic (A : M.Amortized lower upper potential) (p : D.Client α) {e e' : E.State} {a : α} {tr_E : E.Transcript} (he : M.inv e) @@ -303,8 +353,14 @@ theorem Amortized.comp {N : Refinement E F} {lower : F.State → F.Op → ℕ} /-- Componentwise charges of a product specification. -/ def productCharge (c₁ : D₁.State → D₁.Op → ℕ) (c₂ : D₂.State → D₂.Op → ℕ) : (product D₁ D₂).State → (product D₁ D₂).Op → ℕ - | (s₁, _), .inl o => c₁ s₁ o - | (_, s₂), .inr o => c₂ s₂ o + | s, .inl o => c₁ s.1 o + | s, .inr o => c₂ s.2 o + +/-- Equal constant charges on both components are that constant charge on the product. -/ +@[simp] theorem productCharge_const (K : ℕ) : + productCharge (D₁ := D₁) (D₂ := D₂) (fun _ _ => K) (fun _ _ => K) = fun _ _ => K := by + funext s o + cases o <;> rfl /-- **Potentials add across non-interfering products**, provided the methods of each side leave the other side's potential unchanged. -/ From 98e3290dbc1bda9719bde60ccf0b57ecc992f5da Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 17:27:24 -0500 Subject: [PATCH 05/17] fix(DataStructure/StateTransition): place productCharge beside product, outside Refinement Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../StateTransition/Refinement.lean | 24 +++++++++---------- 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/Complexity/DataStructure/StateTransition/Refinement.lean b/Complexity/DataStructure/StateTransition/Refinement.lean index ee80ab1581..08e10929f6 100644 --- a/Complexity/DataStructure/StateTransition/Refinement.lean +++ b/Complexity/DataStructure/StateTransition/Refinement.lean @@ -96,6 +96,18 @@ structure Refinement (D E : StateTransitionSpec.{u, v, w}) where correct : ∀ {e} o {a e' tr}, inv e → D.valid (abs e) o → E.ClientRun e (methods o) a e' tr → D.step (abs e) o (abs e') a ∧ inv e' +/-- Componentwise charges of a product specification. -/ +def productCharge (c₁ : D₁.State → D₁.Op → ℕ) (c₂ : D₂.State → D₂.Op → ℕ) : + (product D₁ D₂).State → (product D₁ D₂).Op → ℕ + | s, .inl o => c₁ s.1 o + | s, .inr o => c₂ s.2 o + +/-- Equal constant charges on both components are that constant charge on the product. -/ +@[simp] theorem productCharge_const (K : ℕ) : + productCharge (D₁ := D₁) (D₂ := D₂) (fun _ _ => K) (fun _ _ => K) = fun _ _ => K := by + funext s o + cases o <;> rfl + /-- Smaller charges total less along any transcript. -/ theorem StateTransitionSpec.totalCostTranscript_mono {c c' : D.State → D.Op → ℕ} (h : ∀ s o, c s o ≤ c' s o) (s : D.State) (tr : D.Transcript) : @@ -350,18 +362,6 @@ theorem Amortized.comp {N : Refinement E F} {lower : F.State → F.Op → ℕ} upper (M.abs (N.abs f)) o + (Φ (N.abs f) + Ψ f) omega -/-- Componentwise charges of a product specification. -/ -def productCharge (c₁ : D₁.State → D₁.Op → ℕ) (c₂ : D₂.State → D₂.Op → ℕ) : - (product D₁ D₂).State → (product D₁ D₂).Op → ℕ - | s, .inl o => c₁ s.1 o - | s, .inr o => c₂ s.2 o - -/-- Equal constant charges on both components are that constant charge on the product. -/ -@[simp] theorem productCharge_const (K : ℕ) : - productCharge (D₁ := D₁) (D₂ := D₂) (fun _ _ => K) (fun _ _ => K) = fun _ _ => K := by - funext s o - cases o <;> rfl - /-- **Potentials add across non-interfering products**, provided the methods of each side leave the other side's potential unchanged. -/ theorem Amortized.prod {M₁ : Refinement D₁ E} {M₂ : Refinement D₂ E} From 56232f9738389bd1f3c285dfddc6b4cd1048c766 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 17:28:34 -0500 Subject: [PATCH 06/17] refactor(DataStructure/StateTransition): make Refinement.Amortized a structure A Prop-valued def whose body starts with an implicit binder is unfolded and auto-introduced during elaboration against an expected type, which broke term-mode uses such as Amortized.prod. A one-field structure, like the existing DataStructure.Amortized, avoids this. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../StateTransition/Refinement.lean | 40 ++++++++++--------- 1 file changed, 21 insertions(+), 19 deletions(-) diff --git a/Complexity/DataStructure/StateTransition/Refinement.lean b/Complexity/DataStructure/StateTransition/Refinement.lean index 08e10929f6..e6d94e5d59 100644 --- a/Complexity/DataStructure/StateTransition/Refinement.lean +++ b/Complexity/DataStructure/StateTransition/Refinement.lean @@ -263,10 +263,12 @@ def prod (M₁ : Refinement D₁ E) (M₂ : Refinement D₂ E) are at most the upper charge of the operation plus the potential before it. Potentials are natural numbers, hence nonnegative; a client bound subtracts nothing when the initial potential is zero. -/ -def Amortized (lower : E.State → E.Op → ℕ) (upper : D.State → D.Op → ℕ) - (potential : E.State → ℕ) : Prop := - ∀ {e} o {a e' tr}, M.inv e → D.valid (M.abs e) o → E.ClientRun e (M.methods o) a e' tr → - E.totalCostTranscript lower e tr + potential e' ≤ upper (M.abs e) o + potential e +structure Amortized (lower : E.State → E.Op → ℕ) (upper : D.State → D.Op → ℕ) + (potential : E.State → ℕ) : Prop where + /-- The physicist's inequality for one method run. -/ + step : ∀ {e} o {a e' tr}, M.inv e → D.valid (M.abs e) o → + E.ClientRun e (M.methods o) a e' tr → + E.totalCostTranscript lower e tr + potential e' ≤ upper (M.abs e) o + potential e variable {M} {lower : E.State → E.Op → ℕ} {upper : D.State → D.Op → ℕ} {potential : E.State → ℕ} @@ -280,7 +282,7 @@ theorem Amortized.ofFn {fE : (e : E.State) → (o : E.Op) → E.State × E.Resul potential (E.clientState e (M.methods o)) ≤ upper (M.abs e) o + potential e) : M.Amortized lower upper potential := by - intro e o a e' tr hi hv hrun + refine ⟨fun {e} o {a e' tr} hi hv hrun => ?_⟩ obtain ⟨_, _, rfl, rfl⟩ := (E.clientRun_iff_runClient e (M.methods o) a e' tr).mp hrun rw [E.totalCostTranscript_canonicalTranscript] exact h o hi hv @@ -291,8 +293,8 @@ theorem Amortized.mono (A : M.Amortized lower upper potential) (hlower : ∀ e o, lower' e o ≤ lower e o) (hupper : ∀ s o, D.valid s o → upper s o ≤ upper' s o) : M.Amortized lower' upper' potential := by - intro e o a e' tr hi hv hrun - have h := A o hi hv hrun + refine ⟨fun {e} o {a e' tr} hi hv hrun => ?_⟩ + have h := A.step o hi hv hrun have hl := E.totalCostTranscript_mono hlower e tr have hu := hupper _ o hv omega @@ -302,9 +304,9 @@ the amortized inequality. -/ theorem Amortized.mul_left (A : M.Amortized lower upper potential) (K : ℕ) : M.Amortized (fun e o => K * lower e o) (fun s o => K * upper s o) (fun e => K * potential e) := by - intro e o a e' tr hi hv hrun + refine ⟨fun {e} o {a e' tr} hi hv hrun => ?_⟩ rw [E.totalCostTranscript_mul_left, ← Nat.mul_add, ← Nat.mul_add] - exact Nat.mul_le_mul_left K (A o hi hv hrun) + exact Nat.mul_le_mul_left K (A.step o hi hv hrun) /-- Potentials telescope along any run of a linked admissible client. -/ theorem Amortized.demonic (A : M.Amortized lower upper potential) (p : D.Client α) @@ -324,7 +326,7 @@ theorem Amortized.demonic (A : M.Amortized lower upper potential) (p : D.Client rw [heq] at hrun obtain ⟨res, e₁, tr₁, tr₂, hrun₁, hrun₂, rfl⟩ := E.clientRun_bind_iff.mp hrun obtain ⟨hstep₁, he₁⟩ := M.correct o he hv_o hrun₁ - have hc₁ := A o he hv_o hrun₁ + have hc₁ := A.step o he hv_o hrun₁ obtain ⟨he₂, tr_D, hrun_D, hc₂⟩ := ih res he₁ (hv_k _ res hstep₁) hrun₂ refine ⟨he₂, ⟨o, res, M.abs e₁⟩ :: tr_D, .liftBind o k res hv_o hstep₁ hrun_D, ?_⟩ rw [E.totalCostTranscript_append lower hrun₁.validTranscript tr₂] @@ -355,9 +357,9 @@ theorem Amortized.comp {N : Refinement E F} {lower : F.State → F.Op → ℕ} {middle : E.State → E.Op → ℕ} {Φ : E.State → ℕ} {Ψ : F.State → ℕ} (A : M.Amortized middle upper Φ) (B : N.Amortized lower middle Ψ) : (M.comp N).Amortized lower upper (fun f => Φ (N.abs f) + Ψ f) := by - intro f o a f' tr hi hv hrun + refine ⟨fun {f} o {a f' tr} hi hv hrun => ?_⟩ obtain ⟨_, tr_E, hrun_E, hN⟩ := B.demonic (M.methods o) hi.1 (M.valid o hi.2 hv) hrun - have hM := A o hi.2 hv hrun_E + have hM := A.step o hi.2 hv hrun_E change F.totalCostTranscript lower f tr + (Φ (N.abs f') + Ψ f') ≤ upper (M.abs (N.abs f)) o + (Φ (N.abs f) + Ψ f) omega @@ -378,16 +380,16 @@ theorem Amortized.prod {M₁ : Refinement D₁ E} {M₂ : Refinement D₂ E} E.ClientRun e (M₂.methods o) a e' tr → Φ₁ e' = Φ₁ e) : (M₁.prod M₂ frame₁ frame₂).Amortized lower (productCharge upper₁ upper₂) (fun e => Φ₁ e + Φ₂ e) := by - intro e o a e' tr hi hv hrun + refine ⟨fun {e} o {a e' tr} hi hv hrun => ?_⟩ cases o with | inl o => - have h := A₁ o hi.1 hv hrun + have h := A₁.step o hi.1 hv hrun have hΦ := potential₁ o hi.1 hi.2 hv hrun change E.totalCostTranscript lower e tr + (Φ₁ e' + Φ₂ e') ≤ upper₁ (M₁.abs e) o + (Φ₁ e + Φ₂ e) omega | inr o => - have h := A₂ o hi.2 hv hrun + have h := A₂.step o hi.2 hv hrun have hΦ := potential₂ o hi.1 hi.2 hv hrun change E.totalCostTranscript lower e tr + (Φ₁ e' + Φ₂ e') ≤ upper₂ (M₂.abs e) o + (Φ₁ e + Φ₂ e) @@ -407,7 +409,7 @@ theorem Amortized.realize (A : M.Amortized lower upper potential) obtain ⟨e, ⟨hi, rfl⟩, hR₀⟩ := hr obtain ⟨e', tr, hrun, hR', _, hcost⟩ := B.demonic hR₀ (M.valid o hi hv) he obtain ⟨hstep, hi'⟩ := M.correct o hi hv hrun - have hc := A o hi hv hrun + have hc := A.step o hi hv hrun refine ⟨M.abs e', hstep, ⟨e', ⟨hi', rfl⟩, hR'⟩, ?_⟩ rw [← hR hR₀, ← hR hR'] omega @@ -415,7 +417,7 @@ theorem Amortized.realize (A : M.Amortized lower upper potential) /-- The identity refinement passes each charge through unchanged. -/ theorem Amortized.id (charge : D.State → D.Op → ℕ) : (Refinement.id D).Amortized charge charge fun _ => 0 := by - intro e o a e' tr _ _ hrun + refine ⟨fun {e} o {a e' tr} _ _ hrun => ?_⟩ cases hrun with | liftBind _ _ r _ _ hrest => cases hrest @@ -426,13 +428,13 @@ module. -/ theorem Amortized.chargeBound (A : M.Amortized lower upper fun _ => 0) : M.toModule.ChargeBound lower upper := by rintro s e o a e' tr ⟨hi, rfl⟩ hv hrun - simpa using A o hi hv hrun + simpa using A.step o hi hv hrun /-- A worst-case `Module.ChargeBound` of the module is an amortized refinement with zero potential. -/ theorem Amortized.of_chargeBound (B : M.toModule.ChargeBound lower upper) : M.Amortized lower upper fun _ => 0 := by - intro e o a e' tr hi hv hrun + refine ⟨fun {e} o {a e' tr} hi hv hrun => ?_⟩ simpa using B o ⟨hi, rfl⟩ hv hrun end Refinement From fe7d60dfa1f451062f231851e21fa89d4b413f61 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 17:31:13 -0500 Subject: [PATCH 07/17] wip: array stack over memory and queue method lemmas Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity/DataStructure/Queue/Spec.lean | 59 +-- Complexity/DataStructure/Stack/Memory.lean | 397 +++++++++++++++++++++ 2 files changed, 434 insertions(+), 22 deletions(-) create mode 100644 Complexity/DataStructure/Stack/Memory.lean diff --git a/Complexity/DataStructure/Queue/Spec.lean b/Complexity/DataStructure/Queue/Spec.lean index 7a0ec18c25..ef315844d5 100644 --- a/Complexity/DataStructure/Queue/Spec.lean +++ b/Complexity/DataStructure/Queue/Spec.lean @@ -28,6 +28,8 @@ method is described in Chapter 17. ## Main results * `transfer_run`: stack operations reverse the rear contents into the front stack. +* `runClient_dequeue_nil`, `stepFn_methods`: the methods realize the FIFO step on the represented + list. * `potential_step`: at most three amortized stack calls, including the size query. * `realized_client`: every adaptive client has a correct backend execution with its bound. * `realized_client_bound`: every supplied linked execution satisfies correctness and the bound. @@ -123,6 +125,36 @@ theorem transfer_run (front back : List α) : (fun r : Unit × (stackPair α).State × List (stackPair α).Op => (r.1, r.2.1, .inr .pop :: .inl (.push a) :: r.2.2)) (ih (a :: front)) +/-- A dequeue from an empty front stack asks for the rear size, transfers the rear, and pops the +front again. -/ +theorem runClient_dequeue_nil (back : List α) : + (stackPair α).runClient ([], back) (methods .dequeue) = + (back.reverse.head?, (back.reverse.tail, []), + .inl .pop :: .inr .size :: (transferTrace back ++ [.inl .pop])) := by + simp only [methods, bind, StateTransitionSpec.runClient_liftBind, stackPair, stack, + List.tail_nil, List.head?_nil] + rw [StateTransitionSpec.runClient_bind, transfer_run] + simp + +/-- Each method returns the FIFO answer, and the stacks then represent the FIFO successor of the +represented list. -/ +theorem stepFn_methods (front back : List α) (o : QueueOp α) : + (queue α).stepFn (front ++ back.reverse) o = + (((stackPair α).clientState (front, back) (methods o)).1 ++ + ((stackPair α).clientState (front, back) (methods o)).2.reverse, + (stackPair α).clientResult (front, back) (methods o)) := by + cases o with + | enqueue n => + change ((front ++ back.reverse) ++ [n], ()) = (front ++ (n :: back).reverse, ()) + simp [List.reverse_cons, List.append_assoc] + | dequeue => + cases front with + | cons a front => rfl + | nil => + simp only [StateTransitionSpec.clientState, StateTransitionSpec.clientResult] + rw [runClient_dequeue_nil] + simp + /-- Representation and behavior are proved once, before selecting a backend or cost model. -/ def implementation : Module (queue α) (stackPair α) := Module.ofFn @@ -134,21 +166,8 @@ def implementation : Module (queue α) (stackPair α) := intro q s o hr _ subst q obtain ⟨front, back⟩ := s - cases o with - | enqueue n => - constructor - · rfl - · change (front ++ back.reverse) ++ [n] = front ++ (n :: back).reverse - simp [List.reverse_cons, List.append_assoc] - | dequeue => - cases front with - | cons a front => exact ⟨rfl, rfl⟩ - | nil => - simp only [methods, bind, StateTransitionSpec.clientResult, - StateTransitionSpec.clientState, StateTransitionSpec.runClient_liftBind, - stackPair, stack, List.tail_nil, List.head?_nil] - rw [StateTransitionSpec.runClient_bind, transfer_run] - simp) + have h := stepFn_methods front back o + exact ⟨(congrArg Prod.snd h).symm, congrArg Prod.fst h⟩) /-- Each transferred element incurs one pop and one push. -/ theorem transferTrace_length (back : List α) : (transferTrace back).length = 2 * back.length := by @@ -173,13 +192,9 @@ theorem potential_step (s : (stackPair α).State) (o : QueueOp α) : change 1 + 2 * back.length ≤ 3 + 2 * back.length omega | nil => - simp only [methods, bind, StateTransitionSpec.runClient_liftBind, stackPair, - stack, List.tail_nil, List.head?_nil] - rw [StateTransitionSpec.runClient_bind, transfer_run] - simp only [StateTransitionSpec.runClient_liftBind, StateTransitionSpec.runClient_pure] - change (transferTrace back ++ [Sum.inl StackOp.pop]).length + 2 ≤ 3 + 2 * back.length - rw [List.length_append, transferTrace_length] - simp only [List.length_singleton] + rw [runClient_dequeue_nil] + simp only [List.length_cons, List.length_append, List.length_nil] + rw [transferTrace_length] omega private theorem weighted_potential_step (K : Nat) {q : (queue α).State} {s : (stackPair α).State} diff --git a/Complexity/DataStructure/Stack/Memory.lean b/Complexity/DataStructure/Stack/Memory.lean new file mode 100644 index 0000000000..b70e19923f --- /dev/null +++ b/Complexity/DataStructure/Stack/Memory.lean @@ -0,0 +1,397 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.DataStructure.Memory.Field +public import Complexity.DataStructure.StateTransition.Refinement +public import Complexity.DataStructure.Stack.WordRAM.Basic + +/-! +# An array stack over the memory oracle + +The bounded stack `Stack.WordRAM.spec w C` is implemented by three short programs over +`Memory.spec w`. The storage is a `Layout` with two named fields: a one-cell `count` and an +`items` array of `C` cells, bottom first. The abstraction function reads the first `count` items +and reverses them, so the top comes first. Each operation is one read, two writes at most, and a +single branch; its evaluation is definitional (`runClient_push`, `runClient_pop_of_pos`, …), and +the refinement obligations follow from those equations and the list view of the array. + +Every operation costs at most three memory units, with no potential (`amortized`). The methods +write only the layout's cells and never allocate (`modifies_methods`), and the abstraction and +invariant depend only on those cells (`abs_congr`, `Inv.congr`). Two stacks with disjoint +layouts therefore implement the product of two stacks (`pairRefinement`). + +This is the same specification that `Stack.WordRAM` implements by a hand-stepped nine-register +dispatcher. Here no register, instruction count or word-fit chain appears; fits enter only +through the admissibility of `Memory.spec w`. + +## Main definitions + +* `Layout`, `Layout.footprint`, `Layout.Valid`: the two fields, the cells they own, and their + static well-formedness. +* `push`, `pop`, `size`, `methods`: the operations as memory programs. +* `abs`, `Inv`: the abstraction function and the implementation invariant. +* `refinement`: the array stack as a `Refinement` of the bounded stack. +* `pairRefinement`: two array stacks with disjoint layouts implement the pair of stacks. +* `allocLayout`: allocate an empty stack. + +## Main results + +* `amortized`: every operation costs at most three memory units. +* `pair_amortized`: so does every operation of the pair. +* `modifies_methods`, `abs_congr`, `Inv.congr`: the frame of a stack. +* `runClient_allocLayout_bind`, `inv_allocLayout`, `abs_allocLayout`: allocation yields an empty + stack in three memory units. + +## References + +* [T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein, *Introduction to Algorithms*, + Section 10.1][CLRS2009] +-/ + +@[expose] public section + +namespace Cslib.DataStructure.Stack.Memory + +open Cslib.WordRAM Cslib.DataStructure Cslib.DataStructure.Memory Cslib.DataStructure.Queue + +/-- The storage of an array stack: a one-cell field holding the number of items, and the item +array, bottom first. -/ +structure Layout where + /-- One cell holding the number of stored items. -/ + count : Block + /-- The items, bottom first. -/ + items : Block + +namespace Layout + +/-- The cells a stack owns. -/ +def footprint (L : Layout) : Finset ℕ := L.count.footprint ∪ L.items.footprint + +/-- Static well-formedness for capacity `C` at word size `w`: the count field is one cell outside +the item array, the array has `C` cells, and `C` fits a word. -/ +structure Valid (L : Layout) (w C : ℕ) : Prop where + /-- The count field is one cell. -/ + count_length : L.count.length = 1 + /-- The count cell is not an item. -/ + count_not_owns : ¬L.items.Owns L.count.base + /-- The item array has the capacity. -/ + items_length : L.items.length = C + /-- The capacity fits a word, so every count does. -/ + capacity_fits : Fits w C + +/-- The count cell belongs to the footprint. -/ +theorem count_mem_footprint (L : Layout) (hL : L.count.length = 1) : + L.count.base ∈ L.footprint := + Finset.mem_union_left _ (Block.mem_footprint.mpr ⟨le_rfl, by omega⟩) + +/-- Every item cell belongs to the footprint. -/ +theorem item_mem_footprint (L : Layout) {i : ℕ} (hi : i < L.items.length) : + L.items.base + i ∈ L.footprint := + Finset.mem_union_right _ (Block.mem_footprint.mpr (Block.owns_add hi)) + +end Layout + +variable (L : Layout) + +/-- Push: write the item above the top, then increment the count. -/ +def push (v : ℕ) : Prog Unit := do + let n ← L.count.get 0 + L.items.set n v + L.count.set 0 (n + 1) + +/-- Pop: an empty stack returns `none`; otherwise read the top item and decrement the count. -/ +def pop : Prog (Option ℕ) := do + let n ← L.count.get 0 + if n = 0 then pure none else do + let v ← L.items.get (n - 1) + L.count.set 0 (n - 1) + pure (some v) + +/-- Size: read the count. -/ +def size : Prog ℕ := L.count.get 0 + +/-- The stack operations as memory programs. -/ +def methods (w C : ℕ) : Methods (Stack.WordRAM.spec w C) (Memory.spec w) + | .push v => push L v + | .pop => pop L + | .size => size L + +/-- The stored stack, top first: the first `count` items, reversed. -/ +def abs (s : Memory.State) : List ℕ := (L.items.entries (s.mem L.count.base) s.mem).reverse + +/-- The implementation invariant: both fields are allocated and the count is within capacity. -/ +structure Inv (s : Memory.State) : Prop where + /-- The count cell is allocated. -/ + count_allocated : L.count.Allocated s + /-- The item array is allocated. -/ + items_allocated : L.items.Allocated s + /-- The count is at most the capacity. -/ + count_le : s.mem L.count.base ≤ L.items.length + +/-! ## Evaluation -/ + +variable {w : ℕ} + +/-- A push reads the count, writes the item and writes the new count. -/ +theorem runClient_push (s : Memory.State) (v : ℕ) : + (Memory.spec w).runClient s (push L v) = + ((), ⟨Function.update (Function.update s.mem (L.items.base + s.mem L.count.base) v) + L.count.base (s.mem L.count.base + 1), s.frontier⟩, + [.read L.count.base, .write (L.items.base + s.mem L.count.base) v, + .write L.count.base (s.mem L.count.base + 1)]) := rfl + +/-- A pop from an empty stack reads the count only. -/ +theorem runClient_pop_of_eq_zero (s : Memory.State) (h : s.mem L.count.base = 0) : + (Memory.spec w).runClient s (pop L) = (none, s, [.read L.count.base]) := by + simp [pop, h] + +/-- A pop from a nonempty stack reads the count and the top item and writes the new count. -/ +theorem runClient_pop_of_pos (s : Memory.State) (h : s.mem L.count.base ≠ 0) : + (Memory.spec w).runClient s (pop L) = + (some (s.mem (L.items.base + (s.mem L.count.base - 1))), + ⟨Function.update s.mem L.count.base (s.mem L.count.base - 1), s.frontier⟩, + [.read L.count.base, .read (L.items.base + (s.mem L.count.base - 1)), + .write L.count.base (s.mem L.count.base - 1)]) := by + unfold pop + simp only [Block.runClient_get_bind, Nat.add_zero, h, ↓reduceIte] + rfl + +/-- A size query reads the count. -/ +theorem runClient_size (s : Memory.State) : + (Memory.spec w).runClient s (size L) = (s.mem L.count.base, s, [.read L.count.base]) := rfl + +/-! ## The list view -/ + +variable {L} {C : ℕ} + +/-- The stack has as many elements as the count. -/ +@[simp] theorem length_abs (s : Memory.State) : (abs L s).length = s.mem L.count.base := by + simp [abs] + +/-- Writing the count leaves the items in place. -/ +theorem abs_update_count (hL : L.Valid w C) (m : ℕ → ℕ) (f : ℕ) {n : ℕ} (hn : n ≤ C) : + abs L ⟨Function.update m L.count.base n, f⟩ = (L.items.entries n m).reverse := by + simp only [abs, Function.update_self] + rw [Block.entries_update_of_not_owns _ (hL.items_length ▸ hn) hL.count_not_owns] + +/-- The abstraction and the invariant read only the layout's cells and the frontier. -/ +theorem abs_congr {s s' : Memory.State} (hL : L.Valid w C) (hs : Inv L s) + (h : ∀ a ∈ L.footprint, s'.mem a = s.mem a) : abs L s' = abs L s := by + have hc : s'.mem L.count.base = s.mem L.count.base := + h _ (L.count_mem_footprint hL.count_length) + simp only [abs, hc] + rw [Block.entries_congr _ _ fun i hi => h _ (L.item_mem_footprint (by + have := hs.count_le + omega))] + +/-- The invariant reads only the layout's cells and survives a growing frontier. -/ +theorem Inv.congr {s s' : Memory.State} (hL : L.Valid w C) (hs : Inv L s) + (h : ∀ a ∈ L.footprint, s'.mem a = s.mem a) (hf : s.frontier ≤ s'.frontier) : Inv L s' where + count_allocated := hs.count_allocated.mono hf + items_allocated := hs.items_allocated.mono hf + count_le := by + rw [h _ (L.count_mem_footprint hL.count_length)] + exact hs.count_le + +/-! ## The refinement -/ + +/-- The count cell is an admissible address. -/ +theorem Inv.count_lt (hL : L.Valid w C) {s : Memory.State} (hs : Inv L s) : + L.count.base < s.frontier := by + simpa using hs.count_allocated.lt_frontier (i := 0) (by rw [hL.count_length]; omega) + +/-- Item `i` below the capacity is an admissible address. -/ +theorem Inv.item_lt {s : Memory.State} (hs : Inv L s) {i : ℕ} (hi : i < L.items.length) : + L.items.base + i < s.frontier := + hs.items_allocated.lt_frontier hi + +/-- The array stack implements the bounded stack of capacity `C`. -/ +def refinement (hL : L.Valid w C) : Refinement (Stack.WordRAM.spec w C) (Memory.spec w) := + Refinement.ofFn (methods L w C) (Inv L) (abs L) + (by + intro s o hs hv + have hcount := hs.count_lt hL + have hC := hL.items_length + cases o with + | push v => + obtain ⟨hlen, hfit⟩ := hv + rw [length_abs] at hlen + simp only [methods, StateTransitionSpec.clientHistory, runClient_push] + simp only [StateTransitionSpec.validHistory_cons, StateTransitionSpec.stepFn, + step_read, step_write, valid_read, valid_write] + exact ⟨hcount, ⟨hs.item_lt (by omega), hfit⟩, ⟨hcount, + hL.capacity_fits.of_le (by omega)⟩, trivial⟩ + | pop => + by_cases h0 : s.mem L.count.base = 0 + · simp only [methods, StateTransitionSpec.clientHistory, runClient_pop_of_eq_zero L s h0] + exact ⟨hcount, trivial⟩ + · simp only [methods, StateTransitionSpec.clientHistory, runClient_pop_of_pos L s h0] + simp only [StateTransitionSpec.validHistory_cons, StateTransitionSpec.stepFn, + step_read, step_write, valid_read, valid_write] + have := hs.count_le + exact ⟨hcount, hs.item_lt (by omega), ⟨hcount, + hL.capacity_fits.of_le (by omega)⟩, trivial⟩ + | size => + simp only [methods, StateTransitionSpec.clientHistory, runClient_size] + exact ⟨hcount, trivial⟩) + (by + intro s o hs hv + have hle := hs.count_le + have hC := hL.items_length + cases o with + | push v => + obtain ⟨hlen, -⟩ := hv + rw [length_abs] at hlen + simp only [methods, StateTransitionSpec.clientState, StateTransitionSpec.clientResult, + runClient_push] + refine ⟨?_, ⟨hs.count_allocated, hs.items_allocated, by simp; omega⟩⟩ + rw [abs_update_count hL _ _ (by omega), Block.entries_succ, + Block.entries_update_of_le _ le_rfl, Function.update_self] + simp [abs] + | pop => + by_cases h0 : s.mem L.count.base = 0 + · simp only [methods, StateTransitionSpec.clientState, StateTransitionSpec.clientResult, + runClient_pop_of_eq_zero L s h0] + have he : abs L s = [] := List.eq_nil_of_length_eq_zero (by simp [h0]) + simp [he, hs] + · simp only [methods, StateTransitionSpec.clientState, StateTransitionSpec.clientResult, + runClient_pop_of_pos L s h0] + refine ⟨?_, ⟨hs.count_allocated, hs.items_allocated, by simp; omega⟩⟩ + obtain ⟨n, hn⟩ := Nat.exists_eq_succ_of_ne_zero h0 + have habs : abs L s = + s.mem (L.items.base + n) :: (L.items.entries n s.mem).reverse := by + simp [abs, hn, Block.entries_succ] + rw [abs_update_count hL _ _ (by omega), habs] + simp [hn] + | size => + simp only [methods, StateTransitionSpec.clientState, StateTransitionSpec.clientResult, + runClient_size] + exact ⟨by simp, hs⟩) + +/-- Every operation costs at most three memory units, so the stack needs no potential. -/ +theorem amortized (hL : L.Valid w C) : + (refinement hL).Amortized charge (fun _ _ => 3) fun _ => 0 := by + apply Refinement.Amortized.ofFn + intro s o _ _ + cases o with + | push v => simp [refinement, methods, StateTransitionSpec.clientHistory, runClient_push] + | pop => + by_cases h0 : s.mem L.count.base = 0 + · simp [refinement, methods, StateTransitionSpec.clientHistory, + runClient_pop_of_eq_zero L s h0] + · simp [refinement, methods, StateTransitionSpec.clientHistory, runClient_pop_of_pos L s h0] + | size => simp [refinement, methods, StateTransitionSpec.clientHistory, runClient_size] + +/-! ## The frame of a stack -/ + +/-- Each admissible operation writes only the layout's cells and never allocates. -/ +theorem modifies_methods (hL : L.Valid w C) {s : Memory.State} (o : StackOp ℕ) + (hv : (Stack.WordRAM.spec w C).valid (abs L s) o) : + (∀ a ∉ L.footprint, + ((Memory.spec w).clientState s (methods L w C o)).mem a = s.mem a) ∧ + ((Memory.spec w).clientState s (methods L w C o)).frontier = s.frontier := by + have hc : L.count.base ∈ L.footprint := L.count_mem_footprint hL.count_length + cases o with + | push v => + obtain ⟨hlen, -⟩ := hv + rw [length_abs] at hlen + have hi : L.items.base + s.mem L.count.base ∈ L.footprint := + L.item_mem_footprint (by rw [hL.items_length]; exact hlen) + simp only [methods, StateTransitionSpec.clientState, runClient_push] + exact ⟨fun a ha => by + rw [Function.update_of_ne (ne_of_mem_of_not_mem hc ha).symm, + Function.update_of_ne (ne_of_mem_of_not_mem hi ha).symm], trivial⟩ + | pop => + by_cases h0 : s.mem L.count.base = 0 + · simp only [methods, StateTransitionSpec.clientState, runClient_pop_of_eq_zero L s h0] + exact ⟨fun _ _ => trivial, trivial⟩ + · simp only [methods, StateTransitionSpec.clientState, runClient_pop_of_pos L s h0] + exact ⟨fun a ha => Function.update_of_ne (ne_of_mem_of_not_mem hc ha).symm _ _, trivial⟩ + | size => exact ⟨fun _ _ => rfl, rfl⟩ + +/-- A stack's operations leave a stack with a disjoint layout unchanged. -/ +theorem frame {L' : Layout} (hL : L.Valid w C) (hL' : L'.Valid w C) + (hd : Disjoint L.footprint L'.footprint) {s : Memory.State} (hs' : Inv L' s) + (o : StackOp ℕ) (hv : (Stack.WordRAM.spec w C).valid (abs L s) o) : + abs L' ((Memory.spec w).clientState s (methods L w C o)) = abs L' s ∧ + Inv L' ((Memory.spec w).clientState s (methods L w C o)) := by + obtain ⟨hm, hf⟩ := modifies_methods hL o hv + have h : ∀ a ∈ L'.footprint, + ((Memory.spec w).clientState s (methods L w C o)).mem a = s.mem a := + fun a ha => hm a (Finset.disjoint_right.mp hd ha) + exact ⟨abs_congr hL' hs' h, hs'.congr hL' h hf.ge⟩ + +/-! ## Two stacks in one memory -/ + +/-- Two array stacks with disjoint layouts implement a pair of bounded stacks. -/ +def pairRefinement {L₁ L₂ : Layout} (h₁ : L₁.Valid w C) (h₂ : L₂.Valid w C) + (hd : Disjoint L₁.footprint L₂.footprint) : + Refinement (product (Stack.WordRAM.spec w C) (Stack.WordRAM.spec w C)) (Memory.spec w) := + (refinement h₁).prod (refinement h₂) + (fun {s} o {a s' tr} hs₁ hs₂ hv hrun => by + obtain ⟨_, _, rfl, _⟩ := ((Memory.spec w).clientRun_iff_runClient _ _ _ _ _).mp hrun + exact frame h₁ h₂ hd hs₂ o hv) + (fun {s} o {a s' tr} hs₁ hs₂ hv hrun => by + obtain ⟨_, _, rfl, _⟩ := ((Memory.spec w).clientRun_iff_runClient _ _ _ _ _).mp hrun + exact frame h₂ h₁ hd.symm hs₁ o hv) + +/-- Every operation of the pair costs at most three memory units. -/ +theorem pair_amortized {L₁ L₂ : Layout} (h₁ : L₁.Valid w C) (h₂ : L₂.Valid w C) + (hd : Disjoint L₁.footprint L₂.footprint) : + (pairRefinement h₁ h₂ hd).Amortized charge (fun _ _ => 3) fun _ => 0 := by + have h : (pairRefinement h₁ h₂ hd).Amortized charge + (productCharge (fun _ _ => 3) (fun _ _ => 3)) fun _ => 0 := + (amortized h₁).prod (amortized h₂) (fun _ _ _ _ _ _ _ _ => rfl) + (fun _ _ _ _ _ _ _ _ => rfl) + rwa [productCharge_const] at h + +/-! ## Allocation -/ + +/-- Allocate an empty stack of capacity `C`: a zeroed count cell and an item array that is not +cleared. -/ +def allocLayout (C : ℕ) : Prog Layout := do + let count ← allocBlock 1 + let items ← allocBlockDirty C + pure ⟨count, items⟩ + +/-- Allocation places the count at the frontier and the items just above it. -/ +theorem runClient_allocLayout_bind {α : Type} (C : ℕ) (next : Layout → Prog α) + (s : Memory.State) : + (Memory.spec w).runClient s (allocLayout C >>= next) = + let (v, s', os) := (Memory.spec w).runClient + ⟨clear s.mem s.frontier 1, s.frontier + 1 + C⟩ + (next ⟨⟨s.frontier, 1⟩, ⟨s.frontier + 1, C⟩⟩) + (v, s', .alloc 1 :: .allocDirty C :: os) := rfl + +/-- The allocated layout is well formed when its end fits a word. -/ +theorem valid_allocLayout {f : ℕ} (hf : Fits w (f + 1 + C)) : + Layout.Valid ⟨⟨f, 1⟩, ⟨f + 1, C⟩⟩ w C where + count_length := rfl + count_not_owns := by simp [Block.Owns] + items_length := rfl + capacity_fits := hf.of_le (by omega) + +/-- The allocated stack satisfies the invariant and is empty. -/ +theorem inv_allocLayout (s : Memory.State) : + Inv ⟨⟨s.frontier, 1⟩, ⟨s.frontier + 1, C⟩⟩ ⟨clear s.mem s.frontier 1, s.frontier + 1 + C⟩ ∧ + abs ⟨⟨s.frontier, 1⟩, ⟨s.frontier + 1, C⟩⟩ + ⟨clear s.mem s.frontier 1, s.frontier + 1 + C⟩ = [] := by + have h0 : clear s.mem s.frontier 1 s.frontier = 0 := + clear_of_owns ⟨le_rfl, show s.frontier < s.frontier + 1 from Nat.lt_add_one _⟩ + refine ⟨⟨?_, ?_, ?_⟩, ?_⟩ + · change s.frontier + 1 ≤ s.frontier + 1 + C + omega + · change s.frontier + 1 + C ≤ s.frontier + 1 + C + exact le_rfl + · change clear s.mem s.frontier 1 s.frontier ≤ C + rw [h0] + exact Nat.zero_le C + · simp [abs, h0] + +end Cslib.DataStructure.Stack.Memory From aad5f3ee860b445a7bde96ab39ab69d50b6f6a0f Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 17:31:23 -0500 Subject: [PATCH 08/17] feat(Foundations): affine cost bounds are O(size) Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../Foundations/Analysis/Asymptotics/CostBound.lean | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/Complexity/Foundations/Analysis/Asymptotics/CostBound.lean b/Complexity/Foundations/Analysis/Asymptotics/CostBound.lean index d17a2b7965..3a99eace52 100644 --- a/Complexity/Foundations/Analysis/Asymptotics/CostBound.lean +++ b/Complexity/Foundations/Analysis/Asymptotics/CostBound.lean @@ -32,6 +32,7 @@ exact natural-number bound into an asymptotic one. ## Main results * `Cslib.CostIsBigO.of_le_nat`: export an exact monotone natural-number bound. +* `Cslib.CostIsBigO.of_le_add_mul`: an affine bound `a + b * size` is `O(size)`. * `Cslib.CostIsBigO.mono`: a smaller cost has the same bound. * `Cslib.CostIsBigO.trans_isBigO`: weaken the comparison function. @@ -76,6 +77,18 @@ theorem trans_isBigO {g' : ι → ℝ} (h : CostIsBigO l g size cost) (hg : g =O obtain ⟨f, hf, hf0, hO, hb⟩ := h exact ⟨f, hf, hf0, hO.trans hg, hb⟩ +/-- A cost at most `a + b * size` is `O(size)` along `atTop`. -/ +theorem of_le_add_mul {size : α → ℕ} (a b : ℕ) (h : ∀ x, cost x ≤ a + b * size x) : + CostIsBigO Filter.atTop (fun n : ℕ => (n : ℝ)) size cost := by + refine of_le_nat (F := fun n => a + b * n) + (fun _ _ hmn => Nat.add_le_add_left (Nat.mul_le_mul_left b hmn) a) ?_ h + refine IsBigO.of_bound (a + b) ?_ + filter_upwards [Filter.eventually_ge_atTop 1] with n hn + have hn' : (1 : ℝ) ≤ n := by exact_mod_cast hn + rw [Real.norm_of_nonneg (by positivity), Real.norm_of_nonneg (by positivity)] + push_cast + nlinarith + end CostIsBigO end Cslib From 6698e86529717d14e635feadf264726885f9cbb9 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 17:34:38 -0500 Subject: [PATCH 09/17] wip: queue over memory Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity/DataStructure/Queue/Memory.lean | 185 +++++++++++++++++++++ Complexity/DataStructure/Stack/Memory.lean | 17 +- 2 files changed, 201 insertions(+), 1 deletion(-) create mode 100644 Complexity/DataStructure/Queue/Memory.lean diff --git a/Complexity/DataStructure/Queue/Memory.lean b/Complexity/DataStructure/Queue/Memory.lean new file mode 100644 index 0000000000..28a37a7a87 --- /dev/null +++ b/Complexity/DataStructure/Queue/Memory.lean @@ -0,0 +1,185 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.DataStructure.Queue.WordRAM.Model +public import Complexity.DataStructure.Stack.Memory +public import Complexity.Foundations.Analysis.Asymptotics.CostBound + +/-! +# A queue over two array stacks over the memory oracle + +The bounded FIFO queue `Queue.WordRAM.spec w C` is implemented in two refinement steps, each +proved once: + +1. `refinement`: the two-stack queue `Queue.methods` over a pair of bounded stacks. It reuses the + queue's existing methods and their behavior (`Queue.stepFn_methods`) and potential argument + (`Queue.potential_step`); only the capacity and word-fit admissibility of the bounded stacks is + new. Each queue operation costs at most three stack calls, amortized, with two credits per + rear element. +2. `Stack.Memory.pairRefinement`: two array stacks with disjoint layouts over `Memory.spec w`, + each stack call costing at most three memory units. + +`memRefinement` composes them, and `mem_amortized` stacks the potentials across the composition +(`Refinement.Amortized.comp`): every queue operation costs at most nine memory units, amortized, +with six credits per rear element. `run` allocates the two stacks and then runs a queue client; +`run_correct` and `run_cost` state its result and its exact memory cost from any well-formed memory, +and `run_cost_isBigO` exports the cost as `O(m)` in the number `m` of queue operations. + +The machine-level counterpart is `Queue.WordRAM`, whose dispatcher is hand-stepped instruction by +instruction. Here the proofs mention neither registers nor instructions; executing the memory +programs on the word RAM is the separate realization step of #2205. + +## Main definitions + +* `boundedStacks`: the pair of bounded stacks. +* `Inv`: a FIFO list within capacity holding words. +* `refinement`: the two-stack queue over the pair of bounded stacks. +* `memRefinement`: the queue over two array stacks over memory. +* `run`: allocate the stacks, then run a queue client. + +## Main results + +* `amortized`: three stack calls per queue operation, with two credits per rear element. +* `mem_amortized`: nine memory units per queue operation, with six credits per rear element. +* `run_correct`, `run_cost`: the allocated queue answers like the specification and costs at + most `6 + 9 m` memory units for `m` queue operations. +* `run_cost_isBigO`: the same cost as `O(m)`. + +## References + +* [T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein, *Introduction to Algorithms*, + Exercise 10.1-6 and Chapter 17][CLRS2009] +-/ + +@[expose] public section + +namespace Cslib.DataStructure.Queue.Memory + +open Cslib.WordRAM Cslib.DataStructure Cslib.DataStructure.Memory Cslib.DataStructure.Queue + +/-- Two bounded stacks of capacity `C` at word size `w`. -/ +abbrev boundedStacks (w C : ℕ) : StateTransitionSpec := + product (Stack.WordRAM.spec w C) (Stack.WordRAM.spec w C) + +/-- A FIFO list within capacity `C` whose entries fit a `w`-bit word. -/ +structure Inv (w C : ℕ) (q : List ℕ) : Prop where + /-- The list is within capacity. -/ + length_le : q.length ≤ C + /-- Every entry fits a word. -/ + fits : ∀ x ∈ q, Fits w x + +namespace Inv + +variable {w C : ℕ} + +/-- Admissible FIFO steps keep the list within capacity and made of words. -/ +theorem step {q : List ℕ} (h : Inv w C q) {o : QueueOp ℕ} + (hv : (Queue.WordRAM.spec w C).valid q o) : Inv w C ((queue ℕ).stepFn q o).1 := by + cases o with + | enqueue n => + obtain ⟨hlen, hfit⟩ := hv + refine ⟨by simp; omega, fun x hx => ?_⟩ + simp only [List.mem_append, List.mem_singleton] at hx + rcases hx with hx | rfl + · exact h.fits x hx + · exact hfit + | dequeue => + exact ⟨by simp; have := h.length_le; omega, fun x hx => h.fits x (List.mem_of_mem_tail hx)⟩ + +end Inv + +variable {w C : ℕ} + +/-- The bounded stacks step exactly as the unbounded ones; only admissibility differs. -/ +theorem runClient_boundedStacks {β : Type} (s : List ℕ × List ℕ) (p : (stackPair ℕ).Client β) : + (boundedStacks w C).runClient s p = (stackPair ℕ).runClient s p := by + induction p generalizing s with + | pure a => rfl + | liftBind o k ih => + have hstep : (boundedStacks w C).stepFn s o = (stackPair ℕ).stepFn s o := by cases o <;> rfl + simp only [StateTransitionSpec.runClient_liftBind, hstep, ih] + +/-- Moving the rear into the front is admissible for bounded stacks when both fit together and +the rear holds words. -/ +theorem validHistory_transferTrace {front back : List ℕ} (hlen : front.length + back.length ≤ C) + (hfit : ∀ x ∈ back, Fits w x) : (boundedStacks w C).ValidHistory (front, back) (transferTrace back) := by + induction back generalizing front with + | nil => trivial + | cons a back ih => + simp only [List.length_cons] at hlen + refine ⟨trivial, ⟨by simp only; omega, hfit a (by simp)⟩, ?_⟩ + exact ih (front := a :: front) (by simp only [List.length_cons]; omega) + fun x hx => hfit x (by simp [hx]) + +/-- The two-stack queue over a pair of bounded stacks: the stacks represent `front ++ rear⁻¹`. -/ +def refinement (w C : ℕ) : Refinement (Queue.WordRAM.spec w C) (boundedStacks w C) := + Refinement.ofFn (methods (α := ℕ)) (fun s => Inv w C (Queue.WordRAM.contents s)) + Queue.WordRAM.contents + (by + rintro ⟨front, back⟩ o hs hv + have hlen := hs.length_le + simp only [Queue.WordRAM.contents, List.length_append, List.length_reverse] at hlen + cases o with + | enqueue n => + obtain ⟨hq, hfit⟩ := hv + simp only [Queue.WordRAM.contents, List.length_append, List.length_reverse] at hq + exact ⟨⟨by omega, hfit⟩, trivial⟩ + | dequeue => + cases front with + | cons a front => exact ⟨trivial, trivial⟩ + | nil => + change (boundedStacks w C).ValidHistory ([], back) + ((boundedStacks w C).runClient ([], back) (methods .dequeue)).2.2 + rw [runClient_boundedStacks, runClient_dequeue_nil] + refine ⟨trivial, trivial, ?_⟩ + rw [StateTransitionSpec.validHistory_append] + refine ⟨validHistory_transferTrace (by simpa using hlen) fun x hx => + hs.fits x (by simp [Queue.WordRAM.contents, hx]), trivial, trivial⟩) + (by + rintro ⟨front, back⟩ o hs hv + have h := stepFn_methods front back o + refine ⟨h, ?_⟩ + have hstep := hs.step hv + rw [show Queue.WordRAM.contents (front, back) = front ++ back.reverse from rfl, h] at hstep + exact hstep) + +/-- Each queue operation costs at most three stack calls, amortized, with two credits per rear +element. -/ +theorem amortized : + (refinement w C).Amortized (fun _ _ => 1) (fun _ _ => 3) fun s => 2 * s.2.length := + Refinement.Amortized.ofFn fun {s} o _ _ => by + have h := potential_step s o + rw [← runClient_boundedStacks (w := w) (C := C)] at h + rw [StateTransitionSpec.totalCost_one] + exact h + +/-! ## Over memory -/ + +/-- The queue over two array stacks over memory. -/ +def memRefinement {L₁ L₂ : Stack.Memory.Layout} (h₁ : L₁.Valid w C) (h₂ : L₂.Valid w C) + (hd : Disjoint L₁.footprint L₂.footprint) : + Refinement (Queue.WordRAM.spec w C) (Memory.spec w) := + (refinement w C).comp (Stack.Memory.pairRefinement h₁ h₂ hd) + +/-- **Stacked potentials.** Every queue operation costs at most nine memory units, amortized, +with six credits per element of the rear stack: the queue's potential, at three memory units per +stack call, read through the stacks' abstraction. -/ +theorem mem_amortized {L₁ L₂ : Stack.Memory.Layout} (h₁ : L₁.Valid w C) (h₂ : L₂.Valid w C) + (hd : Disjoint L₁.footprint L₂.footprint) : + (memRefinement h₁ h₂ hd).Amortized charge (fun _ _ => 9) + fun s => 6 * (Stack.Memory.abs L₂ s).length := by + have h := (amortized.mul_left 3).comp (Stack.Memory.pair_amortized h₁ h₂ hd) + have hΦ : (fun s : Memory.State => + 3 * (2 * (Stack.Memory.abs L₂ s).length) + 0) = + fun s => 6 * (Stack.Memory.abs L₂ s).length := by + funext s + omega + exact hΦ ▸ h + +end Cslib.DataStructure.Queue.Memory diff --git a/Complexity/DataStructure/Stack/Memory.lean b/Complexity/DataStructure/Stack/Memory.lean index b70e19923f..8f5069fe44 100644 --- a/Complexity/DataStructure/Stack/Memory.lean +++ b/Complexity/DataStructure/Stack/Memory.lean @@ -37,13 +37,15 @@ through the admissibility of `Memory.spec w`. * `push`, `pop`, `size`, `methods`: the operations as memory programs. * `abs`, `Inv`: the abstraction function and the implementation invariant. * `refinement`: the array stack as a `Refinement` of the bounded stack. -* `pairRefinement`: two array stacks with disjoint layouts implement the pair of stacks. +* `pairMethods`, `pairRefinement`: two array stacks with disjoint layouts implement the pair of + stacks. * `allocLayout`: allocate an empty stack. ## Main results * `amortized`: every operation costs at most three memory units. * `pair_amortized`: so does every operation of the pair. +* `pairRefinement_methods`: the pair's methods do not depend on the proofs about its layouts. * `modifies_methods`, `abs_congr`, `Inv.congr`: the frame of a stack. * `runClient_allocLayout_bind`, `inv_allocLayout`, `abs_allocLayout`: allocation yields an empty stack in three memory units. @@ -329,6 +331,12 @@ theorem frame {L' : Layout} (hL : L.Valid w C) (hL' : L'.Valid w C) /-! ## Two stacks in one memory -/ +/-- The operations of two stacks, each on its own layout. -/ +def pairMethods (L₁ L₂ : Layout) (w C : ℕ) : + Methods (product (Stack.WordRAM.spec w C) (Stack.WordRAM.spec w C)) (Memory.spec w) + | .inl o => methods L₁ w C o + | .inr o => methods L₂ w C o + /-- Two array stacks with disjoint layouts implement a pair of bounded stacks. -/ def pairRefinement {L₁ L₂ : Layout} (h₁ : L₁.Valid w C) (h₂ : L₂.Valid w C) (hd : Disjoint L₁.footprint L₂.footprint) : @@ -341,6 +349,13 @@ def pairRefinement {L₁ L₂ : Layout} (h₁ : L₁.Valid w C) (h₂ : L₂.Val obtain ⟨_, _, rfl, _⟩ := ((Memory.spec w).clientRun_iff_runClient _ _ _ _ _).mp hrun exact frame h₂ h₁ hd.symm hs₁ o hv) +/-- The pair's methods are `pairMethods`, whatever the proofs about the layouts. -/ +theorem pairRefinement_methods {L₁ L₂ : Layout} (h₁ : L₁.Valid w C) (h₂ : L₂.Valid w C) + (hd : Disjoint L₁.footprint L₂.footprint) : + (pairRefinement h₁ h₂ hd).methods = pairMethods L₁ L₂ w C := by + funext o + cases o <;> rfl + /-- Every operation of the pair costs at most three memory units. -/ theorem pair_amortized {L₁ L₂ : Layout} (h₁ : L₁.Valid w C) (h₂ : L₂.Valid w C) (hd : Disjoint L₁.footprint L₂.footprint) : From 7dda2489654c6b0a3a10ca4687f4147aae32e819 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 17:35:57 -0500 Subject: [PATCH 10/17] refactor(DataStructure/StateTransition): product answer types via Sum.elim With a match, the answer types of product D E mention D and E through the matcher's parameters, so the elaborator cannot identify clients of two products whose components differ only in admissibility (for example the pair of stacks and the pair of bounded stacks). Sum.elim D.Result E.Result depends only on the component answer types. Queue.Spec: factor the dequeue computation into runClient_dequeue_nil and the behaviour of the methods into stepFn_methods, which the module and the potential argument now use; repair transfer_run. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity/DataStructure/Queue/Spec.lean | 67 ++++++++++++------- Complexity/DataStructure/StateTransition.lean | 9 +-- 2 files changed, 46 insertions(+), 30 deletions(-) diff --git a/Complexity/DataStructure/Queue/Spec.lean b/Complexity/DataStructure/Queue/Spec.lean index 7a0ec18c25..0986e07b05 100644 --- a/Complexity/DataStructure/Queue/Spec.lean +++ b/Complexity/DataStructure/Queue/Spec.lean @@ -28,6 +28,8 @@ method is described in Chapter 17. ## Main results * `transfer_run`: stack operations reverse the rear contents into the front stack. +* `runClient_dequeue_nil`, `stepFn_methods`: the methods realize the FIFO step on the represented + list. * `potential_step`: at most three amortized stack calls, including the size query. * `realized_client`: every adaptive client has a correct backend execution with its bound. * `realized_client_bound`: every supplied linked execution satisfies correctness and the bound. @@ -118,10 +120,40 @@ theorem transfer_run (front back : List α) : induction back generalizing front with | nil => rfl | cons a back ih => - simpa [transfer, stackPair, stack, transferTrace, - List.reverse_cons, List.append_assoc] using congrArg - (fun r : Unit × (stackPair α).State × List (stackPair α).Op => - (r.1, r.2.1, .inr .pop :: .inl (.push a) :: r.2.2)) (ih (a :: front)) + change (let (v, s, os) := (stackPair α).runClient (a :: front, back) (transfer back.length) + (v, s, (Sum.inr StackOp.pop : (stackPair α).Op) :: Sum.inl (StackOp.push a) :: os)) = _ + rw [ih] + simp [transferTrace, List.reverse_cons, List.append_assoc] + +/-- A dequeue from an empty front stack asks for the rear size, transfers the rear, and pops the +front again. -/ +theorem runClient_dequeue_nil (back : List α) : + (stackPair α).runClient ([], back) (methods .dequeue) = + (back.reverse.head?, (back.reverse.tail, []), + .inl .pop :: .inr .size :: (transferTrace back ++ [.inl .pop])) := by + simp only [methods, bind, StateTransitionSpec.runClient_liftBind, stackPair, stack, + List.tail_nil, List.head?_nil] + rw [StateTransitionSpec.runClient_bind, transfer_run, List.append_nil] + rfl + +/-- Each method returns the FIFO answer, and the stacks then represent the FIFO successor of the +represented list. -/ +theorem stepFn_methods (front back : List α) (o : QueueOp α) : + (queue α).stepFn (front ++ back.reverse) o = + (((stackPair α).clientState (front, back) (methods o)).1 ++ + ((stackPair α).clientState (front, back) (methods o)).2.reverse, + (stackPair α).clientResult (front, back) (methods o)) := by + cases o with + | enqueue n => + change ((front ++ back.reverse) ++ [n], ()) = (front ++ (n :: back).reverse, ()) + simp [List.reverse_cons, List.append_assoc] + | dequeue => + cases front with + | cons a front => rfl + | nil => + simp only [StateTransitionSpec.clientState, StateTransitionSpec.clientResult] + rw [runClient_dequeue_nil] + simp /-- Representation and behavior are proved once, before selecting a backend or cost model. -/ def implementation : Module (queue α) (stackPair α) := @@ -134,21 +166,8 @@ def implementation : Module (queue α) (stackPair α) := intro q s o hr _ subst q obtain ⟨front, back⟩ := s - cases o with - | enqueue n => - constructor - · rfl - · change (front ++ back.reverse) ++ [n] = front ++ (n :: back).reverse - simp [List.reverse_cons, List.append_assoc] - | dequeue => - cases front with - | cons a front => exact ⟨rfl, rfl⟩ - | nil => - simp only [methods, bind, StateTransitionSpec.clientResult, - StateTransitionSpec.clientState, StateTransitionSpec.runClient_liftBind, - stackPair, stack, List.tail_nil, List.head?_nil] - rw [StateTransitionSpec.runClient_bind, transfer_run] - simp) + have h := stepFn_methods front back o + exact ⟨(congrArg Prod.snd h).symm, congrArg Prod.fst h⟩) /-- Each transferred element incurs one pop and one push. -/ theorem transferTrace_length (back : List α) : (transferTrace back).length = 2 * back.length := by @@ -173,13 +192,9 @@ theorem potential_step (s : (stackPair α).State) (o : QueueOp α) : change 1 + 2 * back.length ≤ 3 + 2 * back.length omega | nil => - simp only [methods, bind, StateTransitionSpec.runClient_liftBind, stackPair, - stack, List.tail_nil, List.head?_nil] - rw [StateTransitionSpec.runClient_bind, transfer_run] - simp only [StateTransitionSpec.runClient_liftBind, StateTransitionSpec.runClient_pure] - change (transferTrace back ++ [Sum.inl StackOp.pop]).length + 2 ≤ 3 + 2 * back.length - rw [List.length_append, transferTrace_length] - simp only [List.length_singleton] + rw [runClient_dequeue_nil] + simp only [List.length_cons, List.length_append, List.length_nil] + rw [transferTrace_length] omega private theorem weighted_potential_step (K : Nat) {q : (queue α).State} {s : (stackPair α).State} diff --git a/Complexity/DataStructure/StateTransition.lean b/Complexity/DataStructure/StateTransition.lean index 114e38b86c..8c0ae6041b 100644 --- a/Complexity/DataStructure/StateTransition.lean +++ b/Complexity/DataStructure/StateTransition.lean @@ -1098,13 +1098,14 @@ theorem eval_eq_liftM {D : StateTransitionSpec.{u, v, u}} | pure a => rfl | liftBind o k ih => exact ih (D.stepFn s o).2 (D.stepFn s o).1 -/-- Two independent abstract components. A backend must separately justify their independence. -/ +/-- Two independent abstract components. A backend must separately justify their independence. +The answer types are `Sum.elim D.Result E.Result`, so the signature of a product depends only on +the signatures of its components: clients of `product D E` are clients of `product D' E'` when +`D`, `D'` and `E`, `E'` differ only in their states' admissibility. -/ abbrev product (D E : StateTransitionSpec.{u, v, w}) : StateTransitionSpec where State := D.State × E.State Op := D.Op ⊕ E.Op - Result - | .inl o => D.Result o - | .inr o => E.Result o + Result := Sum.elim D.Result E.Result step s | .inl o, s', a => D.step s.1 o s'.1 a ∧ s'.2 = s.2 | .inr o, s', a => s'.1 = s.1 ∧ E.step s.2 o s'.2 a From 412ad374dc88c09a00992d8f8318792accd69144 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 17:42:57 -0500 Subject: [PATCH 11/17] feat(DataStructure): queue over two array stacks over the memory oracle The M1 slice of #2205. Stack.Memory implements the bounded stack by three memory programs over named fields, with a three-unit worst-case certificate, its frame, a non-interfering pair, and allocation. Queue.Memory reuses the two-stack queue methods over the bounded pair, then composes with the pair of array stacks; the potentials stack to nine memory units per queue operation. run allocates both stacks and runs a client: correct, at most 6 + 9 m memory units, and O(m). Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 2 + Complexity/DataStructure/Queue/Memory.lean | 181 ++++++++++++++++-- Complexity/DataStructure/Queue/Spec.lean | 30 --- Complexity/DataStructure/Stack/Memory.lean | 18 +- ComplexityTests/DataStructureQueueMemory.lean | 79 ++++++++ 5 files changed, 259 insertions(+), 51 deletions(-) create mode 100644 ComplexityTests/DataStructureQueueMemory.lean diff --git a/Complexity.lean b/Complexity.lean index b6a10c1394..8599d2709f 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -2902,6 +2902,7 @@ public import Complexity.DataStructure.PriorityQueue.WordRAM.FibonacciHeap.MinPQ public import Complexity.DataStructure.PriorityQueue.WordRAM.FibonacciHeap.Model public import Complexity.DataStructure.PriorityQueue.WordRAM.FibonacciHeap.Program public import Complexity.DataStructure.PriorityQueue.WordRAM.FibonacciHeap.Trees +public import Complexity.DataStructure.Queue.Memory public import Complexity.DataStructure.Queue.Spec public import Complexity.DataStructure.Queue.WordRAM.Basic public import Complexity.DataStructure.Queue.WordRAM.Dynamic @@ -2914,6 +2915,7 @@ public import Complexity.DataStructure.SearchTree.Impl public import Complexity.DataStructure.SplayTree.AccessLemma public import Complexity.DataStructure.SplayTree.Basic public import Complexity.DataStructure.SplayTree.Impl +public import Complexity.DataStructure.Stack.Memory public import Complexity.DataStructure.Stack.WordRAM.Basic public import Complexity.DataStructure.Stack.WordRAM.Controller public import Complexity.DataStructure.StateTransition diff --git a/Complexity/DataStructure/Queue/Memory.lean b/Complexity/DataStructure/Queue/Memory.lean index 28a37a7a87..d3fa6805cf 100644 --- a/Complexity/DataStructure/Queue/Memory.lean +++ b/Complexity/DataStructure/Queue/Memory.lean @@ -27,24 +27,28 @@ proved once: `memRefinement` composes them, and `mem_amortized` stacks the potentials across the composition (`Refinement.Amortized.comp`): every queue operation costs at most nine memory units, amortized, -with six credits per rear element. `run` allocates the two stacks and then runs a queue client; -`run_correct` and `run_cost` state its result and its exact memory cost from any well-formed memory, -and `run_cost_isBigO` exports the cost as `O(m)` in the number `m` of queue operations. +with six credits per rear element. `run` allocates the two stacks and then runs a queue client. +From any memory with room for both stacks, `run_correct` gives its answer and the admissibility of +its memory operations, `run_cost` bounds its memory cost by `6 + 9 m` for `m` queue operations, +and `run_cost_isBigO` exports that bound as `O(m)`. The machine-level counterpart is `Queue.WordRAM`, whose dispatcher is hand-stepped instruction by -instruction. Here the proofs mention neither registers nor instructions; executing the memory -programs on the word RAM is the separate realization step of #2205. +instruction. Here the proofs mention neither registers nor instructions. Executing the memory +programs on the word RAM is a separate, generic realization step, which this file does not +provide. ## Main definitions * `boundedStacks`: the pair of bounded stacks. * `Inv`: a FIFO list within capacity holding words. * `refinement`: the two-stack queue over the pair of bounded stacks. -* `memRefinement`: the queue over two array stacks over memory. +* `memRefinement`, `memMethods`: the queue over two array stacks over memory, and its methods as + plain memory programs. * `run`: allocate the stacks, then run a queue client. ## Main results +* `runClient_boundedStacks`: bounded stacks run clients exactly as unbounded ones. * `amortized`: three stack calls per queue operation, with two credits per rear element. * `mem_amortized`: nine memory units per queue operation, with six credits per rear element. * `run_correct`, `run_cost`: the allocated queue answers like the specification and costs at @@ -105,10 +109,29 @@ theorem runClient_boundedStacks {β : Type} (s : List ℕ × List ℕ) (p : (sta have hstep : (boundedStacks w C).stepFn s o = (stackPair ℕ).stepFn s o := by cases o <;> rfl simp only [StateTransitionSpec.runClient_liftBind, hstep, ih] +/-- The final state of a client of the bounded stacks. -/ +theorem clientState_boundedStacks {β : Type} (s : List ℕ × List ℕ) + (p : (stackPair ℕ).Client β) : + (boundedStacks w C).clientState s p = (stackPair ℕ).clientState s p := by + simp only [StateTransitionSpec.clientState, runClient_boundedStacks] + +/-- The result of a client of the bounded stacks. -/ +theorem clientResult_boundedStacks {β : Type} (s : List ℕ × List ℕ) + (p : (stackPair ℕ).Client β) : + (boundedStacks w C).clientResult s p = (stackPair ℕ).clientResult s p := by + simp only [StateTransitionSpec.clientResult, runClient_boundedStacks] + +/-- The history of a client of the bounded stacks. -/ +theorem clientHistory_boundedStacks {β : Type} (s : List ℕ × List ℕ) + (p : (stackPair ℕ).Client β) : + (boundedStacks w C).clientHistory s p = (stackPair ℕ).clientHistory s p := by + simp only [StateTransitionSpec.clientHistory, runClient_boundedStacks] + /-- Moving the rear into the front is admissible for bounded stacks when both fit together and the rear holds words. -/ theorem validHistory_transferTrace {front back : List ℕ} (hlen : front.length + back.length ≤ C) - (hfit : ∀ x ∈ back, Fits w x) : (boundedStacks w C).ValidHistory (front, back) (transferTrace back) := by + (hfit : ∀ x ∈ back, Fits w x) : + (boundedStacks w C).ValidHistory (front, back) (transferTrace back) := by induction back generalizing front with | nil => trivial | cons a back ih => @@ -129,14 +152,15 @@ def refinement (w C : ℕ) : Refinement (Queue.WordRAM.spec w C) (boundedStacks | enqueue n => obtain ⟨hq, hfit⟩ := hv simp only [Queue.WordRAM.contents, List.length_append, List.length_reverse] at hq - exact ⟨⟨by omega, hfit⟩, trivial⟩ + refine ⟨⟨?_, hfit⟩, trivial⟩ + change back.length < C + omega | dequeue => cases front with | cons a front => exact ⟨trivial, trivial⟩ | nil => - change (boundedStacks w C).ValidHistory ([], back) - ((boundedStacks w C).runClient ([], back) (methods .dequeue)).2.2 - rw [runClient_boundedStacks, runClient_dequeue_nil] + rw [clientHistory_boundedStacks, StateTransitionSpec.clientHistory, + runClient_dequeue_nil] refine ⟨trivial, trivial, ?_⟩ rw [StateTransitionSpec.validHistory_append] refine ⟨validHistory_transferTrace (by simpa using hlen) fun x hx => @@ -144,6 +168,7 @@ def refinement (w C : ℕ) : Refinement (Queue.WordRAM.spec w C) (boundedStacks (by rintro ⟨front, back⟩ o hs hv have h := stepFn_methods front back o + rw [clientState_boundedStacks, clientResult_boundedStacks] refine ⟨h, ?_⟩ have hstep := hs.step hv rw [show Queue.WordRAM.contents (front, back) = front ++ back.reverse from rfl, h] at hstep @@ -155,8 +180,10 @@ theorem amortized : (refinement w C).Amortized (fun _ _ => 1) (fun _ _ => 3) fun s => 2 * s.2.length := Refinement.Amortized.ofFn fun {s} o _ _ => by have h := potential_step s o - rw [← runClient_boundedStacks (w := w) (C := C)] at h - rw [StateTransitionSpec.totalCost_one] + change (boundedStacks w C).totalCost (fun _ _ => 1) s + ((boundedStacks w C).clientHistory s (methods o)) + + 2 * ((boundedStacks w C).clientState s (methods o)).2.length ≤ 3 + 2 * s.2.length + rw [StateTransitionSpec.totalCost_one, clientHistory_boundedStacks, clientState_boundedStacks] exact h /-! ## Over memory -/ @@ -182,4 +209,132 @@ theorem mem_amortized {L₁ L₂ : Stack.Memory.Layout} (h₁ : L₁.Valid w C) omega exact hΦ ▸ h +/-! ## Allocation and a whole run -/ + +/-- The queue methods over two array stacks, as plain memory programs. -/ +def memMethods (L₁ L₂ : Stack.Memory.Layout) (w C : ℕ) : + Methods (Queue.WordRAM.spec w C) (Memory.spec w) := + fun o => link (Stack.Memory.pairMethods L₁ L₂ w C) (methods o) + +/-- The composite's methods are `memMethods`, whatever the proofs about the layouts. -/ +theorem memRefinement_methods {L₁ L₂ : Stack.Memory.Layout} (h₁ : L₁.Valid w C) + (h₂ : L₂.Valid w C) (hd : Disjoint L₁.footprint L₂.footprint) : + (memRefinement h₁ h₂ hd).methods = memMethods L₁ L₂ w C := by + funext o + change link (Stack.Memory.pairRefinement h₁ h₂ hd).methods (methods o) = _ + rw [Stack.Memory.pairRefinement_methods] + rfl + +/-- Allocate two empty stacks of capacity `C`, then run a queue client on them. -/ +def run (w C : ℕ) {β : Type} (p : (Queue.WordRAM.spec w C).Client β) : Prog β := do + let L₁ ← Stack.Memory.allocLayout C + let L₂ ← Stack.Memory.allocLayout C + link (memMethods L₁ L₂ w C) p + +/-- The first stack allocated from `s`. -/ +abbrev frontLayout (s : Memory.State) (C : ℕ) : Stack.Memory.Layout := + ⟨⟨s.frontier, 1⟩, ⟨s.frontier + 1, C⟩⟩ + +/-- The second stack allocated from `s`. -/ +abbrev rearLayout (s : Memory.State) (C : ℕ) : Stack.Memory.Layout := + ⟨⟨s.frontier + 1 + C, 1⟩, ⟨s.frontier + 1 + C + 1, C⟩⟩ + +/-- The memory after both allocations. -/ +abbrev allocated (s : Memory.State) (C : ℕ) : Memory.State := + ⟨clear (clear s.mem s.frontier 1) (s.frontier + 1 + C) 1, s.frontier + 1 + C + 1 + C⟩ + +/-- A run allocates both stacks, then runs the linked client from the allocated memory. -/ +theorem runClient_run {β : Type} (p : (Queue.WordRAM.spec w C).Client β) (s : Memory.State) : + (Memory.spec w).runClient s (run w C p) = + let (v, s', os) := (Memory.spec w).runClient (allocated s C) + (link (memMethods (frontLayout s C) (rearLayout s C) w C) p) + (v, s', .alloc 1 :: .allocDirty C :: .alloc 1 :: .allocDirty C :: os) := rfl + +/-- The facts that start the refinement after allocation. -/ +private theorem setup (s : Memory.State) (hfit : Fits w (s.frontier + 2 * (C + 1))) : + ∃ (h₁ : (frontLayout s C).Valid w C) (h₂ : (rearLayout s C).Valid w C) + (hd : Disjoint (frontLayout s C).footprint (rearLayout s C).footprint), + (memRefinement h₁ h₂ hd).inv (allocated s C) ∧ + (memRefinement h₁ h₂ hd).abs (allocated s C) = [] ∧ + Stack.Memory.abs (rearLayout s C) (allocated s C) = [] := by + have h₁ : (frontLayout s C).Valid w C := Stack.Memory.valid_allocLayout (hfit.of_le (by omega)) + have h₂ : (rearLayout s C).Valid w C := Stack.Memory.valid_allocLayout (hfit.of_le (by omega)) + have hd : Disjoint (frontLayout s C).footprint (rearLayout s C).footprint := by + rw [Finset.disjoint_left] + intro a ha hb + simp only [Stack.Memory.Layout.footprint, Finset.mem_union, Block.mem_footprint, + Block.Owns] at ha hb + omega + -- The first stack, as allocated, before the second allocation. + obtain ⟨hi₁, ha₁⟩ := Stack.Memory.inv_allocLayout (C := C) s + -- The second stack, allocated from the state after the first. + obtain ⟨hi₂, ha₂⟩ := Stack.Memory.inv_allocLayout (C := C) + ⟨clear s.mem s.frontier 1, s.frontier + 1 + C⟩ + -- The second allocation leaves the first stack's cells alone. + have hframe : ∀ a ∈ (frontLayout s C).footprint, + (allocated s C).mem a = clear s.mem s.frontier 1 a := by + intro a ha + simp only [Stack.Memory.Layout.footprint, Finset.mem_union, Block.mem_footprint, + Block.Owns] at ha + exact clear_of_not_owns (by simp only [Block.Owns]; omega) + have hi₁' := hi₁.congr h₁ hframe (by simp only; omega) + have ha₁' := (Stack.Memory.abs_congr h₁ hi₁ hframe).trans ha₁ + refine ⟨h₁, h₂, hd, ⟨⟨hi₁', hi₂⟩, ?_⟩, ?_, ha₂⟩ + · change Inv w C (Queue.WordRAM.contents + (Stack.Memory.abs (frontLayout s C) (allocated s C), + Stack.Memory.abs (rearLayout s C) (allocated s C))) + rw [ha₁', ha₂] + exact ⟨by simp [Queue.WordRAM.contents], by simp [Queue.WordRAM.contents]⟩ + · change Queue.WordRAM.contents + (Stack.Memory.abs (frontLayout s C) (allocated s C), + Stack.Memory.abs (rearLayout s C) (allocated s C)) = [] + rw [ha₁', ha₂] + rfl + +/-- **Correctness.** From any memory with room for both stacks, an admissible queue client run +over two freshly allocated array stacks issues only admissible memory operations and returns the +specified answer. -/ +theorem run_correct {β : Type} (p : (Queue.WordRAM.spec w C).Client β) {s : Memory.State} + (hfit : Fits w (s.frontier + 2 * (C + 1))) + (hv : (Queue.WordRAM.spec w C).ValidHistory [] ((Queue.WordRAM.spec w C).clientHistory [] p)) : + (Memory.spec w).ValidHistory s ((Memory.spec w).clientHistory s (run w C p)) ∧ + (Memory.spec w).clientResult s (run w C p) = (Queue.WordRAM.spec w C).clientResult [] p := by + obtain ⟨h₁, h₂, hd, hinv, habs, -⟩ := setup s hfit + obtain ⟨hvE, hres, -, -⟩ := + (memRefinement h₁ h₂ hd).simulates_client p hinv (by rw [habs]; exact hv) + rw [memRefinement_methods] at hvE hres + simp only [StateTransitionSpec.clientHistory, StateTransitionSpec.clientResult, + runClient_run] at hvE hres ⊢ + simp only [StateTransitionSpec.validHistory_cons, StateTransitionSpec.stepFn, step_alloc, + step_allocDirty, valid_alloc, valid_allocDirty] + refine ⟨⟨hfit.of_le (by omega), hfit.of_le (by omega), hfit.of_le (by omega), + hfit.of_le (by omega), hvE⟩, hres.trans (by rw [habs])⟩ + +/-- **Cost.** The same run costs at most `6 + 9 m` memory units for a client of `m` queue +operations: six for the two allocations and nine per operation, amortized. -/ +theorem run_cost {β : Type} (p : (Queue.WordRAM.spec w C).Client β) {s : Memory.State} + (hfit : Fits w (s.frontier + 2 * (C + 1))) + (hv : (Queue.WordRAM.spec w C).ValidHistory [] ((Queue.WordRAM.spec w C).clientHistory [] p)) : + (Memory.spec w).totalCost charge s ((Memory.spec w).clientHistory s (run w C p)) ≤ + 6 + 9 * ((Queue.WordRAM.spec w C).clientHistory [] p).length := by + obtain ⟨h₁, h₂, hd, hinv, habs, hrear⟩ := setup s hfit + have h := (mem_amortized h₁ h₂ hd).client p hinv (by rw [habs]; exact hv) + rw [memRefinement_methods, habs, StateTransitionSpec.totalCost_const, hrear] at h + simp only [StateTransitionSpec.clientHistory, runClient_run, + StateTransitionSpec.totalCost_cons, charge_alloc, charge_allocDirty, + StateTransitionSpec.stepFn, step_alloc, step_allocDirty] at h ⊢ + simp only [List.length_nil, Nat.mul_zero, Nat.add_zero, allocated] at h ⊢ + omega + +/-- **The exported form.** Over admissible clients, the memory cost of a run is `O(m)` in the +number `m` of queue operations. -/ +theorem run_cost_isBigO (s : Memory.State) (hfit : Fits w (s.frontier + 2 * (C + 1))) : + CostIsBigO Filter.atTop (fun m : ℕ => (m : ℝ)) + (fun p : {p : (Queue.WordRAM.spec w C).Client Unit // + (Queue.WordRAM.spec w C).ValidHistory [] ((Queue.WordRAM.spec w C).clientHistory [] p)} => + ((Queue.WordRAM.spec w C).clientHistory [] p.1).length) + (fun p => (Memory.spec w).totalCost charge s + ((Memory.spec w).clientHistory s (run w C p.1))) := + CostIsBigO.of_le_add_mul 6 9 fun p => run_cost p.1 hfit p.2 + end Cslib.DataStructure.Queue.Memory diff --git a/Complexity/DataStructure/Queue/Spec.lean b/Complexity/DataStructure/Queue/Spec.lean index a420660819..0986e07b05 100644 --- a/Complexity/DataStructure/Queue/Spec.lean +++ b/Complexity/DataStructure/Queue/Spec.lean @@ -155,36 +155,6 @@ theorem stepFn_methods (front back : List α) (o : QueueOp α) : rw [runClient_dequeue_nil] simp -/-- A dequeue from an empty front stack asks for the rear size, transfers the rear, and pops the -front again. -/ -theorem runClient_dequeue_nil (back : List α) : - (stackPair α).runClient ([], back) (methods .dequeue) = - (back.reverse.head?, (back.reverse.tail, []), - .inl .pop :: .inr .size :: (transferTrace back ++ [.inl .pop])) := by - simp only [methods, bind, StateTransitionSpec.runClient_liftBind, stackPair, stack, - List.tail_nil, List.head?_nil] - rw [StateTransitionSpec.runClient_bind, transfer_run] - simp - -/-- Each method returns the FIFO answer, and the stacks then represent the FIFO successor of the -represented list. -/ -theorem stepFn_methods (front back : List α) (o : QueueOp α) : - (queue α).stepFn (front ++ back.reverse) o = - (((stackPair α).clientState (front, back) (methods o)).1 ++ - ((stackPair α).clientState (front, back) (methods o)).2.reverse, - (stackPair α).clientResult (front, back) (methods o)) := by - cases o with - | enqueue n => - change ((front ++ back.reverse) ++ [n], ()) = (front ++ (n :: back).reverse, ()) - simp [List.reverse_cons, List.append_assoc] - | dequeue => - cases front with - | cons a front => rfl - | nil => - simp only [StateTransitionSpec.clientState, StateTransitionSpec.clientResult] - rw [runClient_dequeue_nil] - simp - /-- Representation and behavior are proved once, before selecting a backend or cost model. -/ def implementation : Module (queue α) (stackPair α) := Module.ofFn diff --git a/Complexity/DataStructure/Stack/Memory.lean b/Complexity/DataStructure/Stack/Memory.lean index 8f5069fe44..cf79d42258 100644 --- a/Complexity/DataStructure/Stack/Memory.lean +++ b/Complexity/DataStructure/Stack/Memory.lean @@ -17,9 +17,9 @@ public import Complexity.DataStructure.Stack.WordRAM.Basic The bounded stack `Stack.WordRAM.spec w C` is implemented by three short programs over `Memory.spec w`. The storage is a `Layout` with two named fields: a one-cell `count` and an `items` array of `C` cells, bottom first. The abstraction function reads the first `count` items -and reverses them, so the top comes first. Each operation is one read, two writes at most, and a -single branch; its evaluation is definitional (`runClient_push`, `runClient_pop_of_pos`, …), and -the refinement obligations follow from those equations and the list view of the array. +and reverses them, so the top comes first. Each operation is at most three memory operations and +one branch. Its evaluation is definitional (`runClient_push`, `runClient_pop_of_pos`, …), and the +refinement obligations follow from those equations and the list view of the array. Every operation costs at most three memory units, with no potential (`amortized`). The methods write only the layout's cells and never allocate (`modifies_methods`), and the abstraction and @@ -27,8 +27,8 @@ invariant depend only on those cells (`abs_congr`, `Inv.congr`). Two stacks with layouts therefore implement the product of two stacks (`pairRefinement`). This is the same specification that `Stack.WordRAM` implements by a hand-stepped nine-register -dispatcher. Here no register, instruction count or word-fit chain appears; fits enter only -through the admissibility of `Memory.spec w`. +dispatcher. Here no register or instruction count appears. Word fit enters only through the +admissibility of `Memory.spec w` and one static fact of the layout, that the capacity fits. ## Main definitions @@ -46,9 +46,11 @@ through the admissibility of `Memory.spec w`. * `amortized`: every operation costs at most three memory units. * `pair_amortized`: so does every operation of the pair. * `pairRefinement_methods`: the pair's methods do not depend on the proofs about its layouts. -* `modifies_methods`, `abs_congr`, `Inv.congr`: the frame of a stack. -* `runClient_allocLayout_bind`, `inv_allocLayout`, `abs_allocLayout`: allocation yields an empty - stack in three memory units. +* `runClient_push`, `runClient_pop_of_eq_zero`, `runClient_pop_of_pos`, `runClient_size`: the + operations evaluate definitionally. +* `modifies_methods`, `abs_congr`, `Inv.congr`, `frame`: the frame of a stack. +* `runClient_allocLayout_bind`, `valid_allocLayout`, `inv_allocLayout`: allocation yields a + well-formed empty stack in three memory units. ## References diff --git a/ComplexityTests/DataStructureQueueMemory.lean b/ComplexityTests/DataStructureQueueMemory.lean new file mode 100644 index 0000000000..93a8793360 --- /dev/null +++ b/ComplexityTests/DataStructureQueueMemory.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: local-only (test driver) + +public import Complexity.DataStructure.Queue.Memory + +/-! +# A queue over two array stacks, run on concrete memory + +A client enqueues three words and dequeues four times; the third dequeue empties the rear stack +into the front. The run allocates both stacks in empty memory at word size `8` with capacity `3`. +The tests check its answers against the queue specification, its exact memory cost against the +proved bound `6 + 9 m`, the admissibility of every memory operation, and that the general +theorems apply: their room and admissibility hypotheses hold here. +-/ + +@[expose] public section + +namespace ComplexityTests.DataStructureQueueMemory + +open Cslib.WordRAM Cslib.DataStructure Cslib.DataStructure.Memory Cslib.DataStructure.Queue + Cslib.DataStructure.Queue.Memory + +/-- Enqueue `1, 2`, dequeue, enqueue `3`, then dequeue three times. -/ +def client : (Queue.WordRAM.spec 8 3).Client (List (Option ℕ)) := do + (Queue.WordRAM.spec 8 3).call (.enqueue 1) + (Queue.WordRAM.spec 8 3).call (.enqueue 2) + let a ← (Queue.WordRAM.spec 8 3).call .dequeue + (Queue.WordRAM.spec 8 3).call (.enqueue 3) + let b ← (Queue.WordRAM.spec 8 3).call .dequeue + let c ← (Queue.WordRAM.spec 8 3).call .dequeue + let d ← (Queue.WordRAM.spec 8 3).call .dequeue + pure [a, b, c, d] + +/-- Empty memory with nothing allocated. -/ +def empty : State := ⟨fun _ => 0, 0⟩ + +/-- FIFO answers, and an empty queue at the end. -/ +example : (Queue.WordRAM.spec 8 3).clientResult [] client = [some 1, some 2, some 3, none] := by + decide + +/-- The run over memory gives the same answers. -/ +example : (spec 8).clientResult empty (run 8 3 client) = [some 1, some 2, some 3, none] := by + decide + +/-- Its exact memory cost: 6 for the allocations and 43 for the seven queue operations, against +the proved bound `6 + 9 · 7 = 69`. The dequeue that moves two elements costs 17 alone. -/ +example : (spec 8).totalCost charge empty ((spec 8).clientHistory empty (run 8 3 client)) = 49 := by + decide + +/-- Every memory operation of the run is admissible. -/ +example : (spec 8).ValidHistory empty ((spec 8).clientHistory empty (run 8 3 client)) := by + decide + +/-- The client is admissible for the bounded queue. -/ +theorem client_valid : + (Queue.WordRAM.spec 8 3).ValidHistory [] ((Queue.WordRAM.spec 8 3).clientHistory [] client) := + ⟨⟨by decide, by decide⟩, ⟨by decide, by decide⟩, trivial, ⟨by decide, by decide⟩, trivial, + trivial, trivial, trivial⟩ + +/-- The general theorems apply: empty memory has room for both stacks at this word size. -/ +theorem room : Fits 8 (empty.frontier + 2 * (3 + 1)) := by decide + +example : (spec 8).clientResult empty (run 8 3 client) = + (Queue.WordRAM.spec 8 3).clientResult [] client := + (run_correct client room client_valid).2 + +example : (spec 8).totalCost charge empty ((spec 8).clientHistory empty (run 8 3 client)) ≤ 69 := + run_cost client room client_valid + +/-- A memory with too little room: the second stack would end past the 4-bit word range. -/ +example : ¬Fits 4 (empty.frontier + 2 * (7 + 1)) := by decide + +end ComplexityTests.DataStructureQueueMemory From 43ca605529a4654b6c9cea6268a4f38b7d80991e Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 18:57:03 -0500 Subject: [PATCH 12/17] feat(DataStructure): distributional refinements and a random table over memory `RandomizedSpec` gives each operation a law, a stateful `PMF` handler. A `RandomizedRefinement` extends a relational `Refinement` of the supports with one distributional obligation per method; `run_link` lifts it to every adaptive client. The identical-until-bad step reuses `OracleComp.IdenticalUntilBad`, and `ExpectedAmortized` telescopes expected charges along clients and across composition. `withCoins` adds private coins (`ProbOracleComp`) to a lower interface. Pilot: a random table stored in a field array over `Memory.spec w` with coins refines the seed-level hash-family spec `HashFamily.seedSpec`; its run from allocation has transcript law `HashFamily.evalOps` (decision D10 of #2205). Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 3 + .../DataStructure/HashFamily/Memory.lean | 356 +++++++++++ .../DataStructure/HashFamily/Randomized.lean | 97 +++ .../StateTransition/Randomized.lean | 573 ++++++++++++++++++ ComplexityTests/HashFamilyMemory.lean | 86 +++ 5 files changed, 1115 insertions(+) create mode 100644 Complexity/DataStructure/HashFamily/Memory.lean create mode 100644 Complexity/DataStructure/HashFamily/Randomized.lean create mode 100644 Complexity/DataStructure/StateTransition/Randomized.lean create mode 100644 ComplexityTests/HashFamilyMemory.lean diff --git a/Complexity.lean b/Complexity.lean index 8599d2709f..6b738e35aa 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -2867,6 +2867,8 @@ public import Complexity.DataStructure.FusionTree.WordRAM.Rank public import Complexity.DataStructure.FusionTree.WordRAM.ReadHeader public import Complexity.DataStructure.FusionTree.WordRAM.Static public import Complexity.DataStructure.FusionTree.XorCorrection +public import Complexity.DataStructure.HashFamily.Memory +public import Complexity.DataStructure.HashFamily.Randomized public import Complexity.DataStructure.HashFamily.Spec public import Complexity.DataStructure.HashFamily.WordRAM.Basic public import Complexity.DataStructure.HashFamily.WordRAM.DoubleTabulation @@ -2925,6 +2927,7 @@ public import Complexity.DataStructure.StateTransition.CostHoare public import Complexity.DataStructure.StateTransition.Hoare public import Complexity.DataStructure.StateTransition.Impl public import Complexity.DataStructure.StateTransition.Module +public import Complexity.DataStructure.StateTransition.Randomized public import Complexity.DataStructure.StateTransition.Refinement public import Complexity.DataStructure.StateTransition.Resource public import Complexity.DataStructure.VanEmdeBoas.Basic diff --git a/Complexity/DataStructure/HashFamily/Memory.lean b/Complexity/DataStructure/HashFamily/Memory.lean new file mode 100644 index 0000000000..760c81cdf8 --- /dev/null +++ b/Complexity/DataStructure/HashFamily/Memory.lean @@ -0,0 +1,356 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.DataStructure.HashFamily.Randomized +public import Complexity.DataStructure.Memory.Field +import Complexity.Probability.Product + +/-! +# A random table over the memory oracle + +A uniformly random function `Fin U → Fin (2 ^ b)` is the simplest resamplable hash family: its +seed is the whole table. Here it is stored in a field array `table` of `U` cells, behind the +memory oracle with private coins, `(Memory.spec w).toRandomized.withCoins`. `resample` refills the +table with one uniform `b`-bit draw and one write per cell (`fill`), and `eval u` reads cell `u`. + +The abstraction function reads the table as a function (`tableOf`). The implementation is a +`RandomizedRefinement` of the seed-level specification `tableSpec U b` (`refinement`): the only +probabilistic fact is that independent uniform draws fill a uniform table (`run_fill`, +`tableOf_writeFrom`). The generic hop then gives the law of every adaptive client, and the run +from allocation (`run`) has the transcript law `HashFamily.evalOps` on every operation list +(`run_obliviousClient`). This is the memory-level counterpart of +`HashFamily.WordRAM.Impl.evalOps_execSteps`, with no register, instruction count or `ExecSteps` +bookkeeping. Every operation makes at most `2 * U` calls, and `eval` exactly one +(`isCostBounded_methods`, `expectedAmortized`, `isQueryBounded_run`). + +## Main definitions + +* `Cslib.DataStructure.HashFamily.RandomTable.tableSpec`: the random function as a seed-level + specification. +* `Cslib.DataStructure.HashFamily.RandomTable.fill`, `methods`: the operations over memory with + coins. +* `Cslib.DataStructure.HashFamily.RandomTable.tableOf`, `writeFrom`: the abstraction function, and + the memory after a fill. +* `Cslib.DataStructure.HashFamily.RandomTable.refinement`: the distributional refinement. +* `Cslib.DataStructure.HashFamily.RandomTable.run`: allocate, fill, then serve a client. + +## Main results + +* `Cslib.DataStructure.HashFamily.RandomTable.run_fill`: a fill writes a uniform table. +* `Cslib.DataStructure.HashFamily.RandomTable.run_eq`: the law of a client run from allocation. +* `Cslib.DataStructure.HashFamily.RandomTable.run_obliviousClient`: its oblivious transcripts are + `evalOps`. +* `Cslib.DataStructure.HashFamily.RandomTable.demonicValid_run`: every memory call is admissible. +* `Cslib.DataStructure.HashFamily.RandomTable.expectedAmortized`, + `Cslib.DataStructure.HashFamily.RandomTable.isQueryBounded_run`: call counts. + +## References + +* [J. L. Carter, M. N. Wegman, *Universal classes of hash functions*][CarterWegman1979] +-/ + +@[expose] public section + +namespace Cslib.DataStructure.HashFamily.RandomTable + +open Cslib.WordRAM Cslib.DataStructure + +/-- The uniformly random function `Fin U → Fin (2 ^ b)` as a resamplable hash family. -/ +noncomputable abbrev tableSpec (U b : ℕ) : RandomizedSpec := + seedSpec (Probability.PMF.uniformOfFintype (Fin U → Fin (2 ^ b))) fun θ u => θ u + +variable (table : Block) (b : ℕ) + +/-- The table stored in the field `table`: cell `u` read as a `b`-bit word. -/ +def tableOf (U : ℕ) (s : Memory.State) : Fin U → Fin (2 ^ b) := + fun u => Fin.ofNat (2 ^ b) (s.mem (table.base + u)) + +/-- Fill cells `i, …, i + n - 1` of the table with independent uniform `b`-bit words, one draw and +one write per cell. -/ +noncomputable def fill : ℕ → ℕ → ProbOracleComp Memory.Op.Result Unit + | _, 0 => pure () + | i, n + 1 => do + let x ← ProbOracleComp.sample (ProbComp.uniform (Fin (2 ^ b))) + OracleComp.liftRight (table.set i x.val) + fill (i + 1) n + +/-- The operations: `resample` refills the table, and `eval u` reads cell `u`. -/ +noncomputable def methods (U : ℕ) : + (o : HashFamily.Op U) → ProbOracleComp Memory.Op.Result (HashFamily.Result (2 ^ b) o) + | .resample => fill table b 0 U + | .eval u => OracleComp.liftRight (Fin.ofNat (2 ^ b) <$> table.get u) + +/-- The memory after writing `θ j` to cell `i + j` of the table for each `j < n`, in order. -/ +def writeFrom : (i n : ℕ) → (Fin n → Fin (2 ^ b)) → Memory.State → Memory.State + | _, 0, _, s => s + | i, n + 1, θ, s => + writeFrom (i + 1) n (Fin.tail θ) ⟨Function.update s.mem (table.base + i) (θ 0), s.frontier⟩ + +/-! ## The memory after a fill -/ + +variable {table b} + +@[simp] theorem frontier_writeFrom (i n : ℕ) (θ : Fin n → Fin (2 ^ b)) (s : Memory.State) : + (writeFrom table b i n θ s).frontier = s.frontier := by + induction n generalizing i s with + | zero => rfl + | succ n ih => exact ih _ _ _ + +/-- Cells below the first written cell are unchanged. -/ +theorem mem_writeFrom_of_lt (i n : ℕ) (θ : Fin n → Fin (2 ^ b)) (s : Memory.State) {a : ℕ} + (ha : a < table.base + i) : (writeFrom table b i n θ s).mem a = s.mem a := by + induction n generalizing i s with + | zero => rfl + | succ n ih => + rw [writeFrom, ih _ _ _ (by omega)] + exact Function.update_of_ne (by omega) _ _ + +/-- Cell `i + j` holds the `j`-th written word. -/ +theorem mem_writeFrom (i n : ℕ) (θ : Fin n → Fin (2 ^ b)) (s : Memory.State) (j : Fin n) : + (writeFrom table b i n θ s).mem (table.base + (i + j)) = θ j := by + induction n generalizing i s with + | zero => exact j.elim0 + | succ n ih => + rw [writeFrom] + refine Fin.cases ?_ (fun j => ?_) j + · rw [mem_writeFrom_of_lt _ _ _ _ (by simp)] + simp + · rw [show table.base + (i + (j.succ : ℕ)) = table.base + (i + 1 + j) by simp; omega, ih] + rfl + +/-- A full fill stores the written table. -/ +theorem tableOf_writeFrom {U : ℕ} (θ : Fin U → Fin (2 ^ b)) (s : Memory.State) : + tableOf table b U (writeFrom table b 0 U θ s) = θ := by + funext u + have h := mem_writeFrom (table := table) 0 U θ s u + rw [Nat.zero_add] at h + simp [tableOf, h] + +/-! ## Evaluation -/ + +variable {w : ℕ} + +/-- **A fill writes a uniform table.** -/ +theorem run_fill (i n : ℕ) (s : Memory.State) : + ((Memory.spec w).toRandomized.withCoins.run (fill table b i n) s).map Prod.snd = + (Probability.PMF.uniformOfFintype (Fin n → Fin (2 ^ b))).map fun θ => + writeFrom table b i n θ s := by + induction n generalizing i s with + | zero => + change (PMF.pure ((), s)).map Prod.snd = _ + rw [PMF.pure_map] + exact (PMF.map_const _ _).symm + | succ n ih => + change ((Memory.spec w).toRandomized.withCoins.run + (ProbOracleComp.sample (ProbComp.uniform (Fin (2 ^ b))) >>= fun x => + OracleComp.liftRight (table.set i x.val) >>= fun _ => fill table b (i + 1) n) s).map + Prod.snd = _ + rw [RandomizedSpec.run_bind, RandomizedSpec.withCoins_run_sample, ProbComp.eval_uniform, + PMF.bind_map, PMF.map_bind, + ← Probability.PMF.pi_uniformOfFintype (α := fun _ : Fin (n + 1) => Fin (2 ^ b)), + Probability.PMF.pi_fin_succ, Probability.PMF.pi_uniformOfFintype, PMF.map_bind] + refine congrArg (Probability.PMF.uniformOfFintype (Fin (2 ^ b))).bind (funext fun x => ?_) + rw [Function.comp_apply] + dsimp only + rw [RandomizedSpec.run_bind, RandomizedSpec.withCoins_run_liftRight, + StateTransitionSpec.run_toRandomized, PMF.pure_bind, ih, PMF.map_comp] + rfl + +/-- Reading a cell answers the stored word and leaves memory unchanged. -/ +theorem run_methods_eval {U : ℕ} (u : Fin U) (s : Memory.State) : + (Memory.spec w).toRandomized.withCoins.run (methods table b U (.eval u)) s = + PMF.pure (tableOf table b U s u, s) := by + rw [methods, RandomizedSpec.withCoins_run_liftRight, StateTransitionSpec.run_toRandomized] + rfl + +/-! ## Admissibility -/ + +/-- Every call of a fill within an allocated table is admissible when `b`-bit words fit. -/ +theorem demonicValid_fill (hb : b ≤ w) {i n : ℕ} (hn : i + n ≤ table.length) + {s : Memory.State} (hs : table.Allocated s) : + (Memory.spec w).toRandomized.withCoins.toSpec.DemonicValid s (fill table b i n) := by + induction n generalizing i s with + | zero => exact StateTransitionSpec.DemonicValid.pure _ _ + | succ n ih => + refine RandomizedSpec.demonicValid_sample_bind fun x => ?_ + have hfit : Fits w x.val := + fits_iff.mpr (lt_of_lt_of_le x.2 (Nat.pow_le_pow_right (by omega) hb)) + refine StateTransitionSpec.DemonicValid.liftBind + (D := (Memory.spec w).toRandomized.withCoins.toSpec) + (Sum.inr (Memory.Op.write (table.base + i) x.val)) (fun _ => fill table b (i + 1) n) + ⟨hs.lt_frontier (by omega), hfit⟩ fun s' a hstep => ?_ + obtain ⟨-, rfl⟩ := Prod.ext_iff.mp ((PMF.mem_support_pure_iff _ _).mp hstep) + exact ih (by omega) hs + +/-! ## The refinement -/ + +variable (table b) in +/-- **The random table refines the random function.** From an allocated table of `U` cells, +`resample` draws a uniform table and `eval u` answers its entry `u`. -/ +noncomputable def refinement {U : ℕ} (hlen : table.length = U) (hb : b ≤ w) : + RandomizedRefinement (tableSpec U b) (Memory.spec w).toRandomized.withCoins := + .ofLaw (methods table b U) table.Allocated (tableOf table b U) + (fun {s} o hs _ => by + cases o with + | resample => exact demonicValid_fill hb (by omega) hs + | eval u => + exact RandomizedSpec.demonicValid_liftRight + (StateTransitionSpec.toRandomized_demonicValid_of_validHistory + ⟨hs.lt_frontier (by omega), trivial⟩)) + (fun {s} o hs _ a s' h => by + cases o with + | resample => + have h' : s' ∈ (((Memory.spec w).toRandomized.withCoins.run + (fill table b 0 U) s).map Prod.snd).support := + (PMF.mem_support_map_iff _ _ _).mpr ⟨(a, s'), h, rfl⟩ + rw [run_fill] at h' + obtain ⟨θ, -, rfl⟩ := (PMF.mem_support_map_iff _ _ _).mp h' + exact hs.mono (le_of_eq (frontier_writeFrom _ _ _ _).symm) + | eval u => + rw [run_methods_eval, PMF.mem_support_pure_iff] at h + obtain ⟨-, rfl⟩ := Prod.ext_iff.mp h + exact hs) + (fun {s} o _ _ => by + cases o with + | resample => + calc _ = (((Memory.spec w).toRandomized.withCoins.run (fill table b 0 U) s).map + Prod.snd).map fun s' => (PUnit.unit, tableOf table b U s') := by + rw [PMF.map_comp] + rfl + _ = _ := by + rw [run_fill, PMF.map_comp] + simp only [Function.comp_def, tableOf_writeFrom] + | eval u => + rw [run_methods_eval, PMF.pure_map]) + +/-! ## Costs -/ + +variable (U : ℕ) in +/-- One unit per call: `resample` makes one draw and one write per cell, `eval` one read. -/ +def budget : HashFamily.Op U → ℕ + | .resample => 2 * U + | .eval _ => 1 + +/-- A fill of `n` cells makes `2 * n` calls. -/ +theorem isQueryBounded_fill (i n : ℕ) : OracleComp.IsQueryBounded (fill table b i n) (2 * n) := by + induction n generalizing i with + | zero => exact .pure _ _ + | succ n ih => + have hsample : OracleComp.IsQueryBounded + (ProbOracleComp.sample (spec := Memory.Op.Result) (ProbComp.uniform (Fin (2 ^ b)))) 1 := by + rw [ProbComp.uniform, ProbOracleComp.sample_map] + exact (OracleComp.isCostBounded_map_iff _ _ _).mpr (OracleComp.IsCostBounded.query _) + have hwrite (x : ℕ) : OracleComp.IsQueryBounded + (OracleComp.liftRight (spec₁ := unifSpec) (table.set i x)) 1 := + OracleComp.IsCostBounded.query (spec := probOracleSpec Memory.Op.Result) _ + have h := hsample.bind fun x => (hwrite x.val).bind fun _ => ih (i + 1) + exact h.mono (by omega) + +/-- Every operation makes at most its budget of calls. -/ +theorem isCostBounded_methods {U : ℕ} (o : HashFamily.Op U) : + OracleComp.IsQueryBounded (methods table b U o) (budget U o) := by + cases o with + | resample => exact isQueryBounded_fill 0 U + | eval u => + change OracleComp.IsQueryBounded + (PFunctor.FreeM.liftBind (P := ⟨ℕ ⊕ Memory.Op, probOracleSpec Memory.Op.Result⟩) + (Sum.inr (Memory.Op.read _)) fun v => pure (Fin.ofNat (2 ^ b) v)) 1 + exact OracleComp.IsCostBounded.liftBind_iff.mpr ⟨le_rfl, fun _ => .pure _ _⟩ + +/-- In expectation as well, every operation costs at most its budget of calls. -/ +theorem expectedAmortized {U : ℕ} (hlen : table.length = U) (hb : b ≤ w) : + (refinement table b hlen hb).ExpectedAmortized (fun _ _ => 1) (fun _ o => budget U o) + fun _ => 0 := + .of_isCostBounded isCostBounded_methods + +/-! ## The run from allocation -/ + +variable (b) in +/-- Allocate a table of `U` cells, fill it, then serve the client `p`. -/ +noncomputable def run (U : ℕ) {α : Type} (p : OracleComp (HashFamily.Result (U := U) (2 ^ b)) α) : + ProbOracleComp Memory.Op.Result α := do + let table ← OracleComp.liftRight (Memory.allocBlockDirty U) + OracleComp.interpret (methods table b U) + (OracleComp.query (.resample : HashFamily.Op U) >>= fun _ => p) + +theorem run_eq_link {U : ℕ} {α : Type} (p : OracleComp (HashFamily.Result (U := U) (2 ^ b)) α) + (s : Memory.State) (hlen : (⟨s.frontier, U⟩ : Block).length = U) (hb : b ≤ w) : + (Memory.spec w).toRandomized.withCoins.run (run b U p) s = + (Memory.spec w).toRandomized.withCoins.run + (link (refinement ⟨s.frontier, U⟩ b hlen hb).methods + (OracleComp.query (.resample : HashFamily.Op U) >>= fun _ => p)) + ⟨s.mem, s.frontier + U⟩ := by + rw [run, RandomizedSpec.run_bind, RandomizedSpec.withCoins_run_liftRight, + StateTransitionSpec.run_toRandomized, PMF.pure_bind] + rfl + +/-- **The law of a client run from allocation**: a uniform table, then the client against the +random function. -/ +theorem run_eq (hb : b ≤ w) {U : ℕ} {α : Type} + (p : OracleComp (HashFamily.Result (U := U) (2 ^ b)) α) (s : Memory.State) : + ((Memory.spec w).toRandomized.withCoins.run (run b U p) s).map Prod.fst = + (Probability.PMF.uniformOfFintype (Fin U → Fin (2 ^ b))).bind fun θ => + ((tableSpec U b).run p θ).map Prod.fst := by + have hlen : (⟨s.frontier, U⟩ : Block).length = U := rfl + let M := refinement ⟨s.frontier, U⟩ b hlen hb + have hlaw := M.run_link (OracleComp.query (.resample : HashFamily.Op U) >>= fun _ => p) + (e := ⟨s.mem, s.frontier + U⟩) le_rfl + ((tableSpec U b).toSpec.demonicValid_of_forall_valid (fun _ _ => trivial) _ _) + rw [run_eq_link p s hlen hb] + calc _ = (((Memory.spec w).toRandomized.withCoins.run + (link M.methods (OracleComp.query (.resample : HashFamily.Op U) >>= fun _ => p)) + ⟨s.mem, s.frontier + U⟩).map fun (a, e') => (a, M.abs e')).map Prod.fst := by + rw [PMF.map_comp] + rfl + _ = _ := by rw [hlaw, run_resample_bind_seedSpec, PMF.map_bind] + +/-- **The memory-level `evalOps` theorem.** From any memory state, the transcript law of the +oblivious client of `ops`, run after allocating and filling the table, is +`HashFamily.evalOps` of the random function. -/ +theorem run_obliviousClient (hb : b ≤ w) {U : ℕ} (ops : List (HashFamily.Op U)) + (s : Memory.State) : + ((Memory.spec w).toRandomized.withCoins.run + (run b U ((tableSpec U b).obliviousClient ops)) s).map Prod.fst = + HashFamily.evalOps (Probability.PMF.uniformOfFintype (Fin U → Fin (2 ^ b))) + (fun θ u => θ u) ops := by + rw [run_eq hb, HashFamily.evalOps] + exact congrArg _ (funext fun θ => run_obliviousClient_seedSpec _ _ θ ops) + +/-- Every memory call of the run is admissible when the table and `b`-bit words fit. -/ +theorem demonicValid_run (hb : b ≤ w) {U : ℕ} {α : Type} + (p : OracleComp (HashFamily.Result (U := U) (2 ^ b)) α) {s : Memory.State} + (hfit : Fits w (s.frontier + U)) : + (Memory.spec w).toRandomized.withCoins.toSpec.DemonicValid s (run b U p) := by + have hlen : (⟨s.frontier, U⟩ : Block).length = U := rfl + let M := refinement ⟨s.frontier, U⟩ b hlen hb + refine StateTransitionSpec.DemonicValid.liftBind + (D := (Memory.spec w).toRandomized.withCoins.toSpec) + (Sum.inr (Memory.Op.allocDirty U)) _ hfit fun s' a hstep => ?_ + obtain ⟨rfl, rfl⟩ := Prod.ext_iff.mp ((PMF.mem_support_pure_iff _ _).mp hstep) + exact (M.toRefinement.simulates_demonic _ (e := ⟨s.mem, s.frontier + U⟩) le_rfl + ((tableSpec U b).toSpec.demonicValid_of_forall_valid (fun _ _ => trivial) _ _)).1 + +/-- A client whose operations cost at most `n` in total, with `budget U`, runs from allocation +with at most `1 + 2 * U + n` calls. -/ +theorem isQueryBounded_run {U : ℕ} {α : Type} + {p : OracleComp (HashFamily.Result (U := U) (2 ^ b)) α} {n : ℕ} + (hp : OracleComp.IsCostBounded (budget U) p n) : + OracleComp.IsQueryBounded (run b U p) (1 + 2 * U + n) := by + have halloc : OracleComp.IsQueryBounded + (OracleComp.liftRight (spec₁ := unifSpec) (Memory.allocBlockDirty U)) 1 := by + change OracleComp.IsQueryBounded + (PFunctor.FreeM.liftBind (P := ⟨ℕ ⊕ Memory.Op, probOracleSpec Memory.Op.Result⟩) + (Sum.inr (Memory.Op.allocDirty U)) fun base => pure (⟨base, U⟩ : Block)) 1 + exact OracleComp.IsCostBounded.liftBind_iff.mpr ⟨le_rfl, fun _ => .pure _ _⟩ + have h := halloc.bind fun table => OracleComp.IsCostBounded.interpret + (isCostBounded_methods (table := table) (b := b)) + ((OracleComp.IsCostBounded.query (cost := budget U) .resample).bind fun _ => hp) + simpa [run, budget, Nat.add_assoc] using h + +end Cslib.DataStructure.HashFamily.RandomTable diff --git a/Complexity/DataStructure/HashFamily/Randomized.lean b/Complexity/DataStructure/HashFamily/Randomized.lean new file mode 100644 index 0000000000..da9db90caa --- /dev/null +++ b/Complexity/DataStructure/HashFamily/Randomized.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.DataStructure.HashFamily.Spec +public import Complexity.DataStructure.StateTransition.Randomized + +/-! +# Resamplable hash families as randomized specifications + +`HashFamily.seedSpec seedLaw eval` is the seed-level model of a resamplable hash family as a +`RandomizedSpec`. Its state is the current seed: `resample` draws a fresh seed from `seedLaw`, and +`eval u` answers `eval θ u` at the seed `θ`. On the oblivious client of an operation list it is +`evalOpsFromSeed` (`run_obliviousClient_seedSpec`), and after an initial resample it is `evalOps` +(`run_resample_obliviousClient_seedSpec`). An implementation that refines `seedSpec` by a +`RandomizedRefinement` therefore meets every contract proved for `evalOps`, such as +`kWiseSpec_contract_evalOps`, and its adaptive clients are described by `seedSpec` as well. + +## Main definitions + +* `Cslib.DataStructure.HashFamily.seedSpec`: the seed-level randomized specification. + +## Main results + +* `Cslib.DataStructure.HashFamily.run_obliviousClient_seedSpec`: oblivious transcripts from a + fixed seed are `evalOpsFromSeed`. +* `Cslib.DataStructure.HashFamily.run_resample_bind_seedSpec`, + `Cslib.DataStructure.HashFamily.run_resample_obliviousClient_seedSpec`: after an initial + resample, a client runs from a fresh seed, and oblivious transcripts are `evalOps`. +-/ + +@[expose] public section + +namespace Cslib.DataStructure.HashFamily + +variable {Seed : Type} {U m : ℕ} (seedLaw : PMF Seed) (eval : Seed → Fin U → Fin m) + +/-- The seed-level model of a resamplable hash family: the state is the current seed, `resample` +draws a fresh seed from `seedLaw`, and `eval u` answers `eval θ u` without changing the seed. -/ +noncomputable abbrev seedSpec : RandomizedSpec where + State := Seed + Op := HashFamily.Op U + Result := HashFamily.Result m + law + | .resample => fun _ => seedLaw.map fun θ => (PUnit.unit, θ) + | .eval u => fun θ => PMF.pure (eval θ u, θ) + +/-- Running the oblivious client of `ops` from the seed `θ` gives the transcript law +`evalOpsFromSeed`. -/ +theorem run_obliviousClient_seedSpec (θ : Seed) (ops : List (HashFamily.Op U)) : + ((seedSpec seedLaw eval).run ((seedSpec seedLaw eval).obliviousClient ops) θ).map Prod.fst = + evalOpsFromSeed seedLaw eval θ ops := by + induction ops generalizing θ with + | nil => exact PMF.pure_map Prod.fst ([], θ) + | cons o rest ih => + rw [RandomizedSpec.obliviousClient_cons, RandomizedSpec.run_liftBind] + cases o with + | eval u => + change ((PMF.pure (eval θ u, θ)).bind _).map Prod.fst = _ + rw [PMF.pure_bind] + dsimp only + rw [RandomizedSpec.run_map, PMF.map_comp, evalOpsFromSeed, ← ih θ, PMF.map_comp] + rfl + | resample => + change (((seedLaw.map fun θ' => (PUnit.unit, θ')).bind _).map Prod.fst) = _ + rw [PMF.bind_map, PMF.map_bind, evalOpsFromSeed] + refine congrArg seedLaw.bind (funext fun θ' => ?_) + rw [Function.comp_apply] + dsimp only + rw [RandomizedSpec.run_map, PMF.map_comp, ← ih θ', PMF.map_comp] + rfl + +/-- After an initial resample, a client runs from a fresh seed drawn from `seedLaw`. -/ +theorem run_resample_bind_seedSpec {α : Type} (θ : Seed) + (p : OracleComp (HashFamily.Result (U := U) m) α) : + (seedSpec seedLaw eval).run (OracleComp.query (.resample : HashFamily.Op U) >>= fun _ => p) θ = + seedLaw.bind fun θ' => (seedSpec seedLaw eval).run p θ' := by + rw [RandomizedSpec.run_bind] + change ((((seedLaw.map fun θ' => (PUnit.unit, θ')).bind fun x => PMF.pure x)).bind _) = _ + rw [PMF.bind_pure, PMF.bind_map] + rfl + +/-- After an initial resample, the transcript law of the oblivious client of `ops` is +`evalOps`. -/ +theorem run_resample_obliviousClient_seedSpec (θ : Seed) (ops : List (HashFamily.Op U)) : + ((seedSpec seedLaw eval).run (OracleComp.query (.resample : HashFamily.Op U) >>= fun _ => + (seedSpec seedLaw eval).obliviousClient ops) θ).map Prod.fst = + evalOps seedLaw eval ops := by + rw [run_resample_bind_seedSpec, PMF.map_bind, evalOps] + exact congrArg seedLaw.bind (funext fun θ' => run_obliviousClient_seedSpec seedLaw eval θ' ops) + +end Cslib.DataStructure.HashFamily diff --git a/Complexity/DataStructure/StateTransition/Randomized.lean b/Complexity/DataStructure/StateTransition/Randomized.lean new file mode 100644 index 0000000000..19db253b4e --- /dev/null +++ b/Complexity/DataStructure/StateTransition/Randomized.lean @@ -0,0 +1,573 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.DataStructure.StateTransition.Refinement +public import Complexity.Languages.Probabilistic.Oracle +public import Complexity.Languages.Probabilistic.UntilBad +import Complexity.Languages.Probabilistic.Simulation +import Complexity.Probability.PMF.Bind +import Complexity.Probability.PMF.Expect + +/-! +# Distributional refinements of randomized specifications + +A `RandomizedSpec` is a state-transition specification whose operations draw their outcome from a +distribution: `law o` is a stateful `PMF` handler. A client runs against it by +`OracleComp.interpret`, and `RandomizedSpec.run` is the joint distribution of its result and +final state. Its support is a relational `StateTransitionSpec` (`RandomizedSpec.toSpec`), and a +deterministic specification is a randomized one with point-mass outcomes +(`StateTransitionSpec.toRandomized`). An implementation that flips coins calls `E.withCoins`, the +interface `E` beside uniform sampling, whose clients are the `ProbOracleComp E.Result` programs. + +A `RandomizedRefinement D F` extends a relational `Refinement` of the supports with one +distributional obligation. From a state satisfying the invariant, each admissible method's joint +distribution of answer and abstracted final state is the specified law (`law`). The relational +part then supplies the implementation invariant, the admissibility of lower calls and pathwise +amortized costs (`Refinement.Amortized` of `toRefinement`), and the law lifts to every adaptive +client (`RandomizedRefinement.run_link`). All probability is then done on the specification. +States, operations and answers live in `Type`, as for `ProbOracleComp` and +`OracleComp.IdenticalUntilBad`. + +Failure events take one more step. If the real methods agree with exact ones until a bad lower +state (`OracleComp.IdenticalUntilBad`), any experiment on the real client accepts at most as often +as on the specification, plus the probability of the bad event +(`RandomizedRefinement.bind_apply_le_of_identicalUntilBad`). `OracleComp.toOuterMeasure_bad_le` +bounds that probability by per-call charges. + +Expected costs go through charges as well. `RandomizedSpec.expectedCost` is the expected total +charge of a client. A `RandomizedRefinement.ExpectedAmortized` certificate bounds each method's +expected lower cost plus expected final potential by the upper charge plus the initial potential; +it telescopes along adaptive clients (`ExpectedAmortized.client`) and stacks across composition +(`ExpectedAmortized.comp`). When charges do not depend on the state, a query budget +(`OracleComp.IsCostBounded`) bounds the expected cost (`expectedCost_le_of_isCostBounded`). + +## Main definitions + +* `RandomizedSpec`, `RandomizedSpec.run`: randomized specifications and the law of a client run. +* `RandomizedSpec.toSpec`: the relational support. +* `StateTransitionSpec.toRandomized`: a deterministic specification as a randomized one. +* `RandomizedSpec.withCoins`: an interface together with private uniform coins. +* `RandomizedSpec.obliviousClient`: issue a fixed list of operations and record the transcript. +* `RandomizedRefinement`, `RandomizedRefinement.ofLaw`: distributional refinements, and the + constructor that derives the relational step from the law. +* `RandomizedRefinement.comp`: composition. +* `RandomizedRefinement.handler`: the methods as a stateful handler on lower states. +* `RandomizedSpec.expectedCost`, `RandomizedRefinement.ExpectedAmortized`: expected charges and + expected amortized cost refinements. + +## Main results + +* `RandomizedSpec.mem_support_run_of_clientRun`, `RandomizedSpec.exists_clientRun_of_mem_support`: + the support of a run consists of the relational runs. +* `StateTransitionSpec.run_toRandomized`, `StateTransitionSpec.toRandomized_step_iff`: a + deterministic run is a point mass, and the support of a deterministic specification is itself. +* `RandomizedSpec.demonicValid_liftRight`, `RandomizedSpec.demonicValid_sample_bind`: coin calls + are admissible, and programs over `E` keep their admissibility. +* `RandomizedSpec.expectedCost_bind`, `RandomizedSpec.expectedCost_le_of_isCostBounded`, + `RandomizedSpec.isCostBounded_obliviousClient`: expected charges of sequenced programs, and + query budgets. +* `RandomizedRefinement.run_link`: the law of a linked client, read through the abstraction, is + the law of the client on the specification. +* `RandomizedRefinement.inv_of_mem_support_link`: the invariant holds on every outcome. +* `RandomizedRefinement.bind_apply_le_of_identicalUntilBad`, + `RandomizedRefinement.abs_sub_le_of_identicalUntilBad`: the identical-until-bad step. +* `RandomizedRefinement.ExpectedAmortized.client`, `RandomizedRefinement.ExpectedAmortized.comp`, + `RandomizedRefinement.ExpectedAmortized.of_isCostBounded`: expected amortized costs. + +## References + +* [D. Boneh, V. Shoup, *A Graduate Course in Applied Cryptography*, + Version 0.6][BonehShoup2023], Theorem 4.7. +* [Cormen, Leiserson, Rivest and Stein, *Introduction to Algorithms*, Chapter 17][CLRS2009]. +-/ + +@[expose] public section + +namespace Cslib.DataStructure + +open scoped ENNReal + +/-- A randomized specification: from each state, an operation draws its answer and next state +from the distribution `law o`. Admissibility `valid` constrains only refinement certificates. -/ +structure RandomizedSpec where + /-- Mathematical states. -/ + State : Type + /-- Operations available to clients. -/ + Op : Type + /-- The answer type of each operation. -/ + Result : Op → Type + /-- The distribution of the answer and the next state of each operation. -/ + law : (o : Op) → StateT State PMF (Result o) + /-- Preconditions under which an implementation must realize an operation. -/ + valid : State → Op → Prop := fun _ _ => True + +namespace RandomizedSpec + +variable (D : RandomizedSpec) {α β : Type} + +/-- The support of a randomized specification as a relational specification: a step is permitted +when the law gives it positive probability. -/ +abbrev toSpec : StateTransitionSpec.{0, 0, 0} where + State := D.State + Op := D.Op + Result := D.Result + step s o s' a := (a, s') ∈ (D.law o s).support + valid := D.valid + +/-- The joint distribution of the result and the final state of a client run from `s`. -/ +noncomputable abbrev run (p : OracleComp D.Result α) (s : D.State) : PMF (α × D.State) := + (OracleComp.interpret D.law p).run s + +@[simp] theorem run_pure (a : α) (s : D.State) : D.run (pure a) s = PMF.pure (a, s) := rfl + +/-- A call followed by a continuation draws the call's outcome, then runs the continuation. -/ +theorem run_liftBind (o : D.Op) (k : D.Result o → OracleComp D.Result α) (s : D.State) : + D.run (.liftBind o k) s = (D.law o s).bind fun (a, s') => D.run (k a) s' := rfl + +/-- Running `p >>= k` runs `p`, then `k` at its result from the state it reached. -/ +theorem run_bind (p : OracleComp D.Result α) (k : α → OracleComp D.Result β) (s : D.State) : + D.run (p >>= k) s = (D.run p s).bind fun (a, s') => D.run (k a) s' := + OracleComp.run_interpret_bind _ _ _ _ + +/-- Mapping the result of a client maps the result of its run. -/ +theorem run_map (f : α → β) (p : OracleComp D.Result α) (s : D.State) : + D.run (f <$> p) s = (D.run p s).map fun (a, s') => (f a, s') := + OracleComp.run_interpret_map _ _ _ _ + +/-- Every relational run of a client has positive probability. -/ +theorem mem_support_run_of_clientRun {p : D.toSpec.Client α} {s s' : D.toSpec.State} {a : α} + {tr : D.toSpec.Transcript} (h : D.toSpec.ClientRun s p a s' tr) : + (a, s') ∈ (D.run p s).support := by + induction h with + | pure s a => simp + | liftBind o k r _ hstep _ ih => + rw [run_liftBind, PMF.mem_support_bind_iff] + exact ⟨_, hstep, ih⟩ + +/-- On a demonically admissible client, every outcome of positive probability is a relational +run. -/ +theorem exists_clientRun_of_mem_support {p : D.toSpec.Client α} {s s' : D.toSpec.State} {a : α} + (hv : D.toSpec.DemonicValid s p) (h : (a, s') ∈ (D.run p s).support) : + ∃ tr, D.toSpec.ClientRun s p a s' tr := by + induction hv generalizing a s' with + | pure s b => + obtain ⟨rfl, rfl⟩ := Prod.ext_iff.mp ((PMF.mem_support_pure_iff _ _).mp h) + exact ⟨[], .pure _ _⟩ + | liftBind o k hv_o _ ih => + rw [run_liftBind, PMF.mem_support_bind_iff] at h + obtain ⟨⟨r, s₁⟩, hstep, hrest⟩ := h + obtain ⟨tr, htr⟩ := ih s₁ r hstep hrest + exact ⟨_, .liftBind o k r hv_o hstep htr⟩ + +/-- The expected total charge of a client run from `s`, where a call `o` from state `s` costs +`charge s o`. -/ +noncomputable def expectedCost (charge : D.State → D.Op → ℕ) : + OracleComp D.Result α → D.State → ℝ≥0∞ + | .pure _, _ => 0 + | .liftBind o k, s => charge s o + ∑' x, D.law o s x * expectedCost charge (k x.1) x.2 + +@[simp] theorem expectedCost_pure (charge : D.State → D.Op → ℕ) (a : α) (s : D.State) : + D.expectedCost charge (pure a) s = 0 := rfl + +theorem expectedCost_liftBind (charge : D.State → D.Op → ℕ) (o : D.Op) + (k : D.Result o → OracleComp D.Result α) (s : D.State) : + D.expectedCost charge (.liftBind o k) s = + charge s o + ∑' x, D.law o s x * D.expectedCost charge (k x.1) x.2 := rfl + +/-- The expected charge of `p >>= k` is that of `p` plus the expected charge of the +continuation. -/ +theorem expectedCost_bind (charge : D.State → D.Op → ℕ) (p : OracleComp D.Result α) + (k : α → OracleComp D.Result β) (s : D.State) : + D.expectedCost charge (p >>= k) s = + D.expectedCost charge p s + ∑' x, D.run p s x * D.expectedCost charge (k x.1) x.2 := by + induction p generalizing s with + | pure a => + change D.expectedCost charge (k a) s = 0 + ∑' x, PMF.pure (a, s) x * _ + rw [zero_add, tsum_eq_single (a, s)] + · simp + · intro x hx + simp [PMF.pure_apply, hx] + | liftBind o cont ih => + change D.expectedCost charge (.liftBind o fun r => cont r >>= k) s = _ + rw [expectedCost_liftBind, expectedCost_liftBind, run_liftBind, + Probability.PMF.tsum_bind_mul, add_assoc, ← tsum_add] + congr 1 + refine tsum_congr fun x => ?_ + rw [ih, mul_add] + +/-- With charges independent of the state, a query budget bounds the expected charge. -/ +theorem expectedCost_le_of_isCostBounded {cost : D.Op → ℕ} {p : OracleComp D.Result α} {n : ℕ} + (h : OracleComp.IsCostBounded cost p n) (s : D.State) : + D.expectedCost (fun _ o => cost o) p s ≤ n := by + induction h generalizing s with + | pure a n => simp + | liftBind q cont n _ ih => + change D.expectedCost _ (.liftBind q cont) s ≤ _ + rw [expectedCost_liftBind, Nat.cast_add, add_comm (n : ℝ≥0∞)] + gcongr + calc ∑' x, D.law q s x * D.expectedCost (fun _ o => cost o) (cont x.1) x.2 + ≤ ∑' x, D.law q s x * n := tsum_le_tsum fun x => by gcongr; exact ih _ _ + _ = n := by rw [ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul] + +/-- Issue a fixed list of operations and return the transcript of operations and answers. -/ +def obliviousClient : List D.Op → OracleComp D.Result (List (Sigma D.Result)) + | [] => pure [] + | o :: os => .liftBind o fun a => (⟨o, a⟩ :: ·) <$> obliviousClient os + +@[simp] theorem obliviousClient_nil : D.obliviousClient [] = pure [] := rfl + +theorem obliviousClient_cons (o : D.Op) (os : List D.Op) : + D.obliviousClient (o :: os) = + .liftBind o fun a => (⟨o, a⟩ :: ·) <$> D.obliviousClient os := rfl + +/-- The calls of an oblivious client cost the sum of the costs of its operations. -/ +theorem isCostBounded_obliviousClient (cost : D.Op → ℕ) (ops : List D.Op) : + OracleComp.IsCostBounded cost (D.obliviousClient ops) (ops.map cost).sum := by + induction ops with + | nil => exact .pure _ _ + | cons o os ih => + refine OracleComp.IsCostBounded.liftBind_iff.mpr ⟨by simp, fun a => ?_⟩ + rw [OracleComp.isCostBounded_map_iff] + simpa using ih + +/-! ## Private coins -/ + +/-- The interface `E` together with private uniform coins: a call `.inl n` is answered uniformly +from `Fin (n + 1)` and leaves the state unchanged, and a call `.inr o` is a call of `E`. Its clients +are the `ProbOracleComp E.Result` programs. -/ +noncomputable abbrev withCoins (E : RandomizedSpec) : RandomizedSpec where + State := E.State + Op := ℕ ⊕ E.Op + Result := probOracleSpec E.Result + law := ProbOracleComp.handler (fun n => StateT.lift (ProbComp.unifOracle n)) E.law + valid s + | .inl _ => True + | .inr o => E.valid s o + +variable {D} + +/-- A program over `E` alone runs as over `E`. -/ +@[simp] theorem withCoins_run_liftRight (p : OracleComp D.Result α) (s : D.State) : + D.withCoins.run (OracleComp.liftRight p) s = D.run p s := by + simp only [run, ProbOracleComp.handler_eq_sumHandler, OracleComp.interpret_sumHandler_liftRight] + +/-- A closed sampler draws its value and leaves the state unchanged. -/ +@[simp] theorem withCoins_run_sample (q : ProbComp α) (s : D.State) : + D.withCoins.run (ProbOracleComp.sample q) s = (ProbComp.eval q).map (·, s) := + ProbOracleComp.run_interpret_sample D.law q s + +/-- Admissibility over `E` is admissibility of the embedded program. -/ +theorem demonicValid_liftRight {p : D.toSpec.Client α} {s : D.toSpec.State} + (h : D.toSpec.DemonicValid s p) : + D.withCoins.toSpec.DemonicValid s (OracleComp.liftRight p) := by + induction h with + | pure s a => exact StateTransitionSpec.DemonicValid.pure (D := D.withCoins.toSpec) s a + | liftBind o k hv _ ih => + exact StateTransitionSpec.DemonicValid.liftBind (D := D.withCoins.toSpec) (Sum.inr o) + (fun a => OracleComp.liftRight (k a)) hv fun s' a hstep => ih s' a hstep + +/-- Coin calls are admissible, and leave the state unchanged. -/ +theorem demonicValid_sample_bind {q : ProbComp β} {k : β → OracleComp D.withCoins.Result α} + {s : D.State} (h : ∀ b, D.withCoins.toSpec.DemonicValid s (k b)) : + D.withCoins.toSpec.DemonicValid s (ProbOracleComp.sample q >>= k) := by + induction q with + | pure b => exact h b + | liftBind n cont ih => + refine StateTransitionSpec.DemonicValid.liftBind (D := D.withCoins.toSpec) (Sum.inl n) + (fun i => ProbOracleComp.sample (cont i) >>= k) trivial fun s' i hstep => ?_ + have hs : s' = s := by + change (i, s') ∈ ((ProbComp.unifOracle n).bind fun i => PMF.pure (i, s)).support at hstep + obtain ⟨_, _, h⟩ := (PMF.mem_support_bind_iff _ _ _).mp hstep + exact (Prod.ext_iff.mp ((PMF.mem_support_pure_iff _ _).mp h)).2 + subst hs + exact ih i + +end RandomizedSpec + +/-! ## Deterministic specifications -/ + +namespace StateTransitionSpec + +variable {D : StateTransitionSpec.{0, 0, 0}} {f : (s : D.State) → (o : D.Op) → D.State × D.Result o} + [D.HasStepFn f] {α : Type} + +variable (D) in +/-- A deterministic specification as a randomized one: each outcome is a point mass. -/ +noncomputable abbrev toRandomized : RandomizedSpec where + State := D.State + Op := D.Op + Result := D.Result + law o s := let (s', a) := D.stepFn s o; PMF.pure (a, s') + valid := D.valid + +/-- A deterministic run is the point mass at the evaluated result and final state. -/ +@[simp] theorem run_toRandomized (p : D.Client α) (s : D.State) : + D.toRandomized.run p s = PMF.pure (DataStructure.eval D p s) := by + induction p generalizing s with + | pure a => rfl + | liftBind o k ih => + rw [RandomizedSpec.run_liftBind] + exact (PMF.pure_bind _ _).trans (ih _ _) + +/-- The support of a deterministic specification is the specification. -/ +theorem toRandomized_step_iff (s s' : D.State) (o : D.Op) (a : D.Result o) : + D.toRandomized.toSpec.step s o s' a ↔ D.step s o s' a := by + rw [D.step_iff_stepFn] + change (a, s') ∈ (PMF.pure ((D.stepFn s o).2, (D.stepFn s o).1)).support ↔ _ + rw [PMF.mem_support_pure_iff] + constructor + · intro h + obtain ⟨ha, hs⟩ := Prod.mk.inj h + exact Prod.ext hs ha + · intro h + rw [← h] + +/-- Admissibility of a deterministic history is admissibility on the support. -/ +theorem toRandomized_demonicValid_of_validHistory {p : D.Client α} {s : D.State} + (h : D.ValidHistory s (D.clientHistory s p)) : D.toRandomized.toSpec.DemonicValid s p := by + have hv := (D.demonicValid_iff_validHistory_runClient s p).mpr h + clear h + induction hv with + | pure s a => exact StateTransitionSpec.DemonicValid.pure (D := D.toRandomized.toSpec) s a + | liftBind o k hv _ ih => + exact StateTransitionSpec.DemonicValid.liftBind (D := D.toRandomized.toSpec) o k hv + fun s' a hstep => ih s' a ((toRandomized_step_iff _ _ _ _).mp hstep) + +end StateTransitionSpec + +/-! ## Distributional refinements -/ + +/-- A randomized refinement of `D` by methods over `F`: a relational refinement of the supports +whose methods, from a state satisfying the invariant, realize the specified law through the +abstraction function. -/ +structure RandomizedRefinement (D F : RandomizedSpec) extends Refinement D.toSpec F.toSpec where + /-- The answer and the abstracted final state of each admissible method follow the law. -/ + law : ∀ {e} o, inv e → D.valid (abs e) o → + (F.run (methods o) e).map (fun (a, e') => (a, abs e')) = D.law o (abs e) + +namespace RandomizedRefinement + +variable {D F G : RandomizedSpec} {α : Type} + +/-- The constructor from admissibility, preservation of the invariant on outcomes of positive +probability, and the law. The relational step follows from the law. -/ +def ofLaw (methods : Methods D.toSpec F.toSpec) (inv : F.State → Prop) (abs : F.State → D.State) + (valid : ∀ {e} o, inv e → D.valid (abs e) o → F.toSpec.DemonicValid e (methods o)) + (inv_run : ∀ {e} o, inv e → D.valid (abs e) o → + ∀ a e', (a, e') ∈ (F.run (methods o) e).support → inv e') + (law : ∀ {e} o, inv e → D.valid (abs e) o → + (F.run (methods o) e).map (fun (a, e') => (a, abs e')) = D.law o (abs e)) : + RandomizedRefinement D F where + methods := methods + inv := inv + abs := abs + valid := valid + correct {e} o {a e' tr} hi hv hrun := by + have hmem := F.mem_support_run_of_clientRun hrun + refine ⟨?_, inv_run o hi hv a e' hmem⟩ + change (a, abs e') ∈ (D.law o (abs e)).support + rw [← law o hi hv] + exact (PMF.mem_support_map_iff _ _ _).mpr ⟨(a, e'), hmem, rfl⟩ + law := law + +variable (M : RandomizedRefinement D F) + +/-- The invariant holds after every outcome of positive probability of an admissible method. -/ +theorem inv_of_mem_support {e : F.State} (o : D.Op) (he : M.inv e) (hv : D.valid (M.abs e) o) + {a : D.Result o} {e' : F.State} (h : (a, e') ∈ (F.run (M.methods o) e).support) : + M.inv e' := + let ⟨_, hrun⟩ := F.exists_clientRun_of_mem_support (M.valid o he hv) h + (M.correct o he hv hrun).2 + +/-- An outcome of positive probability of an admissible method abstracts to a permitted step. -/ +theorem step_of_mem_support {e : F.State} (o : D.Op) (he : M.inv e) (hv : D.valid (M.abs e) o) + {a : D.Result o} {e' : F.State} (h : (a, e') ∈ (F.run (M.methods o) e).support) : + (a, M.abs e') ∈ (D.law o (M.abs e)).support := by + rw [← M.law o he hv] + exact (PMF.mem_support_map_iff _ _ _).mpr ⟨(a, e'), h, rfl⟩ + +/-- **The distributional hop.** The law of an admissible client linked through the methods, read +through the abstraction function, is the law of the client on the specification. This is +`OracleComp.run_interpret_map_state_of_invariant` for the methods' handler +(`run_interpret_handler`), with preconditions: the law need hold only for admissible operations, +and the client must be admissible. -/ +theorem run_link (p : OracleComp D.Result α) {e : F.State} (he : M.inv e) + (hv : D.toSpec.DemonicValid (M.abs e) p) : + (F.run (link M.methods p) e).map (fun (a, e') => (a, M.abs e')) = D.run p (M.abs e) := by + induction p generalizing e with + | pure a => simp [link] + | liftBind o k ih => + obtain ⟨hv_o, hv_k⟩ := (D.toSpec.demonicValid_liftBind_iff _ o k).mp hv + change (F.run (M.methods o >>= fun r => link M.methods (k r)) e).map _ = _ + rw [F.run_bind, PMF.map_bind, Probability.PMF.bind_congr_on_support _ _ + (fun x => D.run (k x.1) (M.abs x.2)) fun x hx => + ih x.1 (M.inv_of_mem_support o he hv_o hx) (hv_k _ _ (M.step_of_mem_support o he hv_o hx)), + D.run_liftBind, ← M.law o he hv_o, PMF.bind_map] + rfl + +/-- The invariant holds on every outcome of positive probability of an admissible linked +client. -/ +theorem inv_of_mem_support_link (p : OracleComp D.Result α) {e : F.State} (he : M.inv e) + (hv : D.toSpec.DemonicValid (M.abs e) p) {a : α} {e' : F.State} + (h : (a, e') ∈ (F.run (link M.methods p) e).support) : M.inv e' := by + obtain ⟨hvF, hrun⟩ := M.toRefinement.simulates_demonic p he hv + obtain ⟨tr, htr⟩ := F.exists_clientRun_of_mem_support hvF h + exact (hrun a e' tr htr).1 + +/-- Composition: the upper methods are linked through the lower ones, the invariants conjoin, and +the abstraction functions compose. -/ +def comp (M : RandomizedRefinement D F) (N : RandomizedRefinement F G) : + RandomizedRefinement D G where + toRefinement := M.toRefinement.comp N.toRefinement + law {g} o hi hv := by + have h := N.run_link (M.methods o) hi.1 (M.valid o hi.2 hv) + calc _ = ((G.run (link N.methods (M.methods o)) g).map fun (a, g') => (a, N.abs g')).map + fun (a, f) => (a, M.abs f) := by rw [PMF.map_comp]; rfl + _ = _ := by rw [h, M.law o hi.2 hv]; rfl + +/-! ## Identical until bad -/ + +/-- The methods as a stateful handler of the upper operations on lower states. -/ +noncomputable abbrev handler (methods : Methods D.toSpec F.toSpec) : + (o : D.Op) → StateT F.State PMF (D.Result o) := + fun o => OracleComp.interpret F.law (methods o) + +/-- Interpreting a client through the methods' handler runs the linked client. -/ +theorem run_interpret_handler (methods : Methods D.toSpec F.toSpec) + (p : OracleComp D.Result α) (e : F.State) : + (OracleComp.interpret (handler methods) p).run e = F.run (link methods p) e := + congrArg (StateT.run · e) (OracleComp.interpret_interpret methods F.law p).symm + +/-- **The identical-until-bad step.** Let real methods agree with the methods of an exact +randomized refinement until a bad lower state. Then an experiment continuing the real client run +accepts at most as often as on the specification, plus the probability that the real run reaches +a bad state. -/ +theorem bind_apply_le_of_identicalUntilBad (real : Methods D.toSpec F.toSpec) + {bad : F.State → Prop} + (h : OracleComp.IdenticalUntilBad (handler real) (handler M.methods) bad) + (p : OracleComp D.Result α) {e : F.State} (he : M.inv e) + (hv : D.toSpec.DemonicValid (M.abs e) p) {β : Type} (next : α × D.State → PMF β) (b : β) : + ((F.run (link real p) e).bind fun (a, e') => next (a, M.abs e')) b ≤ + (D.run p (M.abs e)).bind next b + + (F.run (link real p) e).toOuterMeasure {x | bad x.2} := by + have hle := h.bind_apply_le p e (fun (a, e') => next (a, M.abs e')) b + rw [run_interpret_handler, run_interpret_handler] at hle + rw [← M.run_link p he hv, PMF.bind_map] + exact hle + +/-- **The identical-until-bad step, two-sided.** The acceptance probabilities of the real client +and of the specification differ by at most the probability that the real run reaches a bad +state. -/ +theorem abs_sub_le_of_identicalUntilBad (real : Methods D.toSpec F.toSpec) + {bad : F.State → Prop} + (h : OracleComp.IdenticalUntilBad (handler real) (handler M.methods) bad) + (p : OracleComp D.Result α) {e : F.State} (he : M.inv e) + (hv : D.toSpec.DemonicValid (M.abs e) p) {β : Type} (next : α × D.State → PMF β) (b : β) : + |(((F.run (link real p) e).bind fun (a, e') => next (a, M.abs e')) b).toReal - + ((D.run p (M.abs e)).bind next b).toReal| ≤ + ((F.run (link real p) e).toOuterMeasure {x | bad x.2}).toReal := by + have hle := h.abs_sub_le p e (fun (a, e') => next (a, M.abs e')) b + rw [run_interpret_handler, run_interpret_handler] at hle + rw [← M.run_link p he hv, PMF.bind_map] + exact hle + +/-! ## Expected amortized costs -/ + +/-- Expected amortized cost refinement: the expected lower charges of every admissible method, +plus the expected potential after it, are at most the upper charge plus the potential before +it. -/ +structure ExpectedAmortized (lower : F.State → F.Op → ℕ) (upper : D.State → D.Op → ℕ) + (potential : F.State → ℝ≥0∞) : Prop where + /-- The physicist's inequality in expectation, for one method. -/ + step : ∀ {e} o, M.inv e → D.valid (M.abs e) o → + F.expectedCost lower (M.methods o) e + ∑' x, F.run (M.methods o) e x * potential x.2 ≤ + upper (M.abs e) o + potential e + +variable {M} {lower : F.State → F.Op → ℕ} {upper : D.State → D.Op → ℕ} + {potential : F.State → ℝ≥0∞} + +/-- **Expected potentials telescope along adaptive clients.** The expected lower charges of an +admissible linked client, plus the expected final potential, are at most the expected upper +charges of the client on the specification plus the initial potential. -/ +theorem ExpectedAmortized.client (A : M.ExpectedAmortized lower upper potential) + (p : OracleComp D.Result α) {e : F.State} (he : M.inv e) + (hv : D.toSpec.DemonicValid (M.abs e) p) : + F.expectedCost lower (link M.methods p) e + + ∑' x, F.run (link M.methods p) e x * potential x.2 ≤ + D.expectedCost upper p (M.abs e) + potential e := by + induction p generalizing e with + | pure a => + change 0 + ∑' x, PMF.pure (a, e) x * potential x.2 ≤ 0 + potential e + rw [tsum_eq_single (a, e)] + · simp + · intro x hx + simp [PMF.pure_apply, hx] + | liftBind o k ih => + obtain ⟨hv_o, hv_k⟩ := (D.toSpec.demonicValid_liftBind_iff _ o k).mp hv + change F.expectedCost lower (M.methods o >>= fun r => link M.methods (k r)) e + + ∑' x, F.run (M.methods o >>= fun r => link M.methods (k r)) e x * potential x.2 ≤ _ + rw [F.expectedCost_bind, F.run_bind, Probability.PMF.tsum_bind_mul, add_assoc, + ← tsum_add] + simp only [← mul_add] + calc _ ≤ F.expectedCost lower (M.methods o) e + ∑' x, F.run (M.methods o) e x * + (D.expectedCost upper (k x.1) (M.abs x.2) + potential x.2) := by + refine add_le_add le_rfl (tsum_le_tsum fun x => ?_) + by_cases hx : x ∈ (F.run (M.methods o) e).support + · exact mul_le_mul_of_nonneg_left (ih x.1 (M.inv_of_mem_support o he hv_o hx) + (hv_k _ _ (M.step_of_mem_support o he hv_o hx))) zero_le + · rw [(PMF.apply_eq_zero_iff _ _).mpr hx, zero_mul, zero_mul] + _ = (F.expectedCost lower (M.methods o) e + + ∑' x, F.run (M.methods o) e x * potential x.2) + + ∑' x, D.law o (M.abs e) x * D.expectedCost upper (k x.1) x.2 := by + rw [← M.law o he hv_o, Probability.PMF.tsum_map_mul] + simp only [mul_add, tsum_add] + ring + _ ≤ (upper (M.abs e) o + potential e) + + ∑' x, D.law o (M.abs e) x * D.expectedCost upper (k x.1) x.2 := + add_le_add (A.step o he hv_o) le_rfl + _ = _ := by rw [D.expectedCost_liftBind]; ring + +/-- **Expected potentials stack across composition.** The composite is amortized in +expectation with the upper potential, read through the lower abstraction, plus the lower +potential. -/ +theorem ExpectedAmortized.comp {N : RandomizedRefinement F G} {lower : G.State → G.Op → ℕ} + {middle : F.State → F.Op → ℕ} {Φ : F.State → ℝ≥0∞} {Ψ : G.State → ℝ≥0∞} + (A : M.ExpectedAmortized middle upper Φ) (B : N.ExpectedAmortized lower middle Ψ) : + (M.comp N).ExpectedAmortized lower upper (fun g => Φ (N.abs g) + Ψ g) where + step {g} o hi hv := by + have hB := B.client (M.methods o) hi.1 (M.valid o hi.2 hv) + have hA := A.step o hi.2 hv + have hΦ : ∑' x, G.run (link N.methods (M.methods o)) g x * Φ (N.abs x.2) = + ∑' x, F.run (M.methods o) (N.abs g) x * Φ x.2 := by + rw [← N.run_link (M.methods o) hi.1 (M.valid o hi.2 hv), Probability.PMF.tsum_map_mul] + change G.expectedCost lower (link N.methods (M.methods o)) g + + ∑' x, G.run (link N.methods (M.methods o)) g x * (Φ (N.abs x.2) + Ψ x.2) ≤ + upper (M.abs (N.abs g)) o + (Φ (N.abs g) + Ψ g) + simp only [mul_add, tsum_add, hΦ] + calc _ = (G.expectedCost lower (link N.methods (M.methods o)) g + + ∑' x, G.run (link N.methods (M.methods o)) g x * Ψ x.2) + + ∑' x, F.run (M.methods o) (N.abs g) x * Φ x.2 := by ring + _ ≤ (F.expectedCost middle (M.methods o) (N.abs g) + Ψ g) + + ∑' x, F.run (M.methods o) (N.abs g) x * Φ x.2 := add_le_add hB le_rfl + _ = (F.expectedCost middle (M.methods o) (N.abs g) + + ∑' x, F.run (M.methods o) (N.abs g) x * Φ x.2) + Ψ g := by ring + _ ≤ (upper (M.abs (N.abs g)) o + Φ (N.abs g)) + Ψ g := add_le_add hA le_rfl + _ = _ := by ring + +/-- With charges independent of the state, query budgets of the methods give an expected +amortized certificate with zero potential. -/ +theorem ExpectedAmortized.of_isCostBounded {cost : F.Op → ℕ} {budget : D.Op → ℕ} + (h : ∀ o, OracleComp.IsCostBounded cost (M.methods o) (budget o)) : + M.ExpectedAmortized (fun _ q => cost q) (fun _ o => budget o) fun _ => 0 where + step {e} o _ _ := by + simpa using F.expectedCost_le_of_isCostBounded (h o) e + +end RandomizedRefinement + +end Cslib.DataStructure diff --git a/ComplexityTests/HashFamilyMemory.lean b/ComplexityTests/HashFamilyMemory.lean new file mode 100644 index 0000000000..ac9483104f --- /dev/null +++ b/ComplexityTests/HashFamilyMemory.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: local-only (test driver) + +public import Complexity.DataStructure.HashFamily.Memory + +/-! +# A random table over the memory oracle, on concrete parameters + +A table of two one-bit cells at word size `8`. The tests evaluate a lookup on concrete memory, +check that the general theorems apply (room in empty memory, admissibility of every memory call, +the transcript law `evalOps`, call counts for a concrete operation list), and instantiate the +expected amortized certificate and the identical-until-bad step, so that none of their hypotheses +is vacuous here. +-/ + +@[expose] public section + +namespace ComplexityTests.HashFamilyMemory + +open Cslib Cslib.WordRAM Cslib.DataStructure Cslib.DataStructure.HashFamily + Cslib.DataStructure.HashFamily.RandomTable + +/-- Empty memory with nothing allocated. -/ +def empty : Memory.State := ⟨fun _ => 0, 0⟩ + +/-- A table of two cells at address `0`, holding `0` and `1`. -/ +def stored : Memory.State := ⟨fun a => if a = 1 then 1 else 0, 2⟩ + +/-- Looking up cell `1` answers the stored bit and leaves memory unchanged. -/ +example : (Memory.spec 8).toRandomized.withCoins.run (methods ⟨0, 2⟩ 1 2 (.eval 1)) stored = + PMF.pure (1, stored) := by + rw [run_methods_eval] + rfl + +/-- Empty memory has room for the table at this word size. -/ +theorem room : Fits 8 (empty.frontier + 2) := by decide + +/-- An operation list: two lookups around a resample. -/ +def ops : List (HashFamily.Op 2) := [.eval 0, .resample, .eval 0, .eval 1] + +/-- Every memory call of the run is admissible. -/ +example : (Memory.spec 8).toRandomized.withCoins.toSpec.DemonicValid empty + (run 1 2 ((tableSpec 2 1).obliviousClient ops)) := + demonicValid_run (by omega) _ room + +/-- The transcript law of the run from allocation is `evalOps` of the random function. -/ +example : ((Memory.spec 8).toRandomized.withCoins.run + (run 1 2 ((tableSpec 2 1).obliviousClient ops)) empty).map Prod.fst = + evalOps (Probability.PMF.uniformOfFintype (Fin 2 → Fin (2 ^ 1))) (fun θ u => θ u) ops := + run_obliviousClient (w := 8) (by omega) ops empty + +/-- The run makes at most `1 + 4 + 7 = 12` calls: one allocation, a fill of two cells, and the +operations, at one call per lookup and four per resample. -/ +example : OracleComp.IsQueryBounded (run 1 2 ((tableSpec 2 1).obliviousClient ops)) 12 := + isQueryBounded_run ((tableSpec 2 1).isCostBounded_obliviousClient (budget 2) ops) + +/-- The refinement and its expected amortized certificate exist on these parameters. -/ +example : (refinement (w := 8) ⟨0, 2⟩ 1 rfl (by omega)).ExpectedAmortized (fun _ _ => 1) + (fun _ o => budget 2 o) fun _ => 0 := + expectedAmortized rfl (by omega) + +/-- The identical-until-bad step applies to the table: with no bad state, an experiment on the +real run accepts at most as often as on the specification. -/ +example {β : Type} (next : List (Sigma (HashFamily.Result (U := 2) (2 ^ 1))) × + (Fin 2 → Fin (2 ^ 1)) → PMF β) (b : β) : + let M := refinement (w := 8) ⟨0, 2⟩ 1 rfl (by omega) + ((Memory.spec 8).toRandomized.withCoins.run + (link M.methods ((tableSpec 2 1).obliviousClient ops)) ⟨empty.mem, 2⟩).bind + (fun (a, e') => next (a, M.abs e')) b ≤ + ((tableSpec 2 1).run ((tableSpec 2 1).obliviousClient ops) + (M.abs ⟨empty.mem, 2⟩)).bind next b + + ((Memory.spec 8).toRandomized.withCoins.run + (link M.methods ((tableSpec 2 1).obliviousClient ops)) ⟨empty.mem, 2⟩).toOuterMeasure + ∅ := by + intro M + exact M.bind_apply_le_of_identicalUntilBad M.methods (bad := fun _ => False) + ⟨fun _ _ _ _ _ _ => rfl, fun _ _ h => h.elim, fun _ _ h => h.elim⟩ _ le_rfl + ((tableSpec 2 1).toSpec.demonicValid_of_forall_valid (fun _ _ => trivial) _ _) next b + +end ComplexityTests.HashFamilyMemory From 27d9b52efabd1f699c1b54a151553deba8bfd909 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 19:14:24 -0500 Subject: [PATCH 13/17] feat(DataStructure): stack coin-using distributional hops; deterministic hops as distributional Follow-ups to #2232 for #2205. - `RandomizedRefinement.withCoins`: coins pass through a refinement unchanged. - `RandomizedRefinement.mergeCoins`: two layers of private coins are one. - `RandomizedRefinement.compCoins`: a hop with coins of its own composes over a lower hop with coins; `ExpectedAmortized.withCoins`/`.compCoins` stack expected potentials across it. - `Refinement.toRandomized`, `Refinement.Amortized.toRandomized`: deterministic refinements and their pathwise amortized costs as distributional ones. - `Probability.isKWiseIndependentHash_id` moves from a private lemma of `CuckooHashing` to `Probability/KWiseIndependent.lean`; the memory random table gets its `kWiseSpec` contract (`RandomTable.kWiseSpec_contract_run`). Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../Dictionary/CuckooHashing.lean | 42 --- .../DataStructure/HashFamily/Memory.lean | 14 + .../StateTransition/Randomized.lean | 297 +++++++++++++++++- Complexity/Probability/KWiseIndependent.lean | 44 +++ ComplexityTests/HashFamilyMemory.lean | 89 +++++- 5 files changed, 435 insertions(+), 51 deletions(-) diff --git a/Complexity/DataStructure/Dictionary/CuckooHashing.lean b/Complexity/DataStructure/Dictionary/CuckooHashing.lean index c7d62bfa88..d6f39e91d8 100644 --- a/Complexity/DataStructure/Dictionary/CuckooHashing.lean +++ b/Complexity/DataStructure/Dictionary/CuckooHashing.lean @@ -382,48 +382,6 @@ private theorem card_filter_prod_equationChain_eq {Θ₁ Θ₂ : Type*} [Fintype rw [card_filter_equationChain_eq hm hh₁ hv₁ hc₁, card_filter_equationChain_eq hm hh₂ hv₂ hc₂] -/-- The identity hash family `id : (X → Y) → X → Y` (representing a uniformly random function -`f : X → Y`) is `k`-wise independent for every `k : ℕ`. -/ -private theorem isKWiseIndependentHash_id {X Y : Type*} [Fintype X] [DecidableEq X] - [Fintype Y] [DecidableEq Y] [Nonempty Y] (k : ℕ) : - IsKWiseIndependentHash k (id : (X → Y) → X → Y) where - dens_filter_restrict_eq {T} _ y := by - let e : (X → Y) ≃ (T → Y) × ({x : X // x ∉ T} → Y) := - { toFun := fun f => (T.restrict f, fun x => f x.1) - invFun := fun p x => if hx : x ∈ T then p.1 ⟨x, hx⟩ else p.2 ⟨x, hx⟩ - left_inv := fun f => by - funext x - dsimp only - split_ifs <;> rfl - right_inv := fun ⟨p₁, p₂⟩ => by - ext ⟨x, hx⟩ - · simp [Finset.restrict, hx] - · simp [hx] } - have hcard_filter : - #{f : X → Y | T.restrict f = y} = Fintype.card ({x : X // x ∉ T} → Y) := by - rw [← Finset.card_univ] - refine Finset.card_nbij' (fun f => (e f).2) (fun g => e.symm (y, g)) ?_ ?_ ?_ ?_ - · intro _ _; exact Finset.mem_univ _ - · intro g _ - simp only [Finset.mem_coe, Finset.mem_filter, Finset.mem_univ, true_and] - exact congrArg Prod.fst (e.apply_symm_apply (y, g)) - · intro f hf - simp only [Finset.mem_coe, Finset.mem_filter, Finset.mem_univ, true_and] at hf - have h1 : (e f).1 = y := hf - calc e.symm (y, (e f).2) = e.symm ((e f).1, (e f).2) := by rw [h1] - _ = f := e.symm_apply_apply f - · intro g _ - exact congrArg Prod.snd (e.apply_symm_apply (y, g)) - have hcard_all : - Fintype.card (X → Y) = - Fintype.card Y ^ #T * Fintype.card ({x : X // x ∉ T} → Y) := by - rw [Fintype.card_congr e, Fintype.card_prod, Fintype.card_fun, Fintype.card_coe] - have hrest_ne : (Fintype.card ({x : X // x ∉ T} → Y) : ℚ≥0) ≠ 0 := - Nat.cast_ne_zero.mpr Fintype.card_ne_zero - dsimp only [id_eq] - rw [Finset.dens_eq_card_div_card, hcard_filter, hcard_all, Nat.cast_mul, Nat.cast_pow, - div_mul_cancel_right₀ hrest_ne] - /-! ## Section 1B: Index-level equation chains for alternating paths and bicyclic prefixes -/ /-- Index-level equation chain on `Fin N`: at each `(a, b) :: rest`, `a ≠ b` and `a` does not diff --git a/Complexity/DataStructure/HashFamily/Memory.lean b/Complexity/DataStructure/HashFamily/Memory.lean index 760c81cdf8..6f66b8615a 100644 --- a/Complexity/DataStructure/HashFamily/Memory.lean +++ b/Complexity/DataStructure/HashFamily/Memory.lean @@ -46,6 +46,8 @@ bookkeeping. Every operation makes at most `2 * U` calls, and `eval` exactly one * `Cslib.DataStructure.HashFamily.RandomTable.run_eq`: the law of a client run from allocation. * `Cslib.DataStructure.HashFamily.RandomTable.run_obliviousClient`: its oblivious transcripts are `evalOps`. +* `Cslib.DataStructure.HashFamily.RandomTable.kWiseSpec_contract_run`: they meet the `kWiseSpec` + contract for every `k`. * `Cslib.DataStructure.HashFamily.RandomTable.demonicValid_run`: every memory call is admissible. * `Cslib.DataStructure.HashFamily.RandomTable.expectedAmortized`, `Cslib.DataStructure.HashFamily.RandomTable.isQueryBounded_run`: call counts. @@ -322,6 +324,18 @@ theorem run_obliviousClient (hb : b ≤ w) {U : ℕ} (ops : List (HashFamily.Op rw [run_eq hb, HashFamily.evalOps] exact congrArg _ (funext fun θ => run_obliviousClient_seedSpec _ _ θ ops) +/-- **The `kWiseSpec` contract over memory.** A uniform table is `k`-wise independent for every +`k` (`Probability.isKWiseIndependentHash_id`). So on every oblivious operation sequence with at +most `k` distinct keys per epoch, the transcript law of the run from allocation meets +`HashFamily.kWiseSpec`: it is the ideal transcript law. -/ +theorem kWiseSpec_contract_run (hb : b ≤ w) {k U : ℕ} {ops : List (HashFamily.Op U)} + (hv : HashFamily.BoundedEpochKeys k ops) (s : Memory.State) : + (HashFamily.kWiseSpec k U (2 ^ b)).Contract ops + (((Memory.spec w).toRandomized.withCoins.run + (run b U ((tableSpec U b).obliviousClient ops)) s).map Prod.fst) := by + rw [run_obliviousClient hb] + exact HashFamily.kWiseSpec_contract_evalOps (Probability.isKWiseIndependentHash_id k) hv + /-- Every memory call of the run is admissible when the table and `b`-bit words fit. -/ theorem demonicValid_run (hb : b ≤ w) {U : ℕ} {α : Type} (p : OracleComp (HashFamily.Result (U := U) (2 ^ b)) α) {s : Memory.State} diff --git a/Complexity/DataStructure/StateTransition/Randomized.lean b/Complexity/DataStructure/StateTransition/Randomized.lean index 19db253b4e..7e9702fd14 100644 --- a/Complexity/DataStructure/StateTransition/Randomized.lean +++ b/Complexity/DataStructure/StateTransition/Randomized.lean @@ -47,6 +47,14 @@ it telescopes along adaptive clients (`ExpectedAmortized.client`) and stacks acr (`ExpectedAmortized.comp`). When charges do not depend on the state, a query budget (`OracleComp.IsCostBounded`) bounds the expected cost (`expectedCost_le_of_isCostBounded`). +Hops stack whether or not they flip coins. A deterministic refinement is a distributional one of +the point-mass laws (`Refinement.toRandomized`), and its pathwise amortized costs are expected +ones (`Refinement.Amortized.toRandomized`). Coins pass through a refinement unchanged +(`RandomizedRefinement.withCoins`), and two layers of coins merge into one +(`RandomizedRefinement.mergeCoins`). So a hop with coins of its own composes over a lower hop +with coins (`RandomizedRefinement.compCoins`), and expected potentials stack across it +(`ExpectedAmortized.compCoins`). + ## Main definitions * `RandomizedSpec`, `RandomizedSpec.run`: randomized specifications and the law of a client run. @@ -60,6 +68,11 @@ it telescopes along adaptive clients (`ExpectedAmortized.client`) and stacks acr * `RandomizedRefinement.handler`: the methods as a stateful handler on lower states. * `RandomizedSpec.expectedCost`, `RandomizedRefinement.ExpectedAmortized`: expected charges and expected amortized cost refinements. +* `RandomizedSpec.coinCharge`: charges on an interface with coins. +* `RandomizedRefinement.withCoins`, `RandomizedRefinement.mergeCoins`, + `RandomizedRefinement.compCoins`: coins through refinements, merged coin streams, and the + composition of hops with coins. +* `Refinement.toRandomized`: a deterministic refinement as a distributional one. ## Main results @@ -79,6 +92,11 @@ it telescopes along adaptive clients (`ExpectedAmortized.client`) and stacks acr `RandomizedRefinement.abs_sub_le_of_identicalUntilBad`: the identical-until-bad step. * `RandomizedRefinement.ExpectedAmortized.client`, `RandomizedRefinement.ExpectedAmortized.comp`, `RandomizedRefinement.ExpectedAmortized.of_isCostBounded`: expected amortized costs. +* `StateTransitionSpec.expectedCost_toRandomized`, `Refinement.Amortized.toRandomized`: expected + charges of deterministic runs, and pathwise amortized costs as expected ones. +* `RandomizedRefinement.ExpectedAmortized.withCoins`, + `RandomizedRefinement.expectedAmortized_mergeCoins`, + `RandomizedRefinement.ExpectedAmortized.compCoins`: expected amortized costs through coins. ## References @@ -140,6 +158,11 @@ theorem run_map (f : α → β) (p : OracleComp D.Result α) (s : D.State) : D.run (f <$> p) s = (D.run p s).map fun (a, s') => (f a, s') := OracleComp.run_interpret_map _ _ _ _ +/-- A single call draws its answer and next state from the law. -/ +@[simp] theorem run_query (o : D.Op) (s : D.State) : + D.run (OracleComp.query o) s = D.law o s := + PMF.bind_pure _ + /-- Every relational run of a client has positive probability. -/ theorem mem_support_run_of_clientRun {p : D.toSpec.Client α} {s s' : D.toSpec.State} {a : α} {tr : D.toSpec.Transcript} (h : D.toSpec.ClientRun s p a s' tr) : @@ -180,6 +203,12 @@ theorem expectedCost_liftBind (charge : D.State → D.Op → ℕ) (o : D.Op) D.expectedCost charge (.liftBind o k) s = charge s o + ∑' x, D.law o s x * D.expectedCost charge (k x.1) x.2 := rfl +/-- The expected charge of a single call is its charge. -/ +@[simp] theorem expectedCost_query (charge : D.State → D.Op → ℕ) (o : D.Op) (s : D.State) : + D.expectedCost charge (OracleComp.query o) s = charge s o := by + rw [OracleComp.query, PFunctor.FreeM.lift, expectedCost_liftBind] + simp + /-- The expected charge of `p >>= k` is that of `p` plus the expected charge of the continuation. -/ theorem expectedCost_bind (charge : D.State → D.Op → ℕ) (p : OracleComp D.Result α) @@ -288,6 +317,51 @@ theorem demonicValid_sample_bind {q : ProbComp β} {k : β → OracleComp D.with subst hs exact ih i +/-- A coin call draws uniformly and leaves the state unchanged. -/ +theorem withCoins_law_inl (n : ℕ) (s : D.State) : + D.withCoins.law (.inl n) s = (ProbComp.unifOracle n).map (·, s) := rfl + +/-- A single coin call is admissible. -/ +theorem demonicValid_coin (n : ℕ) (s : D.State) : + D.withCoins.toSpec.DemonicValid s + (OracleComp.query (spec := probOracleSpec D.Result) (.inl n)) := + .liftBind (D := D.withCoins.toSpec) (Sum.inl n) _ trivial fun s' a _ => .pure s' a + +/-- A single admissible call of `D`, made over `D.withCoins`, is admissible. -/ +theorem demonicValid_query_inr {o : D.Op} {s : D.State} (h : D.valid s o) : + D.withCoins.toSpec.DemonicValid s + (OracleComp.query (spec := probOracleSpec D.Result) (.inr o)) := + .liftBind (D := D.withCoins.toSpec) (Sum.inr o) _ h fun s' a _ => .pure s' a + +variable (D) in +/-- Charges on `D.withCoins`: a coin call `.inl n` costs `coin n`, and a call `.inr o` costs as +in `D`. -/ +def coinCharge (coin : ℕ → ℕ) (charge : D.State → D.Op → ℕ) : + D.withCoins.State → D.withCoins.Op → ℕ + | _, .inl n => coin n + | s, .inr o => charge s o + +/-- A constant charge on coin calls and on calls of `D` is that constant on `D.withCoins`. -/ +@[simp] theorem coinCharge_const (K : ℕ) : + D.coinCharge (fun _ => K) (fun _ _ => K) = fun _ _ => K := by + funext s o + cases o <;> rfl + +/-- A program over `D` alone costs over `D.withCoins` what it costs over `D`. -/ +theorem expectedCost_liftRight (coin : ℕ → ℕ) (charge : D.State → D.Op → ℕ) + (p : OracleComp D.Result α) (s : D.State) : + D.withCoins.expectedCost (D.coinCharge coin charge) (OracleComp.liftRight p) s = + D.expectedCost charge p s := by + induction p generalizing s with + | pure a => rfl + | liftBind o k ih => + change D.withCoins.expectedCost _ + (.liftBind (Sum.inr o) fun a => OracleComp.liftRight (k a)) s = _ + rw [expectedCost_liftBind, expectedCost_liftBind] + change (charge s o : ℝ≥0∞) + ∑' x : D.Result o × D.State, D.law o s x * + D.withCoins.expectedCost _ (OracleComp.liftRight (k x.1)) x.2 = _ + simp only [ih] + end RandomizedSpec /-! ## Deterministic specifications -/ @@ -328,17 +402,34 @@ theorem toRandomized_step_iff (s s' : D.State) (o : D.Op) (a : D.Result o) : · intro h rw [← h] -/-- Admissibility of a deterministic history is admissibility on the support. -/ -theorem toRandomized_demonicValid_of_validHistory {p : D.Client α} {s : D.State} - (h : D.ValidHistory s (D.clientHistory s p)) : D.toRandomized.toSpec.DemonicValid s p := by - have hv := (D.demonicValid_iff_validHistory_runClient s p).mpr h - clear h - induction hv with +/-- Admissibility on a deterministic specification is admissibility on its support. -/ +theorem toRandomized_demonicValid {p : D.Client α} {s : D.State} (h : D.DemonicValid s p) : + D.toRandomized.toSpec.DemonicValid s p := by + induction h with | pure s a => exact StateTransitionSpec.DemonicValid.pure (D := D.toRandomized.toSpec) s a | liftBind o k hv _ ih => exact StateTransitionSpec.DemonicValid.liftBind (D := D.toRandomized.toSpec) o k hv fun s' a hstep => ih s' a ((toRandomized_step_iff _ _ _ _).mp hstep) +/-- Admissibility of a deterministic history is admissibility on the support. -/ +theorem toRandomized_demonicValid_of_validHistory {p : D.Client α} {s : D.State} + (h : D.ValidHistory s (D.clientHistory s p)) : D.toRandomized.toSpec.DemonicValid s p := + toRandomized_demonicValid ((D.demonicValid_iff_validHistory_runClient s p).mpr h) + +/-- The expected charge of a deterministic run is the total charge of its history. -/ +theorem expectedCost_toRandomized (charge : D.State → D.Op → ℕ) (p : D.Client α) + (s : D.State) : + D.toRandomized.expectedCost charge p s = D.totalCost charge s (D.clientHistory s p) := by + induction p generalizing s with + | pure a => exact Nat.cast_zero.symm + | liftBind o k ih => + rw [RandomizedSpec.expectedCost_liftBind] + change _ + ∑' x, PMF.pure ((D.stepFn s o).2, (D.stepFn s o).1) x * _ = + ((charge s o + D.totalCost charge (D.stepFn s o).1 + (D.clientHistory (D.stepFn s o).1 (k (D.stepFn s o).2)) : ℕ) : ℝ≥0∞) + rw [tsum_eq_single ((D.stepFn s o).2, (D.stepFn s o).1) fun x hx => by + simp [PMF.pure_apply, hx], PMF.pure_apply_self, one_mul, ih, Nat.cast_add] + end StateTransitionSpec /-! ## Distributional refinements -/ @@ -568,6 +659,200 @@ theorem ExpectedAmortized.of_isCostBounded {cost : F.Op → ℕ} {budget : D.Op step {e} o _ _ := by simpa using F.expectedCost_le_of_isCostBounded (h o) e +/-! ## Private coins through refinements -/ + +/-- The methods with private coins forwarded: a coin call `.inl n` is the same coin call, and a +call `.inr o` runs the method of `o` over `F`. -/ +def coinMethods (methods : Methods D.toSpec F.toSpec) : + Methods D.withCoins.toSpec F.withCoins.toSpec + | .inl n => OracleComp.query (spec := probOracleSpec F.Result) (.inl n) + | .inr o => OracleComp.liftRight (methods o) + +variable (M) in +/-- **Coins pass through refinements.** A refinement of `D` by `F` refines `D.withCoins` by +`F.withCoins`, with the same invariant and abstraction: coin calls are forwarded unchanged, and +calls of `D` run their methods. -/ +noncomputable def withCoins : RandomizedRefinement D.withCoins F.withCoins := + .ofLaw (coinMethods M.methods) M.inv M.abs + (fun {e} o hi hv => by + cases o with + | inl n => exact F.demonicValid_coin n e + | inr o => exact RandomizedSpec.demonicValid_liftRight (M.valid o hi hv)) + (fun {e} o hi hv a e' h => by + cases o with + | inl n => + rw [coinMethods, RandomizedSpec.run_query, RandomizedSpec.withCoins_law_inl] at h + obtain ⟨_, _, h⟩ := (PMF.mem_support_map_iff _ _ _).mp h + obtain ⟨-, rfl⟩ := Prod.mk.inj h + exact hi + | inr o => + rw [coinMethods, RandomizedSpec.withCoins_run_liftRight] at h + exact M.inv_of_mem_support o hi hv h) + (fun {e} o hi hv => by + cases o with + | inl n => + rw [coinMethods, RandomizedSpec.run_query, RandomizedSpec.withCoins_law_inl, PMF.map_comp] + rfl + | inr o => + rw [coinMethods, RandomizedSpec.withCoins_run_liftRight] + exact M.law o hi hv) + +@[simp] theorem withCoins_methods_inl (n : ℕ) : + M.withCoins.methods (.inl n) = OracleComp.query (spec := probOracleSpec F.Result) (.inl n) := + rfl + +@[simp] theorem withCoins_methods_inr (o : D.Op) : + M.withCoins.methods (.inr o) = OracleComp.liftRight (M.methods o) := rfl + +@[simp] theorem withCoins_inv (e : F.State) : M.withCoins.inv e ↔ M.inv e := Iff.rfl + +@[simp] theorem withCoins_abs (e : F.State) : M.withCoins.abs e = M.abs e := rfl + +/-- The methods merging two layers of private coins: coin calls of either layer become coin +calls, and calls of `G` are forwarded. -/ +def mergeMethods (G : RandomizedSpec) : Methods G.withCoins.withCoins.toSpec G.withCoins.toSpec + | .inl n => OracleComp.query (spec := probOracleSpec G.Result) (.inl n) + | .inr (.inl n) => OracleComp.query (spec := probOracleSpec G.Result) (.inl n) + | .inr (.inr o) => OracleComp.query (spec := probOracleSpec G.Result) (.inr o) + +variable (G) in +/-- **Two layers of private coins are one.** Every call of `G.withCoins.withCoins` is one call +of `G.withCoins` with the same law, so the identity on states is a refinement. -/ +noncomputable def mergeCoins : RandomizedRefinement G.withCoins.withCoins G.withCoins := + .ofLaw (mergeMethods G) (fun _ => True) id + (fun {e} o _ hv => by + rcases o with n | n | o + · exact G.demonicValid_coin n e + · exact G.demonicValid_coin n e + · exact RandomizedSpec.demonicValid_query_inr hv) + (fun _ _ _ _ _ _ => trivial) + (fun {e} o _ _ => by + rcases o with n | n | o <;> + · rw [mergeMethods, RandomizedSpec.run_query] + exact PMF.map_id _) + +theorem mergeCoins_methods : (mergeCoins G).methods = mergeMethods G := rfl + +/-- **Coin-using hops compose.** A refinement of `D` by `F` with coins, over a refinement of `F` by +`G` with coins, refines `D` by `G` with one stream of coins. -/ +noncomputable def compCoins (M : RandomizedRefinement D F.withCoins) + (N : RandomizedRefinement F G.withCoins) : RandomizedRefinement D G.withCoins := + M.comp (N.withCoins.comp (mergeCoins G)) + +@[simp] theorem compCoins_inv (M : RandomizedRefinement D F.withCoins) + (N : RandomizedRefinement F G.withCoins) (g : G.State) : + (M.compCoins N).inv g ↔ N.inv g ∧ M.inv (N.abs g) := by + change (True ∧ N.inv g) ∧ M.inv (N.abs g) ↔ _ + rw [true_and] + +@[simp] theorem compCoins_abs (M : RandomizedRefinement D F.withCoins) + (N : RandomizedRefinement F G.withCoins) (g : G.State) : + (M.compCoins N).abs g = M.abs (N.abs g) := rfl + +variable {coin : ℕ → ℕ} + +/-- Expected amortized costs pass through coins: coin calls cost the same on both sides and leave +the potential unchanged. -/ +theorem ExpectedAmortized.withCoins (A : M.ExpectedAmortized lower upper potential) : + M.withCoins.ExpectedAmortized (F.coinCharge coin lower) (D.coinCharge coin upper) + potential where + step {e} o hi hv := by + cases o with + | inl n => + change F.withCoins.expectedCost _ (OracleComp.query (.inl n)) e + + ∑' x, F.withCoins.run (OracleComp.query (.inl n)) e x * potential x.2 ≤ coin n + potential e + rw [RandomizedSpec.expectedCost_query, RandomizedSpec.run_query, + RandomizedSpec.withCoins_law_inl, Probability.PMF.tsum_map_mul] + simp only [ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul] + exact le_rfl + | inr o => + change F.withCoins.expectedCost _ (OracleComp.liftRight (M.methods o)) e + + ∑' x, F.withCoins.run (OracleComp.liftRight (M.methods o)) e x * potential x.2 ≤ + upper (M.abs e) o + potential e + rw [RandomizedSpec.expectedCost_liftRight, RandomizedSpec.withCoins_run_liftRight] + exact A.step o hi hv + +/-- Merging coin streams costs one call per call, with zero potential. -/ +theorem expectedAmortized_mergeCoins (charge : G.State → G.Op → ℕ) : + (mergeCoins G).ExpectedAmortized (G.coinCharge coin charge) + (G.withCoins.coinCharge coin (G.coinCharge coin charge)) fun _ => 0 where + step {e} o _ _ := by + simp only [mul_zero, tsum_zero, add_zero] + rcases o with n | n | o <;> + · rw [mergeCoins_methods, mergeMethods, RandomizedSpec.expectedCost_query] + exact le_rfl + +/-- **Expected potentials stack across coin-using hops.** -/ +theorem ExpectedAmortized.compCoins {M : RandomizedRefinement D F.withCoins} + {N : RandomizedRefinement F G.withCoins} {lower : G.State → G.Op → ℕ} + {middle : F.State → F.Op → ℕ} {Φ : F.State → ℝ≥0∞} {Ψ : G.State → ℝ≥0∞} + (A : M.ExpectedAmortized (F.coinCharge coin middle) upper Φ) + (B : N.ExpectedAmortized (G.coinCharge coin lower) middle Ψ) : + (M.compCoins N).ExpectedAmortized (G.coinCharge coin lower) upper + fun g => Φ (N.abs g) + Ψ g where + step {g} o hi hv := by + have h := (A.comp (B.withCoins.comp (expectedAmortized_mergeCoins lower))).step o hi hv + simp only [add_zero] at h + exact h + end RandomizedRefinement +/-! ## Deterministic refinements -/ + +namespace Refinement + +variable {D E : StateTransitionSpec.{0, 0, 0}} + {fD : (s : D.State) → (o : D.Op) → D.State × D.Result o} [D.HasStepFn fD] + {fE : (e : E.State) → (o : E.Op) → E.State × E.Result o} [E.HasStepFn fE] + +/-- **Deterministic hops are distributional hops.** A refinement of deterministic specifications +refines their point-mass laws, with the same methods, invariant and abstraction. -/ +noncomputable def toRandomized (M : Refinement D E) : + RandomizedRefinement D.toRandomized E.toRandomized := + .ofLaw M.methods M.inv M.abs + (fun o hi hv => StateTransitionSpec.toRandomized_demonicValid (M.valid o hi hv)) + (fun {e} o hi hv a e' h => by + rw [StateTransitionSpec.run_toRandomized, PMF.mem_support_pure_iff] at h + have he' : e' = E.clientState e (M.methods o) := congrArg Prod.snd h + subst he' + exact (M.correct o hi hv (E.clientRun_canonical e (M.methods o) + ((E.demonicValid_iff_validHistory_runClient e _).mp (M.valid o hi hv)))).2) + (fun {e} o hi hv => by + have hstep := (D.step_iff_stepFn _ _ _ _).mp (M.correct o hi hv + (E.clientRun_canonical e (M.methods o) + ((E.demonicValid_iff_validHistory_runClient e _).mp (M.valid o hi hv)))).1 + rw [StateTransitionSpec.run_toRandomized, PMF.pure_map] + change _ = PMF.pure ((D.stepFn (M.abs e) o).2, (D.stepFn (M.abs e) o).1) + rw [← hstep] + rfl) + +@[simp] theorem toRandomized_methods (M : Refinement D E) : + M.toRandomized.methods = M.methods := rfl + +@[simp] theorem toRandomized_inv (M : Refinement D E) (e : E.State) : + M.toRandomized.inv e ↔ M.inv e := Iff.rfl + +@[simp] theorem toRandomized_abs (M : Refinement D E) (e : E.State) : + M.toRandomized.abs e = M.abs e := rfl + +/-- Pathwise amortized costs of a deterministic refinement are expected amortized costs of its +distributional form. -/ +theorem Amortized.toRandomized {M : Refinement D E} {lower : E.State → E.Op → ℕ} + {upper : D.State → D.Op → ℕ} {potential : E.State → ℕ} + (A : M.Amortized lower upper potential) : + M.toRandomized.ExpectedAmortized lower upper fun e => potential e where + step {e} o hi hv := by + have h := A.step o hi hv (E.clientRun_canonical e (M.methods o) + ((E.demonicValid_iff_validHistory_runClient e _).mp (M.valid o hi hv))) + rw [E.totalCostTranscript_canonicalTranscript] at h + change E.toRandomized.expectedCost lower (M.methods o) e + + ∑' x, E.toRandomized.run (M.methods o) e x * (potential x.2 : ℝ≥0∞) ≤ + upper (M.abs e) o + potential e + rw [StateTransitionSpec.expectedCost_toRandomized, StateTransitionSpec.run_toRandomized, + tsum_eq_single (DataStructure.eval E (M.methods o) e) fun x hx => by + simp [PMF.pure_apply, hx], PMF.pure_apply_self, one_mul] + exact_mod_cast h + +end Refinement + end Cslib.DataStructure diff --git a/Complexity/Probability/KWiseIndependent.lean b/Complexity/Probability/KWiseIndependent.lean index 3fbbf08b1c..da160a7f34 100644 --- a/Complexity/Probability/KWiseIndependent.lean +++ b/Complexity/Probability/KWiseIndependent.lean @@ -61,6 +61,8 @@ tuples gives a better constant. surjective additive group homomorphisms. * `Cslib.Probability.isKWiseIndependentHash_of_surjective`: an additive family whose restrictions to sets of at most `k` points are onto is `k`-wise independent. +* `Cslib.Probability.isKWiseIndependentHash_id`: a uniformly random function is `k`-wise + independent for every `k`. * `Cslib.Probability.IsKWiseIndependentHash.expect_sum_pow_le`: the `2 m`-th moment bound. * `Cslib.Probability.IsKWiseIndependentHash.dens_filter_le_abs_sum`, `Cslib.Probability.IsKWiseIndependentHash.dens_filter_le_abs_sum_sub_expect`: the tail bounds for @@ -443,4 +445,46 @@ theorem isKWiseIndependentHash_of_surjective {k : ℕ} [AddGroup ι] [AddGroup Y rw [Fintype.card_fun, Fintype.card_coe, Nat.cast_pow] at h convert h +/-- **A uniformly random function is `k`-wise independent for every `k`.** The identity family +`id : (X → Y) → X → Y`, whose seed is the whole function, restricts uniformly to every finite set +of points. -/ +theorem isKWiseIndependentHash_id [Fintype X] [DecidableEq X] [Nonempty Y] (k : ℕ) : + IsKWiseIndependentHash k (id : (X → Y) → X → Y) where + dens_filter_restrict_eq {T} _ y := by + let e : (X → Y) ≃ (T → Y) × ({x : X // x ∉ T} → Y) := + { toFun := fun f => (T.restrict f, fun x => f x.1) + invFun := fun p x => if hx : x ∈ T then p.1 ⟨x, hx⟩ else p.2 ⟨x, hx⟩ + left_inv := fun f => by + funext x + dsimp only + split_ifs <;> rfl + right_inv := fun ⟨p₁, p₂⟩ => by + ext ⟨x, hx⟩ + · simp [Finset.restrict, hx] + · simp [hx] } + have hcard_filter : + #{f : X → Y | T.restrict f = y} = Fintype.card ({x : X // x ∉ T} → Y) := by + rw [← Finset.card_univ] + refine Finset.card_nbij' (fun f => (e f).2) (fun g => e.symm (y, g)) ?_ ?_ ?_ ?_ + · intro _ _; exact Finset.mem_univ _ + · intro g _ + simp only [Finset.mem_coe, Finset.mem_filter, Finset.mem_univ, true_and] + exact congrArg Prod.fst (e.apply_symm_apply (y, g)) + · intro f hf + simp only [Finset.mem_coe, Finset.mem_filter, Finset.mem_univ, true_and] at hf + have h1 : (e f).1 = y := hf + calc e.symm (y, (e f).2) = e.symm ((e f).1, (e f).2) := by rw [h1] + _ = f := e.symm_apply_apply f + · intro g _ + exact congrArg Prod.snd (e.apply_symm_apply (y, g)) + have hcard_all : + Fintype.card (X → Y) = + Fintype.card Y ^ #T * Fintype.card ({x : X // x ∉ T} → Y) := by + rw [Fintype.card_congr e, Fintype.card_prod, Fintype.card_fun, Fintype.card_coe] + have hrest_ne : (Fintype.card ({x : X // x ∉ T} → Y) : ℚ≥0) ≠ 0 := + Nat.cast_ne_zero.mpr Fintype.card_ne_zero + dsimp only [id_eq] + rw [Finset.dens_eq_card_div_card, hcard_filter, hcard_all, Nat.cast_mul, Nat.cast_pow, + div_mul_cancel_right₀ hrest_ne] + end Cslib.Probability diff --git a/ComplexityTests/HashFamilyMemory.lean b/ComplexityTests/HashFamilyMemory.lean index ac9483104f..7671466854 100644 --- a/ComplexityTests/HashFamilyMemory.lean +++ b/ComplexityTests/HashFamilyMemory.lean @@ -14,9 +14,10 @@ public import Complexity.DataStructure.HashFamily.Memory A table of two one-bit cells at word size `8`. The tests evaluate a lookup on concrete memory, check that the general theorems apply (room in empty memory, admissibility of every memory call, -the transcript law `evalOps`, call counts for a concrete operation list), and instantiate the -expected amortized certificate and the identical-until-bad step, so that none of their hypotheses -is vacuous here. +the transcript law `evalOps` and the `kWiseSpec` contract, call counts for a concrete operation +list), and instantiate the expected amortized certificate and the identical-until-bad step, so +that none of their hypotheses is vacuous here. A small upper hop with coins of its own is stacked +on the table with `compCoins`, and the stacked law and expected costs are instantiated. -/ @[expose] public section @@ -83,4 +84,86 @@ example {β : Type} (next : List (Sigma (HashFamily.Result (U := 2) (2 ^ 1))) × ⟨fun _ _ _ _ _ _ => rfl, fun _ _ h => h.elim, fun _ _ h => h.elim⟩ _ le_rfl ((tableSpec 2 1).toSpec.demonicValid_of_forall_valid (fun _ _ => trivial) _ _) next b +/-- The operation list has at most two keys per epoch. -/ +theorem bounded : BoundedEpochKeys 2 ops := by + rw [BoundedEpochKeys] + refine ⟨by decide, ?_⟩ + change BoundedEpochKeys 2 [.eval 0, .eval 1] + rw [BoundedEpochKeys] + exact ⟨by decide, trivial⟩ + +/-- The run from allocation meets the `kWiseSpec` contract on the operation list. -/ +example : (kWiseSpec 2 2 (2 ^ 1)).Contract ops + (((Memory.spec 8).toRandomized.withCoins.run + (run 1 2 ((tableSpec 2 1).obliviousClient ops)) empty).map Prod.fst) := + kWiseSpec_contract_run (by omega) bounded empty + +/-! ## A coin-using hop over a coin-using hop -/ + +/-- An upper hop with coins of its own: before each resample it draws a bit and ignores it. -/ +noncomputable def wastefulMethods : + Methods (tableSpec 2 1).toSpec (tableSpec 2 1).withCoins.toSpec + | .resample => ProbOracleComp.sample (ProbComp.unifFin 1) >>= fun _ => + ProbOracleComp.query (spec := HashFamily.Result (U := 2) (2 ^ 1)) .resample + | .eval u => ProbOracleComp.query (spec := HashFamily.Result (U := 2) (2 ^ 1)) (.eval u) + +/-- The wasteful hop refines the random function, since the ignored bit changes no law. -/ +noncomputable def wasteful : RandomizedRefinement (tableSpec 2 1) (tableSpec 2 1).withCoins := + .ofLaw wastefulMethods (fun _ => True) id + (fun _ _ _ => (tableSpec 2 1).withCoins.toSpec.demonicValid_of_forall_valid + (fun _ o => by cases o <;> trivial) _ _) + (fun _ _ _ _ _ _ => trivial) + (fun {θ} o _ _ => by + cases o with + | resample => + have h : (tableSpec 2 1).withCoins.run (wastefulMethods .resample) θ = + (tableSpec 2 1).law .resample θ := by + rw [wastefulMethods, RandomizedSpec.run_bind, RandomizedSpec.withCoins_run_sample, + PMF.bind_map] + change ((ProbComp.unifFin 1).eval.bind fun _ => (tableSpec 2 1).withCoins.run + (OracleComp.query (spec := probOracleSpec _) + (.inr (.resample : HashFamily.Op 2))) θ) = _ + rw [PMF.bind_const, RandomizedSpec.run_query] + rfl + rw [h] + exact PMF.map_id _ + | eval u => + rw [wastefulMethods] + exact (congrArg (PMF.map _) (RandomizedSpec.run_query _ _ _)).trans (PMF.map_id _)) + +/-- The wasteful hop composed over the random table: one stream of coins over memory. -/ +noncomputable def stacked : + RandomizedRefinement (tableSpec 2 1) (Memory.spec 8).toRandomized.withCoins := + wasteful.compCoins (refinement ⟨0, 2⟩ 1 rfl (by omega)) + +/-- The law of a client through both coin-using hops is its law on the random function. -/ +example : ((Memory.spec 8).toRandomized.withCoins.run + (link stacked.methods ((tableSpec 2 1).obliviousClient ops)) ⟨empty.mem, 2⟩).map + (fun (a, e') => (a, stacked.abs e')) = + (tableSpec 2 1).run ((tableSpec 2 1).obliviousClient ops) + (stacked.abs ⟨empty.mem, 2⟩) := + stacked.run_link _ ((RandomizedRefinement.compCoins_inv _ _ _).mpr ⟨le_rfl, trivial⟩) + ((tableSpec 2 1).toSpec.demonicValid_of_forall_valid (fun _ _ => trivial) _ _) + +/-- Expected costs stack across both hops: one unit per memory call or coin, against one more +unit per operation than the table's budget. -/ +example : stacked.ExpectedAmortized (fun _ _ => 1) (fun _ o => budget 2 o + 1) fun _ => 0 := by + have hlower : (tableSpec 2 1).coinCharge (fun _ => 1) (fun _ o => budget 2 o) = + fun _ q => Sum.elim (fun _ => 1) (budget 2) q := by + funext _ q + cases q <;> rfl + have A : wasteful.ExpectedAmortized (fun _ q => Sum.elim (fun _ => 1) (budget 2) q) + (fun _ o => budget 2 o + 1) fun _ => 0 := + .of_isCostBounded fun o => by + cases o with + | resample => + exact OracleComp.IsCostBounded.liftBind_iff.mpr + ⟨by decide, fun _ => (OracleComp.IsCostBounded.query _).mono (by decide)⟩ + | eval u => exact (OracleComp.IsCostBounded.query _).mono (Nat.le_succ _) + rw [← hlower] at A + have B := expectedAmortized (w := 8) (table := ⟨0, 2⟩) (b := 1) rfl (by omega) + rw [← RandomizedSpec.coinCharge_const (D := (Memory.spec 8).toRandomized) 1] at B + unfold stacked + simpa using A.compCoins B + end ComplexityTests.HashFamilyMemory From a944aee861e66736d5e7e7158e288812d0077829 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 19:27:26 -0500 Subject: [PATCH 14/17] feat(Algorithms/Lean/Karger): Karger's contraction algorithm as a randomized client, with its survival bound on the specification For #2205 (decision D10). Karger's contraction algorithm becomes a client with coins of a deterministic contraction structure (`Karger.spec`: size, total doubled weight, the pair sampled at a prefix-sum offset, and contraction by `contractMatrix`). Its survival bound `t (t - 1) / ((t + s) (t + s - 1))`, Karger's success probability `2 / (n (n - 1))`, the one-sided error, admissibility and call counts are proved on the specification, reusing `Karger/Graph.lean` and the `Probability.PMF` event-composition bounds unchanged. Supporting lemmas: `RandomizedSpec.withCoins_run_sample_bind`, `StateTransitionSpec.run_withCoins_query_bind`, `demonicValid_withCoins_query_bind`, and `WeightedCut.cutWeight_fin_two`, `totalDoubledWeight_fin_two`. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 1 + .../Algorithms/Lean/Karger/Contraction.lean | 442 ++++++++++++++++++ .../StateTransition/Randomized.lean | 27 ++ .../Combinatorics/WeightedCut.lean | 19 + ComplexityTests/KargerContraction.lean | 67 +++ 5 files changed, 556 insertions(+) create mode 100644 Complexity/Algorithms/Lean/Karger/Contraction.lean create mode 100644 ComplexityTests/KargerContraction.lean diff --git a/Complexity.lean b/Complexity.lean index 6b738e35aa..cc1c515861 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -16,6 +16,7 @@ public import Complexity.Algorithms.Lean.Huffman.Optimality public import Complexity.Algorithms.Lean.Huffman.TwoQueue public import Complexity.Algorithms.Lean.KMP.Basic public import Complexity.Algorithms.Lean.KMP.Search +public import Complexity.Algorithms.Lean.Karger.Contraction public import Complexity.Algorithms.Lean.Kruskal.Basic public import Complexity.Algorithms.Lean.Kruskal.SimpleGraph public import Complexity.Algorithms.Lean.Matroid.Greedy diff --git a/Complexity/Algorithms/Lean/Karger/Contraction.lean b/Complexity/Algorithms/Lean/Karger/Contraction.lean new file mode 100644 index 0000000000..92b7827b9a --- /dev/null +++ b/Complexity/Algorithms/Lean/Karger/Contraction.lean @@ -0,0 +1,442 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Algorithms.WordRAM.Karger.Graph +public import Complexity.DataStructure.StateTransition.Randomized + +/-! +# Karger's contraction algorithm as a randomized client + +Karger's contraction algorithm [Karger1993] [KargerStein1996] keeps a weighted multigraph on its +current supervertices. It repeatedly picks an edge with probability proportional to its weight +and contracts it. Here the multigraph is an abstract data type, the contraction structure `spec`, +whose state is the weight matrix of the current supervertices (`Graph`) and whose operations are +deterministic: + +* `size` and `total` answer the number of supervertices and the total doubled weight `S`; +* `pairAt r` answers the pair `(u, v)` whose interval of the prefix sums of the weights contains + the offset `r < S` (`sampledPair`, the single-draw sampling of `Karger.Graph`); +* `contract u v` merges `v` into `u` and moves the last supervertex into slot `v` + (`contractMatrix`). + +The algorithm is a client with private coins, a `ProbOracleComp Op.Result` program, run against +`spec.toRandomized.withCoins`. Each step draws a uniform offset below `S`, asks for the pair there +and contracts it (`contractStep`), so it contracts each edge `{u, v}` with probability +`2 W u v / S`. `contractTimes s` makes `s` steps, and `karger` contracts down to two supervertices +and answers half their total weight, the weight of the cut between them. + +All probability is proved here, on the specification. Contracting from `t + s` down to `t` +supervertices preserves a fixed minimum cut with probability at least +`t (t - 1) / ((t + s) (t + s - 1))` (`survives_contractTimes`), so `karger` answers the minimum cut +weight with probability at least `2 / (n (n - 1))` (`two_div_le_toOuterMeasure_karger`), and never +less than it (`minCut_le_of_mem_support_karger`). Every call it makes is admissible +(`demonicValid_karger`). The combinatorics and the one-step bound are `Karger.Graph`'s +(`isContractionOf_contract`, `pullbackCut_contractCut`, `step_survival_prob_ge`, +`telescope_survival_step`), used unchanged, and the composition of the stages is +`Probability.PMF.toOuterMeasure_bind_ge_mul_ennreal`. + +The word-RAM implementation proves the same bound on machine states, interleaved with register +steps (`Cslib.Algorithms.WordRAM.Karger.contractDownTo_spec`). Here no register, address or +instruction count appears. An implementation of `spec` over the memory oracle is a separate, +deterministic hop, and `Refinement.toRandomized` with `RandomizedRefinement.withCoins` carries the +law of the client through it. + +## Main definitions + +* `Graph`, `Op`, `step`, `valid`, `spec`: the contraction structure. +* `sampledPair`, `contractGraph`: the pair sampled at an offset, and contraction. +* `contractStep`, `contractTimes`, `karger`: the algorithm as a client with coins. +* `Survives`: a cut of the input survives in a contracted graph. + +## Main results + +* `survives_contractTimes`: the survival bound. +* `two_div_le_toOuterMeasure_karger`: Karger's success probability. +* `isContractionOf_of_mem_support_contractTimes`, `minCut_le_of_mem_support_karger`: every + outcome is a contraction, so the answer is never below the minimum cut weight. +* `isCostBounded_contractStep`, `isCostBounded_contractTimes`: each contraction makes one coin + call and at most four calls of the structure. +* `demonicValid_contractTimes`, `demonicValid_karger`: every call is admissible. + +## References + +* [D. R. Karger, *Global Min-cuts in RNC, and Other Ramifications of a Simple Min-Cut + Algorithm*][Karger1993] +* [D. R. Karger and C. Stein, *A New Approach to the Minimum Cut Problem*][KargerStein1996] +-/ + +@[expose] public section + +namespace Cslib.Algorithms.Lean.Karger + +open scoped ENNReal +open Cslib.WeightedCut Cslib.Algorithms.WordRAM.Karger Cslib.DataStructure + +/-! ## The contraction structure -/ + +/-- A weighted multigraph on `size` supervertices, given by its weight matrix. -/ +structure Graph where + /-- The number of supervertices. -/ + size : ℕ + /-- The weight matrix. -/ + weight : Fin size → Fin size → ℕ + +/-- The operations of the contraction structure. -/ +inductive Op where + /-- The number of supervertices. -/ + | size + /-- The total doubled weight, the sum of the weighted degrees. -/ + | total + /-- The pair sampled at offset `r` of the prefix sums of the weights. -/ + | pairAt (r : ℕ) + /-- Merge supervertex `v` into `u`. -/ + | contract (u v : ℕ) + +/-- The answer type of each operation. -/ +abbrev Op.Result : Op → Type + | .size => ℕ + | .total => ℕ + | .pairAt _ => ℕ × ℕ + | .contract _ _ => Unit + +open Classical in +/-- The pair sampled at offset `r`: the pair `(u, v)` whose interval of the prefix sums of the +weights contains `r` (`IsSampledPair`), or `(0, 0)` if there is none. -/ +noncomputable def sampledPair {k : ℕ} (W : Fin k → Fin k → ℕ) (r : ℕ) : ℕ × ℕ := + if h : ∃ p : Fin k × Fin k, IsSampledPair W r p.1 p.2 then + Prod.map Fin.val Fin.val (Classical.choose h) + else (0, 0) + +/-- Contraction: merge `v` into `u` and move the last supervertex into slot `v` +(`contractMatrix`). Arguments out of range leave the graph unchanged. -/ +def contractGraph : Graph → ℕ → ℕ → Graph + | ⟨k + 1, W⟩, u, v => + if h : u < k + 1 ∧ v < k + 1 then ⟨k, contractMatrix W ⟨u, h.1⟩ ⟨v, h.2⟩⟩ else ⟨k + 1, W⟩ + | G, _, _ => G + +/-- The transition function of the contraction structure. -/ +noncomputable def step (G : Graph) : (o : Op) → Graph × o.Result + | .size => (G, G.size) + | .total => (G, totalDoubledWeight G.weight) + | .pairAt r => (G, sampledPair G.weight r) + | .contract u v => (contractGraph G u v, ()) + +/-- Admissibility: an offset below the total weight, and two distinct supervertices. -/ +def valid (G : Graph) : Op → Prop + | .pairAt r => r < totalDoubledWeight G.weight + | .contract u v => u < G.size ∧ v < G.size ∧ u ≠ v + | _ => True + +/-- The contraction structure. -/ +noncomputable abbrev spec : StateTransitionSpec := StateTransitionSpec.ofFn step valid + +/-- The pair sampled at an offset is the unique pair whose interval contains it. -/ +theorem sampledPair_eq {k : ℕ} {W : Fin k → Fin k → ℕ} {r : ℕ} {u v : Fin k} + (h : IsSampledPair W r u v) : sampledPair W r = ((u : ℕ), (v : ℕ)) := by + have hex : ∃ p : Fin k × Fin k, IsSampledPair W r p.1 p.2 := ⟨(u, v), h⟩ + obtain ⟨hu, hv⟩ := isSampledPair_unique W (Classical.choose_spec hex) h + rw [sampledPair, dite_eq_left hex, ← hu, ← hv] + rfl + +/-- Contracting two supervertices in range is `contractMatrix`. -/ +theorem contractGraph_fin {m : ℕ} (W : Fin (m + 1) → Fin (m + 1) → ℕ) (u v : Fin (m + 1)) : + contractGraph ⟨m + 1, W⟩ u v = ⟨m, contractMatrix W u v⟩ := by + rw [contractGraph, dite_eq_left ⟨u.isLt, v.isLt⟩] + +/-! ## The algorithm -/ + +/-- A call of the contraction structure, in a program with coins. -/ +abbrev call (o : Op) : ProbOracleComp Op.Result o.Result := ProbOracleComp.query o + +/-- One contraction: draw a uniform offset below the total weight, and contract the pair sampled +there. A weightless graph contracts its first and last supervertices. -/ +noncomputable def contractStep : ProbOracleComp Op.Result Unit := do + let k ← call .size + let S ← call .total + if S = 0 then call (.contract 0 (k - 1)) else do + let r ← ProbOracleComp.sample (ProbComp.unifFin (S - 1)) + let (u, v) ← call (.pairAt r) + call (.contract u v) + +/-- Contract `s` times. -/ +noncomputable def contractTimes : ℕ → ProbOracleComp Op.Result Unit + | 0 => pure () + | s + 1 => contractStep >>= fun _ => contractTimes s + +/-- **Karger's algorithm**: contract down to two supervertices, and answer the weight between +them, half their total weight. -/ +noncomputable def karger : ProbOracleComp Op.Result ℕ := do + let k ← call .size + contractTimes (k - 2) + let S ← call .total + pure (S / 2) + +/-! ## Runs -/ + +/-- One contraction of a graph of positive weight draws a uniform offset below the weight and +contracts the pair sampled there. -/ +private theorem run_contractStep_bind {α : Type} (p : ProbOracleComp Op.Result α) {m : ℕ} + (W : Fin (m + 1) → Fin (m + 1) → ℕ) (hS : totalDoubledWeight W ≠ 0) : + spec.toRandomized.withCoins.run (contractStep >>= fun _ => p) ⟨m + 1, W⟩ = + (ProbComp.unifOracle (totalDoubledWeight W - 1)).bind fun r => + spec.toRandomized.withCoins.run p + (contractGraph ⟨m + 1, W⟩ (sampledPair W r).1 (sampledPair W r).2) := by + simp only [contractStep, bind_assoc] + rw [StateTransitionSpec.run_withCoins_query_bind, StateTransitionSpec.run_withCoins_query_bind] + dsimp only [StateTransitionSpec.stepFn, step] + simp only [hS, ite_false, bind_assoc] + rw [RandomizedSpec.withCoins_run_sample_bind, ProbComp.eval_unifFin] + refine congrArg _ (funext fun r => ?_) + rw [StateTransitionSpec.run_withCoins_query_bind, StateTransitionSpec.run_withCoins_query_bind] + rfl + +/-- One contraction of a weightless graph contracts its first and last supervertices. -/ +private theorem run_contractStep_bind_of_eq_zero {α : Type} (p : ProbOracleComp Op.Result α) + {m : ℕ} (W : Fin (m + 1) → Fin (m + 1) → ℕ) (hS : totalDoubledWeight W = 0) : + spec.toRandomized.withCoins.run (contractStep >>= fun _ => p) ⟨m + 1, W⟩ = + spec.toRandomized.withCoins.run p ⟨m, contractMatrix W 0 (Fin.last m)⟩ := by + simp only [contractStep, bind_assoc] + rw [StateTransitionSpec.run_withCoins_query_bind, StateTransitionSpec.run_withCoins_query_bind] + dsimp only [StateTransitionSpec.stepFn, step] + simp only [hS, ite_true] + rw [StateTransitionSpec.run_withCoins_query_bind] + exact congrArg _ (contractGraph_fin W 0 (Fin.last m)) + +/-! ## Survival of a minimum cut -/ + +/-- The cut `C` of `W₀` survives in `G`: `G` is a contraction of `W₀` to `t` supervertices along +some map, under which `C` is the preimage of a cut. -/ +def Survives {n : ℕ} (W₀ : Fin n → Fin n → ℕ) (C : Finset (Fin n)) (t : ℕ) (G : Graph) : Prop := + ∃ (W : Fin t → Fin t → ℕ) (part : Fin n → Fin t) (B : Finset (Fin t)), + G = ⟨t, W⟩ ∧ IsContractionOf W₀ part W ∧ pullbackCut part B = C + +/-- **Survival of a minimum cut** [KargerStein1996]. Contracting a contraction of a connected +multigraph `W₀` from `t + s` down to `t ≥ 2` supervertices preserves a fixed minimum cut with +probability at least `t (t - 1) / ((t + s) (t + s - 1))`. -/ +theorem survives_contractTimes {n t : ℕ} (ht : 2 ≤ t) {W₀ : Fin n → Fin n → ℕ} + (hmin : 0 < minCut W₀) (s : ℕ) {W : Fin (t + s) → Fin (t + s) → ℕ} + {part : Fin n → Fin (t + s)} (hC : IsContractionOf W₀ part W) {B : Finset (Fin (t + s))} + (hB : IsNonTrivialCut B) (hBmin : cutWeight W₀ (pullbackCut part B) = minCut W₀) : + ((t * (t - 1) : ℕ) : ℝ≥0∞) / (((t + s) * (t + s - 1) : ℕ) : ℝ≥0∞) ≤ + (spec.toRandomized.withCoins.run (contractTimes s) ⟨t + s, W⟩).toOuterMeasure + {x | Survives W₀ (pullbackCut part B) t x.2} := by + induction s with + | zero => + have hpos : ((t * (t - 1) : ℕ) : ℝ≥0∞) ≠ 0 := by + exact_mod_cast (Nat.mul_pos (by omega) (by omega)).ne' + change ((t * (t - 1) : ℕ) : ℝ≥0∞) / ((t * (t - 1) : ℕ) : ℝ≥0∞) ≤ + (PMF.pure ((), (⟨t, W⟩ : Graph))).toOuterMeasure _ + rw [ENNReal.div_self hpos (ENNReal.natCast_ne_top _), PMF.toOuterMeasure_pure_apply, + ite_eq_left ⟨W, part, B, rfl, hC, rfl⟩] + | succ s ih => + have hcard : 2 ≤ Fintype.card (Fin (t + s + 1)) := by rw [Fintype.card_fin]; omega + have hminW : minCut W₀ ≤ minCut W := minCut_le_of_isContractionOf hcard hC + have hS : 0 < totalDoubledWeight W := + totalDoubledWeight_pos_of_minCut_pos hcard hC.multigraph (lt_of_lt_of_le hmin hminW) + change _ ≤ (spec.toRandomized.withCoins.run (contractStep >>= fun _ => contractTimes s) + ⟨t + s + 1, W⟩).toOuterMeasure _ + rw [run_contractStep_bind (m := t + s) _ W hS.ne', + show (t + (s + 1)) * (t + (s + 1) - 1) = (t + s + 1) * (t + s) by + rw [show t + (s + 1) - 1 = t + s by omega]; rfl, + ← telescope_survival_step ht (show t ≤ t + s by omega)] + let castFin : Fin (totalDoubledWeight W - 1 + 1) ≃ Fin (totalDoubledWeight W) := + finCongr (by omega) + have hdeg : (t + s + 1) * cutWeight W B ≤ totalDoubledWeight W := by + have hmul := mul_minCut_le_totalDoubledWeight hcard hC.multigraph + rw [Fintype.card_fin] at hmul + rw [← cutWeight_pullbackCut hC B, hBmin] + exact (Nat.mul_le_mul_left _ hminW).trans hmul + have hstep : ((t + s - 1 : ℕ) : ℝ≥0∞) / (t + s + 1 : ℕ) ≤ + (ProbComp.unifOracle (totalDoubledWeight W - 1)).toOuterMeasure + {r | SampleSurvives W B (castFin r)} := by + have : Nonempty (Fin (totalDoubledWeight W)) := ⟨⟨0, hS⟩⟩ + have h := step_survival_prob_ge (by omega) hC.multigraph hS hdeg + rw [show t + (s + 1) - 2 = t + s - 1 by omega, + ← Probability.PMF.uniformOfFintype_map_equiv castFin, + PMF.toOuterMeasure_map_apply] at h + exact h + refine Probability.PMF.toOuterMeasure_bind_ge_mul_ennreal _ _ _ _ hstep fun r _ hr => ?_ + obtain ⟨u, v, hsamp, hsame⟩ := hr + have hsamp : IsSampledPair W r u v := hsamp + have huv : u ≠ v := isSampledPair_ne hC.multigraph hsamp + have hpb := pullbackCut_contractCut part huv hsame + have hnt : IsNonTrivialCut (contractCut v B) := + isNonTrivialCut_of_pullbackCut _ (hpb ▸ isNonTrivialCut_pullbackCut hC.surj hB) + rw [sampledPair_eq hsamp, contractGraph_fin, ← hpb] + exact ih (isContractionOf_contract hC huv) hnt (hpb ▸ hBmin) + +/-! ## Karger's theorem -/ + +/-- Every outcome of `s` contractions of a contraction of `W₀` from `t + s ≥ 2` supervertices is a +contraction of `W₀` to `t` supervertices. -/ +theorem isContractionOf_of_mem_support_contractTimes {n t : ℕ} (ht : 1 ≤ t) + {W₀ : Fin n → Fin n → ℕ} (s : ℕ) {W : Fin (t + s) → Fin (t + s) → ℕ} + {part : Fin n → Fin (t + s)} (hC : IsContractionOf W₀ part W) {x : Unit × Graph} + (hx : x ∈ (spec.toRandomized.withCoins.run (contractTimes s) ⟨t + s, W⟩).support) : + ∃ (W' : Fin t → Fin t → ℕ) (part' : Fin n → Fin t), + x.2 = ⟨t, W'⟩ ∧ IsContractionOf W₀ part' W' := by + induction s with + | zero => + obtain rfl := (PMF.mem_support_pure_iff _ _).mp hx + exact ⟨W, part, rfl, hC⟩ + | succ s ih => + change x ∈ (spec.toRandomized.withCoins.run (contractStep >>= fun _ => contractTimes s) + ⟨t + s + 1, W⟩).support at hx + by_cases hS : totalDoubledWeight W = 0 + · rw [run_contractStep_bind_of_eq_zero (m := t + s) _ W hS] at hx + have h0 : (0 : Fin (t + s + 1)) ≠ Fin.last (t + s) := by + rw [Ne, Fin.ext_iff, Fin.val_zero, Fin.val_last] + omega + exact ih (isContractionOf_contract hC h0) hx + · rw [run_contractStep_bind (m := t + s) _ W hS, PMF.mem_support_bind_iff] at hx + obtain ⟨r, -, hx⟩ := hx + obtain ⟨u, v, hsamp⟩ := exists_isSampledPair W (show (r : ℕ) < totalDoubledWeight W by + have := r.isLt + omega) + rw [sampledPair_eq hsamp, contractGraph_fin] at hx + exact ih (isContractionOf_contract hC (isSampledPair_ne hC.multigraph hsamp)) hx + +/-- Running `karger` from `n = 2 + s` supervertices contracts `s` times, then answers half the +total weight. -/ +private theorem run_karger {s : ℕ} (W : Fin (2 + s) → Fin (2 + s) → ℕ) : + spec.toRandomized.withCoins.run karger ⟨2 + s, W⟩ = + (spec.toRandomized.withCoins.run (contractTimes s) ⟨2 + s, W⟩).bind fun x => + PMF.pure (totalDoubledWeight x.2.weight / 2, x.2) := by + rw [karger, StateTransitionSpec.run_withCoins_query_bind] + dsimp only [StateTransitionSpec.stepFn, step] + rw [Nat.add_sub_cancel_left, RandomizedSpec.run_bind] + exact congrArg _ (funext fun ⟨_, G⟩ => + StateTransitionSpec.run_withCoins_query_bind (D := spec) Op.total (fun S => pure (S / 2)) G) + +/-- **Karger's theorem** [Karger1993]. On a connected multigraph with `n ≥ 2` vertices, `karger` +answers the minimum cut weight with probability at least `2 / (n (n - 1))`. -/ +theorem two_div_le_toOuterMeasure_karger {n : ℕ} (hn : 2 ≤ n) {W₀ : Fin n → Fin n → ℕ} + (hW₀ : IsMultigraph W₀) (hmin : 0 < minCut W₀) : + (2 : ℝ≥0∞) / ((n * (n - 1) : ℕ) : ℝ≥0∞) ≤ + (spec.toRandomized.withCoins.run karger ⟨n, W₀⟩).toOuterMeasure {x | x.1 = minCut W₀} := by + obtain ⟨s, rfl⟩ : ∃ s, n = 2 + s := ⟨n - 2, by omega⟩ + obtain ⟨C, hC, hCmin⟩ := exists_minCut_achiever (by rw [Fintype.card_fin]; omega) W₀ + have hid : pullbackCut id C = C := by + ext x + simp [mem_pullbackCut] + have hsurv := survives_contractTimes le_rfl hmin s (isContractionOf_id hW₀) hC + (by rw [hid, hCmin]) + rw [hid] at hsurv + rw [run_karger, show (2 : ℝ≥0∞) / ((2 + s) * (2 + s - 1) : ℕ) = + ((2 * (2 - 1) : ℕ) : ℝ≥0∞) / ((2 + s) * (2 + s - 1) : ℕ) * 1 by norm_num] + refine Probability.PMF.toOuterMeasure_bind_ge_mul_ennreal _ _ _ _ hsurv + fun x _ ⟨W', part', B', hx, hC', hpb⟩ => ?_ + have hB' : IsNonTrivialCut B' := isNonTrivialCut_of_pullbackCut part' (hpb ▸ hC) + have hcut : W' 0 1 = minCut W₀ := by + rw [← cutWeight_fin_two hC'.multigraph hB', ← cutWeight_pullbackCut hC', hpb, hCmin] + rw [hx, PMF.toOuterMeasure_pure_apply, ite_eq_left] + change totalDoubledWeight W' / 2 = minCut W₀ + rw [totalDoubledWeight_fin_two hC'.multigraph, ← hcut] + omega + +/-- **One-sided error.** Every answer of `karger` on a multigraph with `n ≥ 2` vertices is the +weight of a non-trivial cut, so it is never below the minimum cut weight. -/ +theorem minCut_le_of_mem_support_karger {n : ℕ} (hn : 2 ≤ n) {W₀ : Fin n → Fin n → ℕ} + (hW₀ : IsMultigraph W₀) {x : ℕ × Graph} + (hx : x ∈ (spec.toRandomized.withCoins.run karger ⟨n, W₀⟩).support) : minCut W₀ ≤ x.1 := by + obtain ⟨s, rfl⟩ : ∃ s, n = 2 + s := ⟨n - 2, by omega⟩ + rw [run_karger, PMF.mem_support_bind_iff] at hx + obtain ⟨y, hy, hx⟩ := hx + obtain ⟨W', part', hy', hC'⟩ := + isContractionOf_of_mem_support_contractTimes (t := 2) (by norm_num) s + (isContractionOf_id hW₀) hy + obtain rfl := (PMF.mem_support_pure_iff _ _).mp hx + obtain ⟨-, hcw, hle⟩ := two_vertex_contraction_output hC' + change minCut W₀ ≤ totalDoubledWeight y.2.weight / 2 + rw [hy'] + change minCut W₀ ≤ totalDoubledWeight W' / 2 + rw [totalDoubledWeight_fin_two hC'.multigraph] + omega + +/-! ## Calls -/ + +/-- One contraction makes at most one coin call and four calls of the structure. -/ +theorem isCostBounded_contractStep {cost : ℕ ⊕ Op → ℕ} {a b : ℕ} + (hcoin : ∀ n, cost (.inl n) ≤ a) (hop : ∀ o, cost (.inr o) ≤ b) : + OracleComp.IsCostBounded cost contractStep (a + 4 * b) := by + have hq (o : Op) {m : ℕ} (hm : b ≤ m) : + OracleComp.IsCostBounded cost (call o) m := + (OracleComp.IsCostBounded.query _).mono ((hop o).trans hm) + have h₁ := hop .size + have h₂ := hop .total + refine OracleComp.IsCostBounded.liftBind_iff.mpr ⟨by omega, fun k => ?_⟩ + refine OracleComp.IsCostBounded.liftBind_iff.mpr ⟨by omega, fun S => ?_⟩ + change OracleComp.IsCostBounded cost (if S = 0 then _ else _) _ + split_ifs + · exact hq _ (by omega) + · have h₃ := hcoin (S - 1) + refine OracleComp.IsCostBounded.liftBind_iff.mpr ⟨by omega, fun r => ?_⟩ + have h₄ := hop (.pairAt r) + exact OracleComp.IsCostBounded.liftBind_iff.mpr ⟨by omega, fun _ => hq _ (by omega)⟩ + +/-- `s` contractions make at most `s` coin calls and `4 s` calls of the structure. -/ +theorem isCostBounded_contractTimes {cost : ℕ ⊕ Op → ℕ} {a b : ℕ} + (hcoin : ∀ n, cost (.inl n) ≤ a) (hop : ∀ o, cost (.inr o) ≤ b) (s : ℕ) : + OracleComp.IsCostBounded cost (contractTimes s) (s * (a + 4 * b)) := by + induction s with + | zero => exact .pure _ _ + | succ s ih => + exact ((isCostBounded_contractStep hcoin hop).bind fun _ => ih).mono + (le_of_eq (by ring)) + +/-! ## Admissibility -/ + +/-- Every call of `s` contractions of a multigraph on `t + s ≥ 2` supervertices is admissible. -/ +theorem demonicValid_contractTimes {t : ℕ} (ht : 1 ≤ t) (s : ℕ) + {W : Fin (t + s) → Fin (t + s) → ℕ} (hW : IsMultigraph W) : + spec.toRandomized.withCoins.toSpec.DemonicValid ⟨t + s, W⟩ (contractTimes s) := by + induction s with + | zero => exact .pure _ _ + | succ s ih => + change spec.toRandomized.withCoins.toSpec.DemonicValid ⟨t + s + 1, W⟩ + (contractStep >>= fun _ => contractTimes s) + simp only [contractStep, bind_assoc] + refine StateTransitionSpec.demonicValid_withCoins_query_bind trivial + (StateTransitionSpec.demonicValid_withCoins_query_bind trivial ?_) + dsimp only [StateTransitionSpec.stepFn, step] + by_cases hS : totalDoubledWeight W = 0 + · simp only [hS, ite_true] + refine StateTransitionSpec.demonicValid_withCoins_query_bind + (show 0 < t + s + 1 ∧ t + s + 1 - 1 < t + s + 1 ∧ 0 ≠ t + s + 1 - 1 by omega) ?_ + dsimp only [StateTransitionSpec.stepFn, step] + rw [show t + s + 1 - 1 = ((Fin.last (t + s) : Fin (t + s + 1)) : ℕ) from rfl, + show (0 : ℕ) = ((0 : Fin (t + s + 1)) : ℕ) from rfl, contractGraph_fin] + exact ih (isMultigraph_contractMatrix hW _ _) + · simp only [hS, ite_false, bind_assoc] + refine RandomizedSpec.demonicValid_sample_bind fun r => ?_ + have hr : (r : ℕ) < totalDoubledWeight W := by + have := r.isLt + omega + obtain ⟨u, v, hsamp⟩ := exists_isSampledPair W hr + refine StateTransitionSpec.demonicValid_withCoins_query_bind hr ?_ + dsimp only [StateTransitionSpec.stepFn, step] + rw [sampledPair_eq hsamp] + refine StateTransitionSpec.demonicValid_withCoins_query_bind + ⟨u.isLt, v.isLt, Fin.val_ne_of_ne (isSampledPair_ne hW hsamp)⟩ ?_ + dsimp only [StateTransitionSpec.stepFn, step] + rw [contractGraph_fin] + exact ih (isMultigraph_contractMatrix hW u v) + +/-- Every call of `karger` on a multigraph with `n ≥ 2` vertices is admissible. -/ +theorem demonicValid_karger {n : ℕ} (hn : 2 ≤ n) {W₀ : Fin n → Fin n → ℕ} + (hW₀ : IsMultigraph W₀) : + spec.toRandomized.withCoins.toSpec.DemonicValid ⟨n, W₀⟩ karger := by + obtain ⟨s, rfl⟩ : ∃ s, n = 2 + s := ⟨n - 2, by omega⟩ + refine StateTransitionSpec.demonicValid_withCoins_query_bind trivial ?_ + dsimp only [StateTransitionSpec.stepFn, step] + rw [Nat.add_sub_cancel_left] + refine StateTransitionSpec.DemonicValid.bind (demonicValid_contractTimes (by omega) s hW₀) + fun _ _ _ _ => StateTransitionSpec.demonicValid_withCoins_query_bind trivial (.pure _ _) + +end Cslib.Algorithms.Lean.Karger diff --git a/Complexity/DataStructure/StateTransition/Randomized.lean b/Complexity/DataStructure/StateTransition/Randomized.lean index 7e9702fd14..d0fcc84322 100644 --- a/Complexity/DataStructure/StateTransition/Randomized.lean +++ b/Complexity/DataStructure/StateTransition/Randomized.lean @@ -317,6 +317,15 @@ theorem demonicValid_sample_bind {q : ProbComp β} {k : β → OracleComp D.with subst hs exact ih i +/-- A closed sampler followed by a continuation draws a value, then runs the continuation from +the same state. -/ +theorem withCoins_run_sample_bind (q : ProbComp β) (k : β → OracleComp D.withCoins.Result α) + (s : D.State) : + D.withCoins.run (ProbOracleComp.sample q >>= k) s = + (ProbComp.eval q).bind fun b => D.withCoins.run (k b) s := by + rw [run_bind, withCoins_run_sample, PMF.bind_map] + rfl + /-- A coin call draws uniformly and leaves the state unchanged. -/ theorem withCoins_law_inl (n : ℕ) (s : D.State) : D.withCoins.law (.inl n) s = (ProbComp.unifOracle n).map (·, s) := rfl @@ -416,6 +425,24 @@ theorem toRandomized_demonicValid_of_validHistory {p : D.Client α} {s : D.State (h : D.ValidHistory s (D.clientHistory s p)) : D.toRandomized.toSpec.DemonicValid s p := toRandomized_demonicValid ((D.demonicValid_iff_validHistory_runClient s p).mpr h) +/-- Over a deterministic specification with coins, a call steps the state and continues with its +answer. -/ +theorem run_withCoins_query_bind {β : Type} (o : D.Op) (k : D.Result o → ProbOracleComp D.Result β) + (s : D.State) : + D.toRandomized.withCoins.run (ProbOracleComp.query o >>= k) s = + D.toRandomized.withCoins.run (k (D.stepFn s o).2) (D.stepFn s o).1 := + PMF.pure_bind _ _ + +/-- Over a deterministic specification with coins, an admissible call whose continuation is +admissible from the next state is admissible. -/ +theorem demonicValid_withCoins_query_bind {β : Type} {o : D.Op} + {k : D.Result o → ProbOracleComp D.Result β} {s : D.State} (hv : D.valid s o) + (hk : D.toRandomized.withCoins.toSpec.DemonicValid (D.stepFn s o).1 (k (D.stepFn s o).2)) : + D.toRandomized.withCoins.toSpec.DemonicValid s (ProbOracleComp.query o >>= k) := + .liftBind (D := D.toRandomized.withCoins.toSpec) (Sum.inr o) k hv fun s' a hstep => by + obtain ⟨rfl, rfl⟩ := Prod.mk.inj ((PMF.mem_support_pure_iff _ _).mp hstep) + exact hk + /-- The expected charge of a deterministic run is the total charge of its history. -/ theorem expectedCost_toRandomized (charge : D.State → D.Op → ℕ) (p : D.Client α) (s : D.State) : diff --git a/Complexity/Foundations/Combinatorics/WeightedCut.lean b/Complexity/Foundations/Combinatorics/WeightedCut.lean index 9b72642631..3e64309752 100644 --- a/Complexity/Foundations/Combinatorics/WeightedCut.lean +++ b/Complexity/Foundations/Combinatorics/WeightedCut.lean @@ -49,6 +49,8 @@ weights; see `Complexity.Foundations.Combinatorics.WeightedCut.Multigraph`. * `Cslib.WeightedCut.cutWeight_compl`: a cut and its complement have the same weight. * `Cslib.WeightedCut.cutWeight_singleton`: a singleton cut weighs the degree of its vertex. +* `Cslib.WeightedCut.cutWeight_fin_two`, `Cslib.WeightedCut.totalDoubledWeight_fin_two`: on two + vertices, every non-trivial cut weighs the weight of the edge, and the degrees sum to twice it. * `Cslib.WeightedCut.le_minCut_iff`: with at least two vertices, `m ≤ minCut W` exactly when every non-trivial cut weighs at least `m`. * `Cslib.WeightedCut.mul_minCut_le_totalDoubledWeight`: `|V| * minCut W` is at most the sum of the @@ -183,6 +185,23 @@ theorem cutWeight_two_singleton_zero {W : Fin 2 → Fin 2 → ℕ} (hW : IsMulti unfold rowDeg rw [Fin.sum_univ_two, hW.2 0, zero_add] +/-- On two vertices, every non-trivial cut weighs the weight of the edge. -/ +theorem cutWeight_fin_two {W : Fin 2 → Fin 2 → ℕ} (hW : IsMultigraph W) {B : Finset (Fin 2)} + (hB : IsNonTrivialCut B) : cutWeight W B = W 0 1 := by + rw [isNonTrivialCut_iff_card, Fintype.card_fin] at hB + obtain ⟨b, rfl⟩ := Finset.card_eq_one.mp (show B.card = 1 by omega) + match b with + | 0 => exact cutWeight_two_singleton_zero hW + | 1 => + rw [show ({1} : Finset (Fin 2)) = Finset.univ \ {0} by decide, cutWeight_compl hW, + cutWeight_two_singleton_zero hW] + +/-- On two vertices, the sum of the degrees is twice the weight of the edge. -/ +theorem totalDoubledWeight_fin_two {W : Fin 2 → Fin 2 → ℕ} (hW : IsMultigraph W) : + totalDoubledWeight W = 2 * W 0 1 := by + simp only [totalDoubledWeight, rowDeg, Fin.sum_univ_two, hW.2, hW.1 1 0] + omega + /-- Global minimum cut weight of a multigraph `W`, defined as the greatest lower bound of `cutWeight W C` over all non-trivial cuts `C`. -/ noncomputable def minCut (W : V → V → ℕ) : ℕ := diff --git a/ComplexityTests/KargerContraction.lean b/ComplexityTests/KargerContraction.lean new file mode 100644 index 0000000000..32ff8bf8fa --- /dev/null +++ b/ComplexityTests/KargerContraction.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: local-only (test driver) + +public import Complexity.Algorithms.Lean.Karger.Contraction + +/-! +# Karger's contraction algorithm on a triangle + +The unit-weight triangle is a connected multigraph with minimum cut weight `2`. The tests evaluate +operations of the contraction structure on it, and instantiate the success bound `1 / 3`, the +one-sided error, admissibility and the call counts, so that none of their hypotheses is vacuous. +-/ + +@[expose] public section + +namespace ComplexityTests.KargerContraction + +open scoped ENNReal +open Cslib Cslib.WeightedCut Cslib.DataStructure Cslib.Algorithms.Lean.Karger + +/-- The triangle with unit weights. -/ +def triangle : Fin 3 → Fin 3 → ℕ := fun i j => if i = j then 0 else 1 + +theorem isMultigraph_triangle : IsMultigraph triangle := ⟨by decide, by decide⟩ + +/-- Every non-trivial cut of the triangle cuts two edges. -/ +theorem minCut_triangle : 0 < minCut triangle := + (minCut_pos_iff (by simp) _).mpr (by unfold IsNonTrivialCut; decide) + +/-- The size and the total doubled weight of the triangle. -/ +example : (step ⟨3, triangle⟩ .size).2 = 3 ∧ (step ⟨3, triangle⟩ .total).2 = 6 := by decide + +/-- The offsets `0` and `1` of the prefix sums sample the edges `(0, 1)` and `(0, 2)`. -/ +example : sampledPair triangle 0 = (0, 1) ∧ sampledPair triangle 1 = (0, 2) := + ⟨sampledPair_eq (u := 0) (v := 1) (by decide), sampledPair_eq (u := 0) (v := 2) (by decide)⟩ + +/-- Karger's algorithm finds the minimum cut of the triangle with probability at least `1 / 3`. -/ +example : (2 : ℝ≥0∞) / ((3 * (3 - 1) : ℕ) : ℝ≥0∞) ≤ + (spec.toRandomized.withCoins.run karger ⟨3, triangle⟩).toOuterMeasure + {x | x.1 = minCut triangle} := + two_div_le_toOuterMeasure_karger (by norm_num) isMultigraph_triangle minCut_triangle + +/-- Every answer is at least the minimum cut weight. -/ +example {x : ℕ × Graph} + (hx : x ∈ (spec.toRandomized.withCoins.run karger ⟨3, triangle⟩).support) : + minCut triangle ≤ x.1 := + minCut_le_of_mem_support_karger (by norm_num) isMultigraph_triangle hx + +/-- Every call is admissible. -/ +example : spec.toRandomized.withCoins.toSpec.DemonicValid ⟨3, triangle⟩ karger := + demonicValid_karger (by norm_num) isMultigraph_triangle + +/-- One contraction makes at most five calls, one of them a coin. -/ +example : OracleComp.IsQueryBounded (contractTimes 1) 5 := + isCostBounded_contractTimes (a := 1) (b := 1) (fun _ => le_rfl) (fun _ => le_rfl) 1 + +example : OracleComp.IsCostBounded (fun q => Sum.elim (fun _ => 1) (fun _ => 0) q) + (contractTimes 1) 1 := + isCostBounded_contractTimes (a := 1) (b := 0) (fun _ => le_rfl) (fun _ => le_rfl) 1 + +end ComplexityTests.KargerContraction From eb950a079ae9d22a02e64c1bd6de8ef6076df132 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 20:45:20 -0500 Subject: [PATCH 15/17] fix(StateTransition): use OracleComp.sumHandler after #2201 #2201 retired `ProbOracleComp.handler` and `handler_eq_sumHandler`. The coin interface `withCoins` now uses the canonical `OracleComp.sumHandler`, which `ProbOracleComp.handler` was equal to. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity/DataStructure/StateTransition/Randomized.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Complexity/DataStructure/StateTransition/Randomized.lean b/Complexity/DataStructure/StateTransition/Randomized.lean index 19db253b4e..03fcab6cd3 100644 --- a/Complexity/DataStructure/StateTransition/Randomized.lean +++ b/Complexity/DataStructure/StateTransition/Randomized.lean @@ -245,7 +245,7 @@ noncomputable abbrev withCoins (E : RandomizedSpec) : RandomizedSpec where State := E.State Op := ℕ ⊕ E.Op Result := probOracleSpec E.Result - law := ProbOracleComp.handler (fun n => StateT.lift (ProbComp.unifOracle n)) E.law + law := OracleComp.sumHandler (fun n => StateT.lift (ProbComp.unifOracle n)) E.law valid s | .inl _ => True | .inr o => E.valid s o @@ -255,7 +255,7 @@ variable {D} /-- A program over `E` alone runs as over `E`. -/ @[simp] theorem withCoins_run_liftRight (p : OracleComp D.Result α) (s : D.State) : D.withCoins.run (OracleComp.liftRight p) s = D.run p s := by - simp only [run, ProbOracleComp.handler_eq_sumHandler, OracleComp.interpret_sumHandler_liftRight] + simp only [run, OracleComp.interpret_sumHandler_liftRight] /-- A closed sampler draws its value and leaves the state unchanged. -/ @[simp] theorem withCoins_run_sample (q : ProbComp α) (s : D.State) : From 86093f013db587270936092e860d6c307df68244 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 21:59:36 -0500 Subject: [PATCH 16/17] refactor(Algorithms/WordRAM/Karger): derive contraction survival from Karger.spec `contractDownTo` now simulates the client `Lean.Karger.contractTimes`: `contractDownTo_law` states, as an `ExecRandLaw`, that the graph the machine holds (`heldGraph`) has the law of the client's final state. Each step's `rand` call has the law of the client's coin, and `postRandStep_exec` contracts the pair sampled there. `contractDownTo_spec` keeps its statement. Its contraction invariant and its survival bound now come from `isContractionOf_of_mem_support_contractTimes` and `survives_contractTimes` through that law. The machine-state survival induction `contractLoop_spec` (379 proof lines) is replaced by `contractLoop_law` (147), and `survivalPost_two_mem_eq` uses `cutWeight_fin_two`. `ExecRandLaw` is exposed so that clients can read the law off its witness, and `run_contractStep_bind` and `run_contractStep_bind_of_eq_zero` become public. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../Algorithms/Lean/Karger/Contraction.lean | 17 +- .../Algorithms/WordRAM/Karger/Contract.lean | 622 ++++++------------ .../Computability/WordRAM/Randomized/Law.lean | 2 +- 3 files changed, 224 insertions(+), 417 deletions(-) diff --git a/Complexity/Algorithms/Lean/Karger/Contraction.lean b/Complexity/Algorithms/Lean/Karger/Contraction.lean index 92b7827b9a..4a198db794 100644 --- a/Complexity/Algorithms/Lean/Karger/Contraction.lean +++ b/Complexity/Algorithms/Lean/Karger/Contraction.lean @@ -41,11 +41,12 @@ less than it (`minCut_le_of_mem_support_karger`). Every call it makes is admissi `telescope_survival_step`), used unchanged, and the composition of the stages is `Probability.PMF.toOuterMeasure_bind_ge_mul_ennreal`. -The word-RAM implementation proves the same bound on machine states, interleaved with register -steps (`Cslib.Algorithms.WordRAM.Karger.contractDownTo_spec`). Here no register, address or -instruction count appears. An implementation of `spec` over the memory oracle is a separate, -deterministic hop, and `Refinement.toRandomized` with `RandomizedRefinement.withCoins` carries the -law of the client through it. +No register, address or instruction count appears here. The word-RAM loop +`Cslib.Algorithms.WordRAM.Karger.contractDownTo` simulates `contractTimes`: the graph it holds has +the law of the client's final state (`Cslib.Algorithms.WordRAM.Karger.contractDownTo_law`), so its +survival bound is `survives_contractTimes`. An implementation of `spec` over the memory oracle is a +separate, deterministic hop, and `Refinement.toRandomized` with `RandomizedRefinement.withCoins` +carries the law of the client through it. ## Main definitions @@ -56,6 +57,8 @@ law of the client through it. ## Main results +* `run_contractStep_bind`, `run_contractStep_bind_of_eq_zero`: the run of one contraction, the + step that an implementation simulates. * `survives_contractTimes`: the survival bound. * `two_div_le_toOuterMeasure_karger`: Karger's success probability. * `isContractionOf_of_mem_support_contractTimes`, `minCut_le_of_mem_support_karger`: every @@ -181,7 +184,7 @@ noncomputable def karger : ProbOracleComp Op.Result ℕ := do /-- One contraction of a graph of positive weight draws a uniform offset below the weight and contracts the pair sampled there. -/ -private theorem run_contractStep_bind {α : Type} (p : ProbOracleComp Op.Result α) {m : ℕ} +theorem run_contractStep_bind {α : Type} (p : ProbOracleComp Op.Result α) {m : ℕ} (W : Fin (m + 1) → Fin (m + 1) → ℕ) (hS : totalDoubledWeight W ≠ 0) : spec.toRandomized.withCoins.run (contractStep >>= fun _ => p) ⟨m + 1, W⟩ = (ProbComp.unifOracle (totalDoubledWeight W - 1)).bind fun r => @@ -197,7 +200,7 @@ private theorem run_contractStep_bind {α : Type} (p : ProbOracleComp Op.Result rfl /-- One contraction of a weightless graph contracts its first and last supervertices. -/ -private theorem run_contractStep_bind_of_eq_zero {α : Type} (p : ProbOracleComp Op.Result α) +theorem run_contractStep_bind_of_eq_zero {α : Type} (p : ProbOracleComp Op.Result α) {m : ℕ} (W : Fin (m + 1) → Fin (m + 1) → ℕ) (hS : totalDoubledWeight W = 0) : spec.toRandomized.withCoins.run (contractStep >>= fun _ => p) ⟨m + 1, W⟩ = spec.toRandomized.withCoins.run p ⟨m, contractMatrix W 0 (Fin.last m)⟩ := by diff --git a/Complexity/Algorithms/WordRAM/Karger/Contract.lean b/Complexity/Algorithms/WordRAM/Karger/Contract.lean index 429d0e1a02..7f52b17c88 100644 --- a/Complexity/Algorithms/WordRAM/Karger/Contract.lean +++ b/Complexity/Algorithms/WordRAM/Karger/Contract.lean @@ -8,10 +8,10 @@ module -- upstream: candidate public import Complexity.Init -public import Complexity.Algorithms.WordRAM.Karger.Graph +public import Complexity.Algorithms.Lean.Karger.Contraction public import Complexity.Computability.WordRAM.Heap public import Complexity.Computability.WordRAM.Notation -public import Complexity.Computability.WordRAM.Randomized.Structured +public import Complexity.Computability.WordRAM.Randomized.Law /-! # Workspace-relocatable randomized contraction on the word RAM @@ -33,6 +33,16 @@ yielding `36 * (k ^ 2 - t ^ 2) + 4` worst-case instructions and at most `k - t` `k` down to `t`, with survival probability at least `(t * (t - 1)) / (k * (k - 1))` for any fixed minimum cut of a connected multigraph. +The probability is not proved on machine states. `contractDownTo` simulates Karger's algorithm as +a client of the contraction structure `Cslib.Algorithms.Lean.Karger.spec`: the graph the machine +holds (`heldGraph`) has the law of `Cslib.Algorithms.Lean.Karger.contractTimes` +(`contractDownTo_law`). Each step's `rand` call draws the offset uniformly below the total weight, +as the client's coin does, and `postRandStep_exec` contracts the pair sampled there. The survival +bound and the contraction invariant are the specification's +(`Cslib.Algorithms.Lean.Karger.survives_contractTimes`, +`Cslib.Algorithms.Lean.Karger.isContractionOf_of_mem_support_contractTimes`), carried through that +law. + ## Source statements and notation mapping * **Matrix contraction and survival bound (paraphrase):** @@ -68,6 +78,8 @@ minimum cut of a connected multigraph. `Cslib.Algorithms.WordRAM.Karger.ContractState`: relocatable memory layout and word-bound invariants for an active `k × k` supervertex adjacency matrix with row stride `stride` and row degree array at `dBase`. +* `Cslib.Algorithms.WordRAM.Karger.heldGraph`: the graph a machine state holds, as a state of + `Cslib.Algorithms.Lean.Karger.spec`. * `Cslib.Algorithms.WordRAM.Karger.computeDegreesAndTotal`, `Cslib.Algorithms.WordRAM.Karger.computeDegreesAndTotalAt`: deterministic `O(k ^ 2)` initializer populating `D[0..k)` and `totS`. @@ -80,10 +92,13 @@ minimum cut of a connected multigraph. * `Cslib.Algorithms.WordRAM.Karger.computeDegreesAndTotal_exec`: `computeDegreesAndTotal` populates `HoldsWorkspace` and `totS = totalDoubledWeight W` within `6 * k ^ 2 + 12 * k + 6` instructions, modifying only `Finset.Ico dBase (dBase + k)`. +* `Cslib.Algorithms.WordRAM.Karger.contractDownTo_law`: `contractDownTo` simulates `k - t` + contractions of the specification: `ExecRandLaw` with `IsQueryBounded (k - t)`, worst-case step + bound `36 * (k ^ 2 - t ^ 2) + 4`, `Modifies` frame, and the law of `heldGraph`. * `Cslib.Algorithms.WordRAM.Karger.contractDownTo_spec`: joint certificate of `ExecRand`, `IsQueryBounded (k - t)`, worst-case step bound `36 * (k ^ 2 - t ^ 2) + 4`, `Modifies` frame, - contraction invariant `IsContractionOf`, and telescoping cut-survival probability lower bound - `((t * (t - 1) : ℕ) : ℝ≥0∞) / (k * (k - 1))`. + contraction invariant `IsContractionOf`, and cut-survival probability lower bound + `((t * (t - 1) : ℕ) : ℝ≥0∞) / (k * (k - 1))`, the last two from the specification. ## References @@ -170,6 +185,27 @@ structure ContractState (w wb db str k t : ℕ) (W : Fin k → Fin k → ℕ) (x fits_totS : Fits w (totalDoubledWeight W) workspace : HoldsWorkspace x.mem wb db str W +/-- The graph that a machine state holds in the workspace at `wb` with row stride `str`: `activeK` +supervertices, with the weight matrix read from memory. It abstracts a `ContractState` to a state +of the contraction structure `Lean.Karger.spec`. -/ +def heldGraph (wb str : ℕ) (x : Data 16) : Lean.Karger.Graph := + ⟨x.regs Reg.activeK, fun i j => x.mem (wb + i.val * str + j.val)⟩ + +/-- A state holding `W` on `k` supervertices holds the graph `⟨k, W⟩`. -/ +theorem ContractState.heldGraph_eq {w wb db str k t : ℕ} {W : Fin k → Fin k → ℕ} {x : Data 16} + (hst : ContractState w wb db str k t W x) : heldGraph wb str x = ⟨k, W⟩ := by + unfold heldGraph + rw [hst.regs_activeK] + exact congrArg _ (funext₂ hst.workspace.1) + +/-- The weight matrix of a state is the weight of the graph it holds. -/ +private theorem ContractState.eq_of_heldGraph_eq {w wb db str k t : ℕ} {W W' : Fin k → Fin k → ℕ} + {x : Data 16} (hst : ContractState w wb db str k t W x) (h : heldGraph wb str x = ⟨k, W'⟩) : + W = W' := by + have h' := hst.heldGraph_eq.symm.trans h + simp only [Lean.Karger.Graph.mk.injEq, heq_eq_eq, true_and] at h' + exact h' + theorem matAddr_lt_end {wb str k : ℕ} (hstr : k ≤ str) (i j : Fin k) : wb + i.val * str + j.val < wb + str * k := by have hi : i.val + 1 ≤ k := i.isLt @@ -2466,14 +2502,7 @@ theorem postRandStep_exec {w wb db str m t r_val : ℕ} workspace := hws_m } -/-! #### `PMF.toOuterMeasure` helpers for step-count maps and `contractDownTo_spec` -/ - -private theorem eval_map_snd_toOuterMeasure {α : Type} (m : ProbComp (α × ℕ)) - (g : α × ℕ → ℕ) (P : α → Prop) : - (((fun z => (z.1, g z)) <$> m).eval).toOuterMeasure {z | P z.1} = - m.eval.toOuterMeasure {z | P z.1} := by - rw [ProbComp.eval_map, PMF.toOuterMeasure_map_apply] - rfl +/-! #### Simulation of the contraction structure and `contractDownTo_spec` -/ private theorem step_budget_succ {t m n_post z₂ : ℕ} (ht : 2 ≤ t) (hm : t ≤ m) (hn : n_post ≤ 45 * (m + 1) + 22) (hz : z₂ ≤ 36 * (m ^ 2 - t ^ 2) + 2) : @@ -2497,87 +2526,78 @@ def SurvivalPost {n : ℕ} (W₀ : Fin n → Fin n → ℕ) (wb db str t : ℕ) y.regs totS = totalDoubledWeight W' ∧ pullbackCut part' B' = C_star -private theorem contractLoop_spec {n w wb db str t steps : ℕ} {W₀ : Fin n → Fin n → ℕ} - {W : Fin (t + steps) → Fin (t + steps) → ℕ} {part : Fin n → Fin (t + steps)} {x : Data 16} - (ht : 2 ≤ t) (hC : IsContractionOf W₀ part W) - (h0 : x.regs zero = 0) (h1 : x.regs one = 1) - (hst : ContractState w wb db str (t + steps) t W x) : - ∃ m : ProbComp (Data 16 × ℕ), - ExecRand w ram[while targetT < activeK do [ ⟪contractStep⟫ ]] x m ∧ - m.IsQueryBounded steps ∧ - (∀ z ∈ m.support, - z.2 ≤ 36 * ((t + steps) ^ 2 - t ^ 2) + 2 ∧ - Modifies (workspaceFootprint wb db str (t + steps)) x.mem z.1.mem ∧ - ∃ (W' : Fin t → Fin t → ℕ) (part' : Fin n → Fin t), - IsContractionOf W₀ part' W' ∧ - ContractState w wb db str t t W' z.1) ∧ - (∀ B : Finset (Fin (t + steps)), - 0 < minCut W₀ → IsNonTrivialCut B → - cutWeight W₀ (pullbackCut part B) = minCut W₀ → - (((t * (t - 1) : ℕ) : ℝ≥0∞) / (((t + steps) * (t + steps - 1) : ℕ) : ℝ≥0∞)) ≤ - m.eval.toOuterMeasure {z | SurvivalPost W₀ wb db str t (pullbackCut part B) z.1}) := by - induction steps generalizing x with +/-- **The contraction loop refines the contraction structure.** From a state holding a multigraph +`W` on `t + s` supervertices, the loop runs within `36 ((t + s)² - t²) + 2` instructions and `s` +`rand` calls, writes only the workspace and ends holding a multigraph on `t` supervertices. The +graph it holds has the law of `s` contractions of `⟨t + s, W⟩` in `Lean.Karger.spec`: each +positive-weight step draws the offset uniformly below the total weight, as the client +`Lean.Karger.contractStep` does, and `postRandStep` contracts the pair sampled there. -/ +private theorem contractLoop_law {w wb db str t s : ℕ} {W : Fin (t + s) → Fin (t + s) → ℕ} + {x : Data 16} (ht : 2 ≤ t) (hW : IsMultigraph W) (h0 : x.regs zero = 0) + (h1 : x.regs one = 1) (hst : ContractState w wb db str (t + s) t W x) : + ExecRandLaw w ram[while targetT < activeK do [ ⟪contractStep⟫ ]] x + (fun y => Modifies (workspaceFootprint wb db str (t + s)) x.mem y.mem ∧ + ∃ W' : Fin t → Fin t → ℕ, IsMultigraph W' ∧ ContractState w wb db str t t W' y) + (36 * ((t + s) ^ 2 - t ^ 2) + 2) s (heldGraph wb str) + ((Lean.Karger.spec.toRandomized.withCoins.run (Lean.Karger.contractTimes s) + ⟨t + s, W⟩).map Prod.snd) := by + induction s generalizing x with | zero => - have hk_eq : t + 0 = t := Nat.add_zero t have hnc : ¬ (Cond.lt targetT activeK).Holds x := by simp [hst.regs_targetT, hst.regs_activeK] - refine ⟨pure (x, 2), ExecRand.loop_exit hnc, .pure _ 0, ?_, ?_⟩ - · intro z hz - cases OracleComp.eq_of_mem_supportWith_pure hz - refine ⟨by simp, Modifies.refl _ _, ?_⟩ - cases hk_eq - exact ⟨W, part, hC, hst⟩ - · intro B _ _ _ - simp only [Nat.add_zero, ProbComp.eval_pure, PMF.toOuterMeasure_pure_apply] - have ht_pos : 0 < t * (t - 1) := Nat.mul_pos (by omega) (by omega) - have hne0 : (((t * (t - 1) : ℕ) : ℝ≥0∞)) ≠ 0 := by exact_mod_cast ht_pos.ne' - have htop : (((t * (t - 1) : ℕ) : ℝ≥0∞)) ≠ ⊤ := ENNReal.natCast_ne_top _ - rw [ENNReal.div_self hne0 htop] - have hmem : (x, 2) ∈ {z : Data 16 × ℕ | - SurvivalPost W₀ wb db str t (pullbackCut part B) z.1} := by - cases hk_eq - exact ⟨W, part, B, hC, hst.workspace, hst.regs_totS, rfl⟩ - simp [hmem] + refine ((ExecRandLaw.loop_exit hnc ⟨Modifies.refl _ _, W, hW, hst⟩).congr_law ?_).mono + (fun _ h => h) (Nat.le_add_left _ _) le_rfl + rw [hst.heldGraph_eq] + exact (PMF.pure_map Prod.snd ((), (⟨t + 0, W⟩ : Lean.Karger.Graph))).symm | succ s ih => - let m_cur := t + s - have hm_def : m_cur = t + s := rfl - have hm_ge : 2 ≤ m_cur := by omega + let κ (G : Lean.Karger.Graph) : PMF Lean.Karger.Graph := + (Lean.Karger.spec.toRandomized.withCoins.run (Lean.Karger.contractTimes s) G).map Prod.snd have hc_loop : (Cond.lt targetT activeK).Holds x := by simp only [Cond.holds_lt, hst.regs_targetT, hst.regs_activeK] omega + -- After one contraction the machine holds a multigraph on `t + s` supervertices, from which + -- the rest of the loop has the law of the rest of the client. + let P (y : Data 16) : Prop := + Modifies (workspaceFootprint wb db str (t + s + 1)) x.mem y.mem ∧ y.regs zero = 0 ∧ + y.regs one = 1 ∧ ∃ W' : Fin (t + s) → Fin (t + s) → ℕ, + IsMultigraph W' ∧ ContractState w wb db str (t + s) t W' y + have hrest : ∀ y, P y → ExecRandLaw w ram[while targetT < activeK do [ ⟪contractStep⟫ ]] y + (fun z => Modifies (workspaceFootprint wb db str (t + (s + 1))) x.mem z.mem ∧ + ∃ W' : Fin t → Fin t → ℕ, IsMultigraph W' ∧ ContractState w wb db str t t W' z) + (36 * ((t + s) ^ 2 - t ^ 2) + 2) s (heldGraph wb str) (κ (heldGraph wb str y)) := by + rintro y ⟨hmod, hy0, hy1, W', hW', hst'⟩ + rw [hst'.heldGraph_eq] + exact (ih hW' hy0 hy1 hst').mono (fun z ⟨hmz, hz⟩ => ⟨modifies_trans_subset hmod hmz + Finset.Subset.rfl (workspaceFootprint_mono (Nat.le_succ _)), hz⟩) le_rfl le_rfl + have hbudget := step_budget_succ (n_post := 45 * (t + s + 1) + 22) ht (Nat.le_add_right t s) + le_rfl le_rfl by_cases hS0 : totalDoubledWeight W = 0 - · -- Zero-weight branch: `totS = 0`, deterministic merge of `(0, Fin.last m_cur)` in `0` calls. + · -- Zero weight: `contractDownTo` drops the last supervertex, which is the specification's + -- contraction of `0` and the last supervertex of a weightless graph. have hcond_z : (Cond.eq totS zero).Holds x := by simp [hst.regs_totS, hS0, h0] - have hm_fit : Fits w m_cur := hst.fits_dEnd.of_le (by omega) - let x_next := x.set activeK m_cur - have hsub1 : (t + (s + 1)) - 1 = m_cur := by omega + have hm_fit : Fits w (t + s) := hst.fits_dEnd.of_le (by omega) + let x_next := x.set activeK (t + s) + have hsub1 : t + (s + 1) - 1 = t + s := by omega have hop : (Op.bin .sub activeK activeK one).eval w x = some x_next := by simp only [Op.eval_bin, BinOp.eval, hst.regs_activeK, h1, hsub1] exact Data.put_of_fits hm_fit - have hstep_det : ExecRand w contractStep x (pure (x_next, 2)) := by - unfold contractStep - simpa only [map_pure] using ExecRand.branch_pos hcond_z (ExecRand.op hop) - let u₀ : Fin (m_cur + 1) := ⟨0, by omega⟩ - let v₀ : Fin (m_cur + 1) := Fin.last m_cur - have huv₀ : u₀ ≠ v₀ := by - intro h - have := congrArg Fin.val h - change 0 = m_cur at this - omega - have hW_zero : ∀ a b : Fin (m_cur + 1), W a b = 0 := fun a b => by + have hW_zero : ∀ a b : Fin (t + s + 1), W a b = 0 := fun a b => by have := entry_le_totalDoubledWeight W a b omega - have hcm_zero : ∀ i j : Fin m_cur, contractMatrix W u₀ v₀ i j = 0 := fun i j => by - unfold contractMatrix mergePair - simp [hW_zero] - have hdeg_cm_zero : ∀ i : Fin m_cur, rowDeg (contractMatrix W u₀ v₀) i = 0 := fun i => by + have hcm_zero : ∀ i j : Fin (t + s), contractMatrix W 0 (Fin.last (t + s)) i j = 0 := + fun i j => by + unfold contractMatrix mergePair + simp [hW_zero] + have hdeg_cm_zero : ∀ i : Fin (t + s), + rowDeg (contractMatrix W 0 (Fin.last (t + s))) i = 0 := fun i => by unfold rowDeg simp [hcm_zero] - have htot_cm_zero : totalDoubledWeight (contractMatrix W u₀ v₀) = 0 := by + have htot_cm_zero : totalDoubledWeight (contractMatrix W 0 (Fin.last (t + s))) = 0 := by unfold totalDoubledWeight simp [hdeg_cm_zero] - have hws_next : HoldsWorkspace x_next.mem wb db str (contractMatrix W u₀ v₀) := by + have hws_next : + HoldsWorkspace x_next.mem wb db str (contractMatrix W 0 (Fin.last (t + s))) := by refine ⟨fun i j => ?_, fun i => ?_⟩ · have hw1 : x.mem (wb + i.val * str + j.val) = W i.castSucc j.castSucc := hst.workspace.1 i.castSucc j.castSucc @@ -2589,8 +2609,9 @@ private theorem contractLoop_spec {n w wb db str t steps : ℕ} {W₀ : Fin n rw [hw2, hdeg_cm_zero] unfold rowDeg simp [hW_zero] - have hmul_le : str * m_cur ≤ str * (t + (s + 1)) := Nat.mul_le_mul_left str (by omega) - have hst_next : ContractState w wb db str m_cur t (contractMatrix W u₀ v₀) x_next := { + have hmul_le : str * (t + s) ≤ str * (t + (s + 1)) := Nat.mul_le_mul_left str (by omega) + have hst_next : + ContractState w wb db str (t + s) t (contractMatrix W 0 (Fin.last (t + s))) x_next := { regs_wBase := by simpa +decide [x_next, Function.update_apply] using hst.regs_wBase regs_dBase := by simpa +decide [x_next, Function.update_apply] using hst.regs_dBase regs_stride := by simpa +decide [x_next, Function.update_apply] using hst.regs_stride @@ -2607,82 +2628,38 @@ private theorem contractLoop_spec {n w wb db str t steps : ℕ} {W₀ : Fin n fits_totS := by rw [htot_cm_zero]; exact fits_zero w workspace := hws_next } - have hC_next : IsContractionOf W₀ (contractPart part u₀ v₀ huv₀) - (contractMatrix W u₀ v₀) := isContractionOf_contract hC huv₀ - obtain ⟨m_tail, hm_tail, hq_tail, hsup_tail, _⟩ := ih hC_next - (by simpa +decide [x_next, Function.update_apply] using h0) - (by simpa +decide [x_next, Function.update_apply] using h1) - hst_next - have hiter := ExecRand.loop_iter hc_loop hstep_det (ml := fun _ => m_tail) fun z hz => by - cases OracleComp.eq_of_mem_supportWith_pure hz - exact hm_tail - refine ⟨_, hiter, ?_, ?_, ?_⟩ - · rw [pure_bind] - exact (hq_tail.bind fun _ => .pure _ 0).mono (by omega) - · intro z hz - obtain ⟨z₁, hz₁, hrest⟩ := OracleComp.mem_supportWith_bind_iff.mp hz - cases OracleComp.eq_of_mem_supportWith_pure hz₁ - obtain ⟨z₂, hz₂, hfinal⟩ := OracleComp.mem_supportWith_bind_iff.mp hrest - cases OracleComp.eq_of_mem_supportWith_pure hfinal - rcases hsup_tail z₂ hz₂ with ⟨htime₂, hmod₂, W', part', hC', hst'⟩ - refine ⟨?_, ?_, W', part', hC', hst'⟩ - · have hbud := step_budget_succ ht (by omega : t ≤ m_cur) (Nat.zero_le _) htime₂ - change 2 + z₂.2 + 2 ≤ 36 * ((m_cur + 1) ^ 2 - t ^ 2) + 2 - omega - · exact modifies_trans_subset (Modifies.refl _ x.mem) hmod₂ - Finset.Subset.rfl (workspaceFootprint_mono (Nat.le_succ m_cur)) - · -- Vacuous when `0 < minCut W₀` since `0 < minCut W₀ ≤ minCut W` forces `0 < totS`. - intro B hmin_pos _ _ - have hminW : 0 < minCut W := - lt_of_lt_of_le hmin_pos - (minCut_le_of_isContractionOf (by rw [Fintype.card_fin]; omega) hC) - have hS_pos := totalDoubledWeight_pos_of_minCut_pos (by rw [Fintype.card_fin]; omega) - hC.multigraph hminW - omega - · -- Positive-weight branch: `0 < totalDoubledWeight W`. - have hS_pos : 0 < totalDoubledWeight W := Nat.pos_of_ne_zero hS0 - let S := totalDoubledWeight W - have hS_def : S = totalDoubledWeight W := rfl + have hb : ExecRandLaw w contractStep x P 2 0 (heldGraph wb str) + (PMF.pure (heldGraph wb str x_next)) := by + unfold contractStep + exact ExecRandLaw.branch_pos hcond_z (ExecRandLaw.of_execWithin (ExecWithin.op hop) + ⟨Modifies.refl _ _, by simpa +decide [x_next, Function.update_apply] using h0, + by simpa +decide [x_next, Function.update_apply] using h1, _, + isMultigraph_contractMatrix hW _ _, hst_next⟩) + refine ((ExecRandLaw.loop_iter hc_loop hb hrest).congr_law ?_).mono (fun _ h => h) + (le_trans (by omega) hbudget) (by omega) + rw [PMF.pure_bind, hst_next.heldGraph_eq] + exact (congrArg (PMF.map Prod.snd) (Lean.Karger.run_contractStep_bind_of_eq_zero (m := t + s) + (Lean.Karger.contractTimes s) W hS0)).symm + · -- Positive weight: one `rand` call draws the offset uniformly below the total weight, and + -- `postRandStep` contracts the pair sampled there. have hcond_nz : ¬ (Cond.eq totS zero).Holds x := by simp [hst.regs_totS, h0, hS0] - have hSm1_fit : Fits w (S - 1) := hst.fits_totS.of_le (by omega) - let x_sub := x.set val1 (S - 1) + have hSm1_fit : Fits w (totalDoubledWeight W - 1) := hst.fits_totS.of_le (by omega) + let x_sub := x.set val1 (totalDoubledWeight W - 1) have hop_sub : (Op.bin .sub val1 totS one).eval w x = some x_sub := by simp only [Op.eval_bin, BinOp.eval, hst.regs_totS, h1] exact Data.put_of_fits hSm1_fit - have hfit_rand : Fits w (x_sub.regs val1) := by simpa [x_sub] using hSm1_fit - have hper_sample : ∀ k : Fin (x_sub.regs val1 + 1), - ∃ (u v : Fin (m_cur + 1)) (huv : u ≠ v) (y_post : Data 16) (n_post : ℕ) - (m_rec : ProbComp (Data 16 × ℕ)), - IsSampledPair W k.val u v ∧ - n_post ≤ 45 * (m_cur + 1) + 22 ∧ - Exec w postRandStep (x_sub.set rem k.val) y_post n_post ∧ - Modifies (workspaceFootprint wb db str (m_cur + 1)) x.mem y_post.mem ∧ - ContractState w wb db str m_cur t (contractMatrix W u v) y_post ∧ - ExecRand w ram[while targetT < activeK do [ ⟪contractStep⟫ ]] y_post m_rec ∧ - m_rec.IsQueryBounded s ∧ - (∀ z ∈ m_rec.support, - z.2 ≤ 36 * (m_cur ^ 2 - t ^ 2) + 2 ∧ - Modifies (workspaceFootprint wb db str m_cur) y_post.mem z.1.mem ∧ - ∃ (W' : Fin t → Fin t → ℕ) (part' : Fin n → Fin t), - IsContractionOf W₀ part' W' ∧ - ContractState w wb db str t t W' z.1) ∧ - (∀ B' : Finset (Fin m_cur), - 0 < minCut W₀ → IsNonTrivialCut B' → - cutWeight W₀ (pullbackCut (contractPart part u v huv) B') = minCut W₀ → - (((t * (t - 1) : ℕ) : ℝ≥0∞) / ((m_cur * (m_cur - 1) : ℕ) : ℝ≥0∞)) ≤ - m_rec.eval.toOuterMeasure - {z | SurvivalPost W₀ wb db str t - (pullbackCut (contractPart part u v huv) B') z.1}) := by + have hN : x_sub.regs val1 = totalDoubledWeight W - 1 := by simp [x_sub] + have hpost : ∀ k : Fin (x_sub.regs val1 + 1), ∃ y, + ExecWithin w postRandStep (x_sub.set rem k.val) y (45 * (t + s + 1) + 22) ∧ P y ∧ + heldGraph wb str y = Lean.Karger.contractGraph ⟨t + s + 1, W⟩ + (Lean.Karger.sampledPair W k).1 (Lean.Karger.sampledPair W k).2 := by intro k - have hk_lt : k.val < S := by - have hk_bound := k.isLt - simp only [x_sub, Data.set_regs, Function.update_self] at hk_bound - omega - obtain ⟨u, v, hsamp⟩ := exists_isSampledPair W hk_lt - have huv : u ≠ v := isSampledPair_ne hC.multigraph hsamp - obtain ⟨y_post, ⟨n_post, hn_post, he_post⟩, hmod_post, hst_post, hy0, hy1⟩ := - postRandStep_exec (x := x_sub.set rem k.val) (t := t) hm_ge hC.multigraph hsamp + obtain ⟨u, v, hsamp⟩ := exists_isSampledPair W (show k.val < totalDoubledWeight W by + have := k.isLt + omega) + obtain ⟨y, hy, hmod, hst', hy0, hy1⟩ := + postRandStep_exec (x := x_sub.set rem k.val) (m := t + s) (t := t) (by omega) hW hsamp (by simpa +decide [x_sub, Function.update_apply] using h0) (by simpa +decide [x_sub, Function.update_apply] using h1) (by simpa +decide [x_sub, Function.update_apply] using hst.regs_wBase) @@ -2697,205 +2674,60 @@ private theorem contractLoop_spec {n w wb db str t steps : ℕ} {W₀ : Fin n (by simp +decide) hst.le_stride hst.disjoint_blocks hst.fits_wEnd hst.fits_dEnd hst.fits_totS hst.workspace - obtain ⟨m_rec, hm_rec, hq_rec, hsup_rec, hsurv_rec⟩ := - ih (isContractionOf_contract hC huv) hy0 hy1 hst_post - exact ⟨u, v, huv, y_post, n_post, m_rec, hsamp, hn_post, he_post, hmod_post, hst_post, - hm_rec, hq_rec, hsup_rec, hsurv_rec⟩ - -- Assemble `ExecRand` for `contractStep` via `codeComp`. - let m_post (d : Data 16) := codeComp w postRandStep d - have hrand_post : ExecRand w ram[rem ← rand val1; ⟪postRandStep⟫] x_sub - (do - let z₁ ← (do - let k ← ProbComp.unifFin (x_sub.regs val1) - pure (x_sub.set rem k.val, 1)) - let z₂ ← m_post z₁.1 - pure (z₂.1, z₁.2 + z₂.2)) := by - refine ExecRand.seq (ExecRand.rand hfit_rand) fun z₁ hz₁ => ?_ - obtain ⟨k, -, hk_eq'⟩ := OracleComp.mem_supportWith_bind_iff.mp hz₁ - cases OracleComp.eq_of_mem_supportWith_pure hk_eq' - obtain ⟨_, _, _, y_post, n_post, _, _, _, he_post, _, _, _, _, _, _⟩ := hper_sample k - dsimp only [m_post] - rw [he_post.execRand.codeComp_eq] - exact he_post.execRand - have hsub_rand_post := (Exec.op hop_sub).seqRand hrand_post - have hstep_rand : ExecRand w contractStep x - ((fun z => (z.1, z.2 + 2)) <$> ((fun z => (z.1, 1 + z.2)) <$> (do - let z₁ ← (do - let k ← ProbComp.unifFin (x_sub.regs val1) - pure (x_sub.set rem k.val, 1)) - let z₂ ← m_post z₁.1 - pure (z₂.1, z₁.2 + z₂.2)))) := - ExecRand.branch_neg hcond_nz hsub_rand_post - let m_loop_rec (d : Data 16) := - codeComp w ram[while targetT < activeK do [ ⟪contractStep⟫ ]] d - let mb := (fun z : Data 16 × ℕ => (z.1, z.2 + 2)) <$> ((fun z => (z.1, 1 + z.2)) <$> (do - let z₁ ← (do - let k ← ProbComp.unifFin (x_sub.regs val1) - pure (x_sub.set rem k.val, 1)) - let z₂ ← m_post z₁.1 - pure (z₂.1, z₁.2 + z₂.2))) - have hmb_support : ∀ z ∈ mb.support, ∃ k : Fin (x_sub.regs val1 + 1), - ∃ (u v : Fin (m_cur + 1)) (huv : u ≠ v) (y_post : Data 16) (n_post : ℕ) - (m_rec : ProbComp (Data 16 × ℕ)), - z = (y_post, (1 + (1 + n_post)) + 2) ∧ - IsSampledPair W k.val u v ∧ - n_post ≤ 45 * (m_cur + 1) + 22 ∧ - Modifies (workspaceFootprint wb db str (m_cur + 1)) x.mem y_post.mem ∧ - m_loop_rec y_post = m_rec ∧ - ExecRand w ram[while targetT < activeK do [ ⟪contractStep⟫ ]] y_post m_rec ∧ - m_rec.IsQueryBounded s ∧ - (∀ z' ∈ m_rec.support, - z'.2 ≤ 36 * (m_cur ^ 2 - t ^ 2) + 2 ∧ - Modifies (workspaceFootprint wb db str m_cur) y_post.mem z'.1.mem ∧ - ∃ (W' : Fin t → Fin t → ℕ) (part' : Fin n → Fin t), - IsContractionOf W₀ part' W' ∧ - ContractState w wb db str t t W' z'.1) := by - intro z hz - obtain ⟨za, hza, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hz - obtain ⟨zb, hzb, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hza - obtain ⟨z₁, hz₁, hrest⟩ := OracleComp.mem_supportWith_bind_iff.mp hzb - obtain ⟨k, -, hk_pure⟩ := OracleComp.mem_supportWith_bind_iff.mp hz₁ - cases OracleComp.eq_of_mem_supportWith_pure hk_pure - obtain ⟨u, v, huv, y_post, n_post, m_rec, hsamp, hn_post, he_post, hmod_post, _, - hm_rec, hq_rec, hsup_rec, _⟩ := hper_sample k - obtain ⟨z₂, hz₂, hzb_pure⟩ := OracleComp.mem_supportWith_bind_iff.mp hrest - cases OracleComp.eq_of_mem_supportWith_pure hzb_pure - dsimp only [m_post] at hz₂ - rw [he_post.execRand.codeComp_eq] at hz₂ - cases OracleComp.eq_of_mem_supportWith_pure hz₂ - have hml_eq : m_loop_rec y_post = m_rec := hm_rec.codeComp_eq - exact ⟨k, u, v, huv, y_post, n_post, m_rec, rfl, hsamp, hn_post, hmod_post, - hml_eq, hm_rec, hq_rec, hsup_rec⟩ - have hiter : ExecRand w ram[while targetT < activeK do [ ⟪contractStep⟫ ]] x - (do - let z₁ ← mb - let z₂ ← m_loop_rec z₁.1 - pure (z₂.1, z₁.2 + z₂.2 + 2)) := by - refine ExecRand.loop_iter hc_loop hstep_rand fun z₁ hz₁ => ?_ - obtain ⟨_, _, _, _, _, _, m_rec, rfl, _, _, _, hml_eq, hm_rec, _, _⟩ := hmb_support z₁ hz₁ - rw [hml_eq] - exact hm_rec - have hmb_qb : mb.IsQueryBounded 1 := by - dsimp only [mb] - simp only [OracleComp.IsQueryBounded, OracleComp.isCostBounded_map_iff] - have hrand_qb : (do - let k ← ProbComp.unifFin (x_sub.regs val1) - pure (x_sub.set rem k.val, 1)).IsQueryBounded 1 := by - simpa only [Nat.add_zero] using - (ProbComp.isQueryBounded_unifFin (x_sub.regs val1)).bind fun _ => .pure _ 0 - have hpost_qb : ∀ z₁ ∈ (do - let k ← ProbComp.unifFin (x_sub.regs val1) - pure (x_sub.set rem k.val, 1)).support, - (m_post z₁.1 >>= fun z₂ => pure (z₂.1, z₁.2 + z₂.2)).IsQueryBounded 0 := by - intro z₁ hz₁ - obtain ⟨k, -, hk_p⟩ := OracleComp.mem_supportWith_bind_iff.mp hz₁ - cases OracleComp.eq_of_mem_supportWith_pure hk_p - obtain ⟨_, _, _, _, _, _, _, _, he_post, _, _, _, _, _, _⟩ := hper_sample k - dsimp only [m_post] - rw [he_post.execRand.codeComp_eq, pure_bind] - exact .pure _ 0 - simpa only [Nat.add_zero] using - OracleComp.IsCostBounded.bind_on_support hrand_qb hpost_qb - refine ⟨_, hiter, ?_, ?_, ?_⟩ - · have htot_qb : (1 : ℕ) + s = s + 1 := Nat.add_comm 1 s - rw [← htot_qb] - refine OracleComp.IsCostBounded.bind_on_support hmb_qb fun z₁ hz₁ => ?_ - obtain ⟨_, _, _, _, _, _, m_rec, rfl, _, _, _, hml_eq, _, hq_rec, _⟩ := hmb_support z₁ hz₁ - rw [hml_eq] - simpa only [Nat.add_zero] using hq_rec.bind fun _ => .pure _ 0 - · intro z hz - obtain ⟨z₁, hz₁, hrest⟩ := OracleComp.mem_supportWith_bind_iff.mp hz - obtain ⟨k, u, v, huv, y_post, n_post, m_rec, rfl, _, hn_post, hmod_post, - hml_eq, _, _, hsup_rec⟩ := hmb_support z₁ hz₁ - rw [hml_eq] at hrest - obtain ⟨z₂, hz₂, hfinal⟩ := OracleComp.mem_supportWith_bind_iff.mp hrest - cases OracleComp.eq_of_mem_supportWith_pure hfinal - rcases hsup_rec z₂ hz₂ with ⟨htime₂, hmod₂, W', part', hC', hst'⟩ - refine ⟨?_, ?_, W', part', hC', hst'⟩ - · exact step_budget_succ ht (by omega : t ≤ m_cur) hn_post htime₂ - · exact modifies_trans_subset hmod_post hmod₂ Finset.Subset.rfl - (workspaceFootprint_mono (Nat.le_succ m_cur)) - · -- Telescoping survival probability bound. - intro B hmin_pos hB_nt hB_min - let C_star := pullbackCut part B - let E : Set (Data 16 × ℕ) := {z | SurvivalPost W₀ wb db str t C_star z.1} - have hN_eq : x_sub.regs val1 + 1 = S := by - simp only [x_sub, Data.set_regs, Function.update_self] - omega - have hm_simp : (do - let z₁ ← mb - let z₂ ← m_loop_rec z₁.1 - pure (z₂.1, z₁.2 + z₂.2 + 2)) = (do - let k ← ProbComp.unifFin (x_sub.regs val1) - let zp ← m_post (x_sub.set rem k.val) - let z₂ ← m_loop_rec zp.1 - pure (z₂.1, ((1 + (1 + zp.2)) + 2) + z₂.2 + 2)) := by - dsimp only [mb] - simp only [← bind_pure_comp, bind_assoc, pure_bind] - rw [hm_simp, ProbComp.eval_bind] - let castFin : Fin (x_sub.regs val1 + 1) ≃ Fin (totalDoubledWeight W) := finCongr hN_eq - let survSet : Set (Fin (x_sub.regs val1 + 1)) := - {k | SampleSurvives W B (castFin k)} - have hdeg_bound : (m_cur + 1) * cutWeight W B ≤ totalDoubledWeight W := by - have hcw_eq : cutWeight W B = minCut W₀ := by - rw [← cutWeight_pullbackCut hC B, hB_min] - rw [hcw_eq] - have hmul := mul_minCut_le_totalDoubledWeight (by rw [Fintype.card_fin]; omega) - hC.multigraph - rw [Fintype.card_fin] at hmul - exact (Nat.mul_le_mul_left (m_cur + 1) - (minCut_le_of_isContractionOf (by rw [Fintype.card_fin]; omega) hC)).trans hmul - have hstep_prob : (((m_cur - 1 : ℕ) : ℝ≥0∞) / (m_cur + 1 : ℕ)) ≤ - (ProbComp.unifFin (x_sub.regs val1)).eval.toOuterMeasure survSet := by - rw [ProbComp.eval_unifFin] - let _ : Nonempty (Fin (x_sub.regs val1 + 1)) := ⟨⟨0, by omega⟩⟩ - let _ : Nonempty (Fin (totalDoubledWeight W)) := ⟨⟨0, hS_pos⟩⟩ - have hmap_u : Cslib.Probability.PMF.uniformOfFintype (Fin (totalDoubledWeight W)) = - (Cslib.Probability.PMF.uniformOfFintype - (Fin (x_sub.regs val1 + 1))).map castFin := - (Cslib.Probability.PMF.uniformOfFintype_map_equiv castFin).symm - have h1_step := step_survival_prob_ge (by omega : 2 ≤ m_cur + 1) hC.multigraph - hS_pos hdeg_bound - have hsub_m : m_cur + 1 - 2 = m_cur - 1 := by omega - rw [hsub_m, hmap_u, PMF.toOuterMeasure_map_apply] at h1_step - exact h1_step - have hsub_ms : t + (s + 1) - 1 = m_cur := by omega - have hm_add : t + (s + 1) = m_cur + 1 := rfl - have htele : (((m_cur - 1 : ℕ) : ℝ≥0∞) / (m_cur + 1 : ℕ)) * - (((t * (t - 1) : ℕ) : ℝ≥0∞) / ((m_cur * (m_cur - 1) : ℕ) : ℝ≥0∞)) = - (((t * (t - 1) : ℕ) : ℝ≥0∞) / (((t + (s + 1)) * (t + (s + 1) - 1) : ℕ) : ℝ≥0∞)) := by - rw [hsub_ms, hm_add] - exact telescope_survival_step ht (by omega : t ≤ m_cur) - rw [← htele] - refine toOuterMeasure_bind_ge_mul_ennreal _ _ survSet E hstep_prob ?_ - intro k _ hk_surv - obtain ⟨u, v, huv, y_post, n_post, m_rec, hsamp, _, he_post, _, _, - hm_rec, _, _, hsurv_rec⟩ := hper_sample k - have hmp_eq : m_post (x_sub.set rem k.val) = pure (y_post, n_post) := - he_post.execRand.codeComp_eq - have hml_eq : m_loop_rec y_post = m_rec := hm_rec.codeComp_eq - have hcont_eq : (do - let zp ← m_post (x_sub.set rem k.val) - let z₂ ← m_loop_rec zp.1 - pure (z₂.1, ((1 + (1 + zp.2)) + 2) + z₂.2 + 2)) = - ((fun z₂ => (z₂.1, ((1 + (1 + n_post)) + 2) + z₂.2 + 2)) <$> m_rec) := by - rw [hmp_eq, pure_bind, hml_eq, ← bind_pure_comp] - rw [hcont_eq, eval_map_snd_toOuterMeasure] - rcases hk_surv with ⟨u', v', hsamp', hsame'⟩ - have hcast_val : (castFin k).val = k.val := rfl - rw [hcast_val] at hsamp' - rcases isSampledPair_unique W hsamp hsamp' with ⟨rfl, rfl⟩ - let B' := contractCut v B - have hpb_eq : pullbackCut (contractPart part u v huv) B' = C_star := - pullbackCut_contractCut part huv hsame' - have hC_star_nt : IsNonTrivialCut C_star := - isNonTrivialCut_pullbackCut hC.surj hB_nt - have hB'_nt : IsNonTrivialCut B' := - isNonTrivialCut_of_pullbackCut (contractPart part u v huv) (hpb_eq ▸ hC_star_nt) - have hB'_min : cutWeight W₀ (pullbackCut (contractPart part u v huv) B') = minCut W₀ := by - rw [hpb_eq] - exact hB_min - simpa only [hpb_eq] using hsurv_rec B' hmin_pos hB'_nt hB'_min + refine ⟨y, hy, ⟨hmod, hy0, hy1, _, isMultigraph_contractMatrix hW u v, hst'⟩, ?_⟩ + rw [hst'.heldGraph_eq, Lean.Karger.sampledPair_eq hsamp, Lean.Karger.contractGraph_fin] + choose y hy using hpost + have hb : ExecRandLaw w contractStep x P (1 + (1 + (45 * (t + s + 1) + 22)) + 2) 1 + (heldGraph wb str) ((Probability.PMF.uniformOfFintype (Fin (x_sub.regs val1 + 1))).map + fun k => heldGraph wb str (y k)) := by + unfold contractStep + exact ExecRandLaw.branch_neg hcond_nz (ExecRandLaw.seq_det (ExecWithin.op hop_sub) + (ExecRandLaw.rand_seq (by rw [hN]; exact hSm1_fit) (fun k => (hy k).1) + fun k => (hy k).2.1)) + refine ((ExecRandLaw.loop_iter hc_loop hb hrest).congr_law ?_).mono (fun _ h => h) + hbudget (by omega) + have hlaw : ∀ k, κ (heldGraph wb str (y k)) = κ (Lean.Karger.contractGraph ⟨t + s + 1, W⟩ + (Lean.Karger.sampledPair W k).1 (Lean.Karger.sampledPair W k).2) := + fun k => by rw [(hy k).2.2] + rw [PMF.bind_map, Function.comp_def, funext hlaw, hN] + exact (PMF.map_bind _ _ _).symm.trans (congrArg (PMF.map Prod.snd) + (Lean.Karger.run_contractStep_bind (m := t + s) (Lean.Karger.contractTimes s) W hS0).symm) + +/-- **`contractDownTo` refines the contraction structure.** From a state holding a multigraph `W` +on `k ≥ t ≥ 2` supervertices, `contractDownTo` runs within `36 (k² - t²) + 4` instructions and +`k - t` `rand` calls, writes only the workspace and ends holding a multigraph on `t` supervertices. +The graph it holds (`heldGraph`) has the law of `k - t` contractions of `⟨k, W⟩` by the client +`Lean.Karger.contractTimes` of `Lean.Karger.spec`. -/ +theorem contractDownTo_law {w wb db str k t : ℕ} {W : Fin k → Fin k → ℕ} {x : Data 16} + (ht : 2 ≤ t) (htk : t ≤ k) (hW : IsMultigraph W) (hst : ContractState w wb db str k t W x) : + ExecRandLaw w contractDownTo x + (fun y => Modifies (workspaceFootprint wb db str k) x.mem y.mem ∧ + ∃ W' : Fin t → Fin t → ℕ, IsMultigraph W' ∧ ContractState w wb db str t t W' y) + (36 * (k ^ 2 - t ^ 2) + 4) (k - t) (heldGraph wb str) + ((Lean.Karger.spec.toRandomized.withCoins.run (Lean.Karger.contractTimes (k - t)) + ⟨k, W⟩).map Prod.snd) := by + obtain ⟨s, rfl⟩ : ∃ s, k = t + s := ⟨k - t, by omega⟩ + rw [Nat.add_sub_cancel_left] + have h1_fit : Fits w 1 := hst.fits_dEnd.of_le (by omega) + let x₁ := (x.set zero 0).set one 1 + have hst₁ : ContractState w wb db str (t + s) t W x₁ := { + regs_wBase := by simpa +decide [x₁, Function.update_apply] using hst.regs_wBase + regs_dBase := by simpa +decide [x₁, Function.update_apply] using hst.regs_dBase + regs_stride := by simpa +decide [x₁, Function.update_apply] using hst.regs_stride + regs_activeK := by simpa +decide [x₁, Function.update_apply] using hst.regs_activeK + regs_targetT := by simpa +decide [x₁, Function.update_apply] using hst.regs_targetT + regs_totS := by simpa +decide [x₁, Function.update_apply] using hst.regs_totS + le_stride := hst.le_stride + disjoint_blocks := hst.disjoint_blocks + fits_wEnd := hst.fits_wEnd + fits_dEnd := hst.fits_dEnd + fits_totS := hst.fits_totS + workspace := hst.workspace + } + have hloop := contractLoop_law ht hW (by simp +decide [x₁]) (by simp +decide [x₁]) hst₁ + unfold contractDownTo + exact (ExecRandLaw.seq_det (ExecWithin.const (fits_zero w)) + (ExecRandLaw.seq_det (ExecWithin.const h1_fit) hloop)).mono (fun _ h => h) (by omega) le_rfl /-- **Master specification for `contractDownTo` (`Code .standard 16`).** Starting from any `ContractState w wb db str k t W x` (`2 ≤ t ≤ k`) where `W` is a contraction of @@ -2906,7 +2738,12 @@ Starting from any `ContractState w wb db str k t W x` (`2 ≤ t ≤ k`) where `W `workspaceFootprint wb db str k` and leaving a valid `t`-supervertex `ContractState` that is a contraction of `W₀`, and 4. preserves any fixed minimum cut `pullbackCut part B` of a connected multigraph (`0 < minCut W₀`) - with probability at least `(t * (t - 1)) / (k * (k - 1))`. -/ + with probability at least `(t * (t - 1)) / (k * (k - 1))`. + +The first three parts and the law of the held graph are `contractDownTo_law`. The contraction in +part 3 and the bound in part 4 are the specification's +(`Lean.Karger.isContractionOf_of_mem_support_contractTimes`, `Lean.Karger.survives_contractTimes`), +carried through that law. -/ theorem contractDownTo_spec {n w wb db str k t : ℕ} {W₀ : Fin n → Fin n → ℕ} {W : Fin k → Fin k → ℕ} {part : Fin n → Fin k} {x : Data 16} (ht : 2 ≤ t) (htk : t ≤ k) (hC : IsContractionOf W₀ part W) @@ -2925,55 +2762,32 @@ theorem contractDownTo_spec {n w wb db str k t : ℕ} {W₀ : Fin n → Fin n cutWeight W₀ (pullbackCut part B) = minCut W₀ → (((t * (t - 1) : ℕ) : ℝ≥0∞) / ((k * (k - 1) : ℕ) : ℝ≥0∞)) ≤ m.eval.toOuterMeasure {z | SurvivalPost W₀ wb db str t (pullbackCut part B) z.1}) := by - have hk_split : t + (k - t) = k := Nat.add_sub_of_le htk - revert W part hst - rw [← hk_split] - intro W part hC hst - have h1_fit : Fits w 1 := hst.fits_dEnd.of_le (by omega) - let x₁ := (x.set zero 0).set one 1 - have e0 : Exec w (Code.op (.const zero 0)) x (x.set zero 0) 1 := - Exec.const (B := .standard) (d := zero) (x := x) (fits_zero w) - have e1 : Exec w (Code.op (.const one 1)) (x.set zero 0) x₁ 1 := - Exec.const (B := .standard) (d := one) (x := x.set zero 0) h1_fit - have hst₁ : ContractState w wb db str (t + (k - t)) t W x₁ := { - regs_wBase := by simpa +decide [x₁, Function.update_apply] using hst.regs_wBase - regs_dBase := by simpa +decide [x₁, Function.update_apply] using hst.regs_dBase - regs_stride := by simpa +decide [x₁, Function.update_apply] using hst.regs_stride - regs_activeK := by simpa +decide [x₁, Function.update_apply] using hst.regs_activeK - regs_targetT := by simpa +decide [x₁, Function.update_apply] using hst.regs_targetT - regs_totS := by simpa +decide [x₁, Function.update_apply] using hst.regs_totS - le_stride := hst.le_stride - disjoint_blocks := hst.disjoint_blocks - fits_wEnd := hst.fits_wEnd - fits_dEnd := hst.fits_dEnd - fits_totS := hst.fits_totS - workspace := hst.workspace - } - obtain ⟨m_loop, hm_loop, hq_loop, hsup_loop, hsurv_loop⟩ := - contractLoop_spec ht hC (by simp +decide [x₁]) - (by simp +decide [x₁]) hst₁ - have hfull : ExecRand w contractDownTo x ((fun z => (z.1, 2 + z.2)) <$> m_loop) := by - unfold contractDownTo - have he12 := e1.seqRand hm_loop - have he012 := e0.seqRand he12 - have hmap_assoc : ((fun z : Data 16 × ℕ => (z.1, 1 + z.2)) <$> - ((fun z : Data 16 × ℕ => (z.1, 1 + z.2)) <$> m_loop)) = - ((fun z : Data 16 × ℕ => (z.1, 2 + z.2)) <$> m_loop) := by - rw [Functor.map_map] - refine congrArg (· <$> m_loop) (funext fun z => Prod.ext rfl (by omega)) - rwa [hmap_assoc] at he012 - have hsub_cancel : t + (k - t) - t = k - t := by omega - refine ⟨(fun z => (z.1, 2 + z.2)) <$> m_loop, hfull, ?_, ?_, ?_⟩ - · rw [hsub_cancel] - simp only [OracleComp.IsQueryBounded, OracleComp.isCostBounded_map_iff] - exact hq_loop - · intro z hz - obtain ⟨z₀, hz₀, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hz - rcases hsup_loop z₀ hz₀ with ⟨ht0, hmod0, W', part', hC', hst'⟩ - exact ⟨by omega, hmod0, W', part', hC', hst'⟩ - · intro B hmin_pos hB_nt hB_min - rw [eval_map_snd_toOuterMeasure] - exact hsurv_loop B hmin_pos hB_nt hB_min + obtain ⟨m, hm, hq, hsup, hlaw⟩ := contractDownTo_law ht htk hC.multigraph hst + obtain ⟨s, rfl⟩ : ∃ s, k = t + s := ⟨k - t, by omega⟩ + rw [Nat.add_sub_cancel_left, ProbComp.eval_map] at hlaw + refine ⟨m, hm, hq, fun z hz => ?_, fun B hmin hB hBmin => ?_⟩ + · obtain ⟨⟨hmod, W', -, hst'⟩, hT⟩ := hsup z hz + have hz' : heldGraph wb str z.1 ∈ ((Lean.Karger.spec.toRandomized.withCoins.run + (Lean.Karger.contractTimes s) ⟨t + s, W⟩).map Prod.snd).support := by + rw [← hlaw, PMF.mem_support_map_iff] + exact ⟨z, by rwa [ProbComp.support_eval], rfl⟩ + obtain ⟨y, hy, hyz⟩ := (PMF.mem_support_map_iff _ _ _).mp hz' + obtain ⟨W'', part', hy', hC'⟩ := + Lean.Karger.isContractionOf_of_mem_support_contractTimes (by omega) s hC hy + obtain rfl := hst'.eq_of_heldGraph_eq (hyz.symm.trans hy') + exact ⟨hT, hmod, W', part', hC', hst'⟩ + · calc _ ≤ _ := Lean.Karger.survives_contractTimes ht hmin s hC hB hBmin + _ = (m.eval.map fun z => heldGraph wb str z.1).toOuterMeasure + {G | Lean.Karger.Survives W₀ (pullbackCut part B) t G} := by + rw [hlaw, PMF.toOuterMeasure_map_apply] + rfl + _ ≤ _ := by + rw [PMF.toOuterMeasure_map_apply] + refine PMF.toOuterMeasure_mono _ fun z ⟨⟨W'', part', B', hG, hC', hpb⟩, hz⟩ => ?_ + rw [ProbComp.support_eval] at hz + obtain ⟨⟨-, W', -, hst'⟩, -⟩ := hsup z hz + obtain rfl := hst'.eq_of_heldGraph_eq hG + exact ⟨W', part', B', hC', hst'.workspace, hst'.regs_totS, hpb⟩ /-- At `t = 2`, any state satisfying `SurvivalPost W₀ wb db str 2 C_star y` where `C_star` is a non-trivial cut attaining `minCut W₀` stores `minCut W₀` in `y.mem (wb + 1)`. -/ @@ -2982,20 +2796,10 @@ theorem survivalPost_two_mem_eq {n : ℕ} {W₀ : Fin n → Fin n → ℕ} {wb d (hnt : IsNonTrivialCut C_star) (hmin : cutWeight W₀ C_star = minCut W₀) (hsurv : SurvivalPost W₀ wb db str 2 C_star y) : y.mem (wb + 1) = minCut W₀ := by - rcases hsurv with ⟨W', part', B', hC', hws', _, hpb'⟩ - have hB'_nt : IsNonTrivialCut B' := - isNonTrivialCut_of_pullbackCut part' (hpb' ▸ hnt) - rw [isNonTrivialCut_iff_card, Fintype.card_fin] at hB'_nt - have hcard1 : B'.card = 1 := by omega - rcases Finset.card_eq_one.mp hcard1 with ⟨b, rfl⟩ - have hcell : y.mem (wb + 1) = W' 0 1 := by - simpa using hws'.1 0 1 - rw [hcell, ← hmin, ← hpb', cutWeight_pullbackCut hC'] - have hb : b = 0 ∨ b = 1 := by omega - rcases hb with rfl | rfl - · exact (cutWeight_two_singleton_zero hC'.multigraph).symm - · have hcompl : ({(1 : Fin 2)} : Finset (Fin 2)) = Finset.univ \ {0} := by decide - rw [hcompl, cutWeight_compl hC'.multigraph, cutWeight_two_singleton_zero hC'.multigraph] + obtain ⟨W', part', B', hC', hws', -, hpb'⟩ := hsurv + have hB' : IsNonTrivialCut B' := isNonTrivialCut_of_pullbackCut part' (hpb' ▸ hnt) + rw [show y.mem (wb + 1) = W' 0 1 by simpa using hws'.1 0 1, + ← cutWeight_fin_two hC'.multigraph hB', ← cutWeight_pullbackCut hC', hpb', hmin] /-! ### Register-embedding (`Code.rename`) wrappers for callers with `r ≥ 16` -/ diff --git a/Complexity/Computability/WordRAM/Randomized/Law.lean b/Complexity/Computability/WordRAM/Randomized/Law.lean index 73141137b0..da5b674dff 100644 --- a/Complexity/Computability/WordRAM/Randomized/Law.lean +++ b/Complexity/Computability/WordRAM/Randomized/Law.lean @@ -56,7 +56,7 @@ variable {B : Basis} {r : ℕ} {α β : Type} /-- `ExecRandLaw w c x P T R f μ`: at word size `w`, running `c` from `x` terminates cleanly on every path, makes at most `R` `rand` calls on every path, every supported outcome `(y, n)` satisfies `P y` and `n ≤ T`, and the observation `f y` of the final data has law `μ`. -/ -def ExecRandLaw (w : ℕ) (c : Code B r) (x : Data r) (P : Data r → Prop) (T R : ℕ) +@[expose] def ExecRandLaw (w : ℕ) (c : Code B r) (x : Data r) (P : Data r → Prop) (T R : ℕ) (f : Data r → α) (μ : PMF α) : Prop := ∃ m, ExecRand w c x m ∧ m.IsQueryBounded R ∧ (∀ z ∈ m.support, P z.1 ∧ z.2 ≤ T) ∧ ((fun z => f z.1) <$> m).eval = μ From 52b5ede8da6d2e092e3a03023225ff6879712a80 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Mon, 2 Nov 2026 00:26:06 -0500 Subject: [PATCH 17/17] refactor(Algorithms/WordRAM/Karger): derive amplified Karger's bounds from a spec-level client The single-trial, amplified and high-probability Karger programs simulate clients of `Lean.Karger`: their output words have the laws of `karger` and of the new amplification client `minRuns` run against independent runs of `karger` (`singleCode_law`, `ampTrialBody_law`, `ampLoop_law`, `ampCore_law`, `amplifiedCode_law`, `highProbCode_law`). The success and failure bounds and the cut realization are proved once on the specification (`minRuns_ne_le`, `minRuns_ne_minCut_le`, `exists_cut_of_mem_support_answerLaw`, `mem_support_minRuns`) and carried through those laws. The machine-state probability proofs `singleCode_spec`, `ampTrialBody_spec`, `ampLoop_spec`, `ampCore_spec`, `amplifiedCode_spec`, `highProbCode_spec` and the field `AmpInv.best_cut` are deleted. The public program specifications keep their statements. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../Algorithms/Lean/Karger/Contraction.lean | 194 +++- .../Algorithms/WordRAM/Karger/Contract.lean | 32 + .../Algorithms/WordRAM/KargerMinCut.lean | 848 ++++++------------ .../Computability/WordRAM/Randomized/Law.lean | 13 + .../KargerMinCutBridge.lean | 31 +- 5 files changed, 492 insertions(+), 626 deletions(-) diff --git a/Complexity/Algorithms/Lean/Karger/Contraction.lean b/Complexity/Algorithms/Lean/Karger/Contraction.lean index 4a198db794..adce16a1fd 100644 --- a/Complexity/Algorithms/Lean/Karger/Contraction.lean +++ b/Complexity/Algorithms/Lean/Karger/Contraction.lean @@ -9,6 +9,7 @@ module public import Complexity.Algorithms.WordRAM.Karger.Graph public import Complexity.DataStructure.StateTransition.Randomized +public import Complexity.Languages.Probabilistic.Iteration /-! # Karger's contraction algorithm as a randomized client @@ -34,25 +35,35 @@ and answers half their total weight, the weight of the cut between them. All probability is proved here, on the specification. Contracting from `t + s` down to `t` supervertices preserves a fixed minimum cut with probability at least `t (t - 1) / ((t + s) (t + s - 1))` (`survives_contractTimes`), so `karger` answers the minimum cut -weight with probability at least `2 / (n (n - 1))` (`two_div_le_toOuterMeasure_karger`), and never -less than it (`minCut_le_of_mem_support_karger`). Every call it makes is admissible +weight with probability at least `2 / (n (n - 1))` (`two_div_le_toOuterMeasure_karger`), and every +answer is the weight of a non-trivial cut (`exists_cut_of_mem_support_answerLaw`), never less than +the minimum (`minCut_le_of_mem_support_karger`). Every call it makes is admissible (`demonicValid_karger`). The combinatorics and the one-step bound are `Karger.Graph`'s (`isContractionOf_contract`, `pullbackCut_contractCut`, `step_survival_prob_ge`, `telescope_survival_step`), used unchanged, and the composition of the stages is `Probability.PMF.toOuterMeasure_bind_ge_mul_ennreal`. +Amplification is a client of a trial oracle whose one call answers one run of `karger`: +`minRuns R` makes `R` calls and keeps the least answer, one `minStep` per call after the first. +Answered by independent runs, `OracleComp.evalWith (fun _ => answerLaw G)`, it misses the minimum +cut weight with probability at most `(1 - 2 / (n (n - 1))) ^ R` (`minRuns_ne_minCut_le`), since +the least answer misses it only when every run does (`minRuns_ne_le`, for any trial). + No register, address or instruction count appears here. The word-RAM loop `Cslib.Algorithms.WordRAM.Karger.contractDownTo` simulates `contractTimes`: the graph it holds has the law of the client's final state (`Cslib.Algorithms.WordRAM.Karger.contractDownTo_law`), so its -survival bound is `survives_contractTimes`. An implementation of `spec` over the memory oracle is a -separate, deterministic hop, and `Refinement.toRandomized` with `RandomizedRefinement.withCoins` -carries the law of the client through it. +survival bound is `survives_contractTimes`. The programs of `Cslib.Algorithms.WordRAM.KargerMinCut` +simulate `karger` and `minRuns` in the same way. An implementation of `spec` over the memory +oracle is a separate, deterministic hop, and `Refinement.toRandomized` with +`RandomizedRefinement.withCoins` carries the law of the client through it. ## Main definitions * `Graph`, `Op`, `step`, `valid`, `spec`: the contraction structure. * `sampledPair`, `contractGraph`: the pair sampled at an offset, and contraction. * `contractStep`, `contractTimes`, `karger`: the algorithm as a client with coins. +* `answerLaw`: the law of the answer of one run of `karger`. +* `minStep`, `minRuns`: amplification, as a client of a trial oracle. * `Survives`: a cut of the input survives in a contracted graph. ## Main results @@ -61,8 +72,15 @@ carries the law of the client through it. step that an implementation simulates. * `survives_contractTimes`: the survival bound. * `two_div_le_toOuterMeasure_karger`: Karger's success probability. -* `isContractionOf_of_mem_support_contractTimes`, `minCut_le_of_mem_support_karger`: every - outcome is a contraction, so the answer is never below the minimum cut weight. +* `isContractionOf_of_mem_support_contractTimes`, `exists_cut_of_mem_support_answerLaw`, + `minCut_le_of_mem_support_karger`: every outcome is a contraction, so the answer is the weight + of a non-trivial cut, never below the minimum. +* `answerLaw_eq`: the answer is half the total weight of the graph left by `n - 2` contractions. +* `minRuns_ne_minCut_le`: amplified Karger, `R` independent runs miss with probability at most + `(1 - 2 / (n (n - 1))) ^ R`. +* `mem_support_iterate_minStep`, `mem_support_minRuns`: every amplified answer is the answer of + one of the runs. +* `minRuns_ne_le`: amplification of any trial whose answers are at least `m`. * `isCostBounded_contractStep`, `isCostBounded_contractTimes`: each contraction makes one coin call and at most four calls of the structure. * `demonicValid_contractTimes`, `demonicValid_karger`: every call is admissible. @@ -305,15 +323,15 @@ theorem isContractionOf_of_mem_support_contractTimes {n t : ℕ} (ht : 1 ≤ t) rw [sampledPair_eq hsamp, contractGraph_fin] at hx exact ih (isContractionOf_contract hC (isSampledPair_ne hC.multigraph hsamp)) hx -/-- Running `karger` from `n = 2 + s` supervertices contracts `s` times, then answers half the -total weight. -/ -private theorem run_karger {s : ℕ} (W : Fin (2 + s) → Fin (2 + s) → ℕ) : - spec.toRandomized.withCoins.run karger ⟨2 + s, W⟩ = - (spec.toRandomized.withCoins.run (contractTimes s) ⟨2 + s, W⟩).bind fun x => +/-- Running `karger` from `n` supervertices contracts `n - 2` times, then answers half the total +weight. -/ +private theorem run_karger {n : ℕ} (W : Fin n → Fin n → ℕ) : + spec.toRandomized.withCoins.run karger ⟨n, W⟩ = + (spec.toRandomized.withCoins.run (contractTimes (n - 2)) ⟨n, W⟩).bind fun x => PMF.pure (totalDoubledWeight x.2.weight / 2, x.2) := by rw [karger, StateTransitionSpec.run_withCoins_query_bind] dsimp only [StateTransitionSpec.stepFn, step] - rw [Nat.add_sub_cancel_left, RandomizedSpec.run_bind] + rw [RandomizedSpec.run_bind] exact congrArg _ (funext fun ⟨_, G⟩ => StateTransitionSpec.run_withCoins_query_bind (D := spec) Op.total (fun S => pure (S / 2)) G) @@ -331,7 +349,7 @@ theorem two_div_le_toOuterMeasure_karger {n : ℕ} (hn : 2 ≤ n) {W₀ : Fin n have hsurv := survives_contractTimes le_rfl hmin s (isContractionOf_id hW₀) hC (by rw [hid, hCmin]) rw [hid] at hsurv - rw [run_karger, show (2 : ℝ≥0∞) / ((2 + s) * (2 + s - 1) : ℕ) = + rw [run_karger, Nat.add_sub_cancel_left, show (2 : ℝ≥0∞) / ((2 + s) * (2 + s - 1) : ℕ) = ((2 * (2 - 1) : ℕ) : ℝ≥0∞) / ((2 + s) * (2 + s - 1) : ℕ) * 1 by norm_num] refine Probability.PMF.toOuterMeasure_bind_ge_mul_ennreal _ _ _ _ hsurv fun x _ ⟨W', part', B', hx, hC', hpb⟩ => ?_ @@ -343,24 +361,146 @@ theorem two_div_le_toOuterMeasure_karger {n : ℕ} (hn : 2 ≤ n) {W₀ : Fin n rw [totalDoubledWeight_fin_two hC'.multigraph, ← hcut] omega +/-- The law of the answer of one run of `karger` on `G`. -/ +noncomputable def answerLaw (G : Graph) : PMF ℕ := + (spec.toRandomized.withCoins.run karger G).map Prod.fst + +/-- The answer of `karger` is half the total weight of the graph that `n - 2` contractions leave. -/ +theorem answerLaw_eq {n : ℕ} (W : Fin n → Fin n → ℕ) : + answerLaw ⟨n, W⟩ = ((spec.toRandomized.withCoins.run (contractTimes (n - 2)) ⟨n, W⟩).map + Prod.snd).map fun G => totalDoubledWeight G.weight / 2 := by + rw [answerLaw, run_karger, PMF.map_comp, PMF.map_bind] + simp only [PMF.pure_map] + exact PMF.bind_pure_comp _ _ + +/-- Every answer of `karger` on a multigraph with `n ≥ 2` vertices is the weight of a non-trivial +cut. -/ +theorem exists_cut_of_mem_support_answerLaw {n : ℕ} (hn : 2 ≤ n) {W₀ : Fin n → Fin n → ℕ} + (hW₀ : IsMultigraph W₀) {v : ℕ} (hv : v ∈ (answerLaw ⟨n, W₀⟩).support) : + ∃ C : Finset (Fin n), IsNonTrivialCut C ∧ v = cutWeight W₀ C := by + obtain ⟨s, rfl⟩ : ∃ s, n = 2 + s := ⟨n - 2, by omega⟩ + rw [answerLaw_eq, PMF.map_comp, PMF.mem_support_map_iff, Nat.add_sub_cancel_left] at hv + obtain ⟨x, hx, rfl⟩ := hv + obtain ⟨W', part', hx', hC'⟩ := + isContractionOf_of_mem_support_contractTimes (t := 2) (by norm_num) s + (isContractionOf_id hW₀) hx + obtain ⟨hnt, hcw, -⟩ := two_vertex_contraction_output hC' + refine ⟨_, hnt, ?_⟩ + change totalDoubledWeight x.2.weight / 2 = _ + rw [hx'] + change totalDoubledWeight W' / 2 = _ + rw [totalDoubledWeight_fin_two hC'.multigraph, ← hcw] + omega + /-- **One-sided error.** Every answer of `karger` on a multigraph with `n ≥ 2` vertices is the weight of a non-trivial cut, so it is never below the minimum cut weight. -/ theorem minCut_le_of_mem_support_karger {n : ℕ} (hn : 2 ≤ n) {W₀ : Fin n → Fin n → ℕ} (hW₀ : IsMultigraph W₀) {x : ℕ × Graph} (hx : x ∈ (spec.toRandomized.withCoins.run karger ⟨n, W₀⟩).support) : minCut W₀ ≤ x.1 := by - obtain ⟨s, rfl⟩ : ∃ s, n = 2 + s := ⟨n - 2, by omega⟩ - rw [run_karger, PMF.mem_support_bind_iff] at hx - obtain ⟨y, hy, hx⟩ := hx - obtain ⟨W', part', hy', hC'⟩ := - isContractionOf_of_mem_support_contractTimes (t := 2) (by norm_num) s - (isContractionOf_id hW₀) hy - obtain rfl := (PMF.mem_support_pure_iff _ _).mp hx - obtain ⟨-, hcw, hle⟩ := two_vertex_contraction_output hC' - change minCut W₀ ≤ totalDoubledWeight y.2.weight / 2 - rw [hy'] - change minCut W₀ ≤ totalDoubledWeight W' / 2 - rw [totalDoubledWeight_fin_two hC'.multigraph] - omega + obtain ⟨C, hC, hx⟩ := exists_cut_of_mem_support_answerLaw hn hW₀ + ((PMF.mem_support_map_iff _ _ _).mpr ⟨x, hx, rfl⟩) + exact hx ▸ minCut_le_cutWeight W₀ hC + +/-! ## Amplification -/ + +/-- One more run of a trial, keeping the least answer `b` so far. The trial is an oracle whose one +call `()` answers one run of `karger`. -/ +def minStep (b : ℕ) : OracleComp (fun _ : Unit => ℕ) ℕ := do + let v ← OracleComp.query () + pure (min v b) + +/-- **Amplification** [Karger1993]: make `R` runs of a trial and answer the least answer, or `0` +when `R = 0`. Answering each call by an independent run of `karger` on `G`, with +`OracleComp.evalWith (fun _ => answerLaw G)`, gives the law of `R` independent runs. -/ +def minRuns : ℕ → OracleComp (fun _ : Unit => ℕ) ℕ + | 0 => pure 0 + | R + 1 => do + let v ← OracleComp.query () + OracleComp.iterate R minStep v + +/-- After the least answer `b` of earlier runs, `R` more runs answer at most `b`: either `b` or the +answer of one of them. -/ +theorem mem_support_iterate_minStep {μ : PMF ℕ} {R b v : ℕ} + (hv : v ∈ (OracleComp.evalWith (fun _ => μ) (OracleComp.iterate R minStep b)).support) : + v ≤ b ∧ (v = b ∨ v ∈ μ.support) := by + rw [OracleComp.support_evalWith] at hv + refine OracleComp.iterate_invariant (fun _ v => v ≤ b ∧ (v = b ∨ v ∈ μ.support)) + ⟨le_rfl, .inl rfl⟩ (fun _ c _ ⟨hcb, hc⟩ next hnext => ?_) v hv + obtain ⟨u, hu, hnext⟩ := OracleComp.mem_supportWith_bind_iff.mp hnext + obtain rfl := OracleComp.eq_of_mem_supportWith_pure hnext + rw [OracleComp.supportWith_query] at hu + refine ⟨(min_le_right u c).trans hcb, ?_⟩ + rcases min_choice u c with h | h <;> rw [h] + · exact .inr hu + · exact hc + +/-- With `R ≥ 1` runs, every answer of `minRuns R` is the answer of one of the runs. -/ +theorem mem_support_minRuns {μ : PMF ℕ} {R v : ℕ} (hR : R ≠ 0) + (hv : v ∈ (OracleComp.evalWith (fun _ => μ) (minRuns R)).support) : v ∈ μ.support := by + obtain ⟨R, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hR + rw [minRuns, OracleComp.evalWith_bind, OracleComp.evalWith_query, PMF.mem_support_bind_iff] at hv + obtain ⟨u, hu, hv⟩ := hv + obtain ⟨-, rfl | hv⟩ := mem_support_iterate_minStep hv + exacts [hu, hv] + +/-- **Amplification.** If every answer of a run is at least `m` and a run misses `m` with +probability at most `q`, then `R` independent runs all miss it, so `minRuns R` misses it, with +probability at most `q ^ R`. -/ +theorem minRuns_ne_le {μ : PMF ℕ} {m : ℕ} {q : ℝ≥0∞} (hge : ∀ v ∈ μ.support, m ≤ v) + (hmiss : μ.toOuterMeasure {v | v ≠ m} ≤ q) (R : ℕ) : + (OracleComp.evalWith (fun _ => μ) (minRuns R)).toOuterMeasure {v | v ≠ m} ≤ q ^ R := by + have hstep (b : ℕ) : + OracleComp.evalWith (fun _ => μ) (minStep b) = μ.map fun v => min v b := by + simp only [minStep, OracleComp.evalWith_bind, OracleComp.evalWith_query, + OracleComp.evalWith_pure] + exact PMF.bind_pure_comp _ _ + -- Once a run hits `m`, the least answer stays there. + have hstay (R : ℕ) : + (OracleComp.evalWith (fun _ => μ) (OracleComp.iterate R minStep m)).toOuterMeasure + {v | v ≠ m} = 0 := by + refine (PMF.toOuterMeasure_apply_eq_zero_iff _ _).mpr + (Set.disjoint_left.mpr fun v hv hne => hne ?_) + obtain ⟨hle, rfl | hv⟩ := mem_support_iterate_minStep hv + · rfl + · exact le_antisymm hle (hge v hv) + -- After a least answer of at least `m`, each further run misses independently. + have hfrom (R : ℕ) : ∀ b, m ≤ b → + (OracleComp.evalWith (fun _ => μ) (OracleComp.iterate R minStep b)).toOuterMeasure + {v | v ≠ m} ≤ q ^ R := by + induction R with + | zero => exact fun _ _ => (Probability.PMF.toOuterMeasure_le_one _ _).trans (by rw [pow_zero]) + | succ R ih => + intro b hb + rw [OracleComp.iterate_succ_bind, OracleComp.evalWith_bind, pow_succ'] + refine Probability.PMF.toOuterMeasure_bind_le_mul_ennreal _ _ {c | c ≠ m} _ ?_ + (fun c hc _ => ih c ?_) fun c _ hc => by rw [not_not.mp hc]; exact hstay R + · rw [hstep, PMF.toOuterMeasure_map_apply] + refine (PMF.toOuterMeasure_mono _ ?_).trans hmiss + rintro v ⟨hv, -⟩ rfl + exact hv (min_eq_left hb) + · rw [hstep, PMF.mem_support_map_iff] at hc + obtain ⟨v, hv, rfl⟩ := hc + exact le_min (hge v hv) hb + cases R with + | zero => exact (Probability.PMF.toOuterMeasure_le_one _ _).trans (by rw [pow_zero]) + | succ R => + rw [minRuns, OracleComp.evalWith_bind, OracleComp.evalWith_query, pow_succ'] + exact Probability.PMF.toOuterMeasure_bind_le_mul_ennreal _ _ {v | v ≠ m} _ hmiss + (fun v hv _ => hfrom R v (hge v hv)) fun v _ hv => by rw [not_not.mp hv]; exact hstay R + +/-- **Amplification of Karger's algorithm** [Karger1993]. On a connected multigraph with `n ≥ 2` +vertices, `R` independent runs of `karger` all miss the minimum cut weight, so `minRuns R` misses +it, with probability at most `(1 - 2 / (n (n - 1))) ^ R`. -/ +theorem minRuns_ne_minCut_le {n : ℕ} (hn : 2 ≤ n) {W₀ : Fin n → Fin n → ℕ} + (hW₀ : IsMultigraph W₀) (hmin : 0 < minCut W₀) (R : ℕ) : + (OracleComp.evalWith (fun _ => answerLaw ⟨n, W₀⟩) (minRuns R)).toOuterMeasure + {v | v ≠ minCut W₀} ≤ (1 - 2 / ((n * (n - 1) : ℕ) : ℝ≥0∞)) ^ R := by + refine minRuns_ne_le (fun v hv => ?_) (Probability.PMF.toOuterMeasure_compl_le_one_sub _ + {v | v = minCut W₀} ?_) R + · obtain ⟨C, hC, rfl⟩ := exists_cut_of_mem_support_answerLaw hn hW₀ hv + exact minCut_le_cutWeight W₀ hC + · rw [answerLaw, PMF.toOuterMeasure_map_apply] + exact two_div_le_toOuterMeasure_karger hn hW₀ hmin /-! ## Calls -/ diff --git a/Complexity/Algorithms/WordRAM/Karger/Contract.lean b/Complexity/Algorithms/WordRAM/Karger/Contract.lean index 7f52b17c88..7fb8044ed5 100644 --- a/Complexity/Algorithms/WordRAM/Karger/Contract.lean +++ b/Complexity/Algorithms/WordRAM/Karger/Contract.lean @@ -95,6 +95,10 @@ law. * `Cslib.Algorithms.WordRAM.Karger.contractDownTo_law`: `contractDownTo` simulates `k - t` contractions of the specification: `ExecRandLaw` with `IsQueryBounded (k - t)`, worst-case step bound `36 * (k ^ 2 - t ^ 2) + 4`, `Modifies` frame, and the law of `heldGraph`. +* `Cslib.Algorithms.WordRAM.Karger.contractDownToAt_law`: the same on any `r ≥ 16` registers, + preserving the caller's registers. +* `Cslib.Algorithms.WordRAM.Karger.ContractState.mem_add_one`: on two supervertices, the weight + between them is half the total weight of the held graph. * `Cslib.Algorithms.WordRAM.Karger.contractDownTo_spec`: joint certificate of `ExecRand`, `IsQueryBounded (k - t)`, worst-case step bound `36 * (k ^ 2 - t ^ 2) + 4`, `Modifies` frame, contraction invariant `IsContractionOf`, and cut-survival probability lower bound @@ -198,6 +202,16 @@ theorem ContractState.heldGraph_eq {w wb db str k t : ℕ} {W : Fin k → Fin k rw [hst.regs_activeK] exact congrArg _ (funext₂ hst.workspace.1) +/-- On two supervertices, the weight between them, at `wb + 1`, is half the total weight of the +held graph. -/ +theorem ContractState.mem_add_one {w wb db str t : ℕ} {W : Fin 2 → Fin 2 → ℕ} {x : Data 16} + (hst : ContractState w wb db str 2 t W x) (hW : IsMultigraph W) : + x.mem (wb + 1) = totalDoubledWeight (heldGraph wb str x).weight / 2 := by + rw [hst.heldGraph_eq] + change _ = totalDoubledWeight W / 2 + rw [totalDoubledWeight_fin_two hW, show x.mem (wb + 1) = W 0 1 by simpa using hst.workspace.1 0 1] + omega + /-- The weight matrix of a state is the weight of the graph it holds. -/ private theorem ContractState.eq_of_heldGraph_eq {w wb db str k t : ℕ} {W W' : Fin k → Fin k → ℕ} {x : Data 16} (hst : ContractState w wb db str k t W x) (h : heldGraph wb str x = ⟨k, W'⟩) : @@ -2855,6 +2869,24 @@ theorem computeDegreesAndTotalAt_exec {r w wb db str k : ℕ} (hr : 16 ≤ r) · rw [extend_castLE_regs_lt, hy₀_t]; rfl · rw [extend_castLE_regs_lt, hy₀_tot] +/-- `contractDownToAt hr` simulates `k - t` contractions of `Lean.Karger.spec` on any `r`-register +file (`16 ≤ r`), as `contractDownTo_law` does, and preserves all caller registers with index +`≥ 16`. -/ +theorem contractDownToAt_law {r w wb db str k t : ℕ} (hr : 16 ≤ r) {W : Fin k → Fin k → ℕ} + {x : Data r} (ht : 2 ≤ t) (htk : t ≤ k) (hW : IsMultigraph W) + (hst : ContractState w wb db str k t W (x.comap (Fin.castLE hr))) : + ExecRandLaw w (contractDownToAt hr) x + (fun y => Modifies (workspaceFootprint wb db str k) x.mem y.mem ∧ + (∀ j : Fin r, 16 ≤ j.val → y.regs j = x.regs j) ∧ + ∃ W' : Fin t → Fin t → ℕ, IsMultigraph W' ∧ + ContractState w wb db str t t W' (y.comap (Fin.castLE hr))) + (36 * (k ^ 2 - t ^ 2) + 4) (k - t) (fun y => heldGraph wb str (y.comap (Fin.castLE hr))) + ((Lean.Karger.spec.toRandomized.withCoins.run (Lean.Karger.contractTimes (k - t)) + ⟨k, W⟩).map Prod.snd) := + (ExecRandLaw.rename (Fin.castLE_injective hr) (contractDownTo_law ht htk hW hst)).mono + (fun _ ⟨y, ⟨hmod, hy⟩, he⟩ => he ▸ ⟨hmod, fun j hj => extend_castLE_regs_ge hr y x j hj, + by rwa [Data.comap_extend (Fin.castLE_injective hr)]⟩) le_rfl le_rfl + /-- Specification of `contractDownToAt hr` on any `r`-register file (`16 ≤ r`), preserving all caller registers with index `≥ 16`. -/ theorem contractDownToAt_spec {r n w wb db str k t : ℕ} (hr : 16 ≤ r) diff --git a/Complexity/Algorithms/WordRAM/KargerMinCut.lean b/Complexity/Algorithms/WordRAM/KargerMinCut.lean index 4152ddf546..cf1de33e8b 100644 --- a/Complexity/Algorithms/WordRAM/KargerMinCut.lean +++ b/Complexity/Algorithms/WordRAM/KargerMinCut.lean @@ -39,6 +39,19 @@ three complete machine-level endpoints built on the workspace-relocatable subrou misses `minCut W` with probability at most `1 / (2 * n)` (hence at most `1 / n`) whenever `0 < minCut W`, via an elementary Bernoulli power bound without `Real.exp`. +No probability is proved on machine states. Each program simulates a client of +`Cslib.Algorithms.Lean.Karger`: the word it outputs has the law of the answer of +`Cslib.Algorithms.Lean.Karger.karger` (`singleCode_law`), or of the amplification client +`Cslib.Algorithms.Lean.Karger.minRuns` run against independent runs of `karger` +(`amplifiedCode_law`, `highProbCode_law`). Each trial contracts as the client does +(`contractDownTo_law`) and reads half the total weight of the two supervertices left +(`ContractState.mem_add_one`), and the loop of trials keeps the least answer as `minRuns` does +(`ampTrialBody_law`, `ampLoop_law`). The success and failure bounds and the cut realization are the +specification's (`Cslib.Algorithms.Lean.Karger.two_div_le_toOuterMeasure_karger`, +`Cslib.Algorithms.Lean.Karger.minRuns_ne_minCut_le`, +`Cslib.Algorithms.Lean.Karger.exists_cut_of_mem_support_answerLaw`, +`Cslib.Algorithms.Lean.Karger.mem_support_minRuns`), carried through those laws. + ## Source statements and notation mapping * **Source locators (paraphrase):** @@ -88,6 +101,13 @@ three complete machine-level endpoints built on the workspace-relocatable subrou ## Main results +* `Cslib.Algorithms.WordRAM.Karger.singleCode_law`, + `Cslib.Algorithms.WordRAM.Karger.amplifiedCode_law`, + `Cslib.Algorithms.WordRAM.Karger.highProbCode_law`: each program's output has the law of the + output of `karger` or of amplified `karger`, within its instruction and `rand`-call bounds. +* `Cslib.Algorithms.WordRAM.Karger.ampTrialBody_law`, `Cslib.Algorithms.WordRAM.Karger.ampLoop_law`, + `Cslib.Algorithms.WordRAM.Karger.ampCore_law`: one trial, the loop of trials and the + amplification core. * `Cslib.Algorithms.WordRAM.Karger.singleProgram_spec`: worst-case `O(n ^ 2)` step bound, `n - 2` `rand`-call bound, pathwise non-trivial cut realization, `Modifies` frame, and `2 / (n * (n - 1))` success probability lower bound for `singleProgram`. @@ -202,6 +222,53 @@ theorem holdsMatrix_init_amplified {r R n : ℕ} (W : Fin n → Fin n → ℕ) : HoldsMatrix (Data.init (r := r) (R :: n :: flattenMatrix W)).mem 3 n W := holdsMatrix_init_append [R, n] W +/-! ### Compiled programs from the law of their output -/ + +/-- A compiled program whose output word has the law `μ`, supported on the weights of non-trivial +cuts of `W`, halts on every path with such a weight, and outputs `minCut W` with the probability +that `μ` gives it. -/ +private theorem program_of_law {r R T T' n w : ℕ} {c : Code .standard r} {out : Fin r} + {input : List ℕ} {F : Finset ℕ} {W : Fin n → Fin n → ℕ} {μ : PMF ℕ} + (h : ExecRandLaw w c (.init input) (fun y => Modifies F (Data.init (r := r) input).mem y.mem) + T R (fun y => y.regs out) μ) (hT : T + 1 ≤ T') (hfit : InputFits w input) + (hμ : ∀ v ∈ μ.support, ∃ C : Finset (Fin n), IsNonTrivialCut C ∧ v = cutWeight W C) : + RandHaltsWithin w (c.program out) (.init input) T' ∧ + RandCallsBounded w (c.program out) (.init input) T' R ∧ + (∀ cfg ∈ (runRand w (c.program out) T' (.running (.init input))).support, + ∃ (y : Data r) (C : Finset (Fin n)), + cfg = .halted (cutWeight W C) y ∧ y.Bounded w ∧ IsNonTrivialCut C ∧ + minCut W ≤ cutWeight W C ∧ Modifies F (Data.init (r := r) input).mem y.mem) ∧ + μ.toOuterMeasure {v | v = minCut W} ≤ + (evalRand w (c.program out) T' (.init input)).toOuterMeasure + {cfg | ∃ y, cfg = .halted (minCut W) y} ∧ + (evalRand w (c.program out) T' (.init input)).toOuterMeasure + {cfg | ∀ y, cfg ≠ .halted (minCut W) y} ≤ μ.toOuterMeasure {v | v ≠ minCut W} := by + let output : RandCfg r → ℕ := fun | .halted v _ => v | _ => 0 + obtain ⟨hhalt, hcalls, hpost, hlaw⟩ := h.program out hT output fun _ _ => rfl + have hhalted : ∀ cfg ∈ (evalRand w (c.program out) T' (.init input)).support, + ∃ y : Data r, cfg = .halted (y.regs out) y := fun cfg hcfg => by + obtain ⟨y, rfl, -⟩ := hpost cfg (by rwa [support_evalRand] at hcfg) + exact ⟨y, rfl⟩ + refine ⟨hhalt, hcalls, fun cfg hcfg => ?_, ?_, ?_⟩ + · obtain ⟨y, rfl, hmod⟩ := hpost cfg hcfg + obtain ⟨C, hC, hv⟩ := hμ (y.regs out) (by + rw [← hlaw, PMF.mem_support_map_iff] + exact ⟨_, by rwa [support_evalRand], rfl⟩) + exact ⟨y, C, by rw [hv], (runRand_bounded_init hfit hcfg).2, hC, minCut_le_cutWeight W hC, + hmod⟩ + · rw [← hlaw, PMF.toOuterMeasure_map_apply] + refine PMF.toOuterMeasure_mono _ ?_ + rintro cfg ⟨hv, hcfg⟩ + obtain ⟨y, rfl⟩ := hhalted cfg hcfg + change y.regs out = minCut W at hv + exact ⟨y, by rw [hv]⟩ + · rw [← hlaw, PMF.toOuterMeasure_map_apply] + refine PMF.toOuterMeasure_mono _ ?_ + rintro cfg ⟨hne, hcfg⟩ hv + obtain ⟨y, rfl⟩ := hhalted cfg hcfg + change y.regs out = minCut W at hv + exact hne y (by rw [hv]) + /-! ### Endpoint 1: Single-trial Basic Karger (`r = 16`) -/ section SingleTrial @@ -314,21 +381,20 @@ theorem singlePost_exec {w wb : ℕ} {x : Data 16} (hwBase : x.regs wBase = wb) Exec.load (B := .standard) (w := w) (d := val1) (a := addr1) (x := s₂) exact ⟨s₃, e1.seq (e2.seq e3), rfl, by simp [s₃]⟩ -/-- Structured `ProbComp` specification of `singleCode`. -/ -theorem singleCode_spec {n w : ℕ} {W : Fin n → Fin n → ℕ} +/-- **A single trial runs `karger`.** At word size `w ≥ logWidth 3 n` with +`totalDoubledWeight W < 2 ^ w`, `singleCode` on `n :: flattenMatrix W` runs within +`singleTime n - 1` instructions and `n - 2` `rand` calls and writes only `[2, 2 + n * n + n)`. The +weight it leaves in `val1` has the law of the answer of `Lean.Karger.karger` on `⟨n, W⟩`: +`contractDownTo` contracts as the client does (`contractDownTo_law`), and `singlePost` reads the +weight between the last two supervertices, half their total weight. -/ +theorem singleCode_law {n w : ℕ} {W : Fin n → Fin n → ℕ} (hn : 2 ≤ n) (hW : IsMultigraph W) (hw : logWidth 3 n ≤ w) (htot : Fits w (totalDoubledWeight W)) : - ∃ m : ProbComp (Data 16 × ℕ), - ExecRand w singleCode (Data.init (n :: flattenMatrix W)) m ∧ - m.IsQueryBounded (n - 2) ∧ - (∀ z ∈ m.support, - z.2 + 1 ≤ singleTime n ∧ - Modifies (Finset.Ico 2 (2 + n * n + n)) - (Data.init (r := 16) (n :: flattenMatrix W)).mem z.1.mem ∧ - ∃ C : Finset (Fin n), IsNonTrivialCut C ∧ z.1.regs val1 = cutWeight W C) ∧ - (0 < minCut W → - (2 : ℝ≥0∞) / ((n * (n - 1) : ℕ) : ℝ≥0∞) ≤ - m.eval.toOuterMeasure {z | z.1.regs val1 = minCut W}) := by + ExecRandLaw w singleCode (Data.init (n :: flattenMatrix W)) + (fun y => Modifies (Finset.Ico 2 (2 + n * n + n)) + (Data.init (r := 16) (n :: flattenMatrix W)).mem y.mem) + (42 * n ^ 2 + 12 * n + 20) (n - 2) (fun y => y.regs val1) + (Lean.Karger.answerLaw ⟨n, W⟩) := by have hws_fit := fits_workspace_of_logWidth_three hn hw have h1 : Fits w 1 := hws_fit.of_le (by omega) have hwEnd : Fits w (2 + n * n) := hws_fit.of_le (by omega) @@ -336,8 +402,7 @@ theorem singleCode_spec {n w : ℕ} {W : Fin n → Fin n → ℕ} have hwb1 : Fits w (2 + 1) := hws_fit.of_le (by omega) obtain ⟨y_setup, e_setup, hmem_setup, hwb_s, hdb_s, hstr_s, hk_s, ht_s⟩ := singleSetup_exec (W := W) hn hw - obtain ⟨y_deg, ⟨n_deg, hn_deg, e_deg⟩, hws_deg, hmod_deg, _, _, - hwb_d, hdb_d, hstr_d, hk_d, ht_d, htot_d⟩ := + obtain ⟨y_deg, e_deg, hws_deg, hmod_deg, _, _, hwb_d, hdb_d, hstr_d, hk_d, ht_d, htot_d⟩ := computeDegreesAndTotal_exec (w := w) (W := W) (x := y_setup) hwb_s hdb_s hstr_s hk_s (le_refl n) (Or.inl (le_refl _)) h1 hwEnd hdEnd htot (hmem_setup ▸ holdsMatrix_init_single W) @@ -345,106 +410,27 @@ theorem singleCode_spec {n w : ℕ} {W : Fin n → Fin n → ℕ} have hst_deg : ContractState w 2 (2 + n * n) n n 2 W y_deg := ⟨hwb_d, hdb_d, hstr_d, hk_d, ht_d, htot_d, le_refl n, Or.inl (le_refl _), hwEnd, hdEnd, htot, hws_deg⟩ - obtain ⟨m_c, hm_c, hq_c, hsup_c, hsurv_c⟩ := - contractDownTo_spec (le_refl 2) hn (isContractionOf_id hW) hst_deg - have hpost_all : ∀ z ∈ m_c.support, - ∃ y_p : Data 16, Exec w singlePost z.1 y_p 3 ∧ - y_p.mem = z.1.mem ∧ y_p.regs val1 = z.1.mem 3 := by - intro z hz - rcases hsup_c z hz with ⟨_, _, W', part', _, hst'⟩ - exact singlePost_exec hst'.regs_wBase h1 hwb1 - obtain ⟨m_post, hm_post_def⟩ : - ∃ m_post : Data 16 → ProbComp (Data 16 × ℕ), - ∀ d, m_post d = codeComp w singlePost d := ⟨_, fun _ => rfl⟩ - have hm_post : ∀ z ∈ m_c.support, ExecRand w singlePost z.1 (m_post z.1) := by - intro z hz - obtain ⟨y_p, e_p, _, _⟩ := hpost_all z hz - have hr := e_p.execRand - rw [hm_post_def] - simpa only [hr.codeComp_eq] using hr - have hm_c_post : ExecRand w (ram[⟪contractDownTo⟫; ⟪singlePost⟫]) y_deg - (do let z₁ ← m_c; let z₂ ← m_post z₁.1; pure (z₂.1, z₁.2 + z₂.2)) := - ExecRand.seq hm_c hm_post - have hm_deg_rest := e_deg.seqRand hm_c_post - have hm_full := e_setup.seqRand hm_deg_rest - let m_total := (fun z => (z.1, 7 + z.2)) <$> - ((fun z => (z.1, n_deg + z.2)) <$> - (do let z₁ ← m_c; let z₂ ← m_post z₁.1; pure (z₂.1, z₁.2 + z₂.2))) + have hsub : workspaceFootprint 2 (2 + n * n) n n ⊆ Finset.Ico 2 (2 + n * n + n) := by + intro a ha + simp only [workspaceFootprint, Finset.mem_union, Finset.mem_Ico] at ha ⊢ + omega + have hrun := ExecRandLaw.seq (contractDownTo_law (le_refl 2) hn hW hst_deg) + (κ := fun G => PMF.pure (totalDoubledWeight G.weight / 2)) fun y ⟨hmod_c, W', hW', hst'⟩ => by + obtain ⟨y_p, e_p, hmem_p, hv_p⟩ := singlePost_exec hst'.regs_wBase h1 hwb1 + have hmod : Modifies (Finset.Ico 2 (2 + n * n + n)) + (Data.init (r := 16) (n :: flattenMatrix W)).mem y_p.mem := by + rw [hmem_p] + exact modifies_trans_subset (hmem_setup ▸ hmod_deg) hmod_c + (Finset.Ico_subset_Ico (by omega) le_rfl) hsub + exact (ExecRandLaw.of_execWithin (f := fun y => y.regs val1) e_p.within hmod).congr_law + (by rw [hv_p, hst'.mem_add_one hW']) have hcode_eq : singleCode = .seq singleSetup (.seq computeDegreesAndTotal (.seq contractDownTo singlePost)) := rfl rw [hcode_eq] - refine ⟨m_total, hm_full, ?_, ?_, ?_⟩ - · simp only [m_total, OracleComp.IsQueryBounded, OracleComp.isCostBounded_map_iff] - have hq_post : ∀ z₁ ∈ m_c.support, - (m_post z₁.1 >>= fun z₂ => pure (z₂.1, z₁.2 + z₂.2)).IsQueryBounded 0 := by - intro z₁ hz₁ - obtain ⟨y_p, e_p, _, _⟩ := hpost_all z₁ hz₁ - rw [hm_post_def, e_p.execRand.codeComp_eq, pure_bind] - exact .pure _ 0 - simpa only [Nat.add_zero] using OracleComp.IsCostBounded.bind_on_support hq_c hq_post - · intro z hz - simp only [m_total, Functor.map_map] at hz - obtain ⟨z₀, hz₀, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hz - obtain ⟨z₁, hz₁, hrest⟩ := OracleComp.mem_supportWith_bind_iff.mp hz₀ - obtain ⟨y_p, e_p, hmem_p, hv1_p⟩ := hpost_all z₁ hz₁ - rw [hm_post_def, e_p.execRand.codeComp_eq] at hrest - obtain ⟨z₂, hz₂, hpure⟩ := OracleComp.mem_supportWith_bind_iff.mp hrest - cases OracleComp.eq_of_mem_supportWith_pure hz₂ - cases OracleComp.eq_of_mem_supportWith_pure hpure - rcases hsup_c z₁ hz₁ with ⟨ht_c, hmod_c, W', part', hC', hst'⟩ - refine ⟨?_, ?_, ?_⟩ - · simp only [singleTime] - omega - · rw [hmem_p] - have hsub1 : Finset.Ico (2 + n * n) (2 + n * n + n) ⊆ Finset.Ico 2 (2 + n * n + n) := - Finset.Ico_subset_Ico (by omega) (le_refl _) - have hsub2 : workspaceFootprint 2 (2 + n * n) n n ⊆ Finset.Ico 2 (2 + n * n + n) := by - intro a ha - simp only [workspaceFootprint, Finset.mem_union, Finset.mem_Ico] at ha ⊢ - omega - exact modifies_trans_subset (hmem_setup ▸ hmod_deg) hmod_c hsub1 hsub2 - · refine ⟨pullbackCut part' {0}, - isNonTrivialCut_pullbackCut hC'.surj (isNonTrivialCut_singleton (by simp) 0), ?_⟩ - rw [hv1_p, cutWeight_pullbackCut hC', cutWeight_two_singleton_zero hC'.multigraph] - simpa using hst'.workspace.1 0 1 - · intro hmin_pos - obtain ⟨C_star, hC_nt, hC_min⟩ := exists_minCut_achiever (by rwa [Fintype.card_fin]) W - have hpb_id : pullbackCut (id : Fin n → Fin n) C_star = C_star := by - ext u - simp [pullbackCut] - have hsurv := hsurv_c C_star hmin_pos hC_nt (by rw [hpb_id, hC_min]) - rw [hpb_id] at hsurv - have h2 : (((2 * (2 - 1) : ℕ) : ℝ≥0∞) / ((n * (n - 1) : ℕ) : ℝ≥0∞)) = - (2 : ℝ≥0∞) / ((n * (n - 1) : ℕ) : ℝ≥0∞) := by norm_num - rw [h2] at hsurv - refine hsurv.trans ?_ - have hm_eval : m_total.eval = - m_c.eval.bind fun z₁ => - ((m_post z₁.1).eval.map fun z₂ => (z₂.1, 7 + (n_deg + (z₁.2 + z₂.2)))) := by - have hm_eq : m_total = (do - let z₁ ← m_c - let z₂ ← m_post z₁.1 - pure (z₂.1, 7 + (n_deg + (z₁.2 + z₂.2)))) := by - simp only [m_total, ← bind_pure_comp, bind_assoc, pure_bind] - rw [hm_eq, ProbComp.eval_bind] - refine congrArg (m_c.eval.bind ·) (funext fun z₁ => ?_) - rw [bind_pure_comp, ProbComp.eval_map] - rw [hm_eval] - have hstep := toOuterMeasure_bind_ge_mul_ennreal m_c.eval - (fun z₁ => (m_post z₁.1).eval.map fun z₂ => (z₂.1, 7 + (n_deg + (z₁.2 + z₂.2)))) - {z | SurvivalPost W 2 (2 + n * n) n 2 C_star z.1} - {z | z.1.regs val1 = minCut W} - (s₁ := m_c.eval.toOuterMeasure {z | SurvivalPost W 2 (2 + n * n) n 2 C_star z.1}) - (s₂ := 1) le_rfl ?_ - · simpa using hstep - · intro z₁ hz₁_eval hsurv₁ - have hz₁ : z₁ ∈ m_c.support := (ProbComp.support_eval m_c) ▸ hz₁_eval - obtain ⟨y_p, e_p, _, hv1_p⟩ := hpost_all z₁ hz₁ - rw [hm_post_def, e_p.execRand.codeComp_eq, ProbComp.eval_pure, - PMF.toOuterMeasure_map_apply, PMF.toOuterMeasure_pure_apply] - have hmem3 : z₁.1.mem 3 = minCut W := survivalPost_two_mem_eq hC_nt hC_min hsurv₁ - have hhit : y_p.regs val1 = minCut W := hv1_p.trans hmem3 - simp [hhit] + refine ((ExecRandLaw.seq_det e_setup.within (ExecRandLaw.seq_det e_deg hrun)).congr_law ?_).mono + (fun _ h => h) (by omega) (by omega) + rw [Lean.Karger.answerLaw_eq] + exact PMF.bind_pure_comp _ _ /-- **Single-trial Basic Karger specification (`singleProgram`).** At word size `w ≥ logWidth 3 n` when `totalDoubledWeight W < 2 ^ w`: @@ -473,29 +459,12 @@ theorem singleProgram_spec {n w : ℕ} {W : Fin n → Fin n → ℕ} (evalRand w singleProgram (singleTime n) (.init input)).toOuterMeasure {cfg | ∃ y, cfg = .halted (minCut W) y}) := by intro input - have hfit_in : InputFits w input := inputFits_single hn hw htot - obtain ⟨m, hm, hq, hsup, hsurv⟩ := singleCode_spec hn hW hw htot - have hrun : runRand w singleProgram (singleTime n) (.running (.init input)) = - (fun z : Data 16 × ℕ => RandCfg.halted (z.1.regs val1) z.1) <$> m := - hm.runRand_program val1 fun z hz => (hsup z hz).1 - refine ⟨?_, ?_, ?_, ?_⟩ - · intro cfg hcfg - rw [hrun] at hcfg - obtain ⟨z, -, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hcfg - exact ⟨z.1.regs val1, z.1, rfl⟩ - · rw [RandCallsBounded, hrun] - exact (OracleComp.isCostBounded_map_iff _ _ _).mpr hq - · intro cfg hcfg - have hbnd := (runRand_bounded_init hfit_in hcfg) - rw [hrun] at hcfg - obtain ⟨z, hz, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hcfg - rcases hsup z hz with ⟨_, hmod, C, hC_nt, hv1⟩ - exact ⟨z.1, C, by rw [hv1], hbnd.2, hC_nt, minCut_le_cutWeight W hC_nt, hmod⟩ - · intro hmin_pos - rw [evalRand, hrun, ProbComp.eval_map, PMF.toOuterMeasure_map_apply] - refine (hsurv hmin_pos).trans (PMF.toOuterMeasure_mono _ ?_) - intro z hz - exact ⟨z.1, congrArg (fun v => RandCfg.halted v z.1) hz.1⟩ + obtain ⟨hhalt, hcalls, hpost, hhit, -⟩ := program_of_law (T' := singleTime n) + (singleCode_law hn hW hw htot) (by unfold singleTime; omega) (inputFits_single hn hw htot) + fun _ hv => Lean.Karger.exists_cut_of_mem_support_answerLaw hn hW hv + refine ⟨hhalt, hcalls, hpost, fun hmin => le_trans ?_ hhit⟩ + rw [Lean.Karger.answerLaw, PMF.toOuterMeasure_map_apply] + exact Lean.Karger.two_div_le_toOuterMeasure_karger hn hW hmin end SingleTrial @@ -692,7 +661,6 @@ structure AmpInv (w sb n R i : ℕ) (W : Fin n → Fin n → ℕ) (mem₀ : ℕ regs_trialIdx : x.regs trialIdx = i src_matrix : HoldsMatrix x.mem sb n W modifies_ws : Modifies (Finset.Ico (sb + n * n) (sb + 2 * (n * n) + n)) mem₀ x.mem - best_cut : 0 < i → ∃ C : Finset (Fin n), IsNonTrivialCut C ∧ x.regs bestVal = cutWeight W C theorem ampTrialPost_exec {w wb i R : ℕ} {x : Data 22} (hwb : x.regs wBase = wb) (hti : x.regs trialIdx = i) (hiR : i < R) @@ -821,37 +789,27 @@ theorem ampTrialPost_exec {w wb i R : ℕ} {x : Data 22} exact ((e1.within).seq ((e2.within).seq ((e3.within).seq ((e4.within).seq (e_br.seq e_inc))))).mono (by omega) -private theorem ampTrial_step_bound {n n_cp n_deg t_c n_p : ℕ} - (hcp : n_cp ≤ 7 * (n * n) + 4) - (hdeg : n_deg ≤ 6 * n ^ 2 + 12 * n + 6) - (hc : t_c ≤ 36 * (n ^ 2 - 2 ^ 2) + 4) - (hp : n_p ≤ 10) : - (n_cp + (3 + n_deg)) + (t_c + n_p) ≤ 49 * n ^ 2 + 12 * n + 27 := by - have hnn : n * n = n ^ 2 := (sq n).symm - omega - -/-- Specification of a single trial `ampTrialBody` from `AmpInv`. -/ -theorem ampTrialBody_spec {w sb n R i : ℕ} {W : Fin n → Fin n → ℕ} {mem₀ : ℕ → ℕ} {x : Data 22} +/-- **One trial runs `karger`.** From `AmpInv` at trial `i < R`, `ampTrialBody` runs within +`49 n² + 12 n + 27` instructions and `n - 2` `rand` calls and keeps the invariant at trial `i + 1`. +Its new `bestVal` has the law of the answer `v` of `Lean.Karger.karger` on `⟨n, W⟩`, taken as is on +the first trial and as `min v bestVal` after: `contractDownToAt` contracts the fresh copy of `W` as +the client does (`contractDownToAt_law`), and `ampTrialPost` reads the weight between the last two +supervertices, half their total weight. -/ +theorem ampTrialBody_law {w sb n R i : ℕ} {W : Fin n → Fin n → ℕ} {mem₀ : ℕ → ℕ} {x : Data 22} (hn : 2 ≤ n) (hW : IsMultigraph W) (hiR : i < R) (h1 : Fits w 1) (hdEnd : Fits w (sb + 2 * (n * n) + n)) (hR_fit : Fits w R) (htot : Fits w (totalDoubledWeight W)) (hinv : AmpInv w sb n R i W mem₀ x) : - ∃ m : ProbComp (Data 22 × ℕ), - ExecRand w ampTrialBody x m ∧ - m.IsQueryBounded (n - 2) ∧ - (∀ z ∈ m.support, - z.2 ≤ 49 * n ^ 2 + 12 * n + 27 ∧ - AmpInv w sb n R (i + 1) W mem₀ z.1 ∧ - (0 < i → x.regs bestVal = minCut W → z.1.regs bestVal = minCut W)) ∧ - (0 < minCut W → - m.eval.toOuterMeasure {z | z.1.regs bestVal ≠ minCut W} ≤ - (1 : ℝ≥0∞) - (2 : ℝ≥0∞) / ((n * (n - 1) : ℕ) : ℝ≥0∞)) := by + ExecRandLaw w ampTrialBody x (AmpInv w sb n R (i + 1) W mem₀) (49 * n ^ 2 + 12 * n + 27) + (n - 2) (fun y => y.regs bestVal) + ((Lean.Karger.answerLaw ⟨n, W⟩).map fun v => + if i = 0 then v else min v (x.regs bestVal)) := by let wb := sb + n * n let db := sb + 2 * (n * n) have hwEnd : Fits w (wb + n * n) := hdEnd.of_le (by omega) have h2_fit : Fits w 2 := hdEnd.of_le (by omega) have hwb1_fit : Fits w (wb + 1) := hdEnd.of_le (by omega) - obtain ⟨y_cp, ⟨n_cp, hn_cp, e_cp⟩, hmat_cp, hmod_cp, + obtain ⟨y_cp, e_cp, hmat_cp, hmod_cp, hwb_cp, hdb_cp, hsb_cp, hn_cp_reg, hml_cp, hnt_cp, hti_cp, hbv_cp⟩ := copyMatrixCode_exec hinv.regs_srcBase hinv.regs_wBase hinv.regs_matLen (le_refl _) h1 hwEnd hinv.src_matrix @@ -872,7 +830,7 @@ theorem ampTrialBody_spec {w sb n R i : ℕ} {W : Fin n → Fin n → ℕ} {mem have ec3 : Exec (B := .standard) w ram[targetT ← #2] ((y_cp.set activeK n).set stride n) y_cfg 1 := Exec.const h2_fit - obtain ⟨y_deg, ⟨n_deg, hn_deg, e_deg⟩, hws_deg, hmod_deg, + obtain ⟨y_deg, e_deg, hws_deg, hmod_deg, hwb_d, hdb_d, hstr_d, hk_d, ht_d, htot_d, hhi_d⟩ := computeDegreesAndTotalAt_exec (w := w) (W := W) (x := y_cfg) hr22 (by change y_cfg.regs wBase = wb; simpa +decide [y_cfg, Function.update_apply] using hwb_cp) @@ -887,8 +845,6 @@ theorem ampTrialBody_spec {w sb n R i : ℕ} {W : Fin n → Fin n → ℕ} {mem have hst_deg : ContractState w wb db n n 2 W (y_deg.comap (Fin.castLE hr22)) := ⟨hwb_d, hdb_d, hstr_d, hk_d, ht_d', htot_d, le_refl n, Or.inl (by omega), hwEnd, hdEnd, htot, hws_deg⟩ - obtain ⟨m_c, hm_c, hq_c, hsup_c, hsurv_c⟩ := - contractDownToAt_spec hr22 (le_refl 2) hn (isContractionOf_id hW) hst_deg have hy_deg_hi : y_deg.regs srcBase = sb ∧ y_deg.regs nOrig = n ∧ y_deg.regs matLen = n * n ∧ y_deg.regs numTrials = R ∧ y_deg.regs trialIdx = i ∧ y_deg.regs bestVal = x.regs bestVal := by @@ -899,321 +855,106 @@ theorem ampTrialBody_spec {w sb n R i : ℕ} {W : Fin n → Fin n → ℕ} {mem · rw [hhi_d numTrials (by decide)]; simpa +decide [y_cfg, Function.update_apply] using hnt_cp · rw [hhi_d trialIdx (by decide)]; simpa +decide [y_cfg, Function.update_apply] using hti_cp · rw [hhi_d bestVal (by decide)]; simpa +decide [y_cfg, Function.update_apply] using hbv_cp - have hpost_all : ∀ z ∈ m_c.support, - ∃ (y_p : Data 22) (n_p : ℕ), n_p ≤ 10 ∧ Exec w ampTrialPost z.1 y_p n_p ∧ - y_p.mem = z.1.mem ∧ - y_p.regs srcBase = sb ∧ y_p.regs wBase = wb ∧ y_p.regs dBase = db ∧ - y_p.regs nOrig = n ∧ y_p.regs matLen = n * n ∧ y_p.regs numTrials = R ∧ - y_p.regs trialIdx = i + 1 ∧ - y_p.regs bestVal = - (if i = 0 then z.1.mem (wb + 1) else min (z.1.mem (wb + 1)) (x.regs bestVal)) := by - intro z hz - rcases hsup_c z hz with ⟨_, _, hz_hi, W', part', _, hst'⟩ - have hz_wb : z.1.regs wBase = wb := hst'.regs_wBase - have hz_db : z.1.regs dBase = db := hst'.regs_dBase - have hz_sb : z.1.regs srcBase = sb := (hz_hi srcBase (by decide)).trans hy_deg_hi.1 - have hz_n : z.1.regs nOrig = n := (hz_hi nOrig (by decide)).trans hy_deg_hi.2.1 - have hz_ml : z.1.regs matLen = n * n := (hz_hi matLen (by decide)).trans hy_deg_hi.2.2.1 - have hz_nt : z.1.regs numTrials = R := (hz_hi numTrials (by decide)).trans hy_deg_hi.2.2.2.1 - have hz_ti : z.1.regs trialIdx = i := (hz_hi trialIdx (by decide)).trans hy_deg_hi.2.2.2.2.1 - have hz_bv : z.1.regs bestVal = x.regs bestVal := - (hz_hi bestVal (by decide)).trans hy_deg_hi.2.2.2.2.2 - obtain ⟨y_p, ⟨n_p, hn_p, e_p⟩, hm_p, hsb_p, hwb_p, hdb_p, hn_p_r, hml_p, hnt_p, hti_p, hbv_p⟩ := - ampTrialPost_exec hz_wb hz_ti hiR h1 hwb1_fit hR_fit - exact ⟨y_p, n_p, hn_p, e_p, hm_p, hsb_p.trans hz_sb, hwb_p, hdb_p.trans hz_db, - hn_p_r.trans hz_n, hml_p.trans hz_ml, hnt_p.trans hz_nt, hti_p, - by simpa only [hz_bv] using hbv_p⟩ - obtain ⟨m_post, hm_post_def⟩ : - ∃ m_post : Data 22 → ProbComp (Data 22 × ℕ), - ∀ d, m_post d = codeComp w ampTrialPost d := ⟨_, fun _ => rfl⟩ - have hm_post : ∀ z ∈ m_c.support, ExecRand w ampTrialPost z.1 (m_post z.1) := by - intro z hz - obtain ⟨y_p, n_p, _, e_p, _⟩ := hpost_all z hz - have hr := e_p.execRand - rw [hm_post_def] - simpa only [hr.codeComp_eq] using hr - have hm_c_post := ExecRand.seq hm_c hm_post - have hm_body : ExecRand w ampTrialBody x - ((fun z => (z.1, (n_cp + (3 + n_deg)) + z.2)) <$> - (do let z₁ ← m_c; let z₂ ← m_post z₁.1; pure (z₂.1, z₁.2 + z₂.2))) := by - have hbody_eq : ampTrialBody = .seq copyMatrixCode - (.seq ram[activeK ← nOrig] (.seq ram[stride ← nOrig] - (.seq ram[targetT ← #2] (.seq (computeDegreesAndTotalAt hr22) - (.seq (contractDownToAt hr22) ampTrialPost))))) := rfl - rw [hbody_eq] - have r4 := e_deg.seqRand hm_c_post - have r3 := ec3.seqRand r4 - have r2 := ec2.seqRand r3 - have r1 := ec1.seqRand r2 - have r0 := e_cp.seqRand r1 - have h111 : ∀ k, 1 + (1 + (1 + k)) = 3 + k := fun _ => by omega - simpa only [Functor.map_map, Nat.add_assoc, h111] using r0 - let m_total := (fun z => (z.1, (n_cp + (3 + n_deg)) + z.2)) <$> - (do let z₁ ← m_c; let z₂ ← m_post z₁.1; pure (z₂.1, z₁.2 + z₂.2)) - refine ⟨m_total, hm_body, ?_, ?_, ?_⟩ - · simp only [m_total, OracleComp.IsQueryBounded, OracleComp.isCostBounded_map_iff] - have hq_post : ∀ z₁ ∈ m_c.support, - (m_post z₁.1 >>= fun z₂ => pure (z₂.1, z₁.2 + z₂.2)).IsQueryBounded 0 := by - intro z₁ hz₁ - obtain ⟨y_p, n_p, _, e_p, _⟩ := hpost_all z₁ hz₁ - rw [hm_post_def, e_p.execRand.codeComp_eq, pure_bind] - exact .pure _ 0 - simpa only [Nat.add_zero] using OracleComp.IsCostBounded.bind_on_support hq_c hq_post - · intro z hz - obtain ⟨z₀, hz₀, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hz - obtain ⟨z₁, hz₁, hrest⟩ := OracleComp.mem_supportWith_bind_iff.mp hz₀ - obtain ⟨y_p, n_p, hn_p, e_p, hm_p, hsb_p, hwb_p, hdb_p, hn_p_r, hml_p, hnt_p, hti_p, hbv_p⟩ := - hpost_all z₁ hz₁ - rw [hm_post_def, e_p.execRand.codeComp_eq] at hrest - obtain ⟨z₂, hz₂, hpure⟩ := OracleComp.mem_supportWith_bind_iff.mp hrest - cases OracleComp.eq_of_mem_supportWith_pure hz₂ - cases OracleComp.eq_of_mem_supportWith_pure hpure - rcases hsup_c z₁ hz₁ with ⟨ht_c, hmod_c, _, W', part', hC', hst'⟩ - have hmod_ws_all : Modifies (Finset.Ico wb (db + n)) x.mem y_p.mem := by - rw [hm_p] - have hs_cp : Finset.Ico wb (wb + n * n) ⊆ Finset.Ico wb (db + n) := - Finset.Ico_subset_Ico (le_refl _) (by omega) - have hs_deg : Finset.Ico db (db + n) ⊆ Finset.Ico wb (db + n) := - Finset.Ico_subset_Ico (by omega) (le_refl _) - have hs_c : workspaceFootprint wb db n n ⊆ Finset.Ico wb (db + n) := by - intro a ha - simp only [workspaceFootprint, Finset.mem_union, Finset.mem_Ico] at ha ⊢ - omega - have hm12 := modifies_trans_subset hmod_cp hmod_deg hs_cp hs_deg - exact modifies_trans_subset hm12 hmod_c Finset.Subset.rfl hs_c - have hsrc_preserved : HoldsMatrix y_p.mem sb n W := by - intro a b - have hlt : sb + a.val * n + b.val < wb := by - have := matAddr_lt_end (wb := sb) (le_refl n) a b - omega - rw [hmod_ws_all _ (by rw [Finset.mem_Ico]; omega)] - exact hinv.src_matrix a b - have hnew_cut : z₁.1.mem (wb + 1) = cutWeight W (pullbackCut part' {0}) := by - rw [cutWeight_pullbackCut hC', cutWeight_two_singleton_zero hC'.multigraph] - simpa using hst'.workspace.1 0 1 - have hnew_nt : IsNonTrivialCut (pullbackCut part' {0}) := - isNonTrivialCut_pullbackCut hC'.surj (isNonTrivialCut_singleton (by simp) 0) - refine ⟨ampTrial_step_bound hn_cp hn_deg ht_c hn_p, ?_, ?_⟩ - · refine ⟨hsb_p, hwb_p, hdb_p, hn_p_r, hml_p, hnt_p, hti_p, hsrc_preserved, - modifies_trans_subset hinv.modifies_ws hmod_ws_all Finset.Subset.rfl Finset.Subset.rfl, - fun _ => ?_⟩ - by_cases hi0 : i = 0 - · exact ⟨pullbackCut part' {0}, hnew_nt, by simp [hbv_p, hi0, hnew_cut]⟩ - · obtain ⟨C_old, hC_old_nt, hbv_old⟩ := hinv.best_cut (Nat.pos_of_ne_zero hi0) - simp only [hbv_p, hi0, ↓reduceIte] - by_cases hle : z₁.1.mem (wb + 1) ≤ x.regs bestVal - · exact ⟨pullbackCut part' {0}, hnew_nt, by rw [Nat.min_eq_left hle, hnew_cut]⟩ - · exact ⟨C_old, hC_old_nt, by rw [Nat.min_eq_right (Nat.le_of_not_le hle), hbv_old]⟩ - · intro hi_pos hbv_min - have hi0 : i ≠ 0 := Nat.ne_of_gt hi_pos - have hge : minCut W ≤ z₁.1.mem (wb + 1) := by - rw [hnew_cut] - exact minCut_le_cutWeight W hnew_nt - simp only [hbv_p, hi0, ↓reduceIte, hbv_min] - exact Nat.min_eq_right hge - · intro hmin_pos - obtain ⟨C_star, hC_nt, hC_min⟩ := exists_minCut_achiever (by rwa [Fintype.card_fin]) W - have hpb_id : pullbackCut (id : Fin n → Fin n) C_star = C_star := by - ext u - simp [pullbackCut] - have hsurv := hsurv_c C_star hmin_pos hC_nt (by rw [hpb_id, hC_min]) - rw [hpb_id] at hsurv - have h2 : (((2 * (2 - 1) : ℕ) : ℝ≥0∞) / ((n * (n - 1) : ℕ) : ℝ≥0∞)) = - (2 : ℝ≥0∞) / ((n * (n - 1) : ℕ) : ℝ≥0∞) := by norm_num - rw [h2] at hsurv - have hhit_ge : (2 : ℝ≥0∞) / ((n * (n - 1) : ℕ) : ℝ≥0∞) ≤ - m_total.eval.toOuterMeasure {z | z.1.regs bestVal = minCut W} := by - refine hsurv.trans ?_ - have hm_eval : m_total.eval = - m_c.eval.bind fun z₁ => - ((m_post z₁.1).eval.map fun z₂ => - (z₂.1, (n_cp + (3 + n_deg)) + (z₁.2 + z₂.2))) := by - have hm_eq : m_total = (do - let z₁ ← m_c - let z₂ ← m_post z₁.1 - pure (z₂.1, (n_cp + (3 + n_deg)) + (z₁.2 + z₂.2))) := by - simp only [m_total, ← bind_pure_comp, bind_assoc, pure_bind] - rw [hm_eq, ProbComp.eval_bind] - refine congrArg (m_c.eval.bind ·) (funext fun z₁ => ?_) - rw [bind_pure_comp, ProbComp.eval_map] - rw [hm_eval] - have hstep := toOuterMeasure_bind_ge_mul_ennreal m_c.eval - (fun z₁ => (m_post z₁.1).eval.map fun z₂ => - (z₂.1, (n_cp + (3 + n_deg)) + (z₁.2 + z₂.2))) - {z | SurvivalPost W wb db n 2 C_star (z.1.comap (Fin.castLE hr22))} - {z | z.1.regs bestVal = minCut W} - (s₁ := m_c.eval.toOuterMeasure - {z | SurvivalPost W wb db n 2 C_star (z.1.comap (Fin.castLE hr22))}) - (s₂ := 1) le_rfl ?_ - · simpa using hstep - · intro z₁ hz₁_eval hsurv₁ - have hz₁ : z₁ ∈ m_c.support := (ProbComp.support_eval m_c) ▸ hz₁_eval - obtain ⟨y_p, n_p, _, e_p, _, _, _, _, _, _, _, _, hbv_p⟩ := hpost_all z₁ hz₁ - rw [hm_post_def, e_p.execRand.codeComp_eq, ProbComp.eval_pure, - PMF.toOuterMeasure_map_apply, PMF.toOuterMeasure_pure_apply] - have hmem_wb1 : z₁.1.mem (wb + 1) = minCut W := - survivalPost_two_mem_eq hC_nt hC_min hsurv₁ - have hbv_hit : y_p.regs bestVal = minCut W := by - rw [hbv_p, hmem_wb1] - by_cases hi0 : i = 0 - · simp [hi0] - · obtain ⟨C_old, hC_old_nt, hbv_old⟩ := hinv.best_cut (Nat.pos_of_ne_zero hi0) - simp only [hi0, ↓reduceIte, hbv_old] - exact Nat.min_eq_left (minCut_le_cutWeight W hC_old_nt) - simp [hbv_hit] - have hcompl : {z : Data 22 × ℕ | z.1.regs bestVal ≠ minCut W} = - {z : Data 22 × ℕ | z.1.regs bestVal = minCut W}ᶜ := by - ext z - simp - rw [hcompl] - exact toOuterMeasure_compl_le_one_sub m_total.eval _ hhit_ge - -/-- Specification of `ampLoop` over `rem = R - i` remaining trials. -/ -theorem ampLoop_spec {w sb n R : ℕ} {W : Fin n → Fin n → ℕ} {mem₀ : ℕ → ℕ} - (hn : 2 ≤ n) (hW : IsMultigraph W) + have hmod_deg' : Modifies (Finset.Ico wb (db + n)) x.mem y_deg.mem := + modifies_trans_subset hmod_cp hmod_deg (Finset.Ico_subset_Ico (le_refl _) (by omega)) + (Finset.Ico_subset_Ico (by omega) (le_refl _)) + have hs_c : workspaceFootprint wb db n n ⊆ Finset.Ico wb (db + n) := by + intro a ha + simp only [workspaceFootprint, Finset.mem_union, Finset.mem_Ico] at ha ⊢ + omega + -- The contraction runs `karger` on the copy, then `ampTrialPost` updates `bestVal`. + have hrun := ExecRandLaw.seq (contractDownToAt_law hr22 (le_refl 2) hn hW hst_deg) + (κ := fun G => PMF.pure (if i = 0 then totalDoubledWeight G.weight / 2 + else min (totalDoubledWeight G.weight / 2) (x.regs bestVal))) + fun y ⟨hmod_c, hy_hi, W', hW', hst'⟩ => by + have hz_db : y.regs dBase = db := hst'.regs_dBase + have hz_ti : y.regs trialIdx = i := (hy_hi trialIdx (by decide)).trans hy_deg_hi.2.2.2.2.1 + have hv : y.mem (wb + 1) = _ := hst'.mem_add_one hW' + obtain ⟨y_p, e_p, hm_p, hsb_p, hwb_p, hdb_p, hn_p, hml_p, hnt_p, hti_p, hbv_p⟩ := + ampTrialPost_exec hst'.regs_wBase hz_ti hiR h1 hwb1_fit hR_fit + have hmod : Modifies (Finset.Ico wb (db + n)) x.mem y_p.mem := by + rw [hm_p] + exact modifies_trans_subset hmod_deg' hmod_c Finset.Subset.rfl hs_c + refine (ExecRandLaw.of_execWithin (P := AmpInv w sb n R (i + 1) W mem₀) + (f := fun y => y.regs bestVal) e_p ⟨?_, hwb_p, hdb_p.trans hz_db, ?_, ?_, ?_, hti_p, + fun a b => ?_, modifies_trans_subset hinv.modifies_ws hmod Finset.Subset.rfl + Finset.Subset.rfl⟩).congr_law ?_ + · exact hsb_p.trans ((hy_hi srcBase (by decide)).trans hy_deg_hi.1) + · exact hn_p.trans ((hy_hi nOrig (by decide)).trans hy_deg_hi.2.1) + · exact hml_p.trans ((hy_hi matLen (by decide)).trans hy_deg_hi.2.2.1) + · exact hnt_p.trans ((hy_hi numTrials (by decide)).trans hy_deg_hi.2.2.2.1) + · have hlt := matAddr_lt_end (wb := sb) (le_refl n) a b + rw [hmod _ (by rw [Finset.mem_Ico]; omega)] + exact hinv.src_matrix a b + · rw [hbv_p, (hy_hi bestVal (by decide)).trans hy_deg_hi.2.2.2.2.2, hv] + have hbody_eq : ampTrialBody = .seq copyMatrixCode + (.seq ram[activeK ← nOrig] (.seq ram[stride ← nOrig] + (.seq ram[targetT ← #2] (.seq (computeDegreesAndTotalAt hr22) + (.seq (contractDownToAt hr22) ampTrialPost))))) := rfl + rw [hbody_eq] + refine ((ExecRandLaw.seq_det e_cp (ExecRandLaw.seq_det ec1.within + (ExecRandLaw.seq_det ec2.within (ExecRandLaw.seq_det ec3.within + (ExecRandLaw.seq_det e_deg hrun))))).congr_law ?_).mono (fun _ h => h) ?_ (by omega) + · rw [Lean.Karger.answerLaw_eq, PMF.map_comp] + exact PMF.bind_pure_comp _ _ + · have hnn : n * n = n ^ 2 := (sq n).symm + omega + +/-- **The loop of trials runs amplified Karger.** From `AmpInv` at trial `i`, with `rem = R - i` +trials left, `ampLoop` runs within `rem (50 n² + 12 n + 30) + 2` instructions and `rem (n - 2)` +`rand` calls and ends at trial `R`. Its `bestVal` has the law of the amplification client run +against independent runs of `Lean.Karger.karger` on `⟨n, W⟩`: of `Lean.Karger.minRuns rem` on the +first trial, and of `rem` more `Lean.Karger.minStep`s from `bestVal` after. -/ +theorem ampLoop_law {w sb n R : ℕ} {W : Fin n → Fin n → ℕ} {mem₀ : ℕ → ℕ} + (hR : 1 ≤ R) (hn : 2 ≤ n) (hW : IsMultigraph W) (h1 : Fits w 1) (hdEnd : Fits w (sb + 2 * (n * n) + n)) (hR_fit : Fits w R) (htot : Fits w (totalDoubledWeight W)) : - ∀ (rem i : ℕ) (x : Data 22), - i + rem = R → - AmpInv w sb n R i W mem₀ x → - ∃ m : ProbComp (Data 22 × ℕ), - ExecRand w ampLoop x m ∧ - m.IsQueryBounded (rem * (n - 2)) ∧ - (∀ z ∈ m.support, - z.2 ≤ rem * (50 * n ^ 2 + 12 * n + 30) + 2 ∧ - AmpInv w sb n R R W mem₀ z.1 ∧ - (0 < i → x.regs bestVal = minCut W → z.1.regs bestVal = minCut W)) ∧ - (0 < minCut W → - m.eval.toOuterMeasure {z | z.1.regs bestVal ≠ minCut W} ≤ - ((1 : ℝ≥0∞) - (2 : ℝ≥0∞) / ((n * (n - 1) : ℕ) : ℝ≥0∞)) ^ rem) := by + ∀ (rem i : ℕ) (x : Data 22), i + rem = R → AmpInv w sb n R i W mem₀ x → + ExecRandLaw w ampLoop x (AmpInv w sb n R R W mem₀) + (rem * (50 * n ^ 2 + 12 * n + 30) + 2) (rem * (n - 2)) (fun y => y.regs bestVal) + (OracleComp.evalWith (fun _ => Lean.Karger.answerLaw ⟨n, W⟩) + (if i = 0 then Lean.Karger.minRuns rem + else OracleComp.iterate rem Lean.Karger.minStep (x.regs bestVal))) := by intro rem induction rem with | zero => intro i x hiR hinv - have hi_eq : i = R := by omega - subst hi_eq + obtain rfl : i = R := by omega have hc : ¬(Cond.lt trialIdx numTrials).Holds x := by simp [Cond.holds_lt, hinv.regs_trialIdx, hinv.regs_numTrials] - refine ⟨pure (x, 2), .loop_exit hc, .pure _ _, ?_, ?_⟩ - · intro z hz - cases OracleComp.eq_of_mem_supportWith_pure hz - exact ⟨by simp, hinv, fun _ hbv => hbv⟩ - · intro _ - simp only [pow_zero] - exact Cslib.Probability.PMF.toOuterMeasure_le_one _ _ + rw [ite_eq_right (by omega)] + exact (ExecRandLaw.loop_exit hc hinv).mono (fun _ h => h) (by omega) (Nat.zero_le _) | succ rem ih => intro i x hiR hinv - have hi_lt : i < R := by omega have hc : (Cond.lt trialIdx numTrials).Holds x := by - simp [Cond.holds_lt, hinv.regs_trialIdx, hinv.regs_numTrials, hi_lt] - obtain ⟨m_b, hm_b, hq_b, hsup_b, hfail_b⟩ := - ampTrialBody_spec hn hW hi_lt h1 hdEnd hR_fit htot hinv - have hnext : ∀ z₁ ∈ m_b.support, - ∃ m_r : ProbComp (Data 22 × ℕ), - ExecRand w ampLoop z₁.1 m_r ∧ - m_r.IsQueryBounded (rem * (n - 2)) ∧ - (∀ z₂ ∈ m_r.support, - z₂.2 ≤ rem * (50 * n ^ 2 + 12 * n + 30) + 2 ∧ - AmpInv w sb n R R W mem₀ z₂.1 ∧ - (0 < i + 1 → z₁.1.regs bestVal = minCut W → z₂.1.regs bestVal = minCut W)) ∧ - (0 < minCut W → - m_r.eval.toOuterMeasure {z | z.1.regs bestVal ≠ minCut W} ≤ - ((1 : ℝ≥0∞) - (2 : ℝ≥0∞) / ((n * (n - 1) : ℕ) : ℝ≥0∞)) ^ rem) := by - intro z₁ hz₁ - exact ih (i + 1) z₁.1 (by omega) (hsup_b z₁ hz₁).2.1 - obtain ⟨ml, hml_def⟩ : - ∃ ml : Data 22 → ProbComp (Data 22 × ℕ), - ∀ d, ml d = codeComp w ampLoop d := ⟨_, fun _ => rfl⟩ - have hml_exec : ∀ z₁ ∈ m_b.support, ExecRand w ampLoop z₁.1 (ml z₁.1) := by - intro z₁ hz₁ - obtain ⟨m_r, hm_r, _⟩ := hnext z₁ hz₁ - rw [hml_def] - simpa only [hm_r.codeComp_eq] using hm_r - have hm_iter : ExecRand w ampLoop x - (do let z₁ ← m_b; let z₂ ← ml z₁.1; pure (z₂.1, z₁.2 + z₂.2 + 2)) := - ExecRand.loop_iter hc hm_b hml_exec - let m_total := (do let z₁ ← m_b; let z₂ ← ml z₁.1; pure (z₂.1, z₁.2 + z₂.2 + 2)) - refine ⟨m_total, hm_iter, ?_, ?_, ?_⟩ - · have hq_each : ∀ z₁ ∈ m_b.support, - (ml z₁.1 >>= fun z₂ => pure (z₂.1, z₁.2 + z₂.2 + 2)).IsQueryBounded - (rem * (n - 2)) := by - intro z₁ hz₁ - obtain ⟨m_r, hm_r, hq_r, _⟩ := hnext z₁ hz₁ - rw [hml_def, hm_r.codeComp_eq] - simpa only [Nat.add_zero] using hq_r.bind fun _ => .pure _ 0 - have hq_tot := OracleComp.IsCostBounded.bind_on_support hq_b hq_each - exact hq_tot.mono (by rw [Nat.succ_mul, Nat.add_comm]) - · intro z hz - obtain ⟨z₁, hz₁, hrest⟩ := OracleComp.mem_supportWith_bind_iff.mp hz - obtain ⟨m_r, hm_r, _, hsup_r, _⟩ := hnext z₁ hz₁ - rw [hml_def, hm_r.codeComp_eq] at hrest - obtain ⟨z₂, hz₂, hpure⟩ := OracleComp.mem_supportWith_bind_iff.mp hrest - cases OracleComp.eq_of_mem_supportWith_pure hpure - rcases hsup_b z₁ hz₁ with ⟨ht₁, _, hstick₁⟩ - rcases hsup_r z₂ hz₂ with ⟨ht₂, hinv₂, hstick₂⟩ - refine ⟨?_, hinv₂, ?_⟩ - · rw [Nat.succ_mul] - omega - · intro hi_pos hbv_x - exact hstick₂ (Nat.succ_pos i) (hstick₁ hi_pos hbv_x) - · intro hmin_pos - have hm_eval : m_total.eval = - m_b.eval.bind fun z₁ => - ((ml z₁.1).eval.map fun z₂ => (z₂.1, z₁.2 + z₂.2 + 2)) := by - dsimp only [m_total] - rw [ProbComp.eval_bind] - refine congrArg (m_b.eval.bind ·) (funext fun z₁ => ?_) - rw [bind_pure_comp, ProbComp.eval_map] - rw [hm_eval, pow_succ'] - refine toOuterMeasure_bind_le_mul_ennreal m_b.eval - (fun z₁ => (ml z₁.1).eval.map fun z₂ => (z₂.1, z₁.2 + z₂.2 + 2)) - {z₁ | z₁.1.regs bestVal ≠ minCut W} - {z | z.1.regs bestVal ≠ minCut W} - (q₁ := (1 : ℝ≥0∞) - (2 : ℝ≥0∞) / ((n * (n - 1) : ℕ) : ℝ≥0∞)) - (q₂ := ((1 : ℝ≥0∞) - (2 : ℝ≥0∞) / ((n * (n - 1) : ℕ) : ℝ≥0∞)) ^ rem) - (hfail_b hmin_pos) ?_ ?_ - · intro z₁ hz₁_eval _ - have hz₁ : z₁ ∈ m_b.support := (ProbComp.support_eval m_b) ▸ hz₁_eval - obtain ⟨m_r, hm_r, _, _, hfail_r⟩ := hnext z₁ hz₁ - rw [hml_def, hm_r.codeComp_eq, PMF.toOuterMeasure_map_apply] - exact hfail_r hmin_pos - · intro z₁ hz₁_eval hhit - have hz₁ : z₁ ∈ m_b.support := (ProbComp.support_eval m_b) ▸ hz₁_eval - have hbv₁ : z₁.1.regs bestVal = minCut W := not_not.mp hhit - obtain ⟨m_r, hm_r, _, hsup_r, _⟩ := hnext z₁ hz₁ - rw [hml_def, hm_r.codeComp_eq, PMF.toOuterMeasure_map_apply, - PMF.toOuterMeasure_apply] - refine tsum_eq_zero_iff.mpr ?_ - intro z₂ - by_cases hz₂_eval : z₂ ∈ m_r.eval.support - · have hz₂ : z₂ ∈ m_r.support := (ProbComp.support_eval m_r) ▸ hz₂_eval - have hbv₂ : z₂.1.regs bestVal = minCut W := - (hsup_r z₂ hz₂).2.2 (Nat.succ_pos i) hbv₁ - have hnot : z₂ ∉ ((fun z : Data 22 × ℕ => (z.1, z₁.2 + z.2 + 2)) ⁻¹' - {z : Data 22 × ℕ | z.1.regs bestVal ≠ minCut W}) := by - simp [hbv₂] - exact Set.indicator_of_notMem hnot _ - · have hp0 : m_r.eval z₂ = 0 := by simpa only [PMF.mem_support_iff, not_not] using hz₂_eval - simp [hp0] - -/-- Specification of `ampCore` for `1 ≤ R` trials from any state with `srcBase = sb`, -`nOrig = n`, `numTrials = R`, and `HoldsMatrix x.mem sb n W`. -/ -theorem ampCore_spec {w sb n R : ℕ} {W : Fin n → Fin n → ℕ} {x : Data 22} + simp [Cond.holds_lt, hinv.regs_trialIdx, hinv.regs_numTrials] + omega + refine ((ExecRandLaw.loop_iter hc (ampTrialBody_law hn hW (by omega) h1 hdEnd hR_fit htot hinv) + (κ := fun b => OracleComp.evalWith (fun _ => Lean.Karger.answerLaw ⟨n, W⟩) + (OracleComp.iterate rem Lean.Karger.minStep b)) fun y hy => by + have h := ih (i + 1) y (by omega) hy + rw [ite_eq_right (Nat.succ_ne_zero i)] at h + exact h).congr_law ?_).mono (fun _ h => h) (by rw [add_one_mul]; omega) + (by rw [add_one_mul]; omega) + by_cases hi : i = 0 + · simp [hi, Lean.Karger.minRuns, Function.comp_def] + · simp [hi, OracleComp.iterate_succ_bind, Lean.Karger.minStep, Function.comp_def] + +/-- **The amplification core runs amplified Karger.** For `1 ≤ R` trials, from a state with +`srcBase = sb`, `nOrig = n`, `numTrials = R` and `HoldsMatrix x.mem sb n W`, `ampCore` runs within +`R (50 n² + 12 n + 30) + 8` instructions and `R (n - 2)` `rand` calls and writes only the +workspace. Its `bestVal` has the law of `Lean.Karger.minRuns R` against independent runs of +`Lean.Karger.karger` on `⟨n, W⟩`. -/ +theorem ampCore_law {w sb n R : ℕ} {W : Fin n → Fin n → ℕ} {x : Data 22} (hR : 1 ≤ R) (hn : 2 ≤ n) (hW : IsMultigraph W) (hsb : x.regs srcBase = sb) (hnOrig : x.regs nOrig = n) (hnumT : x.regs numTrials = R) (h1 : Fits w 1) (hdEnd : Fits w (sb + 2 * (n * n) + n)) (hR_fit : Fits w R) (htot : Fits w (totalDoubledWeight W)) (hsrc_mat : HoldsMatrix x.mem sb n W) : - ∃ m : ProbComp (Data 22 × ℕ), - ExecRand w ampCore x m ∧ - m.IsQueryBounded (R * (n - 2)) ∧ - (∀ z ∈ m.support, - z.2 ≤ R * (50 * n ^ 2 + 12 * n + 30) + 8 ∧ - Modifies (Finset.Ico (sb + n * n) (sb + 2 * (n * n) + n)) x.mem z.1.mem ∧ - ∃ C : Finset (Fin n), IsNonTrivialCut C ∧ z.1.regs bestVal = cutWeight W C) ∧ - (0 < minCut W → - m.eval.toOuterMeasure {z | z.1.regs bestVal ≠ minCut W} ≤ - ((1 : ℝ≥0∞) - (2 : ℝ≥0∞) / ((n * (n - 1) : ℕ) : ℝ≥0∞)) ^ R) := by + ExecRandLaw w ampCore x + (fun y => Modifies (Finset.Ico (sb + n * n) (sb + 2 * (n * n) + n)) x.mem y.mem) + (R * (50 * n ^ 2 + 12 * n + 30) + 8) (R * (n - 2)) (fun y => y.regs bestVal) + (OracleComp.evalWith (fun _ => Lean.Karger.answerLaw ⟨n, W⟩) (Lean.Karger.minRuns R)) := by have hnn_fit : Fits w (n * n) := hdEnd.of_le (by omega) have hwb_fit : Fits w (sb + n * n) := hdEnd.of_le (by omega) have hdb_fit : Fits w (sb + 2 * (n * n)) := hdEnd.of_le (by omega) @@ -1246,7 +987,7 @@ theorem ampCore_spec {w sb n R : ℕ} {W : Fin n → Fin n → ℕ} {x : Data 22 have e5 : Exec (B := .standard) w ram[trialIdx ← #0] s₄ s₅ 1 := Exec.const (fits_zero w) have e6 : Exec (B := .standard) w ram[bestVal ← #0] s₅ s₆ 1 := Exec.const (fits_zero w) have hinv₀ : AmpInv w sb n R 0 W x.mem s₆ := by - refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, hsrc_mat, Modifies.refl _ _, fun h0 => absurd h0 (by omega)⟩ + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, hsrc_mat, Modifies.refl _ _⟩ · simpa +decide [s₆, s₅, s₄, s₃, s₂, s₁, Function.update_apply] using hsb · simp +decide [s₆, s₅, s₄, s₃] · simp +decide [s₆, s₅, s₄] @@ -1254,25 +995,17 @@ theorem ampCore_spec {w sb n R : ℕ} {W : Fin n → Fin n → ℕ} {x : Data 22 · simp +decide [s₆, s₅, s₄, s₃, s₂] · simpa +decide [s₆, s₅, s₄, s₃, s₂, s₁, Function.update_apply] using hnumT · simp +decide [s₆, s₅] - obtain ⟨m_l, hm_l, hq_l, hsup_l, hfail_l⟩ := - ampLoop_spec (mem₀ := x.mem) hn hW h1 hdEnd hR_fit htot R 0 s₆ (Nat.zero_add R) hinv₀ + have hloop := ampLoop_law (mem₀ := x.mem) hR hn hW h1 hdEnd hR_fit htot R 0 s₆ + (Nat.zero_add R) hinv₀ + rw [ite_eq_left rfl] at hloop have hcore_eq : ampCore = .seq ram[val1 ← nOrig * nOrig] (.seq ram[matLen ← val1] (.seq ram[wBase ← srcBase + matLen] (.seq ram[dBase ← wBase + matLen] (.seq ram[trialIdx ← #0] (.seq ram[bestVal ← #0] ampLoop))))) := rfl rw [hcore_eq] - have hm_full := e1.seqRand (e2.seqRand (e3.seqRand (e4.seqRand (e5.seqRand (e6.seqRand hm_l))))) - refine ⟨_, hm_full, ?_, ?_, ?_⟩ - · simp only [Functor.map_map, OracleComp.IsQueryBounded, OracleComp.isCostBounded_map_iff] - exact hq_l - · intro z hz - simp only [Functor.map_map] at hz - obtain ⟨z₀, hz₀, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hz - rcases hsup_l z₀ hz₀ with ⟨ht₀, hinv_f, _⟩ - exact ⟨by omega, hinv_f.modifies_ws, hinv_f.best_cut hR⟩ - · intro hmin_pos - simp only [Functor.map_map, ProbComp.eval_map, PMF.toOuterMeasure_map_apply] - exact hfail_l hmin_pos + exact (ExecRandLaw.seq_det e1.within (ExecRandLaw.seq_det e2.within + (ExecRandLaw.seq_det e3.within (ExecRandLaw.seq_det e4.within (ExecRandLaw.seq_det e5.within + (ExecRandLaw.seq_det e6.within hloop)))))).mono (fun _ h => h.modifies_ws) (by omega) le_rfl end AmplificationEngine @@ -1337,37 +1070,24 @@ theorem amplifiedSetup_exec {w R n : ℕ} {W : Fin n → Fin n → ℕ} exact ⟨s₅, e1.seq (e2.seq (e3.seq (e4.seq e5))), rfl, by simp [s₅], by simp +decide [s₅, s₄], by simp +decide [s₅, s₄, s₃, s₂]⟩ -/-- Structured `ProbComp` specification of `amplifiedCode`. -/ -theorem amplifiedCode_spec {R n w : ℕ} {W : Fin n → Fin n → ℕ} +/-- **`amplifiedCode` runs amplified Karger.** At word size `w ≥ logWidth 3 n` with `1 ≤ R`, +`R < 2 ^ w` and `totalDoubledWeight W < 2 ^ w`, `amplifiedCode` on `R :: n :: flattenMatrix W` runs +within `amplifiedTime R n - 1` instructions and `R (n - 2)` `rand` calls and writes only +`[3 + n * n, 3 + 2 * (n * n) + n)`. Its `bestVal` has the law of `Lean.Karger.minRuns R` against +independent runs of `Lean.Karger.karger` on `⟨n, W⟩`. -/ +theorem amplifiedCode_law {R n w : ℕ} {W : Fin n → Fin n → ℕ} (hR : 1 ≤ R) (hn : 2 ≤ n) (hW : IsMultigraph W) (hw : logWidth 3 n ≤ w) (hR_fit : Fits w R) (htot : Fits w (totalDoubledWeight W)) : - ∃ m : ProbComp (Data 22 × ℕ), - ExecRand w amplifiedCode (Data.init (R :: n :: flattenMatrix W)) m ∧ - m.IsQueryBounded (R * (n - 2)) ∧ - (∀ z ∈ m.support, - z.2 + 1 ≤ amplifiedTime R n ∧ - Modifies (Finset.Ico (3 + n * n) (3 + 2 * (n * n) + n)) - (Data.init (r := 22) (R :: n :: flattenMatrix W)).mem z.1.mem ∧ - ∃ C : Finset (Fin n), IsNonTrivialCut C ∧ z.1.regs bestVal = cutWeight W C) ∧ - (0 < minCut W → - m.eval.toOuterMeasure {z | z.1.regs bestVal ≠ minCut W} ≤ - ((1 : ℝ≥0∞) - (2 : ℝ≥0∞) / ((n * (n - 1) : ℕ) : ℝ≥0∞)) ^ R) := by + ExecRandLaw w amplifiedCode (Data.init (R :: n :: flattenMatrix W)) + (fun y => Modifies (Finset.Ico (3 + n * n) (3 + 2 * (n * n) + n)) + (Data.init (r := 22) (R :: n :: flattenMatrix W)).mem y.mem) + (R * (50 * n ^ 2 + 12 * n + 30) + 15) (R * (n - 2)) (fun y => y.regs bestVal) + (OracleComp.evalWith (fun _ => Lean.Karger.answerLaw ⟨n, W⟩) (Lean.Karger.minRuns R)) := by have hws := fits_workspace_of_logWidth_three hn hw - have h1 : Fits w 1 := hws.of_le (by omega) obtain ⟨y_s, e_s, hm_s, hsb_s, hn_s, hnt_s⟩ := amplifiedSetup_exec (R := R) (W := W) hn hw - obtain ⟨m_c, hm_c, hq_c, hsup_c, hfail_c⟩ := - ampCore_spec hR hn hW hsb_s hn_s hnt_s h1 hws hR_fit htot - (hm_s ▸ holdsMatrix_init_amplified W) - refine ⟨_, e_s.seqRand hm_c, ?_, ?_, ?_⟩ - · simp only [OracleComp.IsQueryBounded, OracleComp.isCostBounded_map_iff] - exact hq_c - · intro z hz - obtain ⟨z₀, hz₀, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hz - rcases hsup_c z₀ hz₀ with ⟨ht₀, hmod₀, hcut₀⟩ - exact ⟨by simp only [amplifiedTime]; omega, hm_s ▸ hmod₀, hcut₀⟩ - · intro hmin_pos - rw [ProbComp.eval_map, PMF.toOuterMeasure_map_apply] - exact hfail_c hmin_pos + exact (ExecRandLaw.seq_det e_s.within (ampCore_law hR hn hW hsb_s hn_s hnt_s + (hws.of_le (by omega)) hws hR_fit htot (hm_s ▸ holdsMatrix_init_amplified W))).mono + (fun _ h => hm_s ▸ h) (by omega) le_rfl /-- **`R`-trial amplified Karger specification (`amplifiedProgram`).** At word size `w ≥ logWidth 3 n` when `1 ≤ R`, `R < 2 ^ w`, and `totalDoubledWeight W < 2 ^ w`: @@ -1397,29 +1117,14 @@ theorem amplifiedProgram_spec {R n w : ℕ} {W : Fin n → Fin n → ℕ} {cfg | ∀ y, cfg ≠ .halted (minCut W) y} ≤ ((1 : ℝ≥0∞) - (2 : ℝ≥0∞) / ((n * (n - 1) : ℕ) : ℝ≥0∞)) ^ R) := by intro input - have hfit_in : InputFits w input := inputFits_amplified hn hw hR_fit htot - obtain ⟨m, hm, hq, hsup, hfail⟩ := amplifiedCode_spec hR hn hW hw hR_fit htot - have hrun : runRand w amplifiedProgram (amplifiedTime R n) (.running (.init input)) = - (fun z : Data 22 × ℕ => RandCfg.halted (z.1.regs bestVal) z.1) <$> m := - hm.runRand_program bestVal fun z hz => (hsup z hz).1 - refine ⟨?_, ?_, ?_, ?_⟩ - · intro cfg hcfg - rw [hrun] at hcfg - obtain ⟨z, -, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hcfg - exact ⟨z.1.regs bestVal, z.1, rfl⟩ - · rw [RandCallsBounded, hrun] - exact (OracleComp.isCostBounded_map_iff _ _ _).mpr hq - · intro cfg hcfg - have hbnd := runRand_bounded_init hfit_in hcfg - rw [hrun] at hcfg - obtain ⟨z, hz, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hcfg - rcases hsup z hz with ⟨_, hmod, C, hC_nt, hbv⟩ - exact ⟨z.1, C, by rw [hbv], hbnd.2, hC_nt, minCut_le_cutWeight W hC_nt, hmod⟩ - · intro hmin_pos - rw [evalRand, hrun, ProbComp.eval_map, PMF.toOuterMeasure_map_apply] - refine (PMF.toOuterMeasure_mono _ ?_).trans (hfail hmin_pos) - intro z hz heq - exact hz.1 z.1 (congrArg (fun v => RandCfg.halted v z.1) heq) + obtain ⟨hhalt, hcalls, hpost, -, hmiss⟩ := + program_of_law (T' := amplifiedTime R n) (amplifiedCode_law hR hn hW hw hR_fit htot) + (by unfold amplifiedTime; omega) + (inputFits_amplified hn hw hR_fit htot) + fun _ hv => Lean.Karger.exists_cut_of_mem_support_answerLaw hn hW + (Lean.Karger.mem_support_minRuns (by omega) hv) + exact ⟨hhalt, hcalls, hpost, fun hmin => + hmiss.trans (Lean.Karger.minRuns_ne_minCut_le hn hW hmin R)⟩ end Amplified @@ -1624,9 +1329,10 @@ theorem highProbSetup_exec {w n : ℕ} {W : Fin n → Fin n → ℕ} (e_loop.seq ((p1.within).seq ((p2.within).seq ((p3.within).seq ((p4.within).seq ((p5.within).seq ((p6.within).seq p7.within))))))))))).mono (by omega) -private theorem highProbTime_bound {n : ℕ} (hn : 2 ≤ n) : - (4 * Nat.log 2 n + 13) + (highProbTrials n * (50 * n ^ 2 + 12 * n + 30) + 8) + 1 ≤ - highProbTime n := by +/-- The setup's `4 log₂ n + 13` instructions, the `highProbTrials n` trials' +`highProbTrials n (50 n² + 12 n + 30) + 8` and the final halt fit in `highProbTime n`. -/ +theorem highProbTime_bound {n : ℕ} (hn : 2 ≤ n) : + 4 * Nat.log 2 n + highProbTrials n * (50 * n ^ 2 + 12 * n + 30) + 22 ≤ highProbTime n := by unfold highProbTime highProbTrials obtain ⟨d, rfl⟩ : ∃ d, n = d + 2 := ⟨n - 2, by omega⟩ have h1 : 50 * (d + 2) ^ 2 + 12 * (d + 2) + 30 ≤ 64 * (d + 2) ^ 2 := by nlinarith @@ -1650,9 +1356,9 @@ private theorem highProbTime_bound {n : ℕ} (hn : 2 ≤ n) : have hpow4 : 16 ≤ (d + 2) ^ 4 := by nlinarith nlinarith calc - (4 * Nat.log 2 (d + 2) + 13) + - (((d + 2) * (d + 2 - 1) / 2 * (Nat.log 2 (d + 2) + 2)) * - (50 * (d + 2) ^ 2 + 12 * (d + 2) + 30) + 8) + 1 + 4 * Nat.log 2 (d + 2) + + ((d + 2) * (d + 2 - 1) / 2 * (Nat.log 2 (d + 2) + 2)) * + (50 * (d + 2) ^ 2 + 12 * (d + 2) + 30) + 22 = (4 * Nat.log 2 (d + 2) + 22) + (((d + 2) * (d + 2 - 1) / 2 * (Nat.log 2 (d + 2) + 2)) * (50 * (d + 2) ^ 2 + 12 * (d + 2) + 30)) := by ring @@ -1660,41 +1366,27 @@ private theorem highProbTime_bound {n : ℕ} (hn : 2 ≤ n) : 32 * (d + 2) ^ 4 * (Nat.log 2 (d + 2) + 2) := Nat.add_le_add hoverhead htrial _ = 33 * (d + 2) ^ 4 * (Nat.log 2 (d + 2) + 2) := by ring -/-- Structured `ProbComp` specification of `highProbCode`. -/ -theorem highProbCode_spec {n w : ℕ} {W : Fin n → Fin n → ℕ} +/-- **`highProbCode` runs amplified Karger.** At word size `w ≥ logWidth 3 n` with +`totalDoubledWeight W < 2 ^ w`, `highProbCode` on `n :: flattenMatrix W` runs within +`4 log₂ n + highProbTrials n (50 n² + 12 n + 30) + 21` instructions and +`highProbTrials n (n - 2)` `rand` calls and writes only `[2 + n * n, 2 + 2 * (n * n) + n)`. Its +`bestVal` has the law of `Lean.Karger.minRuns (highProbTrials n)` against independent runs of +`Lean.Karger.karger` on `⟨n, W⟩`. -/ +theorem highProbCode_law {n w : ℕ} {W : Fin n → Fin n → ℕ} (hn : 2 ≤ n) (hW : IsMultigraph W) (hw : logWidth 3 n ≤ w) (htot : Fits w (totalDoubledWeight W)) : - ∃ m : ProbComp (Data 22 × ℕ), - ExecRand w highProbCode (Data.init (n :: flattenMatrix W)) m ∧ - m.IsQueryBounded (highProbTrials n * (n - 2)) ∧ - (∀ z ∈ m.support, - z.2 + 1 ≤ highProbTime n ∧ - Modifies (Finset.Ico (2 + n * n) (2 + 2 * (n * n) + n)) - (Data.init (r := 22) (n :: flattenMatrix W)).mem z.1.mem ∧ - ∃ C : Finset (Fin n), IsNonTrivialCut C ∧ z.1.regs bestVal = cutWeight W C) ∧ - (0 < minCut W → - m.eval.toOuterMeasure {z | z.1.regs bestVal ≠ minCut W} ≤ - (1 : ℝ≥0∞) / ((2 * n : ℕ) : ℝ≥0∞)) := by + ExecRandLaw w highProbCode (Data.init (n :: flattenMatrix W)) + (fun y => Modifies (Finset.Ico (2 + n * n) (2 + 2 * (n * n) + n)) + (Data.init (r := 22) (n :: flattenMatrix W)).mem y.mem) + (4 * Nat.log 2 n + highProbTrials n * (50 * n ^ 2 + 12 * n + 30) + 21) + (highProbTrials n * (n - 2)) (fun y => y.regs bestVal) + (OracleComp.evalWith (fun _ => Lean.Karger.answerLaw ⟨n, W⟩) + (Lean.Karger.minRuns (highProbTrials n))) := by have hws := fits_workspace_of_logWidth_three hn hw - have h1 : Fits w 1 := hws.of_le (by omega) - have hdEnd : Fits w (2 + 2 * (n * n) + n) := hws.of_le (by omega) - have hhp_fit := fits_highProbTrials_of_logWidth_three hn hw - obtain ⟨y_s, ⟨n_s, hn_s, e_s⟩, hm_s, hsb_s, hn_s_r, hnt_s⟩ := - highProbSetup_exec (W := W) hn hw - obtain ⟨m_c, hm_c, hq_c, hsup_c, hfail_c⟩ := - ampCore_spec (highProbTrials_pos hn) hn hW hsb_s hn_s_r hnt_s h1 hdEnd hhp_fit htot - (hm_s ▸ holdsMatrix_init_single W) - have hbound := highProbTime_bound hn - refine ⟨_, e_s.seqRand hm_c, ?_, ?_, ?_⟩ - · simp only [OracleComp.IsQueryBounded, OracleComp.isCostBounded_map_iff] - exact hq_c - · intro z hz - obtain ⟨z₀, hz₀, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hz - rcases hsup_c z₀ hz₀ with ⟨ht₀, hmod₀, hcut₀⟩ - exact ⟨by omega, hm_s ▸ hmod₀, hcut₀⟩ - · intro hmin_pos - rw [ProbComp.eval_map, PMF.toOuterMeasure_map_apply] - exact (hfail_c hmin_pos).trans (highProb_failure_le hn) + obtain ⟨y_s, e_s, hm_s, hsb_s, hn_s, hnt_s⟩ := highProbSetup_exec (W := W) hn hw + exact (ExecRandLaw.seq_det e_s (ampCore_law (highProbTrials_pos hn) hn hW hsb_s hn_s hnt_s + (hws.of_le (by omega)) (hws.of_le (by omega)) (fits_highProbTrials_of_logWidth_three hn hw) + htot (hm_s ▸ holdsMatrix_init_single W))).mono (fun _ h => hm_s ▸ h) (by omega) le_rfl /-- **Explicit `O(n ^ 4 log n)` high-probability global minimum cut (`highProbProgram`).** At word size `w ≥ logWidth 3 n` when `2 ≤ n` and `totalDoubledWeight W < 2 ^ w`: @@ -1724,29 +1416,13 @@ theorem highProbProgram_spec {n w : ℕ} {W : Fin n → Fin n → ℕ} {cfg | ∀ y, cfg ≠ .halted (minCut W) y} ≤ (1 : ℝ≥0∞) / ((2 * n : ℕ) : ℝ≥0∞)) := by intro input - have hfit_in : InputFits w input := inputFits_single hn hw htot - obtain ⟨m, hm, hq, hsup, hfail⟩ := highProbCode_spec hn hW hw htot - have hrun : runRand w highProbProgram (highProbTime n) (.running (.init input)) = - (fun z : Data 22 × ℕ => RandCfg.halted (z.1.regs bestVal) z.1) <$> m := - hm.runRand_program bestVal fun z hz => (hsup z hz).1 - refine ⟨?_, ?_, ?_, ?_⟩ - · intro cfg hcfg - rw [hrun] at hcfg - obtain ⟨z, -, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hcfg - exact ⟨z.1.regs bestVal, z.1, rfl⟩ - · rw [RandCallsBounded, hrun] - exact (OracleComp.isCostBounded_map_iff _ _ _).mpr hq - · intro cfg hcfg - have hbnd := runRand_bounded_init hfit_in hcfg - rw [hrun] at hcfg - obtain ⟨z, hz, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hcfg - rcases hsup z hz with ⟨_, hmod, C, hC_nt, hbv⟩ - exact ⟨z.1, C, by rw [hbv], hbnd.2, hC_nt, minCut_le_cutWeight W hC_nt, hmod⟩ - · intro hmin_pos - rw [evalRand, hrun, ProbComp.eval_map, PMF.toOuterMeasure_map_apply] - refine (PMF.toOuterMeasure_mono _ ?_).trans (hfail hmin_pos) - intro z hz heq - exact hz.1 z.1 (congrArg (fun v => RandCfg.halted v z.1) heq) + obtain ⟨hhalt, hcalls, hpost, -, hmiss⟩ := + program_of_law (highProbCode_law hn hW hw htot) (highProbTime_bound hn) + (inputFits_single hn hw htot) fun _ hv => + Lean.Karger.exists_cut_of_mem_support_answerLaw hn hW + (Lean.Karger.mem_support_minRuns (Nat.one_le_iff_ne_zero.mp (highProbTrials_pos hn)) hv) + exact ⟨hhalt, hcalls, hpost, fun hmin => + (hmiss.trans (Lean.Karger.minRuns_ne_minCut_le hn hW hmin _)).trans (highProb_failure_le hn)⟩ /-- Corollary of `highProbProgram_spec`: when `0 < minCut W`, `highProbProgram` misses `minCut W` with probability at most `1 / n`. -/ diff --git a/Complexity/Computability/WordRAM/Randomized/Law.lean b/Complexity/Computability/WordRAM/Randomized/Law.lean index da5b674dff..140259bc45 100644 --- a/Complexity/Computability/WordRAM/Randomized/Law.lean +++ b/Complexity/Computability/WordRAM/Randomized/Law.lean @@ -42,6 +42,7 @@ with `f` (`Cslib.WordRAM.ExecRandLaw.program`). * `Cslib.WordRAM.ExecRandLaw.seq`, `Cslib.WordRAM.ExecRandLaw.branch_pos`, `Cslib.WordRAM.ExecRandLaw.branch_neg`, `Cslib.WordRAM.ExecRandLaw.loop_exit`, `Cslib.WordRAM.ExecRandLaw.loop_iter`: composition rules. +* `Cslib.WordRAM.ExecRandLaw.rename`: renaming registers. * `Cslib.WordRAM.ExecRandLaw.execRandWithin`: forgetting the law. * `Cslib.WordRAM.ExecRandLaw.program`: the compiled program halts within the bound, respects the call budget and the postcondition, and has the law `μ`. @@ -88,6 +89,18 @@ theorem withPreserves {i : Fin r} (h : ExecRandLaw w c x P T R f μ) (hi : c.Pre obtain ⟨m, hm, hq, hsup, hlaw⟩ := h exact ⟨m, hm, hq, fun z hz => ⟨⟨(hsup z hz).1, hm.regs_eq hi hz⟩, (hsup z hz).2⟩, hlaw⟩ +/-- Renaming along an injective register map `ρ`: the renamed code observes the registers that `ρ` +chooses and keeps the others. -/ +theorem rename {r' : ℕ} {ρ : Fin r → Fin r'} (hρ : ρ.Injective) {x' : Data r'} + (h : ExecRandLaw w c (x'.comap ρ) P T R f μ) : + ExecRandLaw w (c.rename ρ) x' (fun y' => ∃ y, P y ∧ y' = y.extend ρ x') T R + (fun y' => f (y'.comap ρ)) μ := by + obtain ⟨m, hm, hq, hsup, hlaw⟩ := h + refine ⟨_, hm.rename hρ, (OracleComp.isCostBounded_map_iff _ _ _).mpr hq, fun z hz => ?_, ?_⟩ + · obtain ⟨z₀, hz₀, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hz + exact ⟨⟨z₀.1, (hsup z₀ hz₀).1, rfl⟩, (hsup z₀ hz₀).2⟩ + · simpa only [Functor.map_map, Data.comap_extend hρ] using hlaw + /-- Deterministic code reaching `y` has the point law at the observation of `y`. -/ theorem of_execWithin {y : Data r} (h : ExecWithin w c x y T) (hy : P y) : ExecRandLaw w c x P T 0 f (PMF.pure (f y)) := by diff --git a/abstracts/ComplexityAbstracts/KargerMinCutBridge.lean b/abstracts/ComplexityAbstracts/KargerMinCutBridge.lean index 68a967dcf9..1c9e8d3c8e 100644 --- a/abstracts/ComplexityAbstracts/KargerMinCutBridge.lean +++ b/abstracts/ComplexityAbstracts/KargerMinCutBridge.lean @@ -929,20 +929,20 @@ private theorem ampLoop_exact {w sb n R : ℕ} {W : Fin n → Fin n → ℕ} {me have hc : (Cond.lt trialIdx numTrials).Holds x := by simp [Cond.holds_lt, hinv.regs_trialIdx, hinv.regs_numTrials, hiR] obtain ⟨m_b, hm_b, _, hsup_b, _⟩ := - ampTrialBody_spec hn hW hiR h1 hdEnd hR_fit htot hinv + ampTrialBody_law hn hW hiR h1 hdEnd hR_fit htot hinv have hm_b_ex := ampTrialBody_toExact hn hW hiR h1 hdEnd hR_fit htot hinv hm_b let ml (d : Data 22) := codeComp (B := .standard) w ampLoop d refine ⟨_, ExecRand.loop_iter hc hm_b (ml := ml) ?_, ExecRand.loop_iter hc hm_b_ex (ml := ml) ?_⟩ · intro z hz obtain ⟨m_r, hm_r⟩ := ampLoop_exact hn hW h1 hdEnd hR_fit htot r (i + 1) z.1 - (by omega) (hsup_b z hz).2.1 + (by omega) (hsup_b z hz).1 dsimp only [ml] rw [hm_r.1.codeComp_eq] exact hm_r.1 · intro z hz obtain ⟨m_r, hm_r⟩ := ampLoop_exact hn hW h1 hdEnd hR_fit htot r (i + 1) z.1 - (by omega) (hsup_b z hz).2.1 + (by omega) (hsup_b z hz).1 dsimp only [ml] rw [hm_r.1.codeComp_eq] exact hm_r.2 @@ -987,7 +987,7 @@ private theorem ampCore_exact {w sb n R : ℕ} {W : Fin n → Fin n → ℕ} {x have e5 : Exec (B := .standard) w ram[trialIdx ← #0] s₄ s₅ 1 := Exec.const (fits_zero w) have e6 : Exec (B := .standard) w ram[bestVal ← #0] s₅ s₆ 1 := Exec.const (fits_zero w) have hinv₀ : AmpInv w sb n R 0 W x.mem s₆ := by - refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, hsrc_mat, Modifies.refl _ _, fun h0 => absurd h0 (by omega)⟩ + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, hsrc_mat, Modifies.refl _ _⟩ · exact (set_regs_ne _ _ _ _ (by decide)).trans ((set_regs_ne _ _ _ _ (by decide)).trans ((set_regs_ne _ _ _ _ (by decide)).trans ((set_regs_ne _ _ _ _ (by decide)).trans ((set_regs_ne _ _ _ _ (by decide)).trans ((set_regs_ne _ _ _ _ (by decide)).trans hsb))))) @@ -2257,10 +2257,11 @@ private theorem singleExactProgram_runRand_eq {n w : ℕ} {W : Fin n → Fin n (.running (.init (n :: flattenMatrix W))) = Cslib.WordRAM.runRand w singleProgram (singleTime n) (.running (.init (n :: flattenMatrix W))) := by - obtain ⟨m, hm_std, _, hsup, _⟩ := singleCode_spec hn hW hw htot + obtain ⟨m, hm_std, _, hsup, _⟩ := singleCode_law hn hW hw htot have hm_ex := singleCode_toExact hn hW hw htot hm_std - exact (hm_ex.runRand_program Reg.val1 fun z hz => (hsup z hz).1).trans - (hm_std.runRand_program Reg.val1 fun z hz => (hsup z hz).1).symm + have hT : ∀ z ∈ m.support, z.2 + 1 ≤ singleTime n := fun z hz => + Nat.add_le_add_right (hsup z hz).2 1 + exact (hm_ex.runRand_program Reg.val1 hT).trans (hm_std.runRand_program Reg.val1 hT).symm private theorem amplifiedExactProgram_runRand_eq {R n w : ℕ} {W : Fin n → Fin n → ℕ} (hR : 1 ≤ R) (hn : 2 ≤ n) (hW : IsMultigraph W) (hw : logWidth 3 n ≤ w) @@ -2269,10 +2270,12 @@ private theorem amplifiedExactProgram_runRand_eq {R n w : ℕ} {W : Fin n → Fi (.running (.init (R :: n :: flattenMatrix W))) = Cslib.WordRAM.runRand w amplifiedProgram (amplifiedTime R n) (.running (.init (R :: n :: flattenMatrix W))) := by - obtain ⟨m, hm_std, _, hsup, _⟩ := amplifiedCode_spec hR hn hW hw hR_fit htot + obtain ⟨m, hm_std, _, hsup, _⟩ := amplifiedCode_law hR hn hW hw hR_fit htot have hm_ex := amplifiedCode_toExact hn hW hw hR_fit htot hm_std - exact (hm_ex.runRand_program AmpReg.bestVal fun z hz => (hsup z hz).1).trans - (hm_std.runRand_program AmpReg.bestVal fun z hz => (hsup z hz).1).symm + have hT : ∀ z ∈ m.support, z.2 + 1 ≤ amplifiedTime R n := fun z hz => + Nat.add_le_add_right (hsup z hz).2 1 + exact (hm_ex.runRand_program AmpReg.bestVal hT).trans + (hm_std.runRand_program AmpReg.bestVal hT).symm private theorem highProbExactProgram_runRand_eq {n w : ℕ} {W : Fin n → Fin n → ℕ} (hn : 2 ≤ n) (hW : IsMultigraph W) (hw : logWidth 3 n ≤ w) @@ -2281,10 +2284,12 @@ private theorem highProbExactProgram_runRand_eq {n w : ℕ} {W : Fin n → Fin n (.running (.init (n :: flattenMatrix W))) = Cslib.WordRAM.runRand w highProbProgram (highProbTime n) (.running (.init (n :: flattenMatrix W))) := by - obtain ⟨m, hm_std, _, hsup, _⟩ := highProbCode_spec hn hW hw htot + obtain ⟨m, hm_std, _, hsup, _⟩ := highProbCode_law hn hW hw htot have hm_ex := highProbCode_toExact hn hW hw htot hm_std - exact (hm_ex.runRand_program AmpReg.bestVal fun z hz => (hsup z hz).1).trans - (hm_std.runRand_program AmpReg.bestVal fun z hz => (hsup z hz).1).symm + have hT : ∀ z ∈ m.support, z.2 + 1 ≤ highProbTime n := fun z hz => + (Nat.add_le_add_right (hsup z hz).2 1).trans (highProbTime_bound hn) + exact (hm_ex.runRand_program AmpReg.bestVal hT).trans + (hm_std.runRand_program AmpReg.bestVal hT).symm private theorem init_mem_eq {r : ℕ} (input : List ℕ) : (Data.init (r := r) input).mem = Presentation.initMem input := by