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/20] 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/20] =?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/20] 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/20] 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/20] 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/20] 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/20] 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/20] 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/20] 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/20] 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/20] 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 ad9fa1597181be9ad02e17ba1b15d78456c3e5f6 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 18:06:59 -0500 Subject: [PATCH 12/20] feat(Algorithms/Lean/Dijkstra): Dijkstra as a client of the priority-queue spec Dijkstra's algorithm as an oracle program over three interfaces, the indexed min-priority queue, a distance map (the existing Dictionary spec) and a new read-only adjacency-list interface, combined with `product`. Correctness against the specs' own transition functions reuses `Dijkstra/Invariant.lean` and `decode_edgesWord` unchanged. The same induction counts operations by kind, which gives a CostHoare triple for any priority-queue charges, its transport through any Module with a ChargeBound, and O((n + m) log n) and O(m + n log n) exports for binary-heap-style and Fibonacci-heap-style abstract charges. Part of #2205 (M3 pilot, hops 1-2). Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 4 + .../Algorithms/Lean/Dijkstra/Client.lean | 811 ++++++++++++++++++ Complexity/Algorithms/Lean/Dijkstra/Cost.lean | 245 ++++++ .../DataStructure/AdjacencyList/Spec.lean | 84 ++ .../StateTransition/TotalCost.lean | 48 ++ ComplexityTests/Dijkstra.lean | 87 ++ 6 files changed, 1279 insertions(+) create mode 100644 Complexity/Algorithms/Lean/Dijkstra/Client.lean create mode 100644 Complexity/Algorithms/Lean/Dijkstra/Cost.lean create mode 100644 Complexity/DataStructure/AdjacencyList/Spec.lean create mode 100644 Complexity/DataStructure/StateTransition/TotalCost.lean create mode 100644 ComplexityTests/Dijkstra.lean diff --git a/Complexity.lean b/Complexity.lean index 685133cb41..029ff5033c 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -10,6 +10,8 @@ public import Complexity.Algorithms.ExactTriangle.PieceBounds public import Complexity.Algorithms.ExactTriangle.Splitting public import Complexity.Algorithms.ExactTriangle.Weights public import Complexity.Algorithms.ExactTriangle.Witnesses +public import Complexity.Algorithms.Lean.Dijkstra.Client +public import Complexity.Algorithms.Lean.Dijkstra.Cost public import Complexity.Algorithms.Lean.Huffman.Basic public import Complexity.Algorithms.Lean.Huffman.Kraft public import Complexity.Algorithms.Lean.Huffman.Optimality @@ -2813,6 +2815,7 @@ public import Complexity.Crypto.Protocols.Signature.RandomOracle public import Complexity.DataStructure.AVLTree.Basic public import Complexity.DataStructure.AVLTree.Erase public import Complexity.DataStructure.AVLTree.Impl +public import Complexity.DataStructure.AdjacencyList.Spec public import Complexity.DataStructure.CountMin.Basic public import Complexity.DataStructure.CountMin.LinearHash public import Complexity.DataStructure.CountMin.Probability @@ -2922,6 +2925,7 @@ public import Complexity.DataStructure.StateTransition.Hoare public import Complexity.DataStructure.StateTransition.Impl public import Complexity.DataStructure.StateTransition.Module public import Complexity.DataStructure.StateTransition.Resource +public import Complexity.DataStructure.StateTransition.TotalCost public import Complexity.DataStructure.VanEmdeBoas.Basic public import Complexity.DataStructure.VanEmdeBoas.Elements public import Complexity.DataStructure.VanEmdeBoas.Erase diff --git a/Complexity/Algorithms/Lean/Dijkstra/Client.lean b/Complexity/Algorithms/Lean/Dijkstra/Client.lean new file mode 100644 index 0000000000..cafde60875 --- /dev/null +++ b/Complexity/Algorithms/Lean/Dijkstra/Client.lean @@ -0,0 +1,811 @@ +/- +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.Dijkstra.HeapStatement +public import Complexity.DataStructure.AdjacencyList.Spec +public import Complexity.DataStructure.Dictionary.Spec +public import Complexity.DataStructure.PriorityQueue.Spec +import Complexity.Algorithms.WordRAM.Dijkstra.ListEncode + +/-! +# Dijkstra's algorithm as a client of abstract interfaces + +This file writes Dijkstra's single-source shortest-path algorithm [Dijkstra][Dijkstra1959] +[CLRS2009] as an adaptive client (`Cslib.DataStructure.StateTransitionSpec.Client`, the free monad +that `OracleComp` also uses) of three interfaces, combined by `Cslib.DataStructure.product` into +`Cslib.Algorithms.Lean.Dijkstra.spec`: + +* the indexed min-priority queue `Cslib.DataStructure.PriorityQueue.indexedMinPQSpec` on the + vertices; +* a map of tentative distances, the dictionary `Cslib.DataStructure.Dictionary.spec`, in which a + vertex is absent until it is reached; +* the adjacency lists of the graph, `Cslib.DataStructure.AdjacencyList.spec`, read one edge at a + time. + +Each answer the client sees is one vertex, distance or weight; the graph and the distances stay +behind the interfaces. The client inserts a vertex into the queue when it first reaches it and +decreases its key when its distance improves. It needs no visited set, because the distance of a +visited vertex never improves. The main loop runs at most `n` rounds, one per visited vertex. + +Running the client against the transition functions of the specifications +(`Cslib.DataStructure.StateTransitionSpec.runClient`) is a pure Lean computation. Its correctness +(`Cslib.Algorithms.Lean.Dijkstra.dijkstra_correct`) rests on the machine-free invariant +`Cslib.Algorithms.WordRAM.Dijkstra.Instance.Inv` and on the relaxation of parallel edges +`Cslib.Algorithms.WordRAM.Dijkstra.decode_edgesWord`, both used unchanged. The same induction +counts the operations by kind (`Cslib.Algorithms.Lean.Dijkstra.countP_kind_dijkstra_le`): +at most `n` insertions and extractions, `m` key decreases, `2 m + 1` distance-map queries and +`n + m` graph queries. `Complexity.Algorithms.Lean.Dijkstra.Cost` turns the counts into costs. + +No statement here concerns a machine. The client's continuations are Lean functions, and their +computation is not charged. + +## Main definitions + +* `Cslib.Algorithms.Lean.Dijkstra.spec`: the three interfaces of Dijkstra's algorithm. +* `Cslib.Algorithms.Lean.Dijkstra.relaxEdge`, `Cslib.Algorithms.Lean.Dijkstra.scan`, + `Cslib.Algorithms.Lean.Dijkstra.loop`, `Cslib.Algorithms.Lean.Dijkstra.dijkstra`: the client, + from relaxing one edge to the whole algorithm. +* `Cslib.Algorithms.Lean.Dijkstra.init`, `Cslib.Algorithms.Lean.Dijkstra.HasDistances`: the + initial state and the final states of the interfaces. +* `Cslib.Algorithms.Lean.Dijkstra.OpKind`, `Cslib.Algorithms.Lean.Dijkstra.kind`: the kinds of + operation, for counting. +* `Cslib.Algorithms.Lean.Dijkstra.rateBound`, `Cslib.Algorithms.Lean.Dijkstra.maxCount`: the + bounds on the operations, weighted and by kind. + +## Main results + +* `Cslib.Algorithms.Lean.Dijkstra.dijkstra_correct`: every operation of the client is admissible, + and it ends with the distances in the distance map. +* `Cslib.Algorithms.Lean.Dijkstra.sum_rate_dijkstra_le`, + `Cslib.Algorithms.Lean.Dijkstra.countP_kind_dijkstra_le`: the operation counts. + +## References + +* [E. W. Dijkstra, *A note on two problems in connexion with graphs*][Dijkstra1959] +* [T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein, *Introduction to + Algorithms*][CLRS2009] +-/ + +@[expose] public section + +namespace Cslib.Algorithms.Lean.Dijkstra + +open Cslib.DataStructure Cslib.DataStructure.PriorityQueue +open Cslib.Algorithms.WordRAM.Dijkstra (ListInstance) + +/-- The interfaces of Dijkstra's algorithm on `Fin n`: an indexed min-priority queue with keys +at most `K`, a map of tentative distances with values below `V`, and the adjacency lists of the +graph. -/ +abbrev spec (n K V : ℕ) : StateTransitionSpec := + product (indexedMinPQSpec n K) (product (Dictionary.spec n V n) (AdjacencyList.spec n)) + +instance instHasStepFnSpec (n K V : ℕ) : (spec n K V).HasStepFn + (productStepFn _ _ IndexedMinPQ.step + (productStepFn (Dictionary.spec n V n) (AdjacencyList.spec n) Dictionary.step + AdjacencyList.step)) := + instHasStepFnProduct _ _ + +variable {n K V : ℕ} + +/-- One call to the priority queue. -/ +abbrev queue (o : IndexedMinPQ.Op n) : (spec n K V).Client (IndexedMinPQ.Op.Result o) := + PFunctor.FreeM.lift (P := (spec n K V).signature) (.inl o) + +/-- Look up the tentative distance of `v`: `none` while `v` is unreached. -/ +abbrev getDist (v : Fin n) : (spec n K V).Client (Option ℕ) := + PFunctor.FreeM.lift (P := (spec n K V).signature) (.inr (.inl (.get v))) + +/-- Set the tentative distance of `v` to `d`. -/ +abbrev setDist (v : Fin n) (d : ℕ) : (spec n K V).Client Unit := + PFunctor.FreeM.lift (P := (spec n K V).signature) (.inr (.inl (.insert v d))) + +/-- The number of edges out of `u`. -/ +abbrev degree (u : Fin n) : (spec n K V).Client ℕ := + PFunctor.FreeM.lift (P := (spec n K V).signature) (.inr (.inr (.degree u))) + +/-- The `i`-th edge out of `u`: its target and its weight. -/ +abbrev edge (u : Fin n) (i : ℕ) : (spec n K V).Client (Fin n × ℕ) := + PFunctor.FreeM.lift (P := (spec n K V).signature) (.inr (.inr (.edge u i))) + +/-- Relax the `i`-th edge out of `u`, a vertex at distance `du`. An unreached target is reached +and inserted into the queue; a reached target whose distance improves has its key decreased. -/ +def relaxEdge (u : Fin n) (du i : ℕ) : (spec n K V).Client Unit := do + let (v, c) ← edge u i + match ← getDist v with + | none => + setDist v (du + c) + queue (.insert v (du + c)) + | some dv => + if du + c < dv then + setDist v (du + c) + queue (.decreaseKey v (du + c)) + +/-- Relax every edge out of `u`, a vertex at distance `du`. -/ +def scan (u : Fin n) (du : ℕ) : (spec n K V).Client Unit := do + let d ← degree u + (List.range d).forM (relaxEdge u du) + +/-- The main loop, for at most `k` rounds: extract a vertex of least key from the queue and +relax the edges out of it, until the queue is empty. -/ +def loop : ℕ → (spec n K V).Client Unit + | 0 => pure () + | k + 1 => do + match ← queue .extractMin with + | none => pure () + | some (u, du) => + scan u du + loop k + +/-- **Dijkstra's algorithm** from the source `src`, as a client of `spec`: reach the source at +distance `0`, then run the main loop for `n` rounds. The distances are left in the distance +map. -/ +def dijkstra (src : Fin n) : (spec n K V).Client Unit := do + setDist src 0 + queue (.insert src 0) + loop n + +/-- The initial state for a graph `G`: an empty queue, an empty distance map and the adjacency +lists of `G`. -/ +def init (G : ListInstance) : (spec G.n K V).State := + (IndexedMinPQ.empty G.n, Dictionary.empty G.n, G.adj) + +/-- The kinds of operation of `spec`, for counting them. -/ +inductive OpKind where + /-- A queue insertion. -/ + | insert + /-- A queue extraction. -/ + | extractMin + /-- A queue key decrease. -/ + | decreaseKey + /-- A queue inspection, `isEmpty` or `getKey`. -/ + | inspect + /-- A lookup or update of the distance map. -/ + | distance + /-- A query to the adjacency lists. -/ + | graph + deriving DecidableEq, Repr + +/-- The kind of an operation of `spec`. -/ +def kind : (spec n K V).Op → OpKind + | .inl (.insert _ _) => .insert + | .inl .extractMin => .extractMin + | .inl (.decreaseKey _ _) => .decreaseKey + | .inl .isEmpty | .inl (.getKey _) => .inspect + | .inr (.inl _) => .distance + | .inr (.inr _) => .graph + +section Proof + +variable (rate : OpKind → ℕ) + +/-- The total rate of a history. -/ +private def weight (hist : List (spec n K V).Op) : ℕ := (hist.map fun o => rate (kind o)).sum + +/-- The number of unreached vertices. -/ +private def unreached (dm : Dictionary.State n) : ℕ := + (Finset.univ.filter fun v => dm v = none).card + +/-- A run of `p` from `s` is admissible, ends in `s'`, and has total rate at most `b`, amortized +against `rate .insert` per unreached vertex. -/ +private def Runs (s : (spec n K V).State) (p : (spec n K V).Client Unit) (s' : (spec n K V).State) + (b : ℕ) : Prop := + (spec n K V).ValidHistory s ((spec n K V).clientHistory s p) ∧ + (spec n K V).clientState s p = s' ∧ + weight rate ((spec n K V).clientHistory s p) + rate .insert * unreached s'.2.1 ≤ + b + rate .insert * unreached s.2.1 + +private theorem weight_append (xs ys : List (spec n K V).Op) : + weight rate (xs ++ ys) = weight rate xs + weight rate ys := by + simp only [weight, List.map_append, List.sum_append] + +private theorem weight_cons (o : (spec n K V).Op) (xs : List (spec n K V).Op) : + weight rate (o :: xs) = rate (kind o) + weight rate xs := by + simp only [weight, List.map_cons, List.sum_cons] + +private theorem weight_nil : weight rate ([] : List (spec n K V).Op) = 0 := rfl + +private theorem runClient_bind' {α β : Type} (s : (spec n K V).State) (p : (spec n K V).Client α) + (k : α → (spec n K V).Client β) : + (spec n K V).runClient s (p >>= k) = + ((spec n K V).clientResult ((spec n K V).clientState s p) (k ((spec n K V).clientResult s p)), + (spec n K V).clientState ((spec n K V).clientState s p) (k ((spec n K V).clientResult s p)), + (spec n K V).clientHistory s p ++ + (spec n K V).clientHistory ((spec n K V).clientState s p) + (k ((spec n K V).clientResult s p))) := + StateTransitionSpec.runClient_bind p k s + +private theorem Runs.bind {s s₁ s₂ : (spec n K V).State} {p q : (spec n K V).Client Unit} + {b₁ b₂ : ℕ} (h₁ : Runs rate s p s₁ b₁) (h₂ : Runs rate s₁ q s₂ b₂) : + Runs rate s (p >>= fun _ => q) s₂ (b₁ + b₂) := by + obtain ⟨hv₁, hs₁, hw₁⟩ := h₁ + obtain ⟨hv₂, hs₂, hw₂⟩ := h₂ + have hrun := runClient_bind' s p (fun _ => q) + simp only [hs₁] at hrun + refine ⟨?_, ?_, ?_⟩ + · rw [StateTransitionSpec.clientHistory, hrun, StateTransitionSpec.validHistory_append, + StateTransitionSpec.run_runClient, hs₁] + exact ⟨hv₁, hv₂⟩ + · rw [StateTransitionSpec.clientState, hrun, hs₂] + · rw [StateTransitionSpec.clientHistory, hrun, weight_append] + omega + +private theorem Runs.pure (s : (spec n K V).State) : Runs rate s (pure ()) s 0 := by + refine ⟨trivial, rfl, ?_⟩ + change weight rate [] + _ ≤ _ + rw [weight_nil, Nat.zero_add] + +/-- The relaxation of a tentative distance through a path of length `x`. -/ +private def relaxOpt (x : ℕ) : Option ℕ → Option ℕ + | none => some x + | some d => some (min x d) + +/-- The queue holds the reached vertices outside the visited set `T`, keyed by their tentative +distances. -/ +private def syncQ (T : Finset (Fin n)) (dm : Dictionary.State n) : IndexedMinPQ.State n := + fun v => if v ∈ T then none else dm v + +private theorem unreached_update_of_none {dm : Dictionary.State n} {v : Fin n} (hv : dm v = none) + (x : ℕ) : unreached (Function.update dm v (some x)) + 1 = unreached dm := by + have : (Finset.univ.filter fun w => Function.update dm v (some x) w = none) = + (Finset.univ.filter fun w => dm w = none).erase v := by + ext w + by_cases hw : w = v + · subst hw; simp + · simp [hw] + rw [unreached, this, Finset.card_erase_of_mem (by simpa using hv), unreached] + have : 0 < (Finset.univ.filter fun w => dm w = none).card := + Finset.card_pos.mpr ⟨v, by simpa using hv⟩ + omega + +private theorem unreached_update_of_some {dm : Dictionary.State n} {v : Fin n} {d : ℕ} + (hv : dm v = some d) (x : ℕ) : unreached (Function.update dm v (some x)) = unreached dm := by + unfold unreached + congr 1 + ext w + by_cases hw : w = v + · subst hw; simp [hv] + · simp [hw] + +private theorem syncQ_update {T : Finset (Fin n)} {dm : Dictionary.State n} {v : Fin n} + (hv : v ∉ T) (x : Option ℕ) : + Function.update (syncQ T dm) v x = syncQ T (Function.update dm v x) := by + funext w + by_cases hw : w = v + · subst hw; simp [syncQ, hv] + · simp [syncQ, hw] + +private theorem card_dom_lt {dm : Dictionary.State n} {v : Fin n} (hv : dm v = none) : + (Dictionary.dom dm).card < n := by + have hsub : Dictionary.dom dm ⊆ Finset.univ.erase v := by + intro w hw + rw [Finset.mem_erase] + refine ⟨?_, Finset.mem_univ w⟩ + rintro rfl + simp [Dictionary.dom, hv] at hw + have := Finset.card_le_card hsub + rw [Finset.card_erase_of_mem (Finset.mem_univ v), Finset.card_univ, Fintype.card_fin] at this + have := v.pos + omega + +private theorem Runs.of_runClient {s s' : (spec n K V).State} {p : (spec n K V).Client Unit} + {hist : List (spec n K V).Op} {b : ℕ} (h : (spec n K V).runClient s p = ((), s', hist)) + (hv : (spec n K V).ValidHistory s hist) + (hw : weight rate hist + rate .insert * unreached s'.2.1 ≤ b + rate .insert * unreached s.2.1) : + Runs rate s p s' b := by + refine ⟨?_, ?_, ?_⟩ + · rwa [StateTransitionSpec.clientHistory, h] + · rw [StateTransitionSpec.clientState, h] + · rwa [StateTransitionSpec.clientHistory, h] + +/-- **One edge.** Relaxing the edge `(v, c)` out of `u` updates the tentative distance of `v` and, +unless `v` is visited, its key. A visited target must not improve. -/ +private theorem relaxEdge_runs (T : Finset (Fin n)) (dm : Dictionary.State n) + (adj : AdjacencyList.State n) {u v : Fin n} {du c i : ℕ} (hi : i < (adj u).length) + (hvc : (adj u)[i] = (v, c)) + (hT : v ∈ T → ∃ dv, dm v = some dv ∧ dv ≤ du + c) (hK : du + c ≤ K) (hV : du + c < V) : + Runs rate (syncQ T dm, dm, adj) (relaxEdge (K := K) (V := V) u du i) + (syncQ T (Function.update dm v (relaxOpt (du + c) (dm v))), + Function.update dm v (relaxOpt (du + c) (dm v)), adj) + (rate .graph + 2 * rate .distance + rate .decreaseKey) := by + rcases hdm : dm v with _ | dv + · have hvT : v ∉ T := fun h => by obtain ⟨dv, h1, _⟩ := hT h; simp [hdm] at h1 + have hrun : (spec n K V).runClient (syncQ T dm, dm, adj) (relaxEdge u du i) = + ((), (Function.update (syncQ T dm) v (some (du + c)), Function.update dm v (some (du + c)), + adj), [.inr (.inr (.edge u i)), .inr (.inl (.get v)), .inr (.inl (.insert v (du + c))), + .inl (.insert v (du + c))]) := by + simp only [relaxEdge, StateTransitionSpec.runClient_lift_bind', + StateTransitionSpec.stepFn, AdjacencyList.step_edge _ _ hi, hvc, hdm, IndexedMinPQ.step, + StateTransitionSpec.runClient_lift] + rw [syncQ_update hvT] at hrun + refine Runs.of_runClient rate hrun ?_ ?_ + · simp [StateTransitionSpec.validHistory_cons, AdjacencyList.valid, Dictionary.valid, + IndexedMinPQ.valid, hi, hvc, hdm, card_dom_lt hdm, hV, hK, syncQ, hvT] + · have := unreached_update_of_none hdm (du + c) + rw [weight_cons, weight_cons, weight_cons, weight_cons, weight_nil, ← this, Nat.mul_succ] + dsimp only [kind, relaxOpt] + omega + · by_cases hlt : du + c < dv + · have hvT : v ∉ T := fun h => by + obtain ⟨dv', h1, h2⟩ := hT h + rw [hdm, Option.some_inj] at h1 + omega + have hrun : (spec n K V).runClient (syncQ T dm, dm, adj) (relaxEdge u du i) = + ((), (Function.update (syncQ T dm) v (some (du + c)), + Function.update dm v (some (du + c)), adj), + [.inr (.inr (.edge u i)), .inr (.inl (.get v)), .inr (.inl (.insert v (du + c))), + .inl (.decreaseKey v (du + c))]) := by + simp only [relaxEdge, StateTransitionSpec.runClient_lift_bind', + StateTransitionSpec.stepFn, AdjacencyList.step_edge _ _ hi, hvc, hdm, IndexedMinPQ.step, + StateTransitionSpec.runClient_lift, hlt, ite_true] + rw [syncQ_update hvT] at hrun + have hmin : relaxOpt (du + c) (some dv) = some (du + c) := by + simp only [relaxOpt, Option.some_inj] + omega + rw [hmin] + refine Runs.of_runClient rate hrun ?_ ?_ + · simp [StateTransitionSpec.validHistory_cons, AdjacencyList.valid, Dictionary.valid, + IndexedMinPQ.valid, hi, hvc, hdm, hV, hK, syncQ, hvT, hlt.le] + · rw [weight_cons, weight_cons, weight_cons, weight_cons, weight_nil, + unreached_update_of_some hdm] + dsimp only [kind] + omega + · have hrun : (spec n K V).runClient (syncQ T dm, dm, adj) (relaxEdge u du i) = + ((), (syncQ T dm, dm, adj), [.inr (.inr (.edge u i)), .inr (.inl (.get v))]) := by + simp only [relaxEdge, StateTransitionSpec.runClient_lift_bind', + StateTransitionSpec.stepFn, AdjacencyList.step_edge _ _ hi, hvc, hdm, hlt, ite_false] + rfl + have hmin : Function.update dm v (relaxOpt (du + c) (some dv)) = dm := by + rw [relaxOpt, min_eq_right (Nat.le_of_not_lt hlt), ← hdm, Function.update_eq_self] + rw [hmin] + refine Runs.of_runClient rate hrun ?_ ?_ + · simp [StateTransitionSpec.validHistory_cons, AdjacencyList.valid, hi] + · rw [weight_cons, weight_cons, weight_nil] + dsimp only [kind] + omega + +private theorem Runs.mono {s s' : (spec n K V).State} {p : (spec n K V).Client Unit} {b b' : ℕ} + (h : Runs rate s p s' b) (hb : b ≤ b') : Runs rate s p s' b' := + ⟨h.1, h.2.1, by have := h.2.2; omega⟩ + +/-- A call that leaves the distance map alone, followed by a continuation. -/ +private theorem Runs.lift_bind {s s' : (spec n K V).State} (o : (spec n K V).Op) + {k : (spec n K V).Result o → (spec n K V).Client Unit} {b : ℕ} (hv : (spec n K V).valid s o) + (hdm : ((spec n K V).stepFn s o).1.2.1 = s.2.1) + (h : Runs rate ((spec n K V).stepFn s o).1 (k ((spec n K V).stepFn s o).2) s' b) : + Runs rate s (PFunctor.FreeM.lift o >>= k) s' (rate (kind o) + b) := by + obtain ⟨hv', hs', hw'⟩ := h + refine ⟨?_, ?_, ?_⟩ + · simp only [StateTransitionSpec.clientHistory, StateTransitionSpec.runClient_lift_bind', + StateTransitionSpec.validHistory_cons] + exact ⟨hv, hv'⟩ + · simpa only [StateTransitionSpec.clientState, StateTransitionSpec.runClient_lift_bind'] using hs' + · simp only [StateTransitionSpec.clientHistory, StateTransitionSpec.runClient_lift_bind'] + rw [weight_cons] + rw [hdm] at hw' + simp only [StateTransitionSpec.clientHistory] at hw' + omega + +/-- The effect of relaxing the edges `es` out of a vertex at distance `du` on the distance map. -/ +private def scanMap (du : ℕ) (es : List (Fin n × ℕ)) (dm : Dictionary.State n) : + Dictionary.State n := + es.foldl (fun dm (v, c) => Function.update dm v (relaxOpt (du + c) (dm v))) dm + +private theorem scanMap_append_singleton (du : ℕ) (es : List (Fin n × ℕ)) (v : Fin n) (c : ℕ) + (dm : Dictionary.State n) : + scanMap du (es ++ [(v, c)]) dm = + Function.update (scanMap du es dm) v (relaxOpt (du + c) (scanMap du es dm v)) := by + rw [scanMap, List.foldl_append] + rfl + +/-- Relaxing edges never changes the tentative distance of a vertex that no edge improves. -/ +private theorem scanMap_of_le {du : ℕ} {dm : Dictionary.State n} {v : Fin n} {dv : ℕ} + (es : List (Fin n × ℕ)) (hv : dm v = some dv) (hle : ∀ c, (v, c) ∈ es → dv ≤ du + c) : + scanMap du es dm v = some dv := by + induction es generalizing dm with + | nil => exact hv + | cons e es ih => + obtain ⟨w, c⟩ := e + refine ih ?_ fun c' hc' => hle c' (List.mem_cons_of_mem _ hc') + dsimp only + by_cases hw : v = w + · subst hw + rw [Function.update_self, hv, relaxOpt, min_eq_right (hle c List.mem_cons_self)] + · rw [Function.update_of_ne hw, hv] + +/-- **The edge scan.** Relaxing the first `k` edges out of `u` updates the distance map and keeps +the queue synchronized with it, at rate `rate .graph + 2 * rate .distance + rate .decreaseKey` +per edge, amortized. -/ +private theorem forM_relaxEdge_runs (T : Finset (Fin n)) (dm : Dictionary.State n) + (adj : AdjacencyList.State n) (u : Fin n) (du : ℕ) + (hset : ∀ v c, (v, c) ∈ adj u → v ∈ T → ∃ dv, dm v = some dv ∧ dv ≤ du + c) + (hbound : ∀ v c, (v, c) ∈ adj u → du + c ≤ K ∧ du + c < V) {k : ℕ} (hk : k ≤ (adj u).length) : + Runs rate (syncQ T dm, dm, adj) + ((List.range k).forM (relaxEdge (K := K) (V := V) u du)) + (syncQ T (scanMap du ((adj u).take k) dm), scanMap du ((adj u).take k) dm, adj) + (k * (rate .graph + 2 * rate .distance + rate .decreaseKey)) := by + induction k with + | zero => simpa [scanMap] using Runs.pure rate (syncQ T dm, dm, adj) + | succ k ih => + have hk' : k < (adj u).length := hk + rcases hvc : (adj u)[k] with ⟨v, c⟩ + have hmem : (v, c) ∈ adj u := hvc ▸ List.getElem_mem hk' + have htake : (adj u).take (k + 1) = (adj u).take k ++ [(v, c)] := by + rw [List.take_add_one, List.getElem?_eq_getElem hk', hvc] + rfl + have hT : v ∈ T → ∃ dv, scanMap du ((adj u).take k) dm v = some dv ∧ dv ≤ du + c := by + intro hvT + obtain ⟨dv, hdv, hle⟩ := hset v c hmem hvT + refine ⟨dv, scanMap_of_le _ hdv fun c' hc' => ?_, hle⟩ + obtain ⟨dv', hdv', hle'⟩ := hset v c' (List.mem_of_mem_take hc') hvT + rw [hdv, Option.some_inj] at hdv' + exact hdv' ▸ hle' + have hedge := relaxEdge_runs rate T (scanMap du ((adj u).take k) dm) adj hk' hvc hT + (hbound v c hmem).1 (hbound v c hmem).2 + rw [List.range_succ] + change Runs rate _ (forM (List.range k ++ [k]) (relaxEdge u du)) _ _ + rw [List.forM_append, List.forM_cons, List.forM_nil, htake, scanMap_append_singleton] + exact ((ih hk'.le).bind rate (hedge.bind rate (Runs.pure rate _))).mono rate + (Nat.le_of_eq (by ring)) + +/-- Scanning the edges out of `u` relaxes them all. -/ +private theorem scan_runs (T : Finset (Fin n)) (dm : Dictionary.State n) + (adj : AdjacencyList.State n) (u : Fin n) (du : ℕ) + (hset : ∀ v c, (v, c) ∈ adj u → v ∈ T → ∃ dv, dm v = some dv ∧ dv ≤ du + c) + (hbound : ∀ v c, (v, c) ∈ adj u → du + c ≤ K ∧ du + c < V) : + Runs rate (syncQ T dm, dm, adj) (scan (K := K) (V := V) u du) + (syncQ T (scanMap du (adj u) dm), scanMap du (adj u) dm, adj) + (rate .graph + (adj u).length * (rate .graph + 2 * rate .distance + rate .decreaseKey)) := by + have h := forM_relaxEdge_runs rate T dm adj u du hset hbound (k := (adj u).length) le_rfl + rw [List.take_length] at h + exact Runs.lift_bind rate (.inr (.inr (.degree u))) trivial rfl h + +/-! ### Tentative distances -/ + +/-- A tentative distance as a word: `0` while unreached and `d + 1` at distance `d`. -/ +private def word : Option ℕ → ℕ + | none => 0 + | some d => d + 1 + +/-- The tentative distances of a distance map: `⊤` while unreached. -/ +private def tentative (dm : Dictionary.State n) (v : Fin n) : ℕ∞ := + WordRAM.Dijkstra.decodeDist (word (dm v)) + +private theorem tentative_of_none {dm : Dictionary.State n} {v : Fin n} (h : dm v = none) : + tentative dm v = ⊤ := by + simp [tentative, h, word, WordRAM.Dijkstra.decodeDist] + +private theorem tentative_of_some {dm : Dictionary.State n} {v : Fin n} {d : ℕ} + (h : dm v = some d) : tentative dm v = d := by + simp [tentative, h, word, WordRAM.Dijkstra.decodeDist] + +private theorem word_relaxOpt (du c : ℕ) (o : Option ℕ) : + word (relaxOpt (du + c) o) = WordRAM.Dijkstra.edgeWord (du + 1) c (word o) := by + cases o with + | none => simp only [relaxOpt, word, WordRAM.Dijkstra.edgeWord, ite_true]; omega + | some d => + change min (du + c) d + 1 = WordRAM.Dijkstra.edgeWord (du + 1) c (d + 1) + unfold WordRAM.Dijkstra.edgeWord + split_ifs <;> (try contradiction) <;> omega + +private theorem word_scanMap (du : ℕ) (es : List (Fin n × ℕ)) (dm : Dictionary.State n) + (v : Fin n) : + word (scanMap du es dm v) = WordRAM.Dijkstra.edgesWord (du + 1) es v (word (dm v)) := by + induction es generalizing dm with + | nil => rfl + | cons e es ih => + obtain ⟨w, c⟩ := e + rw [WordRAM.Dijkstra.edgesWord, List.foldl_cons, ← WordRAM.Dijkstra.edgesWord] + refine (ih _).trans ?_ + congr 1 + by_cases hw : w = v + · subst hw + simp [word_relaxOpt] + · simp [Function.update_of_ne (Ne.symm hw), hw] + +/-- Scanning the edges out of `u` relaxes the tentative distances. -/ +private theorem tentative_scanMap (G : ListInstance) {dm : Dictionary.State G.n} {u : Fin G.n} + {du : ℕ} (hu : dm u = some du) : + tentative (scanMap du (G.adj u) dm) = G.toInstance.relax (tentative dm) u := by + funext v + change WordRAM.Dijkstra.decodeDist (word (scanMap du (G.adj u) dm v)) = _ + rw [word_scanMap] + exact WordRAM.Dijkstra.decode_edgesWord G (Nat.add_one_ne_zero du) + (by simp only [tentative, hu, word]) rfl + +/-! ### The main loop -/ + +/-- The loop invariant: visited vertices are reached, and the tentative distances satisfy the +invariant of Dijkstra's algorithm. -/ +private structure Good (G : ListInstance) (T : Finset (Fin G.n)) (dm : Dictionary.State G.n) : + Prop where + reached : ∀ v ∈ T, dm v ≠ none + inv : G.toInstance.Inv T (tentative dm) + +/-- **Visiting a vertex.** If the queue's least key is `du`, for `u`, then `u` is unvisited and at +distance `du`; every edge out of `u` into `u` or a visited vertex is already relaxed; the new keys +respect the bounds; and after the edges out of `u` are relaxed, the invariant holds with `u` +visited. -/ +private theorem Good.visit {G : ListInstance} {T : Finset (Fin G.n)} {dm : Dictionary.State G.n} + (hgood : Good G T dm) (hK : G.n * G.maxWeight ≤ K) (hV : G.n * G.maxWeight < V) {u : Fin G.n} + {du : ℕ} (hf : IndexedMinPQ.findMin (syncQ T dm) = some (u, du)) : + u ∉ T ∧ (∀ v c, (v, c) ∈ G.adj u → v ∈ insert u T → ∃ dv, dm v = some dv ∧ dv ≤ du + c) ∧ + (∀ v c, (v, c) ∈ G.adj u → du + c ≤ K ∧ du + c < V) ∧ + Good G (insert u T) (scanMap du (G.adj u) dm) := by + have hqu := IndexedMinPQ.findMin_eq_some_state hf + have huT : u ∉ T := fun h => by simp [syncQ, h] at hqu + have hdu : dm u = some du := by simpa [syncQ, huT] using hqu + have hDu : tentative dm u = du := tentative_of_some hdu + have hmin : ∀ v ∉ T, tentative dm u ≤ tentative dm v := by + intro v hv + rcases hdv : dm v with _ | dv + · rw [tentative_of_none hdv] + exact le_top + · rw [tentative_of_some hdv, hDu] + exact_mod_cast IndexedMinPQ.findMin_key_le hf (v := v) (k' := dv) + (by simp [syncQ, hv, hdv]) + have hfin : tentative dm u ≠ ⊤ := by + rw [hDu] + exact ENat.natCast_ne_top du + -- Every edge out of `u` into `u` or a visited vertex is already relaxed. + have hset : ∀ v c, (v, c) ∈ G.adj u → v ∈ insert u T → + ∃ dv, dm v = some dv ∧ dv ≤ du + c := by + intro v c hvc hv + rcases Finset.mem_insert.mp hv with rfl | hvT + · exact ⟨du, hdu, Nat.le_add_right du c⟩ + obtain ⟨dv, hdv⟩ := Option.ne_none_iff_exists'.mp (hgood.reached v hvT) + refine ⟨dv, hdv, ?_⟩ + obtain ⟨c', hc'⟩ := Option.ne_none_iff_exists'.mp + fun h => G.lightest_eq_none_iff.mp h c hvc + have hc'c : c' ≤ c := (G.lightest_eq_some_iff.mp hc').2 c hvc + have hv' : (dv : ℕ∞) = G.toInstance.dist G.source v := by + rw [← tentative_of_some hdv] + exact hgood.inv.eq_of_mem v hvT + have hu' : G.toInstance.dist G.source u ≤ du := hDu ▸ hgood.inv.dist_le u + have : (dv : ℕ∞) ≤ ((du + c : ℕ) : ℕ∞) := + calc (dv : ℕ∞) = G.toInstance.dist G.source v := hv' + _ ≤ G.toInstance.dist G.source u + c' := + G.toInstance.dist_le_edge (a := u) (b := v) (c := c') hc' + _ ≤ ((du + c : ℕ) : ℕ∞) := by + push_cast + exact add_le_add hu' (by exact_mod_cast hc'c) + exact_mod_cast this + -- Keys stay at most `n` times the largest weight. + have hcard : T.card + 1 ≤ G.n := by + have := Finset.card_le_univ (insert u T) + rwa [Finset.card_insert_of_notMem huT, Fintype.card_fin] at this + have hduW : du ≤ T.card * G.maxWeight := by + have h : tentative dm u ≤ ((T.card * G.toInstance.maxWeight : ℕ) : ℕ∞) := + hgood.inv.bound u hfin + rw [hDu] at h + have h' : du ≤ T.card * G.toInstance.maxWeight := by exact_mod_cast h + exact h'.trans (Nat.mul_le_mul_left _ G.toInstance_maxWeight_le) + have hbound : ∀ v c, (v, c) ∈ G.adj u → du + c ≤ K ∧ du + c < V := by + intro v c hvc + have hc : c ≤ G.maxWeight := G.le_maxWeight hvc + have : du + c ≤ G.n * G.maxWeight := + calc du + c ≤ T.card * G.maxWeight + G.maxWeight := by omega + _ = (T.card + 1) * G.maxWeight := by ring + _ ≤ G.n * G.maxWeight := Nat.mul_le_mul_right _ hcard + omega + -- After the scan, the invariant holds with `u` visited. + have hgood' : Good G (insert u T) (scanMap du (G.adj u) dm) := by + refine ⟨fun v hv => ?_, ?_⟩ + · have hv0 : dm v ≠ none := by + rcases Finset.mem_insert.mp hv with rfl | hvT + · simp [hdu] + · exact hgood.reached v hvT + obtain ⟨dv, hdv⟩ := Option.ne_none_iff_exists'.mp hv0 + rw [scanMap_of_le _ hdv fun c hvc => by + obtain ⟨dv', hdv', hle⟩ := hset v c hvc hv + rw [hdv, Option.some_inj] at hdv' + exact hdv' ▸ hle] + simp + · have h := WordRAM.Dijkstra.Instance.Inv.step _ hgood.inv huT hmin hfin + rwa [← tentative_scanMap G hdu] at h + exact ⟨huT, hset, hbound, hgood'⟩ + +/-- **The main loop.** From a state satisfying the invariant with visited set `T`, enough rounds +leave an empty queue and the distances in the distance map, at rate `rate .extractMin + +rate .graph` per round and `rate .graph + 2 * rate .distance + rate .decreaseKey` per edge out of +an unvisited vertex, amortized. -/ +private theorem loop_runs (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) + (hV : G.n * G.maxWeight < V) (k : ℕ) : + ∀ (T : Finset (Fin G.n)) (dm : Dictionary.State G.n), Good G T dm → G.n - T.card ≤ k → + ∃ dist, (∀ v, tentative dist v = G.dist G.source v) ∧ + Runs rate (syncQ T dm, dm, G.adj) (loop (K := K) (V := V) k) + (IndexedMinPQ.empty G.n, dist, G.adj) + (k * (rate .extractMin + rate .graph) + (∑ v ∈ Tᶜ, (G.adj v).length) * + (rate .graph + 2 * rate .distance + rate .decreaseKey)) := by + induction k with + | zero => + intro T dm hgood hk + have hcard := Finset.card_le_univ T + rw [Fintype.card_fin] at hcard + have hT : T = Finset.univ := Finset.eq_univ_of_card T (by rw [Fintype.card_fin]; omega) + subst hT + refine ⟨dm, fun v => WordRAM.Dijkstra.Instance.Inv.eq_dist _ hgood.inv + (fun v hv => absurd (Finset.mem_univ v) hv) v, ?_⟩ + have hq : syncQ Finset.univ dm = IndexedMinPQ.empty G.n := by + funext v + simp [syncQ, IndexedMinPQ.empty] + rw [hq] + exact (Runs.pure rate _).mono rate (Nat.zero_le _) + | succ k ih => + intro T dm hgood hk + rw [loop] + rcases hf : IndexedMinPQ.findMin (syncQ T dm) with _ | ⟨u, du⟩ + · -- The queue is empty: every unvisited vertex is unreached. + have hdom := IndexedMinPQ.findMin_eq_none_iff.mp hf + have hq : ∀ v, syncQ T dm v = none := fun v => + IndexedMinPQ.notMem_dom_iff.mp (by rw [hdom]; exact Finset.notMem_empty v) + have hempty : syncQ T dm = IndexedMinPQ.empty G.n := funext hq + have hdone : ∀ v ∉ T, tentative dm v = ⊤ := fun v hv => + tentative_of_none (by simpa [syncQ, hv] using hq v) + refine ⟨dm, WordRAM.Dijkstra.Instance.Inv.eq_dist _ hgood.inv hdone, ?_⟩ + refine (Runs.lift_bind rate (b := 0) (.inl .extractMin) trivial rfl ?_).mono rate ?_ + · simp only [IndexedMinPQ.step, hf] + rw [hempty] + exact Runs.pure rate _ + · dsimp only [kind] + rw [add_one_mul] + omega + · -- Visit `u`, an unvisited vertex of least tentative distance `du`. + obtain ⟨huT, hset, hbound, hgood'⟩ := hgood.visit hK hV hf + obtain ⟨dist, hdist, hrest⟩ := ih (insert u T) (scanMap du (G.adj u) dm) hgood' + (by rw [Finset.card_insert_of_notMem huT]; omega) + refine ⟨dist, hdist, ?_⟩ + have hsync : Function.update (syncQ T dm) u none = syncQ (insert u T) dm := by + funext v + by_cases hv : v = u + · subst hv + simp [syncQ] + · simp [syncQ, hv] + refine (Runs.lift_bind rate (.inl .extractMin) trivial rfl + (b := rate .graph + (G.adj u).length * + (rate .graph + 2 * rate .distance + rate .decreaseKey) + + (k * (rate .extractMin + rate .graph) + (∑ v ∈ (insert u T)ᶜ, (G.adj v).length) * + (rate .graph + 2 * rate .distance + rate .decreaseKey))) ?_).mono rate ?_ + · simp only [IndexedMinPQ.step, hf] + rw [hsync] + exact (scan_runs rate (insert u T) dm G.adj u du hset hbound).bind rate hrest + · have hsum : (G.adj u).length + ∑ v ∈ (insert u T)ᶜ, (G.adj v).length = + ∑ v ∈ Tᶜ, (G.adj v).length := by + rw [Finset.compl_insert] + exact Finset.add_sum_erase Tᶜ (fun v => (G.adj v).length) (Finset.mem_compl.mpr huT) + rw [← hsum] + dsimp only [kind] + nlinarith + +/-- **The whole run.** From the initial state, Dijkstra's algorithm leaves an empty queue and the +distances in the distance map. -/ +private theorem dijkstra_runs (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) + (hV : G.n * G.maxWeight < V) : + ∃ dist, (∀ v, tentative dist v = G.dist G.source v) ∧ + Runs rate (init G) (dijkstra (K := K) (V := V) G.source) + (IndexedMinPQ.empty G.n, dist, G.adj) + (rate .distance + G.n * (rate .extractMin + rate .graph) + + G.m * (rate .graph + 2 * rate .distance + rate .decreaseKey)) := by + have hn : 0 < G.n := G.source.pos + set dm₀ := Function.update (Dictionary.empty G.n) G.source (some 0) with hdm₀ + have htent : tentative dm₀ = Function.update (fun _ => ⊤) G.source 0 := by + funext v + by_cases hv : v = G.source + · subst hv + simp [dm₀, tentative_of_some] + · rw [Function.update_of_ne hv, tentative_of_none (by simp [dm₀, hv, Dictionary.empty])] + have hgood : Good G ∅ dm₀ := + ⟨fun v hv => absurd hv (Finset.notMem_empty v), + htent ▸ WordRAM.Dijkstra.Instance.Inv.init G.toInstance⟩ + obtain ⟨dist, hdist, hv, hs, hw⟩ := + loop_runs rate G hK hV G.n ∅ dm₀ hgood (by simp) + refine ⟨dist, hdist, ?_⟩ + have hq₀ : Function.update (IndexedMinPQ.empty G.n) G.source (some 0) = syncQ ∅ dm₀ := by + funext v + by_cases hv : v = G.source + · subst hv + simp [syncQ, dm₀] + · simp [syncQ, dm₀, hv, IndexedMinPQ.empty, Dictionary.empty] + have hrun : (spec G.n K V).runClient (init G) (dijkstra G.source) = + ((spec G.n K V).clientResult (syncQ ∅ dm₀, dm₀, G.adj) (loop G.n), + (spec G.n K V).clientState (syncQ ∅ dm₀, dm₀, G.adj) (loop G.n), + [.inr (.inl (.insert G.source 0)), .inl (.insert G.source 0)] ++ + (spec G.n K V).clientHistory (syncQ ∅ dm₀, dm₀, G.adj) (loop G.n)) := by + simp only [dijkstra, init, StateTransitionSpec.runClient_lift_bind', IndexedMinPQ.step] + rw [← hdm₀, hq₀] + rfl + have hunr : unreached dm₀ + 1 = unreached (Dictionary.empty G.n) := + unreached_update_of_none rfl 0 + have hunr₀ : unreached (Dictionary.empty G.n) = G.n := by + simp [unreached, Dictionary.empty] + have hsum : ∑ v ∈ (∅ : Finset (Fin G.n))ᶜ, (G.adj v).length = G.m := by + simp [ListInstance.m] + refine Runs.of_runClient rate (hrun.trans (by rw [hs])) ?_ ?_ + · simp only [List.cons_append, List.nil_append, StateTransitionSpec.validHistory_cons] + refine ⟨⟨Or.inl ?_, by omega⟩, ⟨rfl, Nat.zero_le K⟩, ?_⟩ + · simp [Dictionary.dom, Dictionary.empty, init, hn] + · simpa only [StateTransitionSpec.stepFn, IndexedMinPQ.step, hq₀, init] using hv + · rw [weight_append, weight_cons, weight_cons, weight_nil] + simp only [hsum] at hw + dsimp only [kind, init] + rw [hunr₀] at hunr + nlinarith + +end Proof + +/-! ### Correctness -/ + +/-- The final state of Dijkstra's algorithm on `G`: the queue is empty, the graph is unchanged, +and the distance map sends each vertex `v` to `some d` exactly when `d` is the distance from the +source to `v`. So it sends `v` to `none` exactly when `v` is unreachable. -/ +def HasDistances (G : ListInstance) (s : (spec G.n K V).State) : Prop := + ∃ dist : Dictionary.State G.n, s = (IndexedMinPQ.empty G.n, dist, G.adj) ∧ + ∀ v d, dist v = some d ↔ G.dist G.source v = d + +/-- **Correctness of Dijkstra's algorithm** against the specifications of its interfaces. Run +from an empty queue and an empty distance map on a graph whose largest weight `W` satisfies +`n W ≤ K` and `n W < V`, every operation the client issues is admissible, and it ends with the +distances from the source in the distance map. -/ +theorem dijkstra_correct (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) + (hV : G.n * G.maxWeight < V) : + (spec G.n K V).ValidHistory (init G) ((spec G.n K V).clientHistory (init G) + (dijkstra G.source)) ∧ + HasDistances G ((spec G.n K V).clientState (init G) (dijkstra G.source)) := by + obtain ⟨dist, hdist, hv, hs, _⟩ := dijkstra_runs (fun _ => 0) G hK hV + refine ⟨hv, dist, hs, fun v d => ?_⟩ + rw [← hdist v] + rcases h : dist v with _ | d' + · simp [tentative_of_none h] + · simp [tentative_of_some h] + +/-! ### Operation counts -/ + +/-- The total rate of the operations Dijkstra's algorithm issues on a graph with `n` vertices and +`m` edges, at most: `n` insertions, `n` extractions, `m` key decreases, `2 m + 1` distance-map +queries and `n + m` graph queries. -/ +def rateBound (rate : OpKind → ℕ) (n m : ℕ) : ℕ := + n * rate .insert + n * rate .extractMin + m * rate .decreaseKey + + (2 * m + 1) * rate .distance + (n + m) * rate .graph + +/-- **Operations, weighted.** Under any rate per kind of operation, the operations Dijkstra's +algorithm issues have total rate at most `rateBound rate n m`. -/ +theorem sum_rate_dijkstra_le (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) + (hV : G.n * G.maxWeight < V) (rate : OpKind → ℕ) : + (((spec G.n K V).clientHistory (init G) (dijkstra G.source)).map + fun o => rate (kind o)).sum ≤ rateBound rate G.n G.m := by + obtain ⟨dist, _, _, _, hw⟩ := dijkstra_runs rate G hK hV + have hn : unreached (init (K := K) (V := V) G).2.1 = G.n := by + simp [unreached, init, Dictionary.empty] + rw [hn] at hw + change weight rate _ ≤ _ + unfold rateBound + nlinarith [Nat.zero_le (rate .insert * unreached dist)] + +/-- The number of operations of each kind that Dijkstra's algorithm issues on a graph with `n` +vertices and `m` edges, at most. -/ +def maxCount (n m : ℕ) : OpKind → ℕ + | .insert => n + | .extractMin => n + | .decreaseKey => m + | .inspect => 0 + | .distance => 2 * m + 1 + | .graph => n + m + +/-- **Operation counts.** Dijkstra's algorithm issues at most `n` insertions, `n` extractions and +`m` key decreases, never inspects the queue, and issues at most `2 m + 1` distance-map queries +and `n + m` graph queries. -/ +theorem countP_kind_dijkstra_le (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) + (hV : G.n * G.maxWeight < V) (k : OpKind) : + ((spec G.n K V).clientHistory (init G) (dijkstra G.source)).countP (kind · = k) ≤ + maxCount G.n G.m k := by + have h := sum_rate_dijkstra_le G hK hV fun k' => if k' = k then 1 else 0 + simp only [List.sum_map_ite, List.map_const', List.sum_replicate, smul_eq_mul, mul_one, + List.map_const', mul_zero, add_zero, ← List.countP_eq_length_filter] at h + cases k <;> simpa [rateBound, maxCount] using h + +end Cslib.Algorithms.Lean.Dijkstra diff --git a/Complexity/Algorithms/Lean/Dijkstra/Cost.lean b/Complexity/Algorithms/Lean/Dijkstra/Cost.lean new file mode 100644 index 0000000000..ceea564bb2 --- /dev/null +++ b/Complexity/Algorithms/Lean/Dijkstra/Cost.lean @@ -0,0 +1,245 @@ +/- +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.Lean.Dijkstra.Client +public import Complexity.DataStructure.StateTransition.CostHoare +public import Mathlib.Analysis.Asymptotics.Defs +import Complexity.DataStructure.StateTransition.TotalCost + +/-! +# Dijkstra's algorithm: cost in priority-queue operations + +This file measures the cost of Dijkstra's algorithm, as the client +`Cslib.Algorithms.Lean.Dijkstra.dijkstra`, in the operations of its interfaces. A priority-queue +operation costs what an implementation charges for it, possibly amortized, and a distance-map or +graph query costs one unit (`Cslib.Algorithms.Lean.Dijkstra.charge`). The operation counts of the +client do not depend on the implementation. So when insertions, extractions and key decreases are +charged at most `cI`, `cE` and `cD`, the algorithm costs at most `n cI + n cE + m cD + n + 3 m + 1` +on a graph with `n` vertices and `m` edges (`Cslib.Algorithms.Lean.Dijkstra.costHoare_dijkstra`). +The same budget holds on any lower interface that implements the three interfaces with bounded +per-method charges (`Cslib.Algorithms.Lean.Dijkstra.costHoare_link_dijkstra`, through +`Cslib.DataStructure.Module.ChargeBound` and +`Cslib.DataStructure.StateTransitionSpec.CostHoare.link`). + +Two instantiations with abstract charges give the textbook bounds: + +* `O((n + m) log n)` when every queue operation costs `O(log n)`, as in a binary heap + [CLRS2009] (`Cslib.Algorithms.Lean.Dijkstra.exists_costHoare_logLinear`); +* `O(m + n log n)` when insertions and key decreases cost amortized `O(1)` and extractions + `O(log n)`, as in a Fibonacci heap [FredmanTarjan1987] + (`Cslib.Algorithms.Lean.Dijkstra.exists_costHoare_linearithmic`). + +Each states `∃ f` with `f` monotone and `f = O(g)` (Mathlib's `Asymptotics.IsBigO`) along the +filter `Filter.comap Prod.fst Filter.atTop` on `(n, m)`: for all large `n`, uniformly in `m`. + +These are operation-level costs. Pure Lean computation in the client's continuations is not +charged, and no statement concerns a machine. + +## Main definitions + +* `Cslib.Algorithms.Lean.Dijkstra.charge`: queue operations at the charges of a priority-queue + implementation, queries at one unit. +* `Cslib.Algorithms.Lean.Dijkstra.budget`: the operation-level budget. + +## Main results + +* `Cslib.Algorithms.Lean.Dijkstra.totalCost_dijkstra_le`: the total cost under charges bounded + by kind. +* `Cslib.Algorithms.Lean.Dijkstra.costHoare_dijkstra`: correctness and cost against any + priority-queue charges. +* `Cslib.Algorithms.Lean.Dijkstra.costHoare_link_dijkstra`: the same through any implementation of + the interfaces. +* `Cslib.Algorithms.Lean.Dijkstra.budget_mono`: the budget is monotone. +* `Cslib.Algorithms.Lean.Dijkstra.exists_costHoare_logLinear`, + `Cslib.Algorithms.Lean.Dijkstra.exists_costHoare_linearithmic`: the asymptotic bounds. + +## References + +* [E. W. Dijkstra, *A note on two problems in connexion with graphs*][Dijkstra1959] +* [T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein, *Introduction to + Algorithms*][CLRS2009] +* [M. L. Fredman and R. E. Tarjan, *Fibonacci heaps and their uses in improved network + optimization algorithms*][FredmanTarjan1987] +-/ + +@[expose] public section + +namespace Cslib.Algorithms.Lean.Dijkstra + +open Cslib.DataStructure Cslib.DataStructure.PriorityQueue +open Cslib.Algorithms.WordRAM.Dijkstra (ListInstance) + +variable {n K V : ℕ} + +/-- The charge of an operation in the priority-queue currency: a queue operation costs what +`pqCharge` charges for it in the current queue state, and every distance-map or graph query costs +one unit. -/ +def charge (pqCharge : IndexedMinPQ.State n → IndexedMinPQ.Op n → ℕ) : + (spec n K V).State → (spec n K V).Op → ℕ + | (q, _), .inl o => pqCharge q o + | _, .inr _ => 1 + +/-- **Total cost under any charges.** If every operation of each kind costs at most `rate` of its +kind, Dijkstra's algorithm costs at most `rateBound rate n m` in total. -/ +theorem totalCost_dijkstra_le (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) + (hV : G.n * G.maxWeight < V) (cost : (spec G.n K V).State → (spec G.n K V).Op → ℕ) + (rate : OpKind → ℕ) (hcost : ∀ s o, kind o ≠ .inspect → cost s o ≤ rate (kind o)) : + (spec G.n K V).totalCost cost (init G) + ((spec G.n K V).clientHistory (init G) (dijkstra G.source)) ≤ + rateBound rate G.n G.m := by + refine ((spec G.n K V).totalCost_le_sum_map cost (fun o => rate (kind o)) fun s o ho => + hcost s o fun hk => ?_).trans (sum_rate_dijkstra_le G hK hV rate) + have h := countP_kind_dijkstra_le G hK hV .inspect + simp only [maxCount, Nat.le_zero, List.countP_eq_zero, decide_eq_true_eq] at h + exact h o ho hk + +/-- The operation-level budget of Dijkstra's algorithm when insertions cost `cI`, extractions `cE` +and key decreases `cD` each, and every other query one unit. -/ +def budget (cI cE cD n m : ℕ) : ℕ := + n * cI + n * cE + m * cD + (n + 3 * m + 1) + +/-- **Dijkstra's algorithm against any priority queue.** Charge each queue operation what a +priority-queue implementation charges for it, at most `cI` per insertion, `cE` per extraction and +`cD` per key decrease, and one unit per distance-map or graph query. Then Dijkstra's algorithm is +correct, and its total charge is at most `n cI + n cE + m cD + n + 3 m + 1`. -/ +theorem costHoare_dijkstra (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) + (hV : G.n * G.maxWeight < V) (pqCharge : IndexedMinPQ.State G.n → IndexedMinPQ.Op G.n → ℕ) + {cI cE cD : ℕ} (hI : ∀ q v k, pqCharge q (.insert v k) ≤ cI) + (hE : ∀ q, pqCharge q .extractMin ≤ cE) (hD : ∀ q v k, pqCharge q (.decreaseKey v k) ≤ cD) : + (spec G.n K V).CostHoare (charge pqCharge) (· = init G) (dijkstra G.source) + (fun _ => HasDistances G) (fun _ => budget cI cE cD G.n G.m) := by + rw [StateTransitionSpec.costHoare_iff_ofFn, StateTransitionSpec.hoare_iff_ofFn] + refine ⟨fun s hs₀ => ?_, fun s hs₀ => ?_⟩ + · subst hs₀ + exact dijkstra_correct G hK hV + · subst hs₀ + let rate : OpKind → ℕ + | .insert => cI + | .extractMin => cE + | .decreaseKey => cD + | .inspect => 0 + | .distance => 1 + | .graph => 1 + refine (totalCost_dijkstra_le G hK hV _ rate fun s o ho => ?_).trans (le_of_eq ?_) + · obtain ⟨q, _⟩ := s + rcases o with (_ | _ | _ | _ | _) | (_ | _) + · exact absurd rfl ho + · exact absurd rfl ho + · exact hI q _ _ + · exact hD q _ _ + · exact hE q + · exact le_rfl + · exact le_rfl + · simp only [rateBound, budget, rate] + ring + +/-- **Through any implementation of the interfaces.** Let a module `M` implement the interfaces +of Dijkstra's algorithm over a lower interface `E`, with each method body costing at most +`charge pqCharge` of its operation in the lower charges `lower`. From any lower state that +represents the initial state, the linked client costs at most the same budget on `E`, and ends +in a state that represents a final state with the distances. -/ +theorem costHoare_link_dijkstra (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) + (hV : G.n * G.maxWeight < V) {E : StateTransitionSpec} (M : Module (spec G.n K V) E) + {lower : E.State → E.Op → ℕ} + (pqCharge : IndexedMinPQ.State G.n → IndexedMinPQ.Op G.n → ℕ) (B : M.ChargeBound lower + (charge pqCharge)) {cI cE cD : ℕ} (hI : ∀ q v k, pqCharge q (.insert v k) ≤ cI) + (hE : ∀ q, pqCharge q .extractMin ≤ cE) (hD : ∀ q v k, pqCharge q (.decreaseKey v k) ≤ cD) : + E.CostHoare lower (M.rep (init G)) (link M.methods (dijkstra G.source)) + (fun _ e => ∃ s, HasDistances G s ∧ M.rep s e) (fun _ => budget cI cE cD G.n G.m) := + ((costHoare_dijkstra G hK hV pqCharge hI hE hD).link B _ fun _ _ _ _ => le_rfl).consequence + (fun _ he => ⟨_, rfl, he⟩) (fun _ _ h => h) fun _ _ => le_rfl + +/-! ### Asymptotic bounds -/ + +/-- `budget` is monotone in the charges and in the size of the graph. -/ +theorem budget_mono {cI cE cD cI' cE' cD' n m n' m' : ℕ} (hI : cI ≤ cI') + (hE : cE ≤ cE') (hD : cD ≤ cD') (hn : n ≤ n') (hm : m ≤ m') : + budget cI cE cD n m ≤ budget cI' cE' cD' n' m' := by + unfold budget + gcongr + +/-- The budget under charges growing with `n` is `O(g)` over large `n`, uniformly in `m`, when it +is at most `c g (n, m)` for `n ≥ 2`. -/ +private theorem isBigO_budget (cI cE cD : ℕ → ℕ) {g : ℕ × ℕ → ℕ} (c : ℕ) + (h : ∀ n m, 2 ≤ n → budget (cI n) (cE n) (cD n) n m ≤ c * g (n, m)) : + (fun ((n, m) : ℕ × ℕ) => (budget (cI n) (cE n) (cD n) n m : ℝ)) + =O[Filter.comap Prod.fst Filter.atTop] fun p => (g p : ℝ) := by + refine Asymptotics.IsBigO.of_bound (c : ℝ) ?_ + rw [Filter.eventually_comap] + filter_upwards [Filter.eventually_ge_atTop 2] with b hb p hp + obtain ⟨n, m⟩ := p + simp only at hp + subst hp + simp only [Real.norm_natCast] + exact_mod_cast h n m hb + +/-- **Binary-heap-style charges: `O((n + m) log n)`.** If every queue operation is charged at +most `C (⌊log₂ n⌋ + 1)`, as for a binary heap, Dijkstra's algorithm is correct and costs +`f (n, m)` for a monotone `f = O((n + m) log n)`, as `n` grows, uniformly in `m`. -/ +theorem exists_costHoare_logLinear (C : ℕ) : + ∃ f : ℕ × ℕ → ℕ, Monotone f ∧ + (fun p => (f p : ℝ)) =O[Filter.comap Prod.fst Filter.atTop] + (fun ((n, m) : ℕ × ℕ) => ((n + m) * Nat.log 2 n : ℝ)) ∧ + ∀ (G : ListInstance) (K V : ℕ), G.n * G.maxWeight ≤ K → G.n * G.maxWeight < V → + ∀ pqCharge : IndexedMinPQ.State G.n → IndexedMinPQ.Op G.n → ℕ, + (∀ q o, pqCharge q o ≤ C * (Nat.log 2 G.n + 1)) → + (spec G.n K V).CostHoare (charge pqCharge) (· = init G) (dijkstra G.source) + (fun _ => HasDistances G) (fun _ => f (G.n, G.m)) := by + let c (n : ℕ) : ℕ := C * (Nat.log 2 n + 1) + refine ⟨fun (n, m) => budget (c n) (c n) (c n) n m, ?_, ?_, ?_⟩ + · rintro ⟨n, m⟩ ⟨n', m'⟩ ⟨hn, hm⟩ + have hc : c n ≤ c n' := + Nat.mul_le_mul_left C (Nat.add_le_add_right (Nat.log_mono_right hn) 1) + exact budget_mono hc hc hc hn hm + · have := isBigO_budget c c c (g := fun (n, m) => (n + m) * Nat.log 2 n) (4 * C + 5) + fun n m hn => by + have hL : 1 ≤ Nat.log 2 n := Nat.le_log_of_pow_le (by norm_num) (by simpa using hn) + simp only [budget, c] + generalize Nat.log 2 n = L at hL ⊢ + have hC := Nat.le_mul_of_pos_right C hL + nlinarith [Nat.mul_le_mul_left n hC, Nat.mul_le_mul_left m hC, + Nat.le_mul_of_pos_right n hL, Nat.le_mul_of_pos_right m hL] + simpa only [Nat.cast_mul, Nat.cast_add] using this + · intro G K V hK hV pqCharge h + exact costHoare_dijkstra G hK hV pqCharge (fun q _ _ => h q _) (fun q => h q _) + (fun q _ _ => h q _) + +/-- **Fibonacci-heap-style charges: `O(m + n log n)`.** If insertions and key decreases are +charged at most `C` and extractions at most `C (⌊log₂ n⌋ + 1)`, as amortized charges of a +Fibonacci heap, Dijkstra's algorithm is correct and costs `f (n, m)` for a monotone +`f = O(m + n log n)`, as `n` grows, uniformly in `m`. -/ +theorem exists_costHoare_linearithmic (C : ℕ) : + ∃ f : ℕ × ℕ → ℕ, Monotone f ∧ + (fun p => (f p : ℝ)) =O[Filter.comap Prod.fst Filter.atTop] + (fun ((n, m) : ℕ × ℕ) => (m + n * Nat.log 2 n : ℝ)) ∧ + ∀ (G : ListInstance) (K V : ℕ), G.n * G.maxWeight ≤ K → G.n * G.maxWeight < V → + ∀ pqCharge : IndexedMinPQ.State G.n → IndexedMinPQ.Op G.n → ℕ, + (∀ q v k, pqCharge q (.insert v k) ≤ C) → + (∀ q, pqCharge q .extractMin ≤ C * (Nat.log 2 G.n + 1)) → + (∀ q v k, pqCharge q (.decreaseKey v k) ≤ C) → + (spec G.n K V).CostHoare (charge pqCharge) (· = init G) (dijkstra G.source) + (fun _ => HasDistances G) (fun _ => f (G.n, G.m)) := by + let c (n : ℕ) : ℕ := C * (Nat.log 2 n + 1) + refine ⟨fun (n, m) => budget C (c n) C n m, ?_, ?_, ?_⟩ + · rintro ⟨n, m⟩ ⟨n', m'⟩ ⟨hn, hm⟩ + have hc : c n ≤ c n' := + Nat.mul_le_mul_left C (Nat.add_le_add_right (Nat.log_mono_right hn) 1) + exact budget_mono le_rfl hc le_rfl hn hm + · have := isBigO_budget (fun _ => C) c (fun _ => C) (g := fun (n, m) => m + n * Nat.log 2 n) + (3 * C + 5) fun n m hn => by + have hL : 1 ≤ Nat.log 2 n := Nat.le_log_of_pow_le (by norm_num) (by simpa using hn) + simp only [budget, c] + generalize Nat.log 2 n = L at hL ⊢ + have hC := Nat.le_mul_of_pos_right C hL + nlinarith [Nat.mul_le_mul_left n hC, Nat.le_mul_of_pos_right n hL] + simpa only [Nat.cast_mul, Nat.cast_add] using this + · intro G K V hK hV pqCharge hI hE hD + exact costHoare_dijkstra G hK hV pqCharge hI hE hD + +end Cslib.Algorithms.Lean.Dijkstra diff --git a/Complexity/DataStructure/AdjacencyList/Spec.lean b/Complexity/DataStructure/AdjacencyList/Spec.lean new file mode 100644 index 0000000000..da2154f9f9 --- /dev/null +++ b/Complexity/DataStructure/AdjacencyList/Spec.lean @@ -0,0 +1,84 @@ +/- +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 Complexity.DataStructure.StateTransition + +/-! +# Adjacency-list queries as a state-transition specification + +`AdjacencyList.spec n` is a read-only interface to a weighted directed graph on `Fin n`, given by +its adjacency lists of `(target, weight)` pairs. A client asks for the out-degree of a vertex +(`degree`) and for the `i`-th edge out of it (`edge`). The graph itself stays behind the +interface: a client sees one vertex and one weight per query, never a whole list. The state is +never changed. An edge query is admissible only below the out-degree. + +An implementation stores the graph as it likes, for example as the offset and edge arrays that a +word RAM reads from its input. Its correctness and its charges are then proved against `step`. + +## Main definitions + +* `AdjacencyList.State`, `AdjacencyList.Op`, `AdjacencyList.step`, `AdjacencyList.valid`: the + adjacency lists, the two queries with their answers, the transition function and the + admissibility precondition. +* `AdjacencyList.spec`: the deterministic specification over `Fin n`. + +## Main results + +* `AdjacencyList.step_degree`, `AdjacencyList.step_edge`: the answers of the two queries. +-/ + +@[expose] public section + +namespace Cslib.DataStructure.AdjacencyList + +/-- The adjacency lists of a weighted directed graph on `Fin n`: `adj u` holds a pair `(v, c)` +for each edge from `u` to `v` of weight `c`. -/ +abbrev State (n : ℕ) := Fin n → List (Fin n × ℕ) + +/-- Queries to the adjacency lists of a graph on `Fin n`. -/ +inductive Op (n : ℕ) where + /-- The number of edges out of `u`. -/ + | degree (u : Fin n) + /-- The `i`-th edge out of `u`, as its target and its weight. -/ + | edge (u : Fin n) (i : ℕ) + deriving DecidableEq, Repr + +/-- The answer types of the queries. -/ +abbrev Op.Result {n : ℕ} : Op n → Type + | .degree _ => ℕ + | .edge _ _ => Fin n × ℕ + +/-- The answers of the queries; the state never changes. An edge query past the out-degree is +inadmissible, and its answer `(u, 0)` is a placeholder. -/ +def step {n : ℕ} (adj : State n) : (o : Op n) → State n × o.Result + | .degree u => (adj, (adj u).length) + | .edge u i => (adj, (adj u).getD i (u, 0)) + +/-- An edge query is admissible below the out-degree. -/ +def valid {n : ℕ} (adj : State n) : Op n → Prop + | .degree _ => True + | .edge u i => i < (adj u).length + +/-- The adjacency-list interface of graphs on `Fin n`. -/ +abbrev spec (n : ℕ) : StateTransitionSpec := + StateTransitionSpec.ofFn (State := State n) (Op := Op n) (Result := Op.Result) step valid + +/-- A degree query returns the length of the adjacency list. -/ +@[simp] +theorem step_degree {n : ℕ} (adj : State n) (u : Fin n) : + step adj (.degree u) = (adj, (adj u).length) := rfl + +/-- An admissible edge query returns that entry of the adjacency list. -/ +@[simp] +theorem step_edge {n : ℕ} (adj : State n) (u : Fin n) {i : ℕ} (hi : i < (adj u).length) : + step adj (.edge u i) = (adj, (adj u)[i]) := by + simp [step, List.getElem?_eq_getElem hi] + +end Cslib.DataStructure.AdjacencyList diff --git a/Complexity/DataStructure/StateTransition/TotalCost.lean b/Complexity/DataStructure/StateTransition/TotalCost.lean new file mode 100644 index 0000000000..19dc3da407 --- /dev/null +++ b/Complexity/DataStructure/StateTransition/TotalCost.lean @@ -0,0 +1,48 @@ +/- +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 + +/-! +# Bounding the total charge of a history + +`Cslib.DataStructure.StateTransitionSpec.totalCost` sums state-dependent charges along a history. +When each operation's charge is bounded by a weight that does not depend on the state, the total +is bounded by the sum of the weights, which no longer needs the intermediate states. A client's +cost then follows from counting its operations by kind. + +## Main results + +* `Cslib.DataStructure.StateTransitionSpec.totalCost_le_sum_map`: the total charge is at most the + sum of state-independent bounds on the charges of the operations. +-/ + +@[expose] public section + +namespace Cslib.DataStructure.StateTransitionSpec + +universe u v w + +variable {D : StateTransitionSpec.{u, v, w}} + {f : (s : D.State) → (o : D.Op) → D.State × D.Result o} [D.HasStepFn f] + +/-- Charges bounded by state-independent weights on the operations of a history total at most +the sum of the weights. -/ +theorem totalCost_le_sum_map (charge : D.State → D.Op → ℕ) (w : D.Op → ℕ) {s : D.State} + {os : List D.Op} (h : ∀ s, ∀ o ∈ os, charge s o ≤ w o) : + D.totalCost charge s os ≤ (os.map w).sum := by + induction os generalizing s with + | nil => simp + | cons o os ih => + have hstep := h s o List.mem_cons_self + have hrest := ih (s := (D.stepFn s o).1) fun s o ho => h s o (List.mem_cons_of_mem _ ho) + simp only [totalCost_cons, List.map_cons, List.sum_cons] + omega + +end Cslib.DataStructure.StateTransitionSpec diff --git a/ComplexityTests/Dijkstra.lean b/ComplexityTests/Dijkstra.lean new file mode 100644 index 0000000000..ecf6a621ad --- /dev/null +++ b/ComplexityTests/Dijkstra.lean @@ -0,0 +1,87 @@ +/- +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.Lean.Dijkstra.Cost + +/-! Runs of Dijkstra's algorithm as a client of the priority-queue, distance-map and graph +interfaces, and nonvacuity of its correctness and cost theorems. -/ + +@[expose] public section + +open Cslib.DataStructure Cslib.DataStructure.PriorityQueue +open Cslib.Algorithms.WordRAM.Dijkstra (ListInstance) +open Cslib.Algorithms.Lean.Dijkstra + +namespace DijkstraTests + +/-- Three vertices, a parallel edge and a shorter path through a third vertex: edges `0 → 1` of +weights `4` and `5`, `0 → 2` of weight `1`, and `2 → 1` of weight `2`, from source `0`. The +distances are `0`, `3` and `1`. -/ +def graph : ListInstance where + n := 3 + adj := ![[(1, 4), (2, 1), (1, 5)], [], [(1, 2)]] + source := 0 + +/-- `graph` has `4` edges and largest weight `5`, so keys up to `15` and values below `16` +suffice. -/ +example : graph.m = 4 ∧ graph.maxWeight = 5 := by decide + +/-- Running the client against the specifications ends with an empty queue and the distances +`0`, `3` and `1` in the distance map. -/ +example : let (q, dist, _) := (spec 3 15 16).clientState (init graph) (dijkstra graph.source) + q = IndexedMinPQ.empty 3 ∧ dist = ![some 0, some 3, some 1] := by + decide +kernel + +/-- The operations, by kind. The parallel edge of weight `5` is read but relaxes nothing, the edge +`2 → 1` decreases the key of `1` from `4` to `3`, and the third extraction visits `1`, which has +no edges. The graph queries meet their bound `n + m = 7`. -/ +example : ((spec 3 15 16).clientHistory (init graph) (dijkstra graph.source)).map kind = + [.distance, .insert, + .extractMin, .graph, .graph, .distance, .distance, .insert, + .graph, .distance, .distance, .insert, .graph, .distance, + .extractMin, .graph, .graph, .distance, .distance, .decreaseKey, + .extractMin, .graph] ∧ + ((spec 3 15 16).clientHistory (init graph) (dijkstra graph.source)).countP + (kind · = .graph) = maxCount 3 4 .graph := by + decide +kernel + +/-- The correctness theorem applies to `graph`, and gives the distance `3` to vertex `1`. -/ +example : (spec 3 15 16).ValidHistory (init graph) + ((spec 3 15 16).clientHistory (init graph) (dijkstra graph.source)) ∧ + HasDistances graph ((spec 3 15 16).clientState (init graph) (dijkstra graph.source)) := + dijkstra_correct graph (by decide) (by decide) + +/-- Two vertices and no edge, from source `0`: vertex `1` stays unreached. -/ +def edgeless : ListInstance where + n := 2 + adj := ![[], []] + source := 0 + +/-- On `edgeless`, the second round finds the queue empty, and vertex `1` has no distance. -/ +example : let (q, dist, _) := (spec 2 0 1).clientState (init edgeless) (dijkstra edgeless.source) + q = IndexedMinPQ.empty 2 ∧ dist = ![some 0, none] := by + decide +kernel + +/-- Under binary-heap-style charges of `2` per queue operation, the cost theorem bounds the cost +on `graph` by `3 · 2 + 3 · 2 + 4 · 2 + 3 + 3 · 4 + 1 = 36`. -/ +example : (spec 3 15 16).CostHoare (charge fun _ _ => 2) (· = init graph) (dijkstra graph.source) + (fun _ => HasDistances graph) (fun _ => 36) := + (costHoare_dijkstra (K := 15) (V := 16) (cI := 2) (cE := 2) (cD := 2) graph (by decide) + (by decide) _ (fun _ _ _ => le_rfl) (fun _ => le_rfl) (fun _ _ _ => le_rfl)).consequence + (fun _ h => h) (fun _ _ h => h) fun _ _ => by decide + +/-- The asymptotic binary-heap-style bound applies to `graph` with charges of `2` per queue +operation, which is `⌊log₂ 3⌋ + 1`. -/ +example : ∃ b, (spec 3 15 16).CostHoare (charge fun _ _ => 2) (· = init graph) + (dijkstra graph.source) (fun _ => HasDistances graph) (fun _ => b) := by + obtain ⟨f, _, _, hf⟩ := exists_costHoare_logLinear 1 + exact ⟨_, hf graph 15 16 (by decide) (by decide) _ fun _ _ => by + rw [show Nat.log 2 graph.n = 1 from Nat.log_eq_of_pow_le_of_lt_pow (by decide) (by decide)]⟩ + +end DijkstraTests From b2ebc4a13da58654c6983c71e994a4def12ed1b5 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 18:18:25 -0500 Subject: [PATCH 13/20] feat(Algorithms/Lean/Dijkstra): count operations by edges as well as vertices Generalize the amortized run judgment to a potential with a per-unreached and a per-queued vertex part. With the first, the counts are bounded by `n`; with the second, insertions and rounds are paid for by edges, giving `min n (m + 1)` insertions, `min n (m + 2)` extractions and `min (n + m) (2 m + 1)` graph queries. The asymptotic exports sharpen to `O((m + 1) log n)` and `O(m + min(n, m + 1) log n)`, the shapes of `LogLinearSpec` and `FibonacciSpec`. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../Algorithms/Lean/Dijkstra/Client.lean | 229 +++++++++++------- Complexity/Algorithms/Lean/Dijkstra/Cost.lean | 72 +++--- ComplexityTests/Dijkstra.lean | 18 +- 3 files changed, 205 insertions(+), 114 deletions(-) diff --git a/Complexity/Algorithms/Lean/Dijkstra/Client.lean b/Complexity/Algorithms/Lean/Dijkstra/Client.lean index cafde60875..3ae1246a89 100644 --- a/Complexity/Algorithms/Lean/Dijkstra/Client.lean +++ b/Complexity/Algorithms/Lean/Dijkstra/Client.lean @@ -39,8 +39,10 @@ Running the client against the transition functions of the specifications `Cslib.Algorithms.WordRAM.Dijkstra.Instance.Inv` and on the relaxation of parallel edges `Cslib.Algorithms.WordRAM.Dijkstra.decode_edgesWord`, both used unchanged. The same induction counts the operations by kind (`Cslib.Algorithms.Lean.Dijkstra.countP_kind_dijkstra_le`): -at most `n` insertions and extractions, `m` key decreases, `2 m + 1` distance-map queries and -`n + m` graph queries. `Complexity.Algorithms.Lean.Dijkstra.Cost` turns the counts into costs. +at most `min n (m + 1)` insertions, `min n (m + 2)` extractions, `m` key decreases, `2 m + 1` +distance-map queries and `min (n + m) (2 m + 1)` graph queries. Only reached vertices are +inserted, and each insertion after the source's is caused by an edge, so the counts need not grow +with `n`. `Complexity.Algorithms.Lean.Dijkstra.Cost` turns the counts into costs. No statement here concerns a machine. The client's continuations are Lean functions, and their computation is not charged. @@ -182,7 +184,7 @@ def kind : (spec n K V).Op → OpKind section Proof -variable (rate : OpKind → ℕ) +variable (rate : OpKind → ℕ) {pU pQ : ℕ} /-- The total rate of a history. -/ private def weight (hist : List (spec n K V).Op) : ℕ := (hist.map fun o => rate (kind o)).sum @@ -191,14 +193,21 @@ private def weight (hist : List (spec n K V).Op) : ℕ := (hist.map fun o => rat private def unreached (dm : Dictionary.State n) : ℕ := (Finset.univ.filter fun v => dm v = none).card +/-- The potential of a state: `pU` per unreached vertex and `pQ` per queued vertex. -/ +private def pot (pU pQ : ℕ) (s : (spec n K V).State) : ℕ := + pU * unreached s.2.1 + pQ * (IndexedMinPQ.dom s.1).card + /-- A run of `p` from `s` is admissible, ends in `s'`, and has total rate at most `b`, amortized -against `rate .insert` per unreached vertex. -/ -private def Runs (s : (spec n K V).State) (p : (spec n K V).Client Unit) (s' : (spec n K V).State) - (b : ℕ) : Prop := +against the potential `pot pU pQ`. -/ +private def Runs (pU pQ : ℕ) (s : (spec n K V).State) (p : (spec n K V).Client Unit) + (s' : (spec n K V).State) (b : ℕ) : Prop := (spec n K V).ValidHistory s ((spec n K V).clientHistory s p) ∧ (spec n K V).clientState s p = s' ∧ - weight rate ((spec n K V).clientHistory s p) + rate .insert * unreached s'.2.1 ≤ - b + rate .insert * unreached s.2.1 + weight rate ((spec n K V).clientHistory s p) + pot pU pQ s' ≤ b + pot pU pQ s + +/-- The amortized rate of relaxing one edge. -/ +private def edgeRate (pU pQ : ℕ) : ℕ := + rate .graph + 2 * rate .distance + rate .decreaseKey + (rate .insert + pQ - pU) private theorem weight_append (xs ys : List (spec n K V).Op) : weight rate (xs ++ ys) = weight rate xs + weight rate ys := by @@ -221,8 +230,8 @@ private theorem runClient_bind' {α β : Type} (s : (spec n K V).State) (p : (sp StateTransitionSpec.runClient_bind p k s private theorem Runs.bind {s s₁ s₂ : (spec n K V).State} {p q : (spec n K V).Client Unit} - {b₁ b₂ : ℕ} (h₁ : Runs rate s p s₁ b₁) (h₂ : Runs rate s₁ q s₂ b₂) : - Runs rate s (p >>= fun _ => q) s₂ (b₁ + b₂) := by + {b₁ b₂ : ℕ} (h₁ : Runs rate pU pQ s p s₁ b₁) (h₂ : Runs rate pU pQ s₁ q s₂ b₂) : + Runs rate pU pQ s (p >>= fun _ => q) s₂ (b₁ + b₂) := by obtain ⟨hv₁, hs₁, hw₁⟩ := h₁ obtain ⟨hv₂, hs₂, hw₂⟩ := h₂ have hrun := runClient_bind' s p (fun _ => q) @@ -235,7 +244,7 @@ private theorem Runs.bind {s s₁ s₂ : (spec n K V).State} {p q : (spec n K V) · rw [StateTransitionSpec.clientHistory, hrun, weight_append] omega -private theorem Runs.pure (s : (spec n K V).State) : Runs rate s (pure ()) s 0 := by +private theorem Runs.pure (s : (spec n K V).State) : Runs rate pU pQ s (pure ()) s 0 := by refine ⟨trivial, rfl, ?_⟩ change weight rate [] + _ ≤ _ rw [weight_nil, Nat.zero_add] @@ -296,8 +305,8 @@ private theorem card_dom_lt {dm : Dictionary.State n} {v : Fin n} (hv : dm v = n private theorem Runs.of_runClient {s s' : (spec n K V).State} {p : (spec n K V).Client Unit} {hist : List (spec n K V).Op} {b : ℕ} (h : (spec n K V).runClient s p = ((), s', hist)) (hv : (spec n K V).ValidHistory s hist) - (hw : weight rate hist + rate .insert * unreached s'.2.1 ≤ b + rate .insert * unreached s.2.1) : - Runs rate s p s' b := by + (hw : weight rate hist + pot pU pQ s' ≤ b + pot pU pQ s) : + Runs rate pU pQ s p s' b := by refine ⟨?_, ?_, ?_⟩ · rwa [StateTransitionSpec.clientHistory, h] · rw [StateTransitionSpec.clientState, h] @@ -309,10 +318,9 @@ private theorem relaxEdge_runs (T : Finset (Fin n)) (dm : Dictionary.State n) (adj : AdjacencyList.State n) {u v : Fin n} {du c i : ℕ} (hi : i < (adj u).length) (hvc : (adj u)[i] = (v, c)) (hT : v ∈ T → ∃ dv, dm v = some dv ∧ dv ≤ du + c) (hK : du + c ≤ K) (hV : du + c < V) : - Runs rate (syncQ T dm, dm, adj) (relaxEdge (K := K) (V := V) u du i) - (syncQ T (Function.update dm v (relaxOpt (du + c) (dm v))), - Function.update dm v (relaxOpt (du + c) (dm v)), adj) - (rate .graph + 2 * rate .distance + rate .decreaseKey) := by + Runs rate pU pQ (syncQ T dm, dm, adj) (relaxEdge (K := K) (V := V) u du i) + (syncQ T (Function.update dm v (relaxOpt (du + c) (dm v))), + Function.update dm v (relaxOpt (du + c) (dm v)), adj) (edgeRate rate pU pQ) := by rcases hdm : dm v with _ | dv · have hvT : v ∉ T := fun h => by obtain ⟨dv, h1, _⟩ := hT h; simp [hdm] at h1 have hrun : (spec n K V).runClient (syncQ T dm, dm, adj) (relaxEdge u du i) = @@ -322,13 +330,20 @@ private theorem relaxEdge_runs (T : Finset (Fin n)) (dm : Dictionary.State n) simp only [relaxEdge, StateTransitionSpec.runClient_lift_bind', StateTransitionSpec.stepFn, AdjacencyList.step_edge _ _ hi, hvc, hdm, IndexedMinPQ.step, StateTransitionSpec.runClient_lift] + have hq : (IndexedMinPQ.dom (syncQ T (Function.update dm v (some (du + c))))).card = + (IndexedMinPQ.dom (syncQ T dm)).card + 1 := by + rw [← syncQ_update hvT, IndexedMinPQ.dom_insert, Finset.card_insert_of_notMem] + simp [syncQ, hvT, hdm] rw [syncQ_update hvT] at hrun refine Runs.of_runClient rate hrun ?_ ?_ · simp [StateTransitionSpec.validHistory_cons, AdjacencyList.valid, Dictionary.valid, IndexedMinPQ.valid, hi, hvc, hdm, card_dom_lt hdm, hV, hK, syncQ, hvT] · have := unreached_update_of_none hdm (du + c) - rw [weight_cons, weight_cons, weight_cons, weight_cons, weight_nil, ← this, Nat.mul_succ] - dsimp only [kind, relaxOpt] + dsimp only [relaxOpt] + rw [weight_cons, weight_cons, weight_cons, weight_cons, weight_nil, pot, pot] + dsimp only + rw [hq, ← this, Nat.mul_succ, Nat.mul_succ] + dsimp only [kind, edgeRate] omega · by_cases hlt : du + c < dv · have hvT : v ∉ T := fun h => by @@ -343,6 +358,10 @@ private theorem relaxEdge_runs (T : Finset (Fin n)) (dm : Dictionary.State n) simp only [relaxEdge, StateTransitionSpec.runClient_lift_bind', StateTransitionSpec.stepFn, AdjacencyList.step_edge _ _ hi, hvc, hdm, IndexedMinPQ.step, StateTransitionSpec.runClient_lift, hlt, ite_true] + have hq : (IndexedMinPQ.dom (syncQ T (Function.update dm v (some (du + c))))).card = + (IndexedMinPQ.dom (syncQ T dm)).card := by + rw [← syncQ_update hvT, IndexedMinPQ.dom_decreaseKey] + exact IndexedMinPQ.mem_dom_iff.mpr ⟨dv, by simp [syncQ, hvT, hdm]⟩ rw [syncQ_update hvT] at hrun have hmin : relaxOpt (du + c) (some dv) = some (du + c) := by simp only [relaxOpt, Option.some_inj] @@ -351,9 +370,10 @@ private theorem relaxEdge_runs (T : Finset (Fin n)) (dm : Dictionary.State n) refine Runs.of_runClient rate hrun ?_ ?_ · simp [StateTransitionSpec.validHistory_cons, AdjacencyList.valid, Dictionary.valid, IndexedMinPQ.valid, hi, hvc, hdm, hV, hK, syncQ, hvT, hlt.le] - · rw [weight_cons, weight_cons, weight_cons, weight_cons, weight_nil, - unreached_update_of_some hdm] - dsimp only [kind] + · rw [weight_cons, weight_cons, weight_cons, weight_cons, weight_nil, pot, pot] + dsimp only + rw [hq, unreached_update_of_some hdm] + dsimp only [kind, edgeRate] omega · have hrun : (spec n K V).runClient (syncQ T dm, dm, adj) (relaxEdge u du i) = ((), (syncQ T dm, dm, adj), [.inr (.inr (.edge u i)), .inr (.inl (.get v))]) := by @@ -366,19 +386,19 @@ private theorem relaxEdge_runs (T : Finset (Fin n)) (dm : Dictionary.State n) refine Runs.of_runClient rate hrun ?_ ?_ · simp [StateTransitionSpec.validHistory_cons, AdjacencyList.valid, hi] · rw [weight_cons, weight_cons, weight_nil] - dsimp only [kind] + dsimp only [kind, edgeRate] omega private theorem Runs.mono {s s' : (spec n K V).State} {p : (spec n K V).Client Unit} {b b' : ℕ} - (h : Runs rate s p s' b) (hb : b ≤ b') : Runs rate s p s' b' := + (h : Runs rate pU pQ s p s' b) (hb : b ≤ b') : Runs rate pU pQ s p s' b' := ⟨h.1, h.2.1, by have := h.2.2; omega⟩ -/-- A call that leaves the distance map alone, followed by a continuation. -/ +/-- A call followed by a continuation. -/ private theorem Runs.lift_bind {s s' : (spec n K V).State} (o : (spec n K V).Op) - {k : (spec n K V).Result o → (spec n K V).Client Unit} {b : ℕ} (hv : (spec n K V).valid s o) - (hdm : ((spec n K V).stepFn s o).1.2.1 = s.2.1) - (h : Runs rate ((spec n K V).stepFn s o).1 (k ((spec n K V).stepFn s o).2) s' b) : - Runs rate s (PFunctor.FreeM.lift o >>= k) s' (rate (kind o) + b) := by + {k : (spec n K V).Result o → (spec n K V).Client Unit} {b B : ℕ} (hv : (spec n K V).valid s o) + (h : Runs rate pU pQ ((spec n K V).stepFn s o).1 (k ((spec n K V).stepFn s o).2) s' b) + (hB : rate (kind o) + pot pU pQ ((spec n K V).stepFn s o).1 + b ≤ B + pot pU pQ s) : + Runs rate pU pQ s (PFunctor.FreeM.lift o >>= k) s' B := by obtain ⟨hv', hs', hw'⟩ := h refine ⟨?_, ?_, ?_⟩ · simp only [StateTransitionSpec.clientHistory, StateTransitionSpec.runClient_lift_bind', @@ -387,10 +407,17 @@ private theorem Runs.lift_bind {s s' : (spec n K V).State} (o : (spec n K V).Op) · simpa only [StateTransitionSpec.clientState, StateTransitionSpec.runClient_lift_bind'] using hs' · simp only [StateTransitionSpec.clientHistory, StateTransitionSpec.runClient_lift_bind'] rw [weight_cons] - rw [hdm] at hw' simp only [StateTransitionSpec.clientHistory] at hw' omega +/-- A call that leaves the state alone, followed by a continuation. -/ +private theorem Runs.lift_bind_of_eq {s s' : (spec n K V).State} (o : (spec n K V).Op) + {k : (spec n K V).Result o → (spec n K V).Client Unit} {b : ℕ} (hv : (spec n K V).valid s o) + (hs : ((spec n K V).stepFn s o).1 = s) + (h : Runs rate pU pQ ((spec n K V).stepFn s o).1 (k ((spec n K V).stepFn s o).2) s' b) : + Runs rate pU pQ s (PFunctor.FreeM.lift o >>= k) s' (rate (kind o) + b) := + Runs.lift_bind rate o hv h (by rw [hs]; omega) + /-- The effect of relaxing the edges `es` out of a vertex at distance `du` on the distance map. -/ private def scanMap (du : ℕ) (es : List (Fin n × ℕ)) (dm : Dictionary.State n) : Dictionary.State n := @@ -424,11 +451,12 @@ per edge, amortized. -/ private theorem forM_relaxEdge_runs (T : Finset (Fin n)) (dm : Dictionary.State n) (adj : AdjacencyList.State n) (u : Fin n) (du : ℕ) (hset : ∀ v c, (v, c) ∈ adj u → v ∈ T → ∃ dv, dm v = some dv ∧ dv ≤ du + c) - (hbound : ∀ v c, (v, c) ∈ adj u → du + c ≤ K ∧ du + c < V) {k : ℕ} (hk : k ≤ (adj u).length) : - Runs rate (syncQ T dm, dm, adj) + (hbound : ∀ v c, (v, c) ∈ adj u → du + c ≤ K ∧ du + c < V) {k : ℕ} + (hk : k ≤ (adj u).length) : + Runs rate pU pQ (syncQ T dm, dm, adj) ((List.range k).forM (relaxEdge (K := K) (V := V) u du)) (syncQ T (scanMap du ((adj u).take k) dm), scanMap du ((adj u).take k) dm, adj) - (k * (rate .graph + 2 * rate .distance + rate .decreaseKey)) := by + (k * edgeRate rate pU pQ) := by induction k with | zero => simpa [scanMap] using Runs.pure rate (syncQ T dm, dm, adj) | succ k ih => @@ -446,9 +474,9 @@ private theorem forM_relaxEdge_runs (T : Finset (Fin n)) (dm : Dictionary.State rw [hdv, Option.some_inj] at hdv' exact hdv' ▸ hle' have hedge := relaxEdge_runs rate T (scanMap du ((adj u).take k) dm) adj hk' hvc hT - (hbound v c hmem).1 (hbound v c hmem).2 + (hbound v c hmem).1 (hbound v c hmem).2 (pU := pU) (pQ := pQ) rw [List.range_succ] - change Runs rate _ (forM (List.range k ++ [k]) (relaxEdge u du)) _ _ + change Runs rate pU pQ _ (forM (List.range k ++ [k]) (relaxEdge u du)) _ _ rw [List.forM_append, List.forM_cons, List.forM_nil, htake, scanMap_append_singleton] exact ((ih hk'.le).bind rate (hedge.bind rate (Runs.pure rate _))).mono rate (Nat.le_of_eq (by ring)) @@ -458,12 +486,13 @@ private theorem scan_runs (T : Finset (Fin n)) (dm : Dictionary.State n) (adj : AdjacencyList.State n) (u : Fin n) (du : ℕ) (hset : ∀ v c, (v, c) ∈ adj u → v ∈ T → ∃ dv, dm v = some dv ∧ dv ≤ du + c) (hbound : ∀ v c, (v, c) ∈ adj u → du + c ≤ K ∧ du + c < V) : - Runs rate (syncQ T dm, dm, adj) (scan (K := K) (V := V) u du) + Runs rate pU pQ (syncQ T dm, dm, adj) (scan (K := K) (V := V) u du) (syncQ T (scanMap du (adj u) dm), scanMap du (adj u) dm, adj) - (rate .graph + (adj u).length * (rate .graph + 2 * rate .distance + rate .decreaseKey)) := by - have h := forM_relaxEdge_runs rate T dm adj u du hset hbound (k := (adj u).length) le_rfl + (rate .graph + (adj u).length * edgeRate rate pU pQ) := by + have h := forM_relaxEdge_runs rate T dm adj u du hset hbound (pU := pU) (pQ := pQ) + (k := (adj u).length) le_rfl rw [List.take_length] at h - exact Runs.lift_bind rate (.inr (.inr (.degree u))) trivial rfl h + exact Runs.lift_bind_of_eq rate (.inr (.inr (.degree u))) trivial rfl h /-! ### Tentative distances -/ @@ -611,17 +640,17 @@ private theorem Good.visit {G : ListInstance} {T : Finset (Fin G.n)} {dm : Dicti exact ⟨huT, hset, hbound, hgood'⟩ /-- **The main loop.** From a state satisfying the invariant with visited set `T`, enough rounds -leave an empty queue and the distances in the distance map, at rate `rate .extractMin + -rate .graph` per round and `rate .graph + 2 * rate .distance + rate .decreaseKey` per edge out of -an unvisited vertex, amortized. -/ +leave an empty queue and the distances in the distance map, at amortized rate +`rate .extractMin + rate .graph - pQ` per round and `edgeRate rate pU pQ` per edge out of an +unvisited vertex, with `pQ - rate .graph` for a final extraction from an empty queue. -/ private theorem loop_runs (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) (hV : G.n * G.maxWeight < V) (k : ℕ) : ∀ (T : Finset (Fin G.n)) (dm : Dictionary.State G.n), Good G T dm → G.n - T.card ≤ k → ∃ dist, (∀ v, tentative dist v = G.dist G.source v) ∧ - Runs rate (syncQ T dm, dm, G.adj) (loop (K := K) (V := V) k) + Runs rate pU pQ (syncQ T dm, dm, G.adj) (loop (K := K) (V := V) k) (IndexedMinPQ.empty G.n, dist, G.adj) - (k * (rate .extractMin + rate .graph) + (∑ v ∈ Tᶜ, (G.adj v).length) * - (rate .graph + 2 * rate .distance + rate .decreaseKey)) := by + (k * (rate .extractMin + rate .graph - pQ) + (pQ - rate .graph) + + (∑ v ∈ Tᶜ, (G.adj v).length) * edgeRate rate pU pQ) := by induction k with | zero => intro T dm hgood hk @@ -648,11 +677,11 @@ private theorem loop_runs (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) have hdone : ∀ v ∉ T, tentative dm v = ⊤ := fun v hv => tentative_of_none (by simpa [syncQ, hv] using hq v) refine ⟨dm, WordRAM.Dijkstra.Instance.Inv.eq_dist _ hgood.inv hdone, ?_⟩ - refine (Runs.lift_bind rate (b := 0) (.inl .extractMin) trivial rfl ?_).mono rate ?_ + refine Runs.lift_bind rate (b := 0) (.inl .extractMin) trivial ?_ ?_ · simp only [IndexedMinPQ.step, hf] rw [hempty] exact Runs.pure rate _ - · dsimp only [kind] + · simp only [IndexedMinPQ.step, hf, kind] rw [add_one_mul] omega · -- Visit `u`, an unvisited vertex of least tentative distance `du`. @@ -666,31 +695,41 @@ private theorem loop_runs (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) · subst hv simp [syncQ] · simp [syncQ, hv] - refine (Runs.lift_bind rate (.inl .extractMin) trivial rfl - (b := rate .graph + (G.adj u).length * - (rate .graph + 2 * rate .distance + rate .decreaseKey) + - (k * (rate .extractMin + rate .graph) + (∑ v ∈ (insert u T)ᶜ, (G.adj v).length) * - (rate .graph + 2 * rate .distance + rate .decreaseKey))) ?_).mono rate ?_ + have hcard : (IndexedMinPQ.dom (syncQ (insert u T) dm)).card + 1 = + (IndexedMinPQ.dom (syncQ T dm)).card := by + rw [← hsync, IndexedMinPQ.dom_erase_update] + exact Finset.card_erase_add_one (IndexedMinPQ.findMin_mem_dom hf) + refine Runs.lift_bind rate (.inl .extractMin) trivial + (b := rate .graph + (G.adj u).length * edgeRate rate pU pQ + + (k * (rate .extractMin + rate .graph - pQ) + (pQ - rate .graph) + + (∑ v ∈ (insert u T)ᶜ, (G.adj v).length) * edgeRate rate pU pQ)) ?_ ?_ · simp only [IndexedMinPQ.step, hf] rw [hsync] exact (scan_runs rate (insert u T) dm G.adj u du hset hbound).bind rate hrest - · have hsum : (G.adj u).length + ∑ v ∈ (insert u T)ᶜ, (G.adj v).length = - ∑ v ∈ Tᶜ, (G.adj v).length := by - rw [Finset.compl_insert] - exact Finset.add_sum_erase Tᶜ (fun v => (G.adj v).length) (Finset.mem_compl.mpr huT) - rw [← hsum] - dsimp only [kind] - nlinarith + · have hsum : (∑ v ∈ Tᶜ, (G.adj v).length) * edgeRate rate pU pQ = + (G.adj u).length * edgeRate rate pU pQ + + (∑ v ∈ (insert u T)ᶜ, (G.adj v).length) * edgeRate rate pU pQ := by + rw [← add_mul, Finset.compl_insert] + rw [Finset.add_sum_erase Tᶜ (fun v => (G.adj v).length) (Finset.mem_compl.mpr huT)] + have hpot : pot (K := K) (V := V) pU pQ (syncQ T dm, dm, G.adj) = + pot (K := K) (V := V) pU pQ (syncQ (insert u T) dm, dm, G.adj) + pQ := by + simp only [pot] + rw [← hcard, Nat.mul_succ] + omega + simp only [IndexedMinPQ.step, hf, kind] + rw [hsync, hsum, hpot, add_one_mul] + omega /-- **The whole run.** From the initial state, Dijkstra's algorithm leaves an empty queue and the distances in the distance map. -/ private theorem dijkstra_runs (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) (hV : G.n * G.maxWeight < V) : ∃ dist, (∀ v, tentative dist v = G.dist G.source v) ∧ - Runs rate (init G) (dijkstra (K := K) (V := V) G.source) + Runs rate pU pQ (init G) (dijkstra (K := K) (V := V) G.source) (IndexedMinPQ.empty G.n, dist, G.adj) - (rate .distance + G.n * (rate .extractMin + rate .graph) + - G.m * (rate .graph + 2 * rate .distance + rate .decreaseKey)) := by + (rate .distance + (rate .insert + pQ - pU) + + (G.n * (rate .extractMin + rate .graph - pQ) + (pQ - rate .graph) + + G.m * edgeRate rate pU pQ)) := by have hn : 0 < G.n := G.source.pos set dm₀ := Function.update (Dictionary.empty G.n) G.source (some 0) with hdm₀ have htent : tentative dm₀ = Function.update (fun _ => ⊤) G.source 0 := by @@ -730,11 +769,18 @@ private theorem dijkstra_runs (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) refine ⟨⟨Or.inl ?_, by omega⟩, ⟨rfl, Nat.zero_le K⟩, ?_⟩ · simp [Dictionary.dom, Dictionary.empty, init, hn] · simpa only [StateTransitionSpec.stepFn, IndexedMinPQ.step, hq₀, init] using hv - · rw [weight_append, weight_cons, weight_cons, weight_nil] - simp only [hsum] at hw - dsimp only [kind, init] - rw [hunr₀] at hunr - nlinarith + · have hpot₀ : pot pU pQ (init (K := K) (V := V) G) = pU * (unreached dm₀ + 1) := by + simp [pot, init, hunr, IndexedMinPQ.dom_empty] + have hpot₁ : pot (K := K) (V := V) pU pQ (syncQ ∅ dm₀, dm₀, G.adj) = + pU * unreached dm₀ + pQ := by + simp only [pot] + rw [← hq₀, IndexedMinPQ.dom_insert, IndexedMinPQ.dom_empty] + simp + rw [weight_append, weight_cons, weight_cons, weight_nil, hpot₀] + rw [hsum, hpot₁] at hw + dsimp only [kind] + rw [Nat.mul_succ] + omega end Proof @@ -756,7 +802,7 @@ theorem dijkstra_correct (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) (spec G.n K V).ValidHistory (init G) ((spec G.n K V).clientHistory (init G) (dijkstra G.source)) ∧ HasDistances G ((spec G.n K V).clientState (init G) (dijkstra G.source)) := by - obtain ⟨dist, hdist, hv, hs, _⟩ := dijkstra_runs (fun _ => 0) G hK hV + obtain ⟨dist, hdist, hv, hs, _⟩ := dijkstra_runs (fun _ => 0) (pU := 0) (pQ := 0) G hK hV refine ⟨hv, dist, hs, fun v d => ?_⟩ rw [← hdist v] rcases h : dist v with _ | d' @@ -766,11 +812,14 @@ theorem dijkstra_correct (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) /-! ### Operation counts -/ /-- The total rate of the operations Dijkstra's algorithm issues on a graph with `n` vertices and -`m` edges, at most: `n` insertions, `n` extractions, `m` key decreases, `2 m + 1` distance-map -queries and `n + m` graph queries. -/ +`m` edges, at most. It is the lesser of two bounds: at most `n` insertions and extractions, and +`n + m` graph queries; or at most `m + 1` insertions, `m + 2` extractions and `2 m + 1` graph +queries. Both allow `m` key decreases and `2 m + 1` distance-map queries. -/ def rateBound (rate : OpKind → ℕ) (n m : ℕ) : ℕ := - n * rate .insert + n * rate .extractMin + m * rate .decreaseKey + - (2 * m + 1) * rate .distance + (n + m) * rate .graph + min (n * rate .insert + n * rate .extractMin + m * rate .decreaseKey + + (2 * m + 1) * rate .distance + (n + m) * rate .graph) + ((m + 1) * rate .insert + (m + 2) * rate .extractMin + m * rate .decreaseKey + + (2 * m + 1) * rate .distance + (2 * m + 1) * rate .graph) /-- **Operations, weighted.** Under any rate per kind of operation, the operations Dijkstra's algorithm issues have total rate at most `rateBound rate n m`. -/ @@ -778,27 +827,39 @@ theorem sum_rate_dijkstra_le (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) (hV : G.n * G.maxWeight < V) (rate : OpKind → ℕ) : (((spec G.n K V).clientHistory (init G) (dijkstra G.source)).map fun o => rate (kind o)).sum ≤ rateBound rate G.n G.m := by - obtain ⟨dist, _, _, _, hw⟩ := dijkstra_runs rate G hK hV - have hn : unreached (init (K := K) (V := V) G).2.1 = G.n := by - simp [unreached, init, Dictionary.empty] - rw [hn] at hw change weight rate _ ≤ _ - unfold rateBound - nlinarith [Nat.zero_le (rate .insert * unreached dist)] + refine le_min ?_ ?_ + · obtain ⟨dist, _, _, _, hw⟩ := + dijkstra_runs rate (pU := rate .insert) (pQ := 0) G hK hV + have hpot : pot (rate .insert) 0 (init (K := K) (V := V) G) = rate .insert * G.n := by + simp [pot, unreached, init, Dictionary.empty, IndexedMinPQ.dom_empty] + rw [hpot] at hw + simp only [edgeRate, Nat.add_zero, Nat.sub_self, Nat.sub_zero, Nat.zero_sub] at hw + nlinarith [Nat.zero_le (pot (K := K) (V := V) (rate .insert) 0 + (IndexedMinPQ.empty G.n, dist, G.adj))] + · obtain ⟨dist, _, _, _, hw⟩ := + dijkstra_runs rate (pU := 0) (pQ := rate .extractMin + rate .graph) G hK hV + have hpot : pot 0 (rate .extractMin + rate .graph) (init (K := K) (V := V) G) = 0 := by + simp [pot, init, IndexedMinPQ.dom_empty] + rw [hpot] at hw + simp only [edgeRate, Nat.sub_zero, Nat.sub_self, Nat.add_sub_cancel, mul_zero, + Nat.add_zero, Nat.zero_add] at hw + nlinarith [Nat.zero_le (pot (K := K) (V := V) 0 (rate .extractMin + rate .graph) + (IndexedMinPQ.empty G.n, dist, G.adj))] /-- The number of operations of each kind that Dijkstra's algorithm issues on a graph with `n` vertices and `m` edges, at most. -/ def maxCount (n m : ℕ) : OpKind → ℕ - | .insert => n - | .extractMin => n + | .insert => min n (m + 1) + | .extractMin => min n (m + 2) | .decreaseKey => m | .inspect => 0 | .distance => 2 * m + 1 - | .graph => n + m + | .graph => min (n + m) (2 * m + 1) -/-- **Operation counts.** Dijkstra's algorithm issues at most `n` insertions, `n` extractions and -`m` key decreases, never inspects the queue, and issues at most `2 m + 1` distance-map queries -and `n + m` graph queries. -/ +/-- **Operation counts.** Dijkstra's algorithm issues at most `min n (m + 1)` insertions, +`min n (m + 2)` extractions and `m` key decreases, never inspects the queue, and issues at most +`2 m + 1` distance-map queries and `min (n + m) (2 m + 1)` graph queries. -/ theorem countP_kind_dijkstra_le (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) (hV : G.n * G.maxWeight < V) (k : OpKind) : ((spec G.n K V).clientHistory (init G) (dijkstra G.source)).countP (kind · = k) ≤ diff --git a/Complexity/Algorithms/Lean/Dijkstra/Cost.lean b/Complexity/Algorithms/Lean/Dijkstra/Cost.lean index ceea564bb2..fb3d938357 100644 --- a/Complexity/Algorithms/Lean/Dijkstra/Cost.lean +++ b/Complexity/Algorithms/Lean/Dijkstra/Cost.lean @@ -21,7 +21,8 @@ operation costs what an implementation charges for it, possibly amortized, and a graph query costs one unit (`Cslib.Algorithms.Lean.Dijkstra.charge`). The operation counts of the client do not depend on the implementation. So when insertions, extractions and key decreases are charged at most `cI`, `cE` and `cD`, the algorithm costs at most `n cI + n cE + m cD + n + 3 m + 1` -on a graph with `n` vertices and `m` edges (`Cslib.Algorithms.Lean.Dijkstra.costHoare_dijkstra`). +and at most `(m + 1) cI + (m + 2) cE + m cD + 4 m + 2` on a graph with `n` vertices and `m` edges +(`Cslib.Algorithms.Lean.Dijkstra.costHoare_dijkstra`). The same budget holds on any lower interface that implements the three interfaces with bounded per-method charges (`Cslib.Algorithms.Lean.Dijkstra.costHoare_link_dijkstra`, through `Cslib.DataStructure.Module.ChargeBound` and @@ -29,12 +30,15 @@ per-method charges (`Cslib.Algorithms.Lean.Dijkstra.costHoare_link_dijkstra`, th Two instantiations with abstract charges give the textbook bounds: -* `O((n + m) log n)` when every queue operation costs `O(log n)`, as in a binary heap - [CLRS2009] (`Cslib.Algorithms.Lean.Dijkstra.exists_costHoare_logLinear`); -* `O(m + n log n)` when insertions and key decreases cost amortized `O(1)` and extractions - `O(log n)`, as in a Fibonacci heap [FredmanTarjan1987] +* `O((m + 1) log n)`, hence `O((n + m) log n)`, when every queue operation costs `O(log n)`, as + in a binary heap [CLRS2009] (`Cslib.Algorithms.Lean.Dijkstra.exists_costHoare_logLinear`); +* `O(m + min(n, m + 1) log n)`, hence `O(m + n log n)`, when insertions and key decreases cost + amortized `O(1)` and extractions `O(log n)`, as in a Fibonacci heap [FredmanTarjan1987] (`Cslib.Algorithms.Lean.Dijkstra.exists_costHoare_linearithmic`). +These are the shapes of the word-RAM statements `Cslib.Algorithms.WordRAM.Dijkstra.LogLinearSpec` +and `Cslib.Algorithms.WordRAM.Dijkstra.FibonacciSpec`, at the level of operations. + Each states `∃ f` with `f` monotone and `f = O(g)` (Mathlib's `Asymptotics.IsBigO`) along the filter `Filter.comap Prod.fst Filter.atTop` on `(n, m)`: for all large `n`, uniformly in `m`. @@ -100,14 +104,16 @@ theorem totalCost_dijkstra_le (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) exact h o ho hk /-- The operation-level budget of Dijkstra's algorithm when insertions cost `cI`, extractions `cE` -and key decreases `cD` each, and every other query one unit. -/ +and key decreases `cD` each, and every other query one unit: `rateBound` at these rates. -/ def budget (cI cE cD n m : ℕ) : ℕ := - n * cI + n * cE + m * cD + (n + 3 * m + 1) + min (n * cI + n * cE + m * cD + (n + 3 * m + 1)) + ((m + 1) * cI + (m + 2) * cE + m * cD + (4 * m + 2)) /-- **Dijkstra's algorithm against any priority queue.** Charge each queue operation what a priority-queue implementation charges for it, at most `cI` per insertion, `cE` per extraction and `cD` per key decrease, and one unit per distance-map or graph query. Then Dijkstra's algorithm is -correct, and its total charge is at most `n cI + n cE + m cD + n + 3 m + 1`. -/ +correct, and its total charge is at most `n cI + n cE + m cD + n + 3 m + 1`, and at most +`(m + 1) cI + (m + 2) cE + m cD + 4 m + 2`. -/ theorem costHoare_dijkstra (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) (hV : G.n * G.maxWeight < V) (pqCharge : IndexedMinPQ.State G.n → IndexedMinPQ.Op G.n → ℕ) {cI cE cD : ℕ} (hI : ∀ q v k, pqCharge q (.insert v k) ≤ cI) @@ -137,7 +143,7 @@ theorem costHoare_dijkstra (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) · exact le_rfl · exact le_rfl · simp only [rateBound, budget, rate] - ring + congr 1 <;> ring /-- **Through any implementation of the interfaces.** Let a module `M` implement the interfaces of Dijkstra's algorithm over a lower interface `E`, with each method body costing at most @@ -162,7 +168,7 @@ theorem budget_mono {cI cE cD cI' cE' cD' n m n' m' : ℕ} (hI : cI ≤ cI') (hE : cE ≤ cE') (hD : cD ≤ cD') (hn : n ≤ n') (hm : m ≤ m') : budget cI cE cD n m ≤ budget cI' cE' cD' n' m' := by unfold budget - gcongr + exact min_le_min (by gcongr) (by gcongr) /-- The budget under charges growing with `n` is `O(g)` over large `n`, uniformly in `m`, when it is at most `c g (n, m)` for `n ≥ 2`. -/ @@ -179,13 +185,14 @@ private theorem isBigO_budget (cI cE cD : ℕ → ℕ) {g : ℕ × ℕ → ℕ} simp only [Real.norm_natCast] exact_mod_cast h n m hb -/-- **Binary-heap-style charges: `O((n + m) log n)`.** If every queue operation is charged at +/-- **Binary-heap-style charges: `O((m + 1) log n)`.** If every queue operation is charged at most `C (⌊log₂ n⌋ + 1)`, as for a binary heap, Dijkstra's algorithm is correct and costs -`f (n, m)` for a monotone `f = O((n + m) log n)`, as `n` grows, uniformly in `m`. -/ +`f (n, m)` for a monotone `f = O((m + 1) log n)`, as `n` grows, uniformly in `m`. Since +`m + 1 ≤ n + m`, this is also `O((n + m) log n)`. -/ theorem exists_costHoare_logLinear (C : ℕ) : ∃ f : ℕ × ℕ → ℕ, Monotone f ∧ (fun p => (f p : ℝ)) =O[Filter.comap Prod.fst Filter.atTop] - (fun ((n, m) : ℕ × ℕ) => ((n + m) * Nat.log 2 n : ℝ)) ∧ + (fun ((n, m) : ℕ × ℕ) => ((m + 1) * Nat.log 2 n : ℝ)) ∧ ∀ (G : ListInstance) (K V : ℕ), G.n * G.maxWeight ≤ K → G.n * G.maxWeight < V → ∀ pqCharge : IndexedMinPQ.State G.n → IndexedMinPQ.Op G.n → ℕ, (∀ q o, pqCharge q o ≤ C * (Nat.log 2 G.n + 1)) → @@ -197,27 +204,29 @@ theorem exists_costHoare_logLinear (C : ℕ) : have hc : c n ≤ c n' := Nat.mul_le_mul_left C (Nat.add_le_add_right (Nat.log_mono_right hn) 1) exact budget_mono hc hc hc hn hm - · have := isBigO_budget c c c (g := fun (n, m) => (n + m) * Nat.log 2 n) (4 * C + 5) + · have := isBigO_budget c c c (g := fun (n, m) => (m + 1) * Nat.log 2 n) (8 * C + 6) fun n m hn => by have hL : 1 ≤ Nat.log 2 n := Nat.le_log_of_pow_le (by norm_num) (by simpa using hn) - simp only [budget, c] + refine (min_le_right _ _).trans ?_ + simp only [c] generalize Nat.log 2 n = L at hL ⊢ have hC := Nat.le_mul_of_pos_right C hL - nlinarith [Nat.mul_le_mul_left n hC, Nat.mul_le_mul_left m hC, - Nat.le_mul_of_pos_right n hL, Nat.le_mul_of_pos_right m hL] - simpa only [Nat.cast_mul, Nat.cast_add] using this + nlinarith [Nat.mul_le_mul_left (m + 1) hC, Nat.mul_le_mul_left (m + 2) hC, + Nat.mul_le_mul_left m hC, Nat.le_mul_of_pos_right (m + 1) hL] + simpa only [Nat.cast_mul, Nat.cast_add, Nat.cast_one] using this · intro G K V hK hV pqCharge h exact costHoare_dijkstra G hK hV pqCharge (fun q _ _ => h q _) (fun q => h q _) (fun q _ _ => h q _) -/-- **Fibonacci-heap-style charges: `O(m + n log n)`.** If insertions and key decreases are -charged at most `C` and extractions at most `C (⌊log₂ n⌋ + 1)`, as amortized charges of a -Fibonacci heap, Dijkstra's algorithm is correct and costs `f (n, m)` for a monotone -`f = O(m + n log n)`, as `n` grows, uniformly in `m`. -/ +/-- **Fibonacci-heap-style charges: `O(m + min(n, m + 1) log n)`.** If insertions and key +decreases are charged at most `C` and extractions at most `C (⌊log₂ n⌋ + 1)`, as amortized +charges of a Fibonacci heap, Dijkstra's algorithm is correct and costs `f (n, m)` for a monotone +`f = O(m + min(n, m + 1) log n)`, as `n` grows, uniformly in `m`. This is also +`O(m + n log n)`. -/ theorem exists_costHoare_linearithmic (C : ℕ) : ∃ f : ℕ × ℕ → ℕ, Monotone f ∧ (fun p => (f p : ℝ)) =O[Filter.comap Prod.fst Filter.atTop] - (fun ((n, m) : ℕ × ℕ) => (m + n * Nat.log 2 n : ℝ)) ∧ + (fun ((n, m) : ℕ × ℕ) => (m + min (n : ℝ) (m + 1) * Nat.log 2 n : ℝ)) ∧ ∀ (G : ListInstance) (K V : ℕ), G.n * G.maxWeight ≤ K → G.n * G.maxWeight < V → ∀ pqCharge : IndexedMinPQ.State G.n → IndexedMinPQ.Op G.n → ℕ, (∀ q v k, pqCharge q (.insert v k) ≤ C) → @@ -231,14 +240,21 @@ theorem exists_costHoare_linearithmic (C : ℕ) : have hc : c n ≤ c n' := Nat.mul_le_mul_left C (Nat.add_le_add_right (Nat.log_mono_right hn) 1) exact budget_mono le_rfl hc le_rfl hn hm - · have := isBigO_budget (fun _ => C) c (fun _ => C) (g := fun (n, m) => m + n * Nat.log 2 n) - (3 * C + 5) fun n m hn => by + · have := isBigO_budget (fun _ => C) c (fun _ => C) + (g := fun (n, m) => m + min n (m + 1) * Nat.log 2 n) (5 * C + 6) fun n m hn => by have hL : 1 ≤ Nat.log 2 n := Nat.le_log_of_pow_le (by norm_num) (by simpa using hn) - simp only [budget, c] + simp only [c] generalize Nat.log 2 n = L at hL ⊢ have hC := Nat.le_mul_of_pos_right C hL - nlinarith [Nat.mul_le_mul_left n hC, Nat.le_mul_of_pos_right n hL] - simpa only [Nat.cast_mul, Nat.cast_add] using this + rcases le_total n (m + 1) with h | h + · rw [min_eq_left h] + refine (min_le_left _ _).trans ?_ + nlinarith [Nat.mul_le_mul_left n hC, Nat.le_mul_of_pos_right n hL] + · rw [min_eq_right h] + refine (min_le_right _ _).trans ?_ + nlinarith [Nat.mul_le_mul_left (m + 1) hC, Nat.mul_le_mul_left (m + 2) hC, + Nat.le_mul_of_pos_right (m + 1) hL] + simpa only [Nat.cast_mul, Nat.cast_add, Nat.cast_min, Nat.cast_one] using this · intro G K V hK hV pqCharge hI hE hD exact costHoare_dijkstra G hK hV pqCharge hI hE hD diff --git a/ComplexityTests/Dijkstra.lean b/ComplexityTests/Dijkstra.lean index ecf6a621ad..175cbe339c 100644 --- a/ComplexityTests/Dijkstra.lean +++ b/ComplexityTests/Dijkstra.lean @@ -40,7 +40,7 @@ example : let (q, dist, _) := (spec 3 15 16).clientState (init graph) (dijkstra /-- The operations, by kind. The parallel edge of weight `5` is read but relaxes nothing, the edge `2 → 1` decreases the key of `1` from `4` to `3`, and the third extraction visits `1`, which has -no edges. The graph queries meet their bound `n + m = 7`. -/ +no edges. The graph queries meet their bound `min (n + m) (2 m + 1) = 7`. -/ example : ((spec 3 15 16).clientHistory (init graph) (dijkstra graph.source)).map kind = [.distance, .insert, .extractMin, .graph, .graph, .distance, .distance, .insert, @@ -68,8 +68,22 @@ example : let (q, dist, _) := (spec 2 0 1).clientState (init edgeless) (dijkstra q = IndexedMinPQ.empty 2 ∧ dist = ![some 0, none] := by decide +kernel +/-- Four vertices and one edge `0 → 1`: the counts follow the edges, not the vertices. Two +insertions and three extractions, the last finding the queue empty, meet the bounds +`min n (m + 1) = 2` and `min n (m + 2) = 3`. -/ +def sparse : ListInstance where + n := 4 + adj := ![[(1, 7)], [], [], []] + source := 0 + +example : let hist := (spec 4 28 29).clientHistory (init sparse) (dijkstra sparse.source) + hist.countP (kind · = .insert) = maxCount 4 1 .insert ∧ + hist.countP (kind · = .extractMin) = maxCount 4 1 .extractMin := by + decide +kernel + /-- Under binary-heap-style charges of `2` per queue operation, the cost theorem bounds the cost -on `graph` by `3 · 2 + 3 · 2 + 4 · 2 + 3 + 3 · 4 + 1 = 36`. -/ +on `graph` by `3 · 2 + 3 · 2 + 4 · 2 + 3 + 3 · 4 + 1 = 36`, the lesser of the two forms of the +budget. -/ example : (spec 3 15 16).CostHoare (charge fun _ _ => 2) (· = init graph) (dijkstra graph.source) (fun _ => HasDistances graph) (fun _ => 36) := (costHoare_dijkstra (K := 15) (V := 16) (cI := 2) (cE := 2) (cD := 2) graph (by decide) From f40fe1c5d742951bad6e0b74a4fed12607676ee8 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 18:48:07 -0500 Subject: [PATCH 14/20] feat(DataStructure): products over one memory, and glue charges for hop 3 Products over a shared memory (#2205 hop 3): - `Memory.Framed`: a refinement over `Memory.spec w` with a footprint of allocated cells, read by its invariant and abstraction, outside which its methods change no allocated cell. `Framed.ofStatic` for fixed layouts. - `Framed.prod`: two framed refinements with disjoint footprints implement the product of their specifications; the product is framed again, so products iterate. `Framed.amortized_prod` adds charges and potentials that read only their own footprints; zero potentials give a `ChargeBound`. - `Framed.of_fresh`, `Framed.prod_of_fresh`: allocation preserves structures and sets up products. - `Refinement.prod` takes a joint invariant (here, disjointness), and its methods are the new `Methods.prod`. The array stack is now `Stack.Memory.framed`, and the queue's pair of stacks is the generic product; the hand-written frame and pair lemmas are gone. Glue charges: `Refinement.Amortized.add`, `Amortized.glue` (glue at most `K` times a call's charge plus `K`), `Amortized.glue_of_one_le`, `StateTransitionSpec.totalCost_glue_le` and `Memory.one_le_charge`. `Queue.Memory.run_cost_glue` bounds memory charges and glue together by `(2K + 1)(6 + 9m)`. `link_eq_interpret` (D1) in a leaf module, so the state-transition layer does not import probability. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 2 + Complexity/DataStructure/Memory/Frame.lean | 334 ++++++++++++++++++ Complexity/DataStructure/Memory/Spec.lean | 6 + Complexity/DataStructure/Queue/Memory.lean | 112 +++--- Complexity/DataStructure/Stack/Memory.lean | 114 +++--- .../DataStructure/StateTransition/Oracle.lean | 44 +++ .../StateTransition/Refinement.lean | 176 +++++++-- .../DataStructureMemoryProduct.lean | 110 ++++++ ComplexityTests/DataStructureQueueMemory.lean | 12 + 9 files changed, 752 insertions(+), 158 deletions(-) create mode 100644 Complexity/DataStructure/Memory/Frame.lean create mode 100644 Complexity/DataStructure/StateTransition/Oracle.lean create mode 100644 ComplexityTests/DataStructureMemoryProduct.lean diff --git a/Complexity.lean b/Complexity.lean index 8599d2709f..5f2e2464a6 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -2874,6 +2874,7 @@ 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.Frame public import Complexity.DataStructure.Memory.Spec public import Complexity.DataStructure.ObliviousSequence public import Complexity.DataStructure.Online.Basic @@ -2925,6 +2926,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.Oracle public import Complexity.DataStructure.StateTransition.Refinement public import Complexity.DataStructure.StateTransition.Resource public import Complexity.DataStructure.VanEmdeBoas.Basic diff --git a/Complexity/DataStructure/Memory/Frame.lean b/Complexity/DataStructure/Memory/Frame.lean new file mode 100644 index 0000000000..9c41b35613 --- /dev/null +++ b/Complexity/DataStructure/Memory/Frame.lean @@ -0,0 +1,334 @@ +/- +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.Spec +public import Complexity.DataStructure.StateTransition.Refinement + +/-! +# Footprints, and products of data structures sharing one memory + +A `Memory.Framed D w` is a refinement of `D` over `Memory.spec w` together with a footprint: the +finite set of allocated cells that holds the representation of each memory state. Three +obligations make the footprint honest. + +* `congr`: the invariant, the abstraction and the footprint itself read only the footprint's + cells, and survive a growing frontier. +* `modifies`: a method run changes no allocated cell outside the footprint, and the footprint + grows only into cells that the run allocated. +* `lt_frontier`: the footprint is allocated. + +Footprints may change from state to state, so that a structure can grow into cells it allocates +inside its operations. A structure laid out in fixed blocks has a constant footprint, and +`Framed.ofStatic` asks for less. Allocating inside an operation also needs room, since +`Memory.valid` asks the new frontier to fit a word. Neither the abstract state nor the structure's +own cells determine the frontier, and the other side of a product moves it, so such a structure +needs a shared budget of room, which this file does not provide. The structures built so far +allocate their storage once, up front. + +Two framed refinements implement the product of their specifications over one shared memory, +as long as their footprints are disjoint (`Framed.prod`). Disjointness is part of the product's +invariant. It holds after each method run because a run of one side writes only its own cells +and fresh ones, and the other side's footprint is allocated, hence not fresh. The product is +framed again, with the union of the footprints, so products iterate: +`(M₁.prod M₂).prod M₃` implements three structures in one memory. A potential that reads only the +footprint (`Framed.Local`) is left unchanged by the other side's methods, so amortized +certificates add across the product (`Framed.amortized_prod`), and so do worst-case +`Module.ChargeBound`s, as the case of zero potentials. + +Allocation is a memory program like any other. A run that leaves every allocated cell unchanged, +such as the allocation of a further structure, preserves a framed refinement (`Framed.of_fresh`), +and `Framed.prod_of_fresh` sets up a product from structures allocated one after the other. + +## Main definitions + +* `Memory.Framed`: a refinement over memory with a footprint. +* `Memory.Framed.ofStatic`: the constructor for a constant footprint. +* `Memory.Framed.Local`: a function of memory that reads only the footprint. +* `Memory.Framed.prod`: two framed refinements with disjoint footprints implement the product. + +## Main results + +* `Memory.frontier_le_of_clientRun`: a run never lowers the frontier. +* `Memory.mem_run_of_lt_frontier`, `Memory.mem_clientState_of_lt_frontier`: a run changes an + allocated cell only by writing it. +* `Memory.Framed.frame`: a method run of one structure leaves a structure with a disjoint + footprint unchanged. +* `Memory.Framed.prod_methods`: the product's methods are the two sides' methods. +* `Memory.Framed.amortized_prod`: potentials and charges add across the product. +* `Memory.Framed.of_fresh`, `Memory.Framed.prod_of_fresh`: allocation preserves structures and + sets up products. + +## References + +The footprint and frame discipline is the locality principle of separation logic, here with +explicit finite footprints as in `Cslib.WordRAM.HeapAssertion`; see +[J. C. Reynolds, *Separation Logic: A Logic for Shared Mutable Data Structures*][Reynolds2002]. +-/ + +@[expose] public section + +namespace Cslib.DataStructure.Memory + +variable {w : ℕ} + +/-! ## Runs and allocated cells -/ + +/-- No run of a memory program lowers the frontier. -/ +theorem frontier_le_of_clientRun {α : Type} {s s' : State} {p : Prog α} {a : α} + {tr : (spec w).Transcript} (h : (spec w).ClientRun s p a s' tr) : + s.frontier ≤ s'.frontier := by + obtain ⟨_, _, rfl, _⟩ := ((spec w).clientRun_iff_runClient _ _ _ _ _).mp h + rw [← (spec w).run_runClient] + exact frontier_le_run s _ + +/-- A sequence of operations changes an allocated cell only by writing it. -/ +theorem mem_run_of_lt_frontier (s : State) (os : List Op) {a : ℕ} (ha : a < s.frontier) + (hw : ∀ v, Op.write a v ∉ os) : ((spec w).run s os).1.mem a = s.mem a := by + induction os generalizing s with + | nil => rfl + | cons o os ih => + have hw' : ∀ v, Op.write a v ∉ os := fun v hv => hw v (List.mem_cons_of_mem o hv) + change ((spec w).run (step s o).1 os).1.mem a = s.mem a + rw [ih _ (ha.trans_le (frontier_le_step s o)) hw'] + exact mem_step_of_lt_frontier s o ha fun v h => hw v (h ▸ List.mem_cons_self) + +/-- A memory program changes an allocated cell only by writing it. -/ +theorem mem_clientState_of_lt_frontier {α : Type} (s : State) (p : Prog α) {a : ℕ} + (ha : a < s.frontier) (hw : ∀ v, Op.write a v ∉ (spec w).clientHistory s p) : + ((spec w).clientState s p).mem a = s.mem a := by + rw [← (spec w).run_runClient] + exact mem_run_of_lt_frontier s _ ha hw + +/-! ## Framed refinements -/ + +/-- A refinement of `D` over memory whose representation lives in a footprint of allocated +cells. The invariant, the abstraction and the footprint read only the footprint's cells; a +method run changes no allocated cell outside the footprint; and the footprint grows only into +cells at or above the old frontier, which the run allocated. -/ +structure Framed (D : StateTransitionSpec.{0, 0, 0}) (w : ℕ) extends Refinement D (spec w) where + /-- The cells holding the representation. -/ + footprint : State → Finset ℕ + /-- The footprint is allocated. -/ + lt_frontier : ∀ {s a}, inv s → a ∈ footprint s → a < s.frontier + /-- The invariant, the abstraction and the footprint read only the footprint's cells, and + survive a growing frontier. -/ + congr : ∀ {s s'}, inv s → (∀ a ∈ footprint s, s'.mem a = s.mem a) → + s.frontier ≤ s'.frontier → inv s' ∧ abs s' = abs s ∧ footprint s' = footprint s + /-- A method run changes no allocated cell outside the footprint, and the footprint grows + only into fresh cells. -/ + modifies : ∀ {s} o {a s' tr}, inv s → D.valid (abs s) o → + (spec w).ClientRun s (methods o) a s' tr → + (∀ b < s.frontier, b ∉ footprint s → s'.mem b = s.mem b) ∧ + ∀ b ∈ footprint s', b ∈ footprint s ∨ s.frontier ≤ b + +namespace Framed + +variable {D D₁ D₂ : StateTransitionSpec.{0, 0, 0}} + +/-- The constructor for a constant footprint `fp`: the invariant and abstraction read only `fp`, +and each method's final state agrees with its initial state on the allocated cells outside +`fp`. -/ +def ofStatic (M : Refinement D (spec w)) (fp : Finset ℕ) + (lt_frontier : ∀ {s a}, M.inv s → a ∈ fp → a < s.frontier) + (congr : ∀ {s s'}, M.inv s → (∀ a ∈ fp, s'.mem a = s.mem a) → + s.frontier ≤ s'.frontier → M.inv s' ∧ M.abs s' = M.abs s) + (modifies : ∀ {s} o, M.inv s → D.valid (M.abs s) o → ∀ b < s.frontier, b ∉ fp → + ((spec w).clientState s (M.methods o)).mem b = s.mem b) : + Framed D w where + toRefinement := M + footprint _ := fp + lt_frontier := lt_frontier + congr hs h hf := ⟨(congr hs h hf).1, (congr hs h hf).2, rfl⟩ + modifies {s} o {a s' tr} hs hv hrun := by + obtain ⟨_, _, rfl, _⟩ := ((spec w).clientRun_iff_runClient _ _ _ _ _).mp hrun + exact ⟨modifies o hs hv, fun b hb => .inl hb⟩ + +variable (M : Framed D w) + +/-- A function of memory reads only the footprint: it is unchanged when the footprint's cells +are and the frontier grows. The abstraction is one (`Local.abs`); so are potentials that a +product must keep apart. -/ +def Local {β : Type*} (f : State → β) : Prop := + ∀ {s s'}, M.inv s → (∀ a ∈ M.footprint s, s'.mem a = s.mem a) → + s.frontier ≤ s'.frontier → f s' = f s + +/-- The abstraction reads only the footprint. -/ +theorem Local.abs : M.Local M.abs := fun hs h hf => (M.congr hs h hf).2.1 + +/-- A constant reads no cell. -/ +theorem Local.const {β : Type*} (b : β) : M.Local fun _ => b := fun _ _ _ => rfl + +/-- Sums of local functions are local. -/ +theorem Local.add {f g : State → ℕ} (hf : M.Local f) (hg : M.Local g) : + M.Local fun s => f s + g s := fun hs h hfr => + congrArg₂ (· + ·) (hf hs h hfr) (hg hs h hfr) + +/-- A run that leaves every allocated cell unchanged preserves a framed refinement. Allocating +another structure is such a run. -/ +theorem of_fresh {s s' : State} (hs : M.inv s) + (hmem : ∀ a < s.frontier, s'.mem a = s.mem a) (hf : s.frontier ≤ s'.frontier) : + M.inv s' ∧ M.abs s' = M.abs s ∧ M.footprint s' = M.footprint s := + M.congr hs (fun a ha => hmem a (M.lt_frontier hs ha)) hf + +variable {M} (N : Framed D₂ w) + +/-- A method run of `M` keeps every cell of a disjoint, allocated footprint. -/ +theorem agree_of_run {s : State} (o : D.Op) {a : D.Result o} {s' : State} + {tr : (spec w).Transcript} (hM : M.inv s) (hN : N.inv s) + (hd : Disjoint (M.footprint s) (N.footprint s)) (hv : D.valid (M.abs s) o) + (hrun : (spec w).ClientRun s (M.methods o) a s' tr) : + ∀ b ∈ N.footprint s, s'.mem b = s.mem b := fun b hb => + (M.modifies o hM hv hrun).1 b (N.lt_frontier hN hb) (Finset.disjoint_right.mp hd hb) + +/-- **The frame of a framed refinement.** A method run of `M` leaves a framed refinement with a +disjoint footprint unchanged, and the footprints stay disjoint. -/ +theorem frame {s : State} (o : D.Op) {a : D.Result o} {s' : State} + {tr : (spec w).Transcript} (hM : M.inv s) (hN : N.inv s) + (hd : Disjoint (M.footprint s) (N.footprint s)) (hv : D.valid (M.abs s) o) + (hrun : (spec w).ClientRun s (M.methods o) a s' tr) : + N.abs s' = N.abs s ∧ N.inv s' ∧ N.footprint s' = N.footprint s ∧ + Disjoint (M.footprint s') (N.footprint s') := by + have hf := frontier_le_of_clientRun hrun + obtain ⟨hN', habs, hfp⟩ := N.congr hN (agree_of_run N o hM hN hd hv hrun) hf + refine ⟨habs, hN', hfp, Finset.disjoint_left.mpr fun b hb hb' => ?_⟩ + rw [hfp] at hb' + rcases (M.modifies o hM hv hrun).2 b hb with hb | hb + · exact Finset.disjoint_left.mp hd hb hb' + · exact absurd (N.lt_frontier hN hb') (Nat.not_lt.mpr hb) + +/-- A method run of `M` leaves unchanged every function that reads only a disjoint footprint. -/ +theorem Local.frame {β : Type*} {f : State → β} (hf : N.Local f) {s : State} (o : D.Op) + {a : D.Result o} {s' : State} {tr : (spec w).Transcript} (hM : M.inv s) (hN : N.inv s) + (hd : Disjoint (M.footprint s) (N.footprint s)) (hv : D.valid (M.abs s) o) + (hrun : (spec w).ClientRun s (M.methods o) a s' tr) : f s' = f s := + hf hN (agree_of_run N o hM hN hd hv hrun) (frontier_le_of_clientRun hrun) + +/-! ## Products -/ + +variable (M₁ : Framed D₁ w) (M₂ : Framed D₂ w) + +/-- A method run of the left side keeps the right side and the disjointness of the footprints. -/ +theorem prod_frame_left {s : State} (o : D₁.Op) {a : D₁.Result o} {s' : State} + {tr : (spec w).Transcript} (h₁ : M₁.inv s) (h₂ : M₂.inv s) + (hd : Disjoint (M₁.footprint s) (M₂.footprint s)) (hv : D₁.valid (M₁.abs s) o) + (hrun : (spec w).ClientRun s (M₁.methods o) a s' tr) : + M₂.abs s' = M₂.abs s ∧ M₂.inv s' ∧ Disjoint (M₁.footprint s') (M₂.footprint s') := + have h := frame M₂ o h₁ h₂ hd hv hrun + ⟨h.1, h.2.1, h.2.2.2⟩ + +/-- A method run of the right side keeps the left side and the disjointness of the footprints. -/ +theorem prod_frame_right {s : State} (o : D₂.Op) {a : D₂.Result o} {s' : State} + {tr : (spec w).Transcript} (h₁ : M₁.inv s) (h₂ : M₂.inv s) + (hd : Disjoint (M₁.footprint s) (M₂.footprint s)) (hv : D₂.valid (M₂.abs s) o) + (hrun : (spec w).ClientRun s (M₂.methods o) a s' tr) : + M₁.abs s' = M₁.abs s ∧ M₁.inv s' ∧ Disjoint (M₁.footprint s') (M₂.footprint s') := + have h := frame M₁ o h₂ h₁ hd.symm hv hrun + ⟨h.1, h.2.1, h.2.2.2.symm⟩ + +/-- **Products over one memory.** Two framed refinements implement the product of their +specifications over one memory, with the union of their footprints, while the footprints are +disjoint. Disjointness is part of the product's invariant. -/ +def prod : Framed (product D₁ D₂) w where + toRefinement := M₁.toRefinement.prod M₂.toRefinement + (fun s => Disjoint (M₁.footprint s) (M₂.footprint s)) + (prod_frame_left M₁ M₂) (prod_frame_right M₁ M₂) + footprint s := M₁.footprint s ∪ M₂.footprint s + lt_frontier {_ _} hs ha := by + rcases Finset.mem_union.mp ha with ha | ha + · exact M₁.lt_frontier hs.1 ha + · exact M₂.lt_frontier hs.2.1 ha + congr {_ _} hs h hf := by + obtain ⟨h₁, h₂, hd⟩ := hs + obtain ⟨h₁', habs₁, hfp₁⟩ := M₁.congr h₁ (fun a ha => h a (Finset.mem_union_left _ ha)) hf + obtain ⟨h₂', habs₂, hfp₂⟩ := M₂.congr h₂ (fun a ha => h a (Finset.mem_union_right _ ha)) hf + refine ⟨⟨h₁', h₂', ?_⟩, ?_, ?_⟩ + · change Disjoint (M₁.footprint _) (M₂.footprint _) + rwa [hfp₁, hfp₂] + · change (M₁.abs _, M₂.abs _) = (M₁.abs _, M₂.abs _) + rw [habs₁, habs₂] + · rw [hfp₁, hfp₂] + modifies {s} o {a s' tr} hs hv hrun := by + obtain ⟨h₁, h₂, hd⟩ := hs + cases o with + | inl o => + obtain ⟨hmod, hgrow⟩ := M₁.modifies o h₁ hv hrun + obtain ⟨-, -, hfp₂, -⟩ := frame M₂ o h₁ h₂ hd hv hrun + refine ⟨fun b hb hb' => hmod b hb fun h => hb' (Finset.mem_union_left _ h), + fun b hb => ?_⟩ + change b ∈ M₁.footprint s' ∪ M₂.footprint s' at hb + rw [hfp₂] at hb + rcases Finset.mem_union.mp hb with hb | hb + · exact (hgrow b hb).imp_left (Finset.mem_union_left _) + · exact .inl (Finset.mem_union_right _ hb) + | inr o => + obtain ⟨hmod, hgrow⟩ := M₂.modifies o h₂ hv hrun + obtain ⟨-, -, hfp₁, -⟩ := frame M₁ o h₂ h₁ hd.symm hv hrun + refine ⟨fun b hb hb' => hmod b hb fun h => hb' (Finset.mem_union_right _ h), + fun b hb => ?_⟩ + change b ∈ M₁.footprint s' ∪ M₂.footprint s' at hb + rw [hfp₁] at hb + rcases Finset.mem_union.mp hb with hb | hb + · exact .inl (Finset.mem_union_left _ hb) + · exact (hgrow b hb).imp_left (Finset.mem_union_right _) + +/-- The product's methods run each side's methods. They do not depend on the proofs. -/ +theorem prod_methods : (M₁.prod M₂).methods = Methods.prod M₁.methods M₂.methods := rfl + +/-- The product represents each side by its own abstraction. -/ +@[simp] theorem prod_abs (s : State) : (M₁.prod M₂).abs s = (M₁.abs s, M₂.abs s) := rfl + +/-- The product's invariant: both sides' invariants, and disjoint footprints. -/ +theorem prod_inv_iff (s : State) : + (M₁.prod M₂).inv s ↔ + M₁.inv s ∧ M₂.inv s ∧ Disjoint (M₁.footprint s) (M₂.footprint s) := Iff.rfl + +/-- The product's footprint is the union of the footprints. -/ +@[simp] theorem prod_footprint (s : State) : + (M₁.prod M₂).footprint s = M₁.footprint s ∪ M₂.footprint s := rfl + +variable {M₁ M₂} + +/-- A function local to the left side is local to the product. -/ +theorem Local.prod_left {β : Type*} {f : State → β} (hf : M₁.Local f) : + (M₁.prod M₂).Local f := fun hs h hfr => + hf hs.1 (fun a ha => h a (Finset.mem_union_left _ ha)) hfr + +/-- A function local to the right side is local to the product. -/ +theorem Local.prod_right {β : Type*} {f : State → β} (hf : M₂.Local f) : + (M₁.prod M₂).Local f := fun hs h hfr => + hf hs.2.1 (fun a ha => h a (Finset.mem_union_right _ ha)) hfr + +/-- **Potentials add across a product over one memory.** Certificates of the two sides against +one lower charge, with potentials that read only their own footprints, give a certificate of +the product with componentwise upper charges and the sum of the potentials. -/ +theorem amortized_prod {lower : State → Op → ℕ} {upper₁ : D₁.State → D₁.Op → ℕ} + {upper₂ : D₂.State → D₂.Op → ℕ} {Φ₁ Φ₂ : State → ℕ} + (A₁ : M₁.Amortized lower upper₁ Φ₁) (A₂ : M₂.Amortized lower upper₂ Φ₂) + (hΦ₁ : M₁.Local Φ₁) (hΦ₂ : M₂.Local Φ₂) : + (M₁.prod M₂).Amortized lower (productCharge upper₁ upper₂) fun s => Φ₁ s + Φ₂ s := + Refinement.Amortized.prod (frame₁ := prod_frame_left M₁ M₂) (frame₂ := prod_frame_right M₁ M₂) + A₁ A₂ (fun {_} o {_ _ _} h₁ h₂ hd hv hrun => hΦ₂.frame M₂ o h₁ h₂ hd hv hrun) + (fun {_} o {_ _ _} h₁ h₂ hd hv hrun => hΦ₁.frame M₁ o h₂ h₁ hd.symm hv hrun) + +/-- Setting up a product from structures allocated one after the other: `M₁` holds at `s`; a +run from `s` to `s'` leaves the cells below `s.frontier` unchanged; and `M₂` holds at `s'` on a +footprint at or above `s.frontier`. Then the product holds at `s'`, with `M₁`'s abstraction +unchanged. -/ +theorem prod_of_fresh {s s' : State} (h₁ : M₁.inv s) + (hmem : ∀ a < s.frontier, s'.mem a = s.mem a) (hf : s.frontier ≤ s'.frontier) + (h₂ : M₂.inv s') (hfp : ∀ a ∈ M₂.footprint s', s.frontier ≤ a) : + (M₁.prod M₂).inv s' ∧ (M₁.prod M₂).abs s' = (M₁.abs s, M₂.abs s') := by + obtain ⟨h₁', habs, hfp₁⟩ := M₁.of_fresh h₁ hmem hf + refine ⟨⟨h₁', h₂, Finset.disjoint_left.mpr fun a ha ha' => ?_⟩, by rw [prod_abs, habs]⟩ + rw [hfp₁] at ha + exact absurd (M₁.lt_frontier h₁ ha) (Nat.not_lt.mpr (hfp a ha')) + +end Framed + +end Cslib.DataStructure.Memory diff --git a/Complexity/DataStructure/Memory/Spec.lean b/Complexity/DataStructure/Memory/Spec.lean index 3507072aee..f61e0fda4e 100644 --- a/Complexity/DataStructure/Memory/Spec.lean +++ b/Complexity/DataStructure/Memory/Spec.lean @@ -48,6 +48,7 @@ separate step that exchanges it into instructions. Allocation never reuses addre * `Memory.WellFormed.step`, `Memory.WellFormed.run`: admissible operations preserve well-formedness. * `Memory.WellFormed.fits_of_lt_frontier`: allocated addresses fit a word. +* `Memory.one_le_charge`: every operation costs at least one unit. * `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. @@ -162,6 +163,11 @@ abbrev allocDirty (k : ℕ) : Prog ℕ := @[simp] theorem charge_allocDirty (s : State) (k : ℕ) : charge s (.allocDirty k) = 1 := rfl +/-- Every memory operation costs at least one unit, so the number of operations, hence the +glue run after them, is paid for by their charges. -/ +theorem one_le_charge (s : State) (o : Op) : 1 ≤ charge s o := by + cases o <;> simp + /-- Admissibility of a concrete history is decidable. -/ instance decidableValidHistory (w : ℕ) (s : State) (os : List Op) : Decidable ((spec w).ValidHistory s os) := by diff --git a/Complexity/DataStructure/Queue/Memory.lean b/Complexity/DataStructure/Queue/Memory.lean index d3fa6805cf..89acafde8b 100644 --- a/Complexity/DataStructure/Queue/Memory.lean +++ b/Complexity/DataStructure/Queue/Memory.lean @@ -22,8 +22,9 @@ proved once: (`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. +2. `pair`: two array stacks with disjoint layouts in one memory, as the generic product + `Memory.Framed.prod` of two framed stacks, 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, @@ -42,6 +43,7 @@ provide. * `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. +* `pair`: the two stacks in one 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. @@ -53,6 +55,7 @@ provide. * `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_glue`: with glue charged per memory operation, at most `(2 K + 1) (6 + 9 m)`. * `run_cost_isBigO`: the same cost as `O(m)`. ## References @@ -188,22 +191,28 @@ theorem amortized : /-! ## Over memory -/ +/-- The two stacks over one memory, in disjoint layouts. -/ +abbrev pair {L₁ L₂ : Stack.Memory.Layout} (h₁ : L₁.Valid w C) (h₂ : L₂.Valid w C) : + Memory.Framed (boundedStacks w C) w := + (Stack.Memory.framed h₁).prod (Stack.Memory.framed h₂) + /-- 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) : +def memRefinement {L₁ L₂ : Stack.Memory.Layout} (h₁ : L₁.Valid w C) (h₂ : L₂.Valid w C) : Refinement (Queue.WordRAM.spec w C) (Memory.spec w) := - (refinement w C).comp (Stack.Memory.pairRefinement h₁ h₂ hd) + (refinement w C).comp (pair h₁ h₂).toRefinement /-- **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) +theorem mem_amortized {L₁ L₂ : Stack.Memory.Layout} (h₁ : L₁.Valid w C) (h₂ : L₂.Valid w C) : + (memRefinement h₁ h₂).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 hpair := Memory.Framed.amortized_prod (Stack.Memory.amortized h₁) + (Stack.Memory.amortized h₂) (Memory.Framed.Local.const _ 0) (Memory.Framed.Local.const _ 0) + rw [productCharge_const] at hpair + have h := (amortized.mul_left 3).comp hpair have hΦ : (fun s : Memory.State => - 3 * (2 * (Stack.Memory.abs L₂ s).length) + 0) = + 3 * (2 * (Stack.Memory.abs L₂ s).length) + (0 + 0)) = fun s => 6 * (Stack.Memory.abs L₂ s).length := by funext s omega @@ -214,16 +223,12 @@ theorem mem_amortized {L₁ L₂ : Stack.Memory.Layout} (h₁ : L₁.Valid w C) /-- 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) + fun o => link (Methods.prod (Stack.Memory.methods L₁ w C) (Stack.Memory.methods 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 + (h₂ : L₂.Valid w C) : (memRefinement h₁ h₂).methods = memMethods L₁ L₂ w C := 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 @@ -252,43 +257,33 @@ theorem runClient_run {β : Type} (p : (Queue.WordRAM.spec w C).Client β) (s : /-- 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) = [] ∧ + ∃ (h₁ : (frontLayout s C).Valid w C) (h₂ : (rearLayout s C).Valid w C), + (memRefinement h₁ h₂).inv (allocated s C) ∧ + (memRefinement h₁ h₂).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. + -- Each stack is empty once allocated, the second one from the state after the first. 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₂] + -- The second allocation is fresh, so the stacks form a product. + obtain ⟨hinv, habs⟩ := Memory.Framed.prod_of_fresh (M₁ := Stack.Memory.framed h₁) + (M₂ := Stack.Memory.framed h₂) hi₁ + (fun a ha => clear_of_not_owns (by simp only [Block.Owns] at ha ⊢; omega)) (by simp only; omega) + hi₂ + (fun a ha => by + simp only [Stack.Memory.framed_footprint, Stack.Memory.Layout.footprint, Finset.mem_union, + Block.mem_footprint, Block.Owns] at ha + simp only + omega) + have hempty : (pair h₁ h₂).abs (allocated s C) = ([], []) := habs.trans (Prod.ext ha₁ ha₂) + refine ⟨h₁, h₂, ⟨hinv, ?_⟩, ?_, ha₂⟩ + · change Inv w C (Queue.WordRAM.contents ((pair h₁ h₂).abs (allocated s C))) + rw [hempty] 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₂] + · change Queue.WordRAM.contents ((pair h₁ h₂).abs (allocated s C)) = [] + rw [hempty] rfl /-- **Correctness.** From any memory with room for both stacks, an admissible queue client run @@ -299,9 +294,9 @@ theorem run_correct {β : Type} (p : (Queue.WordRAM.spec w C).Client β) {s : Me (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 ⟨h₁, h₂, hinv, habs, -⟩ := setup s hfit obtain ⟨hvE, hres, -, -⟩ := - (memRefinement h₁ h₂ hd).simulates_client p hinv (by rw [habs]; exact hv) + (memRefinement h₁ h₂).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 ⊢ @@ -317,8 +312,8 @@ theorem run_cost {β : Type} (p : (Queue.WordRAM.spec w C).Client β) {s : Memor (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) + obtain ⟨h₁, h₂, hinv, habs, hrear⟩ := setup s hfit + have h := (mem_amortized h₁ h₂).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, @@ -326,6 +321,21 @@ theorem run_cost {β : Type} (p : (Queue.WordRAM.spec w C).Client β) {s : Memor simp only [List.length_nil, Nat.mul_zero, Nat.add_zero, allocated] at h ⊢ omega +/-- **Cost with glue.** A realization also charges the glue that runs after each memory operation. +If that glue costs at most `K` times the operation's charge plus `K`, the run costs at most +`(2 K + 1) (6 + 9 m)` in memory charges and glue together. The queue's and the stacks' methods +are straight-line code between memory operations, so their glue is of this form. -/ +theorem run_cost_glue {β : 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)) + {glue : Memory.State → Memory.Op → ℕ} {K : ℕ} + (hglue : ∀ s o, glue s o ≤ K * (charge s o + 1)) : + (Memory.spec w).totalCost (fun s o => charge s o + glue s o) s + ((Memory.spec w).clientHistory s (run w C p)) ≤ + (2 * K + 1) * (6 + 9 * ((Queue.WordRAM.spec w C).clientHistory [] p).length) := + ((Memory.spec w).totalCost_glue_le one_le_charge hglue s _).trans + (Nat.mul_le_mul_left _ (run_cost p hfit hv)) + /-- **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))) : diff --git a/Complexity/DataStructure/Stack/Memory.lean b/Complexity/DataStructure/Stack/Memory.lean index cf79d42258..5fb09e09e6 100644 --- a/Complexity/DataStructure/Stack/Memory.lean +++ b/Complexity/DataStructure/Stack/Memory.lean @@ -8,7 +8,7 @@ module -- upstream: candidate public import Complexity.DataStructure.Memory.Field -public import Complexity.DataStructure.StateTransition.Refinement +public import Complexity.DataStructure.Memory.Frame public import Complexity.DataStructure.Stack.WordRAM.Basic /-! @@ -23,8 +23,9 @@ refinement obligations follow from those equations and the list view of the arra 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`). +invariant depend only on those cells (`abs_congr`, `Inv.congr`). So the stack is framed by its +layout (`framed`), and stacks with disjoint layouts share one memory through the generic product +`Memory.Framed.prod`. This is the same specification that `Stack.WordRAM` implements by a hand-stepped nine-register dispatcher. Here no register or instruction count appears. Word fit enters only through the @@ -37,18 +38,15 @@ admissibility of `Memory.spec w` and one static fact of the layout, that the cap * `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. -* `pairMethods`, `pairRefinement`: two array stacks with disjoint layouts implement the pair of - stacks. +* `framed`: the same refinement, framed by the layout's cells. * `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. * `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. +* `modifies_methods`, `abs_congr`, `Inv.congr`, `Inv.lt_frontier`: the frame of a stack. * `runClient_allocLayout_bind`, `valid_allocLayout`, `inv_allocLayout`: allocation yields a well-formed empty stack in three memory units. @@ -278,20 +276,6 @@ def refinement (hL : L.Valid w C) : Refinement (Stack.WordRAM.spec w C) (Memory. 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. -/ @@ -319,54 +303,44 @@ theorem modifies_methods (hL : L.Valid w C) {s : Memory.State} (o : StackOp ℕ) 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 -/ - -/-- 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) : - 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) - -/-- 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) : - (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 +/-- The layout's cells are allocated. -/ +theorem Inv.lt_frontier {s : Memory.State} (hs : Inv L s) {a : ℕ} (ha : a ∈ L.footprint) : + a < s.frontier := by + have h₁ := hs.count_allocated + have h₂ := hs.items_allocated + simp only [Layout.footprint, Finset.mem_union, Block.mem_footprint, Block.Owns] at ha + unfold Block.Allocated at h₁ h₂ + omega + +/-- The array stack, with its layout's cells as a constant footprint. Stacks with disjoint +layouts therefore share one memory as a product of stacks (`Memory.Framed.prod`). -/ +def framed (hL : L.Valid w C) : Memory.Framed (Stack.WordRAM.spec w C) w := + .ofStatic (refinement hL) L.footprint (fun hs ha => Inv.lt_frontier hs ha) + (fun hs h hf => ⟨hs.congr hL h hf, abs_congr hL hs h⟩) + (fun o _ hv b _ hb => (modifies_methods hL o hv).1 b hb) + +/-- Every operation costs at most three memory units, so the stack needs no potential. -/ +theorem amortized (hL : L.Valid w C) : + (framed hL).Amortized charge (fun _ _ => 3) fun _ => 0 := by + apply Refinement.Amortized.ofFn + intro s o _ _ + cases o with + | push v => + simp [framed, Memory.Framed.ofStatic, refinement, methods, + StateTransitionSpec.clientHistory, runClient_push] + | pop => + by_cases h0 : s.mem L.count.base = 0 + · simp [framed, Memory.Framed.ofStatic, refinement, methods, + StateTransitionSpec.clientHistory, runClient_pop_of_eq_zero L s h0] + · simp [framed, Memory.Framed.ofStatic, refinement, methods, + StateTransitionSpec.clientHistory, runClient_pop_of_pos L s h0] + | size => + simp [framed, Memory.Framed.ofStatic, refinement, methods, + StateTransitionSpec.clientHistory, runClient_size] + +/-- The footprint of a stack is its layout's cells. -/ +@[simp] theorem framed_footprint (hL : L.Valid w C) (s : Memory.State) : + (framed hL).footprint s = L.footprint := rfl /-! ## Allocation -/ diff --git a/Complexity/DataStructure/StateTransition/Oracle.lean b/Complexity/DataStructure/StateTransition/Oracle.lean new file mode 100644 index 0000000000..5cb3deff99 --- /dev/null +++ b/Complexity/DataStructure/StateTransition/Oracle.lean @@ -0,0 +1,44 @@ +/- +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.Module +public import Complexity.Languages.Probabilistic.Basic + +/-! +# Linking is oracle interpretation + +A client of a state-transition specification is an oracle program over the specification's +signature: both are `PFunctor.FreeM` over the operations and their answer types. Linking a client +through methods over a lower interface is interpreting the program in the lower interface's client +monad, answering each call with its method (`link_eq_interpret`). The lemmas about +`OracleComp.interpret` (sequencing, composition of interpretations, interpretation into `PMF` +and state monads) therefore apply to linked clients, and refinement and cost results about `link` +apply to interpreted programs. + +This bridge is its own module so that the state-transition layer does not import probability. + +## Main results + +* `link_eq_interpret`: linking is interpretation by the methods. +-/ + +@[expose] public section + +namespace Cslib.DataStructure + +universe u v w + +variable {D E : StateTransitionSpec.{u, v, w}} {α : Type w} + +/-- Linking a client through methods is interpreting it as an oracle program, answering each +call with its method. -/ +theorem link_eq_interpret (methods : Methods D E) (p : D.Client α) : + link methods p = OracleComp.interpret (spec := D.Result) (m := E.Client) methods p := rfl + +end Cslib.DataStructure diff --git a/Complexity/DataStructure/StateTransition/Refinement.lean b/Complexity/DataStructure/StateTransition/Refinement.lean index e6d94e5d59..794f512032 100644 --- a/Complexity/DataStructure/StateTransition/Refinement.lean +++ b/Complexity/DataStructure/StateTransition/Refinement.lean @@ -30,7 +30,16 @@ representation is functional yields an `Amortized` certificate of the realized m (`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. +methods of each side leave the other side's abstraction, invariant and potential unchanged. A +joint invariant, such as the disjointness of the memory the two sides use, may be part of the +product's invariant. `Memory.Framed.prod` discharges these obligations from footprints. + +**Glue.** A realization charges, besides each lower call, the glue code that consumes its answer. +In a free-monad program every bind follows exactly one call, so glue charged per bind is a +further charge per lower call, and `Refinement.Amortized.glue` absorbs it at a constant rate when +it is at most proportional to the call's charge plus one. Work not attached to a lower call, such +as a loop iteration that makes no call, is charged per call one level up and added with +`Refinement.Amortized.add`. ## Main definitions @@ -40,12 +49,13 @@ methods of each side leave the other side's abstraction, invariant and potential * `Refinement.toModule`: the underlying relational module. * `Refinement.id`, `Refinement.comp`, `Refinement.prod`: identity, composition, and products under non-interference. +* `Methods.prod`: the methods of both sides of a product. * `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. +The transcript-cost lemmas `StateTransitionSpec.totalCostTranscript_mono`, +`StateTransitionSpec.totalCostTranscript_mul_left` and `StateTransitionSpec.totalCostTranscript_add` +sit here, beside their only clients, rather than in the widely imported `StateTransition` module. ## Main results @@ -58,12 +68,15 @@ than in the widely imported `StateTransition` module. * `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. +* `Refinement.Amortized.mono`, `Refinement.Amortized.mul_left`, `Refinement.Amortized.add`: + weaken charges, exchange both currencies at a constant rate, and add certificates. +* `Refinement.Amortized.glue`, `Refinement.Amortized.glue_of_one_le`: absorb glue charged per + lower call. +* `StateTransitionSpec.totalCost_glue_le`: the same on a history. * `productCharge_const`: equal constant charges on a product. * `StateTransitionSpec.totalCostTranscript_mono`, - `StateTransitionSpec.totalCostTranscript_mul_left`: monotonicity and scaling of transcript - costs. + `StateTransitionSpec.totalCostTranscript_mul_left`, `StateTransitionSpec.totalCostTranscript_add`: + monotonicity, scaling and additivity of transcript costs. * `Refinement.Amortized.chargeBound`, `Refinement.Amortized.of_chargeBound`: with zero potential, the existing worst-case `Module.ChargeBound`. @@ -96,6 +109,11 @@ 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' +/-- The methods of both sides of a product, over one lower interface. -/ +def Methods.prod (m₁ : Methods D₁ E) (m₂ : Methods D₂ E) : Methods (product D₁ D₂) E + | .inl o => m₁ o + | .inr o => m₂ o + /-- 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 → ℕ @@ -127,6 +145,36 @@ theorem StateTransitionSpec.totalCostTranscript_mul_left (K : ℕ) (c : D.State | cons st tr ih => simp only [StateTransitionSpec.totalCostTranscript_cons, ih, Nat.mul_add] +/-- Charges add along a transcript. -/ +theorem StateTransitionSpec.totalCostTranscript_add (c c' : D.State → D.Op → ℕ) (s : D.State) + (tr : D.Transcript) : + D.totalCostTranscript (fun s o => c s o + c' s o) s tr = + 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, ih] + omega + +/-- **Glue on a history.** Glue charged with each operation at most `K` times its charge plus `K` +costs, together with the charges, at most `2 K + 1` times the charges, when every operation +costs at least one unit. -/ +theorem StateTransitionSpec.totalCost_glue_le + {fD : (s : D.State) → (o : D.Op) → D.State × D.Result o} [D.HasStepFn fD] + {lower glue : D.State → D.Op → ℕ} {K : ℕ} (hone : ∀ s o, 1 ≤ lower s o) + (hglue : ∀ s o, glue s o ≤ K * (lower s o + 1)) (s : D.State) (os : List D.Op) : + D.totalCost (fun s o => lower s o + glue s o) s os ≤ (2 * K + 1) * D.totalCost lower s os := by + induction os generalizing s with + | nil => simp + | cons o os ih => + simp only [StateTransitionSpec.totalCost_cons] + have h := ih (D.stepFn s o).1 + have hg := hglue s o + have h1 := Nat.mul_le_mul_left K (hone s o) + rw [Nat.mul_add] at hg ⊢ + rw [Nat.add_mul, Nat.mul_assoc, Nat.one_mul] at ⊢ + omega + namespace Refinement /-- The constructor for deterministic specifications: each method's history is admissible, and @@ -230,32 +278,33 @@ theorem link_comp (M : Refinement D E) (N : Refinement E F) (p : D.Client α) : (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') : +provided the methods of each leave the other's abstraction and invariant unchanged. The joint +invariant `J` holds of the shared lower state and is preserved by both sides; it records what +keeps them apart, such as the disjointness of the memory each one uses. -/ +def prod (M₁ : Refinement D₁ E) (M₂ : Refinement D₂ E) (J : E.State → Prop) + (frame₁ : ∀ {e} o {a e' tr}, M₁.inv e → M₂.inv e → J 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' ∧ J e') + (frame₂ : ∀ {e} o {a e' tr}, M₁.inv e → M₂.inv e → J 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' ∧ J 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 + methods := Methods.prod M₁.methods M₂.methods + inv e := M₁.inv e ∧ M₂.inv e ∧ J 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 + | inr o => exact M₂.valid o hi.2.1 hv correct {_} o {_ _ _} hi hv hrun := by + obtain ⟨hi₁, hi₂, hJ⟩ := hi 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₂⟩ + obtain ⟨hstep, hi₁'⟩ := M₁.correct o hi₁ hv hrun + obtain ⟨habs, hi₂', hJ'⟩ := frame₁ o hi₁ hi₂ hJ hv hrun + exact ⟨⟨hstep, habs⟩, hi₁', hi₂', hJ'⟩ | 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₂⟩ + obtain ⟨hstep, hi₂'⟩ := M₂.correct o hi₂ hv hrun + obtain ⟨habs, hi₁', hJ'⟩ := frame₂ o hi₁ hi₂ hJ hv hrun + exact ⟨⟨habs, hstep⟩, hi₁', hi₂', hJ'⟩ /-! ## Amortized costs -/ @@ -308,6 +357,58 @@ theorem Amortized.mul_left (A : M.Amortized lower upper potential) (K : ℕ) : rw [E.totalCostTranscript_mul_left, ← Nat.mul_add, ← Nat.mul_add] exact Nat.mul_le_mul_left K (A.step o hi hv hrun) +/-- Two certificates of one refinement add: their lower charges, upper charges and potentials. -/ +theorem Amortized.add (A : M.Amortized lower upper potential) + {lower' : E.State → E.Op → ℕ} {upper' : D.State → D.Op → ℕ} {potential' : E.State → ℕ} + (B : M.Amortized lower' upper' potential') : + M.Amortized (fun e o => lower e o + lower' e o) (fun s o => upper s o + upper' s o) + (fun e => potential e + potential' e) := by + refine ⟨fun {e} o {a e' tr} hi hv hrun => ?_⟩ + have h := A.step o hi hv hrun + have h' := B.step o hi hv hrun + rw [E.totalCostTranscript_add] + omega + +/-- **Glue charges.** A realization of the lower interface charges, besides each lower call, the +glue that consumes its answer: in a free-monad program every bind follows exactly one call. If +the glue charged with a call is at most `K` times the call's charge plus `K`, a certificate for +the charges and one for the number of calls give a certificate for the combined charge. Work that +is not attached to a lower call, such as the iterations of a loop that makes no call, is a +further per-call charge of the upper interface, added with `Amortized.add` one level up. -/ +theorem Amortized.glue (A : M.Amortized lower upper potential) + {calls : D.State → D.Op → ℕ} {Ψ : E.State → ℕ} (B : M.Amortized (fun _ _ => 1) calls Ψ) + {glue : E.State → E.Op → ℕ} {K : ℕ} (hglue : ∀ e o, glue e o ≤ K * (lower e o + 1)) : + M.Amortized (fun e o => lower e o + glue e o) + (fun s o => (K + 1) * upper s o + K * calls s o) + (fun e => (K + 1) * potential e + K * Ψ e) := + ((A.mul_left (K + 1)).add (B.mul_left K)).mono + (fun e o => calc + lower e o + glue e o ≤ lower e o + K * (lower e o + 1) := Nat.add_le_add_left (hglue e o) _ + _ = (K + 1) * lower e o + K * 1 := by rw [Nat.mul_add, Nat.add_mul]; omega) + fun _ _ _ => le_rfl + +/-- **Glue charges, when every call costs at least one unit**, as every memory operation does: +then the calls are paid for by their charges, and the combined charge is amortized at `2 K + 1` +times the upper charge. -/ +theorem Amortized.glue_of_one_le (A : M.Amortized lower upper potential) + (hone : ∀ e o, 1 ≤ lower e o) {glue : E.State → E.Op → ℕ} {K : ℕ} + (hglue : ∀ e o, glue e o ≤ K * (lower e o + 1)) : + M.Amortized (fun e o => lower e o + glue e o) (fun s o => (2 * K + 1) * upper s o) + (fun e => (2 * K + 1) * potential e) := by + have h := A.glue (A.mono hone fun _ _ _ => le_rfl) hglue + have hu : (fun s o => (K + 1) * upper s o + K * upper s o) = + fun s o => (2 * K + 1) * upper s o := by + funext s o + rw [Nat.add_mul, Nat.add_mul, Nat.mul_assoc] + omega + have hp : (fun e => (K + 1) * potential e + K * potential e) = + fun e => (2 * K + 1) * potential e := by + funext e + rw [Nat.add_mul, Nat.add_mul, Nat.mul_assoc] + omega + rw [hu, hp] at h + exact h + /-- 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) @@ -366,31 +467,32 @@ theorem Amortized.comp {N : Refinement E F} {lower : F.State → F.Op → ℕ} /-- **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'} +theorem Amortized.prod {M₁ : Refinement D₁ E} {M₂ : Refinement D₂ E} {J : E.State → Prop} + {frame₁ : ∀ {e} o {a e' tr}, M₁.inv e → M₂.inv e → J 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' ∧ J e'} + {frame₂ : ∀ {e} o {a e' tr}, M₁.inv e → M₂.inv e → J 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' ∧ J 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 → + (potential₁ : ∀ {e} o {a e' tr}, M₁.inv e → M₂.inv e → J 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 → + (potential₂ : ∀ {e} o {a e' tr}, M₁.inv e → M₂.inv e → J 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₂) + (M₁.prod M₂ J frame₁ frame₂).Amortized lower (productCharge upper₁ upper₂) (fun e => Φ₁ e + Φ₂ e) := by refine ⟨fun {e} o {a e' tr} hi hv hrun => ?_⟩ + obtain ⟨hi₁, hi₂, hJ⟩ := hi cases o with | inl o => - have h := A₁.step o hi.1 hv hrun - have hΦ := potential₁ o hi.1 hi.2 hv hrun + have h := A₁.step o hi₁ hv hrun + have hΦ := potential₁ o hi₁ hi₂ hJ hv hrun change E.totalCostTranscript lower e tr + (Φ₁ e' + Φ₂ e') ≤ upper₁ (M₁.abs e) o + (Φ₁ e + Φ₂ e) omega | inr o => - have h := A₂.step o hi.2 hv hrun - have hΦ := potential₂ o hi.1 hi.2 hv hrun + have h := A₂.step o hi₂ hv hrun + have hΦ := potential₂ o hi₁ hi₂ hJ hv hrun change E.totalCostTranscript lower e tr + (Φ₁ e' + Φ₂ e') ≤ upper₂ (M₂.abs e) o + (Φ₁ e + Φ₂ e) omega diff --git a/ComplexityTests/DataStructureMemoryProduct.lean b/ComplexityTests/DataStructureMemoryProduct.lean new file mode 100644 index 0000000000..22244481b9 --- /dev/null +++ b/ComplexityTests/DataStructureMemoryProduct.lean @@ -0,0 +1,110 @@ +/- +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.Stack.Memory + +/-! +# Three stacks in one memory + +Three array stacks of capacity `2` sit side by side in one memory at word size `8`. The iterated +product `(S₀.prod S₁).prod S₂` of their framed refinements implements the product of three stack +specifications. The tests run one linked client against concrete memory, transport the +specification's answer to it with `Refinement.simulates_client`, and check that the amortized +certificates add across both products to three memory units per operation, which also gives a +worst-case `Module.ChargeBound`. +-/ + +@[expose] public section + +namespace ComplexityTests.DataStructureMemoryProduct + +open Cslib.WordRAM Cslib.DataStructure Cslib.DataStructure.Memory Cslib.DataStructure.Queue + +/-- A bounded stack of capacity `2` at word size `8`. -/ +abbrev S : StateTransitionSpec := Stack.WordRAM.spec 8 2 + +/-- The layout of stack `i`: its count cell at `3 i`, its items at `3 i + 1` and `3 i + 2`. -/ +def layout (i : ℕ) : Stack.Memory.Layout := ⟨⟨3 * i, 1⟩, ⟨3 * i + 1, 2⟩⟩ + +/-- The three layouts are well formed. -/ +theorem valid (i : ℕ) (hi : i < 3) : (layout i).Valid 8 2 := + Stack.Memory.valid_allocLayout (f := 3 * i) (Fits.of_le (show Fits 8 9 by decide) (by omega)) + +/-- Nested products need their transition function named. -/ +instance : (product (product S S) S).HasStepFn + (productStepFn _ _ (productStepFn S S (stack ℕ).stepFn (stack ℕ).stepFn) (stack ℕ).stepFn) := + instHasStepFnProduct _ _ + +/-- Stack `i`, framed by its layout. -/ +abbrev stackAt (i : ℕ) (hi : i < 3) : Framed S 8 := Stack.Memory.framed (valid i hi) + +/-- The three stacks in one memory. -/ +abbrev triple : Framed (product (product S S) S) 8 := + ((stackAt 0 (by decide)).prod (stackAt 1 (by decide))).prod (stackAt 2 (by decide)) + +/-- Push `1` and `2` on the first stack and `3` on the third, then pop the first stack twice and +read the sizes. -/ +def client : (product (product S S) S).Client (List (Option ℕ) × List ℕ) := do + let _ ← (product (product S S) S).call (.inl (.inl (.push 1))) + let _ ← (product (product S S) S).call (.inl (.inl (.push 2))) + let _ ← (product (product S S) S).call (.inr (.push 3)) + let a ← (product (product S S) S).call (.inl (.inl .pop)) + let b ← (product (product S S) S).call (.inl (.inl .pop)) + let m ← (product (product S S) S).call (.inl (.inr .size)) + let n ← (product (product S S) S).call (.inr .size) + pure ([a, b], [m, n]) + +/-- Nine allocated zero cells: three empty stacks. -/ +def empty : State := ⟨fun _ => 0, 9⟩ + +/-- The linked client answers last in, first out, on each stack separately. -/ +example : (spec 8).clientResult empty (link triple.methods client) = + ([some 2, some 1], [0, 1]) := by + decide + +/-- It issues `4 · 3 + 1 + 1` memory operations, three per push and per nonempty pop, one per +size. -/ +example : (spec 8).totalCost charge empty ((spec 8).clientHistory empty + (link triple.methods client)) = 17 := by + decide + +/-- Each stack holds in the empty memory. -/ +theorem inv_layout (i : ℕ) (hi : i < 3) : Stack.Memory.Inv (layout i) empty where + count_allocated := by simp only [Block.Allocated, layout, empty]; omega + items_allocated := by simp only [Block.Allocated, layout, empty]; omega + count_le := by simp [layout, empty] + +/-- The three stacks hold in the empty memory, with disjoint footprints. -/ +theorem inv_empty : triple.inv empty := + ⟨⟨inv_layout 0 (by decide), inv_layout 1 (by decide), by decide⟩, inv_layout 2 (by decide), + by decide⟩ + +/-- The specification's answer, transported to the memory run by the iterated product. -/ +example : (spec 8).clientResult empty (link triple.methods client) = + (product (product S S) S).clientResult (triple.abs empty) client := + (triple.simulates_client client inv_empty + ⟨⟨by decide, by decide⟩, ⟨by decide, by decide⟩, ⟨by decide, by decide⟩, trivial, trivial, + trivial, trivial, trivial⟩).2.1 + +/-- Every operation of the three stacks costs at most three memory units, amortized with zero +potential: the stacks' certificates add across both products. -/ +theorem amortized : triple.Amortized charge (fun _ _ => 3) fun _ => 0 := by + have h₀₁ := Framed.amortized_prod (Stack.Memory.amortized (valid 0 (by decide))) + (Stack.Memory.amortized (valid 1 (by decide))) (Framed.Local.const _ 0) + (Framed.Local.const _ 0) + rw [productCharge_const] at h₀₁ + have h := Framed.amortized_prod h₀₁ (Stack.Memory.amortized (valid 2 (by decide))) + (fun _ _ _ => rfl) (Framed.Local.const _ 0) + rwa [productCharge_const] at h + +/-- With zero potential, the same certificate is a worst-case charge bound. -/ +example : triple.toModule.ChargeBound charge fun _ _ => 3 := + amortized.chargeBound + +end ComplexityTests.DataStructureMemoryProduct diff --git a/ComplexityTests/DataStructureQueueMemory.lean b/ComplexityTests/DataStructureQueueMemory.lean index 93a8793360..78d4631f2f 100644 --- a/ComplexityTests/DataStructureQueueMemory.lean +++ b/ComplexityTests/DataStructureQueueMemory.lean @@ -73,6 +73,18 @@ example : (spec 8).clientResult empty (run 8 3 client) = example : (spec 8).totalCost charge empty ((spec 8).clientHistory empty (run 8 3 client)) ≤ 69 := run_cost client room client_valid +/-- Glue of two units after each memory operation: the 47 operations add 94 units to the 49 +memory units, within the bound `(2 · 1 + 1) · 69` for `K = 1`. -/ +example : (spec 8).totalCost (fun s o => charge s o + 2) empty + ((spec 8).clientHistory empty (run 8 3 client)) = 143 := by + decide + +example : (spec 8).totalCost (fun s o => charge s o + 2) empty + ((spec 8).clientHistory empty (run 8 3 client)) ≤ 3 * 69 := + run_cost_glue client room client_valid (K := 1) fun s o => by + have := one_le_charge s o + omega + /-- 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 From 524056b7505858152e029625bab9eaa57d914ca2 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 19:04:41 -0500 Subject: [PATCH 15/20] feat(DataStructure/PriorityQueue): indexed binary heap over the memory oracle The indexed min-priority queue indexedMinPQSpec n K is implemented as a binary heap by programs over Memory.spec w, in the layout and with the abstraction (stateOfMem) and invariant (HeapInv) of BinaryHeap.Model. siftUp and siftDown are recursive memory programs whose proofs move one order defect per level with the order lemmas of BinaryHeap.Order, copied from the private lemmas of the word-RAM Sift.lean. Every operation costs at most 10 log n + 14 memory units; the heap is a Memory.Framed with its layout as footprint and starts empty when allocated in memory that is zero above the frontier. Memory.Triple packages CostHoare at one initial state with forward rules for reads, writes, dirty allocation and bind; Memory.ZeroAbove records that the input convention is zero past the input. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 3 + Complexity/DataStructure/Memory/Triple.lean | 171 ++++ .../PriorityQueue/BinaryHeap/Memory.lean | 833 ++++++++++++++++++ .../PriorityQueue/BinaryHeap/Order.lean | 240 +++++ .../DataStructureBinaryHeapMemory.lean | 77 ++ 5 files changed, 1324 insertions(+) create mode 100644 Complexity/DataStructure/Memory/Triple.lean create mode 100644 Complexity/DataStructure/PriorityQueue/BinaryHeap/Memory.lean create mode 100644 Complexity/DataStructure/PriorityQueue/BinaryHeap/Order.lean create mode 100644 ComplexityTests/DataStructureBinaryHeapMemory.lean diff --git a/Complexity.lean b/Complexity.lean index 5f2e2464a6..328ff50ea4 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -2876,6 +2876,7 @@ public import Complexity.DataStructure.HashFamily.WordRAM.Tabulation public import Complexity.DataStructure.Memory.Field public import Complexity.DataStructure.Memory.Frame public import Complexity.DataStructure.Memory.Spec +public import Complexity.DataStructure.Memory.Triple public import Complexity.DataStructure.ObliviousSequence public import Complexity.DataStructure.Online.Basic public import Complexity.DataStructure.OrderedSet.Basic @@ -2888,6 +2889,8 @@ public import Complexity.DataStructure.PrefixSums.WordRAM.Dynamic public import Complexity.DataStructure.PrefixSums.WordRAM.Query public import Complexity.DataStructure.PrefixSums.WordRAM.Tree public import Complexity.DataStructure.PrefixSums.WordRAM.Update +public import Complexity.DataStructure.PriorityQueue.BinaryHeap.Memory +public import Complexity.DataStructure.PriorityQueue.BinaryHeap.Order public import Complexity.DataStructure.PriorityQueue.Spec public import Complexity.DataStructure.PriorityQueue.WordRAM.Basic public import Complexity.DataStructure.PriorityQueue.WordRAM.BinaryHeap diff --git a/Complexity/DataStructure/Memory/Triple.lean b/Complexity/DataStructure/Memory/Triple.lean new file mode 100644 index 0000000000..64d75e69a7 --- /dev/null +++ b/Complexity/DataStructure/Memory/Triple.lean @@ -0,0 +1,171 @@ +/- +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.CostHoare + +/-! +# Correctness-and-cost triples for memory programs + +`Memory.Triple w s p c Q` says that the memory program `p`, run from the state `s` at word size +`w`, issues only admissible operations, costs at most `c` memory units (`Memory.charge`), and +ends with an answer and a state satisfying `Q`. It is `StateTransitionSpec.CostHoare` at the +single initial state `s`; `Memory.triple_iff` unfolds it along the run of `p`. + +The rules evaluate a program from its first operation on. `Triple.read_bind` and +`Triple.write_bind` discharge one operation's admissibility and charge, and leave the +continuation at the next state; `Triple.bind` splits a program at a subprogram with its own +triple; `Triple.pure` ends the run. Each rule peels one unit off a cost written `c + 1`, so a +straight-line program is checked by applying the rules in order. A recursive program is checked +by induction on its recursion measure, with the induction hypothesis applied at the recursive +call. + +The word RAM's initial memory is zero past the input (`zeroAbove_init`), so a structure that +needs zeroed storage can take it there with a dirty allocation, at the cost of one unit, instead +of a zeroed one, whose charge grows with its size. + +## Main definitions + +* `Cslib.DataStructure.Memory.Triple`: admissibility, cost and postcondition of one run. +* `Cslib.DataStructure.Memory.ZeroAbove`: every cell at or above the frontier holds `0`. + +## Main results + +* `Cslib.DataStructure.Memory.triple_iff`: the triple along the run of the program. +* `Cslib.DataStructure.Memory.Triple.pure`, `Cslib.DataStructure.Memory.Triple.read_bind`, + `Cslib.DataStructure.Memory.Triple.write_bind`, + `Cslib.DataStructure.Memory.Triple.allocBlockDirty_bind`: one step of a run. +* `Cslib.DataStructure.Memory.Triple.bind`: sequential composition. +* `Cslib.DataStructure.Memory.Triple.mono`: weaken the cost and the postcondition. +* `Cslib.DataStructure.Memory.zeroAbove_init`: the input convention is zero above the frontier. +-/ + +@[expose] public section + +namespace Cslib.DataStructure.Memory + +open Cslib.WordRAM + +variable {w : ℕ} {α β : Type} + +/-- Run from `s` at word size `w`, the program `p` issues only admissible operations, costs at +most `c` memory units, and ends with an answer and a state satisfying `Q`. -/ +abbrev Triple (w : ℕ) (s : State) (p : Prog α) (c : ℕ) (Q : α → State → Prop) : Prop := + (spec w).CostHoare charge (· = s) p Q fun _ => c + +/-- A triple is a statement about the one run of the program. -/ +theorem triple_iff {s : State} {p : Prog α} {c : ℕ} {Q : α → State → Prop} : + Triple w s p c Q ↔ (spec w).ValidHistory s ((spec w).clientHistory s p) ∧ + (spec w).totalCost charge s ((spec w).clientHistory s p) ≤ c ∧ + Q ((spec w).clientResult s p) ((spec w).clientState s p) := by + rw [Triple, StateTransitionSpec.costHoare_iff_ofFn, StateTransitionSpec.hoare_iff_ofFn] + constructor + · rintro ⟨h, hc⟩ + obtain ⟨hv, hq⟩ := h s rfl + exact ⟨hv, hc s rfl, hq⟩ + · rintro ⟨hv, hc, hq⟩ + exact ⟨fun _ h => h ▸ ⟨hv, hq⟩, fun _ h => h ▸ hc⟩ + +namespace Triple + +variable {s : State} {c c' : ℕ} {Q Q' : α → State → Prop} + +/-- Weaken the cost and the postcondition. -/ +theorem mono {p : Prog α} (h : Triple w s p c Q) (hc : c ≤ c') (hQ : ∀ a s', Q a s' → Q' a s') : + Triple w s p c' Q' := by + rw [triple_iff] at h ⊢ + exact ⟨h.1, h.2.1.trans hc, hQ _ _ h.2.2⟩ + +/-- Returning a value costs nothing. -/ +theorem pure {a : α} (h : Q a s) : Triple w s (Pure.pure a) c Q := + triple_iff.mpr ⟨trivial, Nat.zero_le c, h⟩ + +/-- Read an allocated cell, then continue with its contents. -/ +theorem read_bind {a : ℕ} {k : ℕ → Prog α} (ha : a < s.frontier) + (h : Triple w s (k (s.mem a)) c Q) : Triple w s (read a >>= k) (c + 1) Q := by + rw [triple_iff] at h ⊢ + obtain ⟨hv, hc, hq⟩ := h + refine ⟨⟨ha, hv⟩, ?_, hq⟩ + change 1 + (spec w).totalCost charge s ((spec w).clientHistory s (k (s.mem a))) ≤ c + 1 + omega + +/-- Write a word to an allocated cell, then continue. -/ +theorem write_bind {a v : ℕ} {k : Unit → Prog α} (ha : a < s.frontier) (hv : Fits w v) + (h : Triple w ⟨Function.update s.mem a v, s.frontier⟩ (k ()) c Q) : + Triple w s (write a v >>= k) (c + 1) Q := by + rw [triple_iff] at h ⊢ + obtain ⟨hvh, hc, hq⟩ := h + refine ⟨⟨⟨ha, hv⟩, hvh⟩, ?_, hq⟩ + change 1 + (spec w).totalCost charge ⟨Function.update s.mem a v, s.frontier⟩ + ((spec w).clientHistory ⟨Function.update s.mem a v, s.frontier⟩ (k ())) ≤ c + 1 + omega + +/-- Allocate a field of `k` cells without clearing it, then continue with the field at the +frontier. -/ +theorem allocBlockDirty_bind {k : ℕ} {next : Block → Prog α} (hk : Fits w (s.frontier + k)) + (h : Triple w ⟨s.mem, s.frontier + k⟩ (next ⟨s.frontier, k⟩) c Q) : + Triple w s (allocBlockDirty k >>= next) (c + 1) Q := by + rw [triple_iff] at h ⊢ + obtain ⟨hv, hc, hq⟩ := h + refine ⟨⟨hk, hv⟩, ?_, hq⟩ + change 1 + (spec w).totalCost charge ⟨s.mem, s.frontier + k⟩ + ((spec w).clientHistory ⟨s.mem, s.frontier + k⟩ (next ⟨s.frontier, k⟩)) ≤ c + 1 + omega + +/-- **Sequential composition.** Run `p` within `c₁`, and from each of its outcomes run the +continuation within `c₂`. -/ +theorem bind {p : Prog α} {k : α → Prog β} {c₁ c₂ : ℕ} {Q : β → State → Prop} + (h : Triple w s p c₁ fun a s' => Triple w s' (k a) c₂ Q) : + Triple w s (p >>= k) (c₁ + c₂) Q := by + rw [triple_iff] at h ⊢ + obtain ⟨hv₁, hc₁, h₂⟩ := h + rw [triple_iff] at h₂ + obtain ⟨hv₂, hc₂, hq⟩ := h₂ + have hrun := (spec w).runClient_bind p k s + have hhist : (spec w).clientHistory s (p >>= k) = (spec w).clientHistory s p ++ + (spec w).clientHistory ((spec w).clientState s p) (k ((spec w).clientResult s p)) := by + simp only [StateTransitionSpec.clientHistory] + exact congrArg (fun r => r.2.2) hrun + have hstate : (spec w).clientState s (p >>= k) = + (spec w).clientState ((spec w).clientState s p) (k ((spec w).clientResult s p)) := by + simp only [StateTransitionSpec.clientState] + exact congrArg (fun r => r.2.1) hrun + have hres : (spec w).clientResult s (p >>= k) = + (spec w).clientResult ((spec w).clientState s p) (k ((spec w).clientResult s p)) := + congrArg (fun r => r.1) hrun + have hmid := (spec w).run_runClient p s + refine ⟨?_, ?_, ?_⟩ + · rw [hhist, StateTransitionSpec.validHistory_append, hmid] + exact ⟨hv₁, hv₂⟩ + · rw [hhist, StateTransitionSpec.totalCost_append, hmid] + omega + · rw [hres, hstate] + exact hq + +end Triple + +/-! ## Memory that is zero above the frontier -/ + +/-- Every cell at or above the frontier holds `0`, as in the word RAM's initial memory past the +input. A dirty allocation from such a state hands out a zeroed block at the cost of one unit. -/ +def ZeroAbove (s : State) : Prop := ∀ a, s.frontier ≤ a → s.mem a = 0 + +/-- The input convention is zero above the frontier. -/ +theorem zeroAbove_init (input : List ℕ) : ZeroAbove (State.init input) := by + intro a ha + change (if a = 0 then input.length else input.getD (a - 1) 0) = 0 + have ha' : input.length + 1 ≤ a := ha + rw [ite_eq_right (by omega), List.getD_eq_getElem?_getD, List.getElem?_eq_none (by omega)] + rfl + +/-- A dirty allocation keeps memory zero above the new frontier. -/ +theorem ZeroAbove.allocDirty {s : State} (h : ZeroAbove s) (k : ℕ) : + ZeroAbove ⟨s.mem, s.frontier + k⟩ := fun a ha => h a (by simp only at ha; omega) + +end Cslib.DataStructure.Memory diff --git a/Complexity/DataStructure/PriorityQueue/BinaryHeap/Memory.lean b/Complexity/DataStructure/PriorityQueue/BinaryHeap/Memory.lean new file mode 100644 index 0000000000..0cb6b26d3e --- /dev/null +++ b/Complexity/DataStructure/PriorityQueue/BinaryHeap/Memory.lean @@ -0,0 +1,833 @@ +/- +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.Frame +public import Complexity.DataStructure.Memory.Triple +public import Complexity.DataStructure.PriorityQueue.BinaryHeap.Order +public import Complexity.DataStructure.StateTransition.Refinement +public import Mathlib.Data.Nat.Log + +/-! +# An indexed binary heap over the memory oracle + +The indexed min-priority queue `indexedMinPQSpec n K` is implemented as a binary heap by programs +over `Memory.spec w`. The storage is a `Layout`: a one-cell `size` field and three arrays from +`base`, exactly as in `BinaryHeap.Model`: the `key` of each handle, the `heap` of handles at +positions `1, …, size`, and the `pos`ition of each handle (`0` when absent). The abstraction +function is the model's `stateOfMem`, and the invariant is the model's `HeapInv` at the stored +size. Entries are ordered by `(key, handle)`, so `extractMin` returns exactly the spec's +`findMin`. + +Sift-up and sift-down are recursive memory programs (`siftUp`, `siftDown`). Their proofs are +inductions on the recursion, one level per call: the order lemmas of `BinaryHeap.Order` move the +single order defect one level, and the memory steps are discharged by the rules of +`Memory.Triple`. A level costs at most `8` memory units on the way up and `10` on the way down, so +every operation costs at most `10 ⌊log₂ n⌋ + 14` memory units (`amortized`). No register, address +arithmetic beyond the layout, or instruction count appears; word fit enters only through the +admissibility of `Memory.spec w` and two static facts of the layout, that `n` and the largest key +fit a word. + +The methods write only the layout's cells and never allocate (`methods_frame`), and the +abstraction and invariant read only those cells (`abs_congr`, `Inv.congr`), so the heap is framed +by its layout (`framed`) and composes with other structures in the same memory +(`Memory.Framed.prod`). Allocated in memory that is zero above the frontier, the heap starts empty +at a cost of two memory units (`allocLayout_bind`, `inv_allocated`). + +The word-RAM counterpart is `Cslib.DataStructure.PriorityQueue.WordRAM.BinaryHeap`, a hand-stepped +dispatcher over the same memory layout. + +## Main definitions + +* `Layout`, `Layout.footprint`, `Layout.Valid`: the size cell and the three arrays, the cells they + own, and their static well-formedness. +* `swap`, `siftUp`, `siftDown`: heap repair as memory programs. +* `isEmpty`, `getKey`, `insert`, `decreaseKey`, `extractMin`, `methods`: the operations. +* `abs`, `Inv`: the abstraction function and the implementation invariant. +* `opCost`: the memory cost of one operation, `10 ⌊log₂ n⌋ + 14`. +* `refinement`, `framed`: the binary heap as a `Refinement` of `indexedMinPQSpec n K`, framed by + its layout. +* `allocLayout`, `allocated`: allocate an empty heap, and the layout it hands out. + +## Main results + +* `siftUp_triple`, `siftDown_triple`: sift-up and sift-down repair one order defect within + `8 ⌊log₂ k⌋ + 4` and `10 (⌊log₂ S⌋ - ⌊log₂ k⌋) + 6` memory units. +* `methods_triple`: each operation realizes the specified step within `opCost n`. +* `amortized`: every operation costs at most `opCost n` memory units; `opCost_le` bounds it by + `14 (⌊log₂ n⌋ + 1)`. +* `methods_frame`, `abs_congr`, `Inv.congr`: the frame of a heap. +* `allocLayout_bind`, `valid_allocated`, `inv_allocated`: allocation yields an empty heap. + +## References + +* [T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein, *Introduction to Algorithms*, + Chapter 6][CLRS2009] +-/ + +@[expose] public section + +namespace Cslib.DataStructure.PriorityQueue.BinaryHeap.Memory + +open Cslib.WordRAM Cslib.DataStructure Cslib.DataStructure.Memory +open Cslib.DataStructure.PriorityQueue.WordRAM.BinaryHeap + +/-- The storage of an indexed binary heap on the handles `Fin n`: a one-cell field holding the +number of entries, and three arrays from `base`, laid out as in `BinaryHeap.Model`. -/ +structure Layout (n : ℕ) where + /-- One cell holding the number of entries. -/ + size : Block + /-- The start of the key, heap and position arrays. -/ + base : ℕ + +namespace Layout + +variable {n : ℕ} (L : Layout n) + +/-- The key of each handle, from `base`. -/ +abbrev key : Block := ⟨L.base, n⟩ + +/-- The handle at each heap position `1, …, size`, from `base + n`; position `0` is unused. -/ +abbrev heap : Block := ⟨L.base + n, n + 1⟩ + +/-- The heap position of each handle, `0` when the handle is absent, from `base + 2 n + 1`. -/ +abbrev pos : Block := ⟨L.base + 2 * n + 1, n⟩ + +/-- The cells of the three arrays. -/ +abbrev arrays : Block := ⟨L.base, space n⟩ + +/-- The cells a heap owns. -/ +def footprint : Finset ℕ := L.size.footprint ∪ L.arrays.footprint + +/-- Static well-formedness at word size `w` for keys at most `K`: the size field is one cell +outside the arrays, and `n` and `K` fit a word. -/ +structure Valid (L : Layout n) (w K : ℕ) : Prop where + /-- The size field is one cell. -/ + size_length : L.size.length = 1 + /-- The size cell is not in the arrays. -/ + size_not_owns : ¬L.arrays.Owns L.size.base + /-- The number of handles fits a word, hence so does every handle and position. -/ + n_fits : Fits w n + /-- The largest key fits a word. -/ + key_fits : Fits w K + +end Layout + +variable {n : ℕ} (L : Layout n) + +/-! ## The programs -/ + +/-- Swap the handles `va` at heap position `a` and `vb` at heap position `b`. -/ +def swap (a b va vb : ℕ) : Prog Unit := do + L.heap.set a vb + L.heap.set b va + L.pos.set vb a + L.pos.set va b + +/-- Sift-up from heap position `k`: while the entry at `k` has higher priority than its parent, +swap them and continue from the parent. -/ +def siftUp (k : ℕ) : Prog Unit := + if 2 ≤ k then do + let vk ← L.heap.get k + let kk ← L.key.get vk + let vp ← L.heap.get (k / 2) + let kp ← L.key.get vp + if IndexedMinPQ.RawPrioLT (vk, kk) (vp, kp) then do + swap L k (k / 2) vk vp + siftUp (k / 2) + else pure () + else pure () +termination_by k +decreasing_by omega + +/-- One step of sift-down: if the child entry `(vc, kc)` at position `c` has higher priority than +the entry `(vk, kk)` at position `k`, swap them and continue with `next`. -/ +def sink (k c vk kk vc kc : ℕ) (next : Prog Unit) : Prog Unit := + if IndexedMinPQ.RawPrioLT (vc, kc) (vk, kk) then do + swap L k c vk vc + next + else pure () + +/-- Sift-down from heap position `k` in a heap of size `S`: while some child has higher priority +than the entry at `k`, swap the entry with its child of highest priority and continue from that +child. -/ +def siftDown (S k : ℕ) : Prog Unit := + if 1 ≤ k ∧ 2 * k ≤ S then do + let vk ← L.heap.get k + let kk ← L.key.get vk + let vl ← L.heap.get (2 * k) + let kl ← L.key.get vl + if 2 * k + 1 ≤ S then do + let vr ← L.heap.get (2 * k + 1) + let kr ← L.key.get vr + if IndexedMinPQ.RawPrioLT (vr, kr) (vl, kl) then + sink L k (2 * k + 1) vk kk vr kr (siftDown S (2 * k + 1)) + else sink L k (2 * k) vk kk vl kl (siftDown S (2 * k)) + else sink L k (2 * k) vk kk vl kl (siftDown S (2 * k)) + else pure () +termination_by S + 1 - k +decreasing_by all_goals omega + +/-- Test for emptiness: read the size. -/ +def isEmpty : Prog Bool := do + let S ← L.size.get 0 + pure (decide (S = 0)) + +/-- The key of handle `v`: absent when its position is `0`. -/ +def getKey (v : Fin n) : Prog (Option ℕ) := do + let p ← L.pos.get v + if p = 0 then pure none else do + let k ← L.key.get v + pure (some k) + +/-- Insert the absent handle `v` with key `k`: store the key, append `v` at the end of the heap, +and sift it up. -/ +def insert (v : Fin n) (k : ℕ) : Prog Unit := do + let S ← L.size.get 0 + L.size.set 0 (S + 1) + L.key.set v k + L.heap.set (S + 1) v + L.pos.set v (S + 1) + siftUp L (S + 1) + +/-- Lower the key of the present handle `v` to `k`, and sift it up from its position. -/ +def decreaseKey (v : Fin n) (k : ℕ) : Prog Unit := do + let p ← L.pos.get v + L.key.set v k + siftUp L p + +variable (n) in +/-- The answer of `extractMin` for the handle `u` with key `k`. -/ +def entry (u k : ℕ) : Option (Fin n × ℕ) := if h : u < n then some (⟨u, h⟩, k) else none + +/-- Remove the root and return it: move the last entry to the root, sift it down, and store the +new size. -/ +def extractMin : Prog (Option (Fin n × ℕ)) := do + let S ← L.size.get 0 + if S = 0 then pure none else do + let u ← L.heap.get 1 + let k ← L.key.get u + if S = 1 then do + L.pos.set u 0 + L.size.set 0 0 + pure (entry n u k) + else do + let last ← L.heap.get S + L.pos.set u 0 + L.heap.set 1 last + L.pos.set last 1 + siftDown L (S - 1) 1 + L.size.set 0 (S - 1) + pure (entry n u k) + +/-- The operations of the indexed min-priority queue as memory programs. -/ +def ops : (o : IndexedMinPQ.Op n) → Prog o.Result + | .isEmpty => isEmpty L + | .getKey v => getKey L v + | .insert v k => insert L v k + | .decreaseKey v k => decreaseKey L v k + | .extractMin => extractMin L + +/-- The operations as methods of `indexedMinPQSpec n K` over `Memory.spec w`. -/ +abbrev methods (w K : ℕ) : Methods (indexedMinPQSpec n K) (Memory.spec w) := ops L + +/-- The represented queue: the model's decoding of the key and position arrays. -/ +def abs (s : Memory.State) : IndexedMinPQ.State n := stateOfMem n L.base s.mem + +/-- The implementation invariant: the fields are allocated, and the arrays hold a binary heap of +the stored size. -/ +structure Inv (s : Memory.State) : Prop where + /-- The size cell is allocated. -/ + size_allocated : L.size.Allocated s + /-- The arrays are allocated. -/ + arrays_allocated : L.arrays.Allocated s + /-- The arrays hold a binary heap of the stored size. -/ + heap : HeapInv n L.base (s.mem L.size.base) s.mem + +/-- The memory cost of one operation on `n` handles: `10 ⌊log₂ n⌋ + 14` units. -/ +def opCost (n : ℕ) : ℕ := 10 * Nat.log 2 n + 14 + +/-! ## Layout facts -/ + +variable {L} + +/-- A key cell is allocated. -/ +theorem key_lt {s : Memory.State} (hA : L.arrays.Allocated s) {v : ℕ} (hv : v < n) : + L.key.base + v < s.frontier := by + simp only [Block.Allocated, space] at hA ⊢ + omega + +/-- A heap cell is allocated. -/ +theorem heap_lt {s : Memory.State} (hA : L.arrays.Allocated s) {i : ℕ} (hi : i ≤ n) : + L.heap.base + i < s.frontier := by + simp only [Block.Allocated, space] at hA ⊢ + omega + +/-- A position cell is allocated. -/ +theorem pos_lt {s : Memory.State} (hA : L.arrays.Allocated s) {v : ℕ} (hv : v < n) : + L.pos.base + v < s.frontier := by + simp only [Block.Allocated, space] at hA ⊢ + omega + +/-! ## Rearranging the heap -/ + +variable (L) in +/-- `s'` is `s` with the heap and position arrays rearranged: the frontier, the keys, the presence +of each handle and every cell outside those two arrays are unchanged. -/ +structure Rearranges (s s' : Memory.State) : Prop where + /-- The frontier is unchanged. -/ + frontier_eq : s'.frontier = s.frontier + /-- Each handle is present exactly when it was. -/ + pos_eq_zero : ∀ v < n, s'.mem (L.base + 2 * n + 1 + v) = 0 ↔ s.mem (L.base + 2 * n + 1 + v) = 0 + /-- Cells outside the heap and position arrays are unchanged. -/ + outside : ∀ a, a ≤ L.base + n ∨ L.base + 3 * n < a → s'.mem a = s.mem a + +namespace Rearranges + +/-- Every state is a rearrangement of itself. -/ +theorem refl (s : Memory.State) : Rearranges L s s := + ⟨rfl, fun _ _ => Iff.rfl, fun _ _ => rfl⟩ + +/-- Rearrangements compose. -/ +theorem trans {s₁ s₂ s₃ : Memory.State} (h₁ : Rearranges L s₁ s₂) (h₂ : Rearranges L s₂ s₃) : + Rearranges L s₁ s₃ := + ⟨h₂.frontier_eq.trans h₁.frontier_eq, + fun v hv => (h₂.pos_eq_zero v hv).trans (h₁.pos_eq_zero v hv), + fun a ha => (h₂.outside a ha).trans (h₁.outside a ha)⟩ + +/-- A swap of two heap positions rearranges the heap. -/ +theorem swap {s : Memory.State} {S a b : ℕ} (h : HeapShape n L.base S s.mem) (ha : 1 ≤ a) + (haS : a ≤ S) (hb : 1 ≤ b) (hbS : b ≤ S) (hab : a ≠ b) : + Rearranges L s ⟨swapMem n L.base s.mem a b (s.mem (L.base + n + a)) (s.mem (L.base + n + b)), + s.frontier⟩ := by + obtain ⟨-, -, -, -, hpos, hout⟩ := h.swap ha haS hb hbS hab + exact ⟨rfl, hpos, hout⟩ + +end Rearranges + +/-! ## Sift-up and sift-down -/ + +variable {w : ℕ} + +/-- Swapping two heap positions writes four cells. -/ +theorem swap_bind {α : Type} {s : Memory.State} {a b va vb c : ℕ} {k : Unit → Prog α} + {Q : α → Memory.State → Prop} (hn : Fits w n) (hA : L.arrays.Allocated s) (ha : a ≤ n) + (hb : b ≤ n) (hva : va < n) (hvb : vb < n) + (h : Triple w ⟨swapMem n L.base s.mem a b va vb, s.frontier⟩ (k ()) c Q) : + Triple w s (swap L a b va vb >>= k) (c + 4) Q := by + simp only [swap, bind_assoc] + exact Triple.write_bind (heap_lt hA ha) (hn.of_le hvb.le) <| + Triple.write_bind (heap_lt hA hb) (hn.of_le hva.le) <| + Triple.write_bind (pos_lt hA hvb) (hn.of_le ha) <| + Triple.write_bind (pos_lt hA hva) (hn.of_le hb) h + +/-- **Sift-up** repairs an upward defect at heap position `k` within `8 ⌊log₂ k⌋ + 4` memory +units. -/ +theorem siftUp_triple (hn : Fits w n) {S : ℕ} {s : Memory.State} {k : ℕ} + (hA : L.arrays.Allocated s) (hk : 1 ≤ k) (hkS : k ≤ S) (hshape : HeapShape n L.base S s.mem) + (hord : UpOrdered (heapEntry n L.base s.mem) S k) : + Triple w s (siftUp L k) (8 * Nat.log 2 k + 4) + fun _ s' => HeapInv n L.base S s'.mem ∧ Rearranges L s s' := by + rw [siftUp] + split_ifs with h2 + · have hSn := hshape.size_le + have hvk := hshape.vertex_lt k hk hkS + have hvp := hshape.vertex_lt (k / 2) (by omega) (by omega) + have hlog : Nat.log 2 k = Nat.log 2 (k / 2) + 1 := Nat.log_of_one_lt_of_le one_lt_two h2 + refine (?_ : Triple w s _ (8 * Nat.log 2 (k / 2) + 4 + 8) _).mono (by omega) + fun _ _ h => h + refine Triple.read_bind (heap_lt hA (by omega)) <| Triple.read_bind (key_lt hA hvk) <| + Triple.read_bind (heap_lt hA (by omega)) <| Triple.read_bind (key_lt hA hvp) ?_ + split_ifs with hlt + · obtain ⟨hs', hga, hgb, hgo, -, -⟩ := + hshape.swap (a := k) (b := k / 2) hk hkS (by omega) (by omega) (by omega) + have hr := Rearranges.swap (L := L) hshape hk hkS (b := k / 2) (by omega) (by omega) + (by omega) + refine swap_bind hn hA (by omega) (by omega) hvk hvp <| + (siftUp_triple hn (hr.frontier_eq ▸ hA) (by omega) (by omega) hs' + (hord.swap h2 hkS hlt hga hgb hgo)).mono le_rfl fun _ _ h => ⟨h.1, hr.trans h.2⟩ + · exact Triple.pure ⟨⟨hshape, hord.ordered fun _ _ => + IndexedMinPQ.not_rawPrioLT_iff_rawPrioLE.mp hlt⟩, Rearranges.refl s⟩ + · exact Triple.pure ⟨⟨hshape, hord.ordered fun h => absurd h h2⟩, Rearranges.refl s⟩ +termination_by k +decreasing_by omega + +/-- One step of sift-down: a swap with the child when it has higher priority, then `next`. -/ +theorem sink_triple {s : Memory.State} {k c vk kk vc kc cost : ℕ} {next : Prog Unit} + {Q : Unit → Memory.State → Prop} (hn : Fits w n) (hA : L.arrays.Allocated s) (hk : k ≤ n) + (hc : c ≤ n) (hvk : vk < n) (hvc : vc < n) + (hswap : IndexedMinPQ.RawPrioLT (vc, kc) (vk, kk) → + Triple w ⟨swapMem n L.base s.mem k c vk vc, s.frontier⟩ next cost Q) + (hstop : ¬IndexedMinPQ.RawPrioLT (vc, kc) (vk, kk) → Q () s) : + Triple w s (sink L k c vk kk vc kc next) (cost + 4) Q := by + rw [sink] + split_ifs with hlt + · exact swap_bind hn hA hk hc hvk hvc (hswap hlt) + · exact Triple.pure (hstop hlt) + +/-- **Sift-down** repairs a downward defect at heap position `k` of a heap of size `S` within +`10 (⌊log₂ S⌋ - ⌊log₂ k⌋) + 6` memory units. -/ +theorem siftDown_triple (hn : Fits w n) {S : ℕ} {s : Memory.State} {k : ℕ} + (hA : L.arrays.Allocated s) (hk : 1 ≤ k) (hkS : k ≤ S) (hshape : HeapShape n L.base S s.mem) + (hord : DownOrdered (heapEntry n L.base s.mem) S k) : + Triple w s (siftDown L S k) (10 * (Nat.log 2 S - Nat.log 2 k) + 6) + fun _ s' => HeapInv n L.base S s'.mem ∧ Rearranges L s s' := by + rw [siftDown] + split + next h2 => + have hSn := hshape.size_le + have hvk := hshape.vertex_lt k hk hkS + have hvl := hshape.vertex_lt (2 * k) (by omega) h2.2 + have hlogS : Nat.log 2 (2 * k) ≤ Nat.log 2 S := Nat.log_mono_right h2.2 + have hlogc : ∀ c, c / 2 = k → Nat.log 2 c = Nat.log 2 k + 1 := fun c hc => by + rw [Nat.log_of_one_lt_of_le one_lt_two (by omega), hc] + have hlog2 := hlogc (2 * k) (by omega) + -- The step to the child `c` of highest priority, whichever child it is. + have step : ∀ c, c / 2 = k → c ≤ S → c = minChild (heapEntry n L.base s.mem) S k → + Triple w s (sink L k c (s.mem (L.base + n + k)) (s.mem (L.base + s.mem (L.base + n + k))) + (s.mem (L.base + n + c)) (s.mem (L.base + s.mem (L.base + n + c))) (siftDown L S c)) + (10 * (Nat.log 2 S - (Nat.log 2 k + 1)) + 6 + 4) + fun _ s' => HeapInv n L.base S s'.mem ∧ Rearranges L s s' := by + intro c hck hcS hcmin + obtain ⟨-, -, hmin⟩ := minChild_spec (f := heapEntry n L.base s.mem) (S := S) (a := k) h2.2 + rw [← hcmin] at hmin + refine sink_triple hn hA (by omega) (by omega) hvk (hshape.vertex_lt c (by omega) hcS) + (fun hlt => ?_) fun hlt => ⟨⟨hshape, hord.ordered fun i _ hiS hia => + (IndexedMinPQ.not_rawPrioLT_iff_rawPrioLE.mp hlt).trans (hmin i hiS hia)⟩, + Rearranges.refl s⟩ + obtain ⟨hs', hga, hgc, hgo, -, -⟩ := + hshape.swap (a := k) (b := c) hk hkS (by omega) hcS (by omega) + have hr := Rearranges.swap (L := L) hshape hk hkS (b := c) (by omega) hcS (by omega) + refine (siftDown_triple hn (hr.frontier_eq ▸ hA) (by omega) hcS hs' + (hord.swap hck hcS (fun i _ hiS hia => hmin i hiS hia) hlt hga hgc hgo)).mono + (by rw [hlogc c hck]) fun _ _ h => ⟨h.1, hr.trans h.2⟩ + refine (?_ : Triple w s _ (10 * (Nat.log 2 S - (Nat.log 2 k + 1)) + 6 + 10) _).mono + (by omega) fun _ _ h => h + refine Triple.read_bind (heap_lt hA (by omega)) <| Triple.read_bind (key_lt hA hvk) <| + Triple.read_bind (heap_lt hA (by omega)) <| Triple.read_bind (key_lt hA hvl) ?_ + split + next hr => + have hvr := hshape.vertex_lt (2 * k + 1) (by omega) hr + refine Triple.read_bind (heap_lt hA (by omega)) <| Triple.read_bind (key_lt hA hvr) ?_ + split + next hlr => + exact step (2 * k + 1) (by omega) hr (ite_eq_left (c := _ ∧ _) ⟨hr, hlr⟩).symm + next hlr => + exact step (2 * k) (by omega) h2.2 (ite_eq_right (c := _ ∧ _) fun h => hlr h.2).symm + next hr => + exact (step (2 * k) (by omega) h2.2 (ite_eq_right (c := _ ∧ _) fun h => hr h.1).symm).mono + (by omega) fun _ _ h => h + next h2 => + exact Triple.pure ⟨⟨hshape, hord.ordered fun i hi hiS hia => absurd hiS (by omega)⟩, + Rearranges.refl s⟩ +termination_by S + 1 - k +decreasing_by all_goals omega + +/-! ## The abstraction -/ + +/-- A rearrangement represents the same queue. -/ +theorem Rearranges.abs_eq {s s' : Memory.State} (h : Rearranges L s s') : abs L s' = abs L s := by + funext ⟨v, hv⟩ + have hk := h.outside (L.base + v) (.inl (by omega)) + have hp := h.pos_eq_zero v hv + simp only [abs, stateOfMem, hk] + by_cases h0 : s.mem (L.base + 2 * n + 1 + v) = 0 + · simp [h0, hp.mpr h0] + · simp [h0, mt hp.mp h0] + +/-- A memory that keeps the key and the presence of every handle but `v` represents the queue +updated at `v`. -/ +theorem abs_eq_update {s s' : Memory.State} {v : Fin n} {x : Option ℕ} + (hother : ∀ u : Fin n, u ≠ v → s'.mem (L.base + u) = s.mem (L.base + u) ∧ + (s'.mem (L.base + 2 * n + 1 + u) = 0 ↔ s.mem (L.base + 2 * n + 1 + u) = 0)) + (hv : abs L s' v = x) : abs L s' = Function.update (abs L s) v x := by + funext u + by_cases huv : u = v + · subst huv + rw [Function.update_self, hv] + · rw [Function.update_of_ne huv] + obtain ⟨hk, hp⟩ := hother u huv + simp only [abs, stateOfMem, hk] + by_cases h0 : s.mem (L.base + 2 * n + 1 + u) = 0 + · simp [h0, hp.mpr h0] + · simp [h0, mt hp.mp h0] + +/-! ## The operations -/ + +variable {K : ℕ} + +/-- The cells outside the layout: neither the size cell nor an array cell. -/ +theorem not_mem_footprint (hL : L.Valid w K) {a : ℕ} (ha : a ∉ L.footprint) : + a ≠ L.size.base ∧ (a < L.base ∨ L.base + 3 * n + 1 ≤ a) := by + simp only [Layout.footprint, Finset.mem_union, Block.mem_footprint, Block.Owns, not_or, + not_and_or, not_le, not_lt, hL.size_length, space] at ha + omega + +/-- The size cell lies outside the arrays. -/ +theorem size_outside (hL : L.Valid w K) : + L.size.base < L.base ∨ L.base + 3 * n + 1 ≤ L.size.base := by + have h := hL.size_not_owns + simp only [Block.Owns, not_and_or, not_le, not_lt, space] at h + omega + +/-- The size cell is allocated. -/ +theorem Inv.size_lt (hL : L.Valid w K) {s : Memory.State} (hs : Inv L s) : + L.size.base + 0 < s.frontier := + hs.size_allocated.lt_frontier (by rw [hL.size_length]; omega) + +/-- A heap invariant survives a write to the size cell. -/ +theorem heapInv_update_size (hL : L.Valid w K) {S : ℕ} {m : ℕ → ℕ} + (h : HeapInv n L.base S m) (x : ℕ) : + HeapInv n L.base S (Function.update m L.size.base x) := + h.congr_mem fun a ha => Function.update_of_ne (fun he => hL.size_not_owns + (by rw [← he]; exact Block.mem_footprint.mp ha)) x m + +variable (L) in +/-- What a run of the operation `o` from `s` establishes: the specified step from the represented +queue, the invariant, and the frame: the frontier and every cell outside the layout are +unchanged. -/ +def Post (s : Memory.State) (o : IndexedMinPQ.Op n) (r : o.Result) (s' : Memory.State) : Prop := + IndexedMinPQ.step (abs L s) o = (abs L s', r) ∧ Inv L s' ∧ s'.frontier = s.frontier ∧ + ∀ a ∉ L.footprint, s'.mem a = s.mem a + +/-- An operation that only reads realizes a step that leaves the queue unchanged. -/ +theorem post_self {s : Memory.State} (hs : Inv L s) {o : IndexedMinPQ.Op n} {r : o.Result} + (h : IndexedMinPQ.step (abs L s) o = (abs L s, r)) : Post L s o r s := + ⟨h, hs, rfl, fun _ _ => rfl⟩ + +/-- `isEmpty` reads the size. -/ +theorem isEmpty_triple (hL : L.Valid w K) {s : Memory.State} (hs : Inv L s) : + Triple w s (isEmpty L) 1 (Post L s .isEmpty) := by + refine Triple.read_bind (hs.size_lt hL) (Triple.pure (post_self hs ?_)) + exact Prod.ext rfl (decide_eq_decide.mpr hs.heap.size_eq_zero_iff).symm + +/-- `getKey` reads the position and, for a present handle, the key. -/ +theorem getKey_triple {s : Memory.State} (hs : Inv L s) (v : Fin n) : + Triple w s (getKey L v) 2 (Post L s (.getKey v)) := by + refine Triple.read_bind (pos_lt hs.arrays_allocated v.isLt) ?_ + split + next hp => exact Triple.pure (post_self hs (Prod.ext rfl (ite_eq_left hp))) + next hp => + exact Triple.read_bind (key_lt hs.arrays_allocated v.isLt) + (Triple.pure (post_self hs (Prod.ext rfl (ite_eq_right hp)))) + +/-- `insert` appends the handle and sifts it up, within `8 ⌊log₂ n⌋ + 9` memory units. -/ +theorem insert_triple (hL : L.Valid w K) {s : Memory.State} (hs : Inv L s) {v : Fin n} {k : ℕ} + (hv : IndexedMinPQ.valid K (abs L s) (.insert v k)) : + Triple w s (insert L v k) (8 * Nat.log 2 n + 9) (Post L s (.insert v k)) := by + obtain ⟨hnone, hk⟩ := hv + have hA := hs.arrays_allocated + have hp : s.mem (L.base + 2 * n + 1 + v) = 0 := by + by_contra h + simp [abs, stateOfMem, h] at hnone + have hSn := hs.heap.size_lt v.isLt hp + have hsz := size_outside hL + have hlog := Nat.log_mono_right (b := 2) (show s.mem L.size.base + 1 ≤ n by omega) + refine (?_ : Triple w s _ (8 * Nat.log 2 (s.mem L.size.base + 1) + 4 + 5) _).mono (by omega) + fun _ _ h => h + refine Triple.read_bind (hs.size_lt hL) ?_ + simp only [Nat.add_zero] + refine Triple.write_bind (hs.size_lt hL) (hL.n_fits.of_le (by omega)) <| + Triple.write_bind (key_lt hA v.isLt) (hL.key_fits.of_le hk) <| + Triple.write_bind (heap_lt hA (by omega)) (hL.n_fits.of_le v.isLt.le) <| + Triple.write_bind (pos_lt hA v.isLt) (hL.n_fits.of_le (by omega)) ?_ + obtain ⟨hshape, hord⟩ := (heapInv_update_size hL hs.heap (s.mem L.size.base + 1)).push v.isLt + (c := k) (by rw [Function.update_of_ne (by omega)]; exact hp) + refine Triple.mono (siftUp_triple hL.n_fits hA (by omega) le_rfl hshape hord) le_rfl ?_ + rintro _ s' ⟨hinv, hr⟩ + have hsize : s'.mem L.size.base = s.mem L.size.base + 1 := by + rw [hr.outside _ (by omega)] + simp only [Function.update_apply] + split_ifs <;> omega + refine ⟨?_, ⟨hs.size_allocated.mono (by rw [hr.frontier_eq]), + hA.mono (by rw [hr.frontier_eq]), hsize ▸ hinv⟩, hr.frontier_eq, fun a ha => ?_⟩ + · rw [hr.abs_eq] + refine Prod.ext (abs_eq_update (fun u hu => ?_) ?_).symm rfl + · have hu' : (u : ℕ) ≠ v := Fin.val_ne_of_ne hu + simp only [Function.update_apply] + refine ⟨?_, ?_⟩ <;> split_ifs <;> omega + · simp only [abs, stateOfMem, Function.update_apply] + split_ifs <;> first | rfl | (exfalso; omega) + · obtain ⟨ha₁, ha₂⟩ := not_mem_footprint hL ha + rw [hr.outside a (by omega)] + simp only [Function.update_apply] + split_ifs <;> omega + +/-- `decreaseKey` lowers the key and sifts the handle up, within `8 ⌊log₂ n⌋ + 6` memory units. -/ +theorem decreaseKey_triple (hL : L.Valid w K) {s : Memory.State} (hs : Inv L s) {v : Fin n} + {k : ℕ} (hv : IndexedMinPQ.valid K (abs L s) (.decreaseKey v k)) : + Triple w s (decreaseKey L v k) (8 * Nat.log 2 n + 6) (Post L s (.decreaseKey v k)) := by + obtain ⟨⟨k₀, hk₀, hle⟩, hk⟩ := hv + have hA := hs.arrays_allocated + have hp : s.mem (L.base + 2 * n + 1 + v) ≠ 0 := by + intro h + simp [abs, stateOfMem, h] at hk₀ + have hkey : s.mem (L.base + v) = k₀ := by simpa [abs, stateOfMem, hp] using hk₀ + have hsz := size_outside hL + have hpS := hs.heap.pos_le v v.isLt + have hSn := hs.heap.size_le + have hlog := Nat.log_mono_right (b := 2) (show s.mem (L.base + 2 * n + 1 + v) ≤ n by omega) + refine (?_ : Triple w s _ (8 * Nat.log 2 (s.mem (L.base + 2 * n + 1 + v)) + 4 + 2) _).mono + (by omega) fun _ _ h => h + refine Triple.read_bind (pos_lt hA v.isLt) <| + Triple.write_bind (key_lt hA v.isLt) (hL.key_fits.of_le hk) ?_ + obtain ⟨hshape, hord⟩ := hs.heap.decrease v.isLt hp (c := k) (by omega) + refine Triple.mono (siftUp_triple hL.n_fits hA (Nat.one_le_iff_ne_zero.mpr hp) hpS hshape hord) + le_rfl ?_ + rintro _ s' ⟨hinv, hr⟩ + have hsize : s'.mem L.size.base = s.mem L.size.base := by + rw [hr.outside _ (by omega)] + exact Function.update_of_ne (show L.size.base ≠ L.base + v by omega) _ _ + refine ⟨?_, ⟨hs.size_allocated.mono (by rw [hr.frontier_eq]), + hA.mono (by rw [hr.frontier_eq]), hsize ▸ hinv⟩, hr.frontier_eq, fun a ha => ?_⟩ + · rw [hr.abs_eq] + refine Prod.ext (abs_eq_update (fun u hu => ?_) ?_).symm rfl + · have hu' : (u : ℕ) ≠ v := Fin.val_ne_of_ne hu + simp only [Function.update_apply] + refine ⟨?_, ?_⟩ <;> split_ifs <;> omega + · simp only [abs, stateOfMem, Function.update_apply] + split_ifs <;> first | rfl | (exfalso; omega) + · obtain ⟨ha₁, ha₂⟩ := not_mem_footprint hL ha + rw [hr.outside a (by omega)] + simp only [Function.update_apply] + split_ifs <;> omega + +/-- The answer for a handle. -/ +theorem entry_of_lt {u : ℕ} (hu : u < n) (k : ℕ) : entry n u k = some (⟨u, hu⟩, k) := + dite_eq_left hu + +/-- The postcondition of an extraction that removes the minimum `(u, k)`. -/ +theorem post_extract {s s' : Memory.State} {u k : ℕ} (hu : u < n) + (hfind : IndexedMinPQ.findMin (abs L s) = some (⟨u, hu⟩, k)) + (habs : abs L s' = Function.update (abs L s) ⟨u, hu⟩ none) (hinv : Inv L s') + (hf : s'.frontier = s.frontier) (hframe : ∀ a ∉ L.footprint, s'.mem a = s.mem a) : + Post L s .extractMin (entry n u k) s' := + ⟨by simp only [IndexedMinPQ.step, hfind, habs, entry_of_lt hu], hinv, hf, hframe⟩ + +/-- `extractMin` removes the root, moves the last entry up and sifts it down, within `opCost n` +memory units. -/ +theorem extractMin_triple (hL : L.Valid w K) {s : Memory.State} (hs : Inv L s) : + Triple w s (extractMin L) (opCost n) (Post L s .extractMin) := by + have hA := hs.arrays_allocated + have hsz := size_outside hL + obtain ⟨S, hS⟩ : ∃ S, s.mem L.size.base = S := ⟨_, rfl⟩ + have hinv : HeapInv n L.base S s.mem := hS ▸ hs.heap + have hSn := hinv.size_le + have hlog := Nat.log_mono_right (b := 2) (show S - 1 ≤ n by omega) + refine (?_ : Triple w s _ (10 * (Nat.log 2 (S - 1) - Nat.log 2 1) + 6 + 1 + 7) _).mono + (by simp only [opCost, Nat.log_one_right]; omega) fun _ _ h => h + refine Triple.read_bind (hs.size_lt hL) ?_ + simp only [Nat.add_zero, hS] + split + next h0 => + refine Triple.pure (post_self hs ?_) + have hfind : IndexedMinPQ.findMin (abs L s) = none := + IndexedMinPQ.findMin_eq_none_iff.mpr (hinv.size_eq_zero_iff.mp h0) + simp only [IndexedMinPQ.step, hfind] + next h0 => + have hS1 : 1 ≤ S := Nat.one_le_iff_ne_zero.mpr h0 + have hroot := hinv.vertex_lt 1 le_rfl hS1 + have hfind := hinv.findMin_eq_root hS1 + refine Triple.read_bind (heap_lt hA (by omega)) <| Triple.read_bind (key_lt hA hroot) ?_ + split + next h1 => + subst h1 + have hzero := hinv.extract_one + refine Triple.write_bind (pos_lt hA hroot) (fits_zero w) <| + Triple.write_bind (hs.size_lt hL) (fits_zero w) <| Triple.pure ?_ + refine post_extract (u := s.mem (L.base + n + 1)) hroot hfind ?_ + ⟨hs.size_allocated, hA, ?_⟩ rfl fun a ha => ?_ + · refine abs_eq_update (fun u hu => ?_) ?_ + · have hu' : (u : ℕ) ≠ s.mem (L.base + n + 1) := Fin.val_ne_of_ne hu + simp only [Nat.add_zero, Function.update_apply] + refine ⟨?_, ?_⟩ <;> split_ifs <;> omega + · simp only [abs, stateOfMem, Nat.add_zero, + Function.update_apply] + split_ifs <;> first | rfl | (exfalso; omega) + · have h := heapInv_update_size hL hzero 0 + simp only [Nat.add_zero, Function.update_self] + exact h + · obtain ⟨ha₁, ha₂⟩ := not_mem_footprint hL ha + simp only [Nat.add_zero, Function.update_apply] + split_ifs <;> omega + next h1 => + have hS2 : 2 ≤ S := by omega + have hlast := hinv.vertex_lt S (by omega) le_rfl + obtain ⟨hshape', hdown, hpos'⟩ := hinv.extract hS2 + refine Triple.read_bind (heap_lt hA (by omega)) <| + Triple.write_bind (pos_lt hA hroot) (fits_zero w) <| + Triple.write_bind (heap_lt hA (by omega)) (hL.n_fits.of_le hlast.le) <| + Triple.write_bind (pos_lt hA hlast) (hL.n_fits.of_le (by omega)) ?_ + refine Triple.bind (c₁ := 10 * (Nat.log 2 (S - 1) - Nat.log 2 1) + 6) (c₂ := 1) + (Triple.mono (siftDown_triple hL.n_fits hA le_rfl (by omega) hshape' hdown) le_rfl ?_) + rintro _ s' ⟨hinv', hr⟩ + refine Triple.write_bind (hr.frontier_eq ▸ hs.size_lt hL) (hL.n_fits.of_le (by omega)) <| + Triple.pure ?_ + refine post_extract (u := s.mem (L.base + n + 1)) hroot hfind ?_ + ⟨hs.size_allocated.mono (by rw [hr.frontier_eq]), hA.mono (by rw [hr.frontier_eq]), ?_⟩ + hr.frontier_eq fun a ha => ?_ + · have habs' := hr.abs_eq + refine abs_eq_update (fun u hu => ?_) ?_ + · have hu' : (u : ℕ) ≠ s.mem (L.base + n + 1) := Fin.val_ne_of_ne hu + have hp := hpos' u u.isLt + have hk' := hr.outside (L.base + u) (.inl (by omega)) + have hp' := hr.pos_eq_zero u u.isLt + simp only [Layout.heap, Layout.pos, Nat.add_zero, Function.update_apply] + at hp hk' hp' ⊢ + refine ⟨?_, ?_⟩ + · split_ifs <;> first | omega | (rw [hk']; split_ifs <;> omega) + · split_ifs <;> omega + · have hp := (hr.pos_eq_zero _ hroot).mpr ((hpos' _ hroot).mpr (.inr rfl)) + simp only [abs, stateOfMem, Nat.add_zero, Function.update_apply] + split_ifs <;> first | rfl | (exfalso; omega) + · simp only [Nat.add_zero, Function.update_self] + exact heapInv_update_size hL hinv' _ + · obtain ⟨ha₁, ha₂⟩ := not_mem_footprint hL ha + have := hr.outside a (by omega) + simp only [Layout.heap, Layout.pos, Nat.add_zero, Function.update_apply] + at this ⊢ + split_ifs at this ⊢ <;> omega + +/-- **Each operation realizes the specified step** within `opCost n` memory units, keeps the +invariant, and changes neither the frontier nor any cell outside the layout. -/ +theorem methods_triple (hL : L.Valid w K) {s : Memory.State} (hs : Inv L s) + (o : IndexedMinPQ.Op n) (hv : IndexedMinPQ.valid K (abs L s) o) : + Triple w s (ops L o) (opCost n) (Post L s o) := by + cases o with + | isEmpty => exact (isEmpty_triple hL hs).mono (by unfold opCost; omega) fun _ _ h => h + | getKey v => exact (getKey_triple hs v).mono (by unfold opCost; omega) fun _ _ h => h + | insert v k => exact (insert_triple hL hs hv).mono (by unfold opCost; omega) fun _ _ h => h + | decreaseKey v k => + exact (decreaseKey_triple hL hs hv).mono (by unfold opCost; omega) fun _ _ h => h + | extractMin => exact extractMin_triple hL hs + +/-- The run of an operation, by `methods_triple`. -/ +theorem methods_run (hL : L.Valid w K) {s : Memory.State} (hs : Inv L s) + (o : IndexedMinPQ.Op n) (hv : IndexedMinPQ.valid K (abs L s) o) : + (Memory.spec w).ValidHistory s ((Memory.spec w).clientHistory s (ops L o)) ∧ + (Memory.spec w).totalCost charge s ((Memory.spec w).clientHistory s (ops L o)) ≤ opCost n ∧ + Post L s o ((Memory.spec w).clientResult s (ops L o)) + ((Memory.spec w).clientState s (ops L o)) := + triple_iff.mp (methods_triple hL hs o hv) + +/-- An operation changes no cell outside the layout. -/ +theorem methods_frame (hL : L.Valid w K) {s : Memory.State} (hs : Inv L s) + (o : IndexedMinPQ.Op n) (hv : IndexedMinPQ.valid K (abs L s) o) : + ∀ a ∉ L.footprint, ((Memory.spec w).clientState s (ops L o)).mem a = s.mem a := by + obtain ⟨-, -, -, -, -, h⟩ := methods_run hL hs o hv + exact h + +/-! ## The refinement and its frame -/ + +/-- The binary heap implements the indexed min-priority queue with keys at most `K`. -/ +def refinement (hL : L.Valid w K) : Refinement (indexedMinPQSpec n K) (Memory.spec w) := + Refinement.ofFn (methods L w K) (Inv L) (abs L) + (fun o hs hv => (methods_run hL hs o hv).1) + (fun o hs hv => by + obtain ⟨-, -, hstep, hinv, -⟩ := methods_run hL hs o hv + exact ⟨hstep, hinv⟩) + +/-- The layout's cells are allocated. -/ +theorem Inv.lt_frontier (hL : L.Valid w K) {s : Memory.State} (hs : Inv L s) {a : ℕ} + (ha : a ∈ L.footprint) : a < s.frontier := by + have h₁ := hs.size_allocated + have h₂ := hs.arrays_allocated + simp only [Layout.footprint, Finset.mem_union, Block.mem_footprint, Block.Owns, + hL.size_length, space] at ha + simp only [Block.Allocated, hL.size_length, space] at h₁ h₂ + omega + +/-- The abstraction reads only the arrays. -/ +theorem abs_congr {s s' : Memory.State} (h : ∀ a ∈ L.footprint, s'.mem a = s.mem a) : + abs L s' = abs L s := + stateOfMem_congr fun a ha => h a (Finset.mem_union_right _ ha) + +/-- The invariant reads only the layout's cells and survives a growing frontier. -/ +theorem Inv.congr (hL : L.Valid w K) {s s' : Memory.State} (hs : Inv L s) + (h : ∀ a ∈ L.footprint, s'.mem a = s.mem a) (hf : s.frontier ≤ s'.frontier) : + Inv L s' where + size_allocated := hs.size_allocated.mono hf + arrays_allocated := hs.arrays_allocated.mono hf + heap := by + rw [h _ (Finset.mem_union_left _ (Block.mem_footprint.mpr + ⟨le_rfl, by rw [hL.size_length]; omega⟩))] + exact hs.heap.congr_mem fun a ha => h a (Finset.mem_union_right _ ha) + +/-- The binary heap, with its layout's cells as a constant footprint, so that it shares memory +with other structures (`Memory.Framed.prod`). -/ +def framed (hL : L.Valid w K) : Memory.Framed (indexedMinPQSpec n K) w := + .ofStatic (refinement hL) L.footprint (fun hs ha => hs.lt_frontier hL ha) + (fun hs h hf => ⟨hs.congr hL h hf, abs_congr h⟩) + (fun o hs hv b _ hb => methods_frame hL hs o hv b hb) + +/-- The footprint of a heap is its layout's cells. -/ +@[simp] theorem framed_footprint (hL : L.Valid w K) (s : Memory.State) : + (framed hL).footprint s = L.footprint := rfl + +/-- **Every operation costs at most `opCost n = 10 ⌊log₂ n⌋ + 14` memory units**, with no +potential. -/ +theorem amortized (hL : L.Valid w K) : + (framed hL).Amortized charge (fun _ _ => opCost n) fun _ => 0 := + Refinement.Amortized.ofFn fun {_} o hs hv => by + obtain ⟨-, hc, -⟩ := methods_run (w := w) hL hs o hv + exact Nat.add_le_add_right hc 0 + +/-- The cost of one operation is `O(log n)`: at most `14 (⌊log₂ n⌋ + 1)`. -/ +theorem opCost_le (n : ℕ) : opCost n ≤ 14 * (Nat.log 2 n + 1) := by + unfold opCost + omega + +/-! ## Allocation -/ + +/-- Allocate a heap on `n` handles without clearing its storage: in memory that is zero above +the frontier, it starts empty. -/ +def allocLayout (n : ℕ) : Prog (Layout n) := do + let size ← allocBlockDirty 1 + let arrays ← allocBlockDirty (space n) + pure ⟨size, arrays.base⟩ + +/-- The layout that `allocLayout n` hands out at the frontier `f`. -/ +abbrev allocated (n f : ℕ) : Layout n := ⟨⟨f, 1⟩, f + 1⟩ + +/-- Allocation takes two memory units and hands out the layout at the frontier. -/ +theorem allocLayout_bind {α : Type} {s : Memory.State} {c : ℕ} {next : Layout n → Prog α} + {Q : α → Memory.State → Prop} (hfit : Fits w (s.frontier + 1 + space n)) + (h : Triple w ⟨s.mem, s.frontier + 1 + space n⟩ (next (allocated n s.frontier)) c Q) : + Triple w s (allocLayout n >>= next) (c + 2) Q := by + simp only [allocLayout, bind_assoc] + exact Triple.allocBlockDirty_bind (hfit.of_le (by omega)) <| + Triple.allocBlockDirty_bind hfit (by simpa only [pure_bind] using h) + +/-- The allocated layout is well formed when `n` and the largest key fit a word. -/ +theorem valid_allocated {f : ℕ} (hn : Fits w n) (hK : Fits w K) : + (allocated n f).Valid w K where + size_length := rfl + size_not_owns := by simp [Block.Owns] + n_fits := hn + key_fits := hK + +/-- The allocated layout lies at or above the frontier it was allocated from. -/ +theorem le_of_mem_footprint_allocated {f a : ℕ} (ha : a ∈ (allocated n f).footprint) : f ≤ a := by + simp only [Layout.footprint, Finset.mem_union, Block.mem_footprint, Block.Owns] at ha + omega + +/-- Allocated from memory that is zero above the frontier, the heap satisfies the invariant and +is empty. -/ +theorem inv_allocated {s : Memory.State} (hz : ZeroAbove s) : + Inv (allocated n s.frontier) ⟨s.mem, s.frontier + 1 + space n⟩ ∧ + abs (allocated n s.frontier) ⟨s.mem, s.frontier + 1 + space n⟩ = IndexedMinPQ.empty n := by + have hpos : ∀ v < n, s.mem (s.frontier + 1 + 2 * n + 1 + v) = 0 := fun v _ => hz _ (by omega) + have hshape : HeapShape n (s.frontier + 1) 0 s.mem := + ⟨Nat.zero_le _, fun _ h1 h2 => by omega, fun _ h1 h2 => by omega, + fun v hv => (hpos v hv).le, fun v hv h0 => absurd (hpos v hv) h0⟩ + refine ⟨⟨le_rfl.trans (by simp only; omega), by simp only [Block.Allocated]; omega, ?_⟩, + hshape.stateOfMem_zero⟩ + rw [hz s.frontier le_rfl] + exact ⟨hshape, fun _ h1 h2 => by omega⟩ + +end Cslib.DataStructure.PriorityQueue.BinaryHeap.Memory diff --git a/Complexity/DataStructure/PriorityQueue/BinaryHeap/Order.lean b/Complexity/DataStructure/PriorityQueue/BinaryHeap/Order.lean new file mode 100644 index 0000000000..3c8f74eeb2 --- /dev/null +++ b/Complexity/DataStructure/PriorityQueue/BinaryHeap/Order.lean @@ -0,0 +1,240 @@ +/- +Copyright (c) 2026 Renfei Zhou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Renfei Zhou +-/ + +module +-- upstream: candidate + +public import Complexity.DataStructure.PriorityQueue.WordRAM.BinaryHeap.Model + +/-! +# Indexed binary min-heap: the order lemmas of sift-up and sift-down + +These are the machine-free steps of sift-up and sift-down on the indexed binary heap of +`Cslib.DataStructure.PriorityQueue.WordRAM.BinaryHeap.Model`: swapping two heap positions keeps the +heap shape (`HeapShape.swap`), and a swap with the parent or with the child of highest priority +moves a single order defect one level (`UpOrdered.swap`, `DownOrdered.swap`) until it disappears +(`UpOrdered.ordered`, `DownOrdered.ordered`). + +They are the private order lemmas of +`Complexity/DataStructure/PriorityQueue/WordRAM/BinaryHeap/Sift.lean`, copied unchanged apart from +docstrings so that implementations over the memory oracle can use them without importing word-RAM +code. They extend the namespace of `BinaryHeap.Model`, whose definitions they are about. The +private originals go when the word-RAM heap is migrated (#2205). + +## Main definitions + +* `Cslib.DataStructure.PriorityQueue.WordRAM.BinaryHeap.swapMem`: memory after swapping two heap + positions. +* `Cslib.DataStructure.PriorityQueue.WordRAM.BinaryHeap.minChild`: the child of highest priority. + +## Main results + +* `Cslib.DataStructure.PriorityQueue.WordRAM.BinaryHeap.HeapShape.swap`: a swap keeps the shape. +* `Cslib.DataStructure.PriorityQueue.WordRAM.BinaryHeap.UpOrdered.swap`, + `Cslib.DataStructure.PriorityQueue.WordRAM.BinaryHeap.UpOrdered.ordered`, + `Cslib.DataStructure.PriorityQueue.WordRAM.BinaryHeap.Ordered.upOrdered_one`: sift-up. +* `Cslib.DataStructure.PriorityQueue.WordRAM.BinaryHeap.DownOrdered.swap`, + `Cslib.DataStructure.PriorityQueue.WordRAM.BinaryHeap.DownOrdered.ordered`, + `Cslib.DataStructure.PriorityQueue.WordRAM.BinaryHeap.minChild_spec`: sift-down. + +## References + +* [T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein, *Introduction to + Algorithms*][CLRS2009] +-/ + +@[expose] public section + +namespace Cslib.DataStructure.PriorityQueue.WordRAM.BinaryHeap + +open Cslib.WordRAM Cslib.DataStructure Cslib.DataStructure.PriorityQueue + +section Order + +variable {f g : ℕ → ℕ × ℕ} {S a c : ℕ} + +/-- A heap with one upward defect at `a` is ordered once `a` is ordered with its parent. -/ +theorem UpOrdered.ordered (h : UpOrdered f S a) + (hle : 2 ≤ a → a ≤ S → IndexedMinPQ.RawPrioLE (f (a / 2)) (f a)) : Ordered f S := by + intro i hi hiS + by_cases hia : i = a + · subst hia; exact hle hi hiS + · exact (h i hi hiS).1 hia + +/-- An ordered heap has at most an upward defect at the root. -/ +theorem Ordered.upOrdered_one (h : Ordered f S) : UpOrdered f S 1 := + fun i hi hiS => ⟨fun _ => h i hi hiS, fun _ h2 => absurd h2 (by omega)⟩ + +/-- **One step of sift-up.** Swapping an entry `a` with its parent when it has higher priority +moves the upward defect to the parent. -/ +theorem UpOrdered.swap (h : UpOrdered f S a) (ha : 2 ≤ a) (haS : a ≤ S) + (hlt : IndexedMinPQ.RawPrioLT (f a) (f (a / 2))) (hga : g a = f (a / 2)) (hgp : g (a / 2) = f a) + (hgo : ∀ i, 1 ≤ i → i ≤ S → i ≠ a → i ≠ a / 2 → g i = f i) : + UpOrdered g S (a / 2) := by + intro i hi hiS + obtain ⟨h₁, h₂⟩ := h i hi hiS + constructor + · intro hne + rcases eq_or_ne i a with rfl | hia + · rw [hga, hgp]; exact hlt.le + rw [hgo i (by omega) hiS hia hne] + rcases eq_or_ne (i / 2) a with hia2 | hia2 + · rw [hia2, hga]; exact h₂ hia2 ha + rcases eq_or_ne (i / 2) (a / 2) with hip | hip + · have hp := h₁ hia + rw [hip] at hp + rw [hip, hgp] + exact hlt.le.trans hp + · rw [hgo (i / 2) (by omega) (by omega) hia2 hip] + exact h₁ hia + · intro hip hp2 + have hpa := (h (a / 2) hp2 (by omega)).1 (by omega) + rw [hgo (a / 2 / 2) (by omega) (by omega) (by omega) (by omega)] + rcases eq_or_ne i a with rfl | hia + · rw [hga]; exact hpa + · have hp := h₁ hia + rw [hip] at hp + rw [hgo i (by omega) hiS hia (by omega)] + exact hpa.trans hp + +/-- A heap with one downward defect at `a` is ordered once `a` is ordered with its children. -/ +theorem DownOrdered.ordered (h : DownOrdered f S a) + (hle : ∀ i, 2 ≤ i → i ≤ S → i / 2 = a → IndexedMinPQ.RawPrioLE (f a) (f i)) : Ordered f S := by + intro i hi hiS + by_cases hia : i / 2 = a + · rw [hia]; exact hle i hi hiS hia + · exact (h i hi hiS).1 hia + +/-- **One step of sift-down.** Swapping an entry `a` with its child `c` of highest priority, +when `c` has higher priority than `a`, moves the downward defect to `c`. -/ +theorem DownOrdered.swap (h : DownOrdered f S a) (hc : c / 2 = a) (hcS : c ≤ S) + (hmin : ∀ i, 2 ≤ i → i ≤ S → i / 2 = a → IndexedMinPQ.RawPrioLE (f c) (f i)) + (hlt : IndexedMinPQ.RawPrioLT (f c) (f a)) (hga : g a = f c) (hgc : g c = f a) + (hgo : ∀ i, 1 ≤ i → i ≤ S → i ≠ a → i ≠ c → g i = f i) : + DownOrdered g S c := by + intro i hi hiS + obtain ⟨h₁, -⟩ := h i hi hiS + constructor + · intro hic + rcases eq_or_ne i c with rfl | hic' + · rw [hc, hga, hgc]; exact hlt.le + rcases eq_or_ne (i / 2) a with hia | hia + · rw [hia, hga, hgo i (by omega) hiS (by omega) hic'] + exact hmin i hi hiS hia + rcases eq_or_ne i a with rfl | hia' + · rw [hga, hgo (i / 2) (by omega) (by omega) (by omega) hic] + exact (h c (by omega) hcS).2 hc hi + · rw [hgo i (by omega) hiS hia' hic', hgo (i / 2) (by omega) (by omega) hia hic] + exact h₁ hia + · intro hic _ + have hp := h₁ (by omega) + rw [hic] at hp + rw [hc, hga, hgo i (by omega) hiS (by omega) (by omega)] + exact hp + +end Order + +section Swap + +variable {N base S : ℕ} + +/-- Memory after swapping heap positions `a` and `b`, which hold the handles `va` and `vb`: the +heap array exchanges the two handles and the position array records their new positions. -/ +def swapMem (N base : ℕ) (mem : ℕ → ℕ) (a b va vb : ℕ) : ℕ → ℕ := + Function.update (Function.update (Function.update (Function.update mem (base + N + a) vb) + (base + N + b) va) (base + 2 * N + 1 + vb) a) (base + 2 * N + 1 + va) b + +/-- **Swapping two heap positions** keeps the heap shape, exchanges the two entries, leaves the +other entries, the presence of every handle, and every cell outside the heap and position arrays +unchanged. -/ +theorem HeapShape.swap {mem : ℕ → ℕ} {a b : ℕ} (h : HeapShape N base S mem) + (ha : 1 ≤ a) (haS : a ≤ S) (hb : 1 ≤ b) (hbS : b ≤ S) (hab : a ≠ b) : + let m' := swapMem N base mem a b (mem (base + N + a)) (mem (base + N + b)) + HeapShape N base S m' ∧ heapEntry N base m' a = heapEntry N base mem b ∧ + heapEntry N base m' b = heapEntry N base mem a ∧ + (∀ i, 1 ≤ i → i ≤ S → i ≠ a → i ≠ b → heapEntry N base m' i = heapEntry N base mem i) ∧ + (∀ v < N, m' (base + 2 * N + 1 + v) = 0 ↔ mem (base + 2 * N + 1 + v) = 0) ∧ + (∀ c, c ≤ base + N ∨ base + 3 * N < c → m' c = mem c) := by + intro m' + have hSN := h.size_le + have hva : mem (base + N + a) < N := h.vertex_lt a ha haS + have hvb : mem (base + N + b) < N := h.vertex_lt b hb hbS + have hpa := h.pos_vertex a ha haS + have hpb := h.pos_vertex b hb hbS + have hne : mem (base + N + a) ≠ mem (base + N + b) := fun he => hab (by rw [← hpa, ← hpb, he]) + have hH : ∀ i, 1 ≤ i → i ≤ S → m' (base + N + i) = if i = b then mem (base + N + a) + else if i = a then mem (base + N + b) else mem (base + N + i) := by + intro i hi hiS + simp only [m', swapMem, Function.update_apply]; split_ifs <;> omega + have hP : ∀ v < N, m' (base + 2 * N + 1 + v) = if v = mem (base + N + a) then b + else if v = mem (base + N + b) then a else mem (base + 2 * N + 1 + v) := by + intro v hv + simp only [m', swapMem, Function.update_apply]; split_ifs <;> omega + have hD : ∀ c, c ≤ base + N ∨ base + 3 * N < c → m' c = mem c := by + intro c hc + simp only [m', swapMem, Function.update_apply]; split_ifs <;> omega + have hK : ∀ v < N, m' (base + v) = mem (base + v) := fun _ hv => hD _ (Or.inl (by omega)) + refine ⟨⟨hSN, ?_, ?_, ?_, ?_⟩, ?_, ?_, ?_, ?_, hD⟩ + · intro i hi hiS + rw [hH i hi hiS]; split_ifs; exacts [hva, hvb, h.vertex_lt i hi hiS] + · intro i hi hiS + rw [hH i hi hiS] + split_ifs with h1 h2 + · rw [hP _ hva, ite_eq_left rfl, h1] + · rw [hP _ hvb, ite_eq_right hne.symm, ite_eq_left rfl, h2] + · have hpi := h.pos_vertex i hi hiS + have h1' : mem (base + N + i) ≠ mem (base + N + a) := fun he => h2 (by rw [← hpi, he, hpa]) + have h2' : mem (base + N + i) ≠ mem (base + N + b) := fun he => h1 (by rw [← hpi, he, hpb]) + rw [hP _ (h.vertex_lt i hi hiS), ite_eq_right h1', ite_eq_right h2', hpi] + · intro v hv + rw [hP v hv]; split_ifs; exacts [hbS, haS, h.pos_le v hv] + · intro v hv hv0 + rw [hP v hv] at hv0 ⊢ + split_ifs at hv0 ⊢ with h1 h2 + · rw [hH b hb hbS, ite_eq_left rfl, h1] + · rw [hH a ha haS, ite_eq_right hab, ite_eq_left rfl, h2] + · have hvp := h.vertex_pos v hv hv0 + have hle := h.pos_le v hv + have h1' : mem (base + 2 * N + 1 + v) ≠ b := fun he => h2 (by rw [← hvp, he]) + have h2' : mem (base + 2 * N + 1 + v) ≠ a := fun he => h1 (by rw [← hvp, he]) + rw [hH _ (by omega) hle, ite_eq_right h1', ite_eq_right h2', hvp] + · simp only [heapEntry] + rw [hH a ha haS, ite_eq_right hab, ite_eq_left rfl, hK _ hvb] + · simp only [heapEntry] + rw [hH b hb hbS, ite_eq_left rfl, hK _ hva] + · intro i hi hiS hia hib + simp only [heapEntry] + rw [hH i hi hiS, ite_eq_right hib, ite_eq_right hia, hK _ (h.vertex_lt i hi hiS)] + · intro v hv + rw [hP v hv] + split_ifs with h1 h2 + · subst h1; rw [hpa]; omega + · subst h2; rw [hpb]; omega + · rfl + +/-- The child of `a` with the highest priority in a heap of size `S`: the right child when it +exists and has strictly higher priority than the left child, and the left child otherwise. -/ +def minChild (f : ℕ → ℕ × ℕ) (S a : ℕ) : ℕ := + if 2 * a + 1 ≤ S ∧ IndexedMinPQ.RawPrioLT (f (2 * a + 1)) (f (2 * a)) then 2 * a + 1 else 2 * a + +/-- `minChild` is a child of `a` within the heap, of priority at least that of every child. -/ +theorem minChild_spec {f : ℕ → ℕ × ℕ} {a : ℕ} (ha : 2 * a ≤ S) : + (minChild f S a = 2 * a ∨ minChild f S a = 2 * a + 1) ∧ minChild f S a ≤ S ∧ + ∀ i, i ≤ S → i / 2 = a → IndexedMinPQ.RawPrioLE (f (minChild f S a)) (f i) := by + unfold minChild + split_ifs with h + · refine ⟨Or.inr rfl, h.1, fun i hiS hia => ?_⟩ + rcases (by omega : i = 2 * a ∨ i = 2 * a + 1) with rfl | rfl + · exact h.2.le + · exact IndexedMinPQ.RawPrioLE.refl _ + · refine ⟨Or.inl rfl, ha, fun i hiS hia => ?_⟩ + rcases (by omega : i = 2 * a ∨ i = 2 * a + 1) with rfl | rfl + · exact IndexedMinPQ.RawPrioLE.refl _ + · exact IndexedMinPQ.not_rawPrioLT_iff_rawPrioLE.mp fun hlt => h ⟨hiS, hlt⟩ + +end Swap + +end Cslib.DataStructure.PriorityQueue.WordRAM.BinaryHeap diff --git a/ComplexityTests/DataStructureBinaryHeapMemory.lean b/ComplexityTests/DataStructureBinaryHeapMemory.lean new file mode 100644 index 0000000000..eb3db66022 --- /dev/null +++ b/ComplexityTests/DataStructureBinaryHeapMemory.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +import Complexity.DataStructure.PriorityQueue.BinaryHeap.Memory + +/-! +# An indexed binary heap over the memory oracle, run on concrete memory + +A client inserts three handles, lowers one key, and extracts four times, the last time from an +empty queue. Two handles share a key, so the extractions also check the tie-break toward the +smaller handle. The run allocates a heap on four handles in empty memory at word size `8`. The +tests check its answers against the specification, its exact memory cost against the proved +bound `2 + 8 opCost 4`, the admissibility of every memory operation, and that the hypotheses of +the general theorems hold here. +-/ + +namespace ComplexityTests.DataStructureBinaryHeapMemory + +open Cslib.WordRAM Cslib.DataStructure Cslib.DataStructure.Memory Cslib.DataStructure.PriorityQueue + Cslib.DataStructure.PriorityQueue.BinaryHeap.Memory +open Cslib.DataStructure.PriorityQueue.WordRAM.BinaryHeap (space) + +/-- The queue on four handles with keys at most `9`. -/ +abbrev Q : StateTransitionSpec := indexedMinPQSpec 4 9 + +/-- Insert `2 ↦ 5`, `0 ↦ 3`, `3 ↦ 3`; lower the key of `2` to `1`; extract four times. -/ +def client : Q.Client (List (Option (Fin 4 × ℕ))) := do + Q.call (.insert 2 5) + Q.call (.insert 0 3) + Q.call (.insert 3 3) + Q.call (.decreaseKey 2 1) + let a ← Q.call .extractMin + let b ← Q.call .extractMin + let c ← Q.call .extractMin + let d ← Q.call .extractMin + pure [a, b, c, d] + +/-- Allocate a heap on four handles, then run the client on it. -/ +def run : Prog (List (Option (Fin 4 × ℕ))) := do + let L ← allocLayout 4 + link (methods L 8 9) client + +/-- Empty memory with nothing allocated. -/ +def empty : State := ⟨fun _ => 0, 0⟩ + +-- The specification's answers: smallest key first, and handle `0` before handle `3` at key `3`. +#guard Q.clientResult (IndexedMinPQ.empty 4) client = + [some (2, 1), some (0, 3), some (3, 3), none] + +-- The run over memory gives the same answers. +#guard (spec 8).clientResult empty run = [some (2, 1), some (0, 3), some (3, 3), none] + +-- Every memory operation of the run is admissible at word size `8`. +#guard decide ((spec 8).ValidHistory empty ((spec 8).clientHistory empty run)) + +-- Its exact memory cost, against the bound `2 + 8 · opCost 4 = 274` from allocation and +-- `amortized`. +#guard (spec 8).totalCost charge empty ((spec 8).clientHistory empty run) = 69 + +example : 2 + 8 * opCost 4 = 274 := by decide + +/-- The hypotheses of the general theorems hold: the allocated layout is well formed, and empty +memory is zero above its frontier. -/ +example : (allocated 4 empty.frontier).Valid 8 9 := valid_allocated (by decide) (by decide) + +example : ZeroAbove empty := fun _ _ => rfl + +example : Inv (allocated 4 empty.frontier) ⟨empty.mem, empty.frontier + 1 + space 4⟩ := + (inv_allocated (s := empty) fun _ _ => rfl).1 + +/-- A word size too small for the keys: `9` does not fit three bits. -/ +example : ¬Fits 3 9 := by decide + +end ComplexityTests.DataStructureBinaryHeapMemory From 8c5cd8ed301d2502aee8fcf082e2b58259d925fe Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 19:22:36 -0500 Subject: [PATCH 16/20] test(DataStructure/PriorityQueue): allow #guard in the binary-heap memory test Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- ComplexityTests/DataStructureBinaryHeapMemory.lean | 2 ++ 1 file changed, 2 insertions(+) diff --git a/ComplexityTests/DataStructureBinaryHeapMemory.lean b/ComplexityTests/DataStructureBinaryHeapMemory.lean index eb3db66022..dd3f3734b1 100644 --- a/ComplexityTests/DataStructureBinaryHeapMemory.lean +++ b/ComplexityTests/DataStructureBinaryHeapMemory.lean @@ -17,6 +17,8 @@ bound `2 + 8 opCost 4`, the admissibility of every memory operation, and that th the general theorems hold here. -/ +set_option linter.hashCommand false + namespace ComplexityTests.DataStructureBinaryHeapMemory open Cslib.WordRAM Cslib.DataStructure Cslib.DataStructure.Memory Cslib.DataStructure.PriorityQueue From b417144f27da00332c21ea5dc58e97692af70b58 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 18:41:12 -0500 Subject: [PATCH 17/20] fix(Algorithms/Lean/Dijkstra): evaluate client calls under Sum.elim product answers MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit #2212 states the answer types of product as Sum.elim, which simp does not unfold when it unifies the bind type of a declared call (Option ℕ, Fin n × ℕ) with StateTransitionSpec.runClient_lift_bind'. Evaluate each kind of call by its own definitional equation instead. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../Algorithms/Lean/Dijkstra/Client.lean | 57 ++- .../Algorithms/Lean/Dijkstra/Memory.lean | 359 ++++++++++++++++++ .../DataStructure/AdjacencyList/Memory.lean | 225 +++++++++++ .../DataStructure/Dictionary/Memory.lean | 188 +++++++++ ComplexityTests/DijkstraMemory.lean | 61 +++ 5 files changed, 880 insertions(+), 10 deletions(-) create mode 100644 Complexity/Algorithms/Lean/Dijkstra/Memory.lean create mode 100644 Complexity/DataStructure/AdjacencyList/Memory.lean create mode 100644 Complexity/DataStructure/Dictionary/Memory.lean create mode 100644 ComplexityTests/DijkstraMemory.lean diff --git a/Complexity/Algorithms/Lean/Dijkstra/Client.lean b/Complexity/Algorithms/Lean/Dijkstra/Client.lean index 3ae1246a89..690f8690bd 100644 --- a/Complexity/Algorithms/Lean/Dijkstra/Client.lean +++ b/Complexity/Algorithms/Lean/Dijkstra/Client.lean @@ -229,6 +229,44 @@ private theorem runClient_bind' {α β : Type} (s : (spec n K V).State) (p : (sp (k ((spec n K V).clientResult s p))) := StateTransitionSpec.runClient_bind p k s +/-! One call of each kind, followed by a continuation. Their answer types are the declared ones +(`Option ℕ`, `Fin n × ℕ`, …), so these equations apply where the generic +`StateTransitionSpec.runClient_lift_bind'` would have to unfold `Sum.elim` in the answer types of +`product`. -/ + +private theorem runClient_insert_bind {α : Type} (s : (spec n K V).State) (v : Fin n) (d : ℕ) + (k : Unit → (spec n K V).Client α) : + (spec n K V).runClient s ((queue (.insert v d) : (spec n K V).Client Unit) >>= k) = + let (r, s', os) := (spec n K V).runClient (Function.update s.1 v (some d), s.2) (k ()) + (r, s', .inl (.insert v d) :: os) := rfl + +private theorem runClient_insert (s : (spec n K V).State) (v : Fin n) (d : ℕ) : + (spec n K V).runClient (α := Unit) s (queue (.insert v d)) = + ((), (Function.update s.1 v (some d), s.2), [.inl (.insert v d)]) := rfl + +private theorem runClient_decreaseKey (s : (spec n K V).State) (v : Fin n) (d : ℕ) : + (spec n K V).runClient (α := Unit) s (queue (.decreaseKey v d)) = + ((), (Function.update s.1 v (some d), s.2), [.inl (.decreaseKey v d)]) := rfl + +private theorem runClient_getDist_bind {α : Type} (s : (spec n K V).State) (v : Fin n) + (k : Option ℕ → (spec n K V).Client α) : + (spec n K V).runClient s (getDist v >>= k) = + let (r, s', os) := (spec n K V).runClient s (k (s.2.1 v)) + (r, s', .inr (.inl (.get v)) :: os) := rfl + +private theorem runClient_setDist_bind {α : Type} (s : (spec n K V).State) (v : Fin n) (d : ℕ) + (k : Unit → (spec n K V).Client α) : + (spec n K V).runClient s (setDist v d >>= k) = + let (r, s', os) := + (spec n K V).runClient (s.1, Function.update s.2.1 v (some d), s.2.2) (k ()) + (r, s', .inr (.inl (.insert v d)) :: os) := rfl + +private theorem runClient_edge_bind {α : Type} (s : (spec n K V).State) (u : Fin n) (i : ℕ) + (k : Fin n × ℕ → (spec n K V).Client α) : + (spec n K V).runClient s (edge u i >>= k) = + let (r, s', os) := (spec n K V).runClient s (k (AdjacencyList.step s.2.2 (.edge u i)).2) + (r, s', .inr (.inr (.edge u i)) :: os) := rfl + private theorem Runs.bind {s s₁ s₂ : (spec n K V).State} {p q : (spec n K V).Client Unit} {b₁ b₂ : ℕ} (h₁ : Runs rate pU pQ s p s₁ b₁) (h₂ : Runs rate pU pQ s₁ q s₂ b₂) : Runs rate pU pQ s (p >>= fun _ => q) s₂ (b₁ + b₂) := by @@ -327,9 +365,8 @@ private theorem relaxEdge_runs (T : Finset (Fin n)) (dm : Dictionary.State n) ((), (Function.update (syncQ T dm) v (some (du + c)), Function.update dm v (some (du + c)), adj), [.inr (.inr (.edge u i)), .inr (.inl (.get v)), .inr (.inl (.insert v (du + c))), .inl (.insert v (du + c))]) := by - simp only [relaxEdge, StateTransitionSpec.runClient_lift_bind', - StateTransitionSpec.stepFn, AdjacencyList.step_edge _ _ hi, hvc, hdm, IndexedMinPQ.step, - StateTransitionSpec.runClient_lift] + simp only [relaxEdge, runClient_edge_bind, AdjacencyList.step_edge _ _ hi, hvc, + runClient_getDist_bind, hdm, runClient_setDist_bind, runClient_insert] have hq : (IndexedMinPQ.dom (syncQ T (Function.update dm v (some (du + c))))).card = (IndexedMinPQ.dom (syncQ T dm)).card + 1 := by rw [← syncQ_update hvT, IndexedMinPQ.dom_insert, Finset.card_insert_of_notMem] @@ -355,9 +392,9 @@ private theorem relaxEdge_runs (T : Finset (Fin n)) (dm : Dictionary.State n) Function.update dm v (some (du + c)), adj), [.inr (.inr (.edge u i)), .inr (.inl (.get v)), .inr (.inl (.insert v (du + c))), .inl (.decreaseKey v (du + c))]) := by - simp only [relaxEdge, StateTransitionSpec.runClient_lift_bind', - StateTransitionSpec.stepFn, AdjacencyList.step_edge _ _ hi, hvc, hdm, IndexedMinPQ.step, - StateTransitionSpec.runClient_lift, hlt, ite_true] + simp only [relaxEdge, runClient_edge_bind, AdjacencyList.step_edge _ _ hi, hvc, + runClient_getDist_bind, hdm, hlt, ite_true, runClient_setDist_bind, + runClient_decreaseKey] have hq : (IndexedMinPQ.dom (syncQ T (Function.update dm v (some (du + c))))).card = (IndexedMinPQ.dom (syncQ T dm)).card := by rw [← syncQ_update hvT, IndexedMinPQ.dom_decreaseKey] @@ -377,8 +414,8 @@ private theorem relaxEdge_runs (T : Finset (Fin n)) (dm : Dictionary.State n) omega · have hrun : (spec n K V).runClient (syncQ T dm, dm, adj) (relaxEdge u du i) = ((), (syncQ T dm, dm, adj), [.inr (.inr (.edge u i)), .inr (.inl (.get v))]) := by - simp only [relaxEdge, StateTransitionSpec.runClient_lift_bind', - StateTransitionSpec.stepFn, AdjacencyList.step_edge _ _ hi, hvc, hdm, hlt, ite_false] + simp only [relaxEdge, runClient_edge_bind, AdjacencyList.step_edge _ _ hi, hvc, + runClient_getDist_bind, hdm, hlt, ite_false] rfl have hmin : Function.update dm v (relaxOpt (du + c) (some dv)) = dm := by rw [relaxOpt, min_eq_right (Nat.le_of_not_lt hlt), ← hdm, Function.update_eq_self] @@ -755,8 +792,8 @@ private theorem dijkstra_runs (G : ListInstance) (hK : G.n * G.maxWeight ≤ K) (spec G.n K V).clientState (syncQ ∅ dm₀, dm₀, G.adj) (loop G.n), [.inr (.inl (.insert G.source 0)), .inl (.insert G.source 0)] ++ (spec G.n K V).clientHistory (syncQ ∅ dm₀, dm₀, G.adj) (loop G.n)) := by - simp only [dijkstra, init, StateTransitionSpec.runClient_lift_bind', IndexedMinPQ.step] - rw [← hdm₀, hq₀] + simp only [dijkstra, init, runClient_setDist_bind] + rw [runClient_insert_bind, ← hdm₀, hq₀] rfl have hunr : unreached dm₀ + 1 = unreached (Dictionary.empty G.n) := unreached_update_of_none rfl 0 diff --git a/Complexity/Algorithms/Lean/Dijkstra/Memory.lean b/Complexity/Algorithms/Lean/Dijkstra/Memory.lean new file mode 100644 index 0000000000..177f784de0 --- /dev/null +++ b/Complexity/Algorithms/Lean/Dijkstra/Memory.lean @@ -0,0 +1,359 @@ +/- +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.Lean.Dijkstra.Cost +public import Complexity.DataStructure.AdjacencyList.Memory +public import Complexity.DataStructure.Dictionary.Memory +public import Complexity.DataStructure.PriorityQueue.BinaryHeap.Memory +import Complexity.Algorithms.WordRAM.Dijkstra.ListEncode + +/-! +# Dijkstra's algorithm with a binary heap, over the memory oracle + +The client `Cslib.Algorithms.Lean.Dijkstra.dijkstra` runs over three structures in one memory +(`framed`, a `Memory.Framed.prod`): the indexed binary heap +`Cslib.DataStructure.PriorityQueue.BinaryHeap.Memory.framed`, a direct-address table for the +tentative distances, and the adjacency arrays of the graph. `run` is one memory program for every +graph. It reads the word RAM's input convention (`ListInstance.encode`): it reads `n`, the source +and the number `m` of edges, allocates the distance table and the heap just past the input, where +memory is zero, and runs the linked client on the adjacency arrays of the input. + +`run_spec` is the memory-level counterpart of `Cslib.Algorithms.WordRAM.Dijkstra.LogLinearSpec`: +at every word size that holds `8 (n + m + 2) (W + 2)`, every memory operation of `run` is +admissible, the cell `G.outAddr v` then holds the encoded distance from the source to `v`, and the +run costs at most `52 (m + 1) (⌊log₂ n⌋ + 1)` memory units. `exists_run_logLinear` exports the +bound as `O((m + 1) log n)`. Correctness is `dijkstra_correct` transported through the refinement +(`Refinement.simulates_client`); the cost is the client's operation count +(`totalCost_dijkstra_le`) at the structures' charges, transported by their amortized +certificates (`Refinement.Amortized.client`). The proofs here mention no register, instruction +or address beyond the layout of the input. + +Executing memory programs on the word RAM is a separate, generic realization step, which this +file does not provide. + +## Main definitions + +* `memMethods`, `opCharge`: the methods of the three structures, and their charges. +* `inputGraph`: the adjacency arrays of the input convention. +* `framed`: the three structures as one framed refinement of `Dijkstra.spec`. +* `run`: read the input, allocate, and run Dijkstra's algorithm. + +## Main results + +* `dijkstra_eq`: the client does not depend on the key and value bounds of its interfaces. +* `holds_inputGraph`: the input holds the graph in the adjacency arrays. +* `run_spec`: admissibility, distances and memory cost of `run`. +* `exists_run_logLinear`: the same with an `O((m + 1) log n)` cost function. + +## References + +* [E. W. Dijkstra, *A note on two problems in connexion with graphs*][Dijkstra1959] +* [T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein, *Introduction to + Algorithms*][CLRS2009] +-/ + +@[expose] public section + +namespace Cslib.Algorithms.Lean.Dijkstra.Memory + +open Cslib.WordRAM Cslib.DataStructure Cslib.DataStructure.Memory Cslib.DataStructure.PriorityQueue +open Cslib.Algorithms.WordRAM.Dijkstra (ListInstance encodeDist) + +/-! ## The client does not depend on its bounds -/ + +/-- The main loop does not depend on the key and value bounds `K` and `V`, which only restrict +admissibility. -/ +theorem loop_eq (n K V K' V' k : ℕ) : @loop n K V k = @loop n K' V' k := by + induction k with + | zero => rfl + | succ k ih => + simp only [loop, ih] + rfl + +/-- The client does not depend on the key and value bounds `K` and `V`. -/ +theorem dijkstra_eq {n : ℕ} (K V K' V' : ℕ) (src : Fin n) : + @dijkstra n K V src = @dijkstra n K' V' src := by + simp only [dijkstra, loop_eq n K V K' V'] + +/-! ## The structures -/ + +/-- The methods of the heap `H`, the distance table `T` and the adjacency arrays `A`. -/ +def memMethods (n K V w : ℕ) (H : BinaryHeap.Memory.Layout n) (T : Block) + (A : AdjacencyList.Memory.Layout) : Methods (spec n K V) (Memory.spec w) := + Methods.prod (BinaryHeap.Memory.ops H) + (Methods.prod (Dictionary.Memory.ops T) (AdjacencyList.Memory.ops A)) + +/-- The adjacency arrays of the input convention: the `n + 1` offsets at address `3`, and the `m` +edges from address `n + 4`. -/ +def inputGraph (n m : ℕ) : AdjacencyList.Memory.Layout := ⟨⟨3, n + 1⟩, ⟨n + 4, 2 * m⟩⟩ + +variable {n K V w : ℕ} {H : BinaryHeap.Memory.Layout n} {T : Block} + {A : AdjacencyList.Memory.Layout} + +/-- The heap, the distance table and the adjacency arrays of the graph `adj`, as one framed +refinement of the interfaces of Dijkstra's algorithm. -/ +def framed (hH : H.Valid w K) (hT : Dictionary.Memory.Valid T w n V) (hA : A.Valid n) + (adj : AdjacencyList.State n) : Memory.Framed (spec n K V) w := + (BinaryHeap.Memory.framed hH).prod + ((Dictionary.Memory.framed (n_max := n) hT).prod (AdjacencyList.Memory.framed adj hA)) + +/-- The composite's methods are `memMethods`. -/ +theorem framed_methods (hH : H.Valid w K) (hT : Dictionary.Memory.Valid T w n V) + (hA : A.Valid n) (adj : AdjacencyList.State n) : + (framed hH hT hA adj).methods = memMethods n K V w H T A := rfl + +/-- The methods do not depend on the bounds and the word size in their type. -/ +theorem memMethods_eq (n K V w K' V' w' : ℕ) (H : BinaryHeap.Memory.Layout n) (T : Block) + (A : AdjacencyList.Memory.Layout) : memMethods n K V w H T A = memMethods n K' V' w' H T A := by + funext o + rcases o with o | o | o <;> rfl + +/-- The charge of the composite: a heap operation costs `opCost n`, a distance-table operation +one unit and a graph query three units. -/ +abbrev opCharge (n K V : ℕ) : (spec n K V).State → (spec n K V).Op → ℕ := + productCharge (fun _ _ => BinaryHeap.Memory.opCost n) (productCharge (fun _ _ => 1) + fun _ _ => 3) + +/-- Every operation of the composite costs at most its `charge`, with no potential. -/ +theorem amortized (hH : H.Valid w K) (hT : Dictionary.Memory.Valid T w n V) (hA : A.Valid n) + (adj : AdjacencyList.State n) : + (framed hH hT hA adj).Amortized Memory.charge (opCharge n K V) fun _ => 0 := + Memory.Framed.amortized_prod (BinaryHeap.Memory.amortized hH) + (Memory.Framed.amortized_prod (Dictionary.Memory.amortized hT) + (AdjacencyList.Memory.amortized hA) (Memory.Framed.Local.const _ 0) + (Memory.Framed.Local.const _ 0)) + (Memory.Framed.Local.const _ 0) + (Memory.Framed.Local.const _ 0) + +/-! ## The program -/ + +/-- **Dijkstra's algorithm over memory** on the word RAM's input convention: read `n`, the source +and the number `m` of edges, allocate the distance table and the heap past the input, and run the +client through the three structures. The key bound, value bound and word size in the types of +`memMethods` and `dijkstra` are `0`: they only restrict admissibility, and the program does not +depend on them (`dijkstra_eq`). -/ +def run : Prog Unit := do + let n ← read 1 + let src ← read 2 + let m ← read (n + 3) + let T ← allocBlockDirty n + let H ← BinaryHeap.Memory.allocLayout n + if h : src < n then + link (memMethods n 0 0 0 H T (inputGraph n m)) (dijkstra (K := 0) (V := 0) ⟨src, h⟩) + else pure () + +/-! ## The input -/ + +/-- The input convention holds the graph in the adjacency arrays `inputGraph`. -/ +theorem holds_inputGraph (G : ListInstance) : + AdjacencyList.Memory.Holds (inputGraph G.n G.m) G.adj (Memory.State.init G.encode).mem := by + set m := (Memory.State.init G.encode).mem with hm + have hoff : ∀ j ≤ G.n, m (3 + j) = G.offset j := fun j hj => by + rw [Nat.add_comm] + exact G.init_offset (r := 0) hj + refine ⟨fun u => ?_, fun u => ?_, fun u i hi => ?_, fun u i hi => ?_⟩ + · change m (3 + (u + 1)) = m (3 + u) + _ + rw [hoff _ u.isLt, hoff _ u.isLt.le, G.offset_succ u.isLt] + · change 2 * m (3 + (u + 1)) ≤ 2 * G.m + rw [hoff _ u.isLt, ← G.offset_n] + exact Nat.mul_le_mul_left 2 (G.offset_mono u.isLt) + · change m (G.n + 4 + 2 * (m (3 + u) + i)) = _ + rw [hoff _ u.isLt.le, show G.n + 4 + 2 * (G.offset u + i) = 2 * (G.offset u + i) + G.n + 4 by + omega] + exact G.init_target (r := 0) u hi + · change m (G.n + 4 + (2 * (m (3 + u) + i) + 1)) = _ + rw [hoff _ u.isLt.le, show G.n + 4 + (2 * (G.offset u + i) + 1) = + 2 * (G.offset u + i) + G.n + 5 by omega] + exact G.init_weight (r := 0) u hi + +/-- A cell whose decoded value is `some d` exactly when the distance `D` is `d` holds the encoded +distance. -/ +private theorem eq_encodeDist {x : ℕ} {D : ℕ∞} + (h : ∀ d : ℕ, Dictionary.Memory.decode x = some d ↔ D = d) : x = encodeDist D := by + cases x with + | zero => + have hD : D = ⊤ := by + by_contra hD + obtain ⟨d, rfl⟩ := ENat.ne_top_iff_exists.mp hD + simpa using (h d).mpr rfl + simp [hD, encodeDist] + | succ x => + have hD := (h x).mp rfl + simp [hD, encodeDist] + + +/-! ## Correctness and cost -/ + +/-- The cost of Dijkstra's algorithm over memory, at most: `52 (m + 1) (⌊log₂ n⌋ + 1)`. -/ +def memCost (n m : ℕ) : ℕ := 52 * (m + 1) * (Nat.log 2 n + 1) + +/-- The client's operations, at the charges of the three structures, cost at most +`3 (m + 1) opCost n + 8 m + 4`, which with the six units of reading and allocating is within +`memCost`. -/ +private theorem budget_le (n m : ℕ) : + 6 + (3 * (m + 1) * BinaryHeap.Memory.opCost n + 8 * m + 4) ≤ memCost n m := by + unfold memCost BinaryHeap.Memory.opCost + generalize Nat.log 2 n = L + nlinarith + +/-- **Dijkstra's algorithm over memory.** On the input words of a graph `G`, at every word size +`w` that holds `8 (n + m + 2) (W + 2)`, every memory operation of `run` is admissible, it costs at +most `memCost n m` memory units, and the cell `G.outAddr v` then holds the encoded distance from +the source to `v`, for every vertex `v`. -/ +theorem run_triple (G : ListInstance) {w : ℕ} + (hfit : Fits w (8 * (G.n + G.m + 2) * (G.maxWeight + 2))) : + Triple w (Memory.State.init G.encode) run (memCost G.n G.m) + fun _ s' => ∀ v : Fin G.n, s'.mem (G.outAddr v) = encodeDist (G.dist G.source v) := by + set s₀ := Memory.State.init G.encode with hs₀ + have hf₀ : s₀.frontier = G.n + 2 * G.m + 4 := by + simp only [s₀, Memory.State.init, G.encode_length] + have hz : ZeroAbove s₀ := zeroAbove_init _ + have hn1 : s₀.mem 1 = G.n := rfl + have hsrc : s₀.mem 2 = G.source := rfl + have hm : s₀.mem (G.n + 3) = G.m := by + rw [← G.offset_n] + exact G.init_offset (r := 0) le_rfl + -- The bounds of the interfaces and the facts that fit a word. + set K := G.n * G.maxWeight with hK + have hW : 2 ≤ G.maxWeight + 2 := by omega + have hbig : 2 * (G.n + G.m + 2) ≤ 8 * (G.n + G.m + 2) * (G.maxWeight + 2) := by nlinarith + have hn : Fits w G.n := hfit.of_le (by nlinarith) + have hKf : Fits w K := hfit.of_le (by nlinarith) + have hVf : Fits w (K + 1) := hfit.of_le (by nlinarith) + -- The rate of each kind of operation. + let rate : OpKind → ℕ + | .insert => BinaryHeap.Memory.opCost G.n + | .extractMin => BinaryHeap.Memory.opCost G.n + | .decreaseKey => BinaryHeap.Memory.opCost G.n + | .inspect => 0 + | .distance => 1 + | .graph => 3 + have hrate : rateBound rate G.n G.m ≤ + 3 * (G.m + 1) * BinaryHeap.Memory.opCost G.n + 8 * G.m + 4 := + (min_le_right _ _).trans (by simp only [rate]; nlinarith) + refine Triple.mono (c := rateBound rate G.n G.m + 6) ?_ + (by have := budget_le G.n G.m; omega) fun _ _ h => h + refine Triple.read_bind (by omega) <| Triple.read_bind (by omega) ?_ + rw [hn1, hsrc] + refine Triple.read_bind (by omega) ?_ + rw [hm] + refine Triple.allocBlockDirty_bind (hfit.of_le (by nlinarith)) ?_ + refine BinaryHeap.Memory.allocLayout_bind + (hfit.of_le (by simp only [PriorityQueue.WordRAM.BinaryHeap.space]; nlinarith)) ?_ + rw [dite_eq_left G.source.isLt] + dsimp only + -- The three structures, at the bounds `K` and `K + 1`, on the memory after allocation. + set f := s₀.frontier with hf + have hH : (BinaryHeap.Memory.allocated G.n (f + G.n)).Valid w K := + BinaryHeap.Memory.valid_allocated hn hKf + have hT : Dictionary.Memory.Valid ⟨f, G.n⟩ w G.n (K + 1) := ⟨rfl, hVf⟩ + have hA : (inputGraph G.n G.m).Valid G.n := ⟨rfl⟩ + set M := framed hH hT hA G.adj with hM + obtain ⟨hHinv, hHabs⟩ := BinaryHeap.Memory.inv_allocated (s := ⟨s₀.mem, f + G.n⟩) + (hz.allocDirty G.n) + obtain ⟨hTinv, hTabs⟩ := Dictionary.Memory.inv_alloc (U := G.n) hz + have hsp : PriorityQueue.WordRAM.BinaryHeap.space G.n = 3 * G.n + 1 := rfl + have hinv : M.inv ⟨s₀.mem, f + G.n + 1 + PriorityQueue.WordRAM.BinaryHeap.space G.n⟩ := by + refine ⟨hHinv, ⟨Block.Allocated.mono hTinv (by simp only; omega), + ⟨by simp only [inputGraph, Block.Allocated]; omega, + by simp only [inputGraph, Block.Allocated]; omega, holds_inputGraph G⟩, ?_⟩, ?_⟩ + · simp only [Dictionary.Memory.framed_footprint, AdjacencyList.Memory.framed_footprint] + rw [Finset.disjoint_left] + intro a ha hb + simp only [Block.mem_footprint, Block.Owns, AdjacencyList.Memory.Layout.footprint, + inputGraph, Finset.mem_union] at ha hb + omega + · simp only [Memory.Framed.prod_footprint, BinaryHeap.Memory.framed_footprint, + Dictionary.Memory.framed_footprint, AdjacencyList.Memory.framed_footprint] + rw [Finset.disjoint_left] + intro a ha hb + simp only [Block.mem_footprint, Block.Owns, AdjacencyList.Memory.Layout.footprint, + BinaryHeap.Memory.Layout.footprint, inputGraph, Finset.mem_union, hsp] at ha hb + omega + have habs : M.abs ⟨s₀.mem, f + G.n + 1 + PriorityQueue.WordRAM.BinaryHeap.space G.n⟩ = + init G := by + exact Prod.ext hHabs (Prod.ext hTabs rfl) + obtain ⟨hvalid, hdist⟩ := dijkstra_correct (K := K) (V := K + 1) G le_rfl (by omega) + rw [← habs] at hvalid hdist + obtain ⟨hvE, -, hstate, -⟩ := M.simulates_client (dijkstra G.source) hinv hvalid + have hcost := (amortized hH hT hA G.adj).client (dijkstra G.source) hinv hvalid + have hcost' := totalCost_dijkstra_le (K := K) (V := K + 1) G le_rfl (by omega) + (opCharge G.n K (K + 1)) rate fun s o ho => by + rcases o with (_ | _ | _ | _ | _) | (_ | _) | (_ | _) <;> + first | exact absurd rfl ho | simp [rate, kind, opCharge, productCharge] + rw [← habs] at hcost' + have hprog : link (memMethods G.n 0 0 0 (BinaryHeap.Memory.allocated G.n (f + G.n)) ⟨f, G.n⟩ + (inputGraph G.n G.m)) (dijkstra (K := 0) (V := 0) ⟨G.source, G.source.isLt⟩) = + link M.methods (dijkstra (K := K) (V := K + 1) G.source) := by + rw [hM, framed_methods, dijkstra_eq K (K + 1) 0 0, memMethods_eq G.n K (K + 1) w 0 0 0] + rfl + rw [hprog] + refine triple_iff.mpr ⟨hvE, ?_, fun v => ?_⟩ + · exact (Nat.le_add_right _ _).trans (hcost.trans (Nat.add_le_add_right hcost' 0)) + obtain ⟨dist, hds, hdv⟩ := hdist + rw [← hstate] at hds + have hcell := congrArg (fun x => x.2.1 v) hds + simp only [M, framed, Memory.Framed.prod_abs] at hcell + refine eq_encodeDist fun d => ?_ + rw [show G.outAddr v = f + v by simp only [ListInstance.outAddr]; omega, ← hdv v d, ← hcell] + exact Iff.rfl + +/-- **Dijkstra's algorithm over memory, unpacked.** On the input words of a graph `G`, at every +word size that holds `8 (n + m + 2) (W + 2)`, every memory operation of `run` is admissible, the +cell `G.outAddr v` then holds the encoded distance from the source to `v`, and the run costs at +most `52 (m + 1) (⌊log₂ n⌋ + 1)` memory units. -/ +theorem run_spec (G : ListInstance) {w : ℕ} + (hfit : Fits w (8 * (G.n + G.m + 2) * (G.maxWeight + 2))) : + (Memory.spec w).ValidHistory (Memory.State.init G.encode) + ((Memory.spec w).clientHistory (Memory.State.init G.encode) run) ∧ + (∀ v : Fin G.n, ((Memory.spec w).clientState (Memory.State.init G.encode) run).mem + (G.outAddr v) = encodeDist (G.dist G.source v)) ∧ + (Memory.spec w).totalCost Memory.charge (Memory.State.init G.encode) + ((Memory.spec w).clientHistory (Memory.State.init G.encode) run) ≤ memCost G.n G.m := by + obtain ⟨hv, hc, hd⟩ := triple_iff.mp (run_triple G hfit) + exact ⟨hv, hd, hc⟩ + +/-- `memCost` grows with the graph. -/ +theorem memCost_mono {n m n' m' : ℕ} (hn : n ≤ n') (hm : m ≤ m') : memCost n m ≤ memCost n' m' := by + unfold memCost + have := Nat.log_mono_right (b := 2) hn + gcongr + +/-- **The exported form: `O((m + 1) log n)` memory units.** One memory program computes the +distances from the source of every graph, at every word size that holds `8 (n + m + 2) (W + 2)`, +admissibly and within `f (n, m)` memory units, for a monotone `f = O((m + 1) log n)` as `n` grows, +uniformly in `m`. Since `m + 1 ≤ n + m`, this is also `O((n + m) log n)`. -/ +theorem exists_run_logLinear : + ∃ f : ℕ × ℕ → ℕ, Monotone f ∧ + (fun p => (f p : ℝ)) =O[Filter.comap Prod.fst Filter.atTop] + (fun ((n, m) : ℕ × ℕ) => ((m + 1) * Nat.log 2 n : ℝ)) ∧ + ∀ (G : ListInstance) (w : ℕ), Fits w (8 * (G.n + G.m + 2) * (G.maxWeight + 2)) → + (Memory.spec w).ValidHistory (Memory.State.init G.encode) + ((Memory.spec w).clientHistory (Memory.State.init G.encode) run) ∧ + (∀ v : Fin G.n, ((Memory.spec w).clientState (Memory.State.init G.encode) run).mem + (G.outAddr v) = encodeDist (G.dist G.source v)) ∧ + (Memory.spec w).totalCost Memory.charge (Memory.State.init G.encode) + ((Memory.spec w).clientHistory (Memory.State.init G.encode) run) ≤ f (G.n, G.m) := by + refine ⟨fun (n, m) => memCost n m, fun ⟨_, _⟩ ⟨_, _⟩ ⟨hn, hm⟩ => memCost_mono hn hm, ?_, + fun G _ hfit => run_spec G hfit⟩ + refine Asymptotics.IsBigO.of_bound 104 ?_ + rw [Filter.eventually_comap] + filter_upwards [Filter.eventually_ge_atTop 2] with b hb p hp + obtain ⟨n, m⟩ := p + simp only at hp + subst hp + have hL : 1 ≤ Nat.log 2 n := Nat.le_log_of_pow_le (by norm_num) (by simpa using hb) + have h : memCost n m ≤ 104 * ((m + 1) * Nat.log 2 n) := by + unfold memCost + nlinarith + simp only [Real.norm_natCast, norm_mul] + rw [Real.norm_of_nonneg (by positivity)] + exact_mod_cast h + +end Cslib.Algorithms.Lean.Dijkstra.Memory diff --git a/Complexity/DataStructure/AdjacencyList/Memory.lean b/Complexity/DataStructure/AdjacencyList/Memory.lean new file mode 100644 index 0000000000..04c3ae9a8f --- /dev/null +++ b/Complexity/DataStructure/AdjacencyList/Memory.lean @@ -0,0 +1,225 @@ +/- +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.AdjacencyList.Spec +public import Complexity.DataStructure.Memory.Frame +public import Complexity.DataStructure.Memory.Triple + +/-! +# Adjacency arrays over the memory oracle + +The read-only adjacency-list interface `AdjacencyList.spec n` is implemented over +`Memory.spec w` by compressed adjacency arrays: a field `offsets` whose cell `u` holds the start +of the list of `u` in the edge array, so that the out-degree of `u` is the difference of two +consecutive offsets, and a field `edges` holding each edge as two cells, its target and its +weight. This is the layout in which a word RAM receives a graph as input. A degree query reads +two offsets, and an edge query reads an offset and the edge's two cells (`amortized`). + +The interface never changes its state, so a refinement represents one graph `adj`: its invariant +says that the arrays hold `adj` (`Holds`), and its abstraction function is constant. The methods +write nothing (`ops_triple`), and the invariant reads only the two fields, so the arrays are +framed by their fields and share memory with other structures (`framed`). + +## Main definitions + +* `Layout`, `Layout.footprint`, `Layout.Valid`: the two fields, their cells, and the length of the + offset field. +* `degree`, `edge`, `ops`, `methods`: the queries as memory programs. +* `Holds`, `Inv`: the arrays hold a graph, and the implementation invariant. +* `refinement`, `framed`: the arrays as a refinement of the interface for the graph they hold, + framed by their fields. + +## Main results + +* `ops_triple`: each query returns the specified answer within three memory units, and writes + nothing. +* `amortized`: every query costs at most three memory units. + +## References + +* [T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein, *Introduction to Algorithms*, + Section 22.1][CLRS2009] +-/ + +@[expose] public section + +namespace Cslib.DataStructure.AdjacencyList.Memory + +open Cslib.WordRAM Cslib.DataStructure Cslib.DataStructure.Memory + +/-- Adjacency arrays: the offset of each vertex's list, and the edges, two cells each. -/ +structure Layout where + /-- Cell `u` holds the position of the first edge out of `u`; cell `n` the number of edges. -/ + offsets : Block + /-- Edge `j` occupies cells `2 j` (its target) and `2 j + 1` (its weight). -/ + edges : Block + +namespace Layout + +/-- The cells of both fields. -/ +def footprint (L : Layout) : Finset ℕ := L.offsets.footprint ∪ L.edges.footprint + +/-- The offset field of a graph on `n` vertices has `n + 1` cells. -/ +structure Valid (L : Layout) (n : ℕ) : Prop where + /-- One offset per vertex, and the end of the last list. -/ + offsets_length : L.offsets.length = n + 1 + +end Layout + +variable {n : ℕ} (L : Layout) + +/-- The out-degree of `u`: the difference of two consecutive offsets. -/ +def degree (u : Fin n) : Prog ℕ := do + let a ← L.offsets.get u + let b ← L.offsets.get (u + 1) + pure (b - a) + +/-- The `i`-th edge out of `u`: its target and weight, from the edge at the offset of `u` plus +`i`. A target that is not a vertex cannot occur for an admissible query; the answer is then the +spec's placeholder `(u, 0)`. -/ +def edge (u : Fin n) (i : ℕ) : Prog (Fin n × ℕ) := do + let a ← L.offsets.get u + let t ← L.edges.get (2 * (a + i)) + let c ← L.edges.get (2 * (a + i) + 1) + pure (if h : t < n then (⟨t, h⟩, c) else (u, 0)) + +/-- The queries as memory programs. -/ +def ops : (o : AdjacencyList.Op n) → Prog o.Result + | .degree u => degree L u + | .edge u i => edge L u i + +/-- The queries as methods of `AdjacencyList.spec n` over `Memory.spec w`. -/ +abbrev methods (w : ℕ) : Methods (AdjacencyList.spec n) (Memory.spec w) := ops L + +/-- The memory `m` holds the graph `adj` in the layout: consecutive offsets differ by the +out-degrees, the edges out of `u` follow its offset in order, and every list ends within the edge +field. -/ +structure Holds (adj : AdjacencyList.State n) (m : ℕ → ℕ) : Prop where + /-- The list of `u` ends where the list of `u + 1` starts. -/ + offset_succ : ∀ u : Fin n, + m (L.offsets.base + (u + 1)) = m (L.offsets.base + u) + (adj u).length + /-- Every list ends within the edge field. -/ + end_le : ∀ u : Fin n, 2 * m (L.offsets.base + (u + 1)) ≤ L.edges.length + /-- The target of each edge. -/ + target : ∀ (u : Fin n) (i : ℕ) (hi : i < (adj u).length), + m (L.edges.base + 2 * (m (L.offsets.base + u) + i)) = (adj u)[i].1 + /-- The weight of each edge. -/ + weight : ∀ (u : Fin n) (i : ℕ) (hi : i < (adj u).length), + m (L.edges.base + (2 * (m (L.offsets.base + u) + i) + 1)) = (adj u)[i].2 + +/-- The implementation invariant for the graph `adj`: both fields are allocated and hold it. -/ +structure Inv (adj : AdjacencyList.State n) (s : Memory.State) : Prop where + /-- The offset field is allocated. -/ + offsets_allocated : L.offsets.Allocated s + /-- The edge field is allocated. -/ + edges_allocated : L.edges.Allocated s + /-- The fields hold the graph. -/ + holds : Holds L adj s.mem + +variable {L} {w : ℕ} {adj : AdjacencyList.State n} + +/-- The cells an edge query reads lie in the edge field. -/ +theorem Holds.edge_lt {m : ℕ → ℕ} (h : Holds L adj m) (u : Fin n) {i : ℕ} + (hi : i < (adj u).length) : 2 * (m (L.offsets.base + u) + i) + 1 < L.edges.length := by + have h₁ := h.offset_succ u + have h₂ := h.end_le u + omega + +/-- **Each query returns the specified answer** within three memory units, and writes nothing. -/ +theorem ops_triple (hL : L.Valid n) {s : Memory.State} (hs : Inv L adj s) + (o : AdjacencyList.Op n) (hv : AdjacencyList.valid adj o) : + Triple w s (ops L o) 3 fun r s' => AdjacencyList.step adj o = (adj, r) ∧ s' = s := by + have hoff : ∀ j ≤ n, L.offsets.base + j < s.frontier := fun j hj => + hs.offsets_allocated.lt_frontier (by rw [hL.offsets_length]; omega) + cases o with + | degree u => + refine Triple.read_bind (hoff u u.isLt.le) <| Triple.read_bind (hoff (u + 1) u.isLt) <| + Triple.pure ⟨?_, rfl⟩ + rw [AdjacencyList.step_degree, hs.holds.offset_succ u] + simp + | edge u i => + have hlt := hs.holds.edge_lt u hv + refine Triple.read_bind (hoff u u.isLt.le) <| + Triple.read_bind (hs.edges_allocated.lt_frontier (by omega)) <| + Triple.read_bind (hs.edges_allocated.lt_frontier hlt) <| Triple.pure ⟨?_, rfl⟩ + rw [AdjacencyList.step_edge _ _ hv, hs.holds.target u i hv, hs.holds.weight u i hv] + simp + +/-- The run of a query, by `ops_triple`. -/ +theorem ops_run (hL : L.Valid n) {s : Memory.State} (hs : Inv L adj s) (o : AdjacencyList.Op n) + (hv : AdjacencyList.valid adj o) : + (Memory.spec w).ValidHistory s ((Memory.spec w).clientHistory s (ops L o)) ∧ + (Memory.spec w).totalCost charge s ((Memory.spec w).clientHistory s (ops L o)) ≤ 3 ∧ + AdjacencyList.step adj o = (adj, (Memory.spec w).clientResult s (ops L o)) ∧ + (Memory.spec w).clientState s (ops L o) = s := + triple_iff.mp (ops_triple hL hs o hv) + +variable (adj) in +/-- The adjacency arrays implement the interface for the graph `adj` they hold. -/ +def refinement (hL : L.Valid n) : Refinement (AdjacencyList.spec n) (Memory.spec w) := + Refinement.ofFn (methods L w) (Inv L adj) (fun _ => adj) + (fun o hs hv => (ops_run hL hs o hv).1) + (fun o hs hv => by + obtain ⟨-, -, hstep, hs'⟩ := ops_run hL hs o hv + exact ⟨hstep, (congrArg (Inv L adj) hs').mpr hs⟩) + +/-- The fields are allocated. -/ +theorem Inv.lt_frontier {s : Memory.State} (hs : Inv L adj s) {a : ℕ} (ha : a ∈ L.footprint) : + a < s.frontier := by + have h₁ := hs.offsets_allocated + have h₂ := hs.edges_allocated + simp only [Layout.footprint, Finset.mem_union, Block.mem_footprint, Block.Owns] at ha + unfold Block.Allocated at h₁ h₂ + omega + +/-- The invariant reads only the two fields and survives a growing frontier. -/ +theorem Inv.congr (hL : L.Valid n) {s s' : Memory.State} (hs : Inv L adj s) + (h : ∀ a ∈ L.footprint, s'.mem a = s.mem a) (hf : s.frontier ≤ s'.frontier) : + Inv L adj s' := by + have hoff : ∀ j ≤ n, s'.mem (L.offsets.base + j) = s.mem (L.offsets.base + j) := fun j hj => + h _ (Finset.mem_union_left _ (Block.mem_footprint.mpr + (Block.owns_add (by rw [hL.offsets_length]; omega)))) + have hedge : ∀ j < L.edges.length, s'.mem (L.edges.base + j) = s.mem (L.edges.base + j) := + fun j hj => h _ (Finset.mem_union_right _ (Block.mem_footprint.mpr (Block.owns_add hj))) + have H := hs.holds + refine ⟨hs.offsets_allocated.mono hf, hs.edges_allocated.mono hf, ⟨fun u => ?_, fun u => ?_, + fun u i hi => ?_, fun u i hi => ?_⟩⟩ + · rw [hoff _ u.isLt, hoff _ u.isLt.le] + exact H.offset_succ u + · rw [hoff _ u.isLt] + exact H.end_le u + · have := H.edge_lt u hi + rw [hoff _ u.isLt.le, hedge _ (by omega)] + exact H.target u i hi + · have := H.edge_lt u hi + rw [hoff _ u.isLt.le, hedge _ this] + exact H.weight u i hi + +variable (adj) in +/-- The adjacency arrays, framed by their two fields. -/ +def framed (hL : L.Valid n) : Memory.Framed (AdjacencyList.spec n) w := + .ofStatic (refinement adj hL) L.footprint (fun hs ha => Inv.lt_frontier hs ha) + (fun hs h hf => ⟨hs.congr hL h hf, rfl⟩) + (fun o hs hv b _ _ => by + obtain ⟨-, -, -, hs'⟩ := ops_run (w := w) hL hs o hv + change ((Memory.spec w).clientState _ (ops L o)).mem b = _ + rw [hs']) + +/-- The footprint of the arrays is their two fields. -/ +@[simp] theorem framed_footprint (hL : L.Valid n) (s : Memory.State) : + (framed (w := w) adj hL).footprint s = L.footprint := rfl + +/-- **Every query costs at most three memory units.** -/ +theorem amortized (hL : L.Valid n) : + (framed (w := w) adj hL).Amortized charge (fun _ _ => 3) fun _ => 0 := + Refinement.Amortized.ofFn fun {_} o hs hv => by + obtain ⟨-, hc, -⟩ := ops_run (w := w) hL hs o hv + exact Nat.add_le_add_right hc 0 + +end Cslib.DataStructure.AdjacencyList.Memory diff --git a/Complexity/DataStructure/Dictionary/Memory.lean b/Complexity/DataStructure/Dictionary/Memory.lean new file mode 100644 index 0000000000..433b139bc6 --- /dev/null +++ b/Complexity/DataStructure/Dictionary/Memory.lean @@ -0,0 +1,188 @@ +/- +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.Dictionary.Spec +public import Complexity.DataStructure.Memory.Frame +public import Complexity.DataStructure.Memory.Triple + +/-! +# A direct-address table over the memory oracle + +The dictionary `Dictionary.spec U V n_max` on the keys `Fin U` is implemented as a direct-address +table: a field `T` of `U` cells, one per key, holding `0` for an absent key and `v + 1` for the +value `v` (`decode`). A lookup reads the key's cell and an insertion writes it, one memory unit +each (`amortized`). The table has a cell for every key, so the capacity `n_max` never binds. +Values below `V` are stored, so `V` must fit a word. + +The table is framed by its field (`framed`), so it shares memory with other structures. Allocated +in memory that is zero above the frontier, it starts empty at the cost of one memory unit +(`inv_alloc`). + +## Main definitions + +* `decode`: the value of a cell, `0` for absent. +* `get`, `insert`, `ops`, `methods`: the operations as memory programs. +* `abs`, `Inv`, `Valid`: the abstraction function, the implementation invariant and the static + well-formedness of the field. +* `refinement`, `framed`: the table as a refinement of the dictionary, framed by its field. + +## Main results + +* `amortized`: every operation costs one memory unit. +* `inv_alloc`: a field allocated in memory that is zero above the frontier is an empty table. + +## References + +* [T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein, *Introduction to Algorithms*, + Section 11.1][CLRS2009] +-/ + +@[expose] public section + +namespace Cslib.DataStructure.Dictionary.Memory + +open Cslib.WordRAM Cslib.DataStructure Cslib.DataStructure.Memory + +/-- The value stored in a cell: `0` is an absent key, and `v + 1` the value `v`. This is the +word encoding of `Option ℕ` that the word-RAM dictionaries use. -/ +def decode : ℕ → Option ℕ + | 0 => none + | v + 1 => some v + +@[simp] theorem decode_zero : decode 0 = none := rfl + +@[simp] theorem decode_succ (v : ℕ) : decode (v + 1) = some v := rfl + +variable {U : ℕ} (T : Block) + +/-- Look up a key: read its cell. -/ +def get (u : Fin U) : Prog (Option ℕ) := do + let x ← T.get u + pure (decode x) + +/-- Store the value `v` for a key: write `v + 1` to its cell. -/ +def insert (u : Fin U) (v : ℕ) : Prog Unit := T.set u (v + 1) + +/-- The dictionary operations as memory programs. -/ +def ops : (o : Dictionary.Op U) → Prog o.Result + | .get u => get T u + | .insert u v => insert T u v + +/-- The operations as methods of `Dictionary.spec U V n_max` over `Memory.spec w`. -/ +abbrev methods (w V n_max : ℕ) : Methods (Dictionary.spec U V n_max) (Memory.spec w) := ops T + +/-- The represented dictionary: the decoded cell of each key. -/ +def abs (s : Memory.State) : Dictionary.State U := fun u => decode (s.mem (T.base + u)) + +/-- The implementation invariant: the field is allocated. -/ +abbrev Inv (s : Memory.State) : Prop := T.Allocated s + +/-- Static well-formedness for `U` keys and values below `V` at word size `w`: one cell per key, +and `V` fits a word, so every stored `v + 1` does. -/ +structure Valid (T : Block) (w U V : ℕ) : Prop where + /-- One cell per key. -/ + length_eq : T.length = U + /-- The value bound fits a word. -/ + value_fits : Fits w V + +variable {T} {w V n_max : ℕ} + +/-- The cell of a key is allocated. -/ +theorem cell_lt (hT : Valid T w U V) {s : Memory.State} (hs : Inv T s) (u : Fin U) : + T.base + u < s.frontier := + Block.Allocated.lt_frontier hs (by rw [hT.length_eq]; exact u.isLt) + +/-- The cell of a key belongs to the field. -/ +theorem mem_footprint (hT : Valid T w U V) (u : Fin U) : T.base + u ∈ T.footprint := + Block.mem_footprint.mpr (Block.owns_add (by rw [hT.length_eq]; exact u.isLt)) + +/-- An owned cell of an allocated field is allocated. -/ +theorem lt_of_owns {s : Memory.State} (hs : Inv T s) {a : ℕ} (ha : T.Owns a) : a < s.frontier := by + unfold Block.Owns at ha + unfold Inv Block.Allocated at hs + omega + +variable (T) in +/-- What a run of the operation `o` from `s` establishes: the specified step, the invariant, and +no change to the frontier or to any cell outside the field. -/ +def Post (s : Memory.State) (o : Dictionary.Op U) (r : o.Result) (s' : Memory.State) : Prop := + Dictionary.step (abs T s) o = (abs T s', r) ∧ Inv T s' ∧ s'.frontier = s.frontier ∧ + ∀ a ∉ T.footprint, s'.mem a = s.mem a + +/-- **Each operation realizes the specified step** with one memory operation. -/ +theorem ops_triple (hT : Valid T w U V) {s : Memory.State} (hs : Inv T s) (o : Dictionary.Op U) + (hv : (Dictionary.spec U V n_max).valid (abs T s) o) : Triple w s (ops T o) 1 (Post T s o) := by + cases o with + | get u => + exact Triple.read_bind (cell_lt hT hs u) + (Triple.pure ⟨rfl, hs, rfl, fun _ _ => rfl⟩) + | insert u v => + refine Triple.write_bind (cell_lt hT hs u) (hT.value_fits.of_le hv.2) <| + Triple.pure ⟨?_, hs, rfl, fun a ha => Function.update_of_ne + (fun h => ha (by rw [h]; exact mem_footprint hT u)) _ _⟩ + refine Prod.ext (funext fun u' => ?_) rfl + by_cases hu : u' = u + · subst hu + simp [abs] + · have : (T.base + u' : ℕ) ≠ T.base + u := by + have := Fin.val_ne_of_ne hu + omega + simp [abs, hu, Function.update_of_ne this] + +/-- The run of an operation, by `ops_triple`. -/ +theorem ops_run (hT : Valid T w U V) {s : Memory.State} (hs : Inv T s) (o : Dictionary.Op U) + (hv : (Dictionary.spec U V n_max).valid (abs T s) o) : + (Memory.spec w).ValidHistory s ((Memory.spec w).clientHistory s (ops T o)) ∧ + (Memory.spec w).totalCost charge s ((Memory.spec w).clientHistory s (ops T o)) ≤ 1 ∧ + Post T s o ((Memory.spec w).clientResult s (ops T o)) + ((Memory.spec w).clientState s (ops T o)) := + triple_iff.mp (ops_triple hT hs o hv) + +/-- The direct-address table implements the dictionary. -/ +def refinement (hT : Valid T w U V) : Refinement (Dictionary.spec U V n_max) (Memory.spec w) := + Refinement.ofFn (methods T w V n_max) (Inv T) (abs T) + (fun o hs hv => (ops_run hT hs o hv).1) + (fun o hs hv => by + obtain ⟨-, -, hstep, hinv, -⟩ := ops_run hT hs o hv + exact ⟨hstep, hinv⟩) + +/-- The abstraction reads only the field. -/ +theorem abs_congr (hT : Valid T w U V) {s s' : Memory.State} + (h : ∀ a ∈ T.footprint, s'.mem a = s.mem a) : abs (U := U) T s' = abs T s := + funext fun u => by simp only [abs, h _ (mem_footprint hT u)] + +/-- The table, framed by its field. -/ +def framed (hT : Valid T w U V) : Memory.Framed (Dictionary.spec U V n_max) w := + .ofStatic (refinement hT) T.footprint (fun hs ha => lt_of_owns hs (Block.mem_footprint.mp ha)) + (fun hs h hf => ⟨Block.Allocated.mono hs hf, abs_congr hT h⟩) + (fun o hs hv b _ hb => by + obtain ⟨-, -, -, -, -, h⟩ := ops_run hT hs o hv + exact h b hb) + +/-- The footprint of a table is its field. -/ +@[simp] theorem framed_footprint (hT : Valid T w U V) (s : Memory.State) : + (framed (n_max := n_max) hT).footprint s = T.footprint := rfl + +/-- **Every operation costs one memory unit.** -/ +theorem amortized (hT : Valid T w U V) : + (framed (n_max := n_max) hT).Amortized charge (fun _ _ => 1) fun _ => 0 := + Refinement.Amortized.ofFn fun {_} o hs hv => by + obtain ⟨-, hc, -⟩ := ops_run (w := w) hT hs o hv + exact Nat.add_le_add_right hc 0 + +/-- A field allocated without clearing in memory that is zero above the frontier is an empty +table. -/ +theorem inv_alloc {s : Memory.State} (hz : ZeroAbove s) : + Inv ⟨s.frontier, U⟩ ⟨s.mem, s.frontier + U⟩ ∧ + abs ⟨s.frontier, U⟩ ⟨s.mem, s.frontier + U⟩ = Dictionary.empty U := by + refine ⟨le_rfl, funext fun u => ?_⟩ + change decode (s.mem (s.frontier + u)) = none + rw [hz _ (Nat.le_add_right _ _), decode_zero] + +end Cslib.DataStructure.Dictionary.Memory diff --git a/ComplexityTests/DijkstraMemory.lean b/ComplexityTests/DijkstraMemory.lean new file mode 100644 index 0000000000..cfd90b2a67 --- /dev/null +++ b/ComplexityTests/DijkstraMemory.lean @@ -0,0 +1,61 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +import Complexity.Algorithms.Lean.Dijkstra.Memory + +/-! +# Dijkstra's algorithm with a binary heap, run on the word RAM's input convention + +The graph of `ComplexityTests/Dijkstra.lean`, with a parallel edge and a shorter path through a +third vertex, is written in the input convention and given to `Dijkstra.Memory.run` at word size +`16`. The tests check the distances it leaves past the input, the admissibility of every memory +operation, its exact memory cost against the proved bound `memCost 3 4 = 520`, and that +`run_spec` applies to this graph. +-/ + +open Cslib.WordRAM Cslib.DataStructure +open Cslib.Algorithms.WordRAM.Dijkstra (ListInstance encodeDist) +open Cslib.Algorithms.Lean.Dijkstra.Memory + +namespace DijkstraMemoryTests + +/-- Edges `0 → 1` of weights `4` and `5`, `0 → 2` of weight `1`, and `2 → 1` of weight `2`, from +source `0`. The distances are `0`, `3` and `1`. -/ +def graph : ListInstance where + n := 3 + adj := ![[(1, 4), (2, 1), (1, 5)], [], [(1, 2)]] + source := 0 + +/-- The input words: `n`, the source, four offsets and four edges. -/ +example : graph.encode = [3, 0, 0, 3, 3, 4, 1, 4, 2, 1, 1, 5, 1, 2] := by decide + +/-- The memory of the input convention. -/ +def input : Memory.State := Memory.State.init graph.encode + +-- The cells just past the input hold the encoded distances `0 + 1`, `3 + 1` and `1 + 1`. +#guard (List.finRange 3).map (fun v => + ((Memory.spec 16).clientState input run).mem (graph.outAddr v)) = [1, 4, 2] + +-- Every memory operation of the run is admissible at word size `16`. +#guard decide ((Memory.spec 16).ValidHistory input ((Memory.spec 16).clientHistory input run)) + +-- Its exact memory cost, within `memCost 3 4 = 520`. +#guard (Memory.spec 16).totalCost Memory.charge input + ((Memory.spec 16).clientHistory input run) = 75 + +example : memCost 3 4 = 520 := by decide + +/-- The word size `16` holds `8 (n + m + 2) (W + 2) = 504`, so `run_spec` applies. -/ +theorem fits : Fits 16 (8 * (graph.n + graph.m + 2) * (graph.maxWeight + 2)) := by decide + +/-- By `run_spec`, the cell of vertex `1` holds its encoded distance. -/ +example : ((Memory.spec 16).clientState input run).mem (graph.outAddr ⟨1, by decide⟩) = + encodeDist (graph.dist graph.source ⟨1, by decide⟩) := + (run_spec graph fits).2.1 _ + +/-- A word size too small for the input: `504` does not fit eight bits. -/ +example : ¬Fits 8 (8 * (graph.n + graph.m + 2) * (graph.maxWeight + 2)) := by decide + +end DijkstraMemoryTests From 9fd04ae188de6aaaa1ba89293583f21313cd55f8 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 19:22:05 -0500 Subject: [PATCH 18/20] feat(Algorithms/Lean/Dijkstra): Dijkstra with a binary heap over the memory oracle Memory modules for the other two interfaces of the Dijkstra client: a direct-address table for Dictionary.spec (one cell per key, one memory unit per operation) and compressed adjacency arrays for AdjacencyList.spec (the input layout of a word RAM; at most three memory units per query). With the binary heap they form one Memory.Framed product implementing Dijkstra.spec. Dijkstra.Memory.run is one memory program for every graph: it reads n, the source and m from the input convention, allocates the distance table and the heap past the input, and runs the linked client. run_spec: every memory operation is admissible, the cells past the input hold the encoded distances (the output convention of LogLinearSpec), and the run costs at most 52 (m + 1) (log n + 1) memory units; exists_run_logLinear exports this as O((m + 1) log n). Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Complexity.lean b/Complexity.lean index e347d25329..318f7d9802 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -12,6 +12,7 @@ public import Complexity.Algorithms.ExactTriangle.Weights public import Complexity.Algorithms.ExactTriangle.Witnesses public import Complexity.Algorithms.Lean.Dijkstra.Client public import Complexity.Algorithms.Lean.Dijkstra.Cost +public import Complexity.Algorithms.Lean.Dijkstra.Memory public import Complexity.Algorithms.Lean.Huffman.Basic public import Complexity.Algorithms.Lean.Huffman.Kraft public import Complexity.Algorithms.Lean.Huffman.Optimality @@ -2815,6 +2816,7 @@ public import Complexity.Crypto.Protocols.Signature.RandomOracle public import Complexity.DataStructure.AVLTree.Basic public import Complexity.DataStructure.AVLTree.Erase public import Complexity.DataStructure.AVLTree.Impl +public import Complexity.DataStructure.AdjacencyList.Memory public import Complexity.DataStructure.AdjacencyList.Spec public import Complexity.DataStructure.CountMin.Basic public import Complexity.DataStructure.CountMin.LinearHash @@ -2822,6 +2824,7 @@ public import Complexity.DataStructure.CountMin.Probability public import Complexity.DataStructure.CountMin.Program public import Complexity.DataStructure.Dictionary.CuckooHashing public import Complexity.DataStructure.Dictionary.DoubleHashing +public import Complexity.DataStructure.Dictionary.Memory public import Complexity.DataStructure.Dictionary.Spec public import Complexity.DataStructure.Dictionary.UniformProbing public import Complexity.DataStructure.Dictionary.WordRAM.ChainedHash From a9e0b2ec6db748394bc9a3fa8a86fd9bfbbaf7bc Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 19:22:30 -0500 Subject: [PATCH 19/20] test(Dijkstra): allow #guard in the memory test Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- ComplexityTests/DijkstraMemory.lean | 2 ++ 1 file changed, 2 insertions(+) diff --git a/ComplexityTests/DijkstraMemory.lean b/ComplexityTests/DijkstraMemory.lean index cfd90b2a67..f1210426c9 100644 --- a/ComplexityTests/DijkstraMemory.lean +++ b/ComplexityTests/DijkstraMemory.lean @@ -19,6 +19,8 @@ open Cslib.WordRAM Cslib.DataStructure open Cslib.Algorithms.WordRAM.Dijkstra (ListInstance encodeDist) open Cslib.Algorithms.Lean.Dijkstra.Memory +set_option linter.hashCommand false + namespace DijkstraMemoryTests /-- Edges `0 → 1` of weights `4` and `5`, `0 → 2` of weight `1`, and `2 → 1` of weight `2`, from From 9a20b2fa2171e842728bbb14d14d7ea509a4ee01 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 19:26:59 -0500 Subject: [PATCH 20/20] refactor(Algorithms/Lean/Dijkstra): state the allocated structures separately inv_input: after allocation past the input, the heap, the distance table and the input's adjacency arrays represent Dijkstra's initial state. run_triple uses it. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../Algorithms/Lean/Dijkstra/Memory.lean | 69 ++++++++++++------- 1 file changed, 45 insertions(+), 24 deletions(-) diff --git a/Complexity/Algorithms/Lean/Dijkstra/Memory.lean b/Complexity/Algorithms/Lean/Dijkstra/Memory.lean index 177f784de0..62e06022a5 100644 --- a/Complexity/Algorithms/Lean/Dijkstra/Memory.lean +++ b/Complexity/Algorithms/Lean/Dijkstra/Memory.lean @@ -48,6 +48,7 @@ file does not provide. * `dijkstra_eq`: the client does not depend on the key and value bounds of its interfaces. * `holds_inputGraph`: the input holds the graph in the adjacency arrays. +* `inv_input`: after allocation, the structures represent the initial state. * `run_spec`: admissibility, distances and memory cost of `run`. * `exists_run_logLinear`: the same with an `O((m + 1) log n)` cost function. @@ -172,6 +173,49 @@ theorem holds_inputGraph (G : ListInstance) : 2 * (G.offset u + i) + G.n + 5 by omega] exact G.init_weight (r := 0) u hi +/-- **The structures after allocation.** Past the input of `G`, a distance table and then a heap, +allocated without clearing, together with the adjacency arrays of the input, represent the +initial state of Dijkstra's algorithm on `G`: an empty queue, an empty distance map and the +graph. -/ +theorem inv_input (G : ListInstance) {w K V : ℕ} + (hH : (BinaryHeap.Memory.allocated G.n ((Memory.State.init G.encode).frontier + G.n)).Valid + w K) + (hT : Dictionary.Memory.Valid ⟨(Memory.State.init G.encode).frontier, G.n⟩ w G.n V) + (hA : (inputGraph G.n G.m).Valid G.n) : + (framed hH hT hA G.adj).inv ⟨(Memory.State.init G.encode).mem, + (Memory.State.init G.encode).frontier + G.n + 1 + + PriorityQueue.WordRAM.BinaryHeap.space G.n⟩ ∧ + (framed hH hT hA G.adj).abs ⟨(Memory.State.init G.encode).mem, + (Memory.State.init G.encode).frontier + G.n + 1 + + PriorityQueue.WordRAM.BinaryHeap.space G.n⟩ = init G := by + set s₀ := Memory.State.init G.encode with hs₀ + have hf₀ : s₀.frontier = G.n + 2 * G.m + 4 := by + simp only [s₀, Memory.State.init, G.encode_length] + have hz : ZeroAbove s₀ := zeroAbove_init _ + set f := s₀.frontier with hf + have hf₁ : (Memory.State.init G.encode).frontier = G.n + 2 * G.m + 4 := hf₀ + obtain ⟨hHinv, hHabs⟩ := BinaryHeap.Memory.inv_allocated (s := ⟨s₀.mem, f + G.n⟩) + (hz.allocDirty G.n) + obtain ⟨hTinv, hTabs⟩ := Dictionary.Memory.inv_alloc (U := G.n) hz + have hsp : PriorityQueue.WordRAM.BinaryHeap.space G.n = 3 * G.n + 1 := rfl + refine ⟨⟨hHinv, ⟨Block.Allocated.mono hTinv (by simp only; omega), + ⟨by simp only [inputGraph, Block.Allocated]; omega, + by simp only [inputGraph, Block.Allocated]; omega, holds_inputGraph G⟩, ?_⟩, ?_⟩, + Prod.ext hHabs (Prod.ext hTabs rfl)⟩ + · simp only [Dictionary.Memory.framed_footprint, AdjacencyList.Memory.framed_footprint] + rw [Finset.disjoint_left] + intro a ha hb + simp only [Block.mem_footprint, Block.Owns, AdjacencyList.Memory.Layout.footprint, + inputGraph, Finset.mem_union] at ha hb + omega + · simp only [Memory.Framed.prod_footprint, BinaryHeap.Memory.framed_footprint, + Dictionary.Memory.framed_footprint, AdjacencyList.Memory.framed_footprint] + rw [Finset.disjoint_left] + intro a ha hb + simp only [Block.mem_footprint, Block.Owns, AdjacencyList.Memory.Layout.footprint, + BinaryHeap.Memory.Layout.footprint, inputGraph, Finset.mem_union, hsp] at ha hb + omega + /-- A cell whose decoded value is `some d` exactly when the distance `D` is `d` holds the encoded distance. -/ private theorem eq_encodeDist {x : ℕ} {D : ℕ∞} @@ -255,30 +299,7 @@ theorem run_triple (G : ListInstance) {w : ℕ} have hT : Dictionary.Memory.Valid ⟨f, G.n⟩ w G.n (K + 1) := ⟨rfl, hVf⟩ have hA : (inputGraph G.n G.m).Valid G.n := ⟨rfl⟩ set M := framed hH hT hA G.adj with hM - obtain ⟨hHinv, hHabs⟩ := BinaryHeap.Memory.inv_allocated (s := ⟨s₀.mem, f + G.n⟩) - (hz.allocDirty G.n) - obtain ⟨hTinv, hTabs⟩ := Dictionary.Memory.inv_alloc (U := G.n) hz - have hsp : PriorityQueue.WordRAM.BinaryHeap.space G.n = 3 * G.n + 1 := rfl - have hinv : M.inv ⟨s₀.mem, f + G.n + 1 + PriorityQueue.WordRAM.BinaryHeap.space G.n⟩ := by - refine ⟨hHinv, ⟨Block.Allocated.mono hTinv (by simp only; omega), - ⟨by simp only [inputGraph, Block.Allocated]; omega, - by simp only [inputGraph, Block.Allocated]; omega, holds_inputGraph G⟩, ?_⟩, ?_⟩ - · simp only [Dictionary.Memory.framed_footprint, AdjacencyList.Memory.framed_footprint] - rw [Finset.disjoint_left] - intro a ha hb - simp only [Block.mem_footprint, Block.Owns, AdjacencyList.Memory.Layout.footprint, - inputGraph, Finset.mem_union] at ha hb - omega - · simp only [Memory.Framed.prod_footprint, BinaryHeap.Memory.framed_footprint, - Dictionary.Memory.framed_footprint, AdjacencyList.Memory.framed_footprint] - rw [Finset.disjoint_left] - intro a ha hb - simp only [Block.mem_footprint, Block.Owns, AdjacencyList.Memory.Layout.footprint, - BinaryHeap.Memory.Layout.footprint, inputGraph, Finset.mem_union, hsp] at ha hb - omega - have habs : M.abs ⟨s₀.mem, f + G.n + 1 + PriorityQueue.WordRAM.BinaryHeap.space G.n⟩ = - init G := by - exact Prod.ext hHabs (Prod.ext hTabs rfl) + obtain ⟨hinv, habs⟩ := inv_input G hH hT hA obtain ⟨hvalid, hdist⟩ := dijkstra_correct (K := K) (V := K + 1) G le_rfl (by omega) rw [← habs] at hvalid hdist obtain ⟨hvE, -, hstate, -⟩ := M.simulates_client (dijkstra G.source) hinv hvalid