From 86093f013db587270936092e860d6c307df68244 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Sun, 1 Nov 2026 21:59:36 -0500 Subject: [PATCH 1/6] refactor(Algorithms/WordRAM/Karger): derive contraction survival from Karger.spec `contractDownTo` now simulates the client `Lean.Karger.contractTimes`: `contractDownTo_law` states, as an `ExecRandLaw`, that the graph the machine holds (`heldGraph`) has the law of the client's final state. Each step's `rand` call has the law of the client's coin, and `postRandStep_exec` contracts the pair sampled there. `contractDownTo_spec` keeps its statement. Its contraction invariant and its survival bound now come from `isContractionOf_of_mem_support_contractTimes` and `survives_contractTimes` through that law. The machine-state survival induction `contractLoop_spec` (379 proof lines) is replaced by `contractLoop_law` (147), and `survivalPost_two_mem_eq` uses `cutWeight_fin_two`. `ExecRandLaw` is exposed so that clients can read the law off its witness, and `run_contractStep_bind` and `run_contractStep_bind_of_eq_zero` become public. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../Algorithms/Lean/Karger/Contraction.lean | 17 +- .../Algorithms/WordRAM/Karger/Contract.lean | 622 ++++++------------ .../Computability/WordRAM/Randomized/Law.lean | 2 +- 3 files changed, 224 insertions(+), 417 deletions(-) diff --git a/Complexity/Algorithms/Lean/Karger/Contraction.lean b/Complexity/Algorithms/Lean/Karger/Contraction.lean index 92b7827b9a..4a198db794 100644 --- a/Complexity/Algorithms/Lean/Karger/Contraction.lean +++ b/Complexity/Algorithms/Lean/Karger/Contraction.lean @@ -41,11 +41,12 @@ less than it (`minCut_le_of_mem_support_karger`). Every call it makes is admissi `telescope_survival_step`), used unchanged, and the composition of the stages is `Probability.PMF.toOuterMeasure_bind_ge_mul_ennreal`. -The word-RAM implementation proves the same bound on machine states, interleaved with register -steps (`Cslib.Algorithms.WordRAM.Karger.contractDownTo_spec`). Here no register, address or -instruction count appears. An implementation of `spec` over the memory oracle is a separate, -deterministic hop, and `Refinement.toRandomized` with `RandomizedRefinement.withCoins` carries the -law of the client through it. +No register, address or instruction count appears here. The word-RAM loop +`Cslib.Algorithms.WordRAM.Karger.contractDownTo` simulates `contractTimes`: the graph it holds has +the law of the client's final state (`Cslib.Algorithms.WordRAM.Karger.contractDownTo_law`), so its +survival bound is `survives_contractTimes`. An implementation of `spec` over the memory oracle is a +separate, deterministic hop, and `Refinement.toRandomized` with `RandomizedRefinement.withCoins` +carries the law of the client through it. ## Main definitions @@ -56,6 +57,8 @@ law of the client through it. ## Main results +* `run_contractStep_bind`, `run_contractStep_bind_of_eq_zero`: the run of one contraction, the + step that an implementation simulates. * `survives_contractTimes`: the survival bound. * `two_div_le_toOuterMeasure_karger`: Karger's success probability. * `isContractionOf_of_mem_support_contractTimes`, `minCut_le_of_mem_support_karger`: every @@ -181,7 +184,7 @@ noncomputable def karger : ProbOracleComp Op.Result ℕ := do /-- One contraction of a graph of positive weight draws a uniform offset below the weight and contracts the pair sampled there. -/ -private theorem run_contractStep_bind {α : Type} (p : ProbOracleComp Op.Result α) {m : ℕ} +theorem run_contractStep_bind {α : Type} (p : ProbOracleComp Op.Result α) {m : ℕ} (W : Fin (m + 1) → Fin (m + 1) → ℕ) (hS : totalDoubledWeight W ≠ 0) : spec.toRandomized.withCoins.run (contractStep >>= fun _ => p) ⟨m + 1, W⟩ = (ProbComp.unifOracle (totalDoubledWeight W - 1)).bind fun r => @@ -197,7 +200,7 @@ private theorem run_contractStep_bind {α : Type} (p : ProbOracleComp Op.Result rfl /-- One contraction of a weightless graph contracts its first and last supervertices. -/ -private theorem run_contractStep_bind_of_eq_zero {α : Type} (p : ProbOracleComp Op.Result α) +theorem run_contractStep_bind_of_eq_zero {α : Type} (p : ProbOracleComp Op.Result α) {m : ℕ} (W : Fin (m + 1) → Fin (m + 1) → ℕ) (hS : totalDoubledWeight W = 0) : spec.toRandomized.withCoins.run (contractStep >>= fun _ => p) ⟨m + 1, W⟩ = spec.toRandomized.withCoins.run p ⟨m, contractMatrix W 0 (Fin.last m)⟩ := by diff --git a/Complexity/Algorithms/WordRAM/Karger/Contract.lean b/Complexity/Algorithms/WordRAM/Karger/Contract.lean index 429d0e1a02..7f52b17c88 100644 --- a/Complexity/Algorithms/WordRAM/Karger/Contract.lean +++ b/Complexity/Algorithms/WordRAM/Karger/Contract.lean @@ -8,10 +8,10 @@ module -- upstream: candidate public import Complexity.Init -public import Complexity.Algorithms.WordRAM.Karger.Graph +public import Complexity.Algorithms.Lean.Karger.Contraction public import Complexity.Computability.WordRAM.Heap public import Complexity.Computability.WordRAM.Notation -public import Complexity.Computability.WordRAM.Randomized.Structured +public import Complexity.Computability.WordRAM.Randomized.Law /-! # Workspace-relocatable randomized contraction on the word RAM @@ -33,6 +33,16 @@ yielding `36 * (k ^ 2 - t ^ 2) + 4` worst-case instructions and at most `k - t` `k` down to `t`, with survival probability at least `(t * (t - 1)) / (k * (k - 1))` for any fixed minimum cut of a connected multigraph. +The probability is not proved on machine states. `contractDownTo` simulates Karger's algorithm as +a client of the contraction structure `Cslib.Algorithms.Lean.Karger.spec`: the graph the machine +holds (`heldGraph`) has the law of `Cslib.Algorithms.Lean.Karger.contractTimes` +(`contractDownTo_law`). Each step's `rand` call draws the offset uniformly below the total weight, +as the client's coin does, and `postRandStep_exec` contracts the pair sampled there. The survival +bound and the contraction invariant are the specification's +(`Cslib.Algorithms.Lean.Karger.survives_contractTimes`, +`Cslib.Algorithms.Lean.Karger.isContractionOf_of_mem_support_contractTimes`), carried through that +law. + ## Source statements and notation mapping * **Matrix contraction and survival bound (paraphrase):** @@ -68,6 +78,8 @@ minimum cut of a connected multigraph. `Cslib.Algorithms.WordRAM.Karger.ContractState`: relocatable memory layout and word-bound invariants for an active `k × k` supervertex adjacency matrix with row stride `stride` and row degree array at `dBase`. +* `Cslib.Algorithms.WordRAM.Karger.heldGraph`: the graph a machine state holds, as a state of + `Cslib.Algorithms.Lean.Karger.spec`. * `Cslib.Algorithms.WordRAM.Karger.computeDegreesAndTotal`, `Cslib.Algorithms.WordRAM.Karger.computeDegreesAndTotalAt`: deterministic `O(k ^ 2)` initializer populating `D[0..k)` and `totS`. @@ -80,10 +92,13 @@ minimum cut of a connected multigraph. * `Cslib.Algorithms.WordRAM.Karger.computeDegreesAndTotal_exec`: `computeDegreesAndTotal` populates `HoldsWorkspace` and `totS = totalDoubledWeight W` within `6 * k ^ 2 + 12 * k + 6` instructions, modifying only `Finset.Ico dBase (dBase + k)`. +* `Cslib.Algorithms.WordRAM.Karger.contractDownTo_law`: `contractDownTo` simulates `k - t` + contractions of the specification: `ExecRandLaw` with `IsQueryBounded (k - t)`, worst-case step + bound `36 * (k ^ 2 - t ^ 2) + 4`, `Modifies` frame, and the law of `heldGraph`. * `Cslib.Algorithms.WordRAM.Karger.contractDownTo_spec`: joint certificate of `ExecRand`, `IsQueryBounded (k - t)`, worst-case step bound `36 * (k ^ 2 - t ^ 2) + 4`, `Modifies` frame, - contraction invariant `IsContractionOf`, and telescoping cut-survival probability lower bound - `((t * (t - 1) : ℕ) : ℝ≥0∞) / (k * (k - 1))`. + contraction invariant `IsContractionOf`, and cut-survival probability lower bound + `((t * (t - 1) : ℕ) : ℝ≥0∞) / (k * (k - 1))`, the last two from the specification. ## References @@ -170,6 +185,27 @@ structure ContractState (w wb db str k t : ℕ) (W : Fin k → Fin k → ℕ) (x fits_totS : Fits w (totalDoubledWeight W) workspace : HoldsWorkspace x.mem wb db str W +/-- The graph that a machine state holds in the workspace at `wb` with row stride `str`: `activeK` +supervertices, with the weight matrix read from memory. It abstracts a `ContractState` to a state +of the contraction structure `Lean.Karger.spec`. -/ +def heldGraph (wb str : ℕ) (x : Data 16) : Lean.Karger.Graph := + ⟨x.regs Reg.activeK, fun i j => x.mem (wb + i.val * str + j.val)⟩ + +/-- A state holding `W` on `k` supervertices holds the graph `⟨k, W⟩`. -/ +theorem ContractState.heldGraph_eq {w wb db str k t : ℕ} {W : Fin k → Fin k → ℕ} {x : Data 16} + (hst : ContractState w wb db str k t W x) : heldGraph wb str x = ⟨k, W⟩ := by + unfold heldGraph + rw [hst.regs_activeK] + exact congrArg _ (funext₂ hst.workspace.1) + +/-- The weight matrix of a state is the weight of the graph it holds. -/ +private theorem ContractState.eq_of_heldGraph_eq {w wb db str k t : ℕ} {W W' : Fin k → Fin k → ℕ} + {x : Data 16} (hst : ContractState w wb db str k t W x) (h : heldGraph wb str x = ⟨k, W'⟩) : + W = W' := by + have h' := hst.heldGraph_eq.symm.trans h + simp only [Lean.Karger.Graph.mk.injEq, heq_eq_eq, true_and] at h' + exact h' + theorem matAddr_lt_end {wb str k : ℕ} (hstr : k ≤ str) (i j : Fin k) : wb + i.val * str + j.val < wb + str * k := by have hi : i.val + 1 ≤ k := i.isLt @@ -2466,14 +2502,7 @@ theorem postRandStep_exec {w wb db str m t r_val : ℕ} workspace := hws_m } -/-! #### `PMF.toOuterMeasure` helpers for step-count maps and `contractDownTo_spec` -/ - -private theorem eval_map_snd_toOuterMeasure {α : Type} (m : ProbComp (α × ℕ)) - (g : α × ℕ → ℕ) (P : α → Prop) : - (((fun z => (z.1, g z)) <$> m).eval).toOuterMeasure {z | P z.1} = - m.eval.toOuterMeasure {z | P z.1} := by - rw [ProbComp.eval_map, PMF.toOuterMeasure_map_apply] - rfl +/-! #### Simulation of the contraction structure and `contractDownTo_spec` -/ private theorem step_budget_succ {t m n_post z₂ : ℕ} (ht : 2 ≤ t) (hm : t ≤ m) (hn : n_post ≤ 45 * (m + 1) + 22) (hz : z₂ ≤ 36 * (m ^ 2 - t ^ 2) + 2) : @@ -2497,87 +2526,78 @@ def SurvivalPost {n : ℕ} (W₀ : Fin n → Fin n → ℕ) (wb db str t : ℕ) y.regs totS = totalDoubledWeight W' ∧ pullbackCut part' B' = C_star -private theorem contractLoop_spec {n w wb db str t steps : ℕ} {W₀ : Fin n → Fin n → ℕ} - {W : Fin (t + steps) → Fin (t + steps) → ℕ} {part : Fin n → Fin (t + steps)} {x : Data 16} - (ht : 2 ≤ t) (hC : IsContractionOf W₀ part W) - (h0 : x.regs zero = 0) (h1 : x.regs one = 1) - (hst : ContractState w wb db str (t + steps) t W x) : - ∃ m : ProbComp (Data 16 × ℕ), - ExecRand w ram[while targetT < activeK do [ ⟪contractStep⟫ ]] x m ∧ - m.IsQueryBounded steps ∧ - (∀ z ∈ m.support, - z.2 ≤ 36 * ((t + steps) ^ 2 - t ^ 2) + 2 ∧ - Modifies (workspaceFootprint wb db str (t + steps)) x.mem z.1.mem ∧ - ∃ (W' : Fin t → Fin t → ℕ) (part' : Fin n → Fin t), - IsContractionOf W₀ part' W' ∧ - ContractState w wb db str t t W' z.1) ∧ - (∀ B : Finset (Fin (t + steps)), - 0 < minCut W₀ → IsNonTrivialCut B → - cutWeight W₀ (pullbackCut part B) = minCut W₀ → - (((t * (t - 1) : ℕ) : ℝ≥0∞) / (((t + steps) * (t + steps - 1) : ℕ) : ℝ≥0∞)) ≤ - m.eval.toOuterMeasure {z | SurvivalPost W₀ wb db str t (pullbackCut part B) z.1}) := by - induction steps generalizing x with +/-- **The contraction loop refines the contraction structure.** From a state holding a multigraph +`W` on `t + s` supervertices, the loop runs within `36 ((t + s)² - t²) + 2` instructions and `s` +`rand` calls, writes only the workspace and ends holding a multigraph on `t` supervertices. The +graph it holds has the law of `s` contractions of `⟨t + s, W⟩` in `Lean.Karger.spec`: each +positive-weight step draws the offset uniformly below the total weight, as the client +`Lean.Karger.contractStep` does, and `postRandStep` contracts the pair sampled there. -/ +private theorem contractLoop_law {w wb db str t s : ℕ} {W : Fin (t + s) → Fin (t + s) → ℕ} + {x : Data 16} (ht : 2 ≤ t) (hW : IsMultigraph W) (h0 : x.regs zero = 0) + (h1 : x.regs one = 1) (hst : ContractState w wb db str (t + s) t W x) : + ExecRandLaw w ram[while targetT < activeK do [ ⟪contractStep⟫ ]] x + (fun y => Modifies (workspaceFootprint wb db str (t + s)) x.mem y.mem ∧ + ∃ W' : Fin t → Fin t → ℕ, IsMultigraph W' ∧ ContractState w wb db str t t W' y) + (36 * ((t + s) ^ 2 - t ^ 2) + 2) s (heldGraph wb str) + ((Lean.Karger.spec.toRandomized.withCoins.run (Lean.Karger.contractTimes s) + ⟨t + s, W⟩).map Prod.snd) := by + induction s generalizing x with | zero => - have hk_eq : t + 0 = t := Nat.add_zero t have hnc : ¬ (Cond.lt targetT activeK).Holds x := by simp [hst.regs_targetT, hst.regs_activeK] - refine ⟨pure (x, 2), ExecRand.loop_exit hnc, .pure _ 0, ?_, ?_⟩ - · intro z hz - cases OracleComp.eq_of_mem_supportWith_pure hz - refine ⟨by simp, Modifies.refl _ _, ?_⟩ - cases hk_eq - exact ⟨W, part, hC, hst⟩ - · intro B _ _ _ - simp only [Nat.add_zero, ProbComp.eval_pure, PMF.toOuterMeasure_pure_apply] - have ht_pos : 0 < t * (t - 1) := Nat.mul_pos (by omega) (by omega) - have hne0 : (((t * (t - 1) : ℕ) : ℝ≥0∞)) ≠ 0 := by exact_mod_cast ht_pos.ne' - have htop : (((t * (t - 1) : ℕ) : ℝ≥0∞)) ≠ ⊤ := ENNReal.natCast_ne_top _ - rw [ENNReal.div_self hne0 htop] - have hmem : (x, 2) ∈ {z : Data 16 × ℕ | - SurvivalPost W₀ wb db str t (pullbackCut part B) z.1} := by - cases hk_eq - exact ⟨W, part, B, hC, hst.workspace, hst.regs_totS, rfl⟩ - simp [hmem] + refine ((ExecRandLaw.loop_exit hnc ⟨Modifies.refl _ _, W, hW, hst⟩).congr_law ?_).mono + (fun _ h => h) (Nat.le_add_left _ _) le_rfl + rw [hst.heldGraph_eq] + exact (PMF.pure_map Prod.snd ((), (⟨t + 0, W⟩ : Lean.Karger.Graph))).symm | succ s ih => - let m_cur := t + s - have hm_def : m_cur = t + s := rfl - have hm_ge : 2 ≤ m_cur := by omega + let κ (G : Lean.Karger.Graph) : PMF Lean.Karger.Graph := + (Lean.Karger.spec.toRandomized.withCoins.run (Lean.Karger.contractTimes s) G).map Prod.snd have hc_loop : (Cond.lt targetT activeK).Holds x := by simp only [Cond.holds_lt, hst.regs_targetT, hst.regs_activeK] omega + -- After one contraction the machine holds a multigraph on `t + s` supervertices, from which + -- the rest of the loop has the law of the rest of the client. + let P (y : Data 16) : Prop := + Modifies (workspaceFootprint wb db str (t + s + 1)) x.mem y.mem ∧ y.regs zero = 0 ∧ + y.regs one = 1 ∧ ∃ W' : Fin (t + s) → Fin (t + s) → ℕ, + IsMultigraph W' ∧ ContractState w wb db str (t + s) t W' y + have hrest : ∀ y, P y → ExecRandLaw w ram[while targetT < activeK do [ ⟪contractStep⟫ ]] y + (fun z => Modifies (workspaceFootprint wb db str (t + (s + 1))) x.mem z.mem ∧ + ∃ W' : Fin t → Fin t → ℕ, IsMultigraph W' ∧ ContractState w wb db str t t W' z) + (36 * ((t + s) ^ 2 - t ^ 2) + 2) s (heldGraph wb str) (κ (heldGraph wb str y)) := by + rintro y ⟨hmod, hy0, hy1, W', hW', hst'⟩ + rw [hst'.heldGraph_eq] + exact (ih hW' hy0 hy1 hst').mono (fun z ⟨hmz, hz⟩ => ⟨modifies_trans_subset hmod hmz + Finset.Subset.rfl (workspaceFootprint_mono (Nat.le_succ _)), hz⟩) le_rfl le_rfl + have hbudget := step_budget_succ (n_post := 45 * (t + s + 1) + 22) ht (Nat.le_add_right t s) + le_rfl le_rfl by_cases hS0 : totalDoubledWeight W = 0 - · -- Zero-weight branch: `totS = 0`, deterministic merge of `(0, Fin.last m_cur)` in `0` calls. + · -- Zero weight: `contractDownTo` drops the last supervertex, which is the specification's + -- contraction of `0` and the last supervertex of a weightless graph. have hcond_z : (Cond.eq totS zero).Holds x := by simp [hst.regs_totS, hS0, h0] - have hm_fit : Fits w m_cur := hst.fits_dEnd.of_le (by omega) - let x_next := x.set activeK m_cur - have hsub1 : (t + (s + 1)) - 1 = m_cur := by omega + have hm_fit : Fits w (t + s) := hst.fits_dEnd.of_le (by omega) + let x_next := x.set activeK (t + s) + have hsub1 : t + (s + 1) - 1 = t + s := by omega have hop : (Op.bin .sub activeK activeK one).eval w x = some x_next := by simp only [Op.eval_bin, BinOp.eval, hst.regs_activeK, h1, hsub1] exact Data.put_of_fits hm_fit - have hstep_det : ExecRand w contractStep x (pure (x_next, 2)) := by - unfold contractStep - simpa only [map_pure] using ExecRand.branch_pos hcond_z (ExecRand.op hop) - let u₀ : Fin (m_cur + 1) := ⟨0, by omega⟩ - let v₀ : Fin (m_cur + 1) := Fin.last m_cur - have huv₀ : u₀ ≠ v₀ := by - intro h - have := congrArg Fin.val h - change 0 = m_cur at this - omega - have hW_zero : ∀ a b : Fin (m_cur + 1), W a b = 0 := fun a b => by + have hW_zero : ∀ a b : Fin (t + s + 1), W a b = 0 := fun a b => by have := entry_le_totalDoubledWeight W a b omega - have hcm_zero : ∀ i j : Fin m_cur, contractMatrix W u₀ v₀ i j = 0 := fun i j => by - unfold contractMatrix mergePair - simp [hW_zero] - have hdeg_cm_zero : ∀ i : Fin m_cur, rowDeg (contractMatrix W u₀ v₀) i = 0 := fun i => by + have hcm_zero : ∀ i j : Fin (t + s), contractMatrix W 0 (Fin.last (t + s)) i j = 0 := + fun i j => by + unfold contractMatrix mergePair + simp [hW_zero] + have hdeg_cm_zero : ∀ i : Fin (t + s), + rowDeg (contractMatrix W 0 (Fin.last (t + s))) i = 0 := fun i => by unfold rowDeg simp [hcm_zero] - have htot_cm_zero : totalDoubledWeight (contractMatrix W u₀ v₀) = 0 := by + have htot_cm_zero : totalDoubledWeight (contractMatrix W 0 (Fin.last (t + s))) = 0 := by unfold totalDoubledWeight simp [hdeg_cm_zero] - have hws_next : HoldsWorkspace x_next.mem wb db str (contractMatrix W u₀ v₀) := by + have hws_next : + HoldsWorkspace x_next.mem wb db str (contractMatrix W 0 (Fin.last (t + s))) := by refine ⟨fun i j => ?_, fun i => ?_⟩ · have hw1 : x.mem (wb + i.val * str + j.val) = W i.castSucc j.castSucc := hst.workspace.1 i.castSucc j.castSucc @@ -2589,8 +2609,9 @@ private theorem contractLoop_spec {n w wb db str t steps : ℕ} {W₀ : Fin n rw [hw2, hdeg_cm_zero] unfold rowDeg simp [hW_zero] - have hmul_le : str * m_cur ≤ str * (t + (s + 1)) := Nat.mul_le_mul_left str (by omega) - have hst_next : ContractState w wb db str m_cur t (contractMatrix W u₀ v₀) x_next := { + have hmul_le : str * (t + s) ≤ str * (t + (s + 1)) := Nat.mul_le_mul_left str (by omega) + have hst_next : + ContractState w wb db str (t + s) t (contractMatrix W 0 (Fin.last (t + s))) x_next := { regs_wBase := by simpa +decide [x_next, Function.update_apply] using hst.regs_wBase regs_dBase := by simpa +decide [x_next, Function.update_apply] using hst.regs_dBase regs_stride := by simpa +decide [x_next, Function.update_apply] using hst.regs_stride @@ -2607,82 +2628,38 @@ private theorem contractLoop_spec {n w wb db str t steps : ℕ} {W₀ : Fin n fits_totS := by rw [htot_cm_zero]; exact fits_zero w workspace := hws_next } - have hC_next : IsContractionOf W₀ (contractPart part u₀ v₀ huv₀) - (contractMatrix W u₀ v₀) := isContractionOf_contract hC huv₀ - obtain ⟨m_tail, hm_tail, hq_tail, hsup_tail, _⟩ := ih hC_next - (by simpa +decide [x_next, Function.update_apply] using h0) - (by simpa +decide [x_next, Function.update_apply] using h1) - hst_next - have hiter := ExecRand.loop_iter hc_loop hstep_det (ml := fun _ => m_tail) fun z hz => by - cases OracleComp.eq_of_mem_supportWith_pure hz - exact hm_tail - refine ⟨_, hiter, ?_, ?_, ?_⟩ - · rw [pure_bind] - exact (hq_tail.bind fun _ => .pure _ 0).mono (by omega) - · intro z hz - obtain ⟨z₁, hz₁, hrest⟩ := OracleComp.mem_supportWith_bind_iff.mp hz - cases OracleComp.eq_of_mem_supportWith_pure hz₁ - obtain ⟨z₂, hz₂, hfinal⟩ := OracleComp.mem_supportWith_bind_iff.mp hrest - cases OracleComp.eq_of_mem_supportWith_pure hfinal - rcases hsup_tail z₂ hz₂ with ⟨htime₂, hmod₂, W', part', hC', hst'⟩ - refine ⟨?_, ?_, W', part', hC', hst'⟩ - · have hbud := step_budget_succ ht (by omega : t ≤ m_cur) (Nat.zero_le _) htime₂ - change 2 + z₂.2 + 2 ≤ 36 * ((m_cur + 1) ^ 2 - t ^ 2) + 2 - omega - · exact modifies_trans_subset (Modifies.refl _ x.mem) hmod₂ - Finset.Subset.rfl (workspaceFootprint_mono (Nat.le_succ m_cur)) - · -- Vacuous when `0 < minCut W₀` since `0 < minCut W₀ ≤ minCut W` forces `0 < totS`. - intro B hmin_pos _ _ - have hminW : 0 < minCut W := - lt_of_lt_of_le hmin_pos - (minCut_le_of_isContractionOf (by rw [Fintype.card_fin]; omega) hC) - have hS_pos := totalDoubledWeight_pos_of_minCut_pos (by rw [Fintype.card_fin]; omega) - hC.multigraph hminW - omega - · -- Positive-weight branch: `0 < totalDoubledWeight W`. - have hS_pos : 0 < totalDoubledWeight W := Nat.pos_of_ne_zero hS0 - let S := totalDoubledWeight W - have hS_def : S = totalDoubledWeight W := rfl + have hb : ExecRandLaw w contractStep x P 2 0 (heldGraph wb str) + (PMF.pure (heldGraph wb str x_next)) := by + unfold contractStep + exact ExecRandLaw.branch_pos hcond_z (ExecRandLaw.of_execWithin (ExecWithin.op hop) + ⟨Modifies.refl _ _, by simpa +decide [x_next, Function.update_apply] using h0, + by simpa +decide [x_next, Function.update_apply] using h1, _, + isMultigraph_contractMatrix hW _ _, hst_next⟩) + refine ((ExecRandLaw.loop_iter hc_loop hb hrest).congr_law ?_).mono (fun _ h => h) + (le_trans (by omega) hbudget) (by omega) + rw [PMF.pure_bind, hst_next.heldGraph_eq] + exact (congrArg (PMF.map Prod.snd) (Lean.Karger.run_contractStep_bind_of_eq_zero (m := t + s) + (Lean.Karger.contractTimes s) W hS0)).symm + · -- Positive weight: one `rand` call draws the offset uniformly below the total weight, and + -- `postRandStep` contracts the pair sampled there. have hcond_nz : ¬ (Cond.eq totS zero).Holds x := by simp [hst.regs_totS, h0, hS0] - have hSm1_fit : Fits w (S - 1) := hst.fits_totS.of_le (by omega) - let x_sub := x.set val1 (S - 1) + have hSm1_fit : Fits w (totalDoubledWeight W - 1) := hst.fits_totS.of_le (by omega) + let x_sub := x.set val1 (totalDoubledWeight W - 1) have hop_sub : (Op.bin .sub val1 totS one).eval w x = some x_sub := by simp only [Op.eval_bin, BinOp.eval, hst.regs_totS, h1] exact Data.put_of_fits hSm1_fit - have hfit_rand : Fits w (x_sub.regs val1) := by simpa [x_sub] using hSm1_fit - have hper_sample : ∀ k : Fin (x_sub.regs val1 + 1), - ∃ (u v : Fin (m_cur + 1)) (huv : u ≠ v) (y_post : Data 16) (n_post : ℕ) - (m_rec : ProbComp (Data 16 × ℕ)), - IsSampledPair W k.val u v ∧ - n_post ≤ 45 * (m_cur + 1) + 22 ∧ - Exec w postRandStep (x_sub.set rem k.val) y_post n_post ∧ - Modifies (workspaceFootprint wb db str (m_cur + 1)) x.mem y_post.mem ∧ - ContractState w wb db str m_cur t (contractMatrix W u v) y_post ∧ - ExecRand w ram[while targetT < activeK do [ ⟪contractStep⟫ ]] y_post m_rec ∧ - m_rec.IsQueryBounded s ∧ - (∀ z ∈ m_rec.support, - z.2 ≤ 36 * (m_cur ^ 2 - t ^ 2) + 2 ∧ - Modifies (workspaceFootprint wb db str m_cur) y_post.mem z.1.mem ∧ - ∃ (W' : Fin t → Fin t → ℕ) (part' : Fin n → Fin t), - IsContractionOf W₀ part' W' ∧ - ContractState w wb db str t t W' z.1) ∧ - (∀ B' : Finset (Fin m_cur), - 0 < minCut W₀ → IsNonTrivialCut B' → - cutWeight W₀ (pullbackCut (contractPart part u v huv) B') = minCut W₀ → - (((t * (t - 1) : ℕ) : ℝ≥0∞) / ((m_cur * (m_cur - 1) : ℕ) : ℝ≥0∞)) ≤ - m_rec.eval.toOuterMeasure - {z | SurvivalPost W₀ wb db str t - (pullbackCut (contractPart part u v huv) B') z.1}) := by + have hN : x_sub.regs val1 = totalDoubledWeight W - 1 := by simp [x_sub] + have hpost : ∀ k : Fin (x_sub.regs val1 + 1), ∃ y, + ExecWithin w postRandStep (x_sub.set rem k.val) y (45 * (t + s + 1) + 22) ∧ P y ∧ + heldGraph wb str y = Lean.Karger.contractGraph ⟨t + s + 1, W⟩ + (Lean.Karger.sampledPair W k).1 (Lean.Karger.sampledPair W k).2 := by intro k - have hk_lt : k.val < S := by - have hk_bound := k.isLt - simp only [x_sub, Data.set_regs, Function.update_self] at hk_bound - omega - obtain ⟨u, v, hsamp⟩ := exists_isSampledPair W hk_lt - have huv : u ≠ v := isSampledPair_ne hC.multigraph hsamp - obtain ⟨y_post, ⟨n_post, hn_post, he_post⟩, hmod_post, hst_post, hy0, hy1⟩ := - postRandStep_exec (x := x_sub.set rem k.val) (t := t) hm_ge hC.multigraph hsamp + obtain ⟨u, v, hsamp⟩ := exists_isSampledPair W (show k.val < totalDoubledWeight W by + have := k.isLt + omega) + obtain ⟨y, hy, hmod, hst', hy0, hy1⟩ := + postRandStep_exec (x := x_sub.set rem k.val) (m := t + s) (t := t) (by omega) hW hsamp (by simpa +decide [x_sub, Function.update_apply] using h0) (by simpa +decide [x_sub, Function.update_apply] using h1) (by simpa +decide [x_sub, Function.update_apply] using hst.regs_wBase) @@ -2697,205 +2674,60 @@ private theorem contractLoop_spec {n w wb db str t steps : ℕ} {W₀ : Fin n (by simp +decide) hst.le_stride hst.disjoint_blocks hst.fits_wEnd hst.fits_dEnd hst.fits_totS hst.workspace - obtain ⟨m_rec, hm_rec, hq_rec, hsup_rec, hsurv_rec⟩ := - ih (isContractionOf_contract hC huv) hy0 hy1 hst_post - exact ⟨u, v, huv, y_post, n_post, m_rec, hsamp, hn_post, he_post, hmod_post, hst_post, - hm_rec, hq_rec, hsup_rec, hsurv_rec⟩ - -- Assemble `ExecRand` for `contractStep` via `codeComp`. - let m_post (d : Data 16) := codeComp w postRandStep d - have hrand_post : ExecRand w ram[rem ← rand val1; ⟪postRandStep⟫] x_sub - (do - let z₁ ← (do - let k ← ProbComp.unifFin (x_sub.regs val1) - pure (x_sub.set rem k.val, 1)) - let z₂ ← m_post z₁.1 - pure (z₂.1, z₁.2 + z₂.2)) := by - refine ExecRand.seq (ExecRand.rand hfit_rand) fun z₁ hz₁ => ?_ - obtain ⟨k, -, hk_eq'⟩ := OracleComp.mem_supportWith_bind_iff.mp hz₁ - cases OracleComp.eq_of_mem_supportWith_pure hk_eq' - obtain ⟨_, _, _, y_post, n_post, _, _, _, he_post, _, _, _, _, _, _⟩ := hper_sample k - dsimp only [m_post] - rw [he_post.execRand.codeComp_eq] - exact he_post.execRand - have hsub_rand_post := (Exec.op hop_sub).seqRand hrand_post - have hstep_rand : ExecRand w contractStep x - ((fun z => (z.1, z.2 + 2)) <$> ((fun z => (z.1, 1 + z.2)) <$> (do - let z₁ ← (do - let k ← ProbComp.unifFin (x_sub.regs val1) - pure (x_sub.set rem k.val, 1)) - let z₂ ← m_post z₁.1 - pure (z₂.1, z₁.2 + z₂.2)))) := - ExecRand.branch_neg hcond_nz hsub_rand_post - let m_loop_rec (d : Data 16) := - codeComp w ram[while targetT < activeK do [ ⟪contractStep⟫ ]] d - let mb := (fun z : Data 16 × ℕ => (z.1, z.2 + 2)) <$> ((fun z => (z.1, 1 + z.2)) <$> (do - let z₁ ← (do - let k ← ProbComp.unifFin (x_sub.regs val1) - pure (x_sub.set rem k.val, 1)) - let z₂ ← m_post z₁.1 - pure (z₂.1, z₁.2 + z₂.2))) - have hmb_support : ∀ z ∈ mb.support, ∃ k : Fin (x_sub.regs val1 + 1), - ∃ (u v : Fin (m_cur + 1)) (huv : u ≠ v) (y_post : Data 16) (n_post : ℕ) - (m_rec : ProbComp (Data 16 × ℕ)), - z = (y_post, (1 + (1 + n_post)) + 2) ∧ - IsSampledPair W k.val u v ∧ - n_post ≤ 45 * (m_cur + 1) + 22 ∧ - Modifies (workspaceFootprint wb db str (m_cur + 1)) x.mem y_post.mem ∧ - m_loop_rec y_post = m_rec ∧ - ExecRand w ram[while targetT < activeK do [ ⟪contractStep⟫ ]] y_post m_rec ∧ - m_rec.IsQueryBounded s ∧ - (∀ z' ∈ m_rec.support, - z'.2 ≤ 36 * (m_cur ^ 2 - t ^ 2) + 2 ∧ - Modifies (workspaceFootprint wb db str m_cur) y_post.mem z'.1.mem ∧ - ∃ (W' : Fin t → Fin t → ℕ) (part' : Fin n → Fin t), - IsContractionOf W₀ part' W' ∧ - ContractState w wb db str t t W' z'.1) := by - intro z hz - obtain ⟨za, hza, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hz - obtain ⟨zb, hzb, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hza - obtain ⟨z₁, hz₁, hrest⟩ := OracleComp.mem_supportWith_bind_iff.mp hzb - obtain ⟨k, -, hk_pure⟩ := OracleComp.mem_supportWith_bind_iff.mp hz₁ - cases OracleComp.eq_of_mem_supportWith_pure hk_pure - obtain ⟨u, v, huv, y_post, n_post, m_rec, hsamp, hn_post, he_post, hmod_post, _, - hm_rec, hq_rec, hsup_rec, _⟩ := hper_sample k - obtain ⟨z₂, hz₂, hzb_pure⟩ := OracleComp.mem_supportWith_bind_iff.mp hrest - cases OracleComp.eq_of_mem_supportWith_pure hzb_pure - dsimp only [m_post] at hz₂ - rw [he_post.execRand.codeComp_eq] at hz₂ - cases OracleComp.eq_of_mem_supportWith_pure hz₂ - have hml_eq : m_loop_rec y_post = m_rec := hm_rec.codeComp_eq - exact ⟨k, u, v, huv, y_post, n_post, m_rec, rfl, hsamp, hn_post, hmod_post, - hml_eq, hm_rec, hq_rec, hsup_rec⟩ - have hiter : ExecRand w ram[while targetT < activeK do [ ⟪contractStep⟫ ]] x - (do - let z₁ ← mb - let z₂ ← m_loop_rec z₁.1 - pure (z₂.1, z₁.2 + z₂.2 + 2)) := by - refine ExecRand.loop_iter hc_loop hstep_rand fun z₁ hz₁ => ?_ - obtain ⟨_, _, _, _, _, _, m_rec, rfl, _, _, _, hml_eq, hm_rec, _, _⟩ := hmb_support z₁ hz₁ - rw [hml_eq] - exact hm_rec - have hmb_qb : mb.IsQueryBounded 1 := by - dsimp only [mb] - simp only [OracleComp.IsQueryBounded, OracleComp.isCostBounded_map_iff] - have hrand_qb : (do - let k ← ProbComp.unifFin (x_sub.regs val1) - pure (x_sub.set rem k.val, 1)).IsQueryBounded 1 := by - simpa only [Nat.add_zero] using - (ProbComp.isQueryBounded_unifFin (x_sub.regs val1)).bind fun _ => .pure _ 0 - have hpost_qb : ∀ z₁ ∈ (do - let k ← ProbComp.unifFin (x_sub.regs val1) - pure (x_sub.set rem k.val, 1)).support, - (m_post z₁.1 >>= fun z₂ => pure (z₂.1, z₁.2 + z₂.2)).IsQueryBounded 0 := by - intro z₁ hz₁ - obtain ⟨k, -, hk_p⟩ := OracleComp.mem_supportWith_bind_iff.mp hz₁ - cases OracleComp.eq_of_mem_supportWith_pure hk_p - obtain ⟨_, _, _, _, _, _, _, _, he_post, _, _, _, _, _, _⟩ := hper_sample k - dsimp only [m_post] - rw [he_post.execRand.codeComp_eq, pure_bind] - exact .pure _ 0 - simpa only [Nat.add_zero] using - OracleComp.IsCostBounded.bind_on_support hrand_qb hpost_qb - refine ⟨_, hiter, ?_, ?_, ?_⟩ - · have htot_qb : (1 : ℕ) + s = s + 1 := Nat.add_comm 1 s - rw [← htot_qb] - refine OracleComp.IsCostBounded.bind_on_support hmb_qb fun z₁ hz₁ => ?_ - obtain ⟨_, _, _, _, _, _, m_rec, rfl, _, _, _, hml_eq, _, hq_rec, _⟩ := hmb_support z₁ hz₁ - rw [hml_eq] - simpa only [Nat.add_zero] using hq_rec.bind fun _ => .pure _ 0 - · intro z hz - obtain ⟨z₁, hz₁, hrest⟩ := OracleComp.mem_supportWith_bind_iff.mp hz - obtain ⟨k, u, v, huv, y_post, n_post, m_rec, rfl, _, hn_post, hmod_post, - hml_eq, _, _, hsup_rec⟩ := hmb_support z₁ hz₁ - rw [hml_eq] at hrest - obtain ⟨z₂, hz₂, hfinal⟩ := OracleComp.mem_supportWith_bind_iff.mp hrest - cases OracleComp.eq_of_mem_supportWith_pure hfinal - rcases hsup_rec z₂ hz₂ with ⟨htime₂, hmod₂, W', part', hC', hst'⟩ - refine ⟨?_, ?_, W', part', hC', hst'⟩ - · exact step_budget_succ ht (by omega : t ≤ m_cur) hn_post htime₂ - · exact modifies_trans_subset hmod_post hmod₂ Finset.Subset.rfl - (workspaceFootprint_mono (Nat.le_succ m_cur)) - · -- Telescoping survival probability bound. - intro B hmin_pos hB_nt hB_min - let C_star := pullbackCut part B - let E : Set (Data 16 × ℕ) := {z | SurvivalPost W₀ wb db str t C_star z.1} - have hN_eq : x_sub.regs val1 + 1 = S := by - simp only [x_sub, Data.set_regs, Function.update_self] - omega - have hm_simp : (do - let z₁ ← mb - let z₂ ← m_loop_rec z₁.1 - pure (z₂.1, z₁.2 + z₂.2 + 2)) = (do - let k ← ProbComp.unifFin (x_sub.regs val1) - let zp ← m_post (x_sub.set rem k.val) - let z₂ ← m_loop_rec zp.1 - pure (z₂.1, ((1 + (1 + zp.2)) + 2) + z₂.2 + 2)) := by - dsimp only [mb] - simp only [← bind_pure_comp, bind_assoc, pure_bind] - rw [hm_simp, ProbComp.eval_bind] - let castFin : Fin (x_sub.regs val1 + 1) ≃ Fin (totalDoubledWeight W) := finCongr hN_eq - let survSet : Set (Fin (x_sub.regs val1 + 1)) := - {k | SampleSurvives W B (castFin k)} - have hdeg_bound : (m_cur + 1) * cutWeight W B ≤ totalDoubledWeight W := by - have hcw_eq : cutWeight W B = minCut W₀ := by - rw [← cutWeight_pullbackCut hC B, hB_min] - rw [hcw_eq] - have hmul := mul_minCut_le_totalDoubledWeight (by rw [Fintype.card_fin]; omega) - hC.multigraph - rw [Fintype.card_fin] at hmul - exact (Nat.mul_le_mul_left (m_cur + 1) - (minCut_le_of_isContractionOf (by rw [Fintype.card_fin]; omega) hC)).trans hmul - have hstep_prob : (((m_cur - 1 : ℕ) : ℝ≥0∞) / (m_cur + 1 : ℕ)) ≤ - (ProbComp.unifFin (x_sub.regs val1)).eval.toOuterMeasure survSet := by - rw [ProbComp.eval_unifFin] - let _ : Nonempty (Fin (x_sub.regs val1 + 1)) := ⟨⟨0, by omega⟩⟩ - let _ : Nonempty (Fin (totalDoubledWeight W)) := ⟨⟨0, hS_pos⟩⟩ - have hmap_u : Cslib.Probability.PMF.uniformOfFintype (Fin (totalDoubledWeight W)) = - (Cslib.Probability.PMF.uniformOfFintype - (Fin (x_sub.regs val1 + 1))).map castFin := - (Cslib.Probability.PMF.uniformOfFintype_map_equiv castFin).symm - have h1_step := step_survival_prob_ge (by omega : 2 ≤ m_cur + 1) hC.multigraph - hS_pos hdeg_bound - have hsub_m : m_cur + 1 - 2 = m_cur - 1 := by omega - rw [hsub_m, hmap_u, PMF.toOuterMeasure_map_apply] at h1_step - exact h1_step - have hsub_ms : t + (s + 1) - 1 = m_cur := by omega - have hm_add : t + (s + 1) = m_cur + 1 := rfl - have htele : (((m_cur - 1 : ℕ) : ℝ≥0∞) / (m_cur + 1 : ℕ)) * - (((t * (t - 1) : ℕ) : ℝ≥0∞) / ((m_cur * (m_cur - 1) : ℕ) : ℝ≥0∞)) = - (((t * (t - 1) : ℕ) : ℝ≥0∞) / (((t + (s + 1)) * (t + (s + 1) - 1) : ℕ) : ℝ≥0∞)) := by - rw [hsub_ms, hm_add] - exact telescope_survival_step ht (by omega : t ≤ m_cur) - rw [← htele] - refine toOuterMeasure_bind_ge_mul_ennreal _ _ survSet E hstep_prob ?_ - intro k _ hk_surv - obtain ⟨u, v, huv, y_post, n_post, m_rec, hsamp, _, he_post, _, _, - hm_rec, _, _, hsurv_rec⟩ := hper_sample k - have hmp_eq : m_post (x_sub.set rem k.val) = pure (y_post, n_post) := - he_post.execRand.codeComp_eq - have hml_eq : m_loop_rec y_post = m_rec := hm_rec.codeComp_eq - have hcont_eq : (do - let zp ← m_post (x_sub.set rem k.val) - let z₂ ← m_loop_rec zp.1 - pure (z₂.1, ((1 + (1 + zp.2)) + 2) + z₂.2 + 2)) = - ((fun z₂ => (z₂.1, ((1 + (1 + n_post)) + 2) + z₂.2 + 2)) <$> m_rec) := by - rw [hmp_eq, pure_bind, hml_eq, ← bind_pure_comp] - rw [hcont_eq, eval_map_snd_toOuterMeasure] - rcases hk_surv with ⟨u', v', hsamp', hsame'⟩ - have hcast_val : (castFin k).val = k.val := rfl - rw [hcast_val] at hsamp' - rcases isSampledPair_unique W hsamp hsamp' with ⟨rfl, rfl⟩ - let B' := contractCut v B - have hpb_eq : pullbackCut (contractPart part u v huv) B' = C_star := - pullbackCut_contractCut part huv hsame' - have hC_star_nt : IsNonTrivialCut C_star := - isNonTrivialCut_pullbackCut hC.surj hB_nt - have hB'_nt : IsNonTrivialCut B' := - isNonTrivialCut_of_pullbackCut (contractPart part u v huv) (hpb_eq ▸ hC_star_nt) - have hB'_min : cutWeight W₀ (pullbackCut (contractPart part u v huv) B') = minCut W₀ := by - rw [hpb_eq] - exact hB_min - simpa only [hpb_eq] using hsurv_rec B' hmin_pos hB'_nt hB'_min + refine ⟨y, hy, ⟨hmod, hy0, hy1, _, isMultigraph_contractMatrix hW u v, hst'⟩, ?_⟩ + rw [hst'.heldGraph_eq, Lean.Karger.sampledPair_eq hsamp, Lean.Karger.contractGraph_fin] + choose y hy using hpost + have hb : ExecRandLaw w contractStep x P (1 + (1 + (45 * (t + s + 1) + 22)) + 2) 1 + (heldGraph wb str) ((Probability.PMF.uniformOfFintype (Fin (x_sub.regs val1 + 1))).map + fun k => heldGraph wb str (y k)) := by + unfold contractStep + exact ExecRandLaw.branch_neg hcond_nz (ExecRandLaw.seq_det (ExecWithin.op hop_sub) + (ExecRandLaw.rand_seq (by rw [hN]; exact hSm1_fit) (fun k => (hy k).1) + fun k => (hy k).2.1)) + refine ((ExecRandLaw.loop_iter hc_loop hb hrest).congr_law ?_).mono (fun _ h => h) + hbudget (by omega) + have hlaw : ∀ k, κ (heldGraph wb str (y k)) = κ (Lean.Karger.contractGraph ⟨t + s + 1, W⟩ + (Lean.Karger.sampledPair W k).1 (Lean.Karger.sampledPair W k).2) := + fun k => by rw [(hy k).2.2] + rw [PMF.bind_map, Function.comp_def, funext hlaw, hN] + exact (PMF.map_bind _ _ _).symm.trans (congrArg (PMF.map Prod.snd) + (Lean.Karger.run_contractStep_bind (m := t + s) (Lean.Karger.contractTimes s) W hS0).symm) + +/-- **`contractDownTo` refines the contraction structure.** From a state holding a multigraph `W` +on `k ≥ t ≥ 2` supervertices, `contractDownTo` runs within `36 (k² - t²) + 4` instructions and +`k - t` `rand` calls, writes only the workspace and ends holding a multigraph on `t` supervertices. +The graph it holds (`heldGraph`) has the law of `k - t` contractions of `⟨k, W⟩` by the client +`Lean.Karger.contractTimes` of `Lean.Karger.spec`. -/ +theorem contractDownTo_law {w wb db str k t : ℕ} {W : Fin k → Fin k → ℕ} {x : Data 16} + (ht : 2 ≤ t) (htk : t ≤ k) (hW : IsMultigraph W) (hst : ContractState w wb db str k t W x) : + ExecRandLaw w contractDownTo x + (fun y => Modifies (workspaceFootprint wb db str k) x.mem y.mem ∧ + ∃ W' : Fin t → Fin t → ℕ, IsMultigraph W' ∧ ContractState w wb db str t t W' y) + (36 * (k ^ 2 - t ^ 2) + 4) (k - t) (heldGraph wb str) + ((Lean.Karger.spec.toRandomized.withCoins.run (Lean.Karger.contractTimes (k - t)) + ⟨k, W⟩).map Prod.snd) := by + obtain ⟨s, rfl⟩ : ∃ s, k = t + s := ⟨k - t, by omega⟩ + rw [Nat.add_sub_cancel_left] + have h1_fit : Fits w 1 := hst.fits_dEnd.of_le (by omega) + let x₁ := (x.set zero 0).set one 1 + have hst₁ : ContractState w wb db str (t + s) t W x₁ := { + regs_wBase := by simpa +decide [x₁, Function.update_apply] using hst.regs_wBase + regs_dBase := by simpa +decide [x₁, Function.update_apply] using hst.regs_dBase + regs_stride := by simpa +decide [x₁, Function.update_apply] using hst.regs_stride + regs_activeK := by simpa +decide [x₁, Function.update_apply] using hst.regs_activeK + regs_targetT := by simpa +decide [x₁, Function.update_apply] using hst.regs_targetT + regs_totS := by simpa +decide [x₁, Function.update_apply] using hst.regs_totS + le_stride := hst.le_stride + disjoint_blocks := hst.disjoint_blocks + fits_wEnd := hst.fits_wEnd + fits_dEnd := hst.fits_dEnd + fits_totS := hst.fits_totS + workspace := hst.workspace + } + have hloop := contractLoop_law ht hW (by simp +decide [x₁]) (by simp +decide [x₁]) hst₁ + unfold contractDownTo + exact (ExecRandLaw.seq_det (ExecWithin.const (fits_zero w)) + (ExecRandLaw.seq_det (ExecWithin.const h1_fit) hloop)).mono (fun _ h => h) (by omega) le_rfl /-- **Master specification for `contractDownTo` (`Code .standard 16`).** Starting from any `ContractState w wb db str k t W x` (`2 ≤ t ≤ k`) where `W` is a contraction of @@ -2906,7 +2738,12 @@ Starting from any `ContractState w wb db str k t W x` (`2 ≤ t ≤ k`) where `W `workspaceFootprint wb db str k` and leaving a valid `t`-supervertex `ContractState` that is a contraction of `W₀`, and 4. preserves any fixed minimum cut `pullbackCut part B` of a connected multigraph (`0 < minCut W₀`) - with probability at least `(t * (t - 1)) / (k * (k - 1))`. -/ + with probability at least `(t * (t - 1)) / (k * (k - 1))`. + +The first three parts and the law of the held graph are `contractDownTo_law`. The contraction in +part 3 and the bound in part 4 are the specification's +(`Lean.Karger.isContractionOf_of_mem_support_contractTimes`, `Lean.Karger.survives_contractTimes`), +carried through that law. -/ theorem contractDownTo_spec {n w wb db str k t : ℕ} {W₀ : Fin n → Fin n → ℕ} {W : Fin k → Fin k → ℕ} {part : Fin n → Fin k} {x : Data 16} (ht : 2 ≤ t) (htk : t ≤ k) (hC : IsContractionOf W₀ part W) @@ -2925,55 +2762,32 @@ theorem contractDownTo_spec {n w wb db str k t : ℕ} {W₀ : Fin n → Fin n cutWeight W₀ (pullbackCut part B) = minCut W₀ → (((t * (t - 1) : ℕ) : ℝ≥0∞) / ((k * (k - 1) : ℕ) : ℝ≥0∞)) ≤ m.eval.toOuterMeasure {z | SurvivalPost W₀ wb db str t (pullbackCut part B) z.1}) := by - have hk_split : t + (k - t) = k := Nat.add_sub_of_le htk - revert W part hst - rw [← hk_split] - intro W part hC hst - have h1_fit : Fits w 1 := hst.fits_dEnd.of_le (by omega) - let x₁ := (x.set zero 0).set one 1 - have e0 : Exec w (Code.op (.const zero 0)) x (x.set zero 0) 1 := - Exec.const (B := .standard) (d := zero) (x := x) (fits_zero w) - have e1 : Exec w (Code.op (.const one 1)) (x.set zero 0) x₁ 1 := - Exec.const (B := .standard) (d := one) (x := x.set zero 0) h1_fit - have hst₁ : ContractState w wb db str (t + (k - t)) t W x₁ := { - regs_wBase := by simpa +decide [x₁, Function.update_apply] using hst.regs_wBase - regs_dBase := by simpa +decide [x₁, Function.update_apply] using hst.regs_dBase - regs_stride := by simpa +decide [x₁, Function.update_apply] using hst.regs_stride - regs_activeK := by simpa +decide [x₁, Function.update_apply] using hst.regs_activeK - regs_targetT := by simpa +decide [x₁, Function.update_apply] using hst.regs_targetT - regs_totS := by simpa +decide [x₁, Function.update_apply] using hst.regs_totS - le_stride := hst.le_stride - disjoint_blocks := hst.disjoint_blocks - fits_wEnd := hst.fits_wEnd - fits_dEnd := hst.fits_dEnd - fits_totS := hst.fits_totS - workspace := hst.workspace - } - obtain ⟨m_loop, hm_loop, hq_loop, hsup_loop, hsurv_loop⟩ := - contractLoop_spec ht hC (by simp +decide [x₁]) - (by simp +decide [x₁]) hst₁ - have hfull : ExecRand w contractDownTo x ((fun z => (z.1, 2 + z.2)) <$> m_loop) := by - unfold contractDownTo - have he12 := e1.seqRand hm_loop - have he012 := e0.seqRand he12 - have hmap_assoc : ((fun z : Data 16 × ℕ => (z.1, 1 + z.2)) <$> - ((fun z : Data 16 × ℕ => (z.1, 1 + z.2)) <$> m_loop)) = - ((fun z : Data 16 × ℕ => (z.1, 2 + z.2)) <$> m_loop) := by - rw [Functor.map_map] - refine congrArg (· <$> m_loop) (funext fun z => Prod.ext rfl (by omega)) - rwa [hmap_assoc] at he012 - have hsub_cancel : t + (k - t) - t = k - t := by omega - refine ⟨(fun z => (z.1, 2 + z.2)) <$> m_loop, hfull, ?_, ?_, ?_⟩ - · rw [hsub_cancel] - simp only [OracleComp.IsQueryBounded, OracleComp.isCostBounded_map_iff] - exact hq_loop - · intro z hz - obtain ⟨z₀, hz₀, rfl⟩ := OracleComp.mem_supportWith_map_iff.mp hz - rcases hsup_loop z₀ hz₀ with ⟨ht0, hmod0, W', part', hC', hst'⟩ - exact ⟨by omega, hmod0, W', part', hC', hst'⟩ - · intro B hmin_pos hB_nt hB_min - rw [eval_map_snd_toOuterMeasure] - exact hsurv_loop B hmin_pos hB_nt hB_min + obtain ⟨m, hm, hq, hsup, hlaw⟩ := contractDownTo_law ht htk hC.multigraph hst + obtain ⟨s, rfl⟩ : ∃ s, k = t + s := ⟨k - t, by omega⟩ + rw [Nat.add_sub_cancel_left, ProbComp.eval_map] at hlaw + refine ⟨m, hm, hq, fun z hz => ?_, fun B hmin hB hBmin => ?_⟩ + · obtain ⟨⟨hmod, W', -, hst'⟩, hT⟩ := hsup z hz + have hz' : heldGraph wb str z.1 ∈ ((Lean.Karger.spec.toRandomized.withCoins.run + (Lean.Karger.contractTimes s) ⟨t + s, W⟩).map Prod.snd).support := by + rw [← hlaw, PMF.mem_support_map_iff] + exact ⟨z, by rwa [ProbComp.support_eval], rfl⟩ + obtain ⟨y, hy, hyz⟩ := (PMF.mem_support_map_iff _ _ _).mp hz' + obtain ⟨W'', part', hy', hC'⟩ := + Lean.Karger.isContractionOf_of_mem_support_contractTimes (by omega) s hC hy + obtain rfl := hst'.eq_of_heldGraph_eq (hyz.symm.trans hy') + exact ⟨hT, hmod, W', part', hC', hst'⟩ + · calc _ ≤ _ := Lean.Karger.survives_contractTimes ht hmin s hC hB hBmin + _ = (m.eval.map fun z => heldGraph wb str z.1).toOuterMeasure + {G | Lean.Karger.Survives W₀ (pullbackCut part B) t G} := by + rw [hlaw, PMF.toOuterMeasure_map_apply] + rfl + _ ≤ _ := by + rw [PMF.toOuterMeasure_map_apply] + refine PMF.toOuterMeasure_mono _ fun z ⟨⟨W'', part', B', hG, hC', hpb⟩, hz⟩ => ?_ + rw [ProbComp.support_eval] at hz + obtain ⟨⟨-, W', -, hst'⟩, -⟩ := hsup z hz + obtain rfl := hst'.eq_of_heldGraph_eq hG + exact ⟨W', part', B', hC', hst'.workspace, hst'.regs_totS, hpb⟩ /-- At `t = 2`, any state satisfying `SurvivalPost W₀ wb db str 2 C_star y` where `C_star` is a non-trivial cut attaining `minCut W₀` stores `minCut W₀` in `y.mem (wb + 1)`. -/ @@ -2982,20 +2796,10 @@ theorem survivalPost_two_mem_eq {n : ℕ} {W₀ : Fin n → Fin n → ℕ} {wb d (hnt : IsNonTrivialCut C_star) (hmin : cutWeight W₀ C_star = minCut W₀) (hsurv : SurvivalPost W₀ wb db str 2 C_star y) : y.mem (wb + 1) = minCut W₀ := by - rcases hsurv with ⟨W', part', B', hC', hws', _, hpb'⟩ - have hB'_nt : IsNonTrivialCut B' := - isNonTrivialCut_of_pullbackCut part' (hpb' ▸ hnt) - rw [isNonTrivialCut_iff_card, Fintype.card_fin] at hB'_nt - have hcard1 : B'.card = 1 := by omega - rcases Finset.card_eq_one.mp hcard1 with ⟨b, rfl⟩ - have hcell : y.mem (wb + 1) = W' 0 1 := by - simpa using hws'.1 0 1 - rw [hcell, ← hmin, ← hpb', cutWeight_pullbackCut hC'] - have hb : b = 0 ∨ b = 1 := by omega - rcases hb with rfl | rfl - · exact (cutWeight_two_singleton_zero hC'.multigraph).symm - · have hcompl : ({(1 : Fin 2)} : Finset (Fin 2)) = Finset.univ \ {0} := by decide - rw [hcompl, cutWeight_compl hC'.multigraph, cutWeight_two_singleton_zero hC'.multigraph] + obtain ⟨W', part', B', hC', hws', -, hpb'⟩ := hsurv + have hB' : IsNonTrivialCut B' := isNonTrivialCut_of_pullbackCut part' (hpb' ▸ hnt) + rw [show y.mem (wb + 1) = W' 0 1 by simpa using hws'.1 0 1, + ← cutWeight_fin_two hC'.multigraph hB', ← cutWeight_pullbackCut hC', hpb', hmin] /-! ### Register-embedding (`Code.rename`) wrappers for callers with `r ≥ 16` -/ diff --git a/Complexity/Computability/WordRAM/Randomized/Law.lean b/Complexity/Computability/WordRAM/Randomized/Law.lean index 73141137b0..da5b674dff 100644 --- a/Complexity/Computability/WordRAM/Randomized/Law.lean +++ b/Complexity/Computability/WordRAM/Randomized/Law.lean @@ -56,7 +56,7 @@ variable {B : Basis} {r : ℕ} {α β : Type} /-- `ExecRandLaw w c x P T R f μ`: at word size `w`, running `c` from `x` terminates cleanly on every path, makes at most `R` `rand` calls on every path, every supported outcome `(y, n)` satisfies `P y` and `n ≤ T`, and the observation `f y` of the final data has law `μ`. -/ -def ExecRandLaw (w : ℕ) (c : Code B r) (x : Data r) (P : Data r → Prop) (T R : ℕ) +@[expose] def ExecRandLaw (w : ℕ) (c : Code B r) (x : Data r) (P : Data r → Prop) (T R : ℕ) (f : Data r → α) (μ : PMF α) : Prop := ∃ m, ExecRand w c x m ∧ m.IsQueryBounded R ∧ (∀ z ∈ m.support, P z.1 ∧ z.2 ≤ T) ∧ ((fun z => f z.1) <$> m).eval = μ From 60af788beaf218d26f52c4b5111a1c1dc3d1ee1b Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Mon, 2 Nov 2026 04:14:17 +0000 Subject: [PATCH 2/6] ci(integration): report canonical aggregate-only merges (#2276) Add a report-only verifier with independent temporary Git storage, exact reviewed-feature forward/inverse recovery, and ordinary tracked-attribute tree equality. No queue or source mutation by the verifier. Validation: 16 focused real-Git fixtures; check_hygiene.py --check-simp; git diff --cached --check. Historical 2244 reconstruction returned exact d218e3e1 tree in 3.29s. Full validation and independent review remain before PR integration. No Lean or selected-abstract impact. AI assistance: OpenAI Codex. Refs #2274. --- scripts/aggregate_merge.md | 63 +++++++ scripts/aggregate_merge.py | 261 ++++++++++++++++++++++++++++ scripts/test_aggregate_merge.py | 289 ++++++++++++++++++++++++++++++++ 3 files changed, 613 insertions(+) create mode 100644 scripts/aggregate_merge.md create mode 100644 scripts/aggregate_merge.py create mode 100644 scripts/test_aggregate_merge.py diff --git a/scripts/aggregate_merge.md b/scripts/aggregate_merge.md new file mode 100644 index 0000000000..e800bde15f --- /dev/null +++ b/scripts/aggregate_merge.md @@ -0,0 +1,63 @@ +# Report an aggregate-only merge conflict + +`aggregate_merge.py` checks the narrow generated `Complexity.lean` case from +[#2274](https://github.com/cslib-community/complexitylib/issues/2274). Run it against immutable, +locally available commits: + +```sh +python3 -B scripts/aggregate_merge.py --repo /path/to/checkout \ + --prefix FULL_ACCEPTED_PREFIX_SHA --source FULL_SOURCE_HEAD_SHA \ + --reviewed-base FULL_ORIGINAL_PARENT_SHA --reviewed-head FULL_REVIEWED_HEAD_SHA \ + > aggregate-report.json +``` + +It prints JSON and exits zero only for `status: verified`. `rejected` means an input or merge +falls outside the supported case; `limitation` means canonical reconstruction passed but the +ordinary tracked-attribute Git merge did not produce that exact tree. Neither status authorizes +integration. The report includes immutable inputs, trees, the complete candidate entry map, +reviewed payload entries, feature/aggregate digests and exact inverse recovery of the prefix. + +The verifier requires the complete neutral conflict set to be exactly `Complexity.lean`. +Each input aggregate must have the exact module-style preamble and complete sorted public +imports generated by `scripts/MkAll.lean`. Module names follow the conservative path syntax in +`quick_check.py`; dynamic Lake configuration, moved library roots, symlink modules and other +aggregate styles are rejected. This is an exact generated-format check, not a general Lean +parser that might overlook declarations or options after the imports. + +Canonical imports come from the merged library inventory, so additions and deletions are both +accounted for. Every other entry and mode must equal the neutral merge. The complete original +nonaggregate feature, including docs, tests and removals, must replay onto the accepted prefix; +reviewed payload modes/blobs must remain exact. Reversing that feature and restoring the prefix +aggregate must recover the exact prefix tree. Additional unreviewed source payloads are rejected. + +Finally, Git's ordinary merge with the prefix's tracked attributes must yield the identical +canonical tree. For example, an adjacent insertion may produce sorted imports with `merge=union`, +while reversing the insertion order may produce unsorted imports. Adjacent independent deletions +can also reconstruct correctly while union retains deleted imports. Both latter cases report a +limitation: the source owner must refresh the source branch through the usual reviewed process. +The tool never proposes an alternative queue API or enables a merge driver. + +Git operations use a temporary bare repository/index/object directory populated by an ordinary +local `file://` fetch. It has its own common directory, no alternates or shallow boundary, and +no object inode shared with the source. These properties are checked. Fetching complete history +can cost disk space and time; shallow source repositories are rejected. Pack threads are capped +at two. All inherited `GIT_*` environment variables are cleared before the first Git command, +including object, index, common-directory and worktree redirects. +No source/index/ref/config/object write, merge commit, +queue operation, workflow or cache action occurs in the inspected repository. User/system +attributes, local `info/attributes`, hooks and configured merge drivers are excluded; only the +prefix's tracked attributes participate in the ordinary comparison. Python 3.11+ and Git 2.43+ +are required. Unavailable history is an error, not a request to repair or reconstruct objects. + +This local standard-Git comparison does not certify GitHub's settings, current source ownership, +review approval, dependency landings or CI. Coordinators must still guard the live source/full +prefix, verify the actual hosted candidate tree, and require all six queue checks, including +`mk_all --check`. The report does not change admission policy. + +Focused regression tests use independent temporary Git repositories and run without Lean: + +```sh +python3 -B -m unittest discover -s scripts -p test_aggregate_merge.py -v +``` + +No Lean statement, definition, selected abstract, catalogue entry or rendered PDF changes. diff --git a/scripts/aggregate_merge.py b/scripts/aggregate_merge.py new file mode 100644 index 0000000000..21dcc87e75 --- /dev/null +++ b/scripts/aggregate_merge.py @@ -0,0 +1,261 @@ +#!/usr/bin/env python3 +"""Report whether an aggregate-only conflict has an exact canonical Git merge. + +All four inputs must be full commit IDs available locally. Git writes only to a temporary +repository; the inspected repository is read-only. See aggregate_merge.md for the contract. +""" + +from __future__ import annotations + +import argparse +from contextlib import contextmanager +import hashlib +import json +import os +from pathlib import Path +import re +import subprocess +import sys +import tempfile +import tomllib + + +AGGREGATE = "Complexity.lean" +# scripts/MkAll.lean, module-style branch; intentionally not a general Lean header parser. +MODULE_HEADER = b"module -- shake: keep-all --deprecated_module: ignore\n\n" +COMPONENT = re.compile(r"[A-Za-z_][A-Za-z_0-9]*\Z") # quick_check.source_modules convention +OID = re.compile(r"[0-9a-f]{40}\Z") + + +class Rejected(Exception): + """An input or merge is outside this verifier's bounded contract.""" + + +def require(condition: bool, message: str) -> None: + if not condition: + raise Rejected(message) + + +def environment() -> dict[str, str]: + # Do not inherit replacement objects, index/object directories or user merge drivers. + env = {key: value for key, value in os.environ.items() if not key.startswith("GIT_")} + env.update(GIT_CONFIG_NOSYSTEM="1", GIT_CONFIG_GLOBAL=os.devnull, + GIT_ATTR_NOSYSTEM="1", GIT_NO_REPLACE_OBJECTS="1", GIT_OPTIONAL_LOCKS="0") + return env + + +class Git: + def __init__(self, root: Path, env: dict[str, str]): + self.root, self.env = root, env + + def run(self, *args: str, data: bytes | None = None, allowed=(0,)): + result = subprocess.run( + ["git", "-c", "gc.auto=0", "-c", "maintenance.auto=false", + "-c", "pack.threads=2", "-c", "fetch.parallel=1", + "-c", f"core.attributesFile={os.devnull}", "-c", f"core.hooksPath={os.devnull}", + *args], cwd=self.root, env=self.env, input=data, capture_output=True) + require(result.returncode in allowed, + f"git {args[0]} failed: {result.stderr.decode(errors='replace').strip()}") + return result + + def text(self, *args: str) -> str: + return self.run(*args).stdout.decode().strip() + + def entries(self, tree: str) -> dict[str, dict[str, str]]: + entries = {} + for row in self.run("ls-tree", "-rz", tree).stdout.split(b"\0"): + if row: + metadata, path = row.split(b"\t", 1) + mode, kind, oid = metadata.decode().split() + entries[path.decode()] = {"mode": mode, "type": kind, "oid": oid} + return entries + + def blob(self, entry: dict[str, str]) -> bytes: + require(entry["type"] == "blob", "expected a blob") + return self.run("cat-file", "blob", entry["oid"]).stdout + + def set_aggregate(self, entry: dict[str, str]) -> str: + self.run("update-index", "--add", "--cacheinfo", entry["mode"], entry["oid"], AGGREGATE) + return self.text("write-tree") + + +@contextmanager +def scratch_git(repo: Path, commits: tuple[str, ...]): + require(all(OID.fullmatch(oid) for oid in commits), "use full immutable commit IDs") + source = Git(repo, environment()) + require(source.text("rev-parse", "--show-object-format") == "sha1", "only SHA-1 is supported") + require(source.text("rev-parse", "--is-shallow-repository") == "false", + "shallow source repositories are unsupported") + objects = Path(source.text("rev-parse", "--path-format=absolute", "--git-path", "objects")) + common = Path(source.text("rev-parse", "--path-format=absolute", "--git-common-dir")) + with tempfile.TemporaryDirectory(prefix="aggregate-merge-") as directory: + root = Path(directory) + source.run("init", "--bare", "--quiet", "--template=", "--object-format=sha1", str(root)) + git = Git(root, environment()) + require(Path(git.text("rev-parse", "--absolute-git-dir")).resolve() == root.resolve() and + Path(git.text("rev-parse", "--path-format=absolute", "--git-common-dir")).resolve() + == root.resolve() and root.resolve() != common.resolve(), + "temporary repository does not have an independent common directory") + own_objects = Path(git.text("rev-parse", "--path-format=absolute", "--git-path", "objects")) + require(own_objects.resolve() == (root / "objects").resolve() and + own_objects.resolve() != objects.resolve() and not (root / ".git").exists(), + "temporary object directory is not independent") + # Check identity before fetching or writing merge/index objects. A normal file:// + # fetch uses upload-pack, unlike clone's local hard-link shortcut. + git.run("fetch", "--no-tags", "--no-write-fetch-head", "--no-recurse-submodules", + "--no-auto-maintenance", repo.as_uri(), *dict.fromkeys(commits)) + require(not (own_objects / "info/alternates").exists() and + not (own_objects / "info/http-alternates").exists() and not (root / "shallow").exists(), + "temporary repository contains alternates or a shallow boundary") + source_inodes = {(p.stat().st_dev, p.stat().st_ino) for p in objects.rglob("*") if p.is_file()} + copied = [p for p in own_objects.rglob("*") if p.is_file()] + require(all(not p.is_symlink() and (p.stat().st_dev, p.stat().st_ino) not in source_inodes + for p in copied), "temporary objects share source storage") + git.isolation = {"independent_common_directory": True, "independent_object_directory": True, + "no_alternates_or_shallow_boundary": True, "no_shared_object_inodes": True, + "fetched_object_files": len(copied)} + yield git + + +def canonical(entries: dict[str, dict[str, str]]) -> bytes: + """Mirror mk_all's Complexity root: all .lean modules, sorted by module name.""" + modules = [] + for path, entry in entries.items(): + if path.startswith("Complexity/") and path.endswith(".lean"): + parts = path[:-5].split("/") + require(all(COMPONENT.fullmatch(part) for part in parts), + f"unsupported module path: {path}") + require(entry["type"] == "blob" and entry["mode"] in {"100644", "100755"}, + f"nonregular Lean module: {path}") + modules.append(".".join(parts)) + require(bool(modules), "empty Complexity library") + return MODULE_HEADER + b"".join(f"public import {name}\n".encode() for name in sorted(modules)) + + +def check_aggregate(git: Git, entries: dict, label: str) -> None: + require("lakefile.lean" not in entries and "lakefile.toml" in entries, + f"{label}: unsupported Lake configuration") + config = tomllib.loads(git.blob(entries["lakefile.toml"]).decode()) + libraries = config.get("lean_lib", []) + require(isinstance(libraries, list), f"{label}: invalid Lake libraries") + roots = [lib for lib in libraries if isinstance(lib, dict) and lib.get("name") == "Complexity"] + require(config.get("srcDir", ".") == "." and len(roots) == 1 and + roots[0].get("srcDir", ".") == "." and + roots[0].get("roots", ["Complexity"]) == ["Complexity"] and "globs" not in roots[0], + f"{label}: unsupported Complexity library layout") + require(AGGREGATE in entries and entries[AGGREGATE]["mode"] == "100644", + f"{label}: missing or nonregular aggregate") + content = git.blob(entries[AGGREGATE]) + require(content.startswith(MODULE_HEADER), f"{label}: changed known aggregate preamble") + # Exact generation rejects options/declarations, comments, malformed, repeated, missing, + # extra and unsorted imports. General Lean parsing would accept too much here. + require(content == canonical(entries), f"{label}: aggregate is not canonical for its inventory") + + +def merge(git: Git, prefix: str, source: str, attributes: str): + result = git.run("-c", f"attr.tree={attributes}", "merge-tree", "--write-tree", + "--name-only", "-z", prefix, source, allowed=(0, 1)) + fields = result.stdout.split(b"\0") + tree = fields.pop(0).decode() + require(bool(OID.fullmatch(tree)), "unexpected merge-tree output (Git >= 2.43 required)") + conflicts = [] + for field in fields: + if not field: + break + conflicts.append(field.decode()) + return result.returncode, tree, conflicts + + +def verify(git: Git, prefix: str, source: str, reviewed_base: str, reviewed_head: str, + report: dict) -> None: + refs = {"prefix": prefix, "source": source, + "reviewed_base": reviewed_base, "reviewed_head": reviewed_head} + for label, oid in refs.items(): + require(bool(OID.fullmatch(oid)), f"{label}: use a full immutable commit ID") + require(git.text("rev-parse", "--verify", f"{oid}^{{commit}}") == oid, + f"{label}: expected a commit") + require(git.run("merge-base", "--is-ancestor", reviewed_base, reviewed_head, + allowed=(0, 1)).returncode == 0, "reviewed base is not an ancestor of reviewed head") + require(git.run("merge-base", "--is-ancestor", reviewed_head, source, + allowed=(0, 1)).returncode == 0, "source does not retain reviewed history") + require(len(git.text("merge-base", "--all", prefix, source).splitlines()) == 1, + "merge needs exactly one base") + inventories = {label: git.entries(oid) for label, oid in refs.items()} + for label, entries in inventories.items(): + check_aggregate(git, entries, label) + report.update(inputs=refs, isolation=git.isolation, + input_trees={label: git.text("rev-parse", f"{oid}^{{tree}}") + for label, oid in refs.items()}) + empty = git.run("hash-object", "-t", "tree", "--stdin", "-w", data=b"").stdout.decode().strip() + # attr.tree must actually disable the tracked union attribute on this Git version. + attrs = git.run("-c", f"attr.tree={empty}", "check-attr", "-z", "merge", "--", AGGREGATE).stdout + require(attrs == b"Complexity.lean\0merge\0unspecified\0", "cannot disable tracked attributes") + status, neutral, conflicts = merge(git, prefix, source, empty) + report.update(neutral_tree=neutral, conflicts=conflicts) + require(status == 1 and conflicts == [AGGREGATE], + f"complete neutral conflict set must be exactly [{AGGREGATE!r}], got {conflicts!r}") + merged = git.entries(neutral) + content = canonical(merged) + entry = {"mode": "100644", "type": "blob", + "oid": git.run("hash-object", "-w", "--stdin", data=content).stdout.decode().strip()} + git.run("read-tree", neutral) + candidate = git.set_aggregate(entry) + candidate_entries = git.entries(candidate) + require({p: e for p, e in merged.items() if p != AGGREGATE} == + {p: e for p, e in candidate_entries.items() if p != AGGREGATE}, + "canonicalization changed a nonaggregate entry") + feature = git.run("diff", "--no-ext-diff", "--no-textconv", "--no-renames", "--binary", + "--full-index", reviewed_base, reviewed_head, "--", ".", + ":(exclude)Complexity.lean").stdout + require(bool(feature), "reviewed feature has no nonaggregate payload") + own_paths = sorted(p for p in inventories["reviewed_base"].keys() | inventories["reviewed_head"].keys() + if p != AGGREGATE and inventories["reviewed_base"].get(p) != + inventories["reviewed_head"].get(p)) + for path in own_paths: + require(candidate_entries.get(path) == inventories["reviewed_head"].get(path), + f"reviewed payload mode/blob changed: {path}") + # Whole-feature replay is stronger than checking only the named Lean payloads. It also + # guards docs, removals, modes and every unrelated accepted-prefix entry. + git.run("read-tree", prefix) + git.run("apply", "--cached", "--binary", data=feature) + require(git.set_aggregate(entry) == candidate, "feature forward replay does not recover candidate") + git.run("read-tree", candidate) + git.run("apply", "--cached", "--binary", "--reverse", data=feature) + recovered = git.set_aggregate(inventories["prefix"][AGGREGATE]) + require(recovered == report["input_trees"]["prefix"], "feature inverse does not recover exact prefix") + report.update(candidate_tree=candidate, candidate_entries=candidate_entries, + reviewed_paths=own_paths, reviewed_entries={p: candidate_entries.get(p) for p in own_paths}, + feature_patch_sha256=hashlib.sha256(feature).hexdigest(), recovered_prefix_tree=recovered, + canonical_aggregate_sha256=hashlib.sha256(content).hexdigest(), + canonical_import_count=len(content.splitlines()) - 2) + # A private canonical tree is not an admission mechanism. The ordinary tracked-attribute + # merge, in the target-prefix direction, must produce exactly that tree itself. + status, default, conflicts = merge(git, prefix, source, prefix) + report.update(default_merge_tree=default, default_conflicts=conflicts) + if status != 0 or conflicts or default != candidate: + report["status"] = "limitation" + raise Rejected("ordinary tracked-attribute merge cannot represent the exact canonical candidate; " + "refresh the source branch through its owner") + report["status"] = "verified" + + +def main(argv=None) -> int: + parser = argparse.ArgumentParser(description=__doc__) + parser.add_argument("--repo", type=Path, default=Path.cwd()) + for name in ("prefix", "source", "reviewed-base", "reviewed-head"): + parser.add_argument(f"--{name}", required=True) + args = parser.parse_args(argv) + report = {"status": "rejected", "report_only": True, + "limits": "No source review, CI, hosted candidate or queue authority is certified."} + try: + with scratch_git(args.repo.resolve(), + (args.prefix, args.source, args.reviewed_base, args.reviewed_head)) as git: + verify(git, args.prefix, args.source, args.reviewed_base, args.reviewed_head, report) + except (Rejected, OSError, ValueError) as error: + report["reason"] = str(error) + print(json.dumps(report, indent=2, sort_keys=True)) + return 0 if report["status"] == "verified" else 1 + + +if __name__ == "__main__": + sys.exit(main()) diff --git a/scripts/test_aggregate_merge.py b/scripts/test_aggregate_merge.py new file mode 100644 index 0000000000..220d97abf7 --- /dev/null +++ b/scripts/test_aggregate_merge.py @@ -0,0 +1,289 @@ +#!/usr/bin/env python3 +"""Real Git fixtures for the report-only aggregate verifier; no Lean build is needed.""" + +import contextlib +import hashlib +import io +import json +import os +from pathlib import Path +import subprocess +import tempfile +import unittest +from unittest.mock import patch + +import aggregate_merge as verifier + + +class AggregateMergeTests(unittest.TestCase): + def setUp(self): + temp = tempfile.TemporaryDirectory(prefix="test-aggregate-merge-") + self.addCleanup(temp.cleanup) + self.repo = Path(temp.name) + self.env = verifier.environment() + self.env.update(GIT_AUTHOR_NAME="Fixture", GIT_AUTHOR_EMAIL="fixture@example.invalid", + GIT_COMMITTER_NAME="Fixture", GIT_COMMITTER_EMAIL="fixture@example.invalid") + self.git("init", "--quiet", "--initial-branch=main") + self.write("lakefile.toml", 'name = "fixture"\n[[lean_lib]]\nname = "Complexity"\n') + self.write(".gitattributes", "Complexity.lean merge=union\n") + for name in ("Init", "Zed"): + self.write(f"Complexity/{name}.lean", f"-- fixture {name}\n") + self.aggregate() + self.base = self.commit("base") + + def git(self, *args): + return subprocess.run(["git", "-c", "gc.auto=0", "-c", "maintenance.auto=false", *args], + cwd=self.repo, env=self.env, check=True, + capture_output=True).stdout.decode().strip() + + def write(self, path, content): + target = self.repo / path + target.parent.mkdir(parents=True, exist_ok=True) + target.write_text(content) + + def aggregate(self): + modules = sorted(".".join(p.relative_to(self.repo).with_suffix("").parts) + for p in (self.repo / "Complexity").rglob("*.lean")) + self.write("Complexity.lean", verifier.MODULE_HEADER.decode() + + "".join(f"public import {name}\n" for name in modules)) + + def commit(self, message): + self.git("add", ".") + self.git("commit", "--quiet", "-m", message) + return self.git("rev-parse", "HEAD") + + def additions(self, prefix_name="Able", source_name="Beta"): + self.write(f"Complexity/{prefix_name}.lean", "-- accepted prefix payload\n") + self.write("prefix-doc.md", "accepted prefix documentation\n") + self.aggregate() + prefix = self.commit("prefix") + self.git("switch", "--quiet", "--detach", self.base) + self.write(f"Complexity/{source_name}.lean", "-- reviewed feature payload\n") + self.write("review-doc.md", "reviewed feature documentation\n") + self.write("ComplexityTests/Feature.lean", "-- reviewed fixture\n") + self.aggregate() + return prefix, self.commit("reviewed feature") + + def report(self, prefix, source, reviewed=None, base=None): + output = io.StringIO() + with contextlib.redirect_stdout(output): + status = verifier.main(["--repo", str(self.repo), "--prefix", prefix, + "--source", source, "--reviewed-base", base or self.base, + "--reviewed-head", reviewed or source]) + return status, json.loads(output.getvalue()) + + def snapshot(self): + # Include objects and the fixture's index/refs/config/working files, not just status. + return {str(p.relative_to(self.repo)): hashlib.sha256(p.read_bytes()).hexdigest() + for p in self.repo.rglob("*") if p.is_file()} + + def test_adjacent_additions_exact_default_and_whole_feature_recovery(self): + prefix, source = self.additions() + before = self.snapshot() + status, report = self.report(prefix, source) + self.assertEqual(status, 0, report) + self.assertEqual(report["status"], "verified") + self.assertEqual(report["conflicts"], ["Complexity.lean"]) + self.assertEqual(report["candidate_tree"], report["default_merge_tree"]) + self.assertEqual(report["recovered_prefix_tree"], self.git("rev-parse", prefix + "^{tree}")) + self.assertEqual(report["reviewed_paths"], + ["Complexity/Beta.lean", "ComplexityTests/Feature.lean", "review-doc.md"]) + self.assertEqual(report["canonical_import_count"], 4) + self.assertTrue(report["isolation"]["no_shared_object_inodes"]) + self.assertEqual(before, self.snapshot(), "verifier mutated inspected repository") + + def test_actual_temporary_git_storage_is_independent(self): + prefix, source = self.additions() + with verifier.scratch_git(self.repo, (prefix, source)) as scratch: + self.assertNotEqual(scratch.root, self.repo / ".git") + self.assertFalse((scratch.root / ".git").exists()) + self.assertFalse((scratch.root / "objects/info/alternates").exists()) + self.assertFalse((scratch.root / "objects/info/http-alternates").exists()) + self.assertFalse((scratch.root / "shallow").exists()) + source_inodes = {(p.stat().st_dev, p.stat().st_ino) + for p in (self.repo / ".git/objects").rglob("*") if p.is_file()} + temporary_objects = [p for p in (scratch.root / "objects").rglob("*") if p.is_file()] + self.assertTrue(temporary_objects) + self.assertTrue(all((p.stat().st_dev, p.stat().st_ino) not in source_inodes + for p in temporary_objects)) + # Read a real reviewed payload through the independent fetched objects. + self.assertIn("Complexity/Beta.lean", scratch.entries(source)) + + def test_adjacent_deletions_reconstruct_but_default_union_is_a_limitation(self): + for name in ("Able", "Beta"): + self.write(f"Complexity/{name}.lean", "-- removal fixture\n") + self.aggregate() + base = self.commit("deletion base") + (self.repo / "Complexity/Able.lean").unlink() + self.aggregate() + prefix = self.commit("remove Able") + self.git("switch", "--quiet", "--detach", base) + (self.repo / "Complexity/Beta.lean").unlink() + self.aggregate() + source = self.commit("remove Beta") + status, report = self.report(prefix, source, base=base) + self.assertEqual(status, 1) + self.assertEqual(report["status"], "limitation", report) + self.assertEqual(report["canonical_import_count"], 2) + self.assertEqual(report["reviewed_entries"], {"Complexity/Beta.lean": None}) + self.assertEqual(report["recovered_prefix_tree"], self.git("rev-parse", prefix + "^{tree}")) + self.assertNotEqual(report["candidate_tree"], report["default_merge_tree"]) + + def test_noncanonical_default_merge_fails_closed(self): + prefix, source = self.additions("Beta", "Able") + status, report = self.report(prefix, source) + self.assertEqual(status, 1) + self.assertEqual(report["status"], "limitation", report) + self.assertIn("cannot represent", report["reason"]) + + def test_reviewed_feature_after_ordinary_main_merge(self): + self.write("Complexity/Mid.lean", "-- already landed dependency\n") + self.aggregate() + old_main = self.commit("older main") + self.write("Complexity/Able.lean", "-- accepted prefix addition\n") + self.aggregate() + prefix = self.commit("prefix") + self.git("switch", "--quiet", "--detach", self.base) + self.write("Complexity/Beta.lean", "-- reviewed feature\n") + self.aggregate() + reviewed = self.commit("reviewed feature") + self.git("merge", "--quiet", "--no-edit", old_main) + source = self.git("rev-parse", "HEAD") + status, report = self.report(prefix, source, reviewed=reviewed) + self.assertEqual(status, 0, report) + self.assertEqual(report["reviewed_paths"], ["Complexity/Beta.lean"]) + self.assertIn("Complexity/Mid.lean", report["candidate_entries"]) + + def test_without_tracked_union_default_conflict_is_a_limitation(self): + self.write(".gitattributes", "# no aggregate merge driver\n") + self.base = self.commit("no union base") + prefix, source = self.additions() + _, report = self.report(prefix, source) + self.assertEqual(report["status"], "limitation", report) + self.assertEqual(report["default_conflicts"], ["Complexity.lean"]) + + def test_another_conflicted_file_is_rejected_even_with_union_for_it(self): + self.write(".gitattributes", "Complexity.lean merge=union\n*.md merge=union\n") + self.write("shared.md", "base\n") + self.base = self.commit("shared base") + prefix, source = self.additions() + self.write("shared.md", "source\n") + source = self.commit("source conflict") + self.git("switch", "--quiet", "--detach", prefix) + self.write("shared.md", "prefix\n") + prefix = self.commit("prefix conflict") + _, report = self.report(prefix, source) + self.assertEqual(report["status"], "rejected") + self.assertEqual(report["conflicts"], ["Complexity.lean", "shared.md"]) + + def test_changed_preamble_and_hidden_commands_and_invalid_inventories(self): + prefix, source = self.additions() + valid = (self.repo / "Complexity.lean").read_text() + mutations = { + "preamble": valid.replace("module -- shake: keep-all", "module -- shake: keep-all"), + "declaration": valid + "def hidden := 1\n", + "option": valid + "set_option maxHeartbeats 0\n", + "comment spoof": valid + "-- public import Complexity.Hidden\n", + "malformed": valid.replace("public import Complexity.Beta", "public import Complexity..Beta"), + "duplicate": valid + "public import Complexity.Beta\n", + "missing": valid.replace("public import Complexity.Beta\n", ""), + "nonexistent": valid + "public import Complexity.Absent\n", + "unsorted": valid.replace("public import Complexity.Beta\n", "") + + "public import Complexity.Beta\n", + } + for label, text in mutations.items(): + with self.subTest(label=label): + self.git("switch", "--quiet", "--detach", source) + self.write("Complexity.lean", text) + bad = self.commit(label) + status, report = self.report(prefix, bad) + self.assertEqual(status, 1) + self.assertEqual(report["status"], "rejected", report) + self.assertIn("aggregate", report["reason"]) + + def test_unreviewed_extra_payload_cannot_hide_behind_aggregate_conflict(self): + prefix, reviewed = self.additions() + self.write("unreviewed.md", "not in reviewed feature\n") + source = self.commit("extra unreviewed payload") + _, report = self.report(prefix, source, reviewed=reviewed) + self.assertEqual(report["status"], "rejected", report) + self.assertIn("forward replay", report["reason"]) + + def test_reviewed_payload_byte_and_mode_drift_are_rejected(self): + prefix, reviewed = self.additions() + for mode_only in (False, True): + with self.subTest(mode_only=mode_only): + self.git("switch", "--quiet", "--detach", reviewed) + path = self.repo / "Complexity/Beta.lean" + if mode_only: + path.chmod(0o755) + else: + path.write_text("-- changed payload\n") + source = self.commit("drift") + _, report = self.report(prefix, source, reviewed=reviewed) + self.assertEqual(report["status"], "rejected", report) + self.assertIn("mode/blob changed", report["reason"]) + + def test_nonimmutable_reference_and_missing_review_history_are_rejected(self): + prefix, source = self.additions() + _, report = self.report("HEAD", source) + self.assertIn("immutable", report["reason"]) + _, report = self.report(prefix, prefix, reviewed=source) + self.assertIn("reviewed history", report["reason"]) + + def test_no_aggregate_conflict_is_out_of_scope(self): + _, source = self.additions() + _, report = self.report(self.base, source) + self.assertEqual(report["status"], "rejected", report) + self.assertIn("complete neutral conflict set", report["reason"]) + + def test_changed_library_layout_and_symlink_modules_are_rejected(self): + prefix, source = self.additions() + self.write("lakefile.toml", 'name = "fixture"\n[[lean_lib]]\n' + 'name = "Complexity"\nsrcDir = "elsewhere"\n') + bad = self.commit("changed source directory") + _, report = self.report(prefix, bad) + self.assertIn("library layout", report["reason"]) + self.git("switch", "--quiet", "--detach", source) + (self.repo / "Complexity/Beta.lean").unlink() + (self.repo / "Complexity/Beta.lean").symlink_to("Init.lean") + bad = self.commit("symlink module") + _, report = self.report(prefix, bad) + self.assertIn("nonregular Lean module", report["reason"]) + + def test_local_info_attributes_and_merge_drivers_do_not_change_result(self): + prefix, source = self.additions("Beta", "Able") + self.write(".git/info/attributes", "Complexity.lean merge=ours\n") + self.git("config", "merge.ours.driver", "touch SHOULD_NOT_RUN") + before = self.snapshot() + _, report = self.report(prefix, source) + self.assertEqual(report["status"], "limitation", report) + self.assertEqual(before, self.snapshot()) + self.assertFalse((self.repo / "SHOULD_NOT_RUN").exists()) + + def test_hostile_inherited_git_paths_cannot_redirect_temporary_writes(self): + prefix, source = self.additions() + control = self.repo / ".git" + hostile = {"GIT_DIR": str(control), "GIT_COMMON_DIR": str(control), + "GIT_OBJECT_DIRECTORY": str(control / "objects"), + "GIT_ALTERNATE_OBJECT_DIRECTORIES": str(control / "objects"), + "GIT_INDEX_FILE": str(control / "index"), "GIT_WORK_TREE": str(self.repo)} + before = self.snapshot() + with patch.dict(os.environ, hostile): + status, report = self.report(prefix, source) + self.assertEqual(status, 0, report) + self.assertEqual(before, self.snapshot()) + + def test_noncanonical_accepted_prefix_is_rejected(self): + prefix, source = self.additions() + self.git("switch", "--quiet", "--detach", prefix) + with (self.repo / "Complexity.lean").open("a") as output: + output.write("def hidden := 1\n") + prefix = self.commit("noncanonical accepted prefix") + _, report = self.report(prefix, source) + self.assertEqual(report["status"], "rejected", report) + self.assertIn("prefix: aggregate", report["reason"]) + + +if __name__ == "__main__": + unittest.main() From be44e3447ff980836cd2678bfb69dd422d7c8dad Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Mon, 2 Nov 2026 04:15:12 +0000 Subject: [PATCH 3/6] feat(Classes/Promise): explicit-time sample-and-verify for PromiseBPTIME (#2084 M1) (#2086) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * feat(Classes/Time): explicit-time verifier characterization of NTIME (#1572) Guess and verify within explicit time (`setOf_exists_mem_NTIME`), through a closed fair-coin composition with the new framed sampler `pairSampler`, and a linear-time verifier for every problem in `NTIME` (`exists_verifier_of_mem_NTIME`). Infrastructure toward the nondeterministic time hierarchy. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * refactor(Machines/PTM): make the pair sampler's proof configurations private The induction configurations `PairSampler.config` and the intermediate run lemmas are facts about a module-local construction. Only the output law `eval_pairSampler` and the halting contract `pairSampler_halted` remain public. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * feat(Classes/Promise): PromiseBPTIME with explicit-time sample-and-verify (#2084 M1) Define bounded-error probabilistic time for promise problems (Turing.MultiTapePTM.SolvesWithBoundedErrorInTime, Cslib.Complexity.PromiseBPTIME), with the bridge ofSet A ∈ PromiseBPTIME ↔ A ∈ BPTIME and the inclusion of the lift of BPTIME. Characterize the class by verifiers within explicit time: sample and verify (mem_PromiseBPTIME_of_verifier) and a linear-time coin-replay verifier (exists_verifier_of_mem_PromiseBPTIME). The sample-and-verify machine is extracted from the guess-and-verify proof of #2025 into Classes/Time/SampleVerify (exists_machine_sampleVerify), and setOf_exists_mem_NTIME now uses it. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * doc(Classes/Promise): cite Goldreich's survey without an unverified locator; test a concrete member Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * refactor(Foundations): share the two-thirds dyadic fraction lemma `Classes/Time` and `Classes/Promise/Time` each proved the same private `two_thirds_le_div_iff`. Keep one public copy, `ENNReal.two_div_three_le_natCast_div_two_pow_iff`, in a small Foundations companion and use it from both modules. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * docs(PromiseBPTIME): move hierarchy reference past shared link gap --------- Co-authored-by: Claude Opus 5.5 --- Complexity.lean | 3 + .../Complexity/Classes/Promise/Time.lean | 52 ++++- .../Classes/Promise/Time/Verifier.lean | 177 ++++++++++++++++++ .../Complexity/Classes/Time.lean | 24 +-- .../Complexity/Classes/Time/SampleVerify.lean | 171 +++++++++++++++++ .../Complexity/Classes/Time/Verifier.lean | 148 +++------------ .../Foundations/Analysis/ENNRealFraction.lean | 50 +++++ ComplexityTests/PromiseBPTIME.lean | 98 ++++++++++ ROADMAP.md | 7 + references.bib | 9 + 10 files changed, 593 insertions(+), 146 deletions(-) create mode 100644 Complexity/Computability/Complexity/Classes/Promise/Time/Verifier.lean create mode 100644 Complexity/Computability/Complexity/Classes/Time/SampleVerify.lean create mode 100644 Complexity/Foundations/Analysis/ENNRealFraction.lean create mode 100644 ComplexityTests/PromiseBPTIME.lean diff --git a/Complexity.lean b/Complexity.lean index e546790ca0..8057ce14bf 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -1371,6 +1371,7 @@ public import Complexity.Computability.Complexity.Classes.Promise.Probabilistic public import Complexity.Computability.Complexity.Classes.Promise.Randomized public import Complexity.Computability.Complexity.Classes.Promise.Reduction public import Complexity.Computability.Complexity.Classes.Promise.Time +public import Complexity.Computability.Complexity.Classes.Promise.Time.Verifier public import Complexity.Computability.Complexity.Classes.RP public import Complexity.Computability.Complexity.Classes.RP.Closure public import Complexity.Computability.Complexity.Classes.RepeatedTrials @@ -1433,6 +1434,7 @@ public import Complexity.Computability.Complexity.Classes.Time public import Complexity.Computability.Complexity.Classes.Time.AcceptCount public import Complexity.Computability.Complexity.Classes.Time.BoundedExists public import Complexity.Computability.Complexity.Classes.Time.Polynomial +public import Complexity.Computability.Complexity.Classes.Time.SampleVerify public import Complexity.Computability.Complexity.Classes.Time.Verifier public import Complexity.Computability.Complexity.Classes.Time.WordRAM public import Complexity.Computability.Complexity.Classes.TimeSpace.Williams @@ -3039,6 +3041,7 @@ 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.ENNRealFraction public import Complexity.Foundations.Analysis.ENNRealTsum public import Complexity.Foundations.Analysis.Fourier.ZModProd public import Complexity.Foundations.Analysis.HarmonicMean diff --git a/Complexity/Computability/Complexity/Classes/Promise/Time.lean b/Complexity/Computability/Complexity/Classes/Promise/Time.lean index c3bfe88d4f..fa2cc61177 100644 --- a/Complexity/Computability/Complexity/Classes/Promise/Time.lean +++ b/Complexity/Computability/Complexity/Classes/Promise/Time.lean @@ -19,9 +19,13 @@ the output is `[true]` with probability at least `2/3`, and on no-instances it i probability at least `2/3`. No probability gap or answer is required outside the promise. This is the library's time-indexed native-machine convention, extending `BPTIME` to partial -promises. It does not define the class through bounded-error total completions. A strict-majority -completion belongs to `PPTIME` at the same caller-supplied clock, with ties rejecting; this is not -a bounded-error completion in `BPTIME`. +promises: a decision problem is in `PromiseBPTIME` exactly when it is in `BPTIME`. It does not +define the class through bounded-error total completions. A strict-majority completion belongs to +`PPTIME` at the same caller-supplied clock, with ties rejecting; this is not a bounded-error +completion in `BPTIME`. + +The characterization by sample-and-verify and coin replay at the same clock, up to constant +factors, is in `Complexity.Computability.Complexity.Classes.Promise.Time.Verifier`. ## Main definitions @@ -30,7 +34,11 @@ a bounded-error completion in `BPTIME`. ## Main results +* `Turing.MultiTapePTM.solvesPromiseWithBoundedErrorInTime_ofSet_iff`, + `ofSet_mem_PromiseBPTIME`: on decision problems, the notions are + `Turing.MultiTapePTM.DecidesWithBoundedErrorInTime` and `BPTIME`. * `PromiseBPTIME_mono`: increasing the time bound preserves membership. +* `mem_PromiseBPTIME_of_subset`: shrinking either side of the promise preserves membership. * `promiseClass_BPTIME_subset_PromiseBPTIME`: total bounded-error completions give witnesses. * `PromiseBPTIME_subset_promiseClass_PPTIME`: a strict-majority completion at the same time scale. -/ @@ -65,6 +73,29 @@ theorem SolvesPromiseWithBoundedErrorInTime.mono · rw [machine.eval_runClosed_eq_of_halted _ (ht a) hhalt] exact ⟨hyes, hno⟩ +/-- A machine solving a promise problem solves every promise problem with fewer yes-instances and +fewer no-instances. -/ +theorem SolvesPromiseWithBoundedErrorInTime.of_subset + {machine : MultiTapePTM k Bool State} {enc : α ↪ List Bool} {Q Q' : PromiseProblem α} + {t : α → ℕ} (h : machine.SolvesPromiseWithBoundedErrorInTime enc Q t) + (hyes : Q'.yes ⊆ Q.yes) (hno : Q'.no ⊆ Q.no) : + machine.SolvesPromiseWithBoundedErrorInTime enc Q' t := fun a => + let ⟨hhalt, hQyes, hQno⟩ := h a + ⟨hhalt, fun ha => hQyes (hyes ha), fun ha => hQno (hno ha)⟩ + +/-- On a decision problem, solving with bounded error is deciding with bounded error. -/ +theorem solvesPromiseWithBoundedErrorInTime_ofSet_iff {machine : MultiTapePTM k Bool State} + {enc : α ↪ List Bool} {A : Set α} {t : α → ℕ} : + machine.SolvesPromiseWithBoundedErrorInTime enc (PromiseProblem.ofSet A) t ↔ + machine.DecidesWithBoundedErrorInTime enc A t := by + refine forall_congr' fun a => and_congr_right fun _ => ?_ + by_cases ha : a ∈ A + · have hno : a ∉ (PromiseProblem.ofSet A).no := fun h => h ha + simp only [MultiTapeTM.indicator, ha, ite_true] + exact ⟨fun h => h.1 ha, fun h => ⟨fun _ => h, fun h' => absurd h' hno⟩⟩ + · simp only [MultiTapeTM.indicator, ha, ite_false] + exact ⟨fun h => h.2 ha, fun h => ⟨fun h' => absurd h' ha, fun _ => h⟩⟩ + end Turing.MultiTapePTM namespace Cslib.Complexity @@ -88,6 +119,21 @@ theorem PromiseBPTIME_mono {T₁ T₂ : ℕ → ℕ} (h : ∀ n, T₁ n ≤ T₂ exact ⟨c₁, c₂, k, State, hfinite, machine, hQ.mono fun a => Nat.add_le_add_right (Nat.mul_le_mul_left _ (h _)) _⟩ +/-- A promise problem with fewer yes-instances and fewer no-instances than one in `PromiseBPTIME` +is in `PromiseBPTIME`. -/ +theorem mem_PromiseBPTIME_of_subset {Q Q' : PromiseProblem α} (hQ : Q ∈ PromiseBPTIME enc T) + (hyes : Q'.yes ⊆ Q.yes) (hno : Q'.no ⊆ Q.no) : Q' ∈ PromiseBPTIME enc T := + let ⟨c₁, c₂, k, State, hfinite, machine, hQ⟩ := hQ + ⟨c₁, c₂, k, State, hfinite, machine, hQ.of_subset hyes hno⟩ + +/-- A decision problem, as a promise problem, is in `PromiseBPTIME` exactly when it is in +`BPTIME`. -/ +@[simp] +theorem ofSet_mem_PromiseBPTIME {A : Set α} : + PromiseProblem.ofSet A ∈ PromiseBPTIME enc T ↔ A ∈ BPTIME enc T := by + simp only [PromiseBPTIME, BPTIME, Set.mem_ofPred_eq, + MultiTapePTM.solvesPromiseWithBoundedErrorInTime_ofSet_iff] + /-- A bounded-error total completion supplies a native bounded-error promise solver. -/ theorem promiseClass_BPTIME_subset_PromiseBPTIME : promiseClass (BPTIME enc T) ⊆ PromiseBPTIME enc T := by diff --git a/Complexity/Computability/Complexity/Classes/Promise/Time/Verifier.lean b/Complexity/Computability/Complexity/Classes/Promise/Time/Verifier.lean new file mode 100644 index 0000000000..dded27da8b --- /dev/null +++ b/Complexity/Computability/Complexity/Classes/Promise/Time/Verifier.lean @@ -0,0 +1,177 @@ +/- +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.Complexity.AcceptCount +public import Complexity.Computability.Complexity.Classes.Promise.Time +import Complexity.Computability.Complexity.Classes.Time.SampleVerify +import Complexity.Computability.Machines.Turing.MultiTape.Internal.EqualityPrimitives +import Complexity.Computability.Machines.Turing.MultiTape.Internal.OCombinators +import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.CoinTape +import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ReplayInput +import Complexity.Foundations.Analysis.ENNRealFraction + +/-! +# Verifier characterization of `PromiseBPTIME` within explicit time + +Promise problems [Goldreich][Goldreich2006] in `Cslib.Complexity.PromiseBPTIME enc t` are +characterized by deterministic verifiers reading random strings, keeping the time bound up to +constant factors: + +* **Sample and verify** (`Cslib.Complexity.mem_PromiseBPTIME_of_verifier`). If a verifier `V` is + computable within time `T (a, w)` on encoded pairs, the length `ℓ a` of the random string is + computable in unary within `Tℓ a`, and `(enc a).length + Tℓ a + T (a, w)` is within + `O(t (enc a).length)`, then a promise problem is in `PromiseBPTIME enc t` when at least two + thirds of the strings of length `ℓ a` are accepted on its yes-instances and rejected on its + no-instances. The machine is `Cslib.Complexity.exists_machine_sampleVerify`. +* **Coin replay** (`Cslib.Complexity.exists_verifier_of_mem_PromiseBPTIME`). A promise problem in + `PromiseBPTIME enc t` has a verifier computable in linear time on encoded pairs: replay the + coins on the machine and test whether the output is `[true]`. Every random-string length of at + least `c * t (enc a).length + c` works, since a halted run ignores further coins. + +The polynomial characterization of `PromiseBPP` +(`Cslib.Complexity.mem_PromiseBPP_iff_exists_isPPTOn`) loses the polynomial degree; these +explicit-time forms are what a time hierarchy for promise problems needs. Such a hierarchy is +known without advice, by delayed diagonalization [He][He2025], while the hierarchy for `BPTIME` +itself is open. + +## Main results + +* `Cslib.Complexity.mem_PromiseBPTIME_of_verifier`: sample and verify within explicit time. +* `Cslib.Complexity.exists_verifier_of_mem_PromiseBPTIME`: a linear-time coin-replay verifier. + +## References + +* [O. Goldreich, *On promise problems: a survey*][Goldreich2006] +* [S. He, *A note on a hierarchy theorem for promise-BPTIME*][He2025] +-/ + +public section + +namespace Cslib.Complexity + +open _root_.Turing _root_.Turing.MultiTapeTM +open scoped ENNReal + +variable {α : Type} {enc : α ↪ List Bool} + +/-- The probability that the verdict on a uniformly random string of length `n` is `b` is the +fraction of the strings with that verdict. -/ +private theorem uniformList_map_verdict_apply (V : α × List Bool → Bool) (a : α) (n : ℕ) + (b : Bool) : ((BitString.uniformList n).map fun w => [V (a, w)]) [b] = + (acceptCount (fun p => V p == b) a n : ℝ≥0∞) / 2 ^ n := by + rw [BitString.uniformList_map_apply] + simp only [acceptCount, List.cons.injEq, and_true, beq_iff_eq] + +/-- **Sample and verify, within explicit time.** If a verifier `V` is computable within time +`T (a, w)` on encoded pairs, and the length `ℓ a` of the random string is computable in unary +within time `Tℓ a`, with `(enc a).length + Tℓ a + T (a, w) ≤ C * t (enc a).length + C` for every +string `w` of length `ℓ a`, then a promise problem is in `PromiseBPTIME enc t` when `V` accepts at +least two thirds of the strings of length `ℓ a` together with each yes-instance `a`, and rejects at +least two thirds of them together with each no-instance. -/ +theorem mem_PromiseBPTIME_of_verifier {Q : PromiseProblem α} {V : α × List Bool → Bool} + {ℓ : α → ℕ} {t : ℕ → ℕ} {Tℓ Sℓ : α → ℕ} {T S : α × List Bool → ℕ} {C : ℕ} + (hℓ : ComputableInO ℓ enc encUnary Tℓ Sℓ) + (hV : ComputableInO V (encPair enc encBits) encBool T S) + (ht : ∀ a w, w.length = ℓ a → (enc a).length + Tℓ a + T (a, w) ≤ C * t (enc a).length + C) + (hyes : ∀ a ∈ Q.yes, 2 * 2 ^ ℓ a ≤ 3 * acceptCount V a (ℓ a)) + (hno : ∀ a ∈ Q.no, 2 * 2 ^ ℓ a ≤ 3 * acceptCount (fun p => !V p) a (ℓ a)) : + Q ∈ PromiseBPTIME enc t := by + obtain ⟨c₁, c₂, k, State, hfinite, machine, hmachine⟩ := exists_machine_sampleVerify hℓ hV ht + refine ⟨c₁, c₂, k, State, hfinite, machine, fun a => ⟨(hmachine a).1, fun ha => ?_, fun ha => ?_⟩⟩ + · rw [(hmachine a).2, uniformList_map_verdict_apply, + ENNReal.two_div_three_le_natCast_div_two_pow_iff] + simpa only [beq_true] using hyes a ha + · rw [(hmachine a).2, uniformList_map_verdict_apply, + ENNReal.two_div_three_le_natCast_div_two_pow_iff] + simpa only [beq_false] using hno a ha + +/-- **A linear-time verifier for promise-problem probabilistic time.** A promise problem in +`PromiseBPTIME enc t` has a verifier computable in linear time on encoded pairs. For a constant +`c`, every random-string length `L ≥ c * t (enc a).length + c` works: the verifier accepts at least +two thirds of the strings of length `L` together with each yes-instance, and rejects at least two +thirds of them together with each no-instance. The verifier replays the coins on the machine and +tests whether the output is `[true]`. -/ +theorem exists_verifier_of_mem_PromiseBPTIME {Q : PromiseProblem α} {t : ℕ → ℕ} + (hQ : Q ∈ PromiseBPTIME enc t) : + ∃ (V : α × List Bool → Bool) (c : ℕ), + ComputableInO V (encPair enc encBits) encBool (fun p => (encPair enc encBits p).length) + (fun p => (encPair enc encBits p).length) ∧ + ∀ a L, c * t (enc a).length + c ≤ L → + (a ∈ Q.yes → 2 * 2 ^ L ≤ 3 * acceptCount V a L) ∧ + (a ∈ Q.no → 2 * 2 ^ L ≤ 3 * acceptCount (fun p => !V p) a L) := by + obtain ⟨c₁, c₂, k, State, hfinite, machine, hQ⟩ := hQ + let V : α × List Bool → Bool := fun p => decide (machine.runClosedCoins p.2 (enc p.1) = [true]) + refine ⟨V, c₁ + c₂, ?_, fun a L hL => ?_⟩ + · -- replay the coins, then compare the output with `[true]` + have hswap : ComputableInO (fun p : α × List Bool => (p.2, enc p.1)) (encPair enc encBits) + (encPair encBits encBits) + (fun p => (encPair enc encBits p).length + + ((encPair enc encBits p).length + (enc p.1).length)) + (fun p => (encPair enc encBits p).length + + ((encPair enc encBits p).length + (enc p.1).length)) := + (ComputableInO.snd enc encBits).prod + ((ComputableInO.of_eq (f := fun x : α => enc x) (encIn := enc) (encMid := encBits) + fun _ => rfl).comp (ComputableInO.fst enc encBits)) + have hrun := (ComputableInO.of_linear + (MultiTapePTM.computableInDegree_runClosedCoins machine)).comp hswap + obtain ⟨cr, hcr⟩ := hrun.length_le_time + have heq := ComputableInO.eqWords.comp ((ComputableInO.const (encIn := encPair enc encBits) + (encMid := encBits) [true]).prod hrun) + have hfun : ((fun p : List Bool × List Bool => decide (p.1 = p.2)) ∘ + fun p : α × List Bool => ([true], ((fun q : List Bool × List Bool => + machine.runClosedCoins q.1 q.2) ∘ fun p : α × List Bool => (p.2, enc p.1)) p)) = V := by + funext p + simp [V, eq_comm] + rw [hfun] at heq + -- every part is linear in the encoded pair, including the replayed output + have hbound (p : α × List Bool) : + (encPair enc encBits p).length + ((encPair enc encBits p).length + + ((encPair enc encBits p).length + (enc p.1).length) + + (encPair encBits encBits (p.2, enc p.1)).length) + + 2 * ((machine.runClosedCoins p.2 (enc p.1)).length + 2) ≤ + (9 + 10 * cr) * ((encPair enc encBits p).length + 1) := by + have hc := hcr p + simp only [Function.comp_apply, encBits_apply] at hc + have hle : (enc p.1).length ≤ (encPair enc encBits p).length := by + simp only [encPair_apply, List.length_append, length_frame, encBits_apply] + omega + have hsw : (encPair encBits encBits (p.2, enc p.1)).length ≤ + 2 * (encPair enc encBits p).length := by + simp only [encPair_apply, List.length_append, length_frame, encBits_apply] + omega + generalize (encPair enc encBits p).length = N at * + generalize (machine.runClosedCoins p.2 (enc p.1)).length = R at * + generalize (encPair encBits encBits (p.2, enc p.1)).length = W at * + have hR : R ≤ cr * (5 * N + 1) := hc.trans (Nat.mul_le_mul_left cr (by omega)) + nlinarith + refine heq.mono (9 + 10 * cr) (fun p => ?_) fun p => ?_ + · have := hbound p + simp only [Function.comp_apply, List.length_singleton] at this ⊢ + nlinarith + · have := hbound p + simp only [Function.comp_apply, List.length_singleton] at this ⊢ + omega + · -- at `L` coins, the halted run is distributed as the replays + obtain ⟨hhalt, hyes, hno⟩ := hQ a + have hT : c₁ * t (enc a).length + c₂ ≤ L := + le_trans (by nlinarith) hL + have heval : ProbComp.eval (machine.runClosed L (enc a)) = + (BitString.uniformList L).map fun w => machine.runClosedCoins w (enc a) := by + rw [MultiTapePTM.eval_runClosed_eq_map_coins] + rw [← machine.eval_runClosed_eq_of_halted _ hT hhalt, heval, + BitString.uniformList_map_apply, ENNReal.two_div_three_le_natCast_div_two_pow_iff] at hyes hno + refine ⟨fun ha => ?_, fun ha => ?_⟩ + · simpa only [acceptCount, V, decide_eq_true_eq] using hyes ha + · refine (hno ha).trans (Nat.mul_le_mul_left 3 (Finset.card_le_card fun w hw => ?_)) + simp only [Finset.mem_filter, Finset.mem_univ, true_and, V, Bool.not_eq_true', + decide_eq_false_iff_not] at hw ⊢ + rw [hw] + simp + +end Cslib.Complexity diff --git a/Complexity/Computability/Complexity/Classes/Time.lean b/Complexity/Computability/Complexity/Classes/Time.lean index 57c0226098..73831d7901 100644 --- a/Complexity/Computability/Complexity/Classes/Time.lean +++ b/Complexity/Computability/Complexity/Classes/Time.lean @@ -20,6 +20,7 @@ import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ReplayIn import Complexity.Computability.Probabilistic.PPT.Capture import Complexity.Computability.Probabilistic.PPT.Clock import Complexity.Computability.Probabilistic.Sampling +import Complexity.Foundations.Analysis.ENNRealFraction import Complexity.Probability.PMF.Map import Mathlib.Data.Set.Finite.List @@ -370,25 +371,6 @@ theorem mem_NP_iff_exists_mem_NTIME {α : Type} {enc : α ↪ List Bool} {A : Se open Cslib.Probability open scoped ENNReal -/-- A probability of at least `2 / 3` is a fraction of at least two thirds. -/ -private theorem two_thirds_le_div_iff {c n : ℕ} : - (2 / 3 : ℝ≥0∞) ≤ c / 2 ^ n ↔ 2 * 2 ^ n ≤ 3 * c := by - rw [ENNReal.le_div_iff_mul_le (Or.inl (pow_ne_zero _ two_ne_zero)) - (Or.inl (ENNReal.pow_ne_top ENNReal.ofNat_ne_top)), div_eq_mul_inv, mul_right_comm, - ← div_eq_mul_inv, ENNReal.div_le_iff (by norm_num) (by norm_num)] - constructor - · intro h - have : ((2 * 2 ^ n : ℕ) : ℝ≥0∞) ≤ ((3 * c : ℕ) : ℝ≥0∞) := by - push_cast - rw [mul_comm (3 : ℝ≥0∞)] - exact h - exact_mod_cast this - · intro h - have : ((2 * 2 ^ n : ℕ) : ℝ≥0∞) ≤ ((3 * c : ℕ) : ℝ≥0∞) := by exact_mod_cast h - push_cast at this - rw [mul_comm (c : ℝ≥0∞)] - exact this - /-- An injective map keeps the probability of the image of a value. -/ private theorem map_apply_of_injective {β γ : Type} {p : PMF β} {f : β → γ} (hf : Function.Injective f) (b : β) : p.map f (f b) = p b := by @@ -428,7 +410,7 @@ theorem mem_BPP_iff_exists_mem_BPTIME {α : Type} {enc : α ↪ List Bool} {A : map_apply_of_injective encBool.injective] simp only [program, ProbComp.eval_map, BitString.eval_sampleList] rw [BitString.uniformList_map_apply] - exact two_thirds_le_div_iff.mpr (hA.two_mul_le a) + exact ENNReal.two_div_three_le_natCast_div_two_pow_iff.mpr (hA.two_mul_le a) · rintro ⟨d, c₁, c₂, k, State, hfinite, machine, hA⟩ -- replay the coins refine ⟨Polynomial.C c₁ * Polynomial.X ^ d + Polynomial.C c₂, @@ -444,7 +426,7 @@ theorem mem_BPP_iff_exists_mem_BPTIME {α : Type} {enc : α ↪ List Bool} {A : simp have hprob := (hA a).2 rw [MultiTapePTM.eval_runClosed_eq_map_coins, BitString.uniformList_map_apply, - two_thirds_le_div_iff] at hprob + ENNReal.two_div_three_le_natCast_div_two_pow_iff] at hprob dsimp only [DecidesWithBoundedError, PromiseProblem.SolvesWithBoundedError, BoundedErrorAt] rw [heval] constructor diff --git a/Complexity/Computability/Complexity/Classes/Time/SampleVerify.lean b/Complexity/Computability/Complexity/Classes/Time/SampleVerify.lean new file mode 100644 index 0000000000..f21a52592d --- /dev/null +++ b/Complexity/Computability/Complexity/Classes/Time/SampleVerify.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.Computability.Machines.Turing.MultiTape.Complexity.BigO +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Closed +public import Complexity.Probability.BitString +import Complexity.Computability.Machines.Turing.MultiTape.Internal.OCombinators +import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Composition +import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Deterministic +import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.PairSampler +import Complexity.Computability.Machines.Turing.MultiTape.Run +import Complexity.Probability.PMF.Bind + +/-! +# Sampling a random string and running a verifier, within explicit time + +A fair-coin machine can draw a uniformly random string `w` of length `ℓ a` and output the verdict +`V (a, w)` of a deterministic verifier on the pair `(a, w)`, within the time it takes to write +`ℓ a` in unary and to run the verifier, up to constant factors +(`Cslib.Complexity.exists_machine_sampleVerify`). The machine is a closed fair-coin composition: + +* a deterministic machine writes `frame (enc a)` followed by `ℓ a` ones; +* the fixed sampler `Turing.MultiTapePTM.pairSampler` copies the framed instance and replaces the + ones by fair coins; +* a deterministic machine runs the verifier. + +Every run halts within the clock, and the output is distributed as `[V (a, w)]` for `w` uniform of +length `ℓ a`. Read nondeterministically, the machine guesses and verifies a certificate +(`Cslib.Complexity.setOf_exists_mem_NTIME`); read probabilistically, it samples and verifies +(`Cslib.Complexity.mem_PromiseBPTIME_of_verifier`). Unlike the polynomial compiler of PPT +programs (`Cslib.Probability.IsPPTOn.exists_halting_machine`), the clock keeps the time bound up to +constant factors. + +## Main results + +* `Cslib.Complexity.exists_machine_sampleVerify`: the sample-and-verify machine within explicit + time, with its output distribution. +-/ + +public section + +namespace Cslib.Complexity + +open _root_.Turing _root_.Turing.MultiTapeTM + +variable {α : Type} {enc : α ↪ List Bool} + +/-- **Sample and verify, within explicit time.** If a verifier `V` is computable within time +`T (a, w)` on encoded pairs, and the length `ℓ a` of the random string is computable in unary +within time `Tℓ a`, and `(enc a).length + Tℓ a + T (a, w) ≤ C * t (enc a).length + C` for every +string `w` of length `ℓ a`, then a fair-coin machine with a binary alphabet and finitely many +states halts on every run within time `c₁ * t (enc a).length + c₂` and outputs `[V (a, w)]` for a +uniformly random `w` of length `ℓ a`. -/ +theorem exists_machine_sampleVerify {V : α × List Bool → Bool} {ℓ : α → ℕ} {t : ℕ → ℕ} + {Tℓ Sℓ : α → ℕ} {T S : α × List Bool → ℕ} {C : ℕ} + (hℓ : ComputableInO ℓ enc encUnary Tℓ Sℓ) + (hV : ComputableInO V (encPair enc encBits) encBool T S) + (ht : ∀ a w, w.length = ℓ a → (enc a).length + Tℓ a + T (a, w) ≤ C * t (enc a).length + C) : + ∃ (c₁ c₂ k : ℕ) (State : Type) (_ : Finite State) (machine : MultiTapePTM k Bool State), + ∀ a, (∀ final ∈ (ProbComp.eval (machine.runClosedConfigFrom (c₁ * t (enc a).length + c₂) + (machine.initialConfig (enc a)))).support, final.tapes.state = none) ∧ + ProbComp.eval (machine.runClosed (c₁ * t (enc a).length + c₂) (enc a)) = + (BitString.uniformList (ℓ a)).map fun w => [V (a, w)] := by + -- the deterministic preparation and the verifier, as machines + obtain ⟨c₁, ⟨k₁, Q₁, _, tm₁, h₁⟩, -⟩ := + (ComputableInO.of_eq (f := fun a : α => a) (encIn := enc) (encMid := enc) fun _ => rfl).prod hℓ + obtain ⟨c₃, ⟨k₃, Q₃, _, tm₃, h₃⟩, -⟩ := hV + let L (a : α) : ℕ := ℓ a + let u (a : α) : List Bool := frame (enc a) ++ List.replicate (L a) true + let t₁ (a : α) : ℕ := c₁ * ((enc a).length + Tℓ a + 1) + let t₂ (a : α) : ℕ := (u a).length + 1 + let t₃ (a : α) : ℕ := c₃ * (C * t (enc a).length + C + 1) + have hrun₁ (a : α) := (h₁ a).runFrom_of_le (le_refl (t₁ a)) + have hlen₁ (a : α) : (u a).length ≤ t₁ a := (h₁ a).length_output_le + -- the first phase writes the framed instance and the unary length of the random string + let M₁ : MultiTapePTM k₁ Bool Q₁ := MultiTapePTM.ofDeterministic tm₁ + have hfirst₁ (a : α) : ∀ final ∈ (ProbComp.eval + (M₁.runClosedConfigFrom (t₁ a) (M₁.initialConfig (enc a)))).support, + final.tapes.state = none := by + intro final hfinal + rw [MultiTapePTM.eval_runClosedConfigFrom_ofDeterministic, PMF.mem_support_pure_iff] at hfinal + subst hfinal + exact (hrun₁ a).1 + have hout₁ (a : α) : ProbComp.eval (M₁.runClosed (t₁ a) (enc a)) = PMF.pure (u a) := by + rw [MultiTapePTM.eval_runClosed_ofDeterministic, (hrun₁ a).2] + rfl + -- the sampler copies the framed instance and draws the random string + have hsecond₁ (a : α) : ∀ word ∈ (ProbComp.eval (M₁.runClosed (t₁ a) (enc a))).support, + ∀ final ∈ (ProbComp.eval (MultiTapePTM.pairSampler.runClosedConfigFrom (t₂ a) + (MultiTapePTM.pairSampler.initialConfig word))).support, final.tapes.state = none := by + intro word hword + rw [hout₁ a, PMF.mem_support_pure_iff] at hword + subst hword + exact MultiTapePTM.pairSampler_halted (enc a) (List.replicate (L a) true) + let P₁₂ := MultiTapePTM.pairSampler.comp M₁ false + let t₁₂ (a : α) : ℕ := t₁ a + (t₁ a + 4 + t₂ a) + have heval₁₂ (a : α) : ProbComp.eval (P₁₂.runClosed (t₁₂ a) (enc a)) = + (BitString.uniformList (L a)).map (frame (enc a) ++ ·) := by + rw [MultiTapePTM.eval_comp M₁ MultiTapePTM.pairSampler false (enc a) (t₁ a) (t₂ a) + (hfirst₁ a) (hsecond₁ a), hout₁ a, Probability.PMF.monad_bind_eq_bind, PMF.pure_bind] + simpa only [List.length_replicate, u] using + MultiTapePTM.eval_pairSampler (enc a) (List.replicate (L a) true) + have hhalt₁₂ (a : α) := MultiTapePTM.comp_halted M₁ MultiTapePTM.pairSampler false (enc a) + (t₁ a) (t₂ a) (hfirst₁ a) (hsecond₁ a) + -- the verifier runs on every sampled pair within the uniform clock `t₃` + let M₃ : MultiTapePTM k₃ Bool Q₃ := MultiTapePTM.ofDeterministic tm₃ + have hrun₃ (a : α) (w : List Bool) (hw : w.length = L a) := + (h₃ (a, w)).runFrom_of_le (J := t₃ a) (Nat.mul_le_mul_left c₃ (by + have := ht a w hw + omega)) + have hword (a : α) {word : List Bool} + (hword : word ∈ (ProbComp.eval (P₁₂.runClosed (t₁₂ a) (enc a))).support) : + ∃ w : List Bool, w.length = L a ∧ word = encPair enc encBits (a, w) := by + rw [heval₁₂ a] at hword + obtain ⟨w, hw, rfl⟩ := (PMF.mem_support_map_iff _ _ _).mp hword + exact ⟨w, BitString.mem_support_uniformList_iff.mp hw, rfl⟩ + have hsecond₂ (a : α) : ∀ word ∈ (ProbComp.eval (P₁₂.runClosed (t₁₂ a) (enc a))).support, + ∀ final ∈ (ProbComp.eval (M₃.runClosedConfigFrom (t₃ a) (M₃.initialConfig word))).support, + final.tapes.state = none := by + intro word hw final hfinal + obtain ⟨w, hwlen, rfl⟩ := hword a hw + rw [MultiTapePTM.eval_runClosedConfigFrom_ofDeterministic, PMF.mem_support_pure_iff] at hfinal + subst hfinal + exact (hrun₃ a w hwlen).1 + let P := M₃.comp P₁₂ false + let total (a : α) : ℕ := t₁₂ a + (t₁₂ a + 4 + t₃ a) + have hhalt (a : α) := MultiTapePTM.comp_halted P₁₂ M₃ false (enc a) (t₁₂ a) (t₃ a) (hhalt₁₂ a) + (hsecond₂ a) + -- the output is the verdict on a uniformly random string + have heval (a : α) : ProbComp.eval (P.runClosed (total a) (enc a)) = + (BitString.uniformList (ℓ a)).map fun w => [V (a, w)] := by + rw [MultiTapePTM.eval_comp P₁₂ M₃ false (enc a) (t₁₂ a) (t₃ a) (hhalt₁₂ a) (hsecond₂ a), + Probability.PMF.monad_bind_eq_bind, heval₁₂ a, PMF.bind_map, ← PMF.bind_pure_comp] + refine Probability.PMF.bind_congr_on_support _ _ _ fun w hw => ?_ + have hwlen : w.length = L a := BitString.mem_support_uniformList_iff.mp hw + simp only [Function.comp_apply] + rw [MultiTapePTM.eval_runClosed_ofDeterministic] + exact congrArg PMF.pure (hrun₃ a w hwlen).2 + -- the composed clock is within `O(t)` + have hle (a : α) : total a ≤ (6 * c₁ + c₃) * C * t (enc a).length + + ((6 * c₁ + c₃) * (C + 1) + 14) := by + set X := C * t (enc a).length + C + 1 + have hX₁ : t₁ a ≤ c₁ * X := Nat.mul_le_mul_left c₁ (by + have := ht a (List.replicate (L a) false) (List.length_replicate ..) + omega) + have htotal : total a ≤ 6 * t₁ a + 14 + t₃ a := by + have := hlen₁ a + simp only [total, t₁₂, t₂] + omega + have hX₃ : t₃ a = c₃ * X := rfl + calc total a ≤ 6 * (c₁ * X) + 14 + c₃ * X := by + have := Nat.mul_le_mul_left 6 hX₁ + rw [hX₃] at htotal + omega + _ = (6 * c₁ + c₃) * C * t (enc a).length + ((6 * c₁ + c₃) * (C + 1) + 14) := by + simp only [X] + ring + refine ⟨(6 * c₁ + c₃) * C, (6 * c₁ + c₃) * (C + 1) + 14, _, _, inferInstance, P, fun a => ?_⟩ + refine ⟨?_, ?_⟩ + · rw [P.eval_runClosedConfigFrom_eq_of_halted _ (hle a) (hhalt a)] + exact hhalt a + · rw [P.eval_runClosed_eq_of_halted _ (hle a) (hhalt a)] + exact heval a + +end Cslib.Complexity diff --git a/Complexity/Computability/Complexity/Classes/Time/Verifier.lean b/Complexity/Computability/Complexity/Classes/Time/Verifier.lean index bf32dd203c..73a333cbee 100644 --- a/Complexity/Computability/Complexity/Classes/Time/Verifier.lean +++ b/Complexity/Computability/Complexity/Classes/Time/Verifier.lean @@ -9,15 +9,12 @@ module public import Complexity.Computability.Complexity.Classes.Time import Complexity.Computability.Complexity.Classes.NP.Nondeterministic +import Complexity.Computability.Complexity.Classes.Time.SampleVerify import Complexity.Computability.Machines.Turing.MultiTape.Internal.EqualityPrimitives import Complexity.Computability.Machines.Turing.MultiTape.Internal.OCombinators import Complexity.Computability.Machines.Turing.MultiTape.Internal.ResourceFacts -import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Composition -import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.PairSampler import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ReplayInput -import Complexity.Computability.Machines.Turing.MultiTape.Run import Complexity.Probability.BitString -import Complexity.Probability.PMF.Bind /-! # Nondeterministic time through verifiers, with explicit bounds @@ -33,14 +30,12 @@ two directions here keep it. `{a | ∃ w, w.length = ℓ a ∧ V (a, w) = true}` lies in `NTIME enc t` whenever `(enc a).length + Tℓ a + T (a, w)` is within `O(t (enc a).length)` on certificates of that length. The certificate length may depend on the instance, not only on its encoded length. - The machine is the nondeterministic reading of a closed fair-coin composition: - - a deterministic machine writes `frame (enc a)` followed by `ℓ` ones; - - the fixed sampler `Turing.MultiTapePTM.pairSampler` copies the framed instance and replaces - the ones by fair coins; - - a deterministic machine runs the verifier. - - Its computation paths are exactly the coin replays, so it accepts exactly when some - certificate is accepted, and every branch halts within the composed clock. + The machine is the nondeterministic reading of the sample-and-verify machine + (`Cslib.Complexity.exists_machine_sampleVerify`), a closed fair-coin composition that writes + `frame (enc a)` followed by `ℓ` ones, replaces the ones by fair coins with the fixed sampler + `Turing.MultiTapePTM.pairSampler`, and runs the verifier. Its computation paths are exactly the + coin replays, so it accepts exactly when some certificate is accepted, and every branch halts + within the clock. * **Verifiers from nondeterministic time** (`Cslib.Complexity.exists_verifier_of_mem_NTIME`). A problem in `NTIME enc t` has a verifier that is computable in linear time on encoded pairs: check that the certificate, read as coins of the choice table @@ -81,116 +76,25 @@ theorem setOf_exists_mem_NTIME {V : α × List Bool → Bool} {ℓ : α → ℕ} (hV : ComputableInO V (encPair enc encBits) encBool T S) (ht : ∀ a w, w.length = ℓ a → (enc a).length + Tℓ a + T (a, w) ≤ C * t (enc a).length + C) : {a | ∃ w : List Bool, w.length = ℓ a ∧ V (a, w) = true} ∈ NTIME enc t := by - -- the deterministic preparation and the verifier, as machines - obtain ⟨c₁, ⟨k₁, Q₁, _, tm₁, h₁⟩, -⟩ := - (ComputableInO.of_eq (f := fun a : α => a) (encIn := enc) (encMid := enc) fun _ => rfl).prod hℓ - obtain ⟨c₃, ⟨k₃, Q₃, _, tm₃, h₃⟩, -⟩ := hV - let L (a : α) : ℕ := ℓ a - let u (a : α) : List Bool := frame (enc a) ++ List.replicate (L a) true - let t₁ (a : α) : ℕ := c₁ * ((enc a).length + Tℓ a + 1) - let t₂ (a : α) : ℕ := (u a).length + 1 - let t₃ (a : α) : ℕ := c₃ * (C * t (enc a).length + C + 1) - have hrun₁ (a : α) := (h₁ a).runFrom_of_le (le_refl (t₁ a)) - have hlen₁ (a : α) : (u a).length ≤ t₁ a := (h₁ a).length_output_le - -- the first phase writes the framed instance and the unary certificate length - let M₁ : MultiTapePTM k₁ Bool Q₁ := MultiTapePTM.ofDeterministic tm₁ - have hfirst₁ (a : α) : ∀ final ∈ (ProbComp.eval - (M₁.runClosedConfigFrom (t₁ a) (M₁.initialConfig (enc a)))).support, - final.tapes.state = none := by - intro final hfinal - rw [MultiTapePTM.eval_runClosedConfigFrom_ofDeterministic, PMF.mem_support_pure_iff] at hfinal - subst hfinal - exact (hrun₁ a).1 - have hout₁ (a : α) : ProbComp.eval (M₁.runClosed (t₁ a) (enc a)) = PMF.pure (u a) := by - rw [MultiTapePTM.eval_runClosed_ofDeterministic, (hrun₁ a).2] - rfl - -- the sampler copies the framed instance and guesses the certificate - have hsecond₁ (a : α) : ∀ word ∈ (ProbComp.eval (M₁.runClosed (t₁ a) (enc a))).support, - ∀ final ∈ (ProbComp.eval (MultiTapePTM.pairSampler.runClosedConfigFrom (t₂ a) - (MultiTapePTM.pairSampler.initialConfig word))).support, final.tapes.state = none := by - intro word hword - rw [hout₁ a, PMF.mem_support_pure_iff] at hword - subst hword - exact MultiTapePTM.pairSampler_halted (enc a) (List.replicate (L a) true) - let P₁₂ := MultiTapePTM.pairSampler.comp M₁ false - let t₁₂ (a : α) : ℕ := t₁ a + (t₁ a + 4 + t₂ a) - have heval₁₂ (a : α) : ProbComp.eval (P₁₂.runClosed (t₁₂ a) (enc a)) = - (BitString.uniformList (L a)).map (frame (enc a) ++ ·) := by - rw [MultiTapePTM.eval_comp M₁ MultiTapePTM.pairSampler false (enc a) (t₁ a) (t₂ a) - (hfirst₁ a) (hsecond₁ a), hout₁ a, Probability.PMF.monad_bind_eq_bind, PMF.pure_bind] - simpa only [List.length_replicate, u] using - MultiTapePTM.eval_pairSampler (enc a) (List.replicate (L a) true) - have hhalt₁₂ (a : α) := MultiTapePTM.comp_halted M₁ MultiTapePTM.pairSampler false (enc a) - (t₁ a) (t₂ a) (hfirst₁ a) (hsecond₁ a) - -- the verifier runs on every guessed pair within the uniform clock `t₃` - let M₃ : MultiTapePTM k₃ Bool Q₃ := MultiTapePTM.ofDeterministic tm₃ - have hrun₃ (a : α) (w : List Bool) (hw : w.length = L a) := - (h₃ (a, w)).runFrom_of_le (J := t₃ a) (Nat.mul_le_mul_left c₃ (by - have := ht a w hw - omega)) - have hword (a : α) {word : List Bool} - (hword : word ∈ (ProbComp.eval (P₁₂.runClosed (t₁₂ a) (enc a))).support) : - ∃ w : List Bool, w.length = L a ∧ word = encPair enc encBits (a, w) := by - rw [heval₁₂ a] at hword - obtain ⟨w, hw, rfl⟩ := (PMF.mem_support_map_iff _ _ _).mp hword - exact ⟨w, BitString.mem_support_uniformList_iff.mp hw, rfl⟩ - have hsecond₂ (a : α) : ∀ word ∈ (ProbComp.eval (P₁₂.runClosed (t₁₂ a) (enc a))).support, - ∀ final ∈ (ProbComp.eval (M₃.runClosedConfigFrom (t₃ a) (M₃.initialConfig word))).support, - final.tapes.state = none := by - intro word hw final hfinal - obtain ⟨w, hwlen, rfl⟩ := hword a hw - rw [MultiTapePTM.eval_runClosedConfigFrom_ofDeterministic, PMF.mem_support_pure_iff] at hfinal - subst hfinal - exact (hrun₃ a w hwlen).1 - let P := M₃.comp P₁₂ false - let total (a : α) : ℕ := t₁₂ a + (t₁₂ a + 4 + t₃ a) - -- the nondeterministic reading decides the problem - have hdec : P.toNTM.DecidesInTime enc - {a | ∃ w : List Bool, w.length = ℓ a ∧ V (a, w) = true} total := by - intro a - have htime : P.toNTM.RunsInTime (enc a) (total a) := P.runsInTime_toNTM - (MultiTapePTM.comp_halted P₁₂ M₃ false (enc a) (t₁₂ a) (t₃ a) (hhalt₁₂ a) (hsecond₂ a)) - refine ⟨htime, ?_⟩ - rw [MultiTapeNTM.accepts_iff_exists_time_eq htime, - P.exists_computationPath_toNTM_iff (P := fun cfg => cfg.output = [true])] - have hiff : (∃ final ∈ (ProbComp.eval (P.runClosedConfigFrom (total a) - (P.initialConfig (enc a)))).support, final.tapes.output = [true]) ↔ - [true] ∈ (ProbComp.eval (P.runClosed (total a) (enc a))).support := by - rw [MultiTapePTM.runClosed_eq_map, ProbComp.eval_map, PMF.mem_support_map_iff] - rw [hiff, MultiTapePTM.eval_comp P₁₂ M₃ false (enc a) (t₁₂ a) (t₃ a) (hhalt₁₂ a) - (hsecond₂ a), Probability.PMF.monad_bind_eq_bind, PMF.mem_support_bind_iff] - constructor - · rintro ⟨w, hw, hV⟩ - refine ⟨encPair enc encBits (a, w), ?_, ?_⟩ - · rw [heval₁₂ a] - exact (PMF.mem_support_map_iff _ _ _).mpr - ⟨w, BitString.mem_support_uniformList_iff.mpr hw, rfl⟩ - · rw [MultiTapePTM.eval_runClosed_ofDeterministic, (hrun₃ a w hw).2, PMF.mem_support_pure_iff] - simp [hV] - · rintro ⟨word, hw, hacc⟩ - obtain ⟨w, hwlen, rfl⟩ := hword a hw - rw [MultiTapePTM.eval_runClosed_ofDeterministic, (hrun₃ a w hwlen).2, - PMF.mem_support_pure_iff] at hacc - exact ⟨w, hwlen, by simpa using hacc⟩ - -- the composed clock is within `O(t)` - refine ⟨(6 * c₁ + c₃) * C, (6 * c₁ + c₃) * (C + 1) + 14, _, _, inferInstance, P.toNTM, - hdec.mono fun a => ?_⟩ - set X := C * t (enc a).length + C + 1 - have hX₁ : t₁ a ≤ c₁ * X := Nat.mul_le_mul_left c₁ (by - have := ht a (List.replicate (L a) false) (List.length_replicate ..) - omega) - have htotal : total a ≤ 6 * t₁ a + 14 + t₃ a := by - have := hlen₁ a - simp only [total, t₁₂, t₂] - omega - have hX₃ : t₃ a = c₃ * X := rfl - calc total a ≤ 6 * (c₁ * X) + 14 + c₃ * X := by - have := Nat.mul_le_mul_left 6 hX₁ - rw [hX₃] at htotal - omega - _ = (6 * c₁ + c₃) * C * t (enc a).length + ((6 * c₁ + c₃) * (C + 1) + 14) := by - simp only [X] - ring + obtain ⟨c₁, c₂, k, State, hfinite, machine, hmachine⟩ := exists_machine_sampleVerify hℓ hV ht + refine ⟨c₁, c₂, k, State, hfinite, machine.toNTM, fun a => ?_⟩ + -- the nondeterministic reading accepts exactly when some sampled string is accepted + have htime : machine.toNTM.RunsInTime (enc a) (c₁ * t (enc a).length + c₂) := + machine.runsInTime_toNTM (hmachine a).1 + refine ⟨htime, ?_⟩ + rw [MultiTapeNTM.accepts_iff_exists_time_eq htime, + machine.exists_computationPath_toNTM_iff (P := fun cfg => cfg.output = [true])] + set T := c₁ * t (enc a).length + c₂ + have hiff : (∃ final ∈ (ProbComp.eval (machine.runClosedConfigFrom T + (machine.initialConfig (enc a)))).support, final.tapes.output = [true]) ↔ + [true] ∈ (ProbComp.eval (machine.runClosed T (enc a))).support := by + rw [MultiTapePTM.runClosed_eq_map, ProbComp.eval_map, PMF.mem_support_map_iff] + rw [hiff, (hmachine a).2, PMF.mem_support_map_iff] + constructor + · rintro ⟨w, hw, hVw⟩ + exact ⟨w, BitString.mem_support_uniformList_iff.mpr hw, by rw [hVw]⟩ + · rintro ⟨w, hw, hVw⟩ + exact ⟨w, BitString.mem_support_uniformList_iff.mp hw, by simpa using hVw⟩ /-- **A linear-time verifier for nondeterministic time.** A problem in `NTIME enc t` has a verifier computable in linear time on encoded pairs. For a constant `c`, every certificate length diff --git a/Complexity/Foundations/Analysis/ENNRealFraction.lean b/Complexity/Foundations/Analysis/ENNRealFraction.lean new file mode 100644 index 0000000000..2bbc1e3cc7 --- /dev/null +++ b/Complexity/Foundations/Analysis/ENNRealFraction.lean @@ -0,0 +1,50 @@ +/- +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.Basic.ENNReal.Inv + +/-! +# Dyadic fractions in `ℝ≥0∞` + +A count `c` out of `2 ^ n` equally likely strings is a probability `c / 2 ^ n`. Bounded-error +acceptance thresholds compare it with `2 / 3`; this file turns that comparison into one between +natural numbers. + +## Main results + +* `ENNReal.two_div_three_le_natCast_div_two_pow_iff`: `2 / 3 ≤ c / 2 ^ n ↔ 2 * 2 ^ n ≤ 3 * c`. +-/ + +@[expose] public section + +open scoped ENNReal + +namespace ENNReal + +/-- A dyadic fraction `c / 2 ^ n` is at least two thirds exactly when `2 * 2 ^ n ≤ 3 * c`. -/ +theorem two_div_three_le_natCast_div_two_pow_iff {c n : ℕ} : + (2 / 3 : ℝ≥0∞) ≤ c / 2 ^ n ↔ 2 * 2 ^ n ≤ 3 * c := by + rw [ENNReal.le_div_iff_mul_le (Or.inl (pow_ne_zero _ two_ne_zero)) + (Or.inl (ENNReal.pow_ne_top ENNReal.ofNat_ne_top)), div_eq_mul_inv, mul_right_comm, + ← div_eq_mul_inv, ENNReal.div_le_iff (by norm_num) (by norm_num)] + constructor + · intro h + have : ((2 * 2 ^ n : ℕ) : ℝ≥0∞) ≤ ((3 * c : ℕ) : ℝ≥0∞) := by + push_cast + rw [mul_comm (3 : ℝ≥0∞)] + exact h + exact_mod_cast this + · intro h + have : ((2 * 2 ^ n : ℕ) : ℝ≥0∞) ≤ ((3 * c : ℕ) : ℝ≥0∞) := by exact_mod_cast h + push_cast at this + rw [mul_comm (c : ℝ≥0∞)] + exact this + +end ENNReal diff --git a/ComplexityTests/PromiseBPTIME.lean b/ComplexityTests/PromiseBPTIME.lean new file mode 100644 index 0000000000..533d6fc758 --- /dev/null +++ b/ComplexityTests/PromiseBPTIME.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module + +public import Complexity.Computability.Complexity.Classes.Promise.Time.Verifier +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.Quantitative +import Complexity.Computability.Machines.Turing.MultiTape.Internal.OCombinators + +/-! The explicit-time verifier characterization of `PromiseBPTIME` on concrete bounds. A +deterministic linear-time decider is a sample-and-verify machine with no coins, so it solves every +promise problem it separates, and its problem is in `BPTIME`. A promise problem in linear time +survives the round trip through its linear-time coin-replay verifier and sample and verify, at the +same linear bound, so both explicit-time hypotheses are satisfiable together. -/ + +public section + +namespace ComplexityTests.PromiseBPTIME + +open Cslib Cslib.Complexity Turing Turing.MultiTapeTM + +/-- `c * n + c` in unary, within linear time and space. -/ +private theorem computableInO_linear_unary (c : ℕ) : + ComputableInO (fun x : List Bool => c * x.length + c) encBits encUnary + (fun x => x.length) (fun x => x.length) := by + induction c with + | zero => + simpa using ComputableInO.const (encIn := encBits) (encMid := encUnary) 0 + | succ c ih => + have hstep := ComputableInO.lengthUnary.append + (ComputableInO.const (encIn := encBits) (encMid := encUnary) 1) + (g := fun x : List Bool => x.length + 1) (encOut := encUnary) + fun x => by simp [encUnary_apply, List.replicate_add] + have h := ih.append hstep (g := fun x : List Bool => (c + 1) * x.length + (c + 1)) + (encOut := encUnary) fun x => by + simp only [encUnary_apply, ← List.replicate_add] + congr 1 + ring + exact h.mono 3 (fun x => by simp only [encBits_apply]; omega) + (fun x => by simp only [encBits_apply]; omega) + +/-- **A deterministic linear-time decider, with no coins.** Every promise problem separated by a +problem in `DTIME n` is in `PromiseBPTIME n`. -/ +theorem mem_PromiseBPTIME_of_mem_DTIME {A : Set (List Bool)} {Q : PromiseProblem (List Bool)} + (hA : A ∈ DTIME encBits fun n => n) (hyes : Q.yes ⊆ A) (hno : Q.no ⊆ Aᶜ) : + Q ∈ PromiseBPTIME encBits fun n => n := by + have hV := (computableInO_indicator_of_mem_DTIME hA).comp (ComputableInO.fst encBits encBits) + refine mem_PromiseBPTIME_of_verifier (ℓ := fun _ => 0) (t := fun n => n) (C := 6) + (ComputableInO.const (encIn := encBits) (encMid := encUnary) 0) hV (fun x w hw => ?_) + (fun x hx => ?_) fun x hx => ?_ + · simp only [List.length_eq_zero_iff] at hw + subst hw + simp only [encBits_apply, encPair_apply, List.length_append, length_frame, List.length_nil] + omega + · simp [acceptCount_zero, indicator, hyes hx] + · simp [acceptCount_zero, indicator, show x ∉ A from hno hx] + +/-- Through the bridge with `BPTIME`, a problem in `DTIME n` is in `BPTIME n`. -/ +example {A : Set (List Bool)} (hA : A ∈ DTIME encBits fun n => n) : + A ∈ BPTIME encBits fun n => n := + ofSet_mem_PromiseBPTIME.mp + (mem_PromiseBPTIME_of_mem_DTIME hA le_rfl fun _ h => h) + +/-- The promise problem with every word a yes-instance, solved by sampling no coins and +accepting: a concrete member of `PromiseBPTIME n`. -/ +example : (⟨Set.univ, ∅, Set.disjoint_empty _⟩ : PromiseProblem (List Bool)) ∈ + PromiseBPTIME encBits fun n => n := by + refine mem_PromiseBPTIME_of_verifier (V := fun _ => true) (ℓ := fun _ => 0) (t := fun n => n) + (C := 4) (ComputableInO.const (encIn := encBits) (encMid := encUnary) 0) + (ComputableInO.const (encIn := encPair encBits encBits) (encMid := encBool) true) + (fun x w hw => ?_) (fun x _ => by simp) fun x hx => absurd hx (Set.notMem_empty x) + simp only [List.length_eq_zero_iff] at hw + subst hw + simp only [encBits_apply, encPair_apply, List.length_append, length_frame, List.length_nil] + omega + +/-- **Round trip at linear time.** A promise problem in linear time has a linear-time coin-replay +verifier, and sampling strings of length `c * n + c` for it solves the problem in linear time +again. Both explicit-time hypotheses are satisfiable together. -/ +theorem mem_PromiseBPTIME_linear_of_verifier_roundTrip {Q : PromiseProblem (List Bool)} + (hQ : Q ∈ PromiseBPTIME encBits fun n => n) : Q ∈ PromiseBPTIME encBits fun n => n := by + obtain ⟨V, c, hV, hbound⟩ := exists_verifier_of_mem_PromiseBPTIME hQ + exact mem_PromiseBPTIME_of_verifier (ℓ := fun x : List Bool => c * x.length + c) + (t := fun n => n) (C := c + 4) (computableInO_linear_unary c) hV + (fun x w hw => by + simp only [encBits_apply, encPair_apply, List.length_append, length_frame, hw] + nlinarith) + (fun x hx => (hbound x _ (by simp [encBits_apply])).1 hx) + fun x hx => (hbound x _ (by simp [encBits_apply])).2 hx + +/-- The lift of `BPTIME` is contained in `PromiseBPTIME`, at a concrete bound. -/ +example : promiseClass (BPTIME encBits fun n => n) ⊆ PromiseBPTIME encBits fun n => n := + promiseClass_BPTIME_subset_PromiseBPTIME + +end ComplexityTests.PromiseBPTIME diff --git a/ROADMAP.md b/ROADMAP.md index 27aa9fa94b..76c97cd017 100644 --- a/ROADMAP.md +++ b/ROADMAP.md @@ -185,6 +185,12 @@ index links to canonical definitions rather than keeping a second set. machine's own steps, noninteger polynomial degrees, a word-RAM hierarchy by direct diagonalization with a smaller gap, and sharp nondeterministic and alternating time hierarchies with certified simulators. +- **Probabilistic time hierarchies** ([#2084]): the hierarchy for promise problems + (`PromiseBPTIME`), by delayed diagonalization following He (ECCC TR25-004), and the + one-bit-advice hierarchy for languages of van Melkebeek and Pervyshev. `PromiseBPTIME` and its + explicit-time sample-and-verify characterization are in place (`Classes/Promise/Time` and + `Classes/Promise/Time/Verifier`). The advice-free hierarchy for `BPTIME` itself is open and is + not a target. - The space hierarchy for `log n ≤ g n`, which needs a universal simulation that does not hold its input. - **Space:** Savitch bounds for general space-constructible functions. @@ -799,3 +805,4 @@ not planned, not as proved. [#2127]: https://github.com/cslib-community/complexitylib/issues/2127 [#2145]: https://github.com/cslib-community/complexitylib/issues/2145 [#2146]: https://github.com/cslib-community/complexitylib/issues/2146 +[#2084]: https://github.com/cslib-community/complexitylib/issues/2084 diff --git a/references.bib b/references.bib index 0b4758dbf6..a940707f2c 100644 --- a/references.bib +++ b/references.bib @@ -2429,6 +2429,15 @@ @article{Haussler1992 doi = {10.1016/0890-5401(92)90010-D} } +@techreport{He2025, + author = {He, Songhua}, + title = {A note on a hierarchy theorem for promise-{BPTIME}}, + institution = {Electronic Colloquium on Computational Complexity}, + number = {TR25-004}, + year = {2025}, + url = {https://eccc.weizmann.ac.il/report/2025/004/} +} + @inproceedings{HemaspaandraEtAl2018, author = {Hemaspaandra, Edith and Hemaspaandra, Lane A. and Spakowski, Holger and Watanabe, Osamu}, From 8926efbca03993a4fecfe25c838774dfbc5d3eca Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Mon, 2 Nov 2026 04:18:18 +0000 Subject: [PATCH 4/6] feat(DataStructure): Fibonacci heap over a record, part 2 (decreaseKey with cascading cuts) (#2233) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * 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 * doc(bib): add Guéneau, Charguéraud and Pottier (ESOP 2018) Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * 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 * 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 * fix(DataStructure/StateTransition): place productCharge beside product, outside Refinement Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * 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 * wip: array stack over memory and queue method lemmas Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * feat(Foundations): affine cost bounds are O(size) Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * wip: queue over memory Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * 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 * 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 * feat(DataStructure): Fibonacci heap insert over a record of named cells Add Record.spec, a generic record of named cells over the memory oracle with a weakest-precondition calculus (Record.wp) and a one-unit-per-operation refinement into Memory.spec. Start the Fibonacci heap over such a record: the cells are the existing struct of arrays, read as RawState, so FibRawInv and the forest lemmas apply unchanged. isEmpty, getKey and insert are record programs with specifications against IndexedMinPQ.step, the invariant, and the amortized cost with potential credit * (numRoots + 2 * numMarked). Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * feat(DataStructure): Fibonacci heap decreaseKey with cascading cuts over a record decreaseKey cuts v from its parent when heap order breaks, cascades up the marked ancestors (fuel bounded by the number of marks), then stores the key and updates the minimum root. Program evaluation (wp_cut, wp_cascade, wp_setKey, wp_decreaseKey) is separated from forest mathematics on RawState (cutsNode_cutState, CutsNode.cascading, Cascading.mark, ...), which reuses ValidSubtree.exists_cut, mark_pending, lower_key_no_cut and CutInv.to_fibRawInv unchanged. Amortized cost: 104 record operations. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * fix(DataStructure): credit Renfei Zhou in the record Fibonacci heap; test records and insert Retain the original authorship of the native WordRAM Fibonacci heap that Basic.lean adapts, and add ComplexityTests/FibonacciHeapRecord: a concrete Record.Layout with a program run through Record.wp and Record.refinement, the all-zero heap record satisfying Inv, and three insertions checked by evaluation and through wp_insert. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * fix(DataStructure): credit Renfei Zhou in the record decreaseKey; test a cut and cascading cut Retain the original authorship of the native Cut.lean development that DecreaseKey.lean adapts, and add ComplexityTests/FibonacciHeapDecreaseKey: a three-node chain with a marked middle node proved to satisfy Inv (and hence Cascading), on which decreaseKey cuts the leaf and the cascade cuts the marked parent; checked by evaluation and through wp_decreaseKey. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * fix(DataStructure): name the adapted module without a slash path Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --------- Co-authored-by: Claude Opus 5.5 --- Complexity.lean | 1 + .../FibonacciHeap/DecreaseKey.lean | 960 ++++++++++++++++++ ComplexityTests/FibonacciHeapDecreaseKey.lean | 109 ++ 3 files changed, 1070 insertions(+) create mode 100644 Complexity/DataStructure/PriorityQueue/FibonacciHeap/DecreaseKey.lean create mode 100644 ComplexityTests/FibonacciHeapDecreaseKey.lean diff --git a/Complexity.lean b/Complexity.lean index 8057ce14bf..e6a7aa722f 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -2972,6 +2972,7 @@ 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.FibonacciHeap.Basic +public import Complexity.DataStructure.PriorityQueue.FibonacciHeap.DecreaseKey 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/PriorityQueue/FibonacciHeap/DecreaseKey.lean b/Complexity/DataStructure/PriorityQueue/FibonacciHeap/DecreaseKey.lean new file mode 100644 index 0000000000..2bf7a342ac --- /dev/null +++ b/Complexity/DataStructure/PriorityQueue/FibonacciHeap/DecreaseKey.lean @@ -0,0 +1,960 @@ +/- +Copyright (c) 2026 Renfei Zhou, Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Renfei Zhou, Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.DataStructure.PriorityQueue.FibonacciHeap.Basic + +/-! +# Fibonacci-heap `decreaseKey` over a record of named cells + +`decreaseKey n v k` lowers the key of `v`. If `v` would precede its parent, `cut` moves `v` to the +root list, and `cascade` walks up the ancestors: a marked ancestor is cut in turn, the first +unmarked one is marked [Fredman and Tarjan][FredmanTarjan1987] +[Cormen et al., Section 19.3][CLRS2009]. Then `setKey` stores the key and makes `v` the minimum +root if it precedes it. Cutting before storing the key keeps every tree valid throughout, so no +pre-decrease copy of the state is needed, unlike the hand-stepped `cutNode_forest`. + +The proof splits as in `Basic.lean`: + +* program evaluation: `wp_unlink`, `wp_toRoot` and `wp_cut` produce the effect `CutsNode` of one + cut on the raw view (the facts of the hand-stepped `cutNodeCode_raw`); `wp_cascade` runs the + cascade by induction on its fuel, which exceeds the number of marks; `wp_setKey` and + `wp_decreaseKey` assemble the three cases (root, no cut, cut); +* forest mathematics on `RawState n` alone: `cutsNode_cutState` (pointer surgery of one cut), + `CutsNode.cascading` (a cut keeps the forest `Cascading`, the content of `cutNode_forest`), + `Cascading.clear_root` and `Cascading.mark` (the cascade stops), `Cascading.lowerRootKey` and + `FibRawInv.lowerKey_noCut` (storing the key), with the existing `ValidSubtree.exists_cut`, + `ValidSubtree.mark_pending`, `ValidSubtree.lower_key_no_cut` and `CutInv.to_fibRawInv`. + +Each cascading cut costs at most `22` record operations and turns a marked non-root into an +unmarked root, which releases `credit = 24`, so the cascade is paid by the potential and +`decreaseKey` costs at most `104` operations amortized. + +The module adapts Renfei Zhou's native formalization (`WordRAM/FibonacciHeap`, its `Cut.lean`) to +the record level: his cut (`cutNodeCode_raw`, `cutNode_forest`, with its circular-list uniqueness +argument) and cascading-cut development become `cut`, `CutsNode.cascading`, +`IsCircList.tail_unique` and `cascade`, and his forest lemmas are reused unchanged. + +## Main definitions + +* `unlink`, `toRoot`, `cut`, `cascade`, `setKey`, `decreaseKey`: record programs. +* `CutsNode`, `cutState`: the effect of one cut on the raw view. +* `Cascading`: the forest during cascading cuts, with one pending ancestor. + +## Main results + +* `IsCircList.tail_unique`: a circular list is determined by its head. +* `wp_cut`: a cut evaluates to `CutsNode` in at most `20` operations. +* `CutsNode.cascading`: a cut keeps the forest `Cascading`, with the parent pending. +* `wp_cascade`: the cascade costs at most `53` operations plus the potential it releases. +* `wp_decreaseKey`: `decreaseKey` implements `IndexedMinPQ.step` with amortized cost `104`. + +## References + +* [M. L. Fredman and R. E. Tarjan, *Fibonacci Heaps and Their Uses in Improved Network Optimization + Algorithms*][FredmanTarjan1987] +* [T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein, *Introduction to Algorithms*, + Section 19.3][CLRS2009] +-/ + +@[expose] public section + +namespace Cslib.DataStructure.PriorityQueue.FibonacciHeap + +open Cslib.WordRAM Cslib.DataStructure Cslib.DataStructure.PriorityQueue +open Cslib.DataStructure.PriorityQueue.WordRAM.FibonacciHeap + +/-! ## Programs -/ + +/-- Unlink `z` from the child list of its parent `p`. -/ +def unlink (z p : ℕ) : Prog Unit := do + let d ← rd (.deg p) + wr (.deg p) (d - 1) + if d - 1 = 0 then + wr (.child p) 0 + else + let r ← rd (.right z) + let l ← rd (.left z) + wr (.left r) l + wr (.right l) r + wr (.child p) (r + 1) + +/-- Make the unlinked node `z` an unmarked root after the minimum root. -/ +def toRoot (z : ℕ) : Prog Unit := do + let m ← rd .minRoot + spliceAfter (m - 1) z + wr (.par z) 0 + let mk ← rd (.mark z) + wr (.mark z) 0 + let c ← rd .numMarked + wr .numMarked (c - mk) + let nr ← rd .numRoots + wr .numRoots (nr + 1) + +/-- Cut `z` from its parent `p`: unlink `z` from `p`'s child list, splice it into the root list +after the minimum root, and clear its parent and mark. -/ +def cut (z p : ℕ) : Prog Unit := do + unlink z p + toRoot z + +/-- Cascading cuts from `z`, which has just lost a child, with at most `fuel` cuts: stop at a +root; mark an unmarked node and stop; cut a marked node and continue with its parent. -/ +def cascade : ℕ → ℕ → Prog Unit + | 0, _ => pure () + | fuel + 1, z => do + let pz ← rd (.par z) + if pz = 0 then pure () + else + let mk ← rd (.mark z) + if mk = 0 then + wr (.mark z) 1 + let c ← rd .numMarked + wr .numMarked (c + 1) + else + cut z (pz - 1) + cascade fuel (pz - 1) + +/-- Store the lowered key `k` of `v`, and make `v` the minimum root if it precedes it. -/ +def setKey (v k : ℕ) : Prog Unit := do + wr (.key v) k + let m ← rd .minRoot + let km ← rd (.key (m - 1)) + if IndexedMinPQ.RawPrioLT (v, k) (m - 1, km) then wr .minRoot (v + 1) + +/-- Lower the key of `v` to `k` on a heap of `n` handles: if `v` now precedes its parent, cut it +and cascade from the parent; then store the key and update the minimum root. -/ +def decreaseKey (n v k : ℕ) : Prog Unit := do + let pv ← rd (.par v) + if pv ≠ 0 then + let kp ← rd (.key (pv - 1)) + if IndexedMinPQ.RawPrioLT (v, k) (pv - 1, kp) then + cut v (pv - 1) + cascade (n + 1) (pv - 1) + setKey v k + +/-- The effect of cutting `cur` from its parent `p` when the root list is `m :: rtail`: the facts +of the hand-stepped `cutNodeCode_raw`, on the raw view. -/ +structure CutsNode {n : ℕ} (st : RawState n) (cur p m : Fin n) (rtail : List (Fin n)) + (st' : RawState n) : Prop where + key : st'.key = st.key + inHeap : st'.inHeap = st.inHeap + cons : st'.cons = st.cons + minRoot : st'.minRoot = st.minRoot + sz : st'.sz = st.sz + numRoots : st'.numRoots = st.numRoots + 1 + numMarked : st'.numMarked = st.numMarked - st.mark cur + mark_cur : st'.mark cur = 0 + mark_ne : ∀ u, u ≠ cur → st'.mark u = st.mark u + deg_p : st'.deg p + 1 = st.deg p + deg_ne : ∀ u, u ≠ p → st'.deg u = st.deg u + par_cur : st'.par cur = 0 + par_ne : ∀ u, u ≠ cur → st'.par u = st.par u + child_ne : ∀ u, u ≠ p → st'.child u = st.child u + child_one : st.deg p = 1 → st'.child p = 0 + child_two : ∀ (h : Fin n) (tail : List (Fin n)), 2 ≤ st.deg p → st.child p = h.val + 1 → + IsCircList st.left st.right (h :: tail) → cur ∈ h :: tail → + ∃ (r : Fin n) (rest : List (Fin n)), st'.child p = r.val + 1 ∧ + IsCircList st'.left st'.right (r :: rest) ∧ (r :: rest).Perm ((h :: tail).erase cur) + roots : IsCircList st'.left st'.right (m :: cur :: rtail) + lr_ne : ∀ u, st.par u ≠ p.val + 1 → st.par u ≠ 0 → + st'.left u = st.left u ∧ st'.right u = st.right u + +/-- The state after a cut, given the sibling pointers `left₁`, `right₁` and `p`'s child pointer +`child₁` after unlinking `cur`, and the old right neighbour `r'` of the minimum root `m`. -/ +def cutState {n : ℕ} (st : RawState n) (cur p m r' : Fin n) (left₁ right₁ : Fin n → ℕ) + (child₁ : ℕ) : RawState n := + { st with + deg := Function.update st.deg p (st.deg p - 1) + child := Function.update st.child p child₁ + left := Function.update (Function.update left₁ cur m.val) r' cur.val + right := Function.update (Function.update right₁ cur r'.val) m cur.val + par := Function.update st.par cur 0 + mark := Function.update st.mark cur 0 + numMarked := st.numMarked - st.mark cur + numRoots := st.numRoots + 1 } + +/-- A circular list is determined by its head: from `first`, the `right` pointers trace it. -/ +theorem ChainLinks.tail_unique {n : ℕ} {left right : Fin n → ℕ} {first : Fin n} : + ∀ {prev : Fin n} {t₁ t₂ : List (Fin n)}, (first :: t₁).Nodup → (first :: t₂).Nodup → + ChainLinks left right first prev t₁ → ChainLinks left right first prev t₂ → t₁ = t₂ + | _, [], [], _, _, _, _ => rfl + | _, [], b :: _, _, hnd₂, hc₁, hc₂ => by + have : b = first := Fin.ext (hc₂.1.symm.trans hc₁.1) + subst this + exact absurd List.mem_cons_self (List.nodup_cons.mp hnd₂).1 + | _, a :: _, [], hnd₁, _, hc₁, hc₂ => by + have : a = first := Fin.ext (hc₁.1.symm.trans hc₂.1) + subst this + exact absurd List.mem_cons_self (List.nodup_cons.mp hnd₁).1 + | _, a :: t₁, b :: t₂, hnd₁, hnd₂, hc₁, hc₂ => by + have : a = b := Fin.ext (hc₁.1.symm.trans hc₂.1) + subst this + have sub : ∀ {t : List (Fin n)}, (first :: a :: t).Nodup → (first :: t).Nodup := fun h => + List.nodup_cons.mpr ⟨fun hm => (List.nodup_cons.mp h).1 (List.mem_cons_of_mem a hm), + (List.nodup_cons.mp (List.nodup_cons.mp h).2).2⟩ + rw [ChainLinks.tail_unique (sub hnd₁) (sub hnd₂) hc₁.2.2 hc₂.2.2] + +/-- A circular list is determined by its head. -/ +theorem IsCircList.tail_unique {n : ℕ} {left right : Fin n → ℕ} {h : Fin n} + {t₁ t₂ : List (Fin n)} (h₁ : IsCircList left right (h :: t₁)) + (h₂ : IsCircList left right (h :: t₂)) : t₁ = t₂ := + ChainLinks.tail_unique h₁.1 h₂.1 h₁.2 h₂.2 + +/-- **The effect of a cut**, from `p`'s child pointer and the sibling pointers after unlinking +`cur` (`hunlink`) and the old right neighbour `r'` of the minimum root `m`. -/ +theorem cutsNode_cutState {n : ℕ} {st : RawState n} {cur p m : Fin n} {rtail : List (Fin n)} + (hdp_pos : 1 ≤ st.deg p) + (hdp2 : 2 ≤ st.deg p → ∃ (h : Fin n) (tail : List (Fin n)), + st.child p = h.val + 1 ∧ IsCircList st.left st.right (h :: tail) ∧ + cur ∈ h :: tail ∧ 2 ≤ (h :: tail).length ∧ ∀ u ∈ h :: tail, st.par u = p.val + 1) + (hcirc_r : IsCircList st.left st.right (m :: rtail)) + (hroots_par0 : ∀ u ∈ m :: rtail, st.par u = 0) (hpar_cur : st.par cur = p.val + 1) + {left₁ right₁ : Fin n → ℕ} {child₁ : ℕ} + (hunlink : (st.deg p = 1 ∧ child₁ = 0 ∧ left₁ = st.left ∧ right₁ = st.right) ∨ + (2 ≤ st.deg p ∧ ∃ r l : Fin n, st.right cur = r.val ∧ st.left cur = l.val ∧ + child₁ = r.val + 1 ∧ left₁ = Function.update st.left r l.val ∧ + right₁ = Function.update st.right l r.val)) + {r' : Fin n} (hr' : right₁ m = r'.val) : + CutsNode st cur p m rtail (cutState st cur p m r' left₁ right₁ child₁) := by + -- Roots have parent `0`, children of `p` have parent `p + 1`. + have hroot_ne : ∀ u ∈ m :: rtail, ∀ x, st.par x = p.val + 1 → x ≠ u := fun u hu x hx e => by + rw [e, hroots_par0 u hu] at hx; omega + have hcur_roots : cur ∉ m :: rtail := fun hc => hroot_ne cur hc cur hpar_cur rfl + -- In both cases, the unlinked pointers agree with the old ones at the roots, and at every node + -- whose parent is not `p`. + have hframe₁ : ∀ x, st.par x ≠ p.val + 1 → left₁ x = st.left x ∧ right₁ x = st.right x := by + rcases hunlink with ⟨_, _, rfl, rfl⟩ | ⟨h2, r, l, hr, hl, _, rfl, rfl⟩ + · exact fun _ _ => ⟨rfl, rfl⟩ + · obtain ⟨h, tail, _, hcirc, hcur, hlen, hpar⟩ := hdp2 h2 + obtain ⟨r₂, l₂, _, hr₂, hl₂, hr₂m, hl₂m, -⟩ := hcirc.remove hcur hlen + obtain rfl : r₂ = r := Fin.ext (hr₂.symm.trans hr) + obtain rfl : l₂ = l := Fin.ext (hl₂.symm.trans hl) + intro x hx + have hxr : x ≠ r₂ := fun e => hx (e ▸ hpar r₂ hr₂m) + have hxl : x ≠ l₂ := fun e => hx (e ▸ hpar l₂ hl₂m) + simp [Function.update_of_ne hxr, Function.update_of_ne hxl] + have hcirc₁ : IsCircList left₁ right₁ (m :: rtail) := + hcirc_r.frame fun x hx => hframe₁ x fun e => hroot_ne x hx x e rfl + have hr'_roots : r' ∈ m :: rtail := by + obtain ⟨r'', hr'', hmem⟩ := hcirc₁.right_head + exact (Fin.ext (hr''.symm.trans hr') : r'' = r') ▸ hmem + have hroots' := hcirc₁.insertAfter hcur_roots hr' + -- Nodes off the root list and off `p`'s children keep their sibling pointers. + have hframe : ∀ x, st.par x ≠ p.val + 1 → st.par x ≠ 0 → + (cutState st cur p m r' left₁ right₁ child₁).left x = st.left x ∧ + (cutState st cur p m r' left₁ right₁ child₁).right x = st.right x := fun x hx hx0 => by + have hxc : x ≠ cur := fun e => hx (e ▸ hpar_cur) + have hxm : x ≠ m := fun e => hx0 (e ▸ hroots_par0 m List.mem_cons_self) + have hxr : x ≠ r' := fun e => hx0 (e ▸ hroots_par0 r' hr'_roots) + simpa [cutState, Function.update_of_ne hxc, Function.update_of_ne hxm, + Function.update_of_ne hxr] using hframe₁ x hx + refine ⟨rfl, rfl, rfl, rfl, rfl, rfl, rfl, by simp [cutState], + fun u hu => by simp [cutState, hu], by simp [cutState]; omega, + fun u hu => by simp [cutState, hu], by simp [cutState], fun u hu => by simp [cutState, hu], + fun u hu => by simp [cutState, hu], fun h1 => ?_, ?_, hroots', hframe⟩ + · rcases hunlink with ⟨_, rfl, _⟩ | ⟨h2, _⟩ + · simp [cutState] + · omega + · intro h tail h2 hcp hcirc hcur + rcases hunlink with ⟨h1, _⟩ | ⟨-, r, l, hr, hl, rfl, rfl, rfl⟩ + · omega + obtain ⟨h₀, tail₀, hcp₀, hcirc₀, -, hlen₀, hpar₀⟩ := hdp2 h2 + obtain rfl : h₀ = h := Fin.ext (by omega) + obtain rfl := IsCircList.tail_unique hcirc hcirc₀ + obtain ⟨r₂, l₂, rest, hr₂, hl₂, -, -, -, hcirc₂, hperm₂⟩ := hcirc.remove hcur hlen₀ + obtain rfl : r₂ = r := Fin.ext (hr₂.symm.trans hr) + obtain rfl : l₂ = l := Fin.ext (hl₂.symm.trans hl) + refine ⟨r₂, rest, by simp [cutState], hcirc₂.frame fun x hx => ?_, hperm₂⟩ + have hx_er := hperm₂.subset hx + have hxc : x ≠ cur := fun e => by subst e; exact hcirc.1.not_mem_erase hx_er + have hpx := hpar₀ x (List.mem_of_mem_erase hx_er) + simp [cutState, Function.update_of_ne hxc, + Function.update_of_ne (hroot_ne m List.mem_cons_self x hpx), + Function.update_of_ne (hroot_ne r' hr'_roots x hpx)] + +/-! ## Forest mathematics of cascading cuts -/ + +/-- The forest during cascading cuts from `v`: `FibRawInv` with one `pending` ancestor that may +have lost a child, and with the minimum-root comparison waived for `v`. With `v` a root, this is +the existing `CutInv`. -/ +structure Cascading (n K : ℕ) (s : IndexedMinPQ.State n) (st : RawState n) (v m : Fin n) + (pending : Option (Fin n)) (ts : List (FHTree n)) : Prop where + valid : ∀ T ∈ ts, ValidRoot st pending T + nodup : (forestNodes ts).Nodup + dom : ∀ u, u ∈ forestNodes ts ↔ (s u).isSome + inHeap : ∀ u, (st.inHeap u ≠ 0 ↔ (s u).isSome) ∧ st.inHeap u ≤ 1 + keys : ∀ u ku, s u = some ku → st.key u = ku ∧ ku ≤ K + sz : st.sz = (IndexedMinPQ.dom s).card + numRoots : st.numRoots = ts.length + numMarked : st.numMarked = markedCount st + cons : ∀ d ≤ n, st.cons d = 0 + minRoot : st.minRoot = m.val + 1 + roots : ∃ rtail, IsCircList st.left st.right (m :: rtail) ∧ (m :: rtail).Perm (ts.map FHTree.root) + min_le : ∀ T ∈ ts, T.root ≠ v → IndexedMinPQ.PrioLE (m, st.key m) (T.root, st.key T.root) + +/-- With `v` a root, `Cascading` is the existing `CutInv`. -/ +theorem Cascading.cutInv {n K : ℕ} {s : IndexedMinPQ.State n} {st : RawState n} {v m : Fin n} + {pending : Option (Fin n)} {ts : List (FHTree n)} (h : Cascading n K s st v m pending ts) + (hv : ∃ T ∈ ts, T.root = v) : CutInv n K s st v m pending := by + obtain ⟨rtail, hcirc, hperm⟩ := h.roots + exact ⟨ts, h.valid, h.nodup, h.dom, h.inHeap, h.keys, h.sz, h.numRoots, h.numMarked, h.cons, + ⟨rtail, h.minRoot, hcirc, hperm⟩, hv, h.min_le⟩ + +/-- A valid heap is `Cascading` with nothing pending. -/ +theorem cascading_of_fibRawInv {n K : ℕ} {s : IndexedMinPQ.State n} {st : RawState n} {v : Fin n} + (h : FibRawInv n K s st) (hv : (s v).isSome) : + ∃ m ts, Cascading n K s st v m none ts := by + obtain ⟨ts, hts, hnd, hdom, hin, hkeys, hsz, hnr, hnm, hcons, hrl⟩ := h + rcases hrl with ⟨rfl, _⟩ | ⟨m, rtail, hm, hcirc, hperm, hle⟩ + · exact absurd ((hdom v).mpr hv) List.not_mem_nil + · exact ⟨m, ts, ⟨hts, hnd, hdom, hin, hkeys, hsz, hnr, hnm, hcons, hm, ⟨rtail, hcirc, hperm⟩, + fun T hT _ => hle T hT⟩⟩ + +/-- In a valid subtree with distinct nodes, every node has fewer children than the tree has +nodes. -/ +theorem ValidSubtree.deg_lt_length {n : ℕ} {st : RawState n} {pending : Option (Fin n)} + {T : FHTree n} (hT : ValidSubtree st pending T) (hnd : T.nodes.Nodup) {x : Fin n} + (hx : x ∈ T.nodes) : st.deg x < T.nodes.length := by + induction hT with + | @mk u cs _ _ hdeg _ _ _ _ _ ih => + have hlen : (FHTree.node u cs).nodes.length = (forestNodes cs).length + 1 := by + simp [FHTree.nodes] + rw [hlen] + rcases List.mem_cons.mp hx with rfl | hx + · have := forestNodes_length_ge cs + omega + · obtain ⟨c, hc, hxc⟩ := mem_forestNodes_iff.mp hx + have hnd_c := forestNodes_nodup_tree (List.nodup_cons.mp hnd).2 hc + have := ih c hc hnd_c hxc + obtain ⟨l₁, l₂, rfl⟩ := List.append_of_mem hc + have : c.nodes.length ≤ (forestNodes (l₁ ++ c :: l₂)).length := by + simp only [forestNodes_append, forestNodes, List.length_append] + omega + omega + +/-- **A cut keeps the forest `Cascading`**, with the parent `p` now pending. The cut node `cur` +becomes the root of a new tree; its old tree loses that subtree. This is the forest part of the +hand-stepped `cutNode_forest`. -/ +theorem CutsNode.cascading {n K : ℕ} {s : IndexedMinPQ.State n} {st st' : RawState n} + {cur p v m : Fin n} {pending : Option (Fin n)} {ts : List (FHTree n)} {rtail : List (Fin n)} + (h : Cascading n K s st v m pending ts) (hperm_r : (m :: rtail).Perm (ts.map FHTree.root)) + (hpend : pending = none ∨ pending = some cur) + (hv_root : cur = v ∨ ∃ T ∈ ts, T.root = v) + (hcur_ne_v : ∀ T ∈ ts, cur ∈ T.nodes → T.root ≠ v) + (hcur : cur ∈ forestNodes ts) (hpar_cur : st.par cur = p.val + 1) + (hcut : CutsNode st cur p m rtail st') : + ∃ ts', Cascading n K s st' v m (some p) ts' ∧ (∃ T ∈ ts', T.root = v) ∧ + (∀ T ∈ ts', p ∈ T.nodes → T.root ≠ v) ∧ p ∈ forestNodes ts' := by + obtain ⟨Ti, hTi, hcur_Ti⟩ := mem_forestNodes_iff.mp hcur + obtain ⟨i, hi, rfl⟩ := List.mem_iff_getElem.mp hTi + have hnd_Ti : (ts[i]).nodes.Nodup := forestNodes_nodup_tree h.nodup hTi + have hTi_ne_v : (ts[i]).root ≠ v := hcur_ne_v _ hTi hcur_Ti + have hcur_ne_root : cur ≠ (ts[i]).root := fun e => by + have := (h.valid _ hTi).2.1 + rw [← e] at this + omega + have hcur_desc : cur ∈ forestNodes (ts[i]).children := by + rw [(ts[i]).nodes_eq] at hcur_Ti + exact (List.mem_cons.mp hcur_Ti).resolve_left hcur_ne_root + obtain ⟨T_cut, T', hcut_r, hT'_r, hp_T', hperm_Ti, hvalid_cut, hvalid_T'⟩ := + (h.valid _ hTi).1.exists_cut hnd_Ti hcur_desc hpar_cur hpend + (fun u _ => ⟨congrFun hcut.inHeap u, congrFun hcut.key u⟩) + ⟨hcut.mark_cur, fun u _ hu => hcut.mark_ne u hu⟩ + ⟨hcut.deg_p, fun u _ hu => hcut.deg_ne u hu⟩ + ⟨hcut.par_cur, fun u _ hu => hcut.par_ne u hu⟩ + ⟨hcut.child_one, hcut.child_two⟩ + (fun u _ hu => hcut.child_ne u hu) (fun u _ h1 h0 => hcut.lr_ne u h1 h0) + have hnd_cut_T' : (T_cut.nodes ++ T'.nodes).Nodup := hperm_Ti.nodup_iff.mpr hnd_Ti + have hcur_T' : cur ∉ T'.nodes := fun hm => + (List.nodup_append.mp hnd_cut_T').2.2 cur (hcut_r ▸ T_cut.root_mem_nodes) cur hm rfl + have hT'_ne_cur : T'.root ≠ cur := fun e => hcur_T' (e ▸ T'.root_mem_nodes) + let ts' : List (FHTree n) := T_cut :: ts.set i T' + have hperm_fn : (forestNodes ts').Perm (forestNodes ts) := + forestNodes_set_perm ts i hi T_cut T' hperm_Ti + have hnd' : (forestNodes ts').Nodup := hperm_fn.nodup_iff.mpr h.nodup + have hT'_mem : T' ∈ ts' := List.mem_cons_of_mem _ (List.mem_iff_getElem.mpr + ⟨i, by simpa using hi, by simp⟩) + -- Every other tree is untouched: none of its nodes is `cur` or `p`. + have hother : ∀ j (hj : j < ts.length), j ≠ i → ValidRoot st' (some p) ts[j] := by + intro j hj hji + have hcur_j : cur ∉ (ts[j]).nodes := fun hm => + forestNodes_nodup_idx_disjoint h.nodup hi hj (Ne.symm hji) hcur_Ti hm + have hp_j : p ∉ (ts[j]).nodes := fun hm => by + have hp_Ti : p ∈ (ts[i]).nodes := hperm_Ti.subset (List.mem_append_right _ hp_T') + exact forestNodes_nodup_idx_disjoint h.nodup hi hj (Ne.symm hji) hp_Ti hm + have hsub : ValidSubtree st none ts[j] := by + rcases hpend with rfl | rfl + · exact (h.valid _ (List.getElem_mem hj)).1 + · exact (h.valid _ (List.getElem_mem hj)).1.clear_pending fun hm => + hcur_j ((ts[j]).nodes_eq ▸ List.mem_cons_of_mem _ hm) + have hr_ne : (ts[j]).root ≠ cur := fun e => hcur_j (e ▸ (ts[j]).root_mem_nodes) + refine ⟨(hsub.frame (pending' := none) (fun u hu => ?_) (fun u hu => ?_)).weaken_pending _, + by rw [hcut.par_ne _ hr_ne]; exact (h.valid _ (List.getElem_mem hj)).2.1, + by rw [hcut.mark_ne _ hr_ne]; exact (h.valid _ (List.getElem_mem hj)).2.2⟩ + · have hu_cur : u ≠ cur := fun e => hcur_j (e ▸ hu) + have hu_p : u ≠ p := fun e => hp_j (e ▸ hu) + exact ⟨congrFun hcut.inHeap u, hcut.mark_ne u hu_cur, hcut.deg_ne u hu_p, + hcut.child_ne u hu_p, congrFun hcut.key u⟩ + · have hu_j : u ∈ (ts[j]).nodes := (ts[j]).nodes_eq ▸ List.mem_cons_of_mem _ hu + have hu_cur : u ≠ cur := fun e => hcur_j (e ▸ hu_j) + obtain ⟨q, hq, hpq⟩ := hsub.par_of_mem_children u hu + have hqp : q ≠ p := fun e => hp_j (e ▸ hq) + have hlr := hcut.lr_ne u (by rw [hpq]; have := Fin.val_ne_of_ne hqp; omega) + (by rw [hpq]; omega) + exact ⟨hcut.par_ne u hu_cur, hlr.1, hlr.2, Iff.rfl⟩ + have hvalid' : ∀ T ∈ ts', ValidRoot st' (some p) T := by + intro T hT + rcases List.mem_cons.mp hT with rfl | hT + · exact ⟨hvalid_cut.1.weaken_pending _, hvalid_cut.2.1, hvalid_cut.2.2⟩ + · obtain ⟨j, hj, rfl⟩ := List.mem_iff_getElem.mp hT + have hj' : j < ts.length := by simpa using hj + by_cases hji : j = i + · subst hji + simp only [List.getElem_set_self] + refine ⟨hvalid_T', ?_, ?_⟩ + · rw [hcut.par_ne _ hT'_ne_cur, hT'_r]; exact (h.valid _ hTi).2.1 + · rw [hcut.mark_ne _ hT'_ne_cur, hT'_r]; exact (h.valid _ hTi).2.2 + · rw [List.getElem_set_ne (Ne.symm hji)] + exact hother j hj' hji + have hroots' : (m :: cur :: rtail).Perm (ts'.map FHTree.root) := by + simp only [ts', List.map_cons, hcut_r, map_root_set_eq ts i hi T' hT'_r] + exact (List.Perm.swap cur m rtail).trans (List.Perm.cons cur hperm_r) + have hmem_set : ∀ j (hj : j < ts.length), j ≠ i → ts[j] ∈ ts' := fun j hj hji => + List.mem_cons_of_mem _ (List.mem_iff_getElem.mpr ⟨j, by simpa using hj, + by simp [List.getElem_set_ne (Ne.symm hji)]⟩) + refine ⟨ts', ⟨hvalid', hnd', fun u => hperm_fn.mem_iff.trans (h.dom u), + fun u => by rw [hcut.inHeap]; exact h.inHeap u, + fun u ku hu => by rw [hcut.key]; exact h.keys u ku hu, hcut.sz.trans h.sz, + by rw [hcut.numRoots, h.numRoots]; simp [ts'], ?_, + fun d hd => by rw [hcut.cons]; exact h.cons d hd, + hcut.minRoot.trans h.minRoot, ⟨cur :: rtail, hcut.roots, hroots'⟩, ?_⟩, ?_, ?_, + mem_forestNodes_iff.mpr ⟨T', hT'_mem, hp_T'⟩⟩ + · -- The cut node loses its mark, if any. + obtain ⟨-, -, -, hin_cur, hmk_cur, -⟩ := exists_parent_info (h.valid _ hTi).1 hcur_desc hpar_cur + rw [hcut.numMarked, h.numMarked] + have hiff : ∀ x, x ≠ cur → ((st'.inHeap x ≠ 0 ∧ st'.mark x ≠ 0) ↔ + (st.inHeap x ≠ 0 ∧ st.mark x ≠ 0)) := fun x hx => by + rw [hcut.inHeap, hcut.mark_ne x hx] + by_cases hm0 : st.mark cur = 0 + · rw [hm0, Nat.sub_zero] + refine (markedCount_congr fun x => ?_).symm + by_cases hx : x = cur + · subst hx; simp [hcut.mark_cur, hm0] + · exact hiff x hx + · have := markedCount_clear_one hin_cur hm0 hcut.mark_cur hiff + omega + · intro T hT hTv + rw [hcut.key] + rcases List.mem_cons.mp hT with rfl | hT + · rw [hcut_r] at hTv ⊢ + exact (h.min_le _ hTi hTi_ne_v).trans ((h.valid _ hTi).1.prioLE_of_mem hcur_Ti) + · obtain ⟨j, hj, rfl⟩ := List.mem_iff_getElem.mp hT + have hj' : j < ts.length := by simpa using hj + by_cases hji : j = i + · subst hji + simp only [List.getElem_set_self, hT'_r] at hTv ⊢ + exact h.min_le _ hTi hTi_ne_v + · simp only [List.getElem_set_ne (Ne.symm hji)] at hTv ⊢ + exact h.min_le _ (List.getElem_mem hj') hTv + · rcases hv_root with rfl | ⟨Tv, hTv, hTv_r⟩ + · exact ⟨T_cut, List.mem_cons_self, hcut_r⟩ + · obtain ⟨j, hj, rfl⟩ := List.mem_iff_getElem.mp hTv + have hji : j ≠ i := fun e => by subst e; exact hTi_ne_v hTv_r + exact ⟨_, hmem_set j hj hji, hTv_r⟩ + · intro T hT hpT + by_cases hTT' : T = T' + · subst hTT'; rw [hT'_r]; exact hTi_ne_v + · exact (forestNodes_nodup_disjoint hnd' hT hT'_mem hTT' hpT hp_T').elim + +/-- A node of the forest with a parent `p` is a strict descendant of its tree. -/ +theorem Cascading.desc_of_par {n K : ℕ} {s : IndexedMinPQ.State n} {st : RawState n} + {v m : Fin n} {pending : Option (Fin n)} {ts : List (FHTree n)} + (h : Cascading n K s st v m pending ts) {z : Fin n} (hz : z ∈ forestNodes ts) + (hpz : st.par z ≠ 0) : ∃ T ∈ ts, z ∈ forestNodes T.children := by + obtain ⟨T, hT, hzT⟩ := mem_forestNodes_iff.mp hz + refine ⟨T, hT, ?_⟩ + rw [T.nodes_eq] at hzT + exact (List.mem_cons.mp hzT).resolve_left fun e => hpz (e ▸ (h.valid T hT).2.1) + +/-- **The preconditions of a cut** of a non-root `cur` from its parent `p`, as `wp_cut` takes +them. -/ +theorem Cascading.cut_pre {n K : ℕ} {s : IndexedMinPQ.State n} {st : RawState n} + {v m : Fin n} {pending : Option (Fin n)} {ts : List (FHTree n)} {rtail : List (Fin n)} + (h : Cascading n K s st v m pending ts) (hperm_r : (m :: rtail).Perm (ts.map FHTree.root)) + {cur p : Fin n} (hcur : cur ∈ forestNodes ts) (hpar_cur : st.par cur = p.val + 1) : + 1 ≤ st.deg p ∧ + (2 ≤ st.deg p → ∃ (h : Fin n) (tail : List (Fin n)), + st.child p = h.val + 1 ∧ IsCircList st.left st.right (h :: tail) ∧ + cur ∈ h :: tail ∧ 2 ≤ (h :: tail).length ∧ ∀ u ∈ h :: tail, st.par u = p.val + 1) ∧ + st.deg p ≤ n ∧ (∀ u ∈ m :: rtail, st.par u = 0) ∧ st.numRoots + 1 ≤ n ∧ + st.numMarked ≤ n := by + obtain ⟨T, hT, hdesc⟩ := h.desc_of_par hcur (by omega) + obtain ⟨hpT, -, -, -, -, hdp, hdp2⟩ := exists_parent_info (h.valid T hT).1 hdesc hpar_cur + have hnd_T := forestNodes_nodup_tree h.nodup hT + have hdeg := ValidSubtree.deg_lt_length (h.valid T hT).1 hnd_T hpT + have hlen : T.nodes.length ≤ n := by simpa using hnd_T.length_le_card + have hroot0 : ∀ u ∈ ts.map FHTree.root, st.par u = 0 := fun u hu => by + obtain ⟨R, hR, rfl⟩ := List.mem_map.mp hu + exact (h.valid R hR).2.1 + have hcur_roots : cur ∉ ts.map FHTree.root := fun hm => by + have := hroot0 cur hm + omega + have hnd_roots : (cur :: ts.map FHTree.root).Nodup := + List.nodup_cons.mpr ⟨hcur_roots, map_root_nodup h.nodup⟩ + have hnr : (cur :: ts.map FHTree.root).length ≤ n := by simpa using hnd_roots.length_le_card + simp only [List.length_cons, List.length_map] at hnr + refine ⟨hdp, hdp2, by omega, fun u hu => hroot0 u (hperm_r.subset hu), by rw [h.numRoots]; omega, + h.numMarked ▸ markedCount_le_n st⟩ + +/-- **The cascade stops at a root**: a pending root has lost nothing that matters. -/ +theorem Cascading.clear_root {n K : ℕ} {s : IndexedMinPQ.State n} {st : RawState n} + {v m z : Fin n} {ts : List (FHTree n)} (h : Cascading n K s st v m (some z) ts) + (hz : z ∈ forestNodes ts) (hpz : st.par z = 0) : Cascading n K s st v m none ts := by + obtain ⟨Tz, hTz, hzT⟩ := mem_forestNodes_iff.mp hz + have hz_root : z = Tz.root := ((h.valid Tz hTz).par_eq_zero_iff_root hzT).mp hpz + refine { h with valid := fun T hT => ⟨(h.valid T hT).1.clear_pending fun hm => ?_, + (h.valid T hT).2.1, (h.valid T hT).2.2⟩ } + exact descendant_ne_root_of_nodup h.nodup hT hTz hm hz_root + +/-- **The cascade stops at an unmarked node**, which it marks. -/ +theorem Cascading.mark {n K : ℕ} {s : IndexedMinPQ.State n} {st : RawState n} + {v m z : Fin n} {ts : List (FHTree n)} (h : Cascading n K s st v m (some z) ts) + (hz : z ∈ forestNodes ts) (hpz : st.par z ≠ 0) (hmz : st.mark z = 0) : + Cascading n K s { st with + mark := Function.update st.mark z 1 + numMarked := st.numMarked + 1 } v m none ts := by + obtain ⟨Tz, hTz, hdesc⟩ := h.desc_of_par hz hpz + have hzT : z ∈ Tz.nodes := Tz.nodes_eq ▸ List.mem_cons_of_mem _ hdesc + have hz_ne_root : ∀ T ∈ ts, T.root ≠ z := fun T hT e => + descendant_ne_root_of_nodup h.nodup hTz hT hdesc e.symm + refine { h with valid := fun T hT => ⟨?_, (h.valid T hT).2.1, ?_⟩, numMarked := ?_ } + · by_cases hTT : T = Tz + · subst hTT + exact (h.valid T hT).1.mark_pending hmz (by simp) + (fun x _ hx => by simp [Function.update_of_ne hx]) (fun _ _ => ⟨rfl, rfl, rfl, rfl⟩) + (fun _ _ => ⟨rfl, rfl, rfl⟩) + · have hzT' : z ∉ T.nodes := fun hm => forestNodes_nodup_disjoint h.nodup hT hTz hTT hm hzT + exact ((h.valid T hT).1.clear_pending fun hm => hzT' (T.nodes_eq ▸ List.mem_cons_of_mem _ hm) + ).frame (fun x hx => ⟨rfl, by + simp [Function.update_of_ne (fun e : x = z => hzT' (e ▸ hx))], rfl, rfl, rfl⟩) + (fun _ _ => ⟨rfl, rfl, rfl, Iff.rfl⟩) + · simpa [Function.update_of_ne (hz_ne_root T hT)] using (h.valid T hT).2.2 + · obtain ⟨T, hT, hzT⟩ := mem_forestNodes_iff.mp hz + have hin_z : st.inHeap z ≠ 0 := ((h.inHeap z).1).mpr ((h.dom z).mp hz) + rw [h.numMarked] + exact (markedCount_set_one (st := st) + (st' := { st with mark := Function.update st.mark z 1, numMarked := st.numMarked + 1 }) + hin_z hmz (by simp) fun x hx => by simp [Function.update_of_ne hx]).symm + +/-- **Lowering the key of the root `v`** keeps every tree valid, and with `v` a root the forest +satisfies the existing `CutInv`, ready for the minimum-root update. -/ +theorem Cascading.lowerRootKey {n K : ℕ} {s : IndexedMinPQ.State n} {st : RawState n} + {v m : Fin n} {ts : List (FHTree n)} (h : Cascading n K s st v m none ts) + (hv : ∃ T ∈ ts, T.root = v) {k₀ k : ℕ} (hsv : s v = some k₀) (hk₀ : k ≤ k₀) (hK : k ≤ K) : + CutInv n K (Function.update s v (some k)) { st with key := Function.update st.key v k } + v m none := by + obtain ⟨Tv, hTv, rfl⟩ := hv + have hkv : st.key Tv.root = k₀ := (h.keys _ k₀ hsv).1 + have hvalid : ∀ T ∈ ts, ValidRoot { st with key := Function.update st.key Tv.root k } none T := by + intro T hT + by_cases hTT : T = Tv + · subst hTT + refine ⟨(h.valid T hT).1.lower_key_no_cut (k := k) (forestNodes_nodup_tree h.nodup hT) + T.root_mem_nodes (by omega) (by simp) (fun x _ hx => by simp [hx]) + (fun _ _ => ⟨rfl, rfl, rfl, rfl⟩) (fun _ _ => ⟨rfl, rfl, rfl⟩) (Or.inl rfl), + (h.valid T hT).2.1, (h.valid T hT).2.2⟩ + · have hv_T : Tv.root ∉ T.nodes := fun hm => forestNodes_nodup_disjoint h.nodup hT hTv hTT hm + Tv.root_mem_nodes + exact (h.valid T hT).frame_tree (fun x hx => ⟨rfl, rfl, rfl, rfl, + by simp [Function.update_of_ne (fun e : x = Tv.root => hv_T (e ▸ hx))], rfl⟩) + (fun _ _ => ⟨rfl, rfl⟩) + have hsome : ∀ u, (Function.update s Tv.root (some k) u).isSome = (s u).isSome := fun u => by + by_cases hu : u = Tv.root + · subst hu; simp [hsv] + · simp [hu] + obtain ⟨rtail, hcirc, hperm⟩ := h.roots + refine ⟨ts, hvalid, h.nodup, fun u => (h.dom u).trans (by rw [hsome]), + fun u => by rw [hsome]; exact h.inHeap u, fun u ku hu => ?_, ?_, h.numRoots, + h.numMarked.trans (markedCount_congr fun _ => Iff.rfl).symm, h.cons, + ⟨rtail, h.minRoot, hcirc, hperm⟩, ⟨Tv, hTv, rfl⟩, fun T hT hTr => ?_⟩ + · by_cases hu' : u = Tv.root + · subst hu' + simp only [Function.update_self, Option.some.injEq] at hu + subst hu + simp [hK] + · rw [Function.update_of_ne hu'] at hu + simpa [hu'] using h.keys u ku hu + · rw [h.sz, IndexedMinPQ.dom_decreaseKey (IndexedMinPQ.mem_dom_iff.mpr ⟨k₀, hsv⟩)] + · have hle := h.min_le T hT hTr + simp only [Function.update_of_ne hTr] + by_cases hmv : m = Tv.root + · subst hmv + simp only [Function.update_self] + refine IndexedMinPQ.PrioLE.trans ?_ hle + dsimp only [IndexedMinPQ.PrioLE, IndexedMinPQ.RawPrioLE] + omega + · simpa [Function.update_of_ne hmv] using hle + +/-- **Lowering a key without a cut.** If `v` keeps its heap order with its parent `p`, the heap +stays valid, and `v` cannot precede the minimum root. -/ +theorem FibRawInv.lowerKey_noCut {n K : ℕ} {s : IndexedMinPQ.State n} {st : RawState n} + {v p : Fin n} {k₀ k : ℕ} (h : FibRawInv n K s st) (hsv : s v = some k₀) (hk₀ : k ≤ k₀) + (hK : k ≤ K) (hpv : st.par v = p.val + 1) (hord : ¬IndexedMinPQ.PrioLT (v, k) (p, st.key p)) : + FibRawInv n K (Function.update s v (some k)) { st with key := Function.update st.key v k } ∧ + ∀ m : Fin n, st.minRoot = m.val + 1 → + ¬IndexedMinPQ.PrioLT (v, k) (m, Function.update st.key v k m) := by + obtain ⟨m, ts, hc⟩ := cascading_of_fibRawInv (v := v) h (by simp [hsv]) + obtain ⟨Tv, hTv, hvT⟩ := mem_forestNodes_iff.mp ((hc.dom v).mpr (by simp [hsv])) + have hkv : st.key v = k₀ := (hc.keys v k₀ hsv).1 + have hv_ne_root : ∀ T ∈ ts, T.root ≠ v := fun T hT e => by + have := (hc.valid T hT).2.1 + rw [e] at this + omega + let st₁ : RawState n := { st with key := Function.update st.key v k } + have hvalid : ∀ T ∈ ts, ValidRoot st₁ none T := by + intro T hT + by_cases hTT : T = Tv + · subst hTT + exact ⟨(hc.valid T hT).1.lower_key_no_cut (k := k) (forestNodes_nodup_tree hc.nodup hT) hvT + (by omega) (by simp [st₁]) (fun x _ hx => by simp [st₁, hx]) + (fun _ _ => ⟨rfl, rfl, rfl, rfl⟩) (fun _ _ => ⟨rfl, rfl, rfl⟩) (Or.inr ⟨p, hpv, hord⟩), + (hc.valid T hT).2.1, (hc.valid T hT).2.2⟩ + · have hv_T : v ∉ T.nodes := fun hm => forestNodes_nodup_disjoint hc.nodup hT hTv hTT hm hvT + exact (hc.valid T hT).frame_tree (fun x hx => ⟨rfl, rfl, rfl, rfl, + by simp [st₁, Function.update_of_ne (fun e : x = v => hv_T (e ▸ hx))], rfl⟩) + (fun _ _ => ⟨rfl, rfl⟩) + have hroot_key : ∀ T ∈ ts, st₁.key T.root = st.key T.root := fun T hT => by + simp [st₁, Function.update_of_ne (hv_ne_root T hT)] + obtain ⟨rtail, hcirc, hperm⟩ := hc.roots + obtain ⟨Tm, hTm, hTm_r⟩ := List.mem_map.mp (hperm.subset List.mem_cons_self) + have hmv : m ≠ v := hTm_r ▸ hv_ne_root Tm hTm + have hcut : CutInv n K (Function.update s v (some k)) st₁ Tv.root m none := by + have hsome : ∀ u, (Function.update s v (some k) u).isSome = (s u).isSome := fun u => by + by_cases hu : u = v + · subst hu; simp [hsv] + · simp [hu] + refine ⟨ts, hvalid, hc.nodup, fun u => (hc.dom u).trans (by rw [hsome]), + fun u => by rw [hsome]; exact hc.inHeap u, fun u ku hu => ?_, ?_, hc.numRoots, + hc.numMarked.trans (markedCount_congr fun _ => Iff.rfl).symm, hc.cons, + ⟨rtail, hc.minRoot, hcirc, hperm⟩, ⟨Tv, hTv, rfl⟩, fun T hT _ => ?_⟩ + · by_cases hu' : u = v + · subst hu' + simp only [Function.update_self, Option.some.injEq] at hu + subst hu + simp [st₁, hK] + · rw [Function.update_of_ne hu'] at hu + simpa [st₁, hu'] using hc.keys u ku hu + · rw [hc.sz, IndexedMinPQ.dom_decreaseKey (IndexedMinPQ.mem_dom_iff.mpr ⟨k₀, hsv⟩)] + · rw [hroot_key T hT, ← hTm_r, hroot_key Tm hTm, hTm_r] + by_cases hTv' : T.root = v + · exact (hv_ne_root T hT hTv').elim + · exact hc.min_le T hT hTv' + -- `m` precedes the root of `v`'s tree, which precedes `v`. + have hmin_v : IndexedMinPQ.PrioLE (m, st₁.key m) (v, k) := by + have h1 := hc.min_le Tv hTv (hv_ne_root Tv hTv) + have h2 := (hvalid Tv hTv).1.prioLE_of_mem hvT + rw [← hroot_key Tv hTv, ← hTm_r, ← hroot_key Tm hTm, hTm_r] at h1 + simpa [st₁] using h1.trans h2 + refine ⟨CutInv.to_fibRawInv hcut ⟨rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl⟩ + (Or.inr ⟨fun hlt => ?_, hc.minRoot⟩), fun m' hm' => ?_⟩ + · have hle := hc.min_le Tv hTv (hv_ne_root Tv hTv) + rw [← hroot_key Tv hTv, ← hTm_r, ← hroot_key Tm hTm, hTm_r] at hle + exact IndexedMinPQ.not_prioLT_iff_prioLE.mpr hle hlt + · obtain rfl : m' = m := Fin.ext (by have := hc.minRoot; omega) + exact IndexedMinPQ.not_prioLT_iff_prioLE.mpr hmin_v + +section Programs + +variable {n w : ℕ} + +/-- Splicing `u` after `h`, whose right neighbour is `r`, makes four writes. -/ +theorem wp_spliceAfter {g : Cell → ℕ} {h u r : Fin n} (hr : (view n g).right h = r.val) + (hfit : Fits w n) {Q : Unit → (Cell → ℕ) → ℕ → Prop} + (hQ : Q () (Function.update (Function.update (Function.update (Function.update g + (.left u) h) (.left r) u) (.right u) r) (.right h) u) 5) : + Record.wp (Cell.ok n) w (spliceAfter h u) Q g := by + have hr' : g (.right h) = r.val := hr + simp only [spliceAfter, Record.wp_read_bind, Record.wp_write_bind, Record.wp_write, hr', + Cell.ok] + exact ⟨h.isLt, ⟨u.isLt, hfit.of_le h.isLt.le⟩, ⟨r.isLt, hfit.of_le u.isLt.le⟩, + ⟨u.isLt, hfit.of_le r.isLt.le⟩, ⟨h.isLt, hfit.of_le u.isLt.le⟩, hQ⟩ + +/-- Unlinking `cur` from `p`'s children evaluates to the two cases of `cutsNode_cutState`. -/ +theorem wp_unlink {g : Cell → ℕ} {cur p : Fin n} + (hdp_pos : 1 ≤ (view n g).deg p) + (hdp2 : 2 ≤ (view n g).deg p → ∃ (h : Fin n) (tail : List (Fin n)), + (view n g).child p = h.val + 1 ∧ IsCircList (view n g).left (view n g).right (h :: tail) ∧ + cur ∈ h :: tail ∧ 2 ≤ (h :: tail).length ∧ ∀ u ∈ h :: tail, (view n g).par u = p.val + 1) + (hdp_le : (view n g).deg p ≤ n) (hfit : Fits w n) {Q : Unit → (Cell → ℕ) → ℕ → Prop} + (hQ : ∀ g' t, t ≤ 7 → ∀ (left₁ right₁ : Fin n → ℕ) (child₁ : ℕ), + (((view n g).deg p = 1 ∧ child₁ = 0 ∧ left₁ = (view n g).left ∧ + right₁ = (view n g).right) ∨ + (2 ≤ (view n g).deg p ∧ ∃ r l : Fin n, (view n g).right cur = r.val ∧ + (view n g).left cur = l.val ∧ child₁ = r.val + 1 ∧ + left₁ = Function.update (view n g).left r l.val ∧ + right₁ = Function.update (view n g).right l r.val)) → + view n g' = { view n g with + deg := Function.update (view n g).deg p ((view n g).deg p - 1) + child := Function.update (view n g).child p child₁ + left := left₁ + right := right₁ } → Q () g' t) : + Record.wp (Cell.ok n) w (unlink cur p) Q g := by + have hpn := p.isLt + have hdp : g (.deg p) = (view n g).deg p := rfl + by_cases h1 : (view n g).deg p - 1 = 0 + · simp only [unlink, Record.wp_bind, Record.wp_read, Record.wp_write, hdp, h1, ite_true, + Cell.ok] + refine ⟨hpn, ⟨hpn, fits_zero w⟩, ⟨hpn, fits_zero w⟩, hQ _ _ (by omega) _ _ 0 + (Or.inl ⟨by omega, rfl, rfl, rfl⟩) ?_⟩ + simp only [view_update_deg, view_update_child, h1] + · obtain ⟨h, tail, -, hcirc, hcur, hlen, hpar⟩ := hdp2 (by omega) + obtain ⟨r, l, -, hr, hl, -⟩ := hcirc.remove hcur hlen + have hr' : g (.right cur) = r.val := hr + have hl' : g (.left cur) = l.val := hl + simp only [unlink, Record.wp_bind, Record.wp_read, Record.wp_write, hdp, h1, ite_false, + Function.update_apply, reduceCtorEq, hr', hl', Cell.ok] + refine ⟨hpn, ⟨hpn, hfit.of_le (by omega)⟩, cur.isLt, cur.isLt, ⟨r.isLt, hfit.of_le l.isLt.le⟩, + ⟨l.isLt, hfit.of_le r.isLt.le⟩, ⟨hpn, hfit.of_le r.isLt⟩, hQ _ _ (by omega) _ _ _ + (Or.inr ⟨by omega, r, l, hr, hl, rfl, rfl, rfl⟩) ?_⟩ + simp only [view_update_deg, view_update_child, view_update_left, view_update_right] + +/-- Moving the unlinked `cur` to the root list after the minimum root `m`, whose right neighbour +is `r'`, makes thirteen operations. -/ +theorem wp_toRoot {g : Cell → ℕ} {cur m r' : Fin n} (hm : (view n g).minRoot = m.val + 1) + (hr' : (view n g).right m = r'.val) (hfit : Fits w n) (hnr : (view n g).numRoots + 1 ≤ n) + (hnm : (view n g).numMarked ≤ n) {Q : Unit → (Cell → ℕ) → ℕ → Prop} + (hQ : ∀ g', view n g' = { view n g with + left := Function.update (Function.update (view n g).left cur m.val) r' cur.val + right := Function.update (Function.update (view n g).right cur r'.val) m cur.val + par := Function.update (view n g).par cur 0 + mark := Function.update (view n g).mark cur 0 + numMarked := (view n g).numMarked - (view n g).mark cur + numRoots := (view n g).numRoots + 1 } → Q () g' 13) : + Record.wp (Cell.ok n) w (toRoot cur) Q g := by + have hm' : g .minRoot = m.val + 1 := hm + simp only [toRoot, Record.wp_read_bind, hm', Nat.add_sub_cancel] + refine ⟨trivial, ?_⟩ + rw [Record.wp_bind] + refine wp_spliceAfter hr' hfit ?_ + simp only [Record.wp_write_bind, Record.wp_read_bind, Record.wp_write, Function.update_apply, + reduceCtorEq, ite_false, Cell.ok, true_and] + refine ⟨⟨cur.isLt, fits_zero w⟩, cur.isLt, ⟨cur.isLt, fits_zero w⟩, + hfit.of_le ((Nat.sub_le _ _).trans hnm), hfit.of_le hnr, hQ _ ?_⟩ + simp only [view_update_left, view_update_right, view_update_par, view_update_mark, + view_update_numMarked, view_update_numRoots] + rfl + +/-- **One cut.** Cutting `cur` from its parent `p` evaluates to `CutsNode` in at most `20` +operations. The hypotheses are those of the hand-stepped `cutNodeCode_raw`. -/ +theorem wp_cut {g : Cell → ℕ} {cur p m : Fin n} {rtail : List (Fin n)} + (hdp_pos : 1 ≤ (view n g).deg p) + (hdp2 : 2 ≤ (view n g).deg p → ∃ (h : Fin n) (tail : List (Fin n)), + (view n g).child p = h.val + 1 ∧ IsCircList (view n g).left (view n g).right (h :: tail) ∧ + cur ∈ h :: tail ∧ 2 ≤ (h :: tail).length ∧ ∀ u ∈ h :: tail, (view n g).par u = p.val + 1) + (hdp_le : (view n g).deg p ≤ n) + (hmin : (view n g).minRoot = m.val + 1) + (hcirc_r : IsCircList (view n g).left (view n g).right (m :: rtail)) + (hroots_par0 : ∀ u ∈ m :: rtail, (view n g).par u = 0) + (hpar_cur : (view n g).par cur = p.val + 1) + (hfit : Fits w n) (hnr : (view n g).numRoots + 1 ≤ n) (hnm : (view n g).numMarked ≤ n) + {Q : Unit → (Cell → ℕ) → ℕ → Prop} + (hQ : ∀ g' t, t ≤ 20 → CutsNode (view n g) cur p m rtail (view n g') → Q () g' t) : + Record.wp (Cell.ok n) w (cut cur p) Q g := by + rw [cut, Record.wp_bind] + refine wp_unlink hdp_pos hdp2 hdp_le hfit fun g₁ t₁ ht₁ left₁ right₁ child₁ hunlink hg₁ => ?_ + -- The minimum root's right neighbour, after unlinking. + have hr₁ : ∃ r' : Fin n, right₁ m = r'.val := by + obtain ⟨r', hr', -⟩ := hcirc_r.right_head + rcases hunlink with ⟨-, -, -, rfl⟩ | ⟨h2, r, l, -, hl, -, -, rfl⟩ + · exact ⟨r', hr'⟩ + · obtain ⟨h, tail, -, hcirc, hcur, hlen, hpar⟩ := hdp2 h2 + obtain ⟨r₂, l₂, -, -, hl₂, -, hl₂m, -⟩ := hcirc.remove hcur hlen + obtain rfl : l₂ = l := Fin.ext (hl₂.symm.trans hl) + have hml : m ≠ l₂ := fun e => by + have := hroots_par0 m List.mem_cons_self + rw [e, hpar l₂ hl₂m] at this + omega + exact ⟨r', by rw [Function.update_of_ne hml]; exact hr'⟩ + obtain ⟨r', hr'⟩ := hr₁ + refine wp_toRoot (by rw [hg₁]; exact hmin) (by rw [hg₁]; exact hr') hfit + (by rw [hg₁]; exact hnr) (by rw [hg₁]; exact hnm) fun g₂ hg₂ => hQ _ _ (by omega) ?_ + rw [hg₂, hg₁] + exact cutsNode_cutState hdp_pos hdp2 hcirc_r hroots_par0 hpar_cur hunlink hr' + +/-- **Cascading cuts.** From a forest with `z` pending, the cascade leaves a forest with nothing +pending. Each cut costs at most `22` operations and releases one credit (one more root, one mark +less), so the whole cascade costs at most `53` operations plus the potential it releases. -/ +theorem wp_cascade {K : ℕ} {s : IndexedMinPQ.State n} {v m : Fin n} (hfit : Fits w n) : + ∀ (fuel : ℕ) {g : Cell → ℕ} {z : Fin n} {ts : List (FHTree n)}, + Cascading n K s (view n g) v m (some z) ts → (∃ T ∈ ts, T.root = v) → + (∀ T ∈ ts, z ∈ T.nodes → T.root ≠ v) → z ∈ forestNodes ts → + (view n g).numMarked < fuel → + Record.wp (Cell.ok n) w (cascade fuel z) (fun _ g' t => ∃ ts', + Cascading n K s (view n g') v m none ts' ∧ (∃ T ∈ ts', T.root = v) ∧ + t + potential n g' ≤ 53 + potential n g) g + | 0, _, _, _, _, _, _, _, hfuel => absurd hfuel (Nat.not_lt_zero _) + | fuel + 1, g, z, ts, h, hv, hzv, hz, hfuel => by + have hzn := z.isLt + simp only [cascade, Record.wp_read_bind, Cell.ok] + refine ⟨hzn, ?_⟩ + by_cases hpz : (view n g).par z = 0 + · have hpz' : g (.par z) = 0 := hpz + simp only [hpz', ite_true, Record.wp_pure] + exact ⟨ts, h.clear_root hz hpz, hv, by omega⟩ + obtain ⟨T, hT, hdesc⟩ := h.desc_of_par hz hpz + obtain ⟨p, -, hpar⟩ := (h.valid T hT).1.par_of_mem_children z hdesc + obtain ⟨-, -, -, hinz, hmz1, -⟩ := exists_parent_info (h.valid T hT).1 hdesc hpar + have hpar' : g (.par z) = p.val + 1 := hpar + simp only [hpar', Nat.add_one_ne_zero, ite_false, Record.wp_read_bind, Nat.add_sub_cancel, + Cell.ok] + refine ⟨hzn, ?_⟩ + by_cases hmz : (view n g).mark z = 0 + · have hmz' : g (.mark z) = 0 := hmz + have hc' := h.mark hz hpz hmz + have hcount : (view n g).numMarked + 1 ≤ n := + calc (view n g).numMarked + 1 = markedCount _ := hc'.numMarked + _ ≤ n := markedCount_le_n _ + simp only [hmz', ite_true, Record.wp_write_bind, Record.wp_read_bind, Record.wp_write, + Function.update_apply, reduceCtorEq, ite_false, Cell.ok, true_and] + refine ⟨⟨hzn, hfit.of_le (by omega)⟩, hfit.of_le hcount, ts, ?_, hv, ?_⟩ + · simp only [view_update_mark, view_update_numMarked] + exact hc' + · have : (view n g).numMarked = g .numMarked := rfl + simp only [potential, credit, view_update_mark, view_update_numMarked] + omega + · have hmz' : g (.mark z) ≠ 0 := hmz + simp only [hmz', ite_false] + rw [Record.wp_bind] + obtain ⟨rtail, hcirc, hperm⟩ := h.roots + obtain ⟨hdp, hdp2, hdp_le, hroots0, hnr, hnm⟩ := h.cut_pre hperm hz hpar + refine wp_cut hdp hdp2 hdp_le h.minRoot hcirc hroots0 hpar hfit hnr hnm + fun g₁ t₁ ht₁ hcut => ?_ + obtain ⟨ts₁, hc₁, hv₁, hpv₁, hp₁⟩ := + hcut.cascading h hperm (Or.inr rfl) (Or.inr hv) hzv hz hpar + have hpos : 1 ≤ (view n g).numMarked := by + rw [h.numMarked] + exact Finset.card_pos.mpr ⟨z, by simp [markedSet, hinz, hmz]⟩ + have hnm₁ : (view n g₁).numMarked + 1 = (view n g).numMarked := by + rw [hcut.numMarked]; omega + refine Record.wp_mono (fun _ g' t ⟨ts', hc', hv', hcost⟩ => ⟨ts', hc', hv', ?_⟩) + (wp_cascade hfit fuel hc₁ hv₁ hpv₁ hp₁ (by omega)) + simp only [potential, credit] at hcost ⊢ + rw [hcut.numRoots] at hcost + omega + +/-- **Storing the key.** With the forest ready (`v` a root, or `v` not preceding the minimum +root), storing the key and updating the minimum root restores `FibRawInv`. -/ +theorem wp_setKey {K : ℕ} {s' : IndexedMinPQ.State n} {g : Cell → ℕ} {v m : Fin n} {k : ℕ} + (hm : (view n g).minRoot = m.val + 1) (hk : Fits w k) (hfit : Fits w n) + (hpost : CutInv n K s' { view n g with key := Function.update (view n g).key v k } v m none ∨ + (FibRawInv n K s' { view n g with key := Function.update (view n g).key v k } ∧ + ¬IndexedMinPQ.PrioLT (v, k) (m, Function.update (view n g).key v k m))) + {Q : Unit → (Cell → ℕ) → ℕ → Prop} + (hQ : ∀ g' t, t ≤ 4 → FibRawInv n K s' (view n g') → + (view n g').numRoots = (view n g).numRoots → + (view n g').numMarked = (view n g).numMarked → Q () g' t) : + Record.wp (Cell.ok n) w (setKey v k) Q g := by + have hm' : g .minRoot = m.val + 1 := hm + have hkm : Function.update g (.key v) k (.key m) = Function.update (view n g).key v k m := by + by_cases hmv : m = v + · subst hmv; simp + · simp [Function.update_of_ne hmv, Fin.val_ne_of_ne hmv, view] + simp only [setKey, Record.wp_write_bind, Record.wp_read_bind, Function.update_apply, + reduceCtorEq, ite_false, hm', Nat.add_sub_cancel, Cell.ok, true_and] + rw [← Function.update_apply (f := g), hkm] + refine ⟨⟨v.isLt, hk⟩, m.isLt, ?_⟩ + by_cases hlt : IndexedMinPQ.PrioLT (v, k) (m, Function.update (view n g).key v k m) + · have hlt' : IndexedMinPQ.RawPrioLT (↑v, k) (↑m, Function.update (view n g).key v k m) := hlt + simp only [hlt', ite_true, Record.wp_write, Cell.ok, true_and] + refine ⟨hfit.of_le v.isLt, hQ _ _ (by omega) ?_ rfl rfl⟩ + rcases hpost with hcut | ⟨-, hnlt⟩ + · simp only [view_update_minRoot, view_update_key] + exact CutInv.to_fibRawInv hcut ⟨rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl⟩ + (Or.inl ⟨by simpa using hlt, rfl⟩) + · exact (hnlt hlt).elim + · have hlt' : ¬IndexedMinPQ.RawPrioLT (↑v, k) (↑m, Function.update (view n g).key v k m) := hlt + simp only [hlt', ite_false, Record.wp_pure] + refine hQ _ _ (by omega) ?_ rfl rfl + rcases hpost with hcut | ⟨hinv, -⟩ + · simp only [view_update_key] + exact CutInv.to_fibRawInv hcut ⟨rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl⟩ + (Or.inr ⟨by simpa using hlt, hm⟩) + · simpa only [view_update_key] using hinv + +/-- **Decreasing a key.** `decreaseKey n v k` lowers the key of the present handle `v` to `k`, +preserves the invariant, and costs at most `104` operations amortized. -/ +theorem wp_decreaseKey {K : ℕ} {g : Cell → ℕ} {v : Fin n} {k₀ k : ℕ} (hI : Inv n K g) + (hsv : abs n g v = some k₀) (hk₀ : k ≤ k₀) (hK : k ≤ K) (hfit : Fits w n) + (hKfit : Fits w K) : + Record.wp (Cell.ok n) w (decreaseKey n v k) (fun _ g' t => + abs n g' = Function.update (abs n g) v (some k) ∧ Inv n K g' ∧ + t + potential n g' ≤ 104 + potential n g) g := by + have hvn := v.isLt + have hkfit : Fits w k := hKfit.of_le hK + obtain ⟨m, ts, hc⟩ := cascading_of_fibRawInv (v := v) hI (by simp [hsv]) + have hv_fn : v ∈ forestNodes ts := (hc.dom v).mpr (by simp [hsv]) + obtain ⟨Tv, hTv, hvT⟩ := mem_forestNodes_iff.mp hv_fn + -- Every case ends in `setKey` from a state with the same counters as its potential says. + have hdone : ∀ g' t, FibRawInv n K (Function.update (abs n g) v (some k)) (view n g') → + t + potential n g' ≤ 104 + potential n g → + abs n g' = Function.update (abs n g) v (some k) ∧ Inv n K g' ∧ + t + potential n g' ≤ 104 + potential n g := fun g' t hinv hcost => by + obtain ⟨hI', habs⟩ := inv_of_fibRawInv hinv + exact ⟨habs, hI', hcost⟩ + simp only [decreaseKey, Record.wp_read_bind, Cell.ok] + refine ⟨hvn, ?_⟩ + by_cases hpv : (view n g).par v = 0 + · have hpv' : g (.par v) = 0 := hpv + have hvr : v = Tv.root := ((hc.valid Tv hTv).par_eq_zero_iff_root hvT).mp hpv + simp only [hpv', ne_eq, not_true_eq_false, ite_false] + refine wp_setKey hc.minRoot hkfit hfit + (Or.inl (hc.lowerRootKey ⟨Tv, hTv, hvr.symm⟩ hsv hk₀ hK)) fun g' t ht hinv hnr hnm => ?_ + have hpot : potential n g' = potential n g := by simp only [potential, hnr, hnm] + exact hdone g' (t + 1) hinv (by omega) + · obtain ⟨T, hT, hdesc⟩ := hc.desc_of_par hv_fn hpv + obtain ⟨p, -, hpar⟩ := (hc.valid T hT).1.par_of_mem_children v hdesc + have hpar' : g (.par v) = p.val + 1 := hpar + simp only [hpar', ne_eq, Nat.add_one_ne_zero, not_false_eq_true, ite_true, Nat.add_sub_cancel, + Record.wp_read_bind, Cell.ok] + refine ⟨p.isLt, ?_⟩ + by_cases hlt : IndexedMinPQ.PrioLT (v, k) (p, (view n g).key p) + · -- `v` now precedes its parent: cut it, cascade, and store the key. + have hlt' : IndexedMinPQ.RawPrioLT (↑v, k) (↑p, g (.key ↑p)) := hlt + simp only [hlt', ite_true] + rw [Record.wp_bind] + obtain ⟨rtail, hcirc, hperm⟩ := hc.roots + obtain ⟨hdp, hdp2, hdp_le, hroots0, hnr, hnm⟩ := hc.cut_pre hperm hv_fn hpar + refine wp_cut hdp hdp2 hdp_le hc.minRoot hcirc hroots0 hpar hfit hnr hnm + fun g₁ t₁ ht₁ hcut => ?_ + have hv_ne : ∀ T ∈ ts, v ∈ T.nodes → T.root ≠ v := fun T hT _ e => + hpv (e ▸ (hc.valid T hT).2.1) + obtain ⟨ts₁, hc₁, hv₁, hpv₁, hp₁⟩ := + hcut.cascading hc hperm (Or.inl rfl) (Or.inl rfl) hv_ne hv_fn hpar + rw [Record.wp_bind] + refine Record.wp_mono ?_ (wp_cascade hfit (n + 1) hc₁ hv₁ hpv₁ hp₁ + (by rw [hcut.numMarked]; omega)) + rintro _ g₂ t₂ ⟨ts₂, hc₂, hv₂, hcost₂⟩ + refine wp_setKey hc₂.minRoot hkfit hfit (Or.inl (hc₂.lowerRootKey hv₂ hsv hk₀ hK)) + fun g' t ht hinv hnr' hnm' => hdone g' _ hinv ?_ + have hΦ₁ : potential n g₁ ≤ potential n g + 24 := by + simp only [potential, credit, hcut.numRoots, hcut.numMarked] + omega + have hΦ' : potential n g' = potential n g₂ := by simp only [potential, hnr', hnm'] + omega + · -- `v` keeps its heap order: only the key changes. + have hlt' : ¬IndexedMinPQ.RawPrioLT (↑v, k) (↑p, g (.key ↑p)) := hlt + simp only [hlt', ite_false] + obtain ⟨hinv, hnot⟩ := FibRawInv.lowerKey_noCut hI hsv hk₀ hK hpar hlt + refine wp_setKey hc.minRoot hkfit hfit (Or.inr ⟨hinv, hnot m hc.minRoot⟩) + fun g' t ht hinv' hnr hnm => ?_ + have hpot : potential n g' = potential n g := by simp only [potential, hnr, hnm] + exact hdone g' (t + 1 + 1) hinv' (by omega) + +end Programs + +end Cslib.DataStructure.PriorityQueue.FibonacciHeap diff --git a/ComplexityTests/FibonacciHeapDecreaseKey.lean b/ComplexityTests/FibonacciHeapDecreaseKey.lean new file mode 100644 index 0000000000..7e4acce3d4 --- /dev/null +++ b/ComplexityTests/FibonacciHeapDecreaseKey.lean @@ -0,0 +1,109 @@ +/- +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.PriorityQueue.FibonacciHeap.DecreaseKey + +/-! +# The record Fibonacci heap's `decreaseKey` on a concrete heap + +A heap on three handles is one chain: root `0` with child `1` with child `2`, and `1` is marked. +It satisfies `Inv`, proved here directly, so the invariant and its `Cascading` form have a +concrete instance with a marked node. Decreasing the key of `2` below its parent's cuts `2`, and +the cascade cuts the marked `1` in turn. The tests check the result by evaluation (the keys, the +three unmarked roots, the minimum root, the exact cost) and apply `wp_decreaseKey`, which gives +admissibility, the invariant of the result and the amortized bound `104`. +-/ + +@[expose] public section + +namespace ComplexityTests.FibonacciHeapDecreaseKey + +open Cslib.WordRAM Cslib.DataStructure Cslib.DataStructure.PriorityQueue + Cslib.DataStructure.PriorityQueue.FibonacciHeap + Cslib.DataStructure.PriorityQueue.WordRAM.FibonacciHeap + +/-- The record specification for heaps on three handles at word size `4`. -/ +abbrev heap : StateTransitionSpec := Record.spec (Cell.ok 3) 4 + +/-- Root `0` (key `1`) with child `1` (key `5`, marked) with child `2` (key `7`). Each child list +and the root list is a one-element circular list. -/ +def chain : Cell → ℕ + | .key 0 => 1 | .key 1 => 5 | .key 2 => 7 + | .par 1 => 0 + 1 | .par 2 => 1 + 1 + | .child 0 => 1 + 1 | .child 1 => 2 + 1 + | .left 1 => 1 | .right 1 => 1 | .left 2 => 2 | .right 2 => 2 + | .deg 0 => 1 | .deg 1 => 1 + | .mark 1 => 1 + | .inHeap 0 => 1 | .inHeap 1 => 1 | .inHeap 2 => 1 + | .minRoot => 0 + 1 | .numRoots => 1 | .numMarked => 1 | .sz => 3 + | _ => 0 + +/-- The chain as a tree. -/ +def tree : FHTree 3 := .node 0 [.node 1 [.node 2 []]] + +/-- The chain is a valid root tree. -/ +theorem valid_tree : ValidRoot (view 3 chain) none tree := by + refine ⟨.mk (by decide) (by decide) rfl + (Or.inr ⟨1, [], rfl, by unfold IsCircList ChainLinks; decide, by decide⟩) + (by decide) (by decide) (fun i hi => by simp at hi; omega) fun T hT => ?_, rfl, rfl⟩ + simp only [List.mem_singleton] at hT + subst hT + refine .mk (by decide) (by decide) rfl + (Or.inr ⟨2, [], rfl, by unfold IsCircList ChainLinks; decide, by decide⟩) + (by decide) (by decide) (fun i hi => by simp at hi; omega) fun T hT => ?_ + simp only [List.mem_singleton] at hT + subst hT + exact .mk (by decide) (by decide) rfl (Or.inl ⟨rfl, rfl⟩) (by simp) (by simp) (by simp) (by simp) + +/-- **The invariant has an instance with a marked node**: the chain is a valid heap. -/ +theorem inv_chain : Inv 3 9 chain := by + refine ⟨[tree], by simpa using valid_tree, by decide, fun v => by revert v; decide, + fun v => by revert v; decide, fun v k h => ?_, by decide, rfl, by decide, by decide, + Or.inr ⟨0, [], rfl, by unfold IsCircList ChainLinks; decide, by decide, by decide⟩⟩ + fin_cases v <;> simp [FibonacciHeap.abs, absRaw, view, chain] at h ⊢ <;> omega + +/-- So the forest is `Cascading` for `2`, with nothing pending. -/ +example : ∃ m ts, Cascading 3 9 (abs 3 chain) (view 3 chain) 2 m none ts := + cascading_of_fibRawInv inv_chain (by decide) + +/-- Decrease the key of `2` from `7` to `3`. -/ +abbrev lower : Prog Unit := decreaseKey 3 2 3 + +/-- The keys after the run. -/ +example : abs 3 (heap.clientState chain lower) = ![some 1, some 5, some 3] := by decide + +/-- Both cuts happened: the three handles are unmarked roots, and `0` is still the minimum. -/ +example : (view 3 (heap.clientState chain lower)).numRoots = 3 ∧ + (view 3 (heap.clientState chain lower)).numMarked = 0 ∧ + (∀ v : Fin 3, (view 3 (heap.clientState chain lower)).par v = 0 ∧ + (view 3 (heap.clientState chain lower)).mark v = 0) ∧ + (view 3 (heap.clientState chain lower)).minRoot = 0 + 1 := by decide + +/-- The run's exact cost in record operations. -/ +example : (heap.clientHistory chain lower).length = 40 := by decide + +/-- The potential before and after: one root and one mark, then three roots. -/ +example : potential 3 chain = 72 ∧ potential 3 (heap.clientState chain lower) = 72 := by decide + +/-- **The specification applies**: `wp_decreaseKey` on this run. -/ +theorem lower_spec : Record.wp (Cell.ok 3) 4 lower (fun _ g' t => + abs 3 g' = Function.update (abs 3 chain) 2 (some 3) ∧ Inv 3 9 g' ∧ + t + potential 3 g' ≤ 104 + potential 3 chain) chain := + wp_decreaseKey (v := 2) (k₀ := 7) (k := 3) (w := 4) inv_chain (by decide) (by decide) (by decide) + (by decide) (by decide) + +/-- So the run is admissible, the result is a valid heap, and the cost is within the bound. -/ +example : heap.ValidHistory chain (heap.clientHistory chain lower) ∧ + Inv 3 9 (heap.clientState chain lower) ∧ + (heap.clientHistory chain lower).length + potential 3 (heap.clientState chain lower) ≤ + 104 + potential 3 chain := by + obtain ⟨hv, -, hI, hc⟩ := (Record.wp_iff _ _ _).mp lower_spec + exact ⟨hv, hI, hc⟩ + +end ComplexityTests.FibonacciHeapDecreaseKey From f9d30105ac206108169c4f66d2063967fe4c7f43 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Mon, 2 Nov 2026 04:18:43 +0000 Subject: [PATCH 5/6] feat(DataStructure/Memory): allocators, and a shared room budget for growing structures (#2239) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * 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 * doc(bib): add Guéneau, Charguéraud and Pottier (ESOP 2018) Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * 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 * 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 * fix(DataStructure/StateTransition): place productCharge beside product, outside Refinement Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * 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 * wip: array stack over memory and queue method lemmas Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * feat(Foundations): affine cost bounds are O(size) Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * wip: queue over memory Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * 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 * 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 * 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 * feat(DataStructure/StateTransition): instance search for nested products The product instances index their specification with `no_index`, so `product (product D E) F` and deeper products find `HasStepFn`, `Total` and `Deterministic` without a named instance. The test of three stacks in one memory drops its named instance. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * feat(DataStructure/Memory): allocators, and a shared room budget for growing structures `Memory.Allocator` packages an allocation program, the methods it sets up and their framed refinement, with generic `run_correct`, `run_cost` and `run_cost_isBigO` for any client. `Allocator.prod` allocates structures one after the other and `Allocator.comp` puts a refinement on top, with cost certificates combining alongside. `Memory.Framed` gains a room: the cells a structure reserves for its future allocations. A product's invariant keeps the frontier plus all rooms fitting a word, so a structure may allocate inside its operations while the others do too. `Framed.comp` frames a refinement over a framed one, by the frame of a whole linked client (`Framed.modifies_demonic`). The queue over two stacks is restated through the allocator, with no setup proof of its own. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * feat(DataStructure/Memory): structures already in memory, and a growth test An allocator may now take over allocated cells instead of allocating them: `Allocator.owned` names them, `Allocates.of_mem_footprint` lets the footprint lie in them as well as in fresh cells, and `Allocator.ProdPre` asks a product's two structures to take over disjoint cells. Fresh allocators default to taking over none. `Allocator.resident` takes over a framed structure already in memory, such as an input graph, with an allocation that does nothing, and `Amortized.resident` carries its certificate over. `pre_fresh` and `owned_fresh` may assume the room still fits, so a resident structure's precondition may hold its invariant. `Framed.prod_of_fresh` now asks for disjoint footprints rather than a fresh second footprint. The new test `DataStructureMemoryAlloc` checks two write-once cells that each reserve one cell and allocate it inside their first `set`, with the footprints, abstractions and frontier plus room after each step and the tight word-size boundary; and stacks held by the input, taken over beside stacks allocated from scratch in the Dijkstra shape. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * feat(DataStructure/Memory): allocations keep the memory beyond the frontier An admissible run changes no cell at or above its final frontier (`Memory.mem_run_of_frontier_le`, `mem_clientState_of_frontier_le`). `Allocator.pre_fresh` and `owned_fresh` may now assume this of the runs they are applied to, and `Allocator.prod` supplies it from the first allocation's admissibility. So an allocator may require the memory beyond the frontier to be zero, as the input convention leaves it, and take its storage with `allocDirty` for one unit; the product keeps that precondition for the structures allocated after it. The test's write-once cells now take their headers this way, and a test over a nonzero cell shows that the precondition is needed. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * fix(DataStructure/PriorityQueue): the binary heap's frame keeps the frontier (Framed.ofStatic) Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * fix(DataStructure): migrate the landed memory clients to Framed.ofStatic's frontier_eq and Apart The binary heap (#2237), the adjacency arrays and the direct-address table (#2238) keep the frontier, so each supplies Framed.ofStatic's frontier_eq from its existing run lemma. Dijkstra.Memory.inv_input now assumes that the frontier after allocation fits a word, which the product invariant Memory.Framed.Apart requires; run_triple supplies it from its fitting bound. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --------- Co-authored-by: Claude Opus 5.5 --- Complexity.lean | 1 + .../Algorithms/Lean/Dijkstra/Memory.lean | 13 +- .../DataStructure/AdjacencyList/Memory.lean | 4 + .../DataStructure/Dictionary/Memory.lean | 3 + Complexity/DataStructure/Memory/Alloc.lean | 584 +++++++++++++++++ Complexity/DataStructure/Memory/Frame.lean | 461 ++++++++++---- .../PriorityQueue/BinaryHeap/Memory.lean | 8 + Complexity/DataStructure/Queue/Memory.lean | 163 ++--- Complexity/DataStructure/Stack/Memory.lean | 59 +- Complexity/DataStructure/StateTransition.lean | 26 +- ComplexityTests/DataStructureMemoryAlloc.lean | 592 ++++++++++++++++++ .../DataStructureMemoryProduct.lean | 78 ++- 12 files changed, 1725 insertions(+), 267 deletions(-) create mode 100644 Complexity/DataStructure/Memory/Alloc.lean create mode 100644 ComplexityTests/DataStructureMemoryAlloc.lean diff --git a/Complexity.lean b/Complexity.lean index e6a7aa722f..27a2c0b1fc 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -2952,6 +2952,7 @@ 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.Alloc public import Complexity.DataStructure.Memory.Field public import Complexity.DataStructure.Memory.Frame public import Complexity.DataStructure.Memory.Record diff --git a/Complexity/Algorithms/Lean/Dijkstra/Memory.lean b/Complexity/Algorithms/Lean/Dijkstra/Memory.lean index 62e06022a5..8a9081023f 100644 --- a/Complexity/Algorithms/Lean/Dijkstra/Memory.lean +++ b/Complexity/Algorithms/Lean/Dijkstra/Memory.lean @@ -176,12 +176,14 @@ theorem holds_inputGraph (G : ListInstance) : /-- **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. -/ +graph. The structures share memory only while its frontier fits a word (`Memory.Framed.Apart`). -/ 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) : + (hA : (inputGraph G.n G.m).Valid G.n) + (hfit : Fits w ((Memory.State.init G.encode).frontier + G.n + 1 + + PriorityQueue.WordRAM.BinaryHeap.space 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⟩ ∧ @@ -202,13 +204,15 @@ theorem inv_input (G : ListInstance) {w K V : ℕ} ⟨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] + · refine ⟨?_, hfit⟩ + 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, + · refine ⟨?_, hfit⟩ + 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 @@ -300,6 +304,7 @@ theorem run_triple (G : ListInstance) {w : ℕ} have hA : (inputGraph G.n G.m).Valid G.n := ⟨rfl⟩ set M := framed hH hT hA G.adj with hM obtain ⟨hinv, habs⟩ := inv_input G hH hT hA + (hfit.of_le (by simp only [PriorityQueue.WordRAM.BinaryHeap.space]; nlinarith)) 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 diff --git a/Complexity/DataStructure/AdjacencyList/Memory.lean b/Complexity/DataStructure/AdjacencyList/Memory.lean index 04c3ae9a8f..f87b81bddc 100644 --- a/Complexity/DataStructure/AdjacencyList/Memory.lean +++ b/Complexity/DataStructure/AdjacencyList/Memory.lean @@ -210,6 +210,10 @@ def framed (hL : L.Valid n) : Memory.Framed (AdjacencyList.spec n) w := obtain ⟨-, -, -, hs'⟩ := ops_run (w := w) hL hs o hv change ((Memory.spec w).clientState _ (ops L o)).mem b = _ rw [hs']) + (fun o hs hv => by + obtain ⟨-, -, -, hs'⟩ := ops_run (w := w) hL hs o hv + change ((Memory.spec w).clientState _ (ops L o)).frontier = _ + rw [hs']) /-- The footprint of the arrays is their two fields. -/ @[simp] theorem framed_footprint (hL : L.Valid n) (s : Memory.State) : diff --git a/Complexity/DataStructure/Dictionary/Memory.lean b/Complexity/DataStructure/Dictionary/Memory.lean index 433b139bc6..9d175ebd81 100644 --- a/Complexity/DataStructure/Dictionary/Memory.lean +++ b/Complexity/DataStructure/Dictionary/Memory.lean @@ -164,6 +164,9 @@ def framed (hT : Valid T w U V) : Memory.Framed (Dictionary.spec U V n_max) w := (fun o hs hv b _ hb => by obtain ⟨-, -, -, -, -, h⟩ := ops_run hT hs o hv exact h b hb) + (fun o hs hv => by + obtain ⟨-, -, -, -, h, -⟩ := ops_run hT hs o hv + exact h) /-- The footprint of a table is its field. -/ @[simp] theorem framed_footprint (hT : Valid T w U V) (s : Memory.State) : diff --git a/Complexity/DataStructure/Memory/Alloc.lean b/Complexity/DataStructure/Memory/Alloc.lean new file mode 100644 index 0000000000..1d2d11b11c --- /dev/null +++ b/Complexity/DataStructure/Memory/Alloc.lean @@ -0,0 +1,584 @@ +/- +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.Foundations.Analysis.Asymptotics.CostBound + +/-! +# Allocating data structures over the memory oracle + +A program that uses data structures over `Memory.spec w` first allocates their storage, then runs +a client of their specification through their methods. A `Memory.Allocator D w` packages the +first half for a specification `D`: + +* the allocation program, which returns a handle such as a layout of named fields; +* the methods, given the handle; +* the abstract state the allocation sets up, the room it needs, and a bound on its cost; +* for each memory with that room, the framed refinement it sets up (`Allocator.framed`), with the + proof that the allocation sets it up (`Memory.Allocates`). + +The structure's footprint lies in fresh cells, which the allocation and later operations take +from the frontier, and in the allocated cells `Allocator.owned` that it takes over. A structure +allocated from scratch takes over none. One that the input already holds, such as a graph given +as adjacency arrays, takes over the cells holding it, and its precondition `Allocator.Pre` says +that they do. `Allocator.resident` is the allocator of a framed structure already in memory, +whose allocation does nothing. + +`Allocator.run` allocates and then runs a client. `Allocator.run_correct` and +`Allocator.run_cost` hold for every allocator and every client: a client admissible for the +specification issues only admissible memory operations, answers as the specification does, and +costs at most the allocation's cost, the potential once allocated, and the upper charges of its +operations. A certificate `Allocator.Amortized` carries the cost side. `Allocator.run_cost_isBigO` +exports a constant per-operation charge as `O(m)` in the number `m` of operations. + +Allocators combine as their structures do. + +* `Allocator.prod` allocates two structures one after the other, and sets up their product over + one memory (`Memory.Framed.prod`). Its room is the sum of the rooms, so it reserves both + structures' growth. Iterated, `A₁.prod (A₂.prod A₃)` allocates the three structures of a client + such as Dijkstra's algorithm, which runs over `product PQ (product Dict Adj)`. +* `Allocator.comp` puts a refinement on top, such as a queue over the pair of its stacks, with + `Memory.Framed.comp`. + +Certificates combine along with them (`Allocator.Amortized.prod`, `Allocator.Amortized.comp`, +`Allocator.Amortized.resident`). An allocation changes no allocated cell, and being admissible, +no cell beyond its new frontier either (`Memory.mem_clientState_of_frontier_le`). So it keeps the +other structures' preconditions, such as that the memory beyond the frontier is zero, and the +cells they take over (`Allocator.pre_fresh`, `Allocator.owned_fresh`). The product's +precondition (`Allocator.ProdPre`) asks in addition that the cells the two structures take over +be disjoint. So `A₁.prod (A₂.prod A₃)` may combine structures allocated from scratch with +structures that the input holds. + +## Main definitions + +* `Memory.Allocates`: what an allocation program establishes for the structure it sets up. +* `Memory.Allocator`: an allocation program, the methods it sets up, and their framed refinement. +* `Memory.Allocator.run`: allocate, then run a client. +* `Memory.Allocator.prod`, `Memory.Allocator.comp`: products and refinements on top. +* `Memory.Allocator.ProdPre`: the precondition of a product. +* `Memory.Allocator.resident`: a structure already in memory. +* `Memory.Allocator.Amortized`: an amortized cost certificate of an allocator. + +## Main results + +* `Memory.Allocator.run_correct`: the run is admissible and answers as the specification. +* `Memory.Allocator.run_cost`, `Memory.Allocator.run_cost_le`: its memory cost. +* `Memory.Allocator.run_cost_isBigO`: the cost as `O(m)` for constant per-operation charges. +* `Memory.Allocator.Amortized.prod`, `Memory.Allocator.Amortized.comp`, + `Memory.Allocator.Amortized.resident`: certificates combine, and carry over to structures + already in memory. +-/ + +@[expose] public section + +namespace Cslib.DataStructure.Memory + +open Cslib.WordRAM + +variable {w : ℕ} + +/-- What running the allocation program `alloc` from the memory `s` establishes for the framed +refinement `M`: its operations are admissible and cost at most `cost`, it changes no allocated +cell, and it sets up `M` with the methods of the handle it returns, holding at the abstract state +`init`. The footprint lies in the allocated cells `owned` that the structure takes over and in +fresh cells, and the frontier plus `M`'s room is at most `room` beyond the old frontier. -/ +structure Allocates {D : StateTransitionSpec.{0, 0, 0}} {H : Type} (alloc : Prog H) + (methods : H → Methods D (spec w)) (init : D.State) (owned : Finset ℕ) (room cost : ℕ) + (s : State) (M : Framed D w) : Prop where + /-- The allocation's operations are admissible. -/ + validHistory : (spec w).ValidHistory s ((spec w).clientHistory s alloc) + /-- The allocation costs at most `cost`. -/ + cost_le : (spec w).totalCost charge s ((spec w).clientHistory s alloc) ≤ cost + /-- The allocation changes no allocated cell. -/ + mem_eq : ∀ a < s.frontier, ((spec w).clientState s alloc).mem a = s.mem a + /-- The structure runs the methods of the returned handle. -/ + methods_eq : M.methods = methods ((spec w).clientResult s alloc) + /-- The structure holds after the allocation. -/ + inv : M.inv ((spec w).clientState s alloc) + /-- It represents `init`. -/ + abs_eq : M.abs ((spec w).clientState s alloc) = init + /-- Its footprint lies in the cells it takes over and in fresh cells. -/ + of_mem_footprint : ∀ a ∈ M.footprint ((spec w).clientState s alloc), a ∈ owned ∨ s.frontier ≤ a + /-- The allocation and the structure's reserved room take at most `room` cells. -/ + room_le : ((spec w).clientState s alloc).frontier + M.room ((spec w).clientState s alloc) ≤ + s.frontier + room + +/-- **Allocators.** A memory program `alloc` that allocates a structure implementing `D`, and +the structure's methods, given the handle that `alloc` returns. From a memory satisfying `Pre` in +which `room` cells beyond the frontier fit a word, the allocation sets up the framed refinement +`framed s`, which represents `init`, at a memory cost of at most `cost`. Its footprint lies in +fresh cells and in the allocated cells `owned s` that it takes over, such as an input that holds +the structure already. -/ +structure Allocator (D : StateTransitionSpec.{0, 0, 0}) (w : ℕ) where + /-- What the allocation returns, such as a layout of named fields. -/ + Handle : Type + /-- The allocation program. -/ + alloc : Prog Handle + /-- The structure's methods, given the handle. -/ + methods : Handle → Methods D (spec w) + /-- The abstract state the allocation sets up. -/ + init : D.State + /-- The cells the allocation takes and the room it reserves for growth. -/ + room : ℕ + /-- A bound on the memory cost of the allocation. -/ + cost : ℕ + /-- What the allocation needs of the memory besides room, such as the structure it takes + over. -/ + Pre : State → Prop := fun _ => True + /-- The allocated cells that the structure takes over instead of allocating them. -/ + owned : State → Finset ℕ := fun _ => ∅ + /-- The cells taken over are allocated. -/ + owned_lt : ∀ {s a}, Pre s → a ∈ owned s → a < s.frontier := by intros; simp_all + /-- Runs that keep every allocated cell and every cell beyond the new frontier and leave the + room fitting, such as other allocations, keep the precondition. -/ + pre_fresh : ∀ {s s' : State}, Pre s → (∀ a < s.frontier, s'.mem a = s.mem a) → + (∀ a, s'.frontier ≤ a → s'.mem a = s.mem a) → s.frontier ≤ s'.frontier → + Fits w (s'.frontier + room) → Pre s' := by intros; trivial + /-- Such runs keep the cells taken over. -/ + owned_fresh : ∀ {s s' : State}, Pre s → (∀ a < s.frontier, s'.mem a = s.mem a) → + (∀ a, s'.frontier ≤ a → s'.mem a = s.mem a) → s.frontier ≤ s'.frontier → + Fits w (s'.frontier + room) → owned s' = owned s := by intros; rfl + /-- The framed refinement that allocating from `s` sets up. -/ + framed : (s : State) → Pre s → Fits w (s.frontier + room) → Framed D w + /-- Allocating from `s` sets it up. -/ + allocates : ∀ s (hs : Pre s) (hroom : Fits w (s.frontier + room)), + Allocates alloc methods init (owned s) room cost s (framed s hs hroom) + +namespace Allocator + +variable {D D₁ D₂ E : StateTransitionSpec.{0, 0, 0}} + +/-! ## Runs -/ + +section Run + +variable (A : Allocator D w) + +/-- Allocate the structure, then run a client of its specification through its methods. -/ +def run {β : Type} (p : D.Client β) : Prog β := A.alloc >>= fun h => link (A.methods h) p + +/-- The history of a run: the allocation's, then the linked client's. -/ +theorem clientHistory_run {β : Type} (p : D.Client β) (s : State) : + (spec w).clientHistory s (A.run p) = (spec w).clientHistory s A.alloc ++ + (spec w).clientHistory ((spec w).clientState s A.alloc) + (link (A.methods ((spec w).clientResult s A.alloc)) p) := + (spec w).clientHistory_bind _ _ s + +/-- The answer of a run is the linked client's. -/ +theorem clientResult_run {β : Type} (p : D.Client β) (s : State) : + (spec w).clientResult s (A.run p) = + (spec w).clientResult ((spec w).clientState s A.alloc) + (link (A.methods ((spec w).clientResult s A.alloc)) p) := + (spec w).clientResult_bind _ _ s + +/-- A run ends where the linked client ends. -/ +theorem clientState_run {β : Type} (p : D.Client β) (s : State) : + (spec w).clientState s (A.run p) = + (spec w).clientState ((spec w).clientState s A.alloc) + (link (A.methods ((spec w).clientResult s A.alloc)) p) := + (spec w).clientState_bind _ _ s + +variable {fD : (s : D.State) → (o : D.Op) → D.State × D.Result o} [D.HasStepFn fD] + +/-- **Correctness of a run.** From a memory with the allocator's precondition and room, a client +admissible for the specification issues only admissible memory operations and answers as the +specification does from `A.init`; the structure then holds at the specified final state. -/ +theorem run_correct {β : Type} (p : D.Client β) {s : State} (hs : A.Pre s) + (hroom : Fits w (s.frontier + A.room)) (hv : D.ValidHistory A.init (D.clientHistory A.init p)) : + (spec w).ValidHistory s ((spec w).clientHistory s (A.run p)) ∧ + (spec w).clientResult s (A.run p) = D.clientResult A.init p ∧ + (A.framed s hs hroom).inv ((spec w).clientState s (A.run p)) ∧ + (A.framed s hs hroom).abs ((spec w).clientState s (A.run p)) = D.clientState A.init p := by + have hA := A.allocates s hs hroom + obtain ⟨hvE, hres, habs, hinv⟩ := + (A.framed s hs hroom).simulates_client p hA.inv (by rw [hA.abs_eq]; exact hv) + rw [hA.methods_eq] at hvE hres habs hinv + rw [hA.abs_eq] at hres habs + rw [clientHistory_run, clientResult_run, clientState_run, + StateTransitionSpec.validHistory_append, StateTransitionSpec.run_runClient] + exact ⟨⟨hA.validHistory, hvE⟩, hres, hinv, habs⟩ + +end Run + +/-! ## Cost certificates -/ + +/-- **An amortized cost certificate of an allocator.** From every memory it can allocate from, +the structure it sets up is amortized against `upper` with a potential that reads only its +footprint and is at most `Φ₀` once allocated. -/ +def Amortized (A : Allocator D w) (upper : D.State → D.Op → ℕ) (Φ₀ : ℕ) : Prop := + ∀ s (hs : A.Pre s) (hroom : Fits w (s.frontier + A.room)), ∃ Φ : State → ℕ, + (A.framed s hs hroom).Amortized charge upper Φ ∧ (A.framed s hs hroom).Local Φ ∧ + Φ ((spec w).clientState s A.alloc) ≤ Φ₀ + +section Cost + +variable {A : Allocator D w} {fD : (s : D.State) → (o : D.Op) → D.State × D.Result o} + [D.HasStepFn fD] + +/-- **The cost of a run.** A client admissible for the specification costs at most the +allocation's cost, the potential once allocated, and the upper charges of its operations. -/ +theorem run_cost {upper : D.State → D.Op → ℕ} {Φ₀ : ℕ} (hA : A.Amortized upper Φ₀) {β : Type} + (p : D.Client β) {s : State} (hs : A.Pre s) (hroom : Fits w (s.frontier + A.room)) + (hv : D.ValidHistory A.init (D.clientHistory A.init p)) : + (spec w).totalCost charge s ((spec w).clientHistory s (A.run p)) ≤ + A.cost + Φ₀ + D.totalCost upper A.init (D.clientHistory A.init p) := by + have hal := A.allocates s hs hroom + obtain ⟨Φ, hc, -, hΦ⟩ := hA s hs hroom + have h := hc.client p hal.inv (by rw [hal.abs_eq]; exact hv) + rw [hal.methods_eq, hal.abs_eq] at h + rw [clientHistory_run, StateTransitionSpec.totalCost_append, StateTransitionSpec.run_runClient] + have := hal.cost_le + omega + +/-- The cost of a run for a constant charge `K` per operation: at most the allocation's cost, +the potential once allocated, and `K` per operation. -/ +theorem run_cost_le {K Φ₀ : ℕ} (hA : A.Amortized (fun _ _ => K) Φ₀) {β : Type} + (p : D.Client β) {s : State} (hs : A.Pre s) (hroom : Fits w (s.frontier + A.room)) + (hv : D.ValidHistory A.init (D.clientHistory A.init p)) : + (spec w).totalCost charge s ((spec w).clientHistory s (A.run p)) ≤ + A.cost + Φ₀ + K * (D.clientHistory A.init p).length := by + have h := run_cost hA p hs hroom hv + rw [StateTransitionSpec.totalCost_const, Nat.mul_comm] at h + exact h + +/-- **The exported form.** For a constant charge per operation, the memory cost of a run is +`O(m)` in the number `m` of operations, over admissible clients. -/ +theorem run_cost_isBigO {K Φ₀ : ℕ} (hA : A.Amortized (fun _ _ => K) Φ₀) {β : Type} {s : State} + (hs : A.Pre s) (hroom : Fits w (s.frontier + A.room)) : + CostIsBigO Filter.atTop (fun m : ℕ => (m : ℝ)) + (fun p : {p : D.Client β // D.ValidHistory A.init (D.clientHistory A.init p)} => + (D.clientHistory A.init p.1).length) + (fun p => (spec w).totalCost charge s ((spec w).clientHistory s (A.run p.1))) := + CostIsBigO.of_le_add_mul (A.cost + Φ₀) K fun p => run_cost_le hA p.1 hs hroom p.2 + +end Cost + +/-! ## Refinements on top -/ + +/-- **A refinement on top of an allocated structure.** The same allocation sets up the +composite `Memory.Framed.comp R M`, whose methods link `R`'s methods through the structure's, +provided `R`'s invariant holds of the allocated abstract state. -/ +def comp (R : Refinement D E) (A : Allocator E w) (hinit : R.inv A.init) : Allocator D w where + Handle := A.Handle + alloc := A.alloc + methods h o := link (A.methods h) (R.methods o) + init := R.abs A.init + room := A.room + cost := A.cost + Pre := A.Pre + owned := A.owned + owned_lt := A.owned_lt + pre_fresh := A.pre_fresh + owned_fresh := A.owned_fresh + framed s hs hroom := Framed.comp R (A.framed s hs hroom) + allocates s hs hroom := + have h := A.allocates s hs hroom + { validHistory := h.validHistory + cost_le := h.cost_le + mem_eq := h.mem_eq + methods_eq := by rw [Framed.comp_methods, h.methods_eq] + inv := ⟨h.inv, by rw [h.abs_eq]; exact hinit⟩ + abs_eq := by rw [Framed.comp_abs, h.abs_eq] + of_mem_footprint := h.of_mem_footprint + room_le := h.room_le } + +/-- **Potentials stack through a refinement on top.** A certificate of `R` against the middle +charges and one of the allocator against them give a certificate of the composite, with `R`'s +potential at the allocated state added. -/ +theorem Amortized.comp {R : Refinement D E} {A : Allocator E w} {hinit : R.inv A.init} + {middle : E.State → E.Op → ℕ} {upper : D.State → D.Op → ℕ} {Φ : E.State → ℕ} {Ψ₀ : ℕ} + (hR : R.Amortized middle upper Φ) (hA : A.Amortized middle Ψ₀) : + (A.comp R hinit).Amortized upper (Φ A.init + Ψ₀) := by + intro s hs hroom + obtain ⟨Ψ, hc, hl, hΨ⟩ := hA s hs hroom + have hal := A.allocates s hs hroom + refine ⟨fun s' => Φ ((A.framed s hs hroom).abs s') + Ψ s', Framed.amortized_comp hR hc, + Framed.Local.add (Framed.Local.comp (Framed.Local.comp_abs _ Φ)) (Framed.Local.comp hl), ?_⟩ + change Φ ((A.framed s hs hroom).abs ((spec w).clientState s A.alloc)) + + Ψ ((spec w).clientState s A.alloc) ≤ Φ A.init + Ψ₀ + rw [hal.abs_eq] + omega + +/-! ## Products -/ + +section Prod + +variable (A₁ : Allocator D₁ w) (A₂ : Allocator D₂ w) + +/-- Allocate both structures, one after the other. -/ +def allocPair : Prog (A₁.Handle × A₂.Handle) := do + let h₁ ← A₁.alloc + let h₂ ← A₂.alloc + pure (h₁, h₂) + +/-- Both allocations' histories, one after the other. -/ +theorem clientHistory_allocPair (s : State) : + (spec w).clientHistory s (allocPair A₁ A₂) = (spec w).clientHistory s A₁.alloc ++ + (spec w).clientHistory ((spec w).clientState s A₁.alloc) A₂.alloc := by + rw [allocPair, (spec w).clientHistory_bind, (spec w).clientHistory_bind] + exact congrArg (_ ++ ·) (List.append_nil _) + +/-- The memory after both allocations. -/ +theorem clientState_allocPair (s : State) : + (spec w).clientState s (allocPair A₁ A₂) = + (spec w).clientState ((spec w).clientState s A₁.alloc) A₂.alloc := by + rw [allocPair, (spec w).clientState_bind, (spec w).clientState_bind] + rfl + +/-- Both handles. -/ +theorem clientResult_allocPair (s : State) : + (spec w).clientResult s (allocPair A₁ A₂) = + ((spec w).clientResult s A₁.alloc, + (spec w).clientResult ((spec w).clientState s A₁.alloc) A₂.alloc) := by + rw [allocPair, (spec w).clientResult_bind, (spec w).clientResult_bind] + rfl + +variable {A₁} + +/-- After allocating the first structure, room for both leaves room for the second. -/ +theorem room_after {s : State} (hs₁ : A₁.Pre s) {r : ℕ} + (hroom : Fits w (s.frontier + (A₁.room + r))) : + Fits w (((spec w).clientState s A₁.alloc).frontier + r) := + hroom.of_le (by + have := (A₁.allocates s hs₁ (hroom.of_le (by omega))).room_le + omega) + +/-- After allocating the first structure, the second one's precondition still holds. -/ +theorem pre_after {s : State} (hs₁ : A₁.Pre s) + (hroom : Fits w (s.frontier + (A₁.room + A₂.room))) (hs₂ : A₂.Pre s) : + A₂.Pre ((spec w).clientState s A₁.alloc) := + have h₁ := A₁.allocates s hs₁ (hroom.of_le (by omega)) + A₂.pre_fresh hs₂ h₁.mem_eq (fun _ => mem_clientState_of_frontier_le s _ h₁.validHistory) + (frontier_le_clientState s _) (room_after hs₁ hroom) + +/-- After allocating the first structure, the second one takes over the same cells. -/ +theorem owned_after {s : State} (hs₁ : A₁.Pre s) + (hroom : Fits w (s.frontier + (A₁.room + A₂.room))) (hs₂ : A₂.Pre s) : + A₂.owned ((spec w).clientState s A₁.alloc) = A₂.owned s := + have h₁ := A₁.allocates s hs₁ (hroom.of_le (by omega)) + A₂.owned_fresh hs₂ h₁.mem_eq (fun _ => mem_clientState_of_frontier_le s _ h₁.validHistory) + (frontier_le_clientState s _) (room_after hs₁ hroom) + +variable (A₁) + +/-- The precondition of a product of allocators: both preconditions, and the cells that the two +structures take over are disjoint. -/ +structure ProdPre (s : State) : Prop where + /-- The first allocator's precondition. -/ + left : A₁.Pre s + /-- The second allocator's precondition. -/ + right : A₂.Pre s + /-- The two structures take over disjoint cells. -/ + disjoint : Disjoint (A₁.owned s) (A₂.owned s) + +/-- **Products of allocators.** Allocate the two structures one after the other, and set up +their product over one memory. The room and the cost add, and the product takes over the cells +that either structure takes over. -/ +def prod : Allocator (product D₁ D₂) w where + Handle := A₁.Handle × A₂.Handle + alloc := allocPair A₁ A₂ + methods := fun (h₁, h₂) => Methods.prod (A₁.methods h₁) (A₂.methods h₂) + init := (A₁.init, A₂.init) + room := A₁.room + A₂.room + cost := A₁.cost + A₂.cost + Pre := ProdPre A₁ A₂ + owned s := A₁.owned s ∪ A₂.owned s + owned_lt hs ha := (Finset.mem_union.mp ha).elim (A₁.owned_lt hs.left) (A₂.owned_lt hs.right) + pre_fresh hs hmem habove hf hr := + have hr₁ := hr.of_le (Nat.add_le_add_left (Nat.le_add_right A₁.room A₂.room) _) + have hr₂ := hr.of_le (Nat.add_le_add_left (Nat.le_add_left A₂.room A₁.room) _) + { left := A₁.pre_fresh hs.left hmem habove hf hr₁ + right := A₂.pre_fresh hs.right hmem habove hf hr₂ + disjoint := by + rw [A₁.owned_fresh hs.left hmem habove hf hr₁, A₂.owned_fresh hs.right hmem habove hf hr₂] + exact hs.disjoint } + owned_fresh hs hmem habove hf hr := by + rw [A₁.owned_fresh hs.left hmem habove hf + (hr.of_le (Nat.add_le_add_left (Nat.le_add_right A₁.room A₂.room) _)), + A₂.owned_fresh hs.right hmem habove hf + (hr.of_le (Nat.add_le_add_left (Nat.le_add_left A₂.room A₁.room) _))] + framed s hs hroom := + (A₁.framed s hs.left (hroom.of_le (by omega))).prod + (A₂.framed ((spec w).clientState s A₁.alloc) (pre_after A₂ hs.left hroom hs.right) + (room_after hs.left hroom)) + allocates s hs hroom := by + -- The two allocations, from `s` to `s₁` and from `s₁` to `s₂`. + obtain ⟨hs₁, hs₂, hd⟩ := hs + have hroom₁ : Fits w (s.frontier + A₁.room) := hroom.of_le (by omega) + have h₁ := A₁.allocates s hs₁ hroom₁ + have h₂ := A₂.allocates _ (pre_after A₂ hs₁ hroom hs₂) (room_after hs₁ hroom) + have ho₂ := owned_after A₂ hs₁ hroom hs₂ + have hf₁ := frontier_le_clientState (w := w) s A₁.alloc + have hfit := h₁.room_le + have hfit₂ := h₂.room_le + -- The second footprint lies in cells taken over, which are allocated and apart from the + -- first structure's, and in cells fresh after the first allocation. + obtain ⟨hinv, habs, hfp, hr⟩ := Framed.prod_of_fresh h₁.inv h₂.mem_eq + (frontier_le_clientState _ _) h₂.inv + (Finset.disjoint_left.mpr fun a ha ha' => by + have hlt := (A₁.framed s hs₁ hroom₁).lt_frontier h₁.inv ha + rcases h₂.of_mem_footprint a ha' with ha' | ha' + · rw [ho₂] at ha' + have := A₂.owned_lt hs₂ ha' + rcases h₁.of_mem_footprint a ha with ha | ha + · exact Finset.disjoint_left.mp hd ha ha' + · omega + · omega) + (hroom.of_le (by omega)) + refine + { validHistory := ?_, cost_le := ?_, mem_eq := ?_, methods_eq := ?_, inv := ?_, + abs_eq := ?_, of_mem_footprint := ?_, room_le := ?_ } + · rw [clientHistory_allocPair, StateTransitionSpec.validHistory_append, + StateTransitionSpec.run_runClient] + exact ⟨h₁.validHistory, h₂.validHistory⟩ + · rw [clientHistory_allocPair, StateTransitionSpec.totalCost_append, + StateTransitionSpec.run_runClient] + have := h₁.cost_le + have := h₂.cost_le + omega + · intro a ha + rw [clientState_allocPair, h₂.mem_eq a (ha.trans_le hf₁), h₁.mem_eq a ha] + · rw [clientResult_allocPair, Framed.prod_methods, h₁.methods_eq, h₂.methods_eq] + · rw [clientState_allocPair] + exact hinv + · rw [clientState_allocPair, habs, h₁.abs_eq, h₂.abs_eq] + · intro a ha + rw [clientState_allocPair, hfp] at ha + rcases Finset.mem_union.mp ha with ha | ha + · exact (h₁.of_mem_footprint a ha).imp_left (Finset.mem_union_left _) + · rcases h₂.of_mem_footprint a ha with ha | ha + · rw [ho₂] at ha + exact .inl (Finset.mem_union_right _ ha) + · exact .inr (hf₁.trans ha) + · rw [clientState_allocPair, hr] + omega + +/-- The product's methods run each side's methods with its own handle. -/ +@[simp] theorem prod_methods (h₁ : A₁.Handle) (h₂ : A₂.Handle) : + (A₁.prod A₂).methods (h₁, h₂) = Methods.prod (A₁.methods h₁) (A₂.methods h₂) := rfl + +/-- The product sets up both abstract states. -/ +@[simp] theorem prod_init : (A₁.prod A₂).init = (A₁.init, A₂.init) := rfl + +/-- The product's room is the sum of the rooms. -/ +@[simp] theorem prod_room : (A₁.prod A₂).room = A₁.room + A₂.room := rfl + +/-- The product's allocation costs at most the sum of the costs. -/ +@[simp] theorem prod_cost : (A₁.prod A₂).cost = A₁.cost + A₂.cost := rfl + +/-- The product takes over the cells that either structure takes over. -/ +@[simp] theorem prod_owned (s : State) : + (A₁.prod A₂).owned s = A₁.owned s ∪ A₂.owned s := rfl + +/-- The product's precondition. -/ +theorem prod_pre_iff (s : State) : (A₁.prod A₂).Pre s ↔ ProdPre A₁ A₂ s := Iff.rfl + +variable {A₁ A₂} + +/-- **Certificates add across a product of allocators**: the charges componentwise, the +potentials once allocated by sum. -/ +theorem Amortized.prod {upper₁ : D₁.State → D₁.Op → ℕ} {upper₂ : D₂.State → D₂.Op → ℕ} + {Φ₁ Φ₂ : ℕ} (hA₁ : A₁.Amortized upper₁ Φ₁) (hA₂ : A₂.Amortized upper₂ Φ₂) : + (A₁.prod A₂).Amortized (productCharge upper₁ upper₂) (Φ₁ + Φ₂) := by + intro s hs hroom + obtain ⟨hs₁, hs₂, -⟩ := hs + have hroom₁ : Fits w (s.frontier + A₁.room) := hroom.of_le (by simp only [prod_room]; omega) + have hs₂' := pre_after A₂ hs₁ hroom hs₂ + have hroom₂ := room_after hs₁ hroom + obtain ⟨Ψ₁, hc₁, hl₁, hΨ₁⟩ := hA₁ s hs₁ hroom₁ + obtain ⟨Ψ₂, hc₂, hl₂, hΨ₂⟩ := hA₂ _ hs₂' hroom₂ + refine ⟨fun s' => Ψ₁ s' + Ψ₂ s', Framed.amortized_prod hc₁ hc₂ hl₁ hl₂, + Framed.Local.add hl₁.prod_left hl₂.prod_right, ?_⟩ + -- The first potential is unchanged by the second allocation. + have h₁ := A₁.allocates s hs₁ hroom₁ + have h₂ := A₂.allocates _ hs₂' hroom₂ + have hfit := h₁.room_le + have hfit₂ := h₂.room_le + have hkeep := hl₁ h₁.inv + (fun a ha => h₂.mem_eq a ((A₁.framed s hs₁ hroom₁).lt_frontier h₁.inv ha)) + (frontier_le_clientState _ _) (hroom.of_le (by simp only [prod_room]; omega)) + change Ψ₁ ((spec w).clientState s (allocPair A₁ A₂)) + + Ψ₂ ((spec w).clientState s (allocPair A₁ A₂)) ≤ Φ₁ + Φ₂ + rw [clientState_allocPair, hkeep] + omega + +end Prod + +/-! ## Structures already in memory -/ + +section Resident + +variable (M : Framed D w) (init : D.State) (room : ℕ) + +/-- **A structure already in memory**, such as a graph that the input holds as adjacency arrays. +Its allocation does nothing. It takes over the footprint of `M`, and needs `M` to hold, to +represent `init` and to have at most `room` cells of room. -/ +def resident : Allocator D w where + Handle := Unit + alloc := pure () + methods _ := M.methods + init := init + room := room + cost := 0 + Pre s := M.inv s ∧ M.abs s = init ∧ M.room s ≤ room + owned := M.footprint + owned_lt hs ha := M.lt_frontier hs.1 ha + pre_fresh {s _} hs hmem _ hf hr := by + obtain ⟨hinv, habs, hle⟩ := hs + obtain ⟨hinv', habs', -, hroom'⟩ := M.of_fresh hinv hmem hf (hr.of_le (by omega)) + exact ⟨hinv', habs'.trans habs, hroom' ▸ hle⟩ + owned_fresh {s _} hs hmem _ hf hr := by + obtain ⟨hinv, -, hle⟩ := hs + obtain ⟨-, -, hfp, -⟩ := M.of_fresh hinv hmem hf (hr.of_le (by omega)) + exact hfp + framed _ _ _ := M + allocates s hs _ := by + obtain ⟨hinv, habs, hle⟩ := hs + exact + { validHistory := trivial + cost_le := le_rfl + mem_eq := fun _ _ => rfl + methods_eq := rfl + inv := hinv + abs_eq := habs + of_mem_footprint := fun _ ha => .inl ha + room_le := Nat.add_le_add_left hle s.frontier } + +/-- A structure already in memory runs `M`'s methods. -/ +@[simp] theorem resident_methods (h : Unit) : (resident M init room).methods h = M.methods := rfl + +/-- It represents `init`. -/ +@[simp] theorem resident_init : (resident M init room).init = init := rfl + +/-- It takes over `M`'s footprint. -/ +@[simp] theorem resident_owned (s : State) : (resident M init room).owned s = M.footprint s := rfl + +/-- Its allocation costs nothing. -/ +@[simp] theorem resident_cost : (resident M init room).cost = 0 := rfl + +/-- Its precondition: `M` holds, represents `init` and has at most `room` cells of room. -/ +theorem resident_pre_iff (s : State) : + (resident M init room).Pre s ↔ M.inv s ∧ M.abs s = init ∧ M.room s ≤ room := Iff.rfl + +variable {M init room} + +/-- **The certificate of a structure already in memory** is the structure's own: a potential +that reads only its footprint and is at most `Φ₀` wherever the structure represents `init`. -/ +theorem Amortized.resident {upper : D.State → D.Op → ℕ} {Φ : State → ℕ} {Φ₀ : ℕ} + (hc : M.Amortized charge upper Φ) (hl : M.Local Φ) + (hΦ : ∀ s, M.inv s → M.abs s = init → Φ s ≤ Φ₀) : + (resident M init room).Amortized upper Φ₀ := fun s hs _ => by + obtain ⟨hinv, habs, -⟩ := hs + exact ⟨Φ, hc, hl, hΦ s hinv habs⟩ + +end Resident + +end Allocator + +end Cslib.DataStructure.Memory diff --git a/Complexity/DataStructure/Memory/Frame.lean b/Complexity/DataStructure/Memory/Frame.lean index 9c41b35613..9992941dbc 100644 --- a/Complexity/DataStructure/Memory/Frame.lean +++ b/Complexity/DataStructure/Memory/Frame.lean @@ -11,54 +11,66 @@ 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. +# Footprints, room, 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, and a room, +the number of cells the structure has reserved for its future allocations. Three obligations make +them honest. + +* `congr`: the invariant, the abstraction, the footprint and the room read only the footprint's + cells, and survive a growing frontier that leaves the reserved room fitting a word. +* `modifies`: a method run changes no allocated cell outside the footprint, the footprint grows + only into cells that the run allocated, and the frontier advances by at most the room the run + gives up. * `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 +A structure laid out in fixed blocks has a constant footprint and no room, and `Framed.ofStatic` +asks for less. A structure that allocates inside its operations, such as a growing array, +reserves room for all of its future growth. Its invariant may then ask that the frontier plus its +room fit a word, which is what `Memory.valid` needs of each allocation. That fact is not +preserved by other structures' allocations on its own, so the product keeps it for everybody. + +**Products.** Two framed refinements implement the product of their specifications over one +shared memory (`Framed.prod`). The product's invariant asks that the footprints be disjoint and +that the frontier plus both rooms fit a word. This is the shared room budget: a method run of one +side writes only its own cells and fresh ones, and advances the frontier by at most the room it +gives up, so the other side keeps its cells and its room, and the budget still fits. The product +is framed again, with the union of the footprints and the sum of the rooms, 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. +**Composition.** A refinement of `D` over `E` composed with a framed refinement of `E` is framed +by the same footprint and room (`Framed.comp`), since a whole linked client keeps the frame of its +calls (`Framed.modifies_demonic`). So a structure built on others, such as a queue over two +stacks, joins a product like any other. + +**Allocation** is a memory program like any other. A run that leaves every allocated cell +unchanged and leaves the room fitting, 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. `Memory.Allocator` packages this. ## Main definitions -* `Memory.Framed`: a refinement over memory with a footprint. -* `Memory.Framed.ofStatic`: the constructor for a constant footprint. +* `Memory.Framed`: a refinement over memory with a footprint and a room. +* `Memory.Framed.ofStatic`: the constructor for a constant footprint and no room. * `Memory.Framed.Local`: a function of memory that reads only the footprint. * `Memory.Framed.prod`: two framed refinements with disjoint footprints implement the product. +* `Memory.Framed.comp`: a refinement over a framed refinement is framed. ## Main results -* `Memory.frontier_le_of_clientRun`: a run never lowers the frontier. +* `Memory.frontier_le_of_clientRun`, `Memory.frontier_le_clientState`: 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.mem_run_of_frontier_le`, `Memory.mem_clientState_of_frontier_le`: an admissible run + changes no cell at or above its final frontier. +* `Memory.Framed.modifies_demonic`: a linked client keeps the frame of its calls. * `Memory.Framed.frame`: a method run of one structure leaves a structure with a disjoint - footprint unchanged. + footprint unchanged, and the shared room budget fitting. * `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 @@ -75,6 +87,8 @@ explicit finite footprints as in `Cslib.WordRAM.HeapAssertion`; see namespace Cslib.DataStructure.Memory +open Cslib.WordRAM + variable {w : ℕ} /-! ## Runs and allocated cells -/ @@ -87,6 +101,12 @@ theorem frontier_le_of_clientRun {α : Type} {s s' : State} {p : Prog α} {a : rw [← (spec w).run_runClient] exact frontier_le_run s _ +/-- No memory program lowers the frontier. -/ +theorem frontier_le_clientState {α : Type} (s : State) (p : Prog α) : + s.frontier ≤ ((spec w).clientState s p).frontier := by + 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 @@ -105,76 +125,219 @@ theorem mem_clientState_of_lt_frontier {α : Type} (s : State) (p : Prog α) {a rw [← (spec w).run_runClient] exact mem_run_of_lt_frontier s _ ha hw +/-- An admissible sequence of operations changes no cell at or above its final frontier: writes +go below the frontier, and an allocation clears only the block that it hands out. -/ +theorem mem_run_of_frontier_le {s : State} {os : List Op} (hv : (spec w).ValidHistory s os) + {a : ℕ} (ha : ((spec w).run s os).1.frontier ≤ a) : ((spec w).run s os).1.mem a = s.mem a := by + induction os generalizing s with + | nil => rfl + | cons o os ih => + obtain ⟨hvo, hvs⟩ := hv + change ((spec w).run (step s o).1 os).1.frontier ≤ a at ha + change ((spec w).run (step s o).1 os).1.mem a = s.mem a + rw [ih hvs ha] + have hf : (step s o).1.frontier ≤ a := (frontier_le_run _ os).trans ha + cases o with + | read => rfl + | write b v => + have hb : b < s.frontier := hvo.1 + simp only [step_write] at hf + have hab : a ≠ b := by omega + exact Function.update_of_ne hab v s.mem + | alloc k => + simp only [step_alloc] at hf + exact clear_of_not_owns (by simp only [Block.Owns]; omega) + | allocDirty => rfl + +/-- An admissible memory program changes no cell at or above its final frontier. -/ +theorem mem_clientState_of_frontier_le {α : Type} (s : State) (p : Prog α) + (hv : (spec w).ValidHistory s ((spec w).clientHistory s p)) {a : ℕ} + (ha : ((spec w).clientState s p).frontier ≤ a) : + ((spec w).clientState s p).mem a = s.mem a := by + rw [← (spec w).run_runClient] at ha ⊢ + exact mem_run_of_frontier_le hv ha + /-! ## 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. -/ +/-- A refinement of `D` over memory whose representation lives in a footprint of allocated cells, +with room reserved for its growth. The invariant, the abstraction, the footprint and the room +read only the footprint's cells; a method run changes no allocated cell outside the footprint; +the footprint grows only into cells at or above the old frontier, which the run allocated; and +the frontier advances by at most the room the run gives up. -/ structure Framed (D : StateTransitionSpec.{0, 0, 0}) (w : ℕ) extends Refinement D (spec w) where /-- The cells holding the representation. -/ footprint : State → Finset ℕ + /-- The cells reserved for the structure's future allocations. -/ + room : State → ℕ /-- 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. -/ + /-- The invariant, the abstraction, the footprint and the room read only the footprint's + cells, and survive a growing frontier that leaves the room fitting a word. -/ 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. -/ + s.frontier ≤ s'.frontier → Fits w (s'.frontier + room s) → + inv s' ∧ abs s' = abs s ∧ footprint s' = footprint s ∧ room s' = room s + /-- A method run changes no allocated cell outside the footprint, the footprint grows only + into fresh cells, and the frontier advances by at most the room given up. -/ 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 + (∀ b ∈ footprint s', b ∈ footprint s ∨ s.frontier ≤ b) ∧ + s'.frontier + room s' ≤ s.frontier + room s namespace Framed -variable {D D₁ D₂ : StateTransitionSpec.{0, 0, 0}} +variable {D D₁ D₂ E : 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`. -/ +/-- The constructor for a constant footprint `fp` and no room: the invariant and abstraction read +only `fp`, and each method's final state agrees with its initial state on the allocated cells +outside `fp` and has the same frontier. -/ 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) : + ((spec w).clientState s (M.methods o)).mem b = s.mem b) + (frontier_eq : ∀ {s} o, M.inv s → D.valid (M.abs s) o → + ((spec w).clientState s (M.methods o)).frontier = s.frontier) : Framed D w where toRefinement := M footprint _ := fp + room _ := 0 lt_frontier := lt_frontier - congr hs h hf := ⟨(congr hs h hf).1, (congr hs h hf).2, rfl⟩ + congr hs h hf _ := ⟨(congr hs h hf).1, (congr hs h hf).2, rfl, 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⟩ + exact ⟨modifies o hs hv, fun b hb => .inl hb, (frontier_eq o hs hv).le⟩ 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. -/ +are and the frontier grows, leaving the room fitting a word. The abstraction is one +(`Local.abs`), and so is the room (`Local.room`); 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 + s.frontier ≤ s'.frontier → Fits w (s'.frontier + M.room s) → 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 +theorem Local.abs : M.Local M.abs := fun hs h hf hr => by + obtain ⟨-, habs, -⟩ := M.congr hs h hf hr + exact habs + +/-- The room reads only the footprint. -/ +theorem Local.room : M.Local M.room := fun hs h hf hr => by + obtain ⟨-, -, -, hroom⟩ := M.congr hs h hf hr + exact hroom /-- A constant reads no cell. -/ -theorem Local.const {β : Type*} (b : β) : M.Local fun _ => b := fun _ _ _ => rfl +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) +theorem Local.add {M : Framed D w} {f g : State → ℕ} (hf : M.Local f) (hg : M.Local g) : + M.Local fun s => f s + g s := fun hs h hfr hr => + congrArg₂ (· + ·) (hf hs h hfr hr) (hg hs h hfr hr) -/-- A run that leaves every allocated cell unchanged preserves a framed refinement. Allocating -another structure is such a run. -/ +/-- A function of the abstract state is local. -/ +theorem Local.comp_abs {β : Type*} (f : D.State → β) : M.Local fun s => f (M.abs s) := + fun hs h hfr hr => congrArg f (Local.abs M hs h hfr hr) + +/-- A run that leaves every allocated cell unchanged and leaves the room fitting 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 + (hmem : ∀ a < s.frontier, s'.mem a = s.mem a) (hf : s.frontier ≤ s'.frontier) + (hroom : Fits w (s'.frontier + M.room s)) : + M.inv s' ∧ M.abs s' = M.abs s ∧ M.footprint s' = M.footprint s ∧ M.room s' = M.room s := + M.congr hs (fun a ha => hmem a (M.lt_frontier hs ha)) hf hroom + +/-- **The frame of a client.** A run of a linked admissible client changes no cell outside the +footprint that was allocated before it, grows the footprint only into fresh cells, and advances +the frontier by at most the room it gives up, as each method run does. -/ +theorem modifies_demonic {α : Type} (p : D.Client α) {s s' : State} {a : α} + {tr : (spec w).Transcript} (hs : M.inv s) (hv : D.DemonicValid (M.abs s) p) + (hrun : (spec w).ClientRun s (link M.methods p) a s' tr) : + (∀ b < s.frontier, b ∉ M.footprint s → s'.mem b = s.mem b) ∧ + (∀ b ∈ M.footprint s', b ∈ M.footprint s ∨ s.frontier ≤ b) ∧ + s'.frontier + M.room s' ≤ s.frontier + M.room s := by + induction p generalizing s tr with + | pure b => + obtain ⟨-, rfl, -⟩ := ((spec w).clientRun_pure_iff _ _ _ _ _).mp hrun + exact ⟨fun _ _ _ => rfl, fun _ hb => .inl hb, le_rfl⟩ + | 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 ⟨r, s₁, tr₁, tr₂, hrun₁, hrun₂, rfl⟩ := (spec w).clientRun_bind_iff.mp hrun + obtain ⟨hstep, hs₁⟩ := M.correct o hs hv_o hrun₁ + obtain ⟨hmod₁, hgrow₁, hroom₁⟩ := M.modifies o hs hv_o hrun₁ + obtain ⟨hmod₂, hgrow₂, hroom₂⟩ := ih r hs₁ (hv_k _ r hstep) hrun₂ + have hf₁ := frontier_le_of_clientRun hrun₁ + refine ⟨fun b hb hb' => ?_, fun b hb => ?_, by omega⟩ + · have hb₁ : b ∉ M.footprint s₁ := fun h => + (hgrow₁ b h).elim hb' fun h' => absurd hb (Nat.not_lt.mpr h') + rw [hmod₂ b (hb.trans_le hf₁) hb₁, hmod₁ b hb hb'] + · rcases hgrow₂ b hb with h | h + · exact hgrow₁ b h + · exact .inr (hf₁.trans h) + +/-! ## Composition -/ + +/-- **A refinement over a framed refinement is framed**, by the same footprint and room: the +upper invariant and abstraction read the lower state only through its abstraction, and each +upper method is a linked client of the lower methods. -/ +def comp (R : Refinement D E) (M : Framed E w) : Framed D w where + toRefinement := R.comp M.toRefinement + footprint := M.footprint + room := M.room + lt_frontier hs ha := M.lt_frontier hs.1 ha + congr {s _} hs h hf hr := by + obtain ⟨hM, hR⟩ := hs + obtain ⟨hM', habs, hfp, hroom⟩ := M.congr hM h hf hr + refine ⟨⟨hM', ?_⟩, ?_, hfp, hroom⟩ + · rwa [habs] + · change R.abs (M.abs _) = R.abs (M.abs s) + rw [habs] + modifies {_} o {_ _ _} hs hv hrun := + M.modifies_demonic (R.methods o) hs.1 (R.valid o hs.2 hv) hrun + +/-- The composite's methods link the upper methods through the lower ones. -/ +theorem comp_methods (R : Refinement D E) (M : Framed E w) : + (comp R M).methods = fun o => link M.methods (R.methods o) := rfl + +/-- The composite is the composition of the refinements. -/ +theorem comp_toRefinement (R : Refinement D E) (M : Framed E w) : + (comp R M).toRefinement = R.comp M.toRefinement := rfl + +/-- The composite's invariant: the lower invariant, and the upper invariant of the lower +abstraction. -/ +theorem comp_inv_iff (R : Refinement D E) (M : Framed E w) (s : State) : + (comp R M).inv s ↔ M.inv s ∧ R.inv (M.abs s) := Iff.rfl + +/-- The composite represents a memory state by the upper abstraction of the lower one. -/ +@[simp] theorem comp_abs (R : Refinement D E) (M : Framed E w) (s : State) : + (comp R M).abs s = R.abs (M.abs s) := rfl + +/-- The composite's footprint is the lower footprint. -/ +@[simp] theorem comp_footprint (R : Refinement D E) (M : Framed E w) (s : State) : + (comp R M).footprint s = M.footprint s := rfl + +/-- The composite's room is the lower room. -/ +@[simp] theorem comp_room (R : Refinement D E) (M : Framed E w) (s : State) : + (comp R M).room s = M.room s := rfl + +/-- A function local to the lower framed refinement is local to the composite. -/ +theorem Local.comp {R : Refinement D E} {M : Framed E w} {β : Type*} {f : State → β} + (hf : M.Local f) : (comp R M).Local f := fun hs h hfr hr => hf hs.1 h hfr hr + +/-- **Potentials stack across composition** with a framed refinement, as for refinements +(`Refinement.Amortized.comp`). -/ +theorem amortized_comp {R : Refinement D E} {M : Framed E w} {lower : State → Op → ℕ} + {middle : E.State → E.Op → ℕ} {upper : D.State → D.Op → ℕ} {Φ : E.State → ℕ} + {Ψ : State → ℕ} (A : R.Amortized middle upper Φ) (B : M.Amortized lower middle Ψ) : + (comp R M).Amortized lower upper fun s => Φ (M.abs s) + Ψ s := + A.comp B + +/-! ## Frames of disjoint structures -/ variable {M} (N : Framed D₂ w) @@ -186,96 +349,122 @@ theorem agree_of_run {s : State} (o : D.Op) {a : D.Result o} {s' : State} ∀ 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) +/-- A method run of `M` leaves room for `N` when both rooms fitted before. -/ +theorem room_of_run {s : State} (o : D.Op) {a : D.Result o} {s' : State} + {tr : (spec w).Transcript} (hM : M.inv s) (hv : D.valid (M.abs s) o) + (hrun : (spec w).ClientRun s (M.methods o) a s' tr) {r : ℕ} + (hroom : Fits w (s.frontier + (M.room s + r))) : Fits w (s'.frontier + (M.room s' + r)) := + hroom.of_le (by obtain ⟨-, -, h⟩ := M.modifies o hM hv hrun; omega) + /-- **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. -/ +disjoint footprint unchanged, and the footprints disjoint and the shared room budget fitting. -/ 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) + (hd : Disjoint (M.footprint s) (N.footprint s)) + (hroom : Fits w (s.frontier + (M.room s + N.room 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 + N.abs s' = N.abs s ∧ N.inv s' ∧ N.footprint s' = N.footprint s ∧ N.room s' = N.room s ∧ + Disjoint (M.footprint s') (N.footprint s') ∧ + Fits w (s'.frontier + (M.room s' + N.room 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' => ?_⟩ + have hroom' := room_of_run o hM hv hrun hroom + obtain ⟨hN', habs, hfp, hr⟩ := N.congr hN (agree_of_run N o hM hN hd hv hrun) hf + (hroom'.of_le (by omega)) + refine ⟨habs, hN', hfp, hr, Finset.disjoint_left.mpr fun b hb hb' => ?_, hr ▸ hroom'⟩ rw [hfp] at hb' - rcases (M.modifies o hM hv hrun).2 b hb with hb | hb + obtain ⟨-, hgrow, -⟩ := M.modifies o hM hv hrun + rcases hgrow 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) + (hd : Disjoint (M.footprint s) (N.footprint s)) + (hroom : Fits w (s.frontier + (M.room s + N.room 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) + ((room_of_run o hM hv hrun hroom).of_le (by omega)) /-! ## 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. -/ +/-- What keeps two framed refinements apart in one memory: disjoint footprints, and room for +both. -/ +def Apart (s : State) : Prop := + Disjoint (M₁.footprint s) (M₂.footprint s) ∧ Fits w (s.frontier + (M₁.room s + M₂.room s)) + +/-- A method run of the left side keeps the right side and keeps the two apart. -/ 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. -/ + {tr : (spec w).Transcript} (h₁ : M₁.inv s) (h₂ : M₂.inv s) (hJ : Apart M₁ M₂ 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' ∧ Apart M₁ M₂ s' := by + obtain ⟨habs, hinv, -, -, hapart⟩ := frame M₂ o h₁ h₂ hJ.1 hJ.2 hv hrun + exact ⟨habs, hinv, hapart⟩ + +/-- A method run of the right side keeps the left side and keeps the two apart. -/ 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⟩ + {tr : (spec w).Transcript} (h₁ : M₁.inv s) (h₂ : M₂.inv s) (hJ : Apart M₁ M₂ 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' ∧ Apart M₁ M₂ s' := by + obtain ⟨habs, hinv, -, -, hd, hroom⟩ := + frame M₁ o h₂ h₁ hJ.1.symm (by rw [Nat.add_comm (M₂.room s)]; exact hJ.2) hv hrun + exact ⟨habs, hinv, hd.symm, by rw [Nat.add_comm (M₁.room s')]; exact hroom⟩ /-- **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. -/ +specifications over one memory, with the union of their footprints and the sum of their rooms, +while they are apart: their footprints are disjoint and the frontier plus both rooms fits a word. +Being apart 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)) + toRefinement := M₁.toRefinement.prod M₂.toRefinement (Apart M₁ M₂) (prod_frame_left M₁ M₂) (prod_frame_right M₁ M₂) footprint s := M₁.footprint s ∪ M₂.footprint s + room s := M₁.room s + M₂.room s lt_frontier {_ _} hs ha := by + obtain ⟨h₁, h₂, -⟩ := hs 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₂] + · exact M₁.lt_frontier h₁ ha + · exact M₂.lt_frontier h₂ ha + congr {_ _} hs h hf hr := by + obtain ⟨h₁, h₂, hd, -⟩ := hs + obtain ⟨h₁', habs₁, hfp₁, hr₁⟩ := M₁.congr h₁ + (fun a ha => h a (Finset.mem_union_left _ ha)) hf (hr.of_le (by omega)) + obtain ⟨h₂', habs₂, hfp₂, hr₂⟩ := M₂.congr h₂ + (fun a ha => h a (Finset.mem_union_right _ ha)) hf (hr.of_le (by omega)) + refine ⟨⟨h₁', h₂', ?_, ?_⟩, ?_, ?_, ?_⟩ + · rwa [hfp₁, hfp₂] + · rwa [hr₁, hr₂] · change (M₁.abs _, M₂.abs _) = (M₁.abs _, M₂.abs _) rw [habs₁, habs₂] · rw [hfp₁, hfp₂] + · rw [hr₁, hr₂] modifies {s} o {a s' tr} hs hv hrun := by - obtain ⟨h₁, h₂, hd⟩ := hs + obtain ⟨h₁, h₂, hd, hroom⟩ := 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 + obtain ⟨hmod, hgrow, hr⟩ := M₁.modifies o h₁ hv hrun + obtain ⟨-, -, hfp₂, hr₂, -⟩ := frame M₂ o h₁ h₂ hd hroom 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) + 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) + · omega | inr o => - obtain ⟨hmod, hgrow⟩ := M₂.modifies o h₂ hv hrun - obtain ⟨-, -, hfp₁, -⟩ := frame M₁ o h₂ h₁ hd.symm hv hrun + obtain ⟨hmod, hgrow, hr⟩ := M₂.modifies o h₂ hv hrun + obtain ⟨-, -, hfp₁, hr₁, -⟩ := frame M₁ o h₂ h₁ hd.symm + (by rw [Nat.add_comm (M₂.room s)]; exact hroom) 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 _) + 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 _) + · omega /-- 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 @@ -283,26 +472,30 @@ theorem prod_methods : (M₁.prod M₂).methods = Methods.prod M₁.methods M₂ /-- 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. -/ +/-- The product's invariant: both sides' invariants, and the two sides apart. -/ 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 + (M₁.prod M₂).inv s ↔ M₁.inv s ∧ M₂.inv s ∧ Apart M₁ M₂ 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 +/-- The product's room is the sum of the rooms. -/ +@[simp] theorem prod_room (s : State) : (M₁.prod M₂).room s = M₁.room s + M₂.room 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 + (M₁.prod M₂).Local f := fun ⟨h₁, _, _⟩ h hfr hr => + hf h₁ (fun a ha => h a (Finset.mem_union_left _ ha)) hfr + (hr.of_le (Nat.add_le_add_left (Nat.le_add_right _ _) _)) /-- 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 + (M₁.prod M₂).Local f := fun ⟨_, h₂, _⟩ h hfr hr => + hf h₂ (fun a ha => h a (Finset.mem_union_right _ ha)) hfr + (hr.of_le (Nat.add_le_add_left (Nat.le_add_left _ _) _)) /-- **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 @@ -313,21 +506,25 @@ theorem amortized_prod {lower : State → Op → ℕ} {upper₁ : D₁.State → (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) + A₁ A₂ (fun {_} o {_ _ _} h₁ h₂ hJ hv hrun => hΦ₂.frame M₂ o h₁ h₂ hJ.1 hJ.2 hv hrun) + (fun {_} o {_ _ _} h₁ h₂ hJ hv hrun => hΦ₁.frame M₁ o h₂ h₁ hJ.1.symm + (by rw [Nat.add_comm (M₂.room _)]; exact hJ.2) 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 +run from `s` to `s'` leaves the cells below `s.frontier` unchanged; `M₂` holds at `s'` on a +footprint disjoint from `M₁`'s, such as one at or above `s.frontier`; and the frontier plus both +rooms fits. Then the product holds at `s'`, with `M₁`'s abstraction, footprint and room 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')) + (h₂ : M₂.inv s') (hd : Disjoint (M₁.footprint s) (M₂.footprint s')) + (hroom : Fits w (s'.frontier + (M₁.room s + M₂.room s'))) : + (M₁.prod M₂).inv s' ∧ (M₁.prod M₂).abs s' = (M₁.abs s, M₂.abs s') ∧ + (M₁.prod M₂).footprint s' = M₁.footprint s ∪ M₂.footprint s' ∧ + (M₁.prod M₂).room s' = M₁.room s + M₂.room s' := by + obtain ⟨h₁', habs, hfp₁, hr₁⟩ := M₁.of_fresh h₁ hmem hf (hroom.of_le (by omega)) + exact ⟨⟨h₁', h₂, by rwa [hfp₁], by rwa [hr₁]⟩, by rw [prod_abs, habs], + by rw [prod_footprint, hfp₁], by rw [prod_room, hr₁]⟩ end Framed diff --git a/Complexity/DataStructure/PriorityQueue/BinaryHeap/Memory.lean b/Complexity/DataStructure/PriorityQueue/BinaryHeap/Memory.lean index 0cb6b26d3e..82a58259e1 100644 --- a/Complexity/DataStructure/PriorityQueue/BinaryHeap/Memory.lean +++ b/Complexity/DataStructure/PriorityQueue/BinaryHeap/Memory.lean @@ -722,6 +722,13 @@ theorem methods_frame (hL : L.Valid w K) {s : Memory.State} (hs : Inv L s) obtain ⟨-, -, -, -, -, h⟩ := methods_run hL hs o hv exact h +/-- An operation leaves the frontier where it was. -/ +theorem methods_frontier (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).clientState s (ops L o)).frontier = s.frontier := 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`. -/ @@ -764,6 +771,7 @@ 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) + (fun o hs hv => methods_frontier hL hs o hv) /-- The footprint of a heap is its layout's cells. -/ @[simp] theorem framed_footprint (hL : L.Valid w K) (s : Memory.State) : diff --git a/Complexity/DataStructure/Queue/Memory.lean b/Complexity/DataStructure/Queue/Memory.lean index 89acafde8b..e3845a1645 100644 --- a/Complexity/DataStructure/Queue/Memory.lean +++ b/Complexity/DataStructure/Queue/Memory.lean @@ -22,16 +22,18 @@ 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. `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 +2. Two array stacks allocated one after the other, as the generic product + `Memory.Allocator.prod` of two stack allocators, 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. -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)`. +`allocator` puts the first step on top of the second (`Memory.Allocator.comp`), and +`amortized_allocator` stacks the potentials across the composition: 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. 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)`. +All three are instances of the generic theorems of `Memory.Allocator`, so this file has no setup +proof of its own. 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 @@ -43,16 +45,15 @@ 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. +* `allocator`: the queue over two array stacks, allocated in memory. * `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. +* `amortized_allocator`: 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)`. @@ -191,100 +192,37 @@ 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 of capacity `C`: allocate the stacks one after the other, +and run the two-stack queue on their product. -/ +def allocator (w C : ℕ) : Allocator (Queue.WordRAM.spec w C) w := + ((Stack.Memory.allocator w C).prod (Stack.Memory.allocator w C)).comp (refinement w C) + (show Inv w C [] from ⟨Nat.zero_le C, fun _ h => absurd h List.not_mem_nil⟩) -/-- 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) : - Refinement (Queue.WordRAM.spec w C) (Memory.spec w) := - (refinement w C).comp (pair h₁ h₂).toRefinement +/-- The allocated queue is empty. -/ +@[simp] theorem init_allocator : (allocator w C).init = [] := rfl + +/-- The two stacks take `2 (C + 1)` cells. -/ +@[simp] theorem room_allocator : (allocator w C).room = 2 * (C + 1) := by + change (C + 1) + (C + 1) = _ + omega + +/-- The two stacks are allocated from scratch, so the allocation needs nothing of the memory +besides room. -/ +theorem pre_allocator (s : Memory.State) : (allocator w C).Pre s := + ⟨trivial, trivial, Finset.disjoint_empty_left _⟩ /-- **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) : - (memRefinement h₁ h₂).Amortized charge (fun _ _ => 9) - fun s => 6 * (Stack.Memory.abs L₂ s).length := by - have hpair := Memory.Framed.amortized_prod (Stack.Memory.amortized h₁) - (Stack.Memory.amortized h₂) (Memory.Framed.Local.const _ 0) (Memory.Framed.Local.const _ 0) +stack call, read through the stacks' abstraction. Allocation leaves no potential. -/ +theorem amortized_allocator : (allocator w C).Amortized (fun _ _ => 9) 0 := by + have hpair := (Stack.Memory.amortized_allocator (w := w) (C := C)).prod + (Stack.Memory.amortized_allocator (w := w) (C := C)) 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 + 0)) = - fun s => 6 * (Stack.Memory.abs L₂ s).length := by - funext s - 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 (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) : (memRefinement h₁ h₂).methods = memMethods L₁ L₂ w C := rfl + exact Allocator.Amortized.comp (amortized.mul_left 3) hpair /-- 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), - (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)) - -- 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 - obtain ⟨hi₂, ha₂⟩ := Stack.Memory.inv_allocLayout (C := C) - ⟨clear s.mem s.frontier 1, s.frontier + 1 + C⟩ - -- 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 ((pair h₁ h₂).abs (allocated s C)) = [] - rw [hempty] - rfl +def run (w C : ℕ) {β : Type} (p : (Queue.WordRAM.spec w C).Client β) : Prog β := + (allocator w C).run p /-- **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 @@ -293,17 +231,9 @@ theorem run_correct {β : Type} (p : (Queue.WordRAM.spec w C).Client β) {s : Me (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₂, hinv, habs, -⟩ := setup s hfit - obtain ⟨hvE, hres, -, -⟩ := - (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 ⊢ - 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])⟩ + (Memory.spec w).clientResult s (run w C p) = (Queue.WordRAM.spec w C).clientResult [] p := + have ⟨hvE, hres, _⟩ := (allocator w C).run_correct p (pre_allocator s) (room_allocator ▸ hfit) hv + ⟨hvE, hres⟩ /-- **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. -/ @@ -311,15 +241,8 @@ theorem run_cost {β : Type} (p : (Queue.WordRAM.spec w C).Client β) {s : Memor (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₂, 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, - StateTransitionSpec.stepFn, step_alloc, step_allocDirty] at h ⊢ - simp only [List.length_nil, Nat.mul_zero, Nat.add_zero, allocated] at h ⊢ - omega + 6 + 9 * ((Queue.WordRAM.spec w C).clientHistory [] p).length := + Allocator.run_cost_le amortized_allocator p (pre_allocator s) (room_allocator ▸ hfit) hv /-- **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 @@ -345,6 +268,6 @@ theorem run_cost_isBigO (s : Memory.State) (hfit : Fits w (s.frontier + 2 * (C + ((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 + Allocator.run_cost_isBigO amortized_allocator (pre_allocator s) (room_allocator ▸ hfit) end Cslib.DataStructure.Queue.Memory diff --git a/Complexity/DataStructure/Stack/Memory.lean b/Complexity/DataStructure/Stack/Memory.lean index 5fb09e09e6..4db5ea5025 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.Memory.Frame +public import Complexity.DataStructure.Memory.Alloc public import Complexity.DataStructure.Stack.WordRAM.Basic /-! @@ -25,7 +25,8 @@ Every operation costs at most three memory units, with no potential (`amortized` 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`). So the stack is framed by its layout (`framed`), and stacks with disjoint layouts share one memory through the generic product -`Memory.Framed.prod`. +`Memory.Framed.prod`. `allocator` packages the allocation of an empty stack (`allocLayout`) with +the framed stack it sets up, so that clients allocate stacks through `Memory.Allocator`. 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 @@ -40,6 +41,7 @@ admissibility of `Memory.spec w` and one static fact of the layout, that the cap * `refinement`: the array stack as a `Refinement` of the bounded stack. * `framed`: the same refinement, framed by the layout's cells. * `allocLayout`: allocate an empty stack. +* `allocator`: allocation and the framed stack, as a `Memory.Allocator`. ## Main results @@ -47,8 +49,9 @@ admissibility of `Memory.spec w` and one static fact of the layout, that the cap * `runClient_push`, `runClient_pop_of_eq_zero`, `runClient_pop_of_pos`, `runClient_size`: the operations evaluate definitionally. * `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. +* `runClient_allocLayout_bind`, `runClient_allocLayout`, `valid_allocLayout`, + `inv_allocLayout`: allocation yields a well-formed empty stack in three memory units. +* `amortized_allocator`: the allocator's cost certificate, three units per operation. ## References @@ -318,6 +321,7 @@ 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) + (fun o _ hv => (modifies_methods hL o hv).2) /-- Every operation costs at most three memory units, so the stack needs no potential. -/ theorem amortized (hL : L.Valid w C) : @@ -385,4 +389,51 @@ theorem inv_allocLayout (s : Memory.State) : exact Nat.zero_le C · simp [abs, h0] +/-- Allocation returns the layout at the frontier, clears the count cell, and advances the +frontier past the items. -/ +theorem runClient_allocLayout (C : ℕ) (s : Memory.State) : + (Memory.spec w).runClient s (allocLayout C) = + (⟨⟨s.frontier, 1⟩, ⟨s.frontier + 1, C⟩⟩, ⟨clear s.mem s.frontier 1, s.frontier + 1 + C⟩, + [.alloc 1, .allocDirty C]) := rfl + +/-- **The array stack as an allocator**: allocate an empty stack of capacity `C` in `C + 1` +cells, at a memory cost of three units. -/ +def allocator (w C : ℕ) : Allocator (Stack.WordRAM.spec w C) w where + Handle := Layout + alloc := allocLayout C + methods L := methods L w C + init := [] + room := C + 1 + cost := 3 + framed s _ hroom := framed (valid_allocLayout (f := s.frontier) (hroom.of_le (by omega))) + allocates s _ hroom := by + obtain ⟨hinv, habs⟩ := inv_allocLayout (C := C) s + refine + { validHistory := ?_, cost_le := ?_, mem_eq := ?_, methods_eq := rfl, inv := ?_, + abs_eq := ?_, of_mem_footprint := ?_, room_le := ?_ } <;> + simp only [StateTransitionSpec.clientHistory, StateTransitionSpec.clientState, + runClient_allocLayout] + · simp only [StateTransitionSpec.validHistory_cons, StateTransitionSpec.stepFn, step_alloc, + valid_alloc, valid_allocDirty] + exact ⟨hroom.of_le (by omega), hroom.of_le (by omega), trivial⟩ + · simp + · exact fun a ha => clear_of_not_owns (by simp only [Block.Owns]; omega) + · exact hinv + · exact habs + · intro a ha + simp only [framed_footprint, Layout.footprint, Finset.mem_union, Block.mem_footprint, + Block.Owns] at ha + right + omega + · simp only [framed, Memory.Framed.ofStatic] + omega + +/-- The allocated stack is empty. -/ +@[simp] theorem init_allocator (w C : ℕ) : (allocator w C).init = [] := rfl + +/-- Every stack operation costs at most three memory units, and allocation leaves no +potential. -/ +theorem amortized_allocator : (allocator w C).Amortized (fun _ _ => 3) 0 := + fun _ _ _ => ⟨fun _ => 0, amortized _, Memory.Framed.Local.const _ 0, le_rfl⟩ + end Cslib.DataStructure.Stack.Memory diff --git a/Complexity/DataStructure/StateTransition.lean b/Complexity/DataStructure/StateTransition.lean index 623ad75564..032f4dac9f 100644 --- a/Complexity/DataStructure/StateTransition.lean +++ b/Complexity/DataStructure/StateTransition.lean @@ -71,8 +71,10 @@ The relational semantics is **demonic** for callers and **angelic** for implemen under `[StateTransitionSpec.HasStepFn]`. * `StateTransitionSpec.fst_run_eq_toFLTS_mtr`, `StateTransitionSpec.run_append`, `StateTransitionSpec.validHistory_append`, `StateTransitionSpec.totalCost_append`, - `StateTransitionSpec.run_runClient`, `StateTransitionSpec.runClient_bind`, `eval_bind`, - `eval_eq_liftM`: functional history and client laws under `[StateTransitionSpec.HasStepFn]`. + `StateTransitionSpec.run_runClient`, `StateTransitionSpec.runClient_bind`, + `StateTransitionSpec.clientResult_bind`, `StateTransitionSpec.clientState_bind`, + `StateTransitionSpec.clientHistory_bind`, `eval_bind`, `eval_eq_liftM`: functional history and + client laws under `[StateTransitionSpec.HasStepFn]`. ## References @@ -870,6 +872,26 @@ theorem runClient_bind (p : D.Client α) (k : α → D.Client β) (s : D.State) exact congrArg (fun r : β × D.State × List D.Op => (r.1, r.2.1, o :: r.2.2)) (ih (D.stepFn s o).2 (D.stepFn s o).1) +/-- A sequential client answers as its continuation, run from where the first client stopped. -/ +theorem clientResult_bind (p : D.Client α) (k : α → D.Client β) (s : D.State) : + D.clientResult s (p >>= k) = D.clientResult (D.clientState s p) (k (D.clientResult s p)) := by + change D.clientResult s (p.bind k) = _ + rw [clientResult, runClient_bind] + +/-- A sequential client stops where its continuation, run from where the first client stopped, +stops. -/ +theorem clientState_bind (p : D.Client α) (k : α → D.Client β) (s : D.State) : + D.clientState s (p >>= k) = D.clientState (D.clientState s p) (k (D.clientResult s p)) := by + change D.clientState s (p.bind k) = _ + rw [clientState, runClient_bind] + +/-- The history of a sequential client is the first client's history, then its continuation's. -/ +theorem clientHistory_bind (p : D.Client α) (k : α → D.Client β) (s : D.State) : + D.clientHistory s (p >>= k) = + D.clientHistory s p ++ D.clientHistory (D.clientState s p) (k (D.clientResult s p)) := by + change D.clientHistory s (p.bind k) = _ + rw [clientHistory, runClient_bind] + /-- On a deterministic specification (`[D.HasStepFn f]`), demonic operation-sequence admissibility `ValidOpSeq` coincides with `D.ValidHistory`. -/ @[simp] diff --git a/ComplexityTests/DataStructureMemoryAlloc.lean b/ComplexityTests/DataStructureMemoryAlloc.lean new file mode 100644 index 0000000000..292ff6f507 --- /dev/null +++ b/ComplexityTests/DataStructureMemoryAlloc.lean @@ -0,0 +1,592 @@ +/- +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 + +/-! +# Allocation inside operations, and structures already in memory + +Two checks of the allocator contract of `Memory.Allocator`, at word size `8`. + +**Room consumed inside operations.** A write-once cell reserves one cell of room when it is +allocated, and allocates that cell inside its first `set`. Its header is taken without clearing, +so its allocator needs the memory beyond the frontier to be zero, which the other cell's +allocation keeps. Two such cells share one memory as `cells`, the product of their allocators. +A client sets them alternately, so each `set` allocates above the other structure's newest cell. +The tests check: + +* the answers and the admissibility of the whole run, by the generic `Allocator.run_correct`; +* the allocations inside the operations, in the run's memory history; +* after each step, the footprints, the abstractions and the frontier plus the remaining room, + which stays at the frontier the allocation reserved up to; +* the boundary: from frontier `251`, where `251 + 4` fits a byte, the run is admissible. From + `252` it is not, and only the right `set` fails: its allocation, of the last of the four + reserved cells, would leave the frontier at `256`; +* that the precondition is needed: over a nonzero cell, an unset cell reads as set. + +**Structures already in memory.** A stack that the input holds is taken over by +`Allocator.resident`, in the shape of Dijkstra's algorithm: two stacks are allocated from +scratch above the input, and the input's stack is used in place. The generic theorems give the +run's answer and cost. Two stacks that the input holds in disjoint cells combine too. Taking +over the same cells twice is excluded by the product's precondition. +-/ + +@[expose] public section + +namespace ComplexityTests.DataStructureMemoryAlloc + +open Cslib.WordRAM Cslib.DataStructure Cslib.DataStructure.Memory + +/-! ## A write-once cell that allocates on its first `set` -/ + +/-- The operations of a write-once cell: set it once, and get its value. -/ +inductive CellOp where + /-- Set the cell to a value. -/ + | set (v : ℕ) + /-- Get the value, if set. -/ + | get + deriving DecidableEq + +/-- Setting answers nothing; getting answers the value, if set. -/ +abbrev CellOp.Result : CellOp → Type + | .set _ => Unit + | .get => Option ℕ + +/-- Setting stores the value, and getting returns it. -/ +def cellStep (c : Option ℕ) : (o : CellOp) → Option ℕ × o.Result + | .set v => (some v, ()) + | .get => (c, c) + +/-- A cell is set once, to a word. -/ +def cellValid (w : ℕ) (c : Option ℕ) : CellOp → Prop + | .set v => c = none ∧ Fits w v + | .get => True + +instance (w : ℕ) (c : Option ℕ) (o : CellOp) : Decidable (cellValid w c o) := by + cases o <;> unfold cellValid <;> infer_instance + +/-- The write-once cell at word size `w`. -/ +abbrev Cell (w : ℕ) : StateTransitionSpec := + StateTransitionSpec.ofFn (State := Option ℕ) (Op := CellOp) (Result := CellOp.Result) cellStep + (cellValid w) + +/-- Admissibility of a concrete history of cell operations is decidable. -/ +instance (w : ℕ) (c : Option ℕ) (os : List CellOp) : Decidable ((Cell w).ValidHistory c os) := by + induction os generalizing c with + | nil => exact isTrue trivial + | cons o os ih => + exact decidable_of_iff (cellValid w c o ∧ (Cell w).ValidHistory (cellStep c o).1 os) Iff.rfl + +variable (h w : ℕ) + +/-- Set: allocate the value cell, write the value there, and point the header `h` at it. -/ +def cellSet (v : ℕ) : Prog Unit := do + let p ← allocDirty 1 + write p v + write h p + +/-- Get: a zero header means unset; otherwise read the cell that it points to. -/ +def cellGet : Prog (Option ℕ) := do + let p ← read h + if p = 0 then pure none else do + let v ← read p + pure (some v) + +/-- The cell's operations as memory programs, with header `h`. -/ +def cellMethods : Methods (Cell w) (spec w) + | .set v => cellSet h v + | .get => cellGet h + +/-- The value cell, if the header points to one. -/ +def cellAbs (s : State) : Option ℕ := if s.mem h = 0 then none else some (s.mem (s.mem h)) + +/-- The header, and the value cell once set. -/ +def cellFootprint (s : State) : Finset ℕ := if s.mem h = 0 then {h} else {h, s.mem h} + +/-- One cell of room until the cell is set. -/ +def cellRoom (s : State) : ℕ := if s.mem h = 0 then 1 else 0 + +/-- The header and the value cell are allocated, and the frontier plus the room fits a word, so +that the first `set` may allocate. -/ +structure CellInv (s : State) : Prop where + /-- The header is allocated. -/ + header_lt : h < s.frontier + /-- The value cell is allocated. -/ + value_lt : s.mem h ≠ 0 → s.mem h < s.frontier + /-- The reserved cell fits. -/ + fits_room : Fits w (s.frontier + cellRoom h s) + +/-- A set allocates one cell at the frontier, writes the value there and points the header at +it. -/ +theorem runClient_cellSet (s : State) (v : ℕ) : + (spec w).runClient s (cellSet h v) = + ((), ⟨Function.update (Function.update s.mem s.frontier v) h s.frontier, s.frontier + 1⟩, + [.allocDirty 1, .write s.frontier v, .write h s.frontier]) := rfl + +/-- A get of an unset cell reads the header. -/ +theorem runClient_cellGet_of_eq_zero (s : State) (h0 : s.mem h = 0) : + (spec w).runClient s (cellGet h) = (none, s, [.read h]) := by + simp [cellGet, h0] + +/-- A get of a set cell reads the header and the value cell. -/ +theorem runClient_cellGet_of_ne_zero (s : State) (h0 : s.mem h ≠ 0) : + (spec w).runClient s (cellGet h) = (some (s.mem (s.mem h)), s, [.read h, .read (s.mem h)]) := by + unfold cellGet + simp only [StateTransitionSpec.runClient_lift_bind', StateTransitionSpec.stepFn, step_read, h0, + ↓reduceIte] + rfl + +/-- Allocating a header takes one cell at the frontier, without clearing it. -/ +theorem runClient_allocDirty_one (s : State) : + (spec w).runClient s (allocDirty 1) = (s.frontier, ⟨s.mem, s.frontier + 1⟩, [.allocDirty 1]) := + rfl + +variable {h w} + +/-- A cell is unset exactly when its header is zero. -/ +theorem cellAbs_eq_none {s : State} : cellAbs h s = none ↔ s.mem h = 0 := by + unfold cellAbs + split <;> simp_all + +variable (h w) + +/-- The write-once cell with header `h` implements its specification. -/ +def cellRefinement : Refinement (Cell w) (spec w) := + Refinement.ofFn (cellMethods h w) (CellInv h w) (cellAbs h) + (by + intro s o hs hv + have hh := CellInv.header_lt hs + cases o with + | set v => + obtain ⟨hnone, hfit⟩ := hv + have h0 := cellAbs_eq_none.mp hnone + have hr := CellInv.fits_room hs + simp only [cellRoom, h0, ↓reduceIte] at hr + simp only [cellMethods, StateTransitionSpec.clientHistory, runClient_cellSet, + StateTransitionSpec.validHistory_cons, StateTransitionSpec.stepFn, step_allocDirty, + step_write, valid_allocDirty, valid_write] + exact ⟨hr, ⟨Nat.lt_add_one _, hfit⟩, ⟨by omega, hr.of_le (by omega)⟩, trivial⟩ + | get => + by_cases h0 : s.mem h = 0 + · simp only [cellMethods, StateTransitionSpec.clientHistory, + runClient_cellGet_of_eq_zero h w s h0] + exact ⟨hh, trivial⟩ + · simp only [cellMethods, StateTransitionSpec.clientHistory, + runClient_cellGet_of_ne_zero h w s h0] + exact ⟨hh, CellInv.value_lt hs h0, trivial⟩) + (by + intro s o hs hv + have hh := CellInv.header_lt hs + cases o with + | set v => + obtain ⟨hnone, -⟩ := hv + have h0 := cellAbs_eq_none.mp hnone + have hr := CellInv.fits_room hs + simp only [cellRoom, h0, ↓reduceIte] at hr + have hne : s.frontier ≠ h := by omega + have hf0 : s.frontier ≠ 0 := by omega + simp only [cellMethods, StateTransitionSpec.clientState, StateTransitionSpec.clientResult, + runClient_cellSet] + refine ⟨?_, ⟨by simp only; omega, fun _ => ?_, ?_⟩⟩ + · simp [cellAbs, cellStep, hne, hf0] + · simp only [Function.update_self] + omega + · simpa [cellRoom, hf0] using hr + | get => + by_cases h0 : s.mem h = 0 + · simp only [cellMethods, StateTransitionSpec.clientState, + StateTransitionSpec.clientResult, runClient_cellGet_of_eq_zero h w s h0] + exact ⟨by simp [cellAbs, h0, cellStep], hs⟩ + · simp only [cellMethods, StateTransitionSpec.clientState, + StateTransitionSpec.clientResult, runClient_cellGet_of_ne_zero h w s h0] + exact ⟨by simp [cellAbs, h0, cellStep], hs⟩) + +/-- The refinement runs the cell's methods. -/ +@[simp] theorem cellRefinement_methods : (cellRefinement h w).methods = cellMethods h w := rfl + +/-- The refinement's abstraction. -/ +@[simp] theorem cellRefinement_abs : (cellRefinement h w).abs = cellAbs h := rfl + +/-- The refinement's invariant. -/ +@[simp] theorem cellRefinement_inv : (cellRefinement h w).inv = CellInv h w := rfl + +/-- The header belongs to the footprint. -/ +theorem header_mem_cellFootprint (s : State) : h ∈ cellFootprint h s := by + unfold cellFootprint + split <;> simp + +/-- **The write-once cell, framed with room.** Its footprint grows into the cell that its first +`set` allocates, and that `set` gives up the one cell of room it advances the frontier by. -/ +def cellFramed : Framed (Cell w) w where + toRefinement := cellRefinement h w + footprint := cellFootprint h + room := cellRoom h + lt_frontier {s a} hs ha := by + have hh := CellInv.header_lt hs + unfold cellFootprint at ha + split at ha + · rw [Finset.mem_singleton] at ha + omega + · rcases Finset.mem_insert.mp ha with ha | ha + · omega + · rw [Finset.mem_singleton] at ha + rw [ha] + exact CellInv.value_lt hs (by assumption) + congr {s s'} hs hmem hf hr := by + have hh : s'.mem h = s.mem h := hmem h (header_mem_cellFootprint h s) + have hroom : cellRoom h s' = cellRoom h s := by simp only [cellRoom, hh] + have hfp : cellFootprint h s' = cellFootprint h s := by simp only [cellFootprint, hh] + refine ⟨⟨(CellInv.header_lt hs).trans_le hf, fun h0 => ?_, hroom ▸ hr⟩, ?_, hfp, hroom⟩ + · rw [hh] at h0 ⊢ + exact (CellInv.value_lt hs h0).trans_le hf + · change cellAbs h s' = cellAbs h s + unfold cellAbs + by_cases h0 : s.mem h = 0 + · simp [hh, h0] + · have hv : s'.mem (s.mem h) = s.mem (s.mem h) := hmem _ (by simp [cellFootprint, h0]) + simp [hh, h0, hv] + modifies {s} o {a s' tr} hs hv hrun := by + obtain ⟨_, _, rfl, _⟩ := ((spec w).clientRun_iff_runClient _ _ _ _ _).mp hrun + simp only [cellRefinement_inv, cellRefinement_abs] at hs hv + have hh := CellInv.header_lt hs + cases o with + | set v => + obtain ⟨hnone, -⟩ := hv + have h0 := cellAbs_eq_none.mp hnone + have hne : s.frontier ≠ h := by omega + simp only [cellRefinement_methods, cellMethods, StateTransitionSpec.clientState, + runClient_cellSet] + refine ⟨fun b hb hb' => ?_, fun b hb => ?_, ?_⟩ + · have hbh : b ≠ h := fun e => hb' (e ▸ header_mem_cellFootprint h s) + change Function.update (Function.update s.mem s.frontier v) h s.frontier b = s.mem b + rw [Function.update_of_ne hbh, Function.update_of_ne (by omega)] + · have hf0 : s.frontier ≠ 0 := by omega + simp only [cellFootprint, Function.update_self, hf0, ↓reduceIte, Finset.mem_insert, + Finset.mem_singleton] at hb + rcases hb with hb | hb + · exact .inl (hb ▸ header_mem_cellFootprint h s) + · exact .inr hb.ge + · have hf0 : s.frontier ≠ 0 := by omega + simp [cellRoom, h0, hf0] + | get => + by_cases h0 : s.mem h = 0 + · simp only [cellRefinement_methods, cellMethods, StateTransitionSpec.clientState, + runClient_cellGet_of_eq_zero h w s h0] + exact ⟨fun _ _ _ => trivial, fun _ hb => .inl hb, le_rfl⟩ + · simp only [cellRefinement_methods, cellMethods, StateTransitionSpec.clientState, + runClient_cellGet_of_ne_zero h w s h0] + exact ⟨fun _ _ _ => trivial, fun _ hb => .inl hb, le_rfl⟩ + +/-- A set costs three memory units, a get at most two, with no potential. -/ +theorem cellAmortized : (cellFramed h w).Amortized charge (fun _ _ => 3) fun _ => 0 := by + apply Refinement.Amortized.ofFn + intro s o _ _ + change (spec w).totalCost charge s ((spec w).clientHistory s (cellMethods h w o)) + 0 ≤ 3 + 0 + cases o with + | set v => simp [cellMethods, StateTransitionSpec.clientHistory, runClient_cellSet] + | get => + by_cases h0 : s.mem h = 0 + · simp [cellMethods, StateTransitionSpec.clientHistory, runClient_cellGet_of_eq_zero h w s h0] + · simp [cellMethods, StateTransitionSpec.clientHistory, runClient_cellGet_of_ne_zero h w s h0] + +/-- **The write-once cell as an allocator**: take a header at the frontier without clearing it, +since the memory beyond the frontier is zero, and reserve one more cell for the first `set`. +Another structure's allocation keeps the memory beyond the new frontier zero. -/ +def cellAllocator : Allocator (Cell w) w where + Handle := ℕ + alloc := allocDirty 1 + methods h := cellMethods h w + init := none + room := 2 + cost := 1 + Pre s := ∀ a, s.frontier ≤ a → s.mem a = 0 + pre_fresh hs _ habove hf _ a ha := (habove a ha).trans (hs a (hf.trans ha)) + framed s _ _ := cellFramed s.frontier w + allocates s hs hroom := by + have h0 : s.mem s.frontier = 0 := hs _ le_rfl + refine + { validHistory := ?_, cost_le := ?_, mem_eq := ?_, methods_eq := rfl, inv := ?_, + abs_eq := ?_, of_mem_footprint := ?_, room_le := ?_ } <;> + simp only [StateTransitionSpec.clientHistory, StateTransitionSpec.clientState, + runClient_allocDirty_one] + · exact ⟨hroom.of_le (by omega), trivial⟩ + · simp + · exact fun _ _ => trivial + · refine ⟨Nat.lt_add_one _, fun h => absurd h0 h, ?_⟩ + change Fits w (s.frontier + 1 + cellRoom s.frontier ⟨s.mem, _⟩) + simp only [cellRoom, h0, ↓reduceIte] + exact hroom.of_le (by omega) + · change cellAbs s.frontier ⟨s.mem, _⟩ = none + simp [cellAbs, h0] + · intro a ha + change a ∈ cellFootprint s.frontier ⟨s.mem, _⟩ at ha + simp only [cellFootprint, h0, ↓reduceIte, Finset.mem_singleton] at ha + exact .inr ha.ge + · change s.frontier + 1 + cellRoom s.frontier ⟨s.mem, _⟩ ≤ _ + simp only [cellRoom, h0, ↓reduceIte] + omega + +/-- Each cell costs three memory units per operation, and allocation leaves no potential. -/ +theorem cellAllocator_amortized : (cellAllocator w).Amortized (fun _ _ => 3) 0 := + fun s _ _ => ⟨fun _ => 0, cellAmortized s.frontier w, Framed.Local.const _ 0, le_rfl⟩ + +/-! ## Two cells that allocate inside their operations -/ + +/-- Two write-once cells in one memory, each with one cell of room for its `set`. -/ +abbrev cells : Allocator (product (Cell 8) (Cell 8)) 8 := (cellAllocator 8).prod (cellAllocator 8) + +/-- The two cells reserve four cells: two headers and two value cells. -/ +example : cells.room = 4 := rfl + +/-- Set the left cell. -/ +def setLeft : (product (Cell 8) (Cell 8)).Client Unit := + (product (Cell 8) (Cell 8)).call (.inl (.set 5)) + +/-- Set the left cell, then the right one. -/ +def setBoth : (product (Cell 8) (Cell 8)).Client Unit := do + let _ ← (product (Cell 8) (Cell 8)).call (.inl (.set 5)) + let _ ← (product (Cell 8) (Cell 8)).call (.inr (.set 7)) + pure () + +/-- Set both cells, then get both. -/ +def client : (product (Cell 8) (Cell 8)).Client (Option ℕ × Option ℕ) := do + setBoth + let a ← (product (Cell 8) (Cell 8)).call (.inl .get) + let b ← (product (Cell 8) (Cell 8)).call (.inr .get) + pure (a, b) + +/-- Memory with nothing allocated. -/ +def nothing : State := ⟨fun _ => 0, 0⟩ + +/-- Besides room, the two cells need the memory beyond the frontier to be zero, as the input +convention leaves it. The second cell's need survives the first cell's allocation. -/ +theorem pre {s : State} (hs : ∀ a, s.frontier ≤ a → s.mem a = 0) : cells.Pre s := + ⟨hs, hs, Finset.disjoint_empty_left _⟩ + +/-- The four reserved cells fit a byte. -/ +theorem fits : Fits 8 (nothing.frontier + cells.room) := by decide + +/-- The two cells, as set up by the allocation from `nothing`. -/ +abbrev framed : Framed (product (Cell 8) (Cell 8)) 8 := + cells.framed nothing (pre fun _ _ => rfl) fits + +/-- The client is admissible: each cell is set once, to a byte. -/ +theorem client_valid : (product (Cell 8) (Cell 8)).ValidHistory cells.init + ((product (Cell 8) (Cell 8)).clientHistory cells.init client) := + ⟨⟨rfl, by decide⟩, ⟨rfl, by decide⟩, trivial, trivial, trivial⟩ + +/-- **The run is admissible and answers as the specification does**, by the generic theorem: no +proof about this client or this product. -/ +theorem run_correct : + (spec 8).ValidHistory nothing ((spec 8).clientHistory nothing (cells.run client)) ∧ + (spec 8).clientResult nothing (cells.run client) = (some 5, some 7) ∧ + framed.abs ((spec 8).clientState nothing (cells.run client)) = (some 5, some 7) := by + obtain ⟨hv, hres, -, habs⟩ := cells.run_correct client (pre fun _ _ => rfl) fits client_valid + exact ⟨hv, hres, habs⟩ + +/-- The same answer, by evaluation. -/ +example : (spec 8).clientResult nothing (cells.run client) = (some 5, some 7) := by decide + +/-- **Each `set` allocates inside the operation**: the headers at `0` and `1`, then the left +value cell at `2` and the right one at `3`, above the other structure's newest cell. -/ +example : (spec 8).clientHistory nothing (cells.run client) = + [.allocDirty 1, .allocDirty 1, .allocDirty 1, .write 2 5, .write 0 2, .allocDirty 1, + .write 3 7, .write 1 3, .read 0, .read 2, .read 1, .read 3] := by + decide + +/-- After allocation: both headers, both cells unset, and two cells of room up to frontier +`4`. -/ +example : let s := (spec 8).clientState nothing (cells.run (pure ())) + framed.footprint s = {0, 1} ∧ framed.abs s = (none, none) ∧ s.frontier = 2 ∧ + framed.room s = 2 := by + decide + +/-- After the left `set`: the left cell has taken its reserved cell `2`, and the right cell keeps +its value, its footprint and its reservation. The frontier plus the room is still `4`. -/ +example : let s := (spec 8).clientState nothing (cells.run setLeft) + framed.footprint s = {0, 2, 1} ∧ framed.abs s = (some 5, none) ∧ s.frontier = 3 ∧ + framed.room s = 1 := by + decide + +/-- After both `set`s: all four reserved cells are used and no room is left. -/ +example : let s := (spec 8).clientState nothing (cells.run setBoth) + framed.footprint s = {0, 2, 1, 3} ∧ framed.abs s = (some 5, some 7) ∧ s.frontier = 4 ∧ + framed.room s = 0 := by + decide + +/-- It costs one unit per header, three per `set` and two per `get`. -/ +example : (spec 8).totalCost charge nothing ((spec 8).clientHistory nothing (cells.run client)) = + 12 := by + decide + +/-- The generic cost theorem: two units to allocate, and three per operation. -/ +example : (spec 8).totalCost charge nothing ((spec 8).clientHistory nothing (cells.run client)) ≤ + 2 + 0 + 3 * 4 := by + have h := Allocator.Amortized.prod (cellAllocator_amortized (w := 8)) + (cellAllocator_amortized (w := 8)) + simp only [productCharge_const] at h + exact Allocator.run_cost_le h client (pre fun _ _ => rfl) fits client_valid + +/-- Get the left cell. -/ +def getLeft : (product (Cell 8) (Cell 8)).Client (Option ℕ) := + (product (Cell 8) (Cell 8)).call (.inl .get) + +/-- A memory with a nonzero cell beyond the frontier, where the left header will be taken. -/ +def dirty : State := ⟨fun a => if a = 0 then 9 else 0, 0⟩ + +/-- **The precondition is needed**: from `dirty` it fails, and the left cell, never set, reads as +set, since its header was taken without clearing. -/ +example : ¬cells.Pre dirty ∧ (spec 8).clientResult dirty (cells.run getLeft) = some 0 := by + refine ⟨fun hs => absurd (Allocator.ProdPre.left hs 0 le_rfl) (by decide), by decide⟩ + +/-! ### The boundary of the reservation -/ + +/-- The highest frontier with room for both cells at word size `8`: `251 + 4 = 255`. -/ +def high : State := ⟨fun _ => 0, 251⟩ + +/-- One cell higher: `252 + 4 = 256` does not fit a byte. -/ +def tooHigh : State := ⟨fun _ => 0, 252⟩ + +example : Fits 8 (high.frontier + cells.room) ∧ ¬Fits 8 (tooHigh.frontier + cells.room) := by + decide + +/-- From the highest frontier with room, the generic theorem gives an admissible run. -/ +example : (spec 8).ValidHistory high ((spec 8).clientHistory high (cells.run client)) := + (cells.run_correct client (pre fun _ _ => rfl) (by decide) client_valid).1 + +/-- One cell higher, the run is not admissible. -/ +example : ¬(spec 8).ValidHistory tooHigh ((spec 8).clientHistory tooHigh (cells.run client)) := by + decide + +/-- Only the right `set` fails, when it allocates the last of the four reserved cells: the +allocations and the left `set` are admissible. -/ +example : (spec 8).ValidHistory tooHigh ((spec 8).clientHistory tooHigh (cells.run setLeft)) ∧ + ¬(spec 8).ValidHistory tooHigh ((spec 8).clientHistory tooHigh (cells.run setBoth)) := by + decide + +/-! ## Stacks already in memory -/ + +/-- 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 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)) + +/-- The stack at layout `i`, taken over as it is in memory, holding `xs`. -/ +abbrev inputStack (i : ℕ) (hi : i < 3) (xs : List ℕ) : Allocator S 8 := + Allocator.resident (Stack.Memory.framed (valid i hi)) xs 0 + +/-- The input: stack `0` holds `7` on top of `5`, and stack `1` holds `4`. -/ +def input : State := + ⟨fun a => if a = 0 then 2 else if a = 1 then 5 else if a = 2 then 7 else if a = 3 then 1 + else if a = 4 then 4 else 0, 6⟩ + +/-- Stack `i` holds in the input. -/ +theorem inv_input (i : ℕ) (hi : i < 2) : Stack.Memory.Inv (layout i) input where + count_allocated := by simp only [Block.Allocated, layout, input]; omega + items_allocated := by simp only [Block.Allocated, layout, input]; omega + count_le := by + obtain _ | _ | i := i + · decide + · decide + · omega + +/-- **The Dijkstra shape**: two stacks allocated from scratch above the input, and the input's +stack `0` taken over in place, as Dijkstra's algorithm takes over its input graph. -/ +abbrev dijkstraShape : Allocator (product S (product S S)) 8 := + (Stack.Memory.allocator 8 2).prod ((Stack.Memory.allocator 8 2).prod (inputStack 0 (by decide) + [7, 5])) + +/-- The input holds the stack that the third structure takes over. -/ +theorem pre_dijkstraShape : dijkstraShape.Pre input := + ⟨trivial, ⟨trivial, ⟨inv_input 0 (by decide), by decide, le_rfl⟩, Finset.disjoint_empty_left _⟩, + Finset.disjoint_empty_left _⟩ + +/-- Pop the input's stack, push `1` on the first fresh stack and `2` on the second, then pop +all three. -/ +def dijkstraClient : (product S (product S S)).Client (List (Option ℕ)) := do + let a ← (product S (product S S)).call (.inr (.inr .pop)) + let _ ← (product S (product S S)).call (.inl (.push 1)) + let _ ← (product S (product S S)).call (.inr (.inl (.push 2))) + let b ← (product S (product S S)).call (.inl .pop) + let c ← (product S (product S S)).call (.inr (.inl .pop)) + let d ← (product S (product S S)).call (.inr (.inr .pop)) + pure [a, b, c, d] + +/-- The client is admissible from the allocated states. -/ +theorem dijkstraClient_valid : (product S (product S S)).ValidHistory dijkstraShape.init + ((product S (product S S)).clientHistory dijkstraShape.init dijkstraClient) := + ⟨trivial, ⟨by decide, by decide⟩, ⟨by decide, by decide⟩, trivial, trivial, trivial, trivial⟩ + +/-- **The generic correctness theorem**: the run answers as the specification does from the +input's stack and two empty ones. -/ +example : (spec 8).clientResult input (dijkstraShape.run dijkstraClient) = + [some 7, some 1, some 2, some 5] := by + obtain ⟨-, hres, -⟩ := + dijkstraShape.run_correct dijkstraClient pre_dijkstraShape (by decide) dijkstraClient_valid + rw [hres] + decide + +/-- The same answer, by evaluation. The fresh stacks take the six cells above the input, and +the input's stack is popped in place: its count cell, at address `0`, ends at `0`. -/ +example : (spec 8).clientResult input (dijkstraShape.run dijkstraClient) = + [some 7, some 1, some 2, some 5] ∧ + ((spec 8).clientState input (dijkstraShape.run dijkstraClient)).frontier = 12 ∧ + ((spec 8).clientState input (dijkstraShape.run dijkstraClient)).mem 0 = 0 := by + decide + +/-- The generic cost theorem: six units to allocate the fresh stacks, none for the input's, and +three per operation. -/ +example : (spec 8).totalCost charge input ((spec 8).clientHistory input + (dijkstraShape.run dijkstraClient)) ≤ 6 + 0 + 3 * 6 := by + have hres : (inputStack 0 (by decide) [7, 5]).Amortized (fun _ _ => 3) 0 := + Allocator.Amortized.resident (Stack.Memory.amortized _) (Framed.Local.const _ 0) + fun _ _ _ => le_rfl + have h := Allocator.Amortized.prod (Stack.Memory.amortized_allocator (w := 8) (C := 2)) + (Allocator.Amortized.prod (Stack.Memory.amortized_allocator (w := 8) (C := 2)) hres) + simp only [productCharge_const] at h + exact Allocator.run_cost_le h dijkstraClient pre_dijkstraShape (by decide) dijkstraClient_valid + +/-- Two stacks that the input holds in disjoint cells. -/ +abbrev bothInputs : Allocator (product S S) 8 := + (inputStack 0 (by decide) [7, 5]).prod (inputStack 1 (by decide) [4]) + +/-- Pop both input stacks twice. -/ +def popBoth : (product S S).Client (List (Option ℕ)) := do + let a ← (product S S).call (.inl .pop) + let b ← (product S S).call (.inr .pop) + let c ← (product S S).call (.inl .pop) + let d ← (product S S).call (.inr .pop) + pure [a, b, c, d] + +/-- Both stacks hold in the input, in disjoint cells. -/ +theorem pre_bothInputs : bothInputs.Pre input := + ⟨⟨inv_input 0 (by decide), by decide, le_rfl⟩, ⟨inv_input 1 (by decide), by decide, le_rfl⟩, + by decide⟩ + +/-- The generic correctness theorem for two structures taken over in place. -/ +example : (spec 8).clientResult input (bothInputs.run popBoth) = + [some 7, some 4, some 5, none] := by + obtain ⟨-, hres, -⟩ := bothInputs.run_correct popBoth pre_bothInputs (by decide) + ⟨trivial, trivial, trivial, trivial, trivial⟩ + rw [hres] + decide + +/-- **The same cells cannot be taken over twice**: the product's precondition asks for disjoint +cells, so no memory satisfies it for one stack taken over twice. -/ +example (s : State) : ¬((inputStack 0 (by decide) [7, 5]).prod + (inputStack 0 (by decide) [7, 5])).Pre s := fun hs => by + have hd : Disjoint (layout 0).footprint (layout 0).footprint := Allocator.ProdPre.disjoint hs + exact absurd hd (by decide) + +end ComplexityTests.DataStructureMemoryAlloc diff --git a/ComplexityTests/DataStructureMemoryProduct.lean b/ComplexityTests/DataStructureMemoryProduct.lean index 52d5e75184..2ad73fad46 100644 --- a/ComplexityTests/DataStructureMemoryProduct.lean +++ b/ComplexityTests/DataStructureMemoryProduct.lean @@ -99,15 +99,16 @@ theorem inv_layout (i : ℕ) (hi : i < 3) : Stack.Memory.Inv (layout i) empty wh /-- 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⟩ + ⟨⟨inv_layout 0 (by decide), inv_layout 1 (by decide), by decide, by decide⟩, + inv_layout 2 (by decide), 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 + have ⟨_, hres, _⟩ := 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 + trivial, trivial, trivial⟩ + hres /-- Every operation of the three stacks costs at most three memory units, amortized with zero potential: the stacks' certificates add across both products. -/ @@ -117,11 +118,78 @@ theorem amortized : triple.Amortized charge (fun _ _ => 3) fun _ => 0 := by (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) + (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 +/-! ## Allocated one after the other + +The same three stacks, allocated by a program rather than laid out by hand, in the shape of a +client of three structures such as Dijkstra's algorithm over `product PQ (product Dict Adj)`. +The generic theorems of `Memory.Allocator` give the run's admissibility, answer and cost, with no +setup proof for this client. -/ + +/-- Three stacks of capacity `2`, allocated one after the other. -/ +abbrev allocated : Allocator (product S (product S S)) 8 := + (Stack.Memory.allocator 8 2).prod + ((Stack.Memory.allocator 8 2).prod (Stack.Memory.allocator 8 2)) + +/-- The client above, on the right-nested product. -/ +def client' : (product S (product S S)).Client (List (Option ℕ) × List ℕ) := do + let _ ← (product S (product S S)).call (.inl (.push 1)) + let _ ← (product S (product S S)).call (.inl (.push 2)) + let _ ← (product S (product S S)).call (.inr (.inr (.push 3))) + let a ← (product S (product S S)).call (.inl .pop) + let b ← (product S (product S S)).call (.inl .pop) + let m ← (product S (product S S)).call (.inr (.inl .size)) + let n ← (product S (product S S)).call (.inr (.inr .size)) + pure ([a, b], [m, n]) + +/-- Memory with nothing allocated. -/ +def nothing : State := ⟨fun _ => 0, 0⟩ + +/-- The allocated run answers as the linked client on hand-placed stacks. -/ +example : (spec 8).clientResult nothing (allocated.run client') = ([some 2, some 1], [0, 1]) := by + decide + +/-- It costs the 17 units of the client and three units per allocated stack. -/ +example : (spec 8).totalCost charge nothing ((spec 8).clientHistory nothing + (allocated.run client')) = 9 + 17 := by + decide + +/-- The three stacks are allocated from scratch, so nothing is needed of the memory besides +room. -/ +theorem pre_allocated (s : State) : allocated.Pre s := + ⟨trivial, ⟨trivial, trivial, Finset.disjoint_empty_left _⟩, Finset.disjoint_empty_left _⟩ + +/-- The client is admissible for the three bounded stacks. -/ +theorem client'_valid : (product S (product S S)).ValidHistory allocated.init + ((product S (product S S)).clientHistory allocated.init client') := + ⟨⟨by decide, by decide⟩, ⟨by decide, by decide⟩, ⟨by decide, by decide⟩, trivial, trivial, + trivial, trivial, trivial⟩ + +/-- The stacks' certificates add across both products of allocators. -/ +theorem amortized_allocated : allocated.Amortized (fun _ _ => 3) 0 := by + have h := Allocator.Amortized.prod (Stack.Memory.amortized_allocator (w := 8) (C := 2)) + (Allocator.Amortized.prod (Stack.Memory.amortized_allocator (w := 8) (C := 2)) + (Stack.Memory.amortized_allocator (w := 8) (C := 2))) + simp only [productCharge_const] at h + exact h + +/-- The generic correctness theorem gives the specification's answer. -/ +example : (spec 8).clientResult nothing (allocated.run client') = + (product S (product S S)).clientResult allocated.init client' := + have ⟨_, hres, _⟩ := + allocated.run_correct client' (pre_allocated _) (by decide) client'_valid + hres + +/-- The generic cost theorem: nine units to allocate, and three per operation. -/ +example : (spec 8).totalCost charge nothing ((spec 8).clientHistory nothing + (allocated.run client')) ≤ 9 + 0 + 3 * 7 := + Allocator.run_cost_le amortized_allocated client' (pre_allocated _) (by decide) + client'_valid + end ComplexityTests.DataStructureMemoryProduct From 5565334e09da0aa04eef5beec9b3a0da40749087 Mon Sep 17 00:00:00 2001 From: Samuel Schlesinger Date: Mon, 2 Nov 2026 04:33:11 +0000 Subject: [PATCH 6/6] feat(Algorithms/Lean/Karger): Karger's contraction algorithm as a randomized client, survival proved on the specification (#2241) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * 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 * doc(bib): add Guéneau, Charguéraud and Pottier (ESOP 2018) Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * 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 * 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 * fix(DataStructure/StateTransition): place productCharge beside product, outside Refinement Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * 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 * wip: array stack over memory and queue method lemmas Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * feat(Foundations): affine cost bounds are O(size) Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * wip: queue over memory Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * 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 * 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 * feat(DataStructure): distributional refinements and a random table over memory `RandomizedSpec` gives each operation a law, a stateful `PMF` handler. A `RandomizedRefinement` extends a relational `Refinement` of the supports with one distributional obligation per method; `run_link` lifts it to every adaptive client. The identical-until-bad step reuses `OracleComp.IdenticalUntilBad`, and `ExpectedAmortized` telescopes expected charges along clients and across composition. `withCoins` adds private coins (`ProbOracleComp`) to a lower interface. Pilot: a random table stored in a field array over `Memory.spec w` with coins refines the seed-level hash-family spec `HashFamily.seedSpec`; its run from allocation has transcript law `HashFamily.evalOps` (decision D10 of #2205). Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * feat(DataStructure): stack coin-using distributional hops; deterministic hops as distributional Follow-ups to #2232 for #2205. - `RandomizedRefinement.withCoins`: coins pass through a refinement unchanged. - `RandomizedRefinement.mergeCoins`: two layers of private coins are one. - `RandomizedRefinement.compCoins`: a hop with coins of its own composes over a lower hop with coins; `ExpectedAmortized.withCoins`/`.compCoins` stack expected potentials across it. - `Refinement.toRandomized`, `Refinement.Amortized.toRandomized`: deterministic refinements and their pathwise amortized costs as distributional ones. - `Probability.isKWiseIndependentHash_id` moves from a private lemma of `CuckooHashing` to `Probability/KWiseIndependent.lean`; the memory random table gets its `kWiseSpec` contract (`RandomTable.kWiseSpec_contract_run`). Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * feat(Algorithms/Lean/Karger): Karger's contraction algorithm as a randomized client, with its survival bound on the specification For #2205 (decision D10). Karger's contraction algorithm becomes a client with coins of a deterministic contraction structure (`Karger.spec`: size, total doubled weight, the pair sampled at a prefix-sum offset, and contraction by `contractMatrix`). Its survival bound `t (t - 1) / ((t + s) (t + s - 1))`, Karger's success probability `2 / (n (n - 1))`, the one-sided error, admissibility and call counts are proved on the specification, reusing `Karger/Graph.lean` and the `Probability.PMF` event-composition bounds unchanged. Supporting lemmas: `RandomizedSpec.withCoins_run_sample_bind`, `StateTransitionSpec.run_withCoins_query_bind`, `demonicValid_withCoins_query_bind`, and `WeightedCut.cutWeight_fin_two`, `totalDoubledWeight_fin_two`. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG * fix(StateTransition): use OracleComp.sumHandler after #2201 #2201 retired `ProbOracleComp.handler` and `handler_eq_sumHandler`. The coin interface `withCoins` now uses the canonical `OracleComp.sumHandler`, which `ProbOracleComp.handler` was equal to. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --------- Co-authored-by: Claude Opus 5.5 --- Complexity.lean | 1 + .../Algorithms/Lean/Karger/Contraction.lean | 442 ++++++++++++++++++ .../StateTransition/Randomized.lean | 27 ++ .../Combinatorics/WeightedCut.lean | 19 + ComplexityTests/KargerContraction.lean | 67 +++ 5 files changed, 556 insertions(+) create mode 100644 Complexity/Algorithms/Lean/Karger/Contraction.lean create mode 100644 ComplexityTests/KargerContraction.lean diff --git a/Complexity.lean b/Complexity.lean index 27a2c0b1fc..ff38dfb625 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -21,6 +21,7 @@ public import Complexity.Algorithms.Lean.Huffman.Optimality public import Complexity.Algorithms.Lean.Huffman.TwoQueue public import Complexity.Algorithms.Lean.KMP.Basic public import Complexity.Algorithms.Lean.KMP.Search +public import Complexity.Algorithms.Lean.Karger.Contraction public import Complexity.Algorithms.Lean.Kruskal.Basic public import Complexity.Algorithms.Lean.Kruskal.SimpleGraph public import Complexity.Algorithms.Lean.Matroid.Greedy diff --git a/Complexity/Algorithms/Lean/Karger/Contraction.lean b/Complexity/Algorithms/Lean/Karger/Contraction.lean new file mode 100644 index 0000000000..92b7827b9a --- /dev/null +++ b/Complexity/Algorithms/Lean/Karger/Contraction.lean @@ -0,0 +1,442 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Algorithms.WordRAM.Karger.Graph +public import Complexity.DataStructure.StateTransition.Randomized + +/-! +# Karger's contraction algorithm as a randomized client + +Karger's contraction algorithm [Karger1993] [KargerStein1996] keeps a weighted multigraph on its +current supervertices. It repeatedly picks an edge with probability proportional to its weight +and contracts it. Here the multigraph is an abstract data type, the contraction structure `spec`, +whose state is the weight matrix of the current supervertices (`Graph`) and whose operations are +deterministic: + +* `size` and `total` answer the number of supervertices and the total doubled weight `S`; +* `pairAt r` answers the pair `(u, v)` whose interval of the prefix sums of the weights contains + the offset `r < S` (`sampledPair`, the single-draw sampling of `Karger.Graph`); +* `contract u v` merges `v` into `u` and moves the last supervertex into slot `v` + (`contractMatrix`). + +The algorithm is a client with private coins, a `ProbOracleComp Op.Result` program, run against +`spec.toRandomized.withCoins`. Each step draws a uniform offset below `S`, asks for the pair there +and contracts it (`contractStep`), so it contracts each edge `{u, v}` with probability +`2 W u v / S`. `contractTimes s` makes `s` steps, and `karger` contracts down to two supervertices +and answers half their total weight, the weight of the cut between them. + +All probability is proved here, on the specification. Contracting from `t + s` down to `t` +supervertices preserves a fixed minimum cut with probability at least +`t (t - 1) / ((t + s) (t + s - 1))` (`survives_contractTimes`), so `karger` answers the minimum cut +weight with probability at least `2 / (n (n - 1))` (`two_div_le_toOuterMeasure_karger`), and never +less than it (`minCut_le_of_mem_support_karger`). Every call it makes is admissible +(`demonicValid_karger`). The combinatorics and the one-step bound are `Karger.Graph`'s +(`isContractionOf_contract`, `pullbackCut_contractCut`, `step_survival_prob_ge`, +`telescope_survival_step`), used unchanged, and the composition of the stages is +`Probability.PMF.toOuterMeasure_bind_ge_mul_ennreal`. + +The word-RAM implementation proves the same bound on machine states, interleaved with register +steps (`Cslib.Algorithms.WordRAM.Karger.contractDownTo_spec`). Here no register, address or +instruction count appears. An implementation of `spec` over the memory oracle is a separate, +deterministic hop, and `Refinement.toRandomized` with `RandomizedRefinement.withCoins` carries the +law of the client through it. + +## Main definitions + +* `Graph`, `Op`, `step`, `valid`, `spec`: the contraction structure. +* `sampledPair`, `contractGraph`: the pair sampled at an offset, and contraction. +* `contractStep`, `contractTimes`, `karger`: the algorithm as a client with coins. +* `Survives`: a cut of the input survives in a contracted graph. + +## Main results + +* `survives_contractTimes`: the survival bound. +* `two_div_le_toOuterMeasure_karger`: Karger's success probability. +* `isContractionOf_of_mem_support_contractTimes`, `minCut_le_of_mem_support_karger`: every + outcome is a contraction, so the answer is never below the minimum cut weight. +* `isCostBounded_contractStep`, `isCostBounded_contractTimes`: each contraction makes one coin + call and at most four calls of the structure. +* `demonicValid_contractTimes`, `demonicValid_karger`: every call is admissible. + +## References + +* [D. R. Karger, *Global Min-cuts in RNC, and Other Ramifications of a Simple Min-Cut + Algorithm*][Karger1993] +* [D. R. Karger and C. Stein, *A New Approach to the Minimum Cut Problem*][KargerStein1996] +-/ + +@[expose] public section + +namespace Cslib.Algorithms.Lean.Karger + +open scoped ENNReal +open Cslib.WeightedCut Cslib.Algorithms.WordRAM.Karger Cslib.DataStructure + +/-! ## The contraction structure -/ + +/-- A weighted multigraph on `size` supervertices, given by its weight matrix. -/ +structure Graph where + /-- The number of supervertices. -/ + size : ℕ + /-- The weight matrix. -/ + weight : Fin size → Fin size → ℕ + +/-- The operations of the contraction structure. -/ +inductive Op where + /-- The number of supervertices. -/ + | size + /-- The total doubled weight, the sum of the weighted degrees. -/ + | total + /-- The pair sampled at offset `r` of the prefix sums of the weights. -/ + | pairAt (r : ℕ) + /-- Merge supervertex `v` into `u`. -/ + | contract (u v : ℕ) + +/-- The answer type of each operation. -/ +abbrev Op.Result : Op → Type + | .size => ℕ + | .total => ℕ + | .pairAt _ => ℕ × ℕ + | .contract _ _ => Unit + +open Classical in +/-- The pair sampled at offset `r`: the pair `(u, v)` whose interval of the prefix sums of the +weights contains `r` (`IsSampledPair`), or `(0, 0)` if there is none. -/ +noncomputable def sampledPair {k : ℕ} (W : Fin k → Fin k → ℕ) (r : ℕ) : ℕ × ℕ := + if h : ∃ p : Fin k × Fin k, IsSampledPair W r p.1 p.2 then + Prod.map Fin.val Fin.val (Classical.choose h) + else (0, 0) + +/-- Contraction: merge `v` into `u` and move the last supervertex into slot `v` +(`contractMatrix`). Arguments out of range leave the graph unchanged. -/ +def contractGraph : Graph → ℕ → ℕ → Graph + | ⟨k + 1, W⟩, u, v => + if h : u < k + 1 ∧ v < k + 1 then ⟨k, contractMatrix W ⟨u, h.1⟩ ⟨v, h.2⟩⟩ else ⟨k + 1, W⟩ + | G, _, _ => G + +/-- The transition function of the contraction structure. -/ +noncomputable def step (G : Graph) : (o : Op) → Graph × o.Result + | .size => (G, G.size) + | .total => (G, totalDoubledWeight G.weight) + | .pairAt r => (G, sampledPair G.weight r) + | .contract u v => (contractGraph G u v, ()) + +/-- Admissibility: an offset below the total weight, and two distinct supervertices. -/ +def valid (G : Graph) : Op → Prop + | .pairAt r => r < totalDoubledWeight G.weight + | .contract u v => u < G.size ∧ v < G.size ∧ u ≠ v + | _ => True + +/-- The contraction structure. -/ +noncomputable abbrev spec : StateTransitionSpec := StateTransitionSpec.ofFn step valid + +/-- The pair sampled at an offset is the unique pair whose interval contains it. -/ +theorem sampledPair_eq {k : ℕ} {W : Fin k → Fin k → ℕ} {r : ℕ} {u v : Fin k} + (h : IsSampledPair W r u v) : sampledPair W r = ((u : ℕ), (v : ℕ)) := by + have hex : ∃ p : Fin k × Fin k, IsSampledPair W r p.1 p.2 := ⟨(u, v), h⟩ + obtain ⟨hu, hv⟩ := isSampledPair_unique W (Classical.choose_spec hex) h + rw [sampledPair, dite_eq_left hex, ← hu, ← hv] + rfl + +/-- Contracting two supervertices in range is `contractMatrix`. -/ +theorem contractGraph_fin {m : ℕ} (W : Fin (m + 1) → Fin (m + 1) → ℕ) (u v : Fin (m + 1)) : + contractGraph ⟨m + 1, W⟩ u v = ⟨m, contractMatrix W u v⟩ := by + rw [contractGraph, dite_eq_left ⟨u.isLt, v.isLt⟩] + +/-! ## The algorithm -/ + +/-- A call of the contraction structure, in a program with coins. -/ +abbrev call (o : Op) : ProbOracleComp Op.Result o.Result := ProbOracleComp.query o + +/-- One contraction: draw a uniform offset below the total weight, and contract the pair sampled +there. A weightless graph contracts its first and last supervertices. -/ +noncomputable def contractStep : ProbOracleComp Op.Result Unit := do + let k ← call .size + let S ← call .total + if S = 0 then call (.contract 0 (k - 1)) else do + let r ← ProbOracleComp.sample (ProbComp.unifFin (S - 1)) + let (u, v) ← call (.pairAt r) + call (.contract u v) + +/-- Contract `s` times. -/ +noncomputable def contractTimes : ℕ → ProbOracleComp Op.Result Unit + | 0 => pure () + | s + 1 => contractStep >>= fun _ => contractTimes s + +/-- **Karger's algorithm**: contract down to two supervertices, and answer the weight between +them, half their total weight. -/ +noncomputable def karger : ProbOracleComp Op.Result ℕ := do + let k ← call .size + contractTimes (k - 2) + let S ← call .total + pure (S / 2) + +/-! ## Runs -/ + +/-- One contraction of a graph of positive weight draws a uniform offset below the weight and +contracts the pair sampled there. -/ +private theorem run_contractStep_bind {α : Type} (p : ProbOracleComp Op.Result α) {m : ℕ} + (W : Fin (m + 1) → Fin (m + 1) → ℕ) (hS : totalDoubledWeight W ≠ 0) : + spec.toRandomized.withCoins.run (contractStep >>= fun _ => p) ⟨m + 1, W⟩ = + (ProbComp.unifOracle (totalDoubledWeight W - 1)).bind fun r => + spec.toRandomized.withCoins.run p + (contractGraph ⟨m + 1, W⟩ (sampledPair W r).1 (sampledPair W r).2) := by + simp only [contractStep, bind_assoc] + rw [StateTransitionSpec.run_withCoins_query_bind, StateTransitionSpec.run_withCoins_query_bind] + dsimp only [StateTransitionSpec.stepFn, step] + simp only [hS, ite_false, bind_assoc] + rw [RandomizedSpec.withCoins_run_sample_bind, ProbComp.eval_unifFin] + refine congrArg _ (funext fun r => ?_) + rw [StateTransitionSpec.run_withCoins_query_bind, StateTransitionSpec.run_withCoins_query_bind] + rfl + +/-- One contraction of a weightless graph contracts its first and last supervertices. -/ +private theorem run_contractStep_bind_of_eq_zero {α : Type} (p : ProbOracleComp Op.Result α) + {m : ℕ} (W : Fin (m + 1) → Fin (m + 1) → ℕ) (hS : totalDoubledWeight W = 0) : + spec.toRandomized.withCoins.run (contractStep >>= fun _ => p) ⟨m + 1, W⟩ = + spec.toRandomized.withCoins.run p ⟨m, contractMatrix W 0 (Fin.last m)⟩ := by + simp only [contractStep, bind_assoc] + rw [StateTransitionSpec.run_withCoins_query_bind, StateTransitionSpec.run_withCoins_query_bind] + dsimp only [StateTransitionSpec.stepFn, step] + simp only [hS, ite_true] + rw [StateTransitionSpec.run_withCoins_query_bind] + exact congrArg _ (contractGraph_fin W 0 (Fin.last m)) + +/-! ## Survival of a minimum cut -/ + +/-- The cut `C` of `W₀` survives in `G`: `G` is a contraction of `W₀` to `t` supervertices along +some map, under which `C` is the preimage of a cut. -/ +def Survives {n : ℕ} (W₀ : Fin n → Fin n → ℕ) (C : Finset (Fin n)) (t : ℕ) (G : Graph) : Prop := + ∃ (W : Fin t → Fin t → ℕ) (part : Fin n → Fin t) (B : Finset (Fin t)), + G = ⟨t, W⟩ ∧ IsContractionOf W₀ part W ∧ pullbackCut part B = C + +/-- **Survival of a minimum cut** [KargerStein1996]. Contracting a contraction of a connected +multigraph `W₀` from `t + s` down to `t ≥ 2` supervertices preserves a fixed minimum cut with +probability at least `t (t - 1) / ((t + s) (t + s - 1))`. -/ +theorem survives_contractTimes {n t : ℕ} (ht : 2 ≤ t) {W₀ : Fin n → Fin n → ℕ} + (hmin : 0 < minCut W₀) (s : ℕ) {W : Fin (t + s) → Fin (t + s) → ℕ} + {part : Fin n → Fin (t + s)} (hC : IsContractionOf W₀ part W) {B : Finset (Fin (t + s))} + (hB : IsNonTrivialCut B) (hBmin : cutWeight W₀ (pullbackCut part B) = minCut W₀) : + ((t * (t - 1) : ℕ) : ℝ≥0∞) / (((t + s) * (t + s - 1) : ℕ) : ℝ≥0∞) ≤ + (spec.toRandomized.withCoins.run (contractTimes s) ⟨t + s, W⟩).toOuterMeasure + {x | Survives W₀ (pullbackCut part B) t x.2} := by + induction s with + | zero => + have hpos : ((t * (t - 1) : ℕ) : ℝ≥0∞) ≠ 0 := by + exact_mod_cast (Nat.mul_pos (by omega) (by omega)).ne' + change ((t * (t - 1) : ℕ) : ℝ≥0∞) / ((t * (t - 1) : ℕ) : ℝ≥0∞) ≤ + (PMF.pure ((), (⟨t, W⟩ : Graph))).toOuterMeasure _ + rw [ENNReal.div_self hpos (ENNReal.natCast_ne_top _), PMF.toOuterMeasure_pure_apply, + ite_eq_left ⟨W, part, B, rfl, hC, rfl⟩] + | succ s ih => + have hcard : 2 ≤ Fintype.card (Fin (t + s + 1)) := by rw [Fintype.card_fin]; omega + have hminW : minCut W₀ ≤ minCut W := minCut_le_of_isContractionOf hcard hC + have hS : 0 < totalDoubledWeight W := + totalDoubledWeight_pos_of_minCut_pos hcard hC.multigraph (lt_of_lt_of_le hmin hminW) + change _ ≤ (spec.toRandomized.withCoins.run (contractStep >>= fun _ => contractTimes s) + ⟨t + s + 1, W⟩).toOuterMeasure _ + rw [run_contractStep_bind (m := t + s) _ W hS.ne', + show (t + (s + 1)) * (t + (s + 1) - 1) = (t + s + 1) * (t + s) by + rw [show t + (s + 1) - 1 = t + s by omega]; rfl, + ← telescope_survival_step ht (show t ≤ t + s by omega)] + let castFin : Fin (totalDoubledWeight W - 1 + 1) ≃ Fin (totalDoubledWeight W) := + finCongr (by omega) + have hdeg : (t + s + 1) * cutWeight W B ≤ totalDoubledWeight W := by + have hmul := mul_minCut_le_totalDoubledWeight hcard hC.multigraph + rw [Fintype.card_fin] at hmul + rw [← cutWeight_pullbackCut hC B, hBmin] + exact (Nat.mul_le_mul_left _ hminW).trans hmul + have hstep : ((t + s - 1 : ℕ) : ℝ≥0∞) / (t + s + 1 : ℕ) ≤ + (ProbComp.unifOracle (totalDoubledWeight W - 1)).toOuterMeasure + {r | SampleSurvives W B (castFin r)} := by + have : Nonempty (Fin (totalDoubledWeight W)) := ⟨⟨0, hS⟩⟩ + have h := step_survival_prob_ge (by omega) hC.multigraph hS hdeg + rw [show t + (s + 1) - 2 = t + s - 1 by omega, + ← Probability.PMF.uniformOfFintype_map_equiv castFin, + PMF.toOuterMeasure_map_apply] at h + exact h + refine Probability.PMF.toOuterMeasure_bind_ge_mul_ennreal _ _ _ _ hstep fun r _ hr => ?_ + obtain ⟨u, v, hsamp, hsame⟩ := hr + have hsamp : IsSampledPair W r u v := hsamp + have huv : u ≠ v := isSampledPair_ne hC.multigraph hsamp + have hpb := pullbackCut_contractCut part huv hsame + have hnt : IsNonTrivialCut (contractCut v B) := + isNonTrivialCut_of_pullbackCut _ (hpb ▸ isNonTrivialCut_pullbackCut hC.surj hB) + rw [sampledPair_eq hsamp, contractGraph_fin, ← hpb] + exact ih (isContractionOf_contract hC huv) hnt (hpb ▸ hBmin) + +/-! ## Karger's theorem -/ + +/-- Every outcome of `s` contractions of a contraction of `W₀` from `t + s ≥ 2` supervertices is a +contraction of `W₀` to `t` supervertices. -/ +theorem isContractionOf_of_mem_support_contractTimes {n t : ℕ} (ht : 1 ≤ t) + {W₀ : Fin n → Fin n → ℕ} (s : ℕ) {W : Fin (t + s) → Fin (t + s) → ℕ} + {part : Fin n → Fin (t + s)} (hC : IsContractionOf W₀ part W) {x : Unit × Graph} + (hx : x ∈ (spec.toRandomized.withCoins.run (contractTimes s) ⟨t + s, W⟩).support) : + ∃ (W' : Fin t → Fin t → ℕ) (part' : Fin n → Fin t), + x.2 = ⟨t, W'⟩ ∧ IsContractionOf W₀ part' W' := by + induction s with + | zero => + obtain rfl := (PMF.mem_support_pure_iff _ _).mp hx + exact ⟨W, part, rfl, hC⟩ + | succ s ih => + change x ∈ (spec.toRandomized.withCoins.run (contractStep >>= fun _ => contractTimes s) + ⟨t + s + 1, W⟩).support at hx + by_cases hS : totalDoubledWeight W = 0 + · rw [run_contractStep_bind_of_eq_zero (m := t + s) _ W hS] at hx + have h0 : (0 : Fin (t + s + 1)) ≠ Fin.last (t + s) := by + rw [Ne, Fin.ext_iff, Fin.val_zero, Fin.val_last] + omega + exact ih (isContractionOf_contract hC h0) hx + · rw [run_contractStep_bind (m := t + s) _ W hS, PMF.mem_support_bind_iff] at hx + obtain ⟨r, -, hx⟩ := hx + obtain ⟨u, v, hsamp⟩ := exists_isSampledPair W (show (r : ℕ) < totalDoubledWeight W by + have := r.isLt + omega) + rw [sampledPair_eq hsamp, contractGraph_fin] at hx + exact ih (isContractionOf_contract hC (isSampledPair_ne hC.multigraph hsamp)) hx + +/-- Running `karger` from `n = 2 + s` supervertices contracts `s` times, then answers half the +total weight. -/ +private theorem run_karger {s : ℕ} (W : Fin (2 + s) → Fin (2 + s) → ℕ) : + spec.toRandomized.withCoins.run karger ⟨2 + s, W⟩ = + (spec.toRandomized.withCoins.run (contractTimes s) ⟨2 + s, W⟩).bind fun x => + PMF.pure (totalDoubledWeight x.2.weight / 2, x.2) := by + rw [karger, StateTransitionSpec.run_withCoins_query_bind] + dsimp only [StateTransitionSpec.stepFn, step] + rw [Nat.add_sub_cancel_left, RandomizedSpec.run_bind] + exact congrArg _ (funext fun ⟨_, G⟩ => + StateTransitionSpec.run_withCoins_query_bind (D := spec) Op.total (fun S => pure (S / 2)) G) + +/-- **Karger's theorem** [Karger1993]. On a connected multigraph with `n ≥ 2` vertices, `karger` +answers the minimum cut weight with probability at least `2 / (n (n - 1))`. -/ +theorem two_div_le_toOuterMeasure_karger {n : ℕ} (hn : 2 ≤ n) {W₀ : Fin n → Fin n → ℕ} + (hW₀ : IsMultigraph W₀) (hmin : 0 < minCut W₀) : + (2 : ℝ≥0∞) / ((n * (n - 1) : ℕ) : ℝ≥0∞) ≤ + (spec.toRandomized.withCoins.run karger ⟨n, W₀⟩).toOuterMeasure {x | x.1 = minCut W₀} := by + obtain ⟨s, rfl⟩ : ∃ s, n = 2 + s := ⟨n - 2, by omega⟩ + obtain ⟨C, hC, hCmin⟩ := exists_minCut_achiever (by rw [Fintype.card_fin]; omega) W₀ + have hid : pullbackCut id C = C := by + ext x + simp [mem_pullbackCut] + have hsurv := survives_contractTimes le_rfl hmin s (isContractionOf_id hW₀) hC + (by rw [hid, hCmin]) + rw [hid] at hsurv + rw [run_karger, show (2 : ℝ≥0∞) / ((2 + s) * (2 + s - 1) : ℕ) = + ((2 * (2 - 1) : ℕ) : ℝ≥0∞) / ((2 + s) * (2 + s - 1) : ℕ) * 1 by norm_num] + refine Probability.PMF.toOuterMeasure_bind_ge_mul_ennreal _ _ _ _ hsurv + fun x _ ⟨W', part', B', hx, hC', hpb⟩ => ?_ + have hB' : IsNonTrivialCut B' := isNonTrivialCut_of_pullbackCut part' (hpb ▸ hC) + have hcut : W' 0 1 = minCut W₀ := by + rw [← cutWeight_fin_two hC'.multigraph hB', ← cutWeight_pullbackCut hC', hpb, hCmin] + rw [hx, PMF.toOuterMeasure_pure_apply, ite_eq_left] + change totalDoubledWeight W' / 2 = minCut W₀ + rw [totalDoubledWeight_fin_two hC'.multigraph, ← hcut] + omega + +/-- **One-sided error.** Every answer of `karger` on a multigraph with `n ≥ 2` vertices is the +weight of a non-trivial cut, so it is never below the minimum cut weight. -/ +theorem minCut_le_of_mem_support_karger {n : ℕ} (hn : 2 ≤ n) {W₀ : Fin n → Fin n → ℕ} + (hW₀ : IsMultigraph W₀) {x : ℕ × Graph} + (hx : x ∈ (spec.toRandomized.withCoins.run karger ⟨n, W₀⟩).support) : minCut W₀ ≤ x.1 := by + obtain ⟨s, rfl⟩ : ∃ s, n = 2 + s := ⟨n - 2, by omega⟩ + rw [run_karger, PMF.mem_support_bind_iff] at hx + obtain ⟨y, hy, hx⟩ := hx + obtain ⟨W', part', hy', hC'⟩ := + isContractionOf_of_mem_support_contractTimes (t := 2) (by norm_num) s + (isContractionOf_id hW₀) hy + obtain rfl := (PMF.mem_support_pure_iff _ _).mp hx + obtain ⟨-, hcw, hle⟩ := two_vertex_contraction_output hC' + change minCut W₀ ≤ totalDoubledWeight y.2.weight / 2 + rw [hy'] + change minCut W₀ ≤ totalDoubledWeight W' / 2 + rw [totalDoubledWeight_fin_two hC'.multigraph] + omega + +/-! ## Calls -/ + +/-- One contraction makes at most one coin call and four calls of the structure. -/ +theorem isCostBounded_contractStep {cost : ℕ ⊕ Op → ℕ} {a b : ℕ} + (hcoin : ∀ n, cost (.inl n) ≤ a) (hop : ∀ o, cost (.inr o) ≤ b) : + OracleComp.IsCostBounded cost contractStep (a + 4 * b) := by + have hq (o : Op) {m : ℕ} (hm : b ≤ m) : + OracleComp.IsCostBounded cost (call o) m := + (OracleComp.IsCostBounded.query _).mono ((hop o).trans hm) + have h₁ := hop .size + have h₂ := hop .total + refine OracleComp.IsCostBounded.liftBind_iff.mpr ⟨by omega, fun k => ?_⟩ + refine OracleComp.IsCostBounded.liftBind_iff.mpr ⟨by omega, fun S => ?_⟩ + change OracleComp.IsCostBounded cost (if S = 0 then _ else _) _ + split_ifs + · exact hq _ (by omega) + · have h₃ := hcoin (S - 1) + refine OracleComp.IsCostBounded.liftBind_iff.mpr ⟨by omega, fun r => ?_⟩ + have h₄ := hop (.pairAt r) + exact OracleComp.IsCostBounded.liftBind_iff.mpr ⟨by omega, fun _ => hq _ (by omega)⟩ + +/-- `s` contractions make at most `s` coin calls and `4 s` calls of the structure. -/ +theorem isCostBounded_contractTimes {cost : ℕ ⊕ Op → ℕ} {a b : ℕ} + (hcoin : ∀ n, cost (.inl n) ≤ a) (hop : ∀ o, cost (.inr o) ≤ b) (s : ℕ) : + OracleComp.IsCostBounded cost (contractTimes s) (s * (a + 4 * b)) := by + induction s with + | zero => exact .pure _ _ + | succ s ih => + exact ((isCostBounded_contractStep hcoin hop).bind fun _ => ih).mono + (le_of_eq (by ring)) + +/-! ## Admissibility -/ + +/-- Every call of `s` contractions of a multigraph on `t + s ≥ 2` supervertices is admissible. -/ +theorem demonicValid_contractTimes {t : ℕ} (ht : 1 ≤ t) (s : ℕ) + {W : Fin (t + s) → Fin (t + s) → ℕ} (hW : IsMultigraph W) : + spec.toRandomized.withCoins.toSpec.DemonicValid ⟨t + s, W⟩ (contractTimes s) := by + induction s with + | zero => exact .pure _ _ + | succ s ih => + change spec.toRandomized.withCoins.toSpec.DemonicValid ⟨t + s + 1, W⟩ + (contractStep >>= fun _ => contractTimes s) + simp only [contractStep, bind_assoc] + refine StateTransitionSpec.demonicValid_withCoins_query_bind trivial + (StateTransitionSpec.demonicValid_withCoins_query_bind trivial ?_) + dsimp only [StateTransitionSpec.stepFn, step] + by_cases hS : totalDoubledWeight W = 0 + · simp only [hS, ite_true] + refine StateTransitionSpec.demonicValid_withCoins_query_bind + (show 0 < t + s + 1 ∧ t + s + 1 - 1 < t + s + 1 ∧ 0 ≠ t + s + 1 - 1 by omega) ?_ + dsimp only [StateTransitionSpec.stepFn, step] + rw [show t + s + 1 - 1 = ((Fin.last (t + s) : Fin (t + s + 1)) : ℕ) from rfl, + show (0 : ℕ) = ((0 : Fin (t + s + 1)) : ℕ) from rfl, contractGraph_fin] + exact ih (isMultigraph_contractMatrix hW _ _) + · simp only [hS, ite_false, bind_assoc] + refine RandomizedSpec.demonicValid_sample_bind fun r => ?_ + have hr : (r : ℕ) < totalDoubledWeight W := by + have := r.isLt + omega + obtain ⟨u, v, hsamp⟩ := exists_isSampledPair W hr + refine StateTransitionSpec.demonicValid_withCoins_query_bind hr ?_ + dsimp only [StateTransitionSpec.stepFn, step] + rw [sampledPair_eq hsamp] + refine StateTransitionSpec.demonicValid_withCoins_query_bind + ⟨u.isLt, v.isLt, Fin.val_ne_of_ne (isSampledPair_ne hW hsamp)⟩ ?_ + dsimp only [StateTransitionSpec.stepFn, step] + rw [contractGraph_fin] + exact ih (isMultigraph_contractMatrix hW u v) + +/-- Every call of `karger` on a multigraph with `n ≥ 2` vertices is admissible. -/ +theorem demonicValid_karger {n : ℕ} (hn : 2 ≤ n) {W₀ : Fin n → Fin n → ℕ} + (hW₀ : IsMultigraph W₀) : + spec.toRandomized.withCoins.toSpec.DemonicValid ⟨n, W₀⟩ karger := by + obtain ⟨s, rfl⟩ : ∃ s, n = 2 + s := ⟨n - 2, by omega⟩ + refine StateTransitionSpec.demonicValid_withCoins_query_bind trivial ?_ + dsimp only [StateTransitionSpec.stepFn, step] + rw [Nat.add_sub_cancel_left] + refine StateTransitionSpec.DemonicValid.bind (demonicValid_contractTimes (by omega) s hW₀) + fun _ _ _ _ => StateTransitionSpec.demonicValid_withCoins_query_bind trivial (.pure _ _) + +end Cslib.Algorithms.Lean.Karger diff --git a/Complexity/DataStructure/StateTransition/Randomized.lean b/Complexity/DataStructure/StateTransition/Randomized.lean index 5248fbda60..de38badc36 100644 --- a/Complexity/DataStructure/StateTransition/Randomized.lean +++ b/Complexity/DataStructure/StateTransition/Randomized.lean @@ -317,6 +317,15 @@ theorem demonicValid_sample_bind {q : ProbComp β} {k : β → OracleComp D.with subst hs exact ih i +/-- A closed sampler followed by a continuation draws a value, then runs the continuation from +the same state. -/ +theorem withCoins_run_sample_bind (q : ProbComp β) (k : β → OracleComp D.withCoins.Result α) + (s : D.State) : + D.withCoins.run (ProbOracleComp.sample q >>= k) s = + (ProbComp.eval q).bind fun b => D.withCoins.run (k b) s := by + rw [run_bind, withCoins_run_sample, PMF.bind_map] + rfl + /-- A coin call draws uniformly and leaves the state unchanged. -/ theorem withCoins_law_inl (n : ℕ) (s : D.State) : D.withCoins.law (.inl n) s = (ProbComp.unifOracle n).map (·, s) := rfl @@ -416,6 +425,24 @@ theorem toRandomized_demonicValid_of_validHistory {p : D.Client α} {s : D.State (h : D.ValidHistory s (D.clientHistory s p)) : D.toRandomized.toSpec.DemonicValid s p := toRandomized_demonicValid ((D.demonicValid_iff_validHistory_runClient s p).mpr h) +/-- Over a deterministic specification with coins, a call steps the state and continues with its +answer. -/ +theorem run_withCoins_query_bind {β : Type} (o : D.Op) (k : D.Result o → ProbOracleComp D.Result β) + (s : D.State) : + D.toRandomized.withCoins.run (ProbOracleComp.query o >>= k) s = + D.toRandomized.withCoins.run (k (D.stepFn s o).2) (D.stepFn s o).1 := + PMF.pure_bind _ _ + +/-- Over a deterministic specification with coins, an admissible call whose continuation is +admissible from the next state is admissible. -/ +theorem demonicValid_withCoins_query_bind {β : Type} {o : D.Op} + {k : D.Result o → ProbOracleComp D.Result β} {s : D.State} (hv : D.valid s o) + (hk : D.toRandomized.withCoins.toSpec.DemonicValid (D.stepFn s o).1 (k (D.stepFn s o).2)) : + D.toRandomized.withCoins.toSpec.DemonicValid s (ProbOracleComp.query o >>= k) := + .liftBind (D := D.toRandomized.withCoins.toSpec) (Sum.inr o) k hv fun s' a hstep => by + obtain ⟨rfl, rfl⟩ := Prod.mk.inj ((PMF.mem_support_pure_iff _ _).mp hstep) + exact hk + /-- The expected charge of a deterministic run is the total charge of its history. -/ theorem expectedCost_toRandomized (charge : D.State → D.Op → ℕ) (p : D.Client α) (s : D.State) : diff --git a/Complexity/Foundations/Combinatorics/WeightedCut.lean b/Complexity/Foundations/Combinatorics/WeightedCut.lean index 9b72642631..3e64309752 100644 --- a/Complexity/Foundations/Combinatorics/WeightedCut.lean +++ b/Complexity/Foundations/Combinatorics/WeightedCut.lean @@ -49,6 +49,8 @@ weights; see `Complexity.Foundations.Combinatorics.WeightedCut.Multigraph`. * `Cslib.WeightedCut.cutWeight_compl`: a cut and its complement have the same weight. * `Cslib.WeightedCut.cutWeight_singleton`: a singleton cut weighs the degree of its vertex. +* `Cslib.WeightedCut.cutWeight_fin_two`, `Cslib.WeightedCut.totalDoubledWeight_fin_two`: on two + vertices, every non-trivial cut weighs the weight of the edge, and the degrees sum to twice it. * `Cslib.WeightedCut.le_minCut_iff`: with at least two vertices, `m ≤ minCut W` exactly when every non-trivial cut weighs at least `m`. * `Cslib.WeightedCut.mul_minCut_le_totalDoubledWeight`: `|V| * minCut W` is at most the sum of the @@ -183,6 +185,23 @@ theorem cutWeight_two_singleton_zero {W : Fin 2 → Fin 2 → ℕ} (hW : IsMulti unfold rowDeg rw [Fin.sum_univ_two, hW.2 0, zero_add] +/-- On two vertices, every non-trivial cut weighs the weight of the edge. -/ +theorem cutWeight_fin_two {W : Fin 2 → Fin 2 → ℕ} (hW : IsMultigraph W) {B : Finset (Fin 2)} + (hB : IsNonTrivialCut B) : cutWeight W B = W 0 1 := by + rw [isNonTrivialCut_iff_card, Fintype.card_fin] at hB + obtain ⟨b, rfl⟩ := Finset.card_eq_one.mp (show B.card = 1 by omega) + match b with + | 0 => exact cutWeight_two_singleton_zero hW + | 1 => + rw [show ({1} : Finset (Fin 2)) = Finset.univ \ {0} by decide, cutWeight_compl hW, + cutWeight_two_singleton_zero hW] + +/-- On two vertices, the sum of the degrees is twice the weight of the edge. -/ +theorem totalDoubledWeight_fin_two {W : Fin 2 → Fin 2 → ℕ} (hW : IsMultigraph W) : + totalDoubledWeight W = 2 * W 0 1 := by + simp only [totalDoubledWeight, rowDeg, Fin.sum_univ_two, hW.2, hW.1 1 0] + omega + /-- Global minimum cut weight of a multigraph `W`, defined as the greatest lower bound of `cutWeight W C` over all non-trivial cuts `C`. -/ noncomputable def minCut (W : V → V → ℕ) : ℕ := diff --git a/ComplexityTests/KargerContraction.lean b/ComplexityTests/KargerContraction.lean new file mode 100644 index 0000000000..32ff8bf8fa --- /dev/null +++ b/ComplexityTests/KargerContraction.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: local-only (test driver) + +public import Complexity.Algorithms.Lean.Karger.Contraction + +/-! +# Karger's contraction algorithm on a triangle + +The unit-weight triangle is a connected multigraph with minimum cut weight `2`. The tests evaluate +operations of the contraction structure on it, and instantiate the success bound `1 / 3`, the +one-sided error, admissibility and the call counts, so that none of their hypotheses is vacuous. +-/ + +@[expose] public section + +namespace ComplexityTests.KargerContraction + +open scoped ENNReal +open Cslib Cslib.WeightedCut Cslib.DataStructure Cslib.Algorithms.Lean.Karger + +/-- The triangle with unit weights. -/ +def triangle : Fin 3 → Fin 3 → ℕ := fun i j => if i = j then 0 else 1 + +theorem isMultigraph_triangle : IsMultigraph triangle := ⟨by decide, by decide⟩ + +/-- Every non-trivial cut of the triangle cuts two edges. -/ +theorem minCut_triangle : 0 < minCut triangle := + (minCut_pos_iff (by simp) _).mpr (by unfold IsNonTrivialCut; decide) + +/-- The size and the total doubled weight of the triangle. -/ +example : (step ⟨3, triangle⟩ .size).2 = 3 ∧ (step ⟨3, triangle⟩ .total).2 = 6 := by decide + +/-- The offsets `0` and `1` of the prefix sums sample the edges `(0, 1)` and `(0, 2)`. -/ +example : sampledPair triangle 0 = (0, 1) ∧ sampledPair triangle 1 = (0, 2) := + ⟨sampledPair_eq (u := 0) (v := 1) (by decide), sampledPair_eq (u := 0) (v := 2) (by decide)⟩ + +/-- Karger's algorithm finds the minimum cut of the triangle with probability at least `1 / 3`. -/ +example : (2 : ℝ≥0∞) / ((3 * (3 - 1) : ℕ) : ℝ≥0∞) ≤ + (spec.toRandomized.withCoins.run karger ⟨3, triangle⟩).toOuterMeasure + {x | x.1 = minCut triangle} := + two_div_le_toOuterMeasure_karger (by norm_num) isMultigraph_triangle minCut_triangle + +/-- Every answer is at least the minimum cut weight. -/ +example {x : ℕ × Graph} + (hx : x ∈ (spec.toRandomized.withCoins.run karger ⟨3, triangle⟩).support) : + minCut triangle ≤ x.1 := + minCut_le_of_mem_support_karger (by norm_num) isMultigraph_triangle hx + +/-- Every call is admissible. -/ +example : spec.toRandomized.withCoins.toSpec.DemonicValid ⟨3, triangle⟩ karger := + demonicValid_karger (by norm_num) isMultigraph_triangle + +/-- One contraction makes at most five calls, one of them a coin. -/ +example : OracleComp.IsQueryBounded (contractTimes 1) 5 := + isCostBounded_contractTimes (a := 1) (b := 1) (fun _ => le_rfl) (fun _ => le_rfl) 1 + +example : OracleComp.IsCostBounded (fun q => Sum.elim (fun _ => 1) (fun _ => 0) q) + (contractTimes 1) 1 := + isCostBounded_contractTimes (a := 1) (b := 0) (fun _ => le_rfl) (fun _ => le_rfl) 1 + +end ComplexityTests.KargerContraction