From 874872f77d1d5c4cb709661a259dedb0637d338b Mon Sep 17 00:00:00 2001 From: Renfei Zhou Date: Thu, 29 Oct 2026 15:59:05 +0000 Subject: [PATCH 01/12] feat(stateful,word-ram): add relational specifications and subroutine certificates --- Complexity.lean | 2 + .../Computability/WordRAM/RelSubroutine.lean | 1008 ++++++++++++++ .../Semantics/Stateful/Relational.lean | 1181 +++++++++++++++++ ComplexityTests/StatefulRelational.lean | 241 ++++ ComplexityTests/WordRAMRelSubroutine.lean | 351 +++++ 5 files changed, 2783 insertions(+) create mode 100644 Complexity/Computability/WordRAM/RelSubroutine.lean create mode 100644 Complexity/Foundations/Semantics/Stateful/Relational.lean create mode 100644 ComplexityTests/StatefulRelational.lean create mode 100644 ComplexityTests/WordRAMRelSubroutine.lean diff --git a/Complexity.lean b/Complexity.lean index a53d95e8e..5c5dbb976 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -2014,6 +2014,7 @@ public import Complexity.Computability.WordRAM.Randomized.Expected public import Complexity.Computability.WordRAM.Randomized.LoopSegment public import Complexity.Computability.WordRAM.Randomized.Structured public import Complexity.Computability.WordRAM.RegisterFrame +public import Complexity.Computability.WordRAM.RelSubroutine public import Complexity.Computability.WordRAM.Sequence public import Complexity.Computability.WordRAM.Signed.Arithmetic public import Complexity.Computability.WordRAM.Signed.Comparison @@ -2634,6 +2635,7 @@ public import Complexity.Foundations.Semantics.Stateful.CostHoare public import Complexity.Foundations.Semantics.Stateful.Hoare public import Complexity.Foundations.Semantics.Stateful.Module public import Complexity.Foundations.Semantics.Stateful.Realization +public import Complexity.Foundations.Semantics.Stateful.Relational public import Complexity.Foundations.Semantics.Stateful.Resource public import Complexity.Init public import Complexity.Languages.Probabilistic.Basic diff --git a/Complexity/Computability/WordRAM/RelSubroutine.lean b/Complexity/Computability/WordRAM/RelSubroutine.lean new file mode 100644 index 000000000..9b92e4dee --- /dev/null +++ b/Complexity/Computability/WordRAM/RelSubroutine.lean @@ -0,0 +1,1008 @@ +/- +Copyright (c) 2026 Renfei Zhou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Renfei Zhou +-/ + +module +-- upstream: candidate + +public import Complexity.Init +public import Complexity.Computability.WordRAM.Subroutine +public import Complexity.Foundations.Semantics.Stateful.Relational + +/-! +# Relational Word-RAM dynamic programs and composable data-structure subroutines + +This file extends `Complexity.Computability.WordRAM.Dynamic` and +`Complexity.Computability.WordRAM.Subroutine` from deterministic specifications (`Stateful.Spec`) +to relational specifications (`Stateful.RelSpec`): + +1. **Standalone relational fixed-program implementations (`RelDynamicProgram`, + `RelDynamicCertificate`):** Generalizes `DynamicProgram` and `DynamicCertificate` to + `D : Stateful.RelSpec`, where `execute` witnesses an angelic outcome `(s', a)` satisfying + `D.step s o s' a`. Because the Word-RAM structured semantics `Exec` is deterministic, + `RelDynamicCertificate.realization` establishes `Stateful.RelRealization` directly via + `Exec.unique`. +2. **Unified standalone and inline relational subroutine certificates (`RelSubroutineDS`):** + Mirrors `SubroutineDS` over `D : Stateful.RelSpec`, omitting `rep_unique` (since concrete + potential `potential : Data r_ds → ℕ` depends only on machine data) and existentially + quantifying over `(s', a)` with `D.step s o s' a` in `step_exec`. +3. **Zero-cost embedding of deterministic subroutines (`SubroutineDS.toRelSubroutineDS`):** + Every `SubroutineDS P D w base params s₀` embeds into + `RelSubroutineDS P D.toRelSpec w base params s₀`. +4. **Basis lifting, standalone `Stateful` projections, inline subroutine calls, and flat-program + operation sequences:** Provides `mapSimulates`, `toStandard`, `toRelDynamicProgram`, + `toRelCertificate`, `toRelAmortized`, `toRelBound`, `run_client_amortized`, `run_client_bound`, + `initFresh_exec`, `initFresh_rename`, `zeroFillCode_exec`, `initClear_exec`, + `initClear_rename`, `code_rename`, `call_rename`, `frame_caller`, and flat-program sequence + execution (`RunsRelOps`, `seq_runsRelOps`, `run_ops_exact_fresh`, `run_ops_exact_reusable`). + +## Main definitions + +* `Cslib.WordRAM.RelDynamicProgram`, `Cslib.WordRAM.RelDynamicCertificate`: standalone fixed-program + realization and certificate for a relational specification `D : Stateful.RelSpec`. +* `Cslib.WordRAM.RelSubroutineDS`: unified standalone and inline subroutine specification and + amortized resource certificate for `P : SubroutineCode B r_ds k_init` realizing + `D : Stateful.RelSpec` (without `rep_unique`). +* `Cslib.WordRAM.SubroutineDS.toRelSubroutineDS`: embedding of a deterministic `SubroutineDS` into + `RelSubroutineDS`. +* `Cslib.WordRAM.RelSubroutineDS.RunsRelOps`: sequential flat-program execution of an operation list + recording the resulting abstract transcript `D.Transcript`. + +## Main results + +* `Cslib.WordRAM.RelDynamicCertificate.realization`, + `Cslib.WordRAM.RelDynamicCertificate.instruction_bound`: standalone `Stateful.RelRealization` + and `Stateful.RelBound` certificates. +* `Cslib.WordRAM.RelSubroutineDS.toRelAmortized`, + `Cslib.WordRAM.RelSubroutineDS.run_client_amortized`: standalone amortized potential certificate + and adaptive-client bound over `Basis.standard`. +* `Cslib.WordRAM.RelSubroutineDS.initFresh_rename`, + `Cslib.WordRAM.RelSubroutineDS.initClear_rename`, + `Cslib.WordRAM.RelSubroutineDS.call_rename`, + `Cslib.WordRAM.RelSubroutineDS.frame_caller`: relocated inline initialization, inline operation + calls, and bidirectional framing. +* `Cslib.WordRAM.RelSubroutineDS.run_ops_exact_fresh`, + `Cslib.WordRAM.RelSubroutineDS.run_ops_exact_reusable`: end-to-end flat-program execution of any + demonically admissible operation sequence `D.ValidOpSeq s₀ ops`. + +## References + +* [T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein, *Introduction to Algorithms*, + Chapter 17][CLRS2009] +* [J. C. Reynolds, *Separation Logic: A Logic for Shared Mutable Data Structures*][Reynolds2002] +-/ + +@[expose] public section + +namespace Cslib.WordRAM + +universe u v z + +/-! ## Standalone relational dynamic programs (`RelDynamicProgram`, `RelDynamicCertificate`) -/ + +variable {r : ℕ} {D : Stateful.RelSpec.{u, v, z}} + +/-- A single `.standard`-basis Word-RAM program serving all operations of a relational +specification `D : Stateful.RelSpec` through a fixed register calling convention. -/ +structure RelDynamicProgram (D : Stateful.RelSpec.{u, v, z}) (r : ℕ) where + /-- The same structured program is executed for every operation. -/ + code : Code .standard r + /-- Register returned by the final `halt` instruction. -/ + output : Fin r + /-- Registers overwritten by externally supplied operation arguments. -/ + input : Fin r → Bool + /-- Encoded arguments, independent of the maintained machine state. -/ + encode : D.Op → Fin r → ℕ + /-- Interpretation of the final register tuple as the operation's typed observation. -/ + decode : (o : D.Op) → (Fin r → ℕ) → Option (D.Result o) + +/-- Embed a deterministic `DynamicProgram D r` as a `RelDynamicProgram D.toRelSpec r`. -/ +abbrev DynamicProgram.toRelDynamicProgram {D : Stateful.Spec.{u, v, z}} {r : ℕ} + (P : DynamicProgram D r) : RelDynamicProgram D.toRelSpec r where + code := P.code + output := P.output + input := P.input + encode := P.encode + decode := P.decode + +namespace RelDynamicProgram + +variable (P : RelDynamicProgram D r) + +/-- Deliver operation arguments without changing maintained memory or non-input registers. -/ +def prepare (o : D.Op) (x : Data r) : Data r where + regs i := if P.input i then P.encode o i else x.regs i + mem := x.mem + +/-- Delivering operation arguments preserves the machine memory unchanged. -/ +@[simp] +theorem prepare_mem (o : D.Op) (x : Data r) : (P.prepare o x).mem = x.mem := rfl + +/-- Registers outside the calling convention retain their contents. -/ +theorem prepare_regs_of_not_input {i : Fin r} (hi : P.input i = false) (o : D.Op) (x : Data r) : + (P.prepare o x).regs i = x.regs i := by + simp [prepare, hi] + +/-- Argument delivery preserves bounded words when the arguments fit. -/ +theorem prepare_bounded {w : ℕ} {o : D.Op} {x : Data r} (hx : x.Bounded w) + (ho : ∀ i, P.input i = true → Fits w (P.encode o i)) : (P.prepare o x).Bounded w := by + refine ⟨fun i => ?_, hx.2⟩ + change Fits w (if P.input i then P.encode o i else x.regs i) + split + · exact ho i (by assumption) + · exact hx.1 i + +/-- Evaluate one typed call, delivering its arguments and decoding its observation. The returned +cost includes the final `halt`. -/ +def eval (w fuel : ℕ) (o : D.Op) (x : Data r) : Option (Data r × D.Result o × ℕ) := + match P.code.eval w fuel (P.prepare o x) with + | none => none + | some (y, n) => (P.decode o y.regs).map fun a => (y, a, n + 1) + +/-- A bounded machine call with native execution evidence (`DynamicProgram.OperationTrace`). -/ +def ExecOp (w : ℕ) : Stateful.RelExecution D (Data r) DynamicProgram.OperationTrace := + fun x o a y trace => + (P.prepare o x).Bounded w ∧ ∃ n, TraceExec w P.code (P.prepare o x) y n trace.probes ∧ + P.decode o y.regs = some a ∧ trace.instructions = n + 1 + +/-- Successful typed evaluation supplies an exact operation trace when the delivered state is +bounded. -/ +theorem ExecOp.of_eval {w fuel k : ℕ} {o : D.Op} {x y : Data r} {a : D.Result o} + (hb : (P.prepare o x).Bounded w) (h : P.eval w fuel o x = some (y, a, k)) : + ∃ probes, P.ExecOp w x o a y ⟨k, probes⟩ := by + cases he : P.code.eval w fuel (P.prepare o x) with + | none => simp [eval, he] at h + | some yn => + obtain ⟨z, n⟩ := yn + cases hd : P.decode o z.regs with + | none => simp [eval, he, hd] at h + | some b => + simp only [eval, he, hd, Option.map_some, Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl, rfl⟩ := h + obtain ⟨probes, hp⟩ := (Exec.of_eval he).exists_trace + exact ⟨probes, hb, n, hp, hd, rfl⟩ + +/-- Every call is an execution of one fixed flat machine program. -/ +theorem ExecOp.executes {w : ℕ} {x y : Data r} {o : D.Op} {a : D.Result o} + {trace : DynamicProgram.OperationTrace} (h : P.ExecOp w x o a y trace) : + Executes w (P.code.program P.output) ⟨0, P.prepare o x⟩ (y.regs P.output) + trace.instructions := by + obtain ⟨_, n, he, _, ht⟩ := h + rw [ht] + exact he.exec.executes P.output + +/-- A call preserves bounded words. -/ +theorem ExecOp.bounded {w : ℕ} {x y : Data r} {o : D.Op} {a : D.Result o} + {trace : DynamicProgram.OperationTrace} (h : P.ExecOp w x o a y trace) : y.Bounded w := by + obtain ⟨hb, _, he, _, _⟩ := h + exact he.exec.bounded hb + +/-- Calls are deterministic in their final representation, observation, and instruction count. -/ +theorem ExecOp.unique {w : ℕ} {x y y' : Data r} {o : D.Op} {a a' : D.Result o} + {trace trace' : DynamicProgram.OperationTrace} (h : P.ExecOp w x o a y trace) + (h' : P.ExecOp w x o a' y' trace') : + y = y' ∧ a = a' ∧ trace.instructions = trace'.instructions := by + obtain ⟨_, _, he, ha, ht⟩ := h + obtain ⟨_, _, he', ha', ht'⟩ := h' + obtain ⟨rfl, rfl⟩ := he.exec.unique he'.exec + exact ⟨rfl, Option.some.inj (ha.symm.trans ha'), ht.trans ht'.symm⟩ + +/-- A call's final state and instruction count agree with any structured execution of the code. -/ +theorem ExecOp.eq_of_exec {P : RelDynamicProgram D r} {w : ℕ} {x y z : Data r} {o : D.Op} + {a : D.Result o} {trace : DynamicProgram.OperationTrace} {m : ℕ} + (he : P.ExecOp w x o a y trace) (h : Exec w P.code (P.prepare o x) z m) : + y = z ∧ trace.instructions = m + 1 := by + obtain ⟨_, _, ht, _, hn⟩ := he + obtain ⟨rfl, rfl⟩ := ht.exec.unique h + exact ⟨rfl, hn⟩ + +/-- The write transcript supplies a frame rule for a call, including register-only delivery. -/ +theorem ExecOp.frame {w : ℕ} {x y : Data r} {o : D.Op} {a : D.Result o} + {trace : DynamicProgram.OperationTrace} (h : P.ExecOp w x o a y trace) {Q : HeapAssertion} + (hQ : Q.holds x.mem) (hd : Disjoint Q.footprint (Probe.writes trace.probes)) : + Q.holds y.mem := by + obtain ⟨_, _, he, _, _⟩ := h + exact he.frame hQ hd + +end RelDynamicProgram + +/-- Per-operation angelic machine proof obligations for a `RelDynamicProgram`. -/ +structure RelDynamicCertificate (P : RelDynamicProgram D r) (w : ℕ) where + /-- Abstract state represented by the persistent machine data. -/ + rep : D.State → Data r → Prop + /-- Represented configurations contain only machine words. -/ + bounded : ∀ {s x}, rep s x → x.Bounded w + /-- Admissible arguments fit the machine's word size. -/ + arguments_fit : ∀ {s} (o), D.valid s o → ∀ i, P.input i = true → Fits w (P.encode o i) + /-- A machine execution implements an admissible operation by realizing some permitted + `(s', a)` with `D.step s o s' a`. -/ + execute : ∀ {s x} (o), rep s x → D.valid s o → + ∃ y s' a n, Exec w P.code (P.prepare o x) y n ∧ + D.step s o s' a ∧ P.decode o y.regs = some a ∧ rep s' y + +/-- Embed a deterministic `DynamicCertificate` as a `RelDynamicCertificate`. -/ +def DynamicCertificate.toRelDynamicCertificate {D : Stateful.Spec.{u, v, z}} {r w : ℕ} + {P : DynamicProgram D r} (C : DynamicCertificate P w) : + RelDynamicCertificate P.toRelDynamicProgram w where + rep := C.rep + bounded := C.bounded + arguments_fit := C.arguments_fit + execute o hr hv := by + obtain ⟨y, n, he, hdec, hrep⟩ := C.execute o hr hv + exact ⟨y, (D.step _ o).1, (D.step _ o).2, n, he, rfl, hdec, hrep⟩ + +namespace RelDynamicCertificate + +variable {P : RelDynamicProgram D r} {w : ℕ} (C : RelDynamicCertificate P w) + +/-- Turn a successful typed evaluation on a represented state and admissible operation into +certified `ExecOp` evidence. -/ +theorem execOp_of_eval {s : D.State} {x y : Data r} {o : D.Op} {a : D.Result o} {fuel k : ℕ} + (hr : C.rep s x) (hv : D.valid s o) (h : P.eval w fuel o x = some (y, a, k)) : + ∃ probes, P.ExecOp w x o a y ⟨k, probes⟩ := + RelDynamicProgram.ExecOp.of_eval P + (P.prepare_bounded (C.bounded hr) (C.arguments_fit o hv)) h + +/-- Fixed-program relational certificates realize `D` via `Stateful.RelRealization`. -/ +def realization : Stateful.RelRealization D (P.ExecOp w) where + rep := C.rep + total o hr hv := by + obtain ⟨y, _, a, n, he, _, ha, _⟩ := C.execute o hr hv + obtain ⟨ts, hts⟩ := he.exists_trace + exact ⟨a, y, ⟨n + 1, ts⟩, + P.prepare_bounded (C.bounded hr) (C.arguments_fit o hv), n, hts, ha, rfl⟩ + correct hr hv he := by + obtain ⟨y, s', a, n, he', hstep, ha, hr'⟩ := C.execute _ hr hv + obtain ⟨_, _, ht, ha', _⟩ := he + obtain ⟨rfl, rfl⟩ := ht.exec.unique he' + have h_eq : _ = a := Option.some.inj (ha'.symm.trans ha) + subst h_eq + exact ⟨s', hstep, hr'⟩ + +/-- A separate per-operation instruction estimate supplies a reusable `Stateful.RelBound`. -/ +theorem instruction_bound (charge : D.State → D.Op → ℕ) + (hbound : ∀ {s x} (o) {y n}, C.rep s x → D.valid s o → + Exec w P.code (P.prepare o x) y n → n + 1 ≤ charge s o) : + Stateful.RelBound C.realization DynamicProgram.OperationTrace.instructions charge := by + intro s x o a y trace hr hv he + obtain ⟨_, n, ht, _, hn⟩ := he + rw [hn] + exact hbound o hr hv ht.exec + +/-- A uniform constant instruction bound follows from an existential per-operation execution. -/ +theorem instruction_bound_const (K : ℕ) + (hbound : ∀ {s x} (o), C.rep s x → D.valid s o → + ∃ y n, Exec w P.code (P.prepare o x) y n ∧ n + 1 ≤ K) : + Stateful.RelBound C.realization DynamicProgram.OperationTrace.instructions + (fun _ _ => K) := by + apply C.instruction_bound + intro s x o y n hr hv he + obtain ⟨_, _, he', hn⟩ := hbound o hr hv + obtain ⟨_, rfl⟩ := he.unique he' + exact hn + +/-- Adaptive client execution, final representation, and linear total instruction bound for a +uniform constant per-operation instruction certificate. -/ +theorem run_client_const {K : ℕ} + (B : Stateful.RelBound C.realization DynamicProgram.OperationTrace.instructions + (fun _ _ => K)) + {α : Type*} (p : D.Client α) {s : D.State} {x : Data r} + (hr : C.rep s x) (hv : D.DemonicValid s p) : + ∃ a y traces s' tr, + Stateful.RelExecutes (P.ExecOp w) p x a y traces ∧ + D.ClientRun s p a s' tr ∧ + C.rep s' y ∧ + traces.length = tr.length ∧ + Stateful.total DynamicProgram.OperationTrace.instructions traces ≤ tr.length * K := by + obtain ⟨a, y, traces, s', tr, he, hrun, hr', hlen, hcost⟩ := B.exists_executes p hr hv + rw [D.totalCost_const] at hcost + exact ⟨a, y, traces, s', tr, he, hrun, hr', hlen, hcost⟩ + +/-- Lift a per-operation pointwise memory frame from `Exec` to `ExecOp`. -/ +theorem frame_of_execute {j : ℕ} + (hframe : ∀ {s x} (o), C.rep s x → D.valid s o → + ∃ z n, Exec w P.code (P.prepare o x) z n ∧ z.mem j = x.mem j) + {s : D.State} {x y : Data r} {o : D.Op} {a : D.Result o} + {trace : DynamicProgram.OperationTrace} + (hr : C.rep s x) (hv : D.valid s o) (he : P.ExecOp w x o a y trace) : + y.mem j = x.mem j := by + obtain ⟨z, n, hz, hf⟩ := hframe o hr hv + exact (he.eq_of_exec hz).1 ▸ hf + +/-- Lift a per-operation `Modifies` bound from `Exec` to `ExecOp`. -/ +theorem modifies_of_execute {F : Finset ℕ} + (hmod : ∀ {s x} (o), C.rep s x → D.valid s o → + ∃ z n, Exec w P.code (P.prepare o x) z n ∧ Modifies F x.mem z.mem) + {s : D.State} {x y : Data r} {o : D.Op} {a : D.Result o} + {trace : DynamicProgram.OperationTrace} + (hr : C.rep s x) (hv : D.valid s o) (he : P.ExecOp w x o a y trace) : + Modifies F x.mem y.mem := + fun j hj => C.frame_of_execute + (fun o hr' hv' => let ⟨z, n, hz, hf⟩ := hmod o hr' hv'; ⟨z, n, hz, hf j hj⟩) + hr hv he + +/-- Lift a per-operation pointwise memory frame across a demonically admissible adaptive client +execution. -/ +theorem executes_client_frame {j : ℕ} + (hframe : ∀ {s x y o a trace}, C.rep s x → D.valid s o → + P.ExecOp w x o a y trace → y.mem j = x.mem j) + {α : Type*} {p : D.Client α} {s : D.State} {x y : Data r} {val : α} + {traces : List DynamicProgram.OperationTrace} + (hr : C.rep s x) (hv : D.DemonicValid s p) + (he : Stateful.RelExecutes (P.ExecOp w) p x val y traces) : + y.mem j = x.mem j := by + induction he generalizing s with + | pure _ _ => rfl + | @call o k c a c' trace _ _ _ hstep _ ih => + obtain ⟨hv_o, hv_k⟩ := (D.demonicValid_liftBind_iff s o k).mp hv + obtain ⟨s', hstep_d, hr'⟩ := C.realization.correct hr hv_o hstep + exact (ih hr' (hv_k s' a hstep_d)).trans (hframe hr hv_o hstep) + +/-- Lift a per-operation `Modifies` bound across a demonically admissible adaptive client +execution. -/ +theorem executes_client_modifies {F : Finset ℕ} + (hmod : ∀ {s x y o a trace}, C.rep s x → D.valid s o → + P.ExecOp w x o a y trace → Modifies F x.mem y.mem) + {α : Type*} {p : D.Client α} {s : D.State} {x y : Data r} {val : α} + {traces : List DynamicProgram.OperationTrace} + (hr : C.rep s x) (hv : D.DemonicValid s p) + (he : Stateful.RelExecutes (P.ExecOp w) p x val y traces) : + Modifies F x.mem y.mem := + fun j hj => C.executes_client_frame + (fun hr' hv' he' => hmod hr' hv' he' j hj) hr hv he + +/-- Memory probes are bounded by the instruction charge. -/ +theorem probe_bound (charge : D.State → D.Op → ℕ) + (B : Stateful.RelBound C.realization DynamicProgram.OperationTrace.instructions charge) : + Stateful.RelBound C.realization (fun t => t.probes.length) charge := by + intro s x o a y trace hr hv he + have hb := B hr hv he + obtain ⟨_, n, ht, _, hn⟩ := he + exact ht.length_le.trans ((Nat.le_add_right n 1).trans (hn ▸ hb)) + +end RelDynamicCertificate + +/-! ## `RelSubroutineDS` and `SubroutineDS.toRelSubroutineDS` -/ + +namespace SubroutineCode + +variable {B : Basis} {r_ds k_init : ℕ} + +/-- Compiled flat `Program B r_ds` for `O(1)` fresh zeroed-memory initialization. -/ +def initFreshProg (P : SubroutineCode B r_ds k_init) : Program B r_ds := + P.initFresh.program P.output + +/-- Compiled flat `Program B r_ds` for `O(space)` dirty-memory reusable initialization. -/ +def initClearProg (P : SubroutineCode B r_ds k_init) : Program B r_ds := + P.initClear.program P.output + +/-- Compiled flat `Program B r_ds` serving all operations of the data structure. -/ +def opProg (P : SubroutineCode B r_ds k_init) : Program B r_ds := + P.code.program P.output + +end SubroutineCode + +/-- Unified standalone and subroutine specification/resource certificate for +`P : SubroutineCode B r_ds k_init` realizing a relational specification `D : Stateful.RelSpec` +at word width `w`, base address `base`, runtime parameters `params`, and initial state `s₀`. + +In contrast to `SubroutineDS`, `rep_unique` is omitted (because concrete potential +`potential : Data r_ds → ℕ` depends only on machine data) and `step_exec` existentially +quantifies over a permitted outcome `(s', a)` satisfying `D.step s o s' a`. -/ +structure RelSubroutineDS {B : Basis} {r_ds k_init : ℕ} (P : SubroutineCode B r_ds k_init) + (D : Stateful.RelSpec.{u, v, z}) (w base : ℕ) (params : Fin k_init → ℕ) (s₀ : D.State) where + /-- Contiguous memory footprint length `[base, base + space)`. -/ + space : ℕ + /-- Instruction bound for `P.allocSpan`. -/ + spanTime : ℕ + /-- Instruction bound for `P.initSetup`. -/ + setupTime : ℕ + /-- Upper bound on initial concrete potential after initialization. -/ + initPotential : ℕ + /-- Amortized instruction charge per operation (excluding trailing standalone `halt`). -/ + charge : D.State → D.Op → ℕ + /-- Representation invariant linking mathematical state `s` to concrete `Data r_ds`. -/ + rep : D.State → Data r_ds → Prop + /-- Concrete integer potential depending only on `Data r_ds`. -/ + potential : Data r_ds → ℕ + /-- Standalone register encoding for `RelDynamicProgram.prepare`. -/ + encode : D.Op → Fin r_ds → ℕ + /-- Partial argument-matching predicate for inline callers (refined by `encode`). -/ + argMatch : D.Op → (Fin r_ds → ℕ) → Prop + /-- Output decoder reading typed operation observations from final registers. -/ + decode : (o : D.Op) → (Fin r_ds → ℕ) → Option (D.Result o) + /-- Represented configurations are word-bounded. -/ + bounded : ∀ {s x}, rep s x → x.Bounded w + /-- Standalone encoded arguments fit in `w`-bit words on admissible calls. -/ + arguments_fit : ∀ {s} (o), D.valid s o → ∀ i, P.input i = true → Fits w (encode o i) + /-- Full standalone `prepare` delivery satisfies `argMatch`. -/ + encode_matches : ∀ (o : D.Op) (regs : Fin r_ds → ℕ), + argMatch o (fun i => if P.input i then encode o i else regs i) + /-- `rep` depends only on persistent registers (`P.input i = false`) and `[base, base + space)`. + -/ + rep_supported : ∀ {s x x'}, + (∀ i, P.input i = false → x'.regs i = x.regs i) → + (∀ a ∈ (Block.mk base space).footprint, x'.mem a = x.mem a) → + x'.Bounded w → rep s x → rep s x' + /-- `potential` depends only on persistent registers and `[base, base + space)` under `rep`. -/ + potential_supported : ∀ {s x x'}, + (∀ i, P.input i = false → x'.regs i = x.regs i) → + (∀ a ∈ (Block.mk base space).footprint, x'.mem a = x.mem a) → + rep s x → potential x' = potential x + /-- Distinctness of registers used by `zeroFillCode` relative to `baseReg` and `frontierReg`. -/ + clear_nodup : [P.curReg, P.zeroReg, P.oneReg, P.baseReg, P.frontierReg].Nodup + /-- Initialization parameter registers are not overwritten by `zeroFillCode`. -/ + params_not_clear : ∀ j, P.initParams j ∉ [P.curReg, P.zeroReg, P.oneReg] + /-- `P.incCur` increments `P.curReg` by `1` when `P.oneReg = 1` and the sum fits in `w` bits. -/ + incCur_eval : ∀ {x : Data r_ds}, x.regs P.oneReg = 1 → Fits w (x.regs P.curReg + 1) → + P.incCur.eval w x = some (x.set P.curReg (x.regs P.curReg + 1)) + /-- Execution of `P.allocSpan`: records `baseReg = base` and advances `frontierReg`. -/ + span_exec : ∀ {x : Data r_ds}, + x.Bounded w → x.regs P.frontierReg = base → (∀ j, x.regs (P.initParams j) = params j) → + ∃ x₁, ExecWithin w P.allocSpan x x₁ spanTime ∧ x₁.mem = x.mem ∧ + x₁.regs P.baseReg = base ∧ x₁.regs P.frontierReg = base + space ∧ + (∀ j, x₁.regs (P.initParams j) = params j) + /-- Execution of `P.initSetup` once `[base, base + space)` holds zeros. -/ + setup_exec : ∀ {x₁ : Data r_ds}, + x₁.Bounded w → x₁.regs P.baseReg = base → x₁.regs P.frontierReg = base + space → + (∀ j, x₁.regs (P.initParams j) = params j) → + (∀ a ∈ (Block.mk base space).footprint, x₁.mem a = 0) → + ∃ y, ExecWithin w P.initSetup x₁ y setupTime ∧ y.regs P.frontierReg = base + space ∧ + rep s₀ y ∧ potential y ≤ initPotential ∧ + Modifies (Block.mk base space).footprint x₁.mem y.mem + /-- Angelic execution of `P.code` for any admissible operation `o` whose arguments match `x.regs`, + witnessing some permitted outcome `(s', a)` with `D.step s o s' a`. -/ + step_exec : ∀ {s : D.State} {x : Data r_ds} (o : D.Op), + rep s x → D.valid s o → argMatch o x.regs → + ∃ y s' a n, Exec w P.code x y n ∧ + D.step s o s' a ∧ + decode o y.regs = some a ∧ + rep s' y ∧ + Modifies (Block.mk base space).footprint x.mem y.mem ∧ + n + potential y ≤ charge s o + potential x + +/-- Embed any deterministic `SubroutineDS P D w base params s₀` as a relational +`RelSubroutineDS P D.toRelSpec w base params s₀`. -/ +def SubroutineDS.toRelSubroutineDS {B : Basis} {r_ds k_init w base : ℕ} + {P : SubroutineCode B r_ds k_init} {D : Stateful.Spec.{u, v, z}} + {params : Fin k_init → ℕ} {s₀ : D.State} + (C : SubroutineDS P D w base params s₀) : + RelSubroutineDS P D.toRelSpec w base params s₀ where + space := C.space + spanTime := C.spanTime + setupTime := C.setupTime + initPotential := C.initPotential + charge := C.charge + rep := C.rep + potential := C.potential + encode := C.encode + argMatch := C.argMatch + decode := C.decode + bounded := C.bounded + arguments_fit := C.arguments_fit + encode_matches := C.encode_matches + rep_supported := C.rep_supported + potential_supported := C.potential_supported + clear_nodup := C.clear_nodup + params_not_clear := C.params_not_clear + incCur_eval := C.incCur_eval + span_exec := C.span_exec + setup_exec := C.setup_exec + step_exec o hr hv harg := by + obtain ⟨y, n, he, hdec, hrep, hmod, hpot⟩ := C.step_exec o hr hv harg + exact ⟨y, (D.step _ o).1, (D.step _ o).2, n, he, rfl, hdec, hrep, hmod, hpot⟩ + +namespace RelSubroutineDS + +variable {B B' : Basis} {r_ds r_caller k_init w base : ℕ} + {P : SubroutineCode B r_ds k_init} {D : Stateful.RelSpec.{u, v, z}} + {params : Fin k_init → ℕ} {s₀ : D.State} + +/-- Total instruction bound for `P.initFresh`. -/ +def initTime (C : RelSubroutineDS P D w base params s₀) : ℕ := + C.spanTime + C.setupTime + +/-! ### Projection 1: Basis lifting and standalone `RelDynamicProgram` / `Stateful` theorems -/ + +/-- Lift a `RelSubroutineDS` certificate along any defined-evaluation basis simulation. -/ +def mapSimulates (φ : B.Simulates B') (C : RelSubroutineDS P D w base params s₀) : + RelSubroutineDS (P.mapSimulates φ) D w base params s₀ where + space := C.space + spanTime := C.spanTime + setupTime := C.setupTime + initPotential := C.initPotential + charge := C.charge + rep := C.rep + potential := C.potential + encode := C.encode + argMatch := C.argMatch + decode := C.decode + bounded := C.bounded + arguments_fit := C.arguments_fit + encode_matches := C.encode_matches + rep_supported := C.rep_supported + potential_supported := C.potential_supported + clear_nodup := C.clear_nodup + params_not_clear := C.params_not_clear + incCur_eval h1 hfit := Op.eval_mapSimulates_of_some φ (C.incCur_eval h1 hfit) + span_exec hx hf hp := + let ⟨x₁, he, hm, hb, hfr, hpar⟩ := C.span_exec hx hf hp + ⟨x₁, he.mapSimulates φ, hm, hb, hfr, hpar⟩ + setup_exec hx₁ hb hfr hpar hz := + let ⟨y, he, hfr', hrep, hpot, hmod⟩ := C.setup_exec hx₁ hb hfr hpar hz + ⟨y, he.mapSimulates φ, hfr', hrep, hpot, hmod⟩ + step_exec o hr hv harg := + let ⟨y, s', a, n, he, hstep, hdec, hrep, hmod, hpot⟩ := C.step_exec o hr hv harg + ⟨y, s', a, n, he.mapSimulates φ, hstep, hdec, hrep, hmod, hpot⟩ + +/-- Lift an exact-basis `RelSubroutineDS` certificate to `Basis.standard`. -/ +abbrev toStandard {P : SubroutineCode .exact r_ds k_init} + (C : RelSubroutineDS P D w base params s₀) : + RelSubroutineDS P.toStandard D w base params s₀ := + C.mapSimulates .exactStandard + +section Standard + +variable {P_std : SubroutineCode .standard r_ds k_init} + (C : RelSubroutineDS P_std D w base params s₀) + +/-- Project a `.standard`-basis `RelSubroutineDS` to a standalone `RelDynamicProgram`. -/ +def toRelDynamicProgram : RelDynamicProgram D r_ds where + code := P_std.code + output := P_std.output + input := P_std.input + encode := C.encode + decode := C.decode + +/-- Project a `.standard`-basis `RelSubroutineDS` to a standalone `RelDynamicCertificate`. -/ +def toRelCertificate : RelDynamicCertificate C.toRelDynamicProgram w where + rep := C.rep + bounded := C.bounded + arguments_fit := C.arguments_fit + execute {s x} o hr hv := by + have hb' : (C.toRelDynamicProgram.prepare o x).Bounded w := + C.toRelDynamicProgram.prepare_bounded (C.bounded hr) (C.arguments_fit o hv) + have hr' : C.rep s (C.toRelDynamicProgram.prepare o x) := + C.rep_supported + (fun i hi => C.toRelDynamicProgram.prepare_regs_of_not_input hi o x) + (fun _ _ => rfl) hb' hr + have harg : C.argMatch o (C.toRelDynamicProgram.prepare o x).regs := + C.encode_matches o x.regs + obtain ⟨y, s', a, n, he, hstep, hdec, hrep, _, _⟩ := C.step_exec o hr' hv harg + exact ⟨y, s', a, n, he, hstep, hdec, hrep⟩ + +/-- Project a `.standard`-basis `RelSubroutineDS` to a standalone `Stateful.RelAmortized` +certificate, charging `+ 1` per operation for `RelDynamicProgram`'s trailing `halt` instruction. -/ +theorem toRelAmortized : + Stateful.RelAmortized C.toRelCertificate.realization + DynamicProgram.OperationTrace.instructions + (fun _ x => C.potential x) + (fun s o => C.charge s o + 1) where + step {s x o a y trace} hr hv he := by + have hb' : (C.toRelDynamicProgram.prepare o x).Bounded w := + C.toRelDynamicProgram.prepare_bounded (C.bounded hr) (C.arguments_fit o hv) + have hr' : C.rep s (C.toRelDynamicProgram.prepare o x) := + C.rep_supported + (fun i hi => C.toRelDynamicProgram.prepare_regs_of_not_input hi o x) + (fun _ _ => rfl) hb' hr + have hp_eq : C.potential (C.toRelDynamicProgram.prepare o x) = C.potential x := + C.potential_supported + (fun i hi => C.toRelDynamicProgram.prepare_regs_of_not_input hi o x) + (fun _ _ => rfl) hr + have harg : C.argMatch o (C.toRelDynamicProgram.prepare o x).regs := + C.encode_matches o x.regs + obtain ⟨z, s', a', m, hz, hstep, hdec, hrep, _, hpot⟩ := C.step_exec o hr' hv harg + obtain ⟨rfl, hinst⟩ := he.eq_of_exec hz + obtain ⟨_, _, _, ha_trace, _⟩ := he + have ha_eq : a = a' := Option.some.inj (ha_trace.symm.trans hdec) + subst ha_eq + refine ⟨s', hstep, hrep, ?_⟩ + rw [hinst] + rw [hp_eq] at hpot + omega + +/-- Alias for `toRelAmortized` matching `SubroutineDS.toAmortized`. -/ +abbrev toAmortized := @toRelAmortized + +/-- When `C.potential` is identically zero, `RelSubroutineDS` projects directly to a worst-case +`Stateful.RelBound` certificate. -/ +theorem toRelBound (hpot : ∀ x, C.potential x = 0) : + Stateful.RelBound C.toRelCertificate.realization + DynamicProgram.OperationTrace.instructions + (fun s o => C.charge s o + 1) := by + intro s x o a y trace hr hv he + obtain ⟨_, _, _, h⟩ := C.toRelAmortized.step hr hv he + simp only [hpot] at h + omega + +/-- Alias for `toRelBound` matching `SubroutineDS.toBound`. -/ +abbrev toBound := @toRelBound + +/-- Standalone adaptive-client amortized bound for any demonically admissible client `p`. -/ +theorem run_client_amortized {α : Type*} (p : D.Client α) {s : D.State} {x : Data r_ds} + (hr : C.rep s x) (hv : D.DemonicValid s p) : + ∃ a y traces s' tr, + Stateful.RelExecutes (C.toRelDynamicProgram.ExecOp w) p x a y traces ∧ + D.ClientRun s p a s' tr ∧ + C.rep s' y ∧ + traces.length = tr.length ∧ + Stateful.total DynamicProgram.OperationTrace.instructions traces + C.potential y ≤ + D.totalCost (fun s o => C.charge s o + 1) s tr + C.potential x := + C.toRelAmortized.run_client_amortized p hr hv + +/-- Standalone adaptive-client worst-case bound when `C.potential` is identically zero. -/ +theorem run_client_bound (hpot : ∀ x, C.potential x = 0) {α : Type*} (p : D.Client α) + {s : D.State} {x : Data r_ds} (hr : C.rep s x) (hv : D.DemonicValid s p) : + ∃ a y traces s' tr, + Stateful.RelExecutes (C.toRelDynamicProgram.ExecOp w) p x a y traces ∧ + D.ClientRun s p a s' tr ∧ + C.rep s' y ∧ + traces.length = tr.length ∧ + Stateful.total DynamicProgram.OperationTrace.instructions traces ≤ + D.totalCost (fun s o => C.charge s o + 1) s tr := + Stateful.RelBound.exists_executes (C.toRelBound hpot) p hr hv + +end Standard + +/-! ### Projection 2: Fresh `O(1)` initialization and register relocation -/ + +/-- Execute `P.initFresh` on zeroed `[base, base + C.space)` in `C.initTime` instructions. -/ +theorem initFresh_exec (C : RelSubroutineDS P D w base params s₀) {x : Data r_ds} + (hx : x.Bounded w) (hfr : x.regs P.frontierReg = base) + (hpar : ∀ j, x.regs (P.initParams j) = params j) + (hz : ∀ a ∈ (Block.mk base C.space).footprint, x.mem a = 0) : + ∃ y, ExecWithin w P.initFresh x y C.initTime ∧ + y.regs P.frontierReg = base + C.space ∧ + C.rep s₀ y ∧ + C.potential y ≤ C.initPotential ∧ + Modifies (Block.mk base C.space).footprint x.mem y.mem := by + obtain ⟨x₁, he₁, hm₁, hb₁, hfr₁, hpar₁⟩ := C.span_exec hx hfr hpar + have hx₁ : x₁.Bounded w := he₁.bounded hx + have hz₁ : ∀ a ∈ (Block.mk base C.space).footprint, x₁.mem a = 0 := by + intro a ha + rw [hm₁] + exact hz a ha + obtain ⟨y, he₂, hfr₂, hrep, hpot, hmod⟩ := C.setup_exec hx₁ hb₁ hfr₁ hpar₁ hz₁ + rw [hm₁] at hmod + exact ⟨y, he₁.seq he₂, hfr₂, hrep, hpot, hmod⟩ + +/-- Relocated `O(1)` fresh initialization along any injective register embedding `f`. -/ +theorem initFresh_rename (C : RelSubroutineDS P D w base params s₀) + {f : Fin r_ds → Fin r_caller} (hf : f.Injective) {x : Data r_caller} + (hx : (x.comap f).Bounded w) (hfr : x.regs (f P.frontierReg) = base) + (hpar : ∀ j, x.regs (f (P.initParams j)) = params j) + (hz : ∀ a ∈ (Block.mk base C.space).footprint, x.mem a = 0) : + ∃ z, ExecWithin w (P.initFresh.rename f) x z C.initTime ∧ + z.regs (f P.frontierReg) = base + C.space ∧ + C.rep s₀ (z.comap f) ∧ + C.potential (z.comap f) ≤ C.initPotential ∧ + Modifies (Block.mk base C.space).footprint x.mem z.mem ∧ + (∀ j ∉ Set.range f, z.regs j = x.regs j) := by + obtain ⟨y, he, hfr', hrep, hpot, hmod⟩ := C.initFresh_exec hx hfr hpar hz + refine ⟨y.extend f x, he.rename hf, ?_, ?_, ?_, hmod, + fun j hj => Data.extend_regs_of_notMem y x hj⟩ + · change ((y.extend f x).comap f).regs P.frontierReg = base + C.space + rw [Data.comap_extend hf] + exact hfr' + · rw [Data.comap_extend hf] + exact hrep + · rw [Data.comap_extend hf] + exact hpot + +/-! ### Projection 3: Generic `O(space)` dirty-memory initialization (`initClear`) -/ + +/-- Auxiliary deterministic `SubroutineDS` sharing `C`'s initialization fields so +`zeroFillCode_exec` is reused without duplicating its loop proof. -/ +private def toInitSubroutineDS (C : RelSubroutineDS P D w base params s₀) : + SubroutineDS P + { State := PUnit.{1}, Op := PUnit.{1}, Result := fun _ => PUnit.{1}, + step := fun _ _ => (⟨⟩, ⟨⟩), valid := fun _ _ => False } + w base params ⟨⟩ where + space := C.space + spanTime := C.spanTime + setupTime := C.setupTime + initPotential := C.initPotential + charge _ _ := 0 + rep _ x := C.rep s₀ x + potential := C.potential + encode _ _ := 0 + argMatch _ _ := True + decode _ _ := some ⟨⟩ + bounded := C.bounded + rep_unique _ _ := rfl + arguments_fit _ hv := False.elim hv + encode_matches _ _ := trivial + rep_supported := C.rep_supported + potential_supported := C.potential_supported + clear_nodup := C.clear_nodup + params_not_clear := C.params_not_clear + incCur_eval := C.incCur_eval + span_exec := C.span_exec + setup_exec := C.setup_exec + step_exec _ _ hv := False.elim hv + +/-- Generic execution of `P.zeroFillCode` clearing `[base, base + C.space)` in `4 * C.space + 6` +instructions over any basis `B`. -/ +theorem zeroFillCode_exec (C : RelSubroutineDS P D w base params s₀) {x₁ : Data r_ds} + (hx₁ : x₁.Bounded w) (hb₁ : x₁.regs P.baseReg = base) + (hfr₁ : x₁.regs P.frontierReg = base + C.space) + (hpar₁ : ∀ j, x₁.regs (P.initParams j) = params j) : + ∃ x₂, ExecWithin w P.zeroFillCode x₁ x₂ (4 * C.space + 6) ∧ + x₂.Bounded w ∧ + x₂.regs P.baseReg = base ∧ + x₂.regs P.frontierReg = base + C.space ∧ + (∀ j, x₂.regs (P.initParams j) = params j) ∧ + (∀ a ∈ (Block.mk base C.space).footprint, x₂.mem a = 0) ∧ + Modifies (Block.mk base C.space).footprint x₁.mem x₂.mem := + C.toInitSubroutineDS.zeroFillCode_exec hx₁ hb₁ hfr₁ hpar₁ + +/-- Execute `P.initClear` on arbitrary dirty memory in `C.initTime + 4 * C.space + 6` +instructions. -/ +theorem initClear_exec (C : RelSubroutineDS P D w base params s₀) {x : Data r_ds} + (hx : x.Bounded w) (hfr : x.regs P.frontierReg = base) + (hpar : ∀ j, x.regs (P.initParams j) = params j) : + ∃ y, ExecWithin w P.initClear x y (C.initTime + 4 * C.space + 6) ∧ + y.regs P.frontierReg = base + C.space ∧ + C.rep s₀ y ∧ + C.potential y ≤ C.initPotential ∧ + Modifies (Block.mk base C.space).footprint x.mem y.mem := by + obtain ⟨x₁, he₁, hm₁, hb₁, hfr₁, hpar₁⟩ := C.span_exec hx hfr hpar + obtain ⟨x₂, he₂, hx₂, hb₂, hfr₂, hpar₂, hz₂, hmod₂⟩ := + C.zeroFillCode_exec (he₁.bounded hx) hb₁ hfr₁ hpar₁ + obtain ⟨y, he₃, hfr₃, hrep, hpot, hmod₃⟩ := C.setup_exec hx₂ hb₂ hfr₂ hpar₂ hz₂ + rw [hm₁] at hmod₂ + have hmod : Modifies (Block.mk base C.space).footprint x.mem y.mem := by + simpa only [Finset.union_idempotent] using hmod₂.trans hmod₃ + exact ⟨y, (he₁.seq (he₂.seq he₃)).mono (by unfold initTime; omega), hfr₃, hrep, hpot, hmod⟩ + +/-- Relocated `O(space)` dirty-memory initialization along any injective register embedding `f`. -/ +theorem initClear_rename (C : RelSubroutineDS P D w base params s₀) + {f : Fin r_ds → Fin r_caller} (hf : f.Injective) {x : Data r_caller} + (hx : (x.comap f).Bounded w) (hfr : x.regs (f P.frontierReg) = base) + (hpar : ∀ j, x.regs (f (P.initParams j)) = params j) : + ∃ z, ExecWithin w (P.initClear.rename f) x z (C.initTime + 4 * C.space + 6) ∧ + z.regs (f P.frontierReg) = base + C.space ∧ + C.rep s₀ (z.comap f) ∧ + C.potential (z.comap f) ≤ C.initPotential ∧ + Modifies (Block.mk base C.space).footprint x.mem z.mem ∧ + (∀ j ∉ Set.range f, z.regs j = x.regs j) := by + obtain ⟨y, he, hfr', hrep, hpot, hmod⟩ := C.initClear_exec hx hfr hpar + refine ⟨y.extend f x, he.rename hf, ?_, ?_, ?_, hmod, + fun j hj => Data.extend_regs_of_notMem y x hj⟩ + · change ((y.extend f x).comap f).regs P.frontierReg = base + C.space + rw [Data.comap_extend hf] + exact hfr' + · rw [Data.comap_extend hf] + exact hrep + · rw [Data.comap_extend hf] + exact hpot + +/-! ### Projection 4: Relocated inline subroutine calls (`code_rename`, `call_rename`) -/ + +/-- Execute `P.code.rename f` inline when arguments already match `(x.comap f).regs`, +witnessing a permitted outcome `(s', a)` with `D.step s o s' a`. -/ +theorem code_rename (C : RelSubroutineDS P D w base params s₀) + {f : Fin r_ds → Fin r_caller} (hf : f.Injective) + {s : D.State} {x : Data r_caller} (o : D.Op) + (hr : C.rep s (x.comap f)) (hv : D.valid s o) (harg : C.argMatch o (x.comap f).regs) : + ∃ z s' a t, ExecWithin w (P.code.rename f) x z t ∧ + D.step s o s' a ∧ + C.decode o (z.comap f).regs = some a ∧ + C.rep s' (z.comap f) ∧ + Modifies (Block.mk base C.space).footprint x.mem z.mem ∧ + (∀ j ∉ Set.range f, z.regs j = x.regs j) ∧ + t + C.potential (z.comap f) ≤ C.charge s o + C.potential (x.comap f) := by + obtain ⟨y, s', a, n, he, hstep, hdec, hrep, hmod, hpot⟩ := C.step_exec o hr hv harg + refine ⟨y.extend f x, s', a, n, (he.rename hf).within, hstep, ?_, ?_, hmod, + fun j hj => Data.extend_regs_of_notMem y x hj, ?_⟩ + · rw [Data.comap_extend hf] + exact hdec + · rw [Data.comap_extend hf] + exact hrep + · rw [Data.comap_extend hf] + exact hpot + +/-- Execute `.seq prep (P.code.rename f)` inline after a caller argument-preparation block `prep` +that preserves persistent DS registers and memory in `[base, base + C.space)`. -/ +theorem call_rename (C : RelSubroutineDS P D w base params s₀) + {f : Fin r_ds → Fin r_caller} (hf : f.Injective) + {s : D.State} {x x' : Data r_caller} {prep : Code B r_caller} {t_prep : ℕ} (o : D.Op) + (hr : C.rep s (x.comap f)) (hv : D.valid s o) + (hprep : ExecWithin w prep x x' t_prep) + (hb' : (x'.comap f).Bounded w) + (hreg : ∀ i, P.input i = false → x'.regs (f i) = x.regs (f i)) + (hmem : ∀ a ∈ (Block.mk base C.space).footprint, x'.mem a = x.mem a) + (harg : C.argMatch o (x'.comap f).regs) : + ∃ z s' a t, ExecWithin w (.seq prep (P.code.rename f)) x z t ∧ + D.step s o s' a ∧ + C.decode o (z.comap f).regs = some a ∧ + C.rep s' (z.comap f) ∧ + Modifies (Block.mk base C.space).footprint x'.mem z.mem ∧ + (∀ j ∉ Set.range f, z.regs j = x'.regs j) ∧ + t + C.potential (z.comap f) ≤ t_prep + C.charge s o + C.potential (x.comap f) := by + have hr' : C.rep s (x'.comap f) := + C.rep_supported (x := x.comap f) (x' := x'.comap f) hreg hmem hb' hr + have hp_eq : C.potential (x'.comap f) = C.potential (x.comap f) := + C.potential_supported (x := x.comap f) (x' := x'.comap f) hreg hmem hr + obtain ⟨z, s', a, t_op, he_op, hstep, hdec, hrep_z, hmod_z, hregs_z, hpot_z⟩ := + C.code_rename hf o hr' hv harg + exact ⟨z, s', a, t_prep + t_op, hprep.seq he_op, hstep, hdec, hrep_z, hmod_z, hregs_z, + by rw [hp_eq] at hpot_z; omega⟩ + +/-! ### Projection 5: Caller-to-DS bidirectional framing (`frame_caller`) -/ + +/-- Any caller state transition that preserves `(x'.comap f).Bounded w`, leaves persistent DS +registers (`P.input i = false`) unchanged, and writes only to a set `F` disjoint from +`[base, base + C.space)` preserves both `C.rep s (x'.comap f)` and `C.potential (x'.comap f)`. -/ +theorem frame_caller (C : RelSubroutineDS P D w base params s₀) + {f : Fin r_ds → Fin r_caller} {s : D.State} {x x' : Data r_caller} {F : Finset ℕ} + (hr : C.rep s (x.comap f)) + (hb' : (x'.comap f).Bounded w) + (hreg : ∀ i, P.input i = false → x'.regs (f i) = x.regs (f i)) + (hdisj : Disjoint (Block.mk base C.space).footprint F) + (hmem : Modifies F x.mem x'.mem) : + C.rep s (x'.comap f) ∧ C.potential (x'.comap f) = C.potential (x.comap f) := by + have hag : ∀ a ∈ (Block.mk base C.space).footprint, x'.mem a = x.mem a := fun a ha => + hmem a (fun hf => Finset.disjoint_left.mp hdisj ha hf) + exact ⟨C.rep_supported (x := x.comap f) (x' := x'.comap f) hreg hag hb' hr, + C.potential_supported (x := x.comap f) (x' := x'.comap f) hreg hag hr⟩ + +/-! ### Projection 6: Flat-program operation-sequence execution (`RunsRelOps`, `run_ops_exact_*`) -/ + +/-- Default register-preparation function overwriting `P.input` registers with `C.encode o`. -/ +def prepareRegs (C : RelSubroutineDS P D w base params s₀) (o : D.Op) + (regs : Fin r_ds → ℕ) : Fin r_ds → ℕ := + fun i => if P.input i then C.encode o i else regs i + +/-- Sequential flat-program execution of `ops : List D.Op` by repeated calls to `P.opProg`: +each call prepares input registers via `prepRegs`, runs `P.opProg` from `pc = 0` to `halt`, +decodes a permitted outcome `(s₁, a)` with `D.step s o s₁ a`, modifies memory only within +`[base, base + C.space)`, records the resulting transcript `tr : D.Transcript`, and accumulates +total instructions executed (including each trailing `halt`). -/ +inductive RunsRelOps (C : RelSubroutineDS P D w base params s₀) + (prepRegs : D.Op → (Fin r_ds → ℕ) → (Fin r_ds → ℕ) := C.prepareRegs) : + D.State → Data r_ds → List D.Op → D.Transcript → D.State → Data r_ds → ℕ → Prop + | nil {s x} : RunsRelOps C prepRegs s x [] [] s x 0 + | cons {s s₁ s₂ x o a ops tr pc y z steps rest} : + Runs w P.opProg ⟨0, ⟨prepRegs o x.regs, x.mem⟩⟩ ⟨pc, y⟩ steps → + (∃ out, step w P.opProg ⟨pc, y⟩ = .halt out) → + D.step s o s₁ a → + C.decode o y.regs = some a → + Modifies (Block.mk base C.space).footprint x.mem y.mem → + RunsRelOps C prepRegs s₁ y ops tr s₂ z rest → + RunsRelOps C prepRegs s x (o :: ops) (⟨o, a, s₁⟩ :: tr) s₂ z ((steps + 1) + rest) + +private theorem step_program_halt (c : Code B r_ds) (out : Fin r_ds) (y : Data r_ds) : + step w (c.program out) ⟨0 + c.size, y⟩ = .halt (y.regs out) := + step_halt (by + simp only [Code.program, Nat.zero_add, + List.getElem?_append_right (Code.length_assemble c 0).le, + Code.length_assemble, Nat.sub_self, List.getElem?_cons_zero]) + +/-- Flat-program sequence execution under a custom register-preparation function `prepRegs`. -/ +theorem seq_runsRelOps_of_prep (C : RelSubroutineDS P D w base params s₀) + (prepRegs : D.Op → (Fin r_ds → ℕ) → (Fin r_ds → ℕ)) + (hfit : ∀ {s} (o) (regs : Fin r_ds → ℕ), D.valid s o → (∀ i, Fits w (regs i)) → + ∀ i, Fits w (prepRegs o regs i)) + (hnot_in : ∀ (o : D.Op) (regs : Fin r_ds → ℕ) (i : Fin r_ds), + P.input i = false → prepRegs o regs i = regs i) + (harg : ∀ (o : D.Op) (regs : Fin r_ds → ℕ), C.argMatch o (prepRegs o regs)) : + ∀ (ops : List D.Op) {s : D.State} {x : Data r_ds}, + C.rep s x → D.ValidOpSeq s ops → + ∃ tr s_fin z t_ops, + C.RunsRelOps prepRegs s x ops tr s_fin z t_ops ∧ + tr.ops = ops ∧ + D.ValidTranscript s tr s_fin ∧ + C.rep s_fin z ∧ + t_ops + C.potential z ≤ + D.totalCost (fun st o => C.charge st o + 1) s tr + C.potential x + | [], s, x, hr, _ => + ⟨[], s, x, 0, .nil, rfl, .nil s, hr, Nat.zero_add (C.potential x) ▸ le_rfl⟩ + | o :: ops, s, x, hr, ⟨hv_o, hv_rest⟩ => by + let x' : Data r_ds := ⟨prepRegs o x.regs, x.mem⟩ + have hbx := C.bounded hr + have hb' : x'.Bounded w := ⟨hfit o x.regs hv_o hbx.1, hbx.2⟩ + have hreg' : ∀ i, P.input i = false → x'.regs i = x.regs i := + fun i hi => hnot_in o x.regs i hi + have hr' : C.rep s x' := C.rep_supported hreg' (fun _ _ => rfl) hb' hr + have hpot' : C.potential x' = C.potential x := + C.potential_supported hreg' (fun _ _ => rfl) hr + obtain ⟨y, s₁, a, m, he_op, hstep, hdec, hr_y, hmod, hpot_m⟩ := + C.step_exec o hr' hv_o (harg o x.regs) + rw [hpot'] at hpot_m + have hruns : Runs w P.opProg ⟨0, x'⟩ ⟨0 + P.code.size, y⟩ m := + he_op.runs (pc := 0) (p := P.opProg) (Program.Contains.self _).append_left + have hhalt : step w P.opProg ⟨0 + P.code.size, y⟩ = .halt (y.regs P.output) := + step_program_halt P.code P.output y + obtain ⟨tr, s_fin, z, rest, hrest, hops, htr, hr_z, hpot_rest⟩ := + seq_runsRelOps_of_prep C prepRegs hfit hnot_in harg ops hr_y (hv_rest s₁ a hstep) + refine ⟨⟨o, a, s₁⟩ :: tr, s_fin, z, (m + 1) + rest, + .cons hruns ⟨_, hhalt⟩ hstep hdec hmod hrest, + congrArg (o :: ·) hops, .cons _ hv_o hstep htr, hr_z, ?_⟩ + simp only [Stateful.RelSpec.totalCost_cons] + omega + +/-- Flat-program sequence execution using `C.prepareRegs`. -/ +theorem seq_runsRelOps (C : RelSubroutineDS P D w base params s₀) + (ops : List D.Op) {s : D.State} {x : Data r_ds} + (hr : C.rep s x) (hv : D.ValidOpSeq s ops) : + ∃ tr s_fin z t_ops, + C.RunsRelOps C.prepareRegs s x ops tr s_fin z t_ops ∧ + tr.ops = ops ∧ + D.ValidTranscript s tr s_fin ∧ + C.rep s_fin z ∧ + t_ops + C.potential z ≤ + D.totalCost (fun st o => C.charge st o + 1) s tr + C.potential x := by + refine C.seq_runsRelOps_of_prep C.prepareRegs ?_ ?_ C.encode_matches ops hr hv + · intro s' o regs hv_o hregs i + simp only [prepareRegs] + split_ifs with hi + · exact C.arguments_fit o hv_o i hi + · exact hregs i + · intro o regs i hi + simp [prepareRegs, hi] + +/-- Standalone flat-program operation-sequence theorem with `O(1)` fresh initialization on zeroed +`[base, base + C.space)`. -/ +theorem run_ops_exact_fresh (C : RelSubroutineDS P D w base params s₀) + {d₀ : Data r_ds} (hd₀ : d₀.Bounded w) + (hfr : d₀.regs P.frontierReg = base) + (hpar : ∀ j, d₀.regs (P.initParams j) = params j) + (hzero : ∀ a ∈ (Block.mk base C.space).footprint, d₀.mem a = 0) + (ops : List D.Op) (hv : D.ValidOpSeq s₀ ops) : + ∃ pc₀ x₀ t_init tr s_fin z t_ops, + Runs w P.initFreshProg ⟨0, d₀⟩ ⟨pc₀, x₀⟩ t_init ∧ + (∃ out, step w P.initFreshProg ⟨pc₀, x₀⟩ = .halt out) ∧ + Modifies (Block.mk base C.space).footprint d₀.mem x₀.mem ∧ + C.RunsRelOps C.prepareRegs s₀ x₀ ops tr s_fin z t_ops ∧ + tr.ops = ops ∧ + D.ValidTranscript s₀ tr s_fin ∧ + C.rep s_fin z ∧ + t_init ≤ C.initTime ∧ + t_ops + C.potential z ≤ + D.totalCost (fun st o => C.charge st o + 1) s₀ tr + C.initPotential := by + obtain ⟨x₀, ⟨t_init, ht_init, he_init⟩, _, hr₀, hpot₀, hmod₀⟩ := + C.initFresh_exec hd₀ hfr hpar hzero + have hruns₀ : Runs w P.initFreshProg ⟨0, d₀⟩ ⟨0 + P.initFresh.size, x₀⟩ t_init := + he_init.runs (pc := 0) (p := P.initFreshProg) (Program.Contains.self _).append_left + have hhalt₀ : step w P.initFreshProg ⟨0 + P.initFresh.size, x₀⟩ = .halt (x₀.regs P.output) := + step_program_halt P.initFresh P.output x₀ + obtain ⟨tr, s_fin, z, t_ops, hruns_ops, hops, htr, hr_z, hbound⟩ := + C.seq_runsRelOps ops hr₀ hv + exact ⟨_, x₀, t_init, tr, s_fin, z, t_ops, hruns₀, ⟨_, hhalt₀⟩, hmod₀, hruns_ops, + hops, htr, hr_z, ht_init, by omega⟩ + +/-- Standalone flat-program operation-sequence theorem with `O(space)` reusable initialization on +arbitrary `w`-bounded memory. -/ +theorem run_ops_exact_reusable (C : RelSubroutineDS P D w base params s₀) + {d₀ : Data r_ds} (hd₀ : d₀.Bounded w) + (hfr : d₀.regs P.frontierReg = base) + (hpar : ∀ j, d₀.regs (P.initParams j) = params j) + (ops : List D.Op) (hv : D.ValidOpSeq s₀ ops) : + ∃ pc₀ x₀ t_init tr s_fin z t_ops, + Runs w P.initClearProg ⟨0, d₀⟩ ⟨pc₀, x₀⟩ t_init ∧ + (∃ out, step w P.initClearProg ⟨pc₀, x₀⟩ = .halt out) ∧ + Modifies (Block.mk base C.space).footprint d₀.mem x₀.mem ∧ + C.RunsRelOps C.prepareRegs s₀ x₀ ops tr s_fin z t_ops ∧ + tr.ops = ops ∧ + D.ValidTranscript s₀ tr s_fin ∧ + C.rep s_fin z ∧ + t_init ≤ C.initTime + 4 * C.space + 6 ∧ + t_ops + C.potential z ≤ + D.totalCost (fun st o => C.charge st o + 1) s₀ tr + C.initPotential := by + obtain ⟨x₀, ⟨t_init, ht_init, he_init⟩, _, hr₀, hpot₀, hmod₀⟩ := + C.initClear_exec hd₀ hfr hpar + have hruns₀ : Runs w P.initClearProg ⟨0, d₀⟩ ⟨0 + P.initClear.size, x₀⟩ t_init := + he_init.runs (pc := 0) (p := P.initClearProg) (Program.Contains.self _).append_left + have hhalt₀ : step w P.initClearProg ⟨0 + P.initClear.size, x₀⟩ = .halt (x₀.regs P.output) := + step_program_halt P.initClear P.output x₀ + obtain ⟨tr, s_fin, z, t_ops, hruns_ops, hops, htr, hr_z, hbound⟩ := + C.seq_runsRelOps ops hr₀ hv + exact ⟨_, x₀, t_init, tr, s_fin, z, t_ops, hruns₀, ⟨_, hhalt₀⟩, hmod₀, hruns_ops, + hops, htr, hr_z, ht_init, by omega⟩ + +end RelSubroutineDS + +end Cslib.WordRAM diff --git a/Complexity/Foundations/Semantics/Stateful/Relational.lean b/Complexity/Foundations/Semantics/Stateful/Relational.lean new file mode 100644 index 000000000..40d7761e7 --- /dev/null +++ b/Complexity/Foundations/Semantics/Stateful/Relational.lean @@ -0,0 +1,1181 @@ +/- +Copyright (c) 2026 Renfei Zhou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Renfei Zhou +-/ + +module +-- upstream: candidate + +public import Complexity.Init +public import Complexity.Foundations.Semantics.Stateful.Amortized +public import Complexity.Foundations.Semantics.Stateful.CostHoare +public import Cslib.Foundations.Semantics.LTS.Basic + +/-! +# Relational stateful specifications, demonic adaptive clients, and angelic realizations + +A relational stateful specification (`Cslib.Stateful.RelSpec`) generalizes `Cslib.Stateful.Spec` +from a deterministic transition function `step : State → (o : Op) → State × Result o` to a +transition relation `step : State → (o : Op) → State → Result o → Prop`. This allows data-structure +specifications to leave implementation choices (such as which free slot or handle is allocated, or +how equal-key ties are broken) underspecified in the abstract interface while keeping internal +allocator state hidden inside concrete representation invariants. + +The semantics is **demonic** for callers and **angelic** for implementations: +* An adaptive client `p : D.Client α` is demonically admissible (`D.DemonicValid s p`) when each + issued operation is admissible (`D.valid`) and the continuation remains admissible under *every* + outcome `(s', a)` permitted by `D.step`. Caller postconditions (`D.Hoare`) and abstract cost + budgets (`D.CostHoare`) hold across *all* permitted client runs (`D.ClientRun`). +* A concrete backend realization (`RelRealization`, `RelAmortized`) is angelic in the abstract + post-state: each concrete operation execution witnesses *some* permitted abstract transition + `D.step s o s' a` maintaining the representation invariant and potential inequality. + +Every deterministic `D : Spec` embeds into `RelSpec` with zero overhead via `Spec.toRelSpec` +(preserving `State`, `Op`, `Result`, `valid`, `signature`, and `Client α` definitionally), and +`DemonicValid`, `ClientRun`, `Hoare`, and `CostHoare` on `D.toRelSpec` are equivalent to their +deterministic counterparts on `D`. + +## Main definitions + +* `Cslib.Stateful.RelSpec`: relational stateful specification with `State`, `Op`, `Result`, + transition relation `step`, and input admissibility `valid`. +* `Cslib.Stateful.RelSpec.Total`: typeclass asserting that every admissible `(s, o)` has at least + one permitted outcome `(s', a)`. +* `Cslib.Stateful.Spec.toRelSpec`: zero-cost embedding of a deterministic `Spec` into `RelSpec`. +* `Cslib.Stateful.RelSpec.toLTS`: projection of a `RelSpec` to a `Cslib.LTS` labelled by + input-output pairs `Σ o : D.Op, D.Result o`. +* `Cslib.Stateful.RelSpec.Step`, `Cslib.Stateful.RelSpec.Transcript`, + `Cslib.Stateful.RelSpec.ValidTranscript`, `Cslib.Stateful.RelSpec.ValidOpSeq`, + `Cslib.Stateful.RelSpec.totalCost`, `Cslib.Stateful.RelSpec.totalCostOutcome`: execution + transcripts, non-adaptive operation-sequence admissibility, and abstract cost accounting. +* `Cslib.Stateful.RelSpec.ClientRun`, `Cslib.Stateful.RelSpec.DemonicValid`, + `Cslib.Stateful.RelSpec.Hoare`, `Cslib.Stateful.RelSpec.CostHoare`: adaptive client runs, + demonic admissibility, and compositional Hoare / CostHoare triples. +* `Cslib.Stateful.RelExecution`, `Cslib.Stateful.RelExecutes`, + `Cslib.Stateful.RelRealization`, `Cslib.Stateful.RelBound`, `Cslib.Stateful.RelAmortized`: + native execution traces, angelic representation simulation, and potential-method certificates. + +## Main results + +* `Cslib.Stateful.Spec.toRelSpec_demonicValid_iff`, + `Cslib.Stateful.Spec.toRelSpec_clientRun_iff`, + `Cslib.Stateful.Spec.toRelSpec_hoare_iff`, + `Cslib.Stateful.Spec.toRelSpec_costHoare_iff`: exact collapse of relational client semantics to + deterministic `Spec` semantics on `D.toRelSpec`. +* `Cslib.Stateful.RelRealization.correct_client`, + `Cslib.Stateful.RelRealization.exists_executes`: soundness and existence of native client + executions under `DemonicValid`. +* `Cslib.Stateful.RelAmortized.executes_le`, `Cslib.Stateful.RelAmortized.run_client_amortized`: + amortized potential telescoping along adaptive client executions. + +## References + +* [T. H. Cormen, C. E. Leiserson, R. L. Rivest and C. Stein, *Introduction to Algorithms*, + Chapter 17][CLRS2009] +* [D. Sangiorgi, *Introduction to Bisimulation and Coinduction*][Sangiorgi2011] +-/ + +@[expose] public section + +namespace Cslib.Stateful + +universe u v w x y + +/-! ## Core relational specification and totality -/ + +/-- A relational stateful specification with state type `State`, operation type `Op`, +operation-dependent observation family `Result`, transition relation `step`, and input +admissibility predicate `valid`. -/ +structure RelSpec where + /-- Mathematical states, independent of a concrete storage representation. -/ + State : Type u + /-- Operations available to clients. -/ + Op : Type v + /-- The observation type returned by each operation. -/ + Result : Op → Type w + /-- Relational step specification: `step s o s' a` holds when transitioning from `s` to `s'` + and returning `a : Result o` is a permitted outcome of `o`. -/ + step : State → (o : Op) → State → Result o → Prop + /-- Preconditions under which an operation's implementation must satisfy its contract. -/ + valid : State → Op → Prop := fun _ _ => True + +namespace RelSpec + +variable (D : RelSpec.{u, v, w}) + +/-- The set of permitted `(nextState, result)` outcomes of operation `o` from state `s`. -/ +def outcomes (s : D.State) (o : D.Op) : Set (D.State × D.Result o) := + {p | D.step s o p.1 p.2} + +/-- Membership in `D.outcomes s o` unfolds to `D.step s o`. -/ +@[simp] +theorem mem_outcomes_iff (s : D.State) (o : D.Op) (p : D.State × D.Result o) : + p ∈ D.outcomes s o ↔ D.step s o p.1 p.2 := Iff.rfl + +/-- A relational specification is total on admissible inputs if every valid `(s, o)` admits at +least one permitted outcome `(s', a)`. -/ +class Total : Prop where + /-- Every admissible operation call has at least one permitted post-state and result. -/ + step_total : ∀ s o, D.valid s o → ∃ s' a, D.step s o s' a + +/-- Obtain a permitted outcome `(s', a)` for an admissible operation under `[D.Total]`. -/ +theorem exists_step [D.Total] {s : D.State} {o : D.Op} (hv : D.valid s o) : + ∃ s' a, D.step s o s' a := + Total.step_total s o hv + +/-- The polynomial operation signature `⟨D.Op, D.Result⟩`. -/ +abbrev signature : PFunctor.{v, w} := ⟨D.Op, D.Result⟩ + +/-- An adaptive client over `D`: each continuation may branch on the observed operation result. -/ +abbrev Client (α : Type y) : Type (max v w y) := D.signature.FreeM α + +/-- Invoke a single operation `o : D.Op` in an adaptive `D.Client`. -/ +abbrev call (o : D.Op) : D.Client (D.Result o) := .liftBind o .pure + +/-- An input-output transition label pairing an operation `o : D.Op` with its result `a`. -/ +abbrev Label : Type (max v w) := Σ o : D.Op, D.Result o + +/-- View a relational stateful specification as a labelled transition system (`Cslib.LTS`) +labelled by input-output pairs `⟨o, a⟩ : Σ o : D.Op, D.Result o`. -/ +def toLTS : LTS D.State D.Label where + Tr s lbl s' := D.step s lbl.1 s' lbl.2 + +/-- A transition in `D.toLTS` is a step of `D`. -/ +@[simp] +theorem toLTS_tr (s s' : D.State) (lbl : D.Label) : + D.toLTS.Tr s lbl s' ↔ D.step s lbl.1 s' lbl.2 := Iff.rfl + +end RelSpec + +/-! ## Zero-cost embedding of deterministic specifications (`Spec.toRelSpec`) -/ + +/-- Embed a deterministic `Stateful.Spec` as a relational `RelSpec` whose transition relation +holds if and only if `(s', a) = D.step s o`. -/ +abbrev Spec.toRelSpec (D : Spec.{u, v, w}) : RelSpec.{u, v, w} where + State := D.State + Op := D.Op + Result := D.Result + step s o s' a := (s', a) = D.step s o + valid := D.valid + +instance : Coe Spec.{u, v, w} RelSpec.{u, v, w} := ⟨Spec.toRelSpec⟩ + +namespace Spec + +variable (D : Spec.{u, v, w}) + +/-- `toRelSpec` preserves the state type definitionally. -/ +@[simp] +theorem toRelSpec_state : D.toRelSpec.State = D.State := rfl + +/-- `toRelSpec` preserves the operation type definitionally. -/ +@[simp] +theorem toRelSpec_op : D.toRelSpec.Op = D.Op := rfl + +/-- `toRelSpec` preserves the result family definitionally. -/ +@[simp] +theorem toRelSpec_result : D.toRelSpec.Result = D.Result := rfl + +/-- A step in `D.toRelSpec` holds iff `(s', a) = D.step s o`. -/ +@[simp] +theorem toRelSpec_step (s : D.State) (o : D.Op) (s' : D.State) (a : D.Result o) : + D.toRelSpec.step s o s' a ↔ (s', a) = D.step s o := Iff.rfl + +/-- `toRelSpec` preserves the admissibility predicate definitionally. -/ +@[simp] +theorem toRelSpec_valid (s : D.State) (o : D.Op) : + D.toRelSpec.valid s o ↔ D.valid s o := Iff.rfl + +/-- `toRelSpec` preserves the polynomial signature definitionally. -/ +@[simp] +theorem toRelSpec_signature : D.toRelSpec.signature = D.signature := rfl + +/-- `toRelSpec` preserves the adaptive client type definitionally. -/ +@[simp] +theorem toRelSpec_client (α : Type y) : D.toRelSpec.Client α = D.Client α := rfl + +/-- Every embedded deterministic specification is automatically total. -/ +instance : D.toRelSpec.Total where + step_total s o _ := ⟨(D.step s o).1, (D.step s o).2, Prod.mk.eta⟩ + +/-- Transitions in `D.toRelSpec.toLTS` agree with `D.toFLTS` on states and `(D.step s o).2` on +observations. -/ +theorem toRelSpec_toLTS_tr (s s' : D.State) (o : D.Op) (a : D.Result o) : + D.toRelSpec.toLTS.Tr s ⟨o, a⟩ s' ↔ s' = D.toFLTS.tr s o ∧ a = (D.step s o).2 := by + simp [RelSpec.toLTS, Spec.toRelSpec, Spec.toFLTS, Prod.ext_iff] + +/-- The labelled transition system of an embedded deterministic specification is deterministic. -/ +instance : D.toRelSpec.toLTS.Deterministic where + deterministic s lbl s₁ s₂ h₁ h₂ := by + have h₁' := congrArg Prod.fst h₁ + have h₂' := congrArg Prod.fst h₂ + exact h₁'.trans h₂'.symm + +/-- Multi-step execution `D.run` produces a valid multi-step trace in `D.toRelSpec.toLTS` ending +at `D.toFLTS.mtr s os`. -/ +theorem toRelSpec_toLTS_mtr_run (s : D.State) (os : List D.Op) : + D.toRelSpec.toLTS.MTr s (D.run s os).2 (D.toFLTS.mtr s os) := by + induction os generalizing s with + | nil => exact .refl + | cons o os ih => + exact .stepL Prod.mk.eta (ih (D.step s o).1) + +end Spec + +/-! ## Transcripts, non-adaptive operation sequences, and cost accounting -/ + +namespace RelSpec + +variable (D : RelSpec.{u, v, w}) + +/-- One recorded step of a relational specification: the issued operation `op`, its returned +observation `result`, and the resulting post-state `nextState`. -/ +structure Step : Type (max u v w) where + /-- The operation invoked at this step. -/ + op : D.Op + /-- The observation returned by `op`. -/ + result : D.Result op + /-- The abstract post-state reached after `op`. -/ + nextState : D.State + +/-- A finite execution transcript is a list of recorded steps. -/ +abbrev Transcript : Type (max u v w) := List D.Step + +/-- Extract the underlying sequence of operations from a transcript. -/ +def Transcript.ops {D : RelSpec.{u, v, w}} (tr : D.Transcript) : List D.Op := + tr.map Step.op + +/-- Extract the `Cslib.LTS` input-output labels from a transcript. -/ +def Transcript.labels {D : RelSpec.{u, v, w}} (tr : D.Transcript) : List D.Label := + tr.map fun st => ⟨st.op, st.result⟩ + +@[simp] +theorem Transcript.ops_nil {D : RelSpec.{u, v, w}} : + Transcript.ops ([] : D.Transcript) = [] := rfl + +@[simp] +theorem Transcript.ops_cons {D : RelSpec.{u, v, w}} (st : D.Step) (tr : D.Transcript) : + Transcript.ops (st :: tr) = st.op :: Transcript.ops tr := rfl + +@[simp] +theorem Transcript.ops_append {D : RelSpec.{u, v, w}} (tr₁ tr₂ : D.Transcript) : + Transcript.ops (tr₁ ++ tr₂) = Transcript.ops tr₁ ++ Transcript.ops tr₂ := + List.map_append + +@[simp] +theorem Transcript.length_ops {D : RelSpec.{u, v, w}} (tr : D.Transcript) : + (Transcript.ops tr).length = tr.length := + List.length_map _ + +@[simp] +theorem Transcript.labels_nil {D : RelSpec.{u, v, w}} : + Transcript.labels ([] : D.Transcript) = [] := rfl + +@[simp] +theorem Transcript.labels_cons {D : RelSpec.{u, v, w}} (st : D.Step) (tr : D.Transcript) : + Transcript.labels (st :: tr) = ⟨st.op, st.result⟩ :: Transcript.labels tr := rfl + +@[simp] +theorem Transcript.labels_append {D : RelSpec.{u, v, w}} (tr₁ tr₂ : D.Transcript) : + Transcript.labels (tr₁ ++ tr₂) = Transcript.labels tr₁ ++ Transcript.labels tr₂ := + List.map_append + +@[simp] +theorem Transcript.length_labels {D : RelSpec.{u, v, w}} (tr : D.Transcript) : + (Transcript.labels tr).length = tr.length := + List.length_map _ + +/-- `D.ValidTranscript s tr s'` holds when `tr` is a valid step-by-step execution starting at `s` +and ending at `s'`, where each step is admissible (`D.valid`) and permitted by `D.step`. -/ +inductive ValidTranscript : D.State → D.Transcript → D.State → Prop + | nil (s : D.State) : ValidTranscript s [] s + | cons {s : D.State} (st : D.Step) {tr : D.Transcript} {s_fin : D.State} : + D.valid s st.op → + D.step s st.op st.nextState st.result → + ValidTranscript st.nextState tr s_fin → + ValidTranscript s (st :: tr) s_fin + +/-- The empty transcript is valid iff the initial and final states coincide. -/ +@[simp] +theorem validTranscript_nil_iff {D : RelSpec.{u, v, w}} (s s' : D.State) : + D.ValidTranscript s [] s' ↔ s = s' := by + constructor + · intro h; cases h; rfl + · rintro rfl; exact .nil s + +/-- A nonempty transcript is valid iff its head step is admissible and permitted and its tail is +valid from `st.nextState`. -/ +@[simp] +theorem validTranscript_cons_iff {D : RelSpec.{u, v, w}} (s s' : D.State) (st : D.Step) + (tr : D.Transcript) : + D.ValidTranscript s (st :: tr) s' ↔ + D.valid s st.op ∧ D.step s st.op st.nextState st.result ∧ + D.ValidTranscript st.nextState tr s' := by + constructor + · intro h + cases h with + | cons _ hv hstep htr => exact ⟨hv, hstep, htr⟩ + · rintro ⟨hv, hstep, htr⟩ + exact .cons st hv hstep htr + +/-- Valid transcripts compose across concatenation. -/ +theorem ValidTranscript.append {D : RelSpec.{u, v, w}} {s s₁ s₂ : D.State} + {tr₁ tr₂ : D.Transcript} (h₁ : D.ValidTranscript s tr₁ s₁) + (h₂ : D.ValidTranscript s₁ tr₂ s₂) : + D.ValidTranscript s (tr₁ ++ tr₂) s₂ := by + induction h₁ with + | nil _ => exact h₂ + | cons st hv hstep _ ih => exact .cons st hv hstep (ih h₂) + +/-- Every valid transcript projects to a multi-step transition in `D.toLTS`. -/ +theorem ValidTranscript.toLTS_mtr {D : RelSpec.{u, v, w}} {s s' : D.State} + {tr : D.Transcript} (h : D.ValidTranscript s tr s') : + D.toLTS.MTr s tr.labels s' := by + induction h with + | nil _ => exact .refl + | cons _ _ hstep _ ih => exact .stepL hstep ih + +/-- Demonic admissibility of a non-adaptive operation sequence `ops : List D.Op` from `s`: +the head operation is admissible at `s`, and the tail sequence remains admissible from every +permitted post-state `s'` of the head operation. -/ +def ValidOpSeq (s : D.State) : List D.Op → Prop + | [] => True + | o :: ops => D.valid s o ∧ ∀ s' a, D.step s o s' a → ValidOpSeq s' ops + +@[simp] +theorem validOpSeq_nil (s : D.State) : D.ValidOpSeq s [] ↔ True := Iff.rfl + +@[simp] +theorem validOpSeq_cons (s : D.State) (o : D.Op) (ops : List D.Op) : + D.ValidOpSeq s (o :: ops) ↔ D.valid s o ∧ ∀ s' a, D.step s o s' a → D.ValidOpSeq s' ops := + Iff.rfl + +/-- Total interfaces have no operation-sequence admissibility obligations. -/ +theorem validOpSeq_of_forall_valid (h : ∀ s o, D.valid s o) (s : D.State) (ops : List D.Op) : + D.ValidOpSeq s ops := by + induction ops generalizing s with + | nil => trivial + | cons o ops ih => exact ⟨h s o, fun s' _ _ => ih s'⟩ + +/-- Under `[D.Total]`, every demonically admissible operation sequence admits at least one valid +transcript. -/ +theorem exists_validTranscript_of_validOpSeq [D.Total] {s : D.State} {ops : List D.Op} + (hv : D.ValidOpSeq s ops) : + ∃ tr s', tr.ops = ops ∧ D.ValidTranscript s tr s' := by + induction ops generalizing s with + | nil => exact ⟨[], s, rfl, .nil s⟩ + | cons o ops ih => + obtain ⟨hv_o, hv_rest⟩ := hv + obtain ⟨s₁, a, hstep⟩ := D.exists_step hv_o + obtain ⟨tr, s₂, hops, htr⟩ := ih (hv_rest s₁ a hstep) + exact ⟨⟨o, a, s₁⟩ :: tr, s₂, congrArg (o :: ·) hops, .cons _ hv_o hstep htr⟩ + +/-- State-dependent charges summed along a transcript. -/ +def totalCost (charge : D.State → D.Op → ℕ) : D.State → D.Transcript → ℕ + | _, [] => 0 + | s, st :: tr => charge s st.op + totalCost charge st.nextState tr + +/-- Outcome-dependent charges summed along a transcript, where each step charge may also inspect +the post-state `st.nextState` and result `st.result`. -/ +def totalCostOutcome (charge : D.State → (o : D.Op) → D.State → D.Result o → ℕ) : + D.State → D.Transcript → ℕ + | _, [] => 0 + | s, st :: tr => + charge s st.op st.nextState st.result + totalCostOutcome charge st.nextState tr + +@[simp] +theorem totalCost_nil (charge : D.State → D.Op → ℕ) (s : D.State) : + D.totalCost charge s [] = 0 := rfl + +@[simp] +theorem totalCost_cons (charge : D.State → D.Op → ℕ) (s : D.State) (st : D.Step) + (tr : D.Transcript) : + D.totalCost charge s (st :: tr) = charge s st.op + D.totalCost charge st.nextState tr := rfl + +@[simp] +theorem totalCostOutcome_nil (charge : D.State → (o : D.Op) → D.State → D.Result o → ℕ) + (s : D.State) : + D.totalCostOutcome charge s [] = 0 := rfl + +@[simp] +theorem totalCostOutcome_cons (charge : D.State → (o : D.Op) → D.State → D.Result o → ℕ) + (s : D.State) (st : D.Step) (tr : D.Transcript) : + D.totalCostOutcome charge s (st :: tr) = + charge s st.op st.nextState st.result + D.totalCostOutcome charge st.nextState tr := rfl + +/-- `totalCost` is the special case of `totalCostOutcome` that ignores the post-state and +result. -/ +theorem totalCost_eq_totalCostOutcome (charge : D.State → D.Op → ℕ) (s : D.State) + (tr : D.Transcript) : + D.totalCost charge s tr = D.totalCostOutcome (fun s o _ _ => charge s o) s tr := by + induction tr generalizing s with + | nil => rfl + | cons st tr ih => simp [ih] + +/-- Along a valid transcript prefix `D.ValidTranscript s tr₁ s₁`, `totalCost` splits additively at +the intermediate state `s₁`. -/ +theorem totalCost_append {D : RelSpec.{u, v, w}} (charge : D.State → D.Op → ℕ) + {s s₁ : D.State} {tr₁ : D.Transcript} (h₁ : D.ValidTranscript s tr₁ s₁) + (tr₂ : D.Transcript) : + D.totalCost charge s (tr₁ ++ tr₂) = + D.totalCost charge s tr₁ + D.totalCost charge s₁ tr₂ := by + induction h₁ with + | nil _ => simp + | cons st _ _ _ ih => simp [ih, Nat.add_assoc] + +/-- Uniform per-operation bounds scale by the transcript length on any valid transcript. -/ +theorem totalCost_le_length_mul {D : RelSpec.{u, v, w}} (charge : D.State → D.Op → ℕ) (T : ℕ) + (h : ∀ s o, D.valid s o → charge s o ≤ T) {s s' : D.State} {tr : D.Transcript} + (hv : D.ValidTranscript s tr s') : + D.totalCost charge s tr ≤ tr.length * T := by + induction hv with + | nil _ => simp + | cons st hv_o _ _ ih => + have hstep := h _ st.op hv_o + simp only [totalCost_cons, List.length_cons, Nat.add_mul, Nat.one_mul] + omega + +/-- A constant charge `K` per operation totals `tr.length * K`. -/ +theorem totalCost_const (K : ℕ) (s : D.State) (tr : D.Transcript) : + D.totalCost (fun _ _ => K) s tr = tr.length * K := by + induction tr generalizing s with + | nil => simp + | cons st tr ih => simp [ih, Nat.add_mul, Nat.add_comm] + +/-- A unit charge per operation totals the transcript length. -/ +theorem totalCost_one (s : D.State) (tr : D.Transcript) : + D.totalCost (fun _ _ => 1) s tr = tr.length := by + simpa using D.totalCost_const 1 s tr + +end RelSpec + +/-! ## Adaptive clients (`ClientRun`, `DemonicValid`) and demonic `Hoare` / `CostHoare` -/ + +namespace RelSpec + +variable (D : RelSpec.{u, v, w}) {α β : Type y} + +/-- `D.ClientRun s p v s' tr` holds when running the adaptive client `p : D.Client α` from initial +state `s` can produce return value `v : α`, final state `s' : D.State`, and transcript `tr` by +making admissible and permitted transitions at each operation call. -/ +inductive ClientRun : D.State → D.Client α → α → D.State → D.Transcript → Prop + | pure (s : D.State) (a : α) : + ClientRun s (.pure a) a s [] + | liftBind {s s₁ s₂ : D.State} (o : D.Op) (k : D.Result o → D.Client α) + (a : D.Result o) {v : α} {tr : D.Transcript} : + D.valid s o → + D.step s o s₁ a → + ClientRun s₁ (k a) v s₂ tr → + ClientRun s (.liftBind o k) v s₂ (⟨o, a, s₁⟩ :: tr) + +/-- Every `ClientRun` produces a valid transcript. -/ +theorem ClientRun.validTranscript {D : RelSpec.{u, v, w}} {s s' : D.State} {p : D.Client α} + {v : α} {tr : D.Transcript} (h : D.ClientRun s p v s' tr) : + D.ValidTranscript s tr s' := by + induction h with + | pure s _ => exact .nil s + | liftBind _ _ _ hv hstep _ ih => exact .cons _ hv hstep ih + +theorem clientRun_pure_iff {D : RelSpec.{u, v, w}} (s : D.State) (a v : α) (s' : D.State) + (tr : D.Transcript) : + D.ClientRun s (.pure a) v s' tr ↔ v = a ∧ s' = s ∧ tr = [] := by + constructor + · intro h + cases h + exact ⟨rfl, rfl, rfl⟩ + · rintro ⟨rfl, rfl, rfl⟩ + exact .pure s' v + +theorem clientRun_liftBind_iff {D : RelSpec.{u, v, w}} (s : D.State) (o : D.Op) + (k : D.Result o → D.Client α) (v : α) (s₂ : D.State) (tr : D.Transcript) : + D.ClientRun s (.liftBind o k) v s₂ tr ↔ + D.valid s o ∧ ∃ a s₁ tr', D.step s o s₁ a ∧ + D.ClientRun s₁ (k a) v s₂ tr' ∧ tr = ⟨o, a, s₁⟩ :: tr' := by + constructor + · intro h + cases h with + | liftBind _ _ a hv hstep hrest => + exact ⟨hv, a, _, _, hstep, hrest, rfl⟩ + · rintro ⟨hv, a, s₁, tr', hstep, hrest, rfl⟩ + exact .liftBind o k a hv hstep hrest + +/-- Sequential client runs compose by concatenating their transcripts. -/ +theorem ClientRun.bind {D : RelSpec.{u, v, w}} {s s₁ s₂ : D.State} {p : D.Client α} + {k : α → D.Client β} {a : α} {b : β} {tr₁ tr₂ : D.Transcript} + (h₁ : D.ClientRun s p a s₁ tr₁) (h₂ : D.ClientRun s₁ (k a) b s₂ tr₂) : + D.ClientRun s (p.bind k) b s₂ (tr₁ ++ tr₂) := by + induction h₁ with + | pure _ _ => exact h₂ + | liftBind o cont res hv hstep _ ih => + exact .liftBind o (fun r => (cont r).bind k) res hv hstep (ih h₂) + +/-- A client run of `p.bind k` splits into a run of `p` and a run of `k` from the intermediate +result and state. -/ +theorem clientRun_bind_iff {D : RelSpec.{u, v, w}} {s s₂ : D.State} {p : D.Client α} + {k : α → D.Client β} {b : β} {tr : D.Transcript} : + D.ClientRun s (p.bind k) b s₂ tr ↔ + ∃ a s₁ tr₁ tr₂, D.ClientRun s p a s₁ tr₁ ∧ + D.ClientRun s₁ (k a) b s₂ tr₂ ∧ tr = tr₁ ++ tr₂ := by + constructor + · intro h + induction p generalizing s tr with + | pure a => + exact ⟨a, s, [], tr, .pure s a, h, rfl⟩ + | liftBind o cont ih => + change D.ClientRun s (.liftBind o fun r => (cont r).bind k) b s₂ tr at h + cases h with + | liftBind _ _ res hv hstep hrest => + obtain ⟨a, s₁, tr₁, tr₂, hp, hk, rfl⟩ := ih res hrest + exact ⟨a, s₁, ⟨o, res, _⟩ :: tr₁, tr₂, .liftBind o cont res hv hstep hp, hk, rfl⟩ + · rintro ⟨a, s₁, tr₁, tr₂, hp, hk, rfl⟩ + exact hp.bind hk + +/-- Demonic admissibility of an adaptive client `p` from state `s`: +* `.pure a` is always admissible; +* `.liftBind o k` requires `D.valid s o` now, and for *every* permitted outcome `(s', a)` of `o` + from `s`, the continuation `k a` must be demonically admissible from `s'`. -/ +inductive DemonicValid : D.State → D.Client α → Prop + | pure (s : D.State) (a : α) : + DemonicValid s (.pure a) + | liftBind {s : D.State} (o : D.Op) (k : D.Result o → D.Client α) : + D.valid s o → + (∀ s' a, D.step s o s' a → DemonicValid s' (k a)) → + DemonicValid s (.liftBind o k) + +theorem demonicValid_pure_iff {D : RelSpec.{u, v, w}} (s : D.State) (a : α) : + D.DemonicValid s (.pure a) ↔ True := + ⟨fun _ => trivial, fun _ => .pure s a⟩ + +theorem demonicValid_liftBind_iff {D : RelSpec.{u, v, w}} (s : D.State) (o : D.Op) + (k : D.Result o → D.Client α) : + D.DemonicValid s (.liftBind o k) ↔ + D.valid s o ∧ ∀ s' a, D.step s o s' a → D.DemonicValid s' (k a) := by + constructor + · intro h + cases h with + | liftBind _ _ hv hk => exact ⟨hv, hk⟩ + · rintro ⟨hv, hk⟩; exact .liftBind o k hv hk + +/-- On a specification where every operation is valid in every state, every client is demonically +admissible. -/ +theorem demonicValid_of_forall_valid (h : ∀ s o, D.valid s o) (s : D.State) (p : D.Client α) : + D.DemonicValid s p := by + induction p generalizing s with + | pure a => exact .pure s a + | liftBind o k ih => exact .liftBind o k (h s o) fun s' a _ => ih a s' + +/-- Under `[D.Total]`, every demonically admissible client admits at least one valid `ClientRun`. -/ +theorem DemonicValid.exists_clientRun {D : RelSpec.{u, v, w}} [D.Total] {s : D.State} + {p : D.Client α} (hv : D.DemonicValid s p) : + ∃ v s' tr, D.ClientRun s p v s' tr := by + induction hv with + | pure s a => exact ⟨a, s, [], .pure s a⟩ + | liftBind o k hv_o _ ih => + obtain ⟨s₁, a, hstep⟩ := D.exists_step hv_o + obtain ⟨v, s₂, tr, hrun⟩ := ih s₁ a hstep + exact ⟨v, s₂, ⟨o, a, s₁⟩ :: tr, .liftBind o k a hv_o hstep hrun⟩ + +/-- Demonic admissibility composes across `bind` when the continuation is demonically admissible +after every valid run of the first client. -/ +theorem DemonicValid.bind {D : RelSpec.{u, v, w}} {s : D.State} {p : D.Client α} + {k : α → D.Client β} (hp : D.DemonicValid s p) + (hk : ∀ a s' tr, D.ClientRun s p a s' tr → D.DemonicValid s' (k a)) : + D.DemonicValid s (p.bind k) := by + induction hp with + | pure s a => exact hk a s [] (.pure s a) + | liftBind o cont hv_o _ ih => + refine .liftBind o (fun r => (cont r).bind k) hv_o fun s₁ r hstep => ?_ + exact ih s₁ r hstep fun a s₂ tr hrun => hk a s₂ (⟨o, r, s₁⟩ :: tr) + (.liftBind o cont r hv_o hstep hrun) + +/-- Demonic Hoare triple for a relational specification: from any initial state satisfying `pre`, +the client `p` is demonically admissible and *every* valid `ClientRun` satisfies `post`. -/ +def Hoare (pre : D.State → Prop) (p : D.Client α) (post : α → D.State → Prop) : Prop := + ∀ s, pre s → D.DemonicValid s p ∧ ∀ v s' tr, D.ClientRun s p v s' tr → post v s' + +namespace Hoare + +variable {D : RelSpec.{u, v, w}} + +/-- Returning a pure value leaves the state unchanged. -/ +theorem pure (pre : D.State → Prop) (a : α) (post : α → D.State → Prop) + (h : ∀ s, pre s → post a s) : D.Hoare pre (.pure a) post := by + intro s hs + refine ⟨.pure s a, ?_⟩ + intro v s' tr hrun + cases hrun + exact h s hs + +/-- Calling an operation requires `D.valid s o` and establishes `post a s'` for every permitted +outcome `D.step s o s' a`. -/ +theorem call (pre : D.State → Prop) (o : D.Op) (post : D.Result o → D.State → Prop) + (h : ∀ s, pre s → D.valid s o ∧ ∀ s' a, D.step s o s' a → post a s') : + D.Hoare pre (.liftBind o fun a => .pure a) post := by + intro s hs + obtain ⟨hv, hpost⟩ := h s hs + refine ⟨.liftBind o (fun a => .pure a) hv fun s' a _ => .pure s' a, ?_⟩ + intro v s' tr hrun + cases hrun with + | liftBind _ _ a _ hstep hrest => + cases hrest + exact hpost s' v hstep + +/-- Sequential composition of demonic Hoare triples. -/ +theorem bind {pre : D.State → Prop} {mid : α → D.State → Prop} + {post : β → D.State → Prop} {p : D.Client α} {k : α → D.Client β} + (hp : D.Hoare pre p mid) (hk : ∀ a, D.Hoare (mid a) (k a) post) : + D.Hoare pre (p.bind k) post := by + intro s hs + obtain ⟨hvp, hpost_p⟩ := hp s hs + refine ⟨hvp.bind fun a s₁ tr₁ hrun₁ => (hk a s₁ (hpost_p a s₁ tr₁ hrun₁)).1, ?_⟩ + intro b s₂ tr hrun + obtain ⟨a, s₁, tr₁, tr₂, hrun₁, hrun₂, _⟩ := clientRun_bind_iff.mp hrun + exact (hk a s₁ (hpost_p a s₁ tr₁ hrun₁)).2 b s₂ tr₂ hrun₂ + +/-- Consequence rule for demonic Hoare triples. -/ +theorem consequence {pre pre' : D.State → Prop} {post post' : α → D.State → Prop} + {p : D.Client α} (h : D.Hoare pre p post) (hp : ∀ s, pre' s → pre s) + (hq : ∀ a s, post a s → post' a s) : D.Hoare pre' p post' := by + intro s hs + obtain ⟨hv, hpost⟩ := h s (hp s hs) + exact ⟨hv, fun v s' tr hrun => hq v s' (hpost v s' tr hrun)⟩ + +end Hoare + +/-- Demonic `CostHoare` triple: strengthens `D.Hoare` with a worst-case abstract charge bound +`D.totalCost charge s tr ≤ budget s` across *every* valid `ClientRun`. -/ +def CostHoare (charge : D.State → D.Op → ℕ) (pre : D.State → Prop) + (p : D.Client α) (post : α → D.State → Prop) (budget : D.State → ℕ) : Prop := + D.Hoare pre p post ∧ + ∀ s, pre s → ∀ v s' tr, D.ClientRun s p v s' tr → D.totalCost charge s tr ≤ budget s + +namespace CostHoare + +variable {D : RelSpec.{u, v, w}} {charge : D.State → D.Op → ℕ} {pre : D.State → Prop} + {post : α → D.State → Prop} {budget : D.State → ℕ} {p : D.Client α} + +/-- Project a `CostHoare` triple to its underlying `Hoare` triple. -/ +theorem hoare (h : D.CostHoare charge pre p post budget) : D.Hoare pre p post := h.1 + +/-- Returning a pure value incurs zero operation cost. -/ +theorem pure (a : α) (h : ∀ s, pre s → post a s) : + D.CostHoare charge pre (.pure a) post (fun _ => 0) := by + refine ⟨Hoare.pure pre a post h, ?_⟩ + intro s _ v s' tr hrun + cases hrun + exact Nat.le_refl 0 + +/-- Calling a single operation charges `charge s o` at the pre-state `s`. -/ +theorem call (o : D.Op) {post : D.Result o → D.State → Prop} + (h : ∀ s, pre s → D.valid s o ∧ ∀ s' a, D.step s o s' a → post a s') : + D.CostHoare charge pre (.liftBind o fun a => .pure a) post (fun s => charge s o) := by + refine ⟨Hoare.call pre o post h, ?_⟩ + intro s _ v s' tr hrun + cases hrun with + | liftBind _ _ a _ _ hrest => + cases hrest + simp + +/-- Compose `CostHoare` budgets at every intermediate state satisfying `mid`. -/ +theorem bind {mid : α → D.State → Prop} {post : β → D.State → Prop} + {k : α → D.Client β} {first : D.State → ℕ} {next : α → D.State → ℕ} + (hp : D.CostHoare charge pre p mid first) + (hk : ∀ a, D.CostHoare charge (mid a) (k a) post (next a)) + (hb : ∀ s, pre s → ∀ a s', mid a s' → first s + next a s' ≤ budget s) : + D.CostHoare charge pre (p.bind k) post budget := by + refine ⟨Hoare.bind hp.hoare (fun a => (hk a).hoare), ?_⟩ + intro s hs b s₂ tr hrun + obtain ⟨a, s₁, tr₁, tr₂, hrun₁, hrun₂, rfl⟩ := clientRun_bind_iff.mp hrun + have hmid : mid a s₁ := (hp.hoare s hs).2 a s₁ tr₁ hrun₁ + have hf := hp.2 s hs a s₁ tr₁ hrun₁ + have hn := (hk a).2 s₁ hmid b s₂ tr₂ hrun₂ + rw [D.totalCost_append charge hrun₁.validTranscript tr₂] + exact (Nat.add_le_add hf hn).trans (hb s hs a s₁ hmid) + +/-- Consequence rule for demonic `CostHoare` triples. -/ +theorem consequence {pre' : D.State → Prop} {post' : α → D.State → Prop} + {budget' : D.State → ℕ} (h : D.CostHoare charge pre p post budget) + (hp : ∀ s, pre' s → pre s) (hq : ∀ a s, post a s → post' a s) + (hb : ∀ s, pre' s → budget s ≤ budget' s) : + D.CostHoare charge pre' p post' budget' := + ⟨h.hoare.consequence hp hq, + fun s hs v s' tr hrun => (h.2 s (hp s hs) v s' tr hrun).trans (hb s hs)⟩ + +end CostHoare + +end RelSpec + +/-! ## Equivalence of relational and deterministic client semantics on `D.toRelSpec` -/ + +namespace Spec + +variable (D : Spec.{u, v, w}) {α : Type y} + +/-- On `D.toRelSpec`, non-adaptive operation-sequence admissibility `ValidOpSeq` coincides with +`D.ValidHistory`. -/ +theorem toRelSpec_validOpSeq_iff (s : D.State) (ops : List D.Op) : + D.toRelSpec.ValidOpSeq s ops ↔ D.ValidHistory s ops := by + induction ops generalizing s with + | nil => rfl + | cons o ops ih => + change (D.valid s o ∧ ∀ s' a, (s', a) = D.step s o → D.toRelSpec.ValidOpSeq s' ops) ↔ + D.valid s o ∧ D.ValidHistory (D.step s o).1 ops + refine and_congr_right fun _ => ?_ + constructor + · intro h + exact (ih (D.step s o).1).mp (h (D.step s o).1 (D.step s o).2 Prod.mk.eta) + · intro h s' a heq + have hs' : s' = (D.step s o).1 := congrArg Prod.fst heq + subst hs' + exact (ih (D.step s o).1).mpr h + +/-- The unique canonical transcript determined by a deterministic specification `D` on an +operation list `os` from state `s`. -/ +def canonicalTranscript (s : D.State) : List D.Op → D.toRelSpec.Transcript + | [] => [] + | o :: os => + let next := D.step s o + ⟨o, next.2, next.1⟩ :: canonicalTranscript next.1 os + +@[simp] +theorem canonicalTranscript_nil (s : D.State) : D.canonicalTranscript s [] = [] := rfl + +@[simp] +theorem canonicalTranscript_cons (s : D.State) (o : D.Op) (os : List D.Op) : + D.canonicalTranscript s (o :: os) = + ⟨o, (D.step s o).2, (D.step s o).1⟩ :: D.canonicalTranscript (D.step s o).1 os := rfl + +/-- The underlying operation list of `D.canonicalTranscript s os` is `os`. -/ +@[simp] +theorem canonicalTranscript_ops (s : D.State) (os : List D.Op) : + (D.canonicalTranscript s os).ops = os := by + induction os generalizing s with + | nil => rfl + | cons o os ih => simp [ih] + +/-- `totalCost` along `D.canonicalTranscript s os` equals `D.totalCost charge s os`. -/ +@[simp] +theorem toRelSpec_totalCost_canonicalTranscript (charge : D.State → D.Op → ℕ) (s : D.State) + (os : List D.Op) : + D.toRelSpec.totalCost charge s (D.canonicalTranscript s os) = D.totalCost charge s os := by + induction os generalizing s with + | nil => rfl + | cons o os ih => + change charge s o + + D.toRelSpec.totalCost charge (D.step s o).1 (D.canonicalTranscript (D.step s o).1 os) = + charge s o + D.totalCost charge (D.step s o).1 os + rw [ih] + +/-- On `D.toRelSpec`, demonic client admissibility `DemonicValid s p` is equivalent to +`D.ValidHistory s (D.runClient s p).2.2`. -/ +theorem toRelSpec_demonicValid_iff (s : D.State) (p : D.Client α) : + D.toRelSpec.DemonicValid s p ↔ D.ValidHistory s (D.runClient s p).2.2 := by + induction p generalizing s with + | pure a => + exact ⟨fun _ => trivial, fun _ => RelSpec.DemonicValid.pure (D := D.toRelSpec) s a⟩ + | liftBind o k ih => + rw [RelSpec.demonicValid_liftBind_iff (D := D.toRelSpec), runClient_liftBind, validHistory_cons] + refine and_congr_right fun _ => ?_ + constructor + · intro h + exact (ih (D.step s o).2 (D.step s o).1).mp + (h (D.step s o).1 (D.step s o).2 Prod.mk.eta) + · intro h s' a heq + have hs' : s' = (D.step s o).1 := congrArg Prod.fst heq + have ha : a = (D.step s o).2 := congrArg Prod.snd heq + subst hs'; subst ha + exact (ih (D.step s o).2 (D.step s o).1).mpr h + +/-- Every client with an admissible deterministic history executes canonically in `D.toRelSpec`. -/ +theorem toRelSpec_clientRun_canonical (s : D.State) (p : D.Client α) + (hv : D.ValidHistory s (D.runClient s p).2.2) : + D.toRelSpec.ClientRun s p (D.runClient s p).1 (D.runClient s p).2.1 + (D.canonicalTranscript s (D.runClient s p).2.2) := by + induction p generalizing s with + | pure a => + exact RelSpec.ClientRun.pure (D := D.toRelSpec) s a + | liftBind o k ih => + exact RelSpec.ClientRun.liftBind (D := D.toRelSpec) o k (D.step s o).2 hv.1 Prod.mk.eta + (ih (D.step s o).2 (D.step s o).1 hv.2) + +private theorem toRelSpec_clientRun_imp {s : D.toRelSpec.State} {p : D.toRelSpec.Client α} + {v : α} {s' : D.toRelSpec.State} {tr : D.toRelSpec.Transcript} + (h : D.toRelSpec.ClientRun s p v s' tr) : + D.ValidHistory s (D.runClient s p).2.2 ∧ + v = (D.runClient s p).1 ∧ + s' = (D.runClient s p).2.1 ∧ + tr = D.canonicalTranscript s (D.runClient s p).2.2 := by + induction h with + | pure s a => + exact ⟨trivial, rfl, rfl, rfl⟩ + | @liftBind s s₁ s₂ o k res v tr hv hstep _ ih => + have hs₁ : s₁ = (D.step s o).1 := congrArg Prod.fst hstep + have hres : res = (D.step s o).2 := congrArg Prod.snd hstep + subst hs₁; subst hres + obtain ⟨hv_rest, rfl, rfl, rfl⟩ := ih + exact ⟨⟨hv, hv_rest⟩, rfl, rfl, rfl⟩ + +/-- On `D.toRelSpec`, `ClientRun` collapses uniquely to `D.runClient` and `D.ValidHistory`. -/ +theorem toRelSpec_clientRun_iff (s : D.State) (p : D.Client α) (v : α) (s' : D.State) + (tr : D.toRelSpec.Transcript) : + D.toRelSpec.ClientRun s p v s' tr ↔ + D.ValidHistory s (D.runClient s p).2.2 ∧ + v = (D.runClient s p).1 ∧ + s' = (D.runClient s p).2.1 ∧ + tr = D.canonicalTranscript s (D.runClient s p).2.2 := + ⟨D.toRelSpec_clientRun_imp, fun ⟨hv, h₁, h₂, h₃⟩ => + h₁ ▸ h₂ ▸ h₃ ▸ D.toRelSpec_clientRun_canonical s p hv⟩ + +/-- On `D.toRelSpec`, `RelSpec.Hoare` is equivalent to `Spec.Hoare`. -/ +theorem toRelSpec_hoare_iff (pre : D.State → Prop) (p : D.Client α) (post : α → D.State → Prop) : + D.toRelSpec.Hoare pre p post ↔ D.Hoare pre p post := by + refine forall_congr' fun s => imp_congr_right fun _ => ?_ + rw [toRelSpec_demonicValid_iff] + constructor + · rintro ⟨hv, hpost⟩ + exact ⟨hv, hpost _ _ _ (D.toRelSpec_clientRun_canonical s p hv)⟩ + · rintro ⟨hv, hpost⟩ + refine ⟨hv, fun v s' tr hrun => ?_⟩ + obtain ⟨_, rfl, rfl, _⟩ := (D.toRelSpec_clientRun_iff s p v s' tr).mp hrun + exact hpost + +/-- On `D.toRelSpec`, `RelSpec.CostHoare` is equivalent to `Spec.CostHoare`. -/ +theorem toRelSpec_costHoare_iff (charge : D.State → D.Op → ℕ) (pre : D.State → Prop) + (p : D.Client α) (post : α → D.State → Prop) (budget : D.State → ℕ) : + D.toRelSpec.CostHoare charge pre p post budget ↔ D.CostHoare charge pre p post budget := by + unfold RelSpec.CostHoare Spec.CostHoare + rw [toRelSpec_hoare_iff] + refine and_congr_right fun hhoare => forall_congr' fun s => imp_congr_right fun hs => ?_ + have hv := (hhoare s hs).1 + constructor + · intro h + have hb := h _ _ _ (D.toRelSpec_clientRun_canonical s p hv) + rwa [D.toRelSpec_totalCost_canonicalTranscript] at hb + · intro h v s' tr hrun + obtain ⟨_, _, _, rfl⟩ := (D.toRelSpec_clientRun_iff s p v s' tr).mp hrun + rwa [D.toRelSpec_totalCost_canonicalTranscript] + +end Spec + +/-! ## Native backend executions (`RelExecution`, `RelExecutes`), `RelRealization`, `RelAmortized` +-/ + +/-- A concrete backend execution relation for a relational specification `D : RelSpec`. -/ +abbrev RelExecution (D : RelSpec.{u, v, w}) (C Trace : Type x) := + C → (o : D.Op) → D.Result o → C → Trace → Prop + +/-- Adaptive client execution collecting native execution evidence in call order over a +relational specification `D : RelSpec`. -/ +inductive RelExecutes {D : RelSpec.{u, v, w}} {C τ : Type x} {α : Type y} + (exec : RelExecution D C τ) : D.Client α → C → α → C → List τ → Prop + | pure (a c) : RelExecutes exec (.pure a) c a c [] + | call {o k c a c' trace b c'' traces} : + exec c o a c' trace → RelExecutes exec (k a) c' b c'' traces → + RelExecutes exec (.liftBind o k) c b c'' (trace :: traces) + +/-- Sequential client execution splits its native trace at the call boundary. -/ +theorem relExecutes_bind_iff {D : RelSpec.{u, v, w}} {C τ : Type x} {α β : Type y} + (exec : RelExecution D C τ) (p : D.Client α) (k : α → D.Client β) + {c c' : C} {b : β} {ts : List τ} : + RelExecutes exec (p.bind k) c b c' ts ↔ + ∃ a mid front back, RelExecutes exec p c a mid front ∧ + RelExecutes exec (k a) mid b c' back ∧ ts = front ++ back := by + induction p generalizing c ts with + | pure a => + constructor + · intro h; exact ⟨a, c, [], ts, .pure a c, h, rfl⟩ + · rintro ⟨a', mid, front, back, hp, hk, ht⟩ + cases hp + simpa only [ht, List.nil_append, PFunctor.FreeM.bind] using hk + | liftBind o cont ih => + change RelExecutes exec (.liftBind o fun a => (cont a).bind k) c b c' ts ↔ _ + constructor + · intro h + cases h with + | call ho rest => + obtain ⟨a, mid, front, back, hp, hk, ht⟩ := (ih _).mp rest + exact ⟨a, mid, _, back, .call ho hp, hk, by simp [ht]⟩ + · rintro ⟨a, mid, front, back, hp, hk, ht⟩ + cases hp with + | call ho rest => + have hrest := (ih _).mpr ⟨a, mid, _, back, rest, hk, rfl⟩ + have h := RelExecutes.call (k := fun a => (cont a).bind k) ho hrest + simpa only [ht, List.cons_append] using h + +private theorem Spec.toRelSpec_relExecutes_imp {D : Spec.{u, v, w}} {C τ : Type x} {α : Type y} + {exec : Execution D C τ} {p : D.toRelSpec.Client α} {c : C} {a : α} {c' : C} + {traces : List τ} (h : RelExecutes (D := D.toRelSpec) exec p c a c' traces) : + Executes exec p c a c' traces := by + induction h with + | pure a c => exact .pure a c + | call ho _ ih => exact .call ho ih + +/-- On `D.toRelSpec`, `RelExecutes` coincides with `Executes`. -/ +theorem Spec.toRelSpec_relExecutes_iff {D : Spec.{u, v, w}} {C τ : Type x} {α : Type y} + (exec : Execution D C τ) (p : D.Client α) (c : C) (a : α) (c' : C) (traces : List τ) : + RelExecutes (D := D.toRelSpec) exec p c a c' traces ↔ Executes exec p c a c' traces := by + refine ⟨Spec.toRelSpec_relExecutes_imp, fun h => ?_⟩ + induction h with + | pure a c => exact RelExecutes.pure (D := D.toRelSpec) a c + | call ho _ ih => exact RelExecutes.call (D := D.toRelSpec) ho ih + +/-- Angelic semantic realization of a relational specification `D : RelSpec`: +* `total`: every represented state and admissible operation admits a native execution; +* `correct`: every native execution from a represented state on an admissible operation realizes + *some* permitted abstract post-state `s'` with `D.step s o s' a ∧ rep s' c'`. -/ +structure RelRealization (D : RelSpec.{u, v, w}) {C τ : Type x} + (exec : RelExecution D C τ) where + /-- Representation invariant linking abstract states to concrete backend states. -/ + rep : D.State → C → Prop + /-- Existence of a native execution for every represented state and admissible operation. -/ + total : ∀ {s c} o, rep s c → D.valid s o → ∃ a c' trace, exec c o a c' trace + /-- Angelic step correctness: every native execution realizes some permitted abstract step. -/ + correct : ∀ {s c o a c' trace}, rep s c → D.valid s o → exec c o a c' trace → + ∃ s', D.step s o s' a ∧ rep s' c' + +namespace RelRealization + +variable {D : RelSpec.{u, v, w}} {C τ : Type x} {α : Type y} + {exec : RelExecution D C τ} (R : RelRealization D exec) + +/-- From related states, every native execution of a demonically admissible client realizes a +valid `ClientRun` ending in a related state. -/ +theorem correct_client {p : D.Client α} {s : D.State} {c c' : C} {a : α} + {traces : List τ} (hr : R.rep s c) (hv : D.DemonicValid s p) + (he : RelExecutes exec p c a c' traces) : + ∃ s' tr, D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ traces.length = tr.length := by + induction he generalizing s with + | pure a c => + exact ⟨s, [], .pure s a, hr, rfl⟩ + | @call o k c res c₁ trace b c₂ traces ho hes ih => + obtain ⟨hv_o, hv_k⟩ := (D.demonicValid_liftBind_iff s o k).mp hv + obtain ⟨s₁, hstep, hr₁⟩ := R.correct hr hv_o ho + obtain ⟨s₂, tr, hrun, hr₂, hlen⟩ := ih hr₁ (hv_k s₁ res hstep) + exact ⟨s₂, ⟨o, res, s₁⟩ :: tr, .liftBind o k res hv_o hstep hrun, hr₂, + congrArg (· + 1) hlen⟩ + +/-- From related states, every demonically admissible client admits a native execution realizing a +valid `ClientRun` ending in a related state. -/ +theorem exists_executes (p : D.Client α) {s : D.State} {c : C} (hr : R.rep s c) + (hv : D.DemonicValid s p) : + ∃ a c' traces s' tr, RelExecutes exec p c a c' traces ∧ + D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ traces.length = tr.length := by + induction hv generalizing c with + | pure s a => + exact ⟨a, c, [], s, [], .pure a c, .pure s a, hr, rfl⟩ + | liftBind o k hv_o _ ih => + obtain ⟨res, c₁, trace, ho⟩ := R.total o hr hv_o + obtain ⟨s₁, hstep, hr₁⟩ := R.correct hr hv_o ho + obtain ⟨b, c₂, traces, s₂, tr, hes, hrun, hr₂, hlen⟩ := ih s₁ res hstep hr₁ + exact ⟨b, c₂, trace :: traces, s₂, ⟨o, res, s₁⟩ :: tr, + .call ho hes, .liftBind o k res hv_o hstep hrun, hr₂, congrArg (· + 1) hlen⟩ + +end RelRealization + +/-- Lift a deterministic `Realization D exec` to a relational `RelRealization D.toRelSpec exec`. -/ +def Realization.toRelRealization {D : Spec.{u, v, w}} {C τ : Type x} + {exec : Execution D C τ} (R : Realization D exec) : + RelRealization D.toRelSpec exec where + rep := R.rep + total o hr hv := R.total o hr hv + correct {s c o a c' trace} hr hv he := by + obtain ⟨ha, hr'⟩ := R.correct hr hv he + exact ⟨(D.step s o).1, Prod.ext rfl ha, hr'⟩ + +/-- Every native execution of a verified demonic `Hoare` client satisfies its abstract +postcondition in a related final state. -/ +theorem RelSpec.Hoare.realize {D : RelSpec.{u, v, w}} {C Trace : Type x} {α : Type y} + {exec : RelExecution D C Trace} (R : RelRealization D exec) + {pre : D.State → Prop} {post : α → D.State → Prop} {p : D.Client α} + (h : D.Hoare pre p post) {s : D.State} {c c' : C} {a : α} {traces : List Trace} + (hp : pre s) (hr : R.rep s c) (he : RelExecutes exec p c a c' traces) : + ∃ s' tr, D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ post a s' := by + obtain ⟨hv, hpost⟩ := h s hp + obtain ⟨s', tr, hrun, hr', _⟩ := R.correct_client hr hv he + exact ⟨s', tr, hrun, hr', hpost a s' tr hrun⟩ + +/-- Per-operation worst-case resource certificate over a relational realization `R`. -/ +def RelBound {D : RelSpec.{u, v, w}} {C τ : Type x} {exec : RelExecution D C τ} + (R : RelRealization D exec) (weight : τ → ℕ) (charge : D.State → D.Op → ℕ) : Prop := + ∀ {s c o a c' trace}, R.rep s c → D.valid s o → exec c o a c' trace → + weight trace ≤ charge s o + +/-- Lift a deterministic `Bound R weight charge` to `RelBound R.toRelRealization weight charge`. -/ +theorem Bound.toRelBound {D : Spec.{u, v, w}} {C τ : Type x} {exec : Execution D C τ} + {R : Realization D exec} {weight : τ → ℕ} {charge : D.State → D.Op → ℕ} + (B : Bound R weight charge) : + RelBound R.toRelRealization weight charge := + fun hr hv he => B hr hv he + +/-- Potential-method amortized resource certificate over a relational realization `R`: +for every native operation execution from `R.rep s c` on an admissible `o`, there exists a +permitted abstract post-state `s'` satisfying `D.step s o s' a`, `R.rep s' c'`, and the +single-step potential inequality `weight trace + potential s' c' ≤ charge s o + potential s c`. -/ +structure RelAmortized {D : RelSpec.{u, v, w}} {C Trace : Type x} + {exec : RelExecution D C Trace} (R : RelRealization D exec) (weight : Trace → ℕ) + (potential : D.State → C → ℕ) (charge : D.State → D.Op → ℕ) : Prop where + /-- Angelic single-step potential inequality witnessing a permitted post-state `s'`. -/ + step : ∀ {s c o a c' trace}, R.rep s c → D.valid s o → exec c o a c' trace → + ∃ s', D.step s o s' a ∧ R.rep s' c' ∧ + weight trace + potential s' c' ≤ charge s o + potential s c + +namespace RelAmortized + +variable {D : RelSpec.{u, v, w}} {C Trace : Type x} {α : Type y} + {exec : RelExecution D C Trace} {R : RelRealization D exec} + {weight : Trace → ℕ} {potential : D.State → C → ℕ} {charge : D.State → D.Op → ℕ} + (A : RelAmortized R weight potential charge) + +include A in +/-- **Amortized telescoping along adaptive clients (`executes_le`).** +For any demonically admissible client `p` and native execution `RelExecutes exec p c a c' traces`, +there exist a final abstract state `s'` and transcript `tr` such that `D.ClientRun s p a s' tr`, +`R.rep s' c'`, and +`total weight traces + potential s' c' ≤ D.totalCost charge s tr + potential s c`. -/ +theorem executes_le {p : D.Client α} {s : D.State} {c c' : C} {a : α} + {traces : List Trace} (hr : R.rep s c) (hv : D.DemonicValid s p) + (he : RelExecutes exec p c a c' traces) : + ∃ s' tr, D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ + traces.length = tr.length ∧ + total weight traces + potential s' c' ≤ + D.totalCost charge s tr + potential s c := by + induction he generalizing s with + | pure a c => + exact ⟨s, [], .pure s a, hr, rfl, Nat.le_refl _⟩ + | @call o k c res c₁ trace b c₂ traces ho hes ih => + obtain ⟨hv_o, hv_k⟩ := (D.demonicValid_liftBind_iff s o k).mp hv + obtain ⟨s₁, hstep, hr₁, hpot₁⟩ := A.step hr hv_o ho + obtain ⟨s₂, tr, hrun, hr₂, hlen, hpot₂⟩ := ih hr₁ (hv_k s₁ res hstep) + refine ⟨s₂, ⟨o, res, s₁⟩ :: tr, .liftBind o k res hv_o hstep hrun, hr₂, + congrArg (· + 1) hlen, ?_⟩ + simp only [total_cons, RelSpec.totalCost_cons] + omega + +/-- Alias for `RelAmortized.executes_le` matching `Amortized.client`. -/ +abbrev client := @executes_le + +include A in +/-- **Existence, correctness, and amortized bound (`run_client_amortized`).** +From related initial states, every demonically admissible client `p` admits a native execution +satisfying `D.ClientRun`, `R.rep`, and the telescoping potential bound. -/ +theorem run_client_amortized (p : D.Client α) {s : D.State} {c : C} + (hr : R.rep s c) (hv : D.DemonicValid s p) : + ∃ a c' traces s' tr, RelExecutes exec p c a c' traces ∧ + D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ + traces.length = tr.length ∧ + total weight traces + potential s' c' ≤ + D.totalCost charge s tr + potential s c := by + obtain ⟨a, c', traces, _, _, he, _, _, _⟩ := R.exists_executes p hr hv + obtain ⟨s', tr, hrun, hr', hlen, hpot⟩ := A.executes_le hr hv he + exact ⟨a, c', traces, s', tr, he, hrun, hr', hlen, hpot⟩ + +include A in +/-- Alias for `RelAmortized.run_client_amortized` matching `Amortized.exists_executes`. -/ +theorem exists_executes (p : D.Client α) {s : D.State} {c : C} + (hr : R.rep s c) (hv : D.DemonicValid s p) : + ∃ a c' traces s' tr, RelExecutes exec p c a c' traces ∧ + D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ + traces.length = tr.length ∧ + total weight traces + potential s' c' ≤ + D.totalCost charge s tr + potential s c := + A.run_client_amortized p hr hv + +/-- A worst-case `RelBound` is a zero-potential `RelAmortized` certificate. -/ +theorem of_relBound (B : RelBound R weight charge) : + RelAmortized R weight (fun _ _ => 0) charge where + step hr hv he := by + obtain ⟨s', hstep, hr'⟩ := R.correct hr hv he + exact ⟨s', hstep, hr', by simpa using B hr hv he⟩ + +end RelAmortized + +/-- Lift a deterministic `Amortized R weight potential charge` certificate to +`RelAmortized R.toRelRealization weight potential charge`. -/ +theorem Amortized.toRelAmortized {D : Spec.{u, v, w}} {C Trace : Type x} + {exec : Execution D C Trace} {R : Realization D exec} + {weight : Trace → ℕ} {potential : D.State → C → ℕ} {charge : D.State → D.Op → ℕ} + (A : Amortized R weight potential charge) : + RelAmortized R.toRelRealization weight potential charge where + step {s c o a c' trace} hr hv he := by + obtain ⟨ha, hr'⟩ := R.correct hr hv he + exact ⟨(D.step s o).1, Prod.ext rfl ha, hr', A.step hr hv he⟩ + +namespace RelBound + +variable {D : RelSpec.{u, v, w}} {C τ : Type x} {α : Type y} + {exec : RelExecution D C τ} {R : RelRealization D exec} + {weight : τ → ℕ} {charge : D.State → D.Op → ℕ} + (B : RelBound R weight charge) + +include B in +/-- Under a worst-case `RelBound`, every native execution of a demonically admissible client has +total weight at most `D.totalCost charge s tr` for some valid `ClientRun` transcript `tr`. -/ +theorem client {p : D.Client α} {s : D.State} {c c' : C} {a : α} {traces : List τ} + (hr : R.rep s c) (hv : D.DemonicValid s p) (he : RelExecutes exec p c a c' traces) : + ∃ s' tr, D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ + traces.length = tr.length ∧ + total weight traces ≤ D.totalCost charge s tr := by + obtain ⟨s', tr, hrun, hr', hlen, hpot⟩ := (RelAmortized.of_relBound B).executes_le hr hv he + exact ⟨s', tr, hrun, hr', hlen, by simpa using hpot⟩ + +include B in +/-- Under a worst-case `RelBound`, every demonically admissible client admits a native execution +meeting the total charge bound. -/ +theorem exists_executes (p : D.Client α) {s : D.State} {c : C} + (hr : R.rep s c) (hv : D.DemonicValid s p) : + ∃ a c' traces s' tr, RelExecutes exec p c a c' traces ∧ + D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ + traces.length = tr.length ∧ + total weight traces ≤ D.totalCost charge s tr := by + obtain ⟨a, c', traces, s', tr, he, hrun, hr', hlen, hpot⟩ := + (RelAmortized.of_relBound B).run_client_amortized p hr hv + exact ⟨a, c', traces, s', tr, he, hrun, hr', hlen, by simpa using hpot⟩ + +end RelBound + +/-- Transport a demonic `CostHoare` triple through a `RelAmortized` certificate to bound native +execution weight plus final potential by `budget s + potential s c`. -/ +theorem RelSpec.CostHoare.realize_amortized {D : RelSpec.{u, v, w}} {C τ : Type x} {α : Type y} + {exec : RelExecution D C τ} {R : RelRealization D exec} + {weight : τ → ℕ} {potential : D.State → C → ℕ} {charge : D.State → D.Op → ℕ} + {pre : D.State → Prop} {post : α → D.State → Prop} {budget : D.State → ℕ} + {p : D.Client α} (A : RelAmortized R weight potential charge) + (h : D.CostHoare charge pre p post budget) {s : D.State} {c c' : C} + {a : α} {traces : List τ} (hs : pre s) (hr : R.rep s c) + (he : RelExecutes exec p c a c' traces) : + ∃ s' tr, D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ post a s' ∧ + total weight traces + potential s' c' ≤ budget s + potential s c := by + obtain ⟨hv, hpost⟩ := h.1 s hs + obtain ⟨s', tr, hrun, hr', _, hpot⟩ := A.executes_le hr hv he + have hbud := h.2 s hs a s' tr hrun + exact ⟨s', tr, hrun, hr', hpost a s' tr hrun, by omega⟩ + +/-- Transport a demonic `CostHoare` triple through a worst-case `RelBound` certificate. -/ +theorem RelSpec.CostHoare.realize {D : RelSpec.{u, v, w}} {C τ : Type x} {α : Type y} + {exec : RelExecution D C τ} {R : RelRealization D exec} + {weight : τ → ℕ} {charge : D.State → D.Op → ℕ} + {pre : D.State → Prop} {post : α → D.State → Prop} {budget : D.State → ℕ} + {p : D.Client α} (B : RelBound R weight charge) + (h : D.CostHoare charge pre p post budget) {s : D.State} {c c' : C} + {a : α} {traces : List τ} (hs : pre s) (hr : R.rep s c) + (he : RelExecutes exec p c a c' traces) : + (∃ s', R.rep s' c' ∧ post a s') ∧ total weight traces ≤ budget s := by + obtain ⟨s', _, _, hr', hpost, hpot⟩ := + h.realize_amortized (RelAmortized.of_relBound B) hs hr he + exact ⟨⟨s', hr', hpost⟩, by simpa using hpot⟩ + +/-- Existence of a native execution satisfying a demonic `CostHoare` contract under `RelBound`. -/ +theorem RelSpec.CostHoare.exists_executes {D : RelSpec.{u, v, w}} {C τ : Type x} {α : Type y} + {exec : RelExecution D C τ} {R : RelRealization D exec} + {weight : τ → ℕ} {charge : D.State → D.Op → ℕ} + {pre : D.State → Prop} {post : α → D.State → Prop} {budget : D.State → ℕ} + {p : D.Client α} (B : RelBound R weight charge) + (h : D.CostHoare charge pre p post budget) {s : D.State} {c : C} + (hs : pre s) (hr : R.rep s c) : + ∃ a c' traces, RelExecutes exec p c a c' traces ∧ + (∃ s', R.rep s' c' ∧ post a s') ∧ total weight traces ≤ budget s := by + obtain ⟨a, c', traces, _, _, he, _, _, _⟩ := R.exists_executes p hr (h.1 s hs).1 + exact ⟨a, c', traces, he, h.realize B hs hr he⟩ + +end Cslib.Stateful diff --git a/ComplexityTests/StatefulRelational.lean b/ComplexityTests/StatefulRelational.lean new file mode 100644 index 000000000..8d3373331 --- /dev/null +++ b/ComplexityTests/StatefulRelational.lean @@ -0,0 +1,241 @@ +/- +Copyright (c) 2026 Renfei Zhou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Renfei Zhou +-/ + +module +-- upstream: local-only (test driver) + +public import Complexity.Init +public import Complexity.Foundations.Semantics.Stateful.Relational + +/-! +# Tests for Relational Stateful Specifications + +Concrete non-vacuous tests for `Cslib.Stateful.RelSpec`, its totality class `RelSpec.Total`, +projection `RelSpec.toLTS`, zero-cost deterministic embedding `Spec.toRelSpec`, demonic adaptive +client semantics (`ClientRun`, `DemonicValid`, `RelSpec.Hoare`, `RelSpec.CostHoare`), and angelic +backend realization and amortized analysis (`RelRealization`, `RelBound`, `RelAmortized`). +-/ + +@[expose] public section + +namespace Cslib.Stateful.Tests + +open Cslib.Stateful + +/-! ## 1. A genuinely nondeterministic relational specification (two-slot allocator) -/ + +/-- Operations of a two-slot index allocator: `alloc` nondeterministically returns any free +slot in `Fin 2`; `free i` releases slot `i`. -/ +inductive TwoSlotOp : Type + | alloc : TwoSlotOp + | free : Fin 2 → TwoSlotOp + deriving DecidableEq + +/-- Relational specification of a two-slot allocator whose state `(b₀, b₁) : Bool × Bool` +records whether slots `0` and `1` are currently occupied. When both slots are free, `alloc` +nondeterministically returns either `0` or `1`. -/ +abbrev TwoSlotAlloc : RelSpec where + State := Bool × Bool + Op := TwoSlotOp + Result + | .alloc => Fin 2 + | .free _ => Unit + valid s + | .alloc => s.1 = false ∨ s.2 = false + | .free _ => True + step s o s' a := + match o, a with + | .alloc, i => + (i = 0 ∧ s.1 = false ∧ s' = (true, s.2)) ∨ + (i = 1 ∧ s.2 = false ∧ s' = (s.1, true)) + | .free i, () => + s' = if i = 0 then (false, s.2) else (s.1, false) + +instance : TwoSlotAlloc.Total where + step_total s o hv := by + cases o with + | alloc => + rcases hv with h0 | h1 + · exact ⟨(true, s.2), 0, Or.inl ⟨rfl, h0, rfl⟩⟩ + · exact ⟨(s.1, true), 1, Or.inr ⟨rfl, h1, rfl⟩⟩ + | free i => + exact ⟨if i = 0 then (false, s.2) else (s.1, false), (), rfl⟩ + +/-- Both slot `0` and slot `1` are valid outcomes of `alloc` from `(false, false)`. -/ +theorem twoSlotAlloc_nondeterministic : + ((true, false), (0 : Fin 2)) ∈ TwoSlotAlloc.outcomes (false, false) .alloc ∧ + ((false, true), (1 : Fin 2)) ∈ TwoSlotAlloc.outcomes (false, false) .alloc := + ⟨Or.inl ⟨rfl, rfl, rfl⟩, Or.inr ⟨rfl, rfl, rfl⟩⟩ + +/-- Sample LTS transition via `RelSpec.toLTS`. -/ +theorem twoSlotAlloc_toLTS_tr : + TwoSlotAlloc.toLTS.Tr (false, false) ⟨.alloc, (1 : Fin 2)⟩ (false, true) := + Or.inr ⟨rfl, rfl, rfl⟩ + +/-! ## 2. Adaptive client, demonic admissibility, and Hoare / CostHoare verification -/ + +/-- Adaptive client that allocates two slots sequentially, frees the first slot returned, and +returns the pair `(i, j)` of allocated slots. -/ +abbrev allocTwoAndFreeFirst : TwoSlotAlloc.Client (Fin 2 × Fin 2) := + .liftBind TwoSlotOp.alloc fun i => + .liftBind TwoSlotOp.alloc fun j => + .liftBind (TwoSlotOp.free i) fun _ => + .pure (i, j) + +/-- From `(false, false)`, `allocTwoAndFreeFirst` is demonically admissible across all +nondeterministic choices of the first and second allocations. -/ +theorem allocTwoAndFreeFirst_demonicValid : + TwoSlotAlloc.DemonicValid (false, false) allocTwoAndFreeFirst := by + refine RelSpec.DemonicValid.liftBind (D := TwoSlotAlloc) TwoSlotOp.alloc _ (Or.inl rfl) + fun s₁ i h₁ => ?_ + have hv₂ : TwoSlotAlloc.valid s₁ TwoSlotOp.alloc := by + rcases h₁ with ⟨rfl, _, rfl⟩ | ⟨rfl, _, rfl⟩ + · exact Or.inr rfl + · exact Or.inl rfl + refine RelSpec.DemonicValid.liftBind (D := TwoSlotAlloc) TwoSlotOp.alloc _ hv₂ + fun s₂ j _ => ?_ + refine RelSpec.DemonicValid.liftBind (D := TwoSlotAlloc) (TwoSlotOp.free i) _ trivial + fun s₃ _ _ => .pure s₃ (i, j) + +/-- Demonic `CostHoare` specification: under unit per-operation charge, every relational execution +of `allocTwoAndFreeFirst` from `(false, false)` returns distinct slots `i ≠ j`, leaves `i` free +and `j` occupied, and incurs abstract cost `3`. -/ +theorem allocTwoAndFreeFirst_costHoare : + TwoSlotAlloc.CostHoare (fun _ _ => 1) + (fun s => s = (false, false)) + allocTwoAndFreeFirst + (fun p s' => p.1 ≠ p.2 ∧ (if p.1 = 0 then s'.1 = false else s'.2 = false)) + (fun _ => 3) := by + refine ⟨fun s hs => ?_, fun s hs v s' tr hrun => ?_⟩ + · subst hs + refine ⟨allocTwoAndFreeFirst_demonicValid, fun v s' tr hrun => ?_⟩ + obtain ⟨_, i, s₁, tr₁, h₁, hrun₁, _⟩ := (RelSpec.clientRun_liftBind_iff ..).mp hrun + obtain ⟨_, j, s₂, tr₂, h₂, hrun₂, _⟩ := (RelSpec.clientRun_liftBind_iff ..).mp hrun₁ + obtain ⟨_, _, s₃, tr₃, h₃, hrun₃, _⟩ := (RelSpec.clientRun_liftBind_iff ..).mp hrun₂ + obtain ⟨rfl, rfl, rfl⟩ := (RelSpec.clientRun_pure_iff ..).mp hrun₃ + rcases h₁ with ⟨rfl, _, rfl⟩ | ⟨rfl, _, rfl⟩ + · rcases h₂ with ⟨_, hfalse, _⟩ | ⟨rfl, _, rfl⟩ + · cases hfalse + · subst h₃ + exact ⟨by decide, by decide⟩ + · rcases h₂ with ⟨rfl, _, rfl⟩ | ⟨_, hfalse, _⟩ + · subst h₃ + exact ⟨by decide, by decide⟩ + · cases hfalse + · subst hs + obtain ⟨_, i, s₁, tr₁, _, hrun₁, rfl⟩ := (RelSpec.clientRun_liftBind_iff ..).mp hrun + obtain ⟨_, j, s₂, tr₂, _, hrun₂, rfl⟩ := (RelSpec.clientRun_liftBind_iff ..).mp hrun₁ + obtain ⟨_, _, s₃, tr₃, _, hrun₃, rfl⟩ := (RelSpec.clientRun_liftBind_iff ..).mp hrun₂ + obtain ⟨rfl, rfl, rfl⟩ := (RelSpec.clientRun_pure_iff ..).mp hrun₃ + simp + +/-- Consequence to plain demonic `Hoare`. -/ +theorem allocTwoAndFreeFirst_hoare : + TwoSlotAlloc.Hoare + (fun s => s = (false, false)) + allocTwoAndFreeFirst + (fun p s' => p.1 ≠ p.2 ∧ (if p.1 = 0 then s'.1 = false else s'.2 = false)) := + allocTwoAndFreeFirst_costHoare.hoare + +/-! ## 3. Concrete first-fit backend realization and amortized certificate -/ + +/-- Concrete first-fit implementation of `TwoSlotAlloc`: `alloc` chooses slot `0` when free and +slot `1` otherwise, recording `1` unit of execution trace cost per operation. -/ +def firstFitExec : RelExecution TwoSlotAlloc (Bool × Bool) ℕ + | c, .alloc, i, c', n => + n = 1 ∧ + if c.1 = false then i = 0 ∧ c' = (true, c.2) + else i = 1 ∧ c' = (c.1, true) + | c, .free i, (), c', n => + n = 1 ∧ c' = (if i = 0 then (false, c.2) else (c.1, false)) + +/-- Angelic realization of `TwoSlotAlloc` by `firstFitExec`. -/ +def firstFitRealization : RelRealization TwoSlotAlloc firstFitExec where + rep s c := s = c + total {s c} o hr _ := by + subst hr + cases o with + | alloc => + rcases Bool.dichotomy s.1 with h0 | h0 + · exact ⟨0, (true, s.2), 1, rfl, by simp [h0]⟩ + · exact ⟨1, (s.1, true), 1, rfl, by simp [h0]⟩ + | free i => + exact ⟨(), if i = 0 then (false, s.2) else (s.1, false), 1, rfl, rfl⟩ + correct {s c o a c' n} hr hv he := by + subst hr + cases o with + | alloc => + obtain ⟨_, hbranch⟩ := he + rcases Bool.dichotomy s.1 with h0 | h0 + · simp only [h0, ↓reduceIte] at hbranch + obtain ⟨rfl, rfl⟩ := hbranch + exact ⟨(true, s.2), Or.inl ⟨rfl, h0, rfl⟩, rfl⟩ + · simp only [h0, Bool.true_eq_false, ↓reduceIte] at hbranch + obtain ⟨rfl, rfl⟩ := hbranch + have h1 : s.2 = false := hv.resolve_left (by simp [h0]) + exact ⟨(s.1, true), Or.inr ⟨rfl, h1, rfl⟩, by simp [h0]⟩ + | free i => + obtain ⟨_, rfl⟩ := he + cases a + exact ⟨if i = 0 then (false, s.2) else (s.1, false), rfl, rfl⟩ + +/-- Per-operation worst-case bound for `firstFitRealization`. -/ +theorem firstFitBound : + RelBound firstFitRealization id (fun _ _ => 1) := by + intro s c o a c' n _ _ he + cases o with + | alloc => exact Nat.le_of_eq he.1 + | free _ => exact Nat.le_of_eq he.1 + +/-- Amortized certificate for `firstFitRealization` with zero potential. -/ +theorem firstFitAmortized : + RelAmortized firstFitRealization id (fun _ _ => 0) (fun _ _ => 1) := + RelAmortized.of_relBound firstFitBound + +/-- End-to-end execution of `allocTwoAndFreeFirst` on `firstFitRealization` via +`RelAmortized.run_client_amortized` and `RelSpec.CostHoare.realize_amortized`. -/ +theorem firstFit_allocTwoAndFreeFirst_executes : + ∃ v c' traces s' tr, + RelExecutes firstFitExec allocTwoAndFreeFirst (false, false) v c' traces ∧ + TwoSlotAlloc.ClientRun (false, false) allocTwoAndFreeFirst v s' tr ∧ + firstFitRealization.rep s' c' ∧ + (v.1 ≠ v.2 ∧ (if v.1 = 0 then s'.1 = false else s'.2 = false)) ∧ + total id traces ≤ 3 := by + obtain ⟨v, c', traces, _, _, he, _, _, _, _⟩ := + firstFitAmortized.run_client_amortized allocTwoAndFreeFirst + (s := (false, false)) (c := (false, false)) rfl allocTwoAndFreeFirst_demonicValid + obtain ⟨s', tr, hrun, hr, hpost, hcost⟩ := + allocTwoAndFreeFirst_costHoare.realize_amortized firstFitAmortized rfl rfl he + exact ⟨v, c', traces, s', tr, he, hrun, hr, hpost, by omega⟩ + +/-! ## 4. Layer 1 (`Spec.toRelSpec`) embedding and collapse equivalences -/ + +/-- Simple deterministic counter specification to exercise `Spec.toRelSpec`. -/ +abbrev CounterSpec : Spec where + State := ℕ + Op := Unit + Result _ := ℕ + step n _ := (n + 1, n) + +/-- Adaptive client on `CounterSpec` that increments twice and returns the sum of results. -/ +def counterTwice : CounterSpec.Client ℕ := + .liftBind () fun a => .liftBind () fun b => .pure (a + b) + +/-- `DemonicValid` on `CounterSpec.toRelSpec` collapses to `ValidHistory` on `CounterSpec`. -/ +theorem counterTwice_demonicValid (n : ℕ) : + CounterSpec.toRelSpec.DemonicValid n counterTwice := by + rw [CounterSpec.toRelSpec_demonicValid_iff] + exact ⟨trivial, trivial, trivial⟩ + +/-- `RelSpec.Hoare` on `CounterSpec.toRelSpec` is equivalent to `Spec.Hoare`. -/ +theorem counterTwice_relHoare : + CounterSpec.toRelSpec.Hoare (fun n => n = 5) counterTwice (fun v s' => v = 11 ∧ s' = 7) := by + rw [CounterSpec.toRelSpec_hoare_iff] + intro s hs + subst hs + exact ⟨⟨trivial, trivial, trivial⟩, rfl, rfl⟩ + +end Cslib.Stateful.Tests diff --git a/ComplexityTests/WordRAMRelSubroutine.lean b/ComplexityTests/WordRAMRelSubroutine.lean new file mode 100644 index 000000000..1eecc6baa --- /dev/null +++ b/ComplexityTests/WordRAMRelSubroutine.lean @@ -0,0 +1,351 @@ +/- +Copyright (c) 2026 Renfei Zhou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Renfei Zhou +-/ + +module +-- upstream: local-only (test driver) + +public import Complexity.Init +public import Complexity.Computability.WordRAM.RelSubroutine + +/-! +# Tests for Relational Word-RAM Subroutine Realizations + +Concrete non-vacuous tests for `Cslib.WordRAM.RelSubroutineDS`, `RelDynamicProgram`, +`RelDynamicCertificate`, `SubroutineDS.toRelSubroutineDS`, `RelSubroutineDS.toStandard`, +`RelSubroutineDS.call_rename`, `RelSubroutineDS.run_client_amortized`, +`RelSubroutineDS.run_ops_exact_fresh`, and `RelSubroutineDS.run_ops_exact_reusable` on a +genuinely nondeterministic two-slot allocator specification. +-/ + +@[expose] public section + +namespace Cslib.WordRAM.Tests + +open Cslib Cslib.Stateful Cslib.WordRAM + +/-! ## 1. Nondeterministic two-slot allocator specification -/ + +/-- Relational specification of a two-slot allocator: from state `(b₀, b₁) : Bool × Bool`, an +allocation operation `()` nondeterministically returns any free slot `i : Fin 2` and marks slot +`i` occupied. When both slots are free (`(false, false)`), both `0` and `1` are permitted. -/ +abbrev TwoSlotAlloc : RelSpec where + State := Bool × Bool + Op := Unit + Result _ := Fin 2 + valid s _ := s.1 = false ∨ s.2 = false + step s _ s' i := + (i = 0 ∧ s.1 = false ∧ s' = (true, s.2)) ∨ + (i = 1 ∧ s.2 = false ∧ s' = (s.1, true)) + +instance : TwoSlotAlloc.Total where + step_total s _ hv := by + rcases hv with h0 | h1 + · exact ⟨(true, s.2), 0, Or.inl ⟨rfl, h0, rfl⟩⟩ + · exact ⟨(s.1, true), 1, Or.inr ⟨rfl, h1, rfl⟩⟩ + +/-! ## 2. Concrete `SubroutineCode .exact` implementation and `RelSubroutineDS` certificate -/ + +/-- Six-register `.exact` Word-RAM subroutine implementing `TwoSlotAlloc` by sequential +allocation of slot `0` followed by slot `1`: +* register `0`: `baseReg` (persistent) +* register `1`: `frontierReg` (persistent) +* register `2`: `curReg` (scratch) +* register `3`: `zeroReg` (scratch) +* register `4`: `oneReg` / `output` (scratch) +* register `5`: persistent next-free-slot counter (`0`, `1`, or `2`). -/ +abbrev twoSlotCode : SubroutineCode .exact 6 0 where + allocSpan := .op (.copy 0 1) + initSetup := .op (.const 5 0) + code := .seq (.op (.copy 4 5)) (.seq (.op (.const 3 1)) (.op (.exactBin .add 5 5 3))) + frontierReg := 1 + baseReg := 0 + initParams := Fin.elim0 + curReg := 2 + zeroReg := 3 + oneReg := 4 + incCur := .exactBin .add 2 2 4 + input i := i == 2 || i == 3 || i == 4 + output := 4 + +/-- Representation invariant for `twoSlotCode` at word width `w` and base address `base`. -/ +abbrev twoSlotRep (w base : ℕ) (s : Bool × Bool) (x : Data 6) : Prop := + x.Bounded w ∧ x.regs 0 = base ∧ + ((s = (false, false) ∧ x.regs 5 = 0) ∨ + (s = (true, false) ∧ x.regs 5 = 1) ∨ + (s = (true, true) ∧ x.regs 5 = 2)) + +/-- `RelSubroutineDS` certificate showing that `twoSlotCode` realizes the nondeterministic +`TwoSlotAlloc` specification whenever `Fits w 2`. -/ +abbrev twoSlotSubroutine (w base : ℕ) (h2 : Fits w 2) : + RelSubroutineDS twoSlotCode TwoSlotAlloc w base Fin.elim0 (false, false) where + space := 0 + spanTime := 1 + setupTime := 1 + initPotential := 0 + charge _ _ := 3 + rep := twoSlotRep w base + potential _ := 0 + encode _ _ := 0 + argMatch _ _ := True + decode _ regs := some ⟨regs 4 % 2, Nat.mod_lt _ (by decide)⟩ + bounded hr := hr.1 + arguments_fit _ _ _ _ := fits_zero w + encode_matches _ _ := trivial + rep_supported {s x x'} hregs _ hx' hr := by + refine ⟨hx', ?_, ?_⟩ + · rw [hregs 0 rfl]; exact hr.2.1 + · rw [hregs 5 rfl]; exact hr.2.2 + potential_supported _ _ _ := rfl + clear_nodup := by decide + params_not_clear j := j.elim0 + incCur_eval {x} hone hfit := by + simp only [Op.eval_exactBin, BinOp.evalExact, hone, Option.bind_some, Data.put_of_fits hfit] + span_exec {x} _ hfr _ := by + refine ⟨x.set 0 (x.regs 1), ⟨1, Nat.le_refl 1, Exec.copy⟩, rfl, ?_, ?_, fun j => j.elim0⟩ + · simp [Data.set, hfr] + · simp [Data.set, hfr] + setup_exec {x₁} hx₁ hb₁ hfr₁ _ _ := by + refine ⟨x₁.set 5 0, ⟨1, Nat.le_refl 1, Exec.const (fits_zero w)⟩, ?_, ?_, Nat.le_refl 0, + fun _ _ => rfl⟩ + · simp [Data.set, hfr₁] + · refine ⟨hx₁.set (fits_zero w), ?_, Or.inl ⟨rfl, by simp [Data.set]⟩⟩ + simp [Data.set, hb₁] + step_exec {s x} _ hr hv _ := by + have h1 : Fits w 1 := h2.of_le (by decide) + rcases hr with ⟨hx, hb, ⟨rfl, h5⟩ | ⟨rfl, h5⟩ | ⟨rfl, _⟩⟩ + · let x₁ := x.set 4 (x.regs 5) + let x₂ := x₁.set 3 1 + let y := x₂.set 5 (x₂.regs 5 + x₂.regs 3) + have hfit : Fits w (x₂.regs 5 + x₂.regs 3) := by + simpa [x₂, x₁, Data.set, h5] using h1 + have heval : (Op.exactBin .add (5 : Fin 6) 5 3).eval w x₂ = some y := by + simp only [Op.eval_exactBin, BinOp.evalExact, Option.bind_some, Data.put_of_fits hfit, y] + have hex : Exec w twoSlotCode.code x y 3 := + Exec.copy.seq ((Exec.const h1).seq (Exec.op heval)) + have hy_b : y.Bounded w := hex.bounded hx + refine ⟨y, (true, false), 0, 3, hex, Or.inl ⟨rfl, rfl, rfl⟩, ?_, ?_, + fun _ _ => rfl, Nat.le_refl 3⟩ + · simp [y, x₂, x₁, Data.set, h5] + · refine ⟨hy_b, ?_, Or.inr (Or.inl ⟨rfl, ?_⟩)⟩ + · simp [y, x₂, x₁, Data.set, hb] + · simp [y, x₂, x₁, Data.set, h5] + · let x₁ := x.set 4 (x.regs 5) + let x₂ := x₁.set 3 1 + let y := x₂.set 5 (x₂.regs 5 + x₂.regs 3) + have hfit : Fits w (x₂.regs 5 + x₂.regs 3) := by + simpa [x₂, x₁, Data.set, h5] using h2 + have heval : (Op.exactBin .add (5 : Fin 6) 5 3).eval w x₂ = some y := by + simp only [Op.eval_exactBin, BinOp.evalExact, Option.bind_some, Data.put_of_fits hfit, y] + have hex : Exec w twoSlotCode.code x y 3 := + Exec.copy.seq ((Exec.const h1).seq (Exec.op heval)) + have hy_b : y.Bounded w := hex.bounded hx + refine ⟨y, (true, true), 1, 3, hex, Or.inr ⟨rfl, rfl, rfl⟩, ?_, ?_, + fun _ _ => rfl, Nat.le_refl 3⟩ + · simp [y, x₂, x₁, Data.set, h5] + · refine ⟨hy_b, ?_, Or.inr (Or.inr ⟨rfl, ?_⟩)⟩ + · simp [y, x₂, x₁, Data.set, hb] + · simp [y, x₂, x₁, Data.set, h5] + · cases hv with + | inl h => cases h + | inr h => cases h + +/-! ## 3. Exercising `call_rename`, `run_client_amortized`, and flat-program execution -/ + +/-- Adaptive client allocating two slots sequentially and returning both indices. -/ +abbrev allocPair : TwoSlotAlloc.Client (Fin 2 × Fin 2) := + .liftBind () fun i => + .liftBind () fun j => + .pure (i, j) + +/-- `allocPair` is demonically admissible from `(false, false)` across all permitted outcomes. -/ +theorem allocPair_demonicValid : + TwoSlotAlloc.DemonicValid (false, false) allocPair := by + refine RelSpec.DemonicValid.liftBind (D := TwoSlotAlloc) () _ (Or.inl rfl) fun s₁ i h₁ => ?_ + have hv₂ : TwoSlotAlloc.valid s₁ () := by + rcases h₁ with ⟨rfl, _, rfl⟩ | ⟨rfl, _, rfl⟩ + · exact Or.inr rfl + · exact Or.inl rfl + exact RelSpec.DemonicValid.liftBind (D := TwoSlotAlloc) () _ hv₂ + fun s₂ j _ => .pure s₂ (i, j) + +/-- Standalone adaptive-client amortized theorem via `RelSubroutineDS.toStandard` and +`RelSubroutineDS.run_client_amortized`. -/ +theorem twoSlot_run_client_amortized (w base : ℕ) (h2 : Fits w 2) + {x : Data 6} (hr : (twoSlotSubroutine w base h2).rep (false, false) x) : + ∃ a y traces s' tr, + Stateful.RelExecutes + ((twoSlotSubroutine w base h2).toStandard.toRelDynamicProgram.ExecOp w) + allocPair x a y traces ∧ + TwoSlotAlloc.ClientRun (false, false) allocPair a s' tr ∧ + (twoSlotSubroutine w base h2).rep s' y ∧ + traces.length = tr.length ∧ + Stateful.total DynamicProgram.OperationTrace.instructions traces ≤ + TwoSlotAlloc.totalCost (fun _ _ => 4) (false, false) tr := + (twoSlotSubroutine w base h2).toStandard.run_client_bound (fun _ => rfl) + allocPair hr allocPair_demonicValid + +/-- Canonical injective register embedding `Fin 6 → Fin 8`. -/ +def embed6to8 : Fin 6 → Fin 8 := Fin.castLE (by decide) + +theorem embed6to8_injective : Function.Injective embed6to8 := + (Fin.castLEOrderEmb (by decide : 6 ≤ 8)).injective + +/-- Relocated inline call via `RelSubroutineDS.call_rename` inside an 8-register caller. -/ +theorem twoSlot_call_rename (w base : ℕ) (h2 : Fits w 2) + {x : Data 8} (hx : (x.comap embed6to8).Bounded w) + (hr : (twoSlotSubroutine w base h2).rep (false, false) (x.comap embed6to8)) : + ∃ z s' a t, + ExecWithin w (.seq (.op (.const 2 0)) (twoSlotCode.code.rename embed6to8)) x z t ∧ + TwoSlotAlloc.step (false, false) () s' a ∧ + (twoSlotSubroutine w base h2).decode () + (z.comap embed6to8).regs = some a ∧ + (twoSlotSubroutine w base h2).rep s' (z.comap embed6to8) ∧ + Modifies (Block.mk base 0).footprint (x.set 2 0).mem z.mem ∧ + (∀ j ∉ Set.range embed6to8, z.regs j = (x.set 2 0).regs j) ∧ + t ≤ 4 := by + have hprep : ExecWithin (B := .exact) w (.op (.const (2 : Fin 8) 0)) x (x.set 2 0) 1 := + ⟨1, Nat.le_refl 1, Exec.const (fits_zero w)⟩ + have hb' : ((x.set 2 0).comap embed6to8).Bounded w := by + refine ⟨fun i => ?_, hx.2⟩ + by_cases hi : embed6to8 i = 2 + · simp [Data.comap, Data.set, hi, fits_zero w] + · simp only [Fin.isValue, Data.comap_regs, Data.set_regs, Function.update_of_ne hi] + exact hx.1 i + have hreg : ∀ i : Fin 6, twoSlotCode.input i = false → + (x.set 2 0).regs (embed6to8 i) = x.regs (embed6to8 i) := by + intro i hi + have hne : embed6to8 i ≠ 2 := by + fin_cases i <;> revert hi <;> decide + simp [Data.set, Function.update_of_ne hne] + obtain ⟨z, s', a, t, he, hstep, hdec, hrep, hmod, hframe, ht⟩ := + (twoSlotSubroutine w base h2).call_rename + embed6to8_injective () hr (Or.inl rfl) hprep hb' hreg (fun _ _ => rfl) trivial + exact ⟨z, s', a, t, he, hstep, hdec, hrep, hmod, hframe, by omega⟩ + +/-- Two-operation sequence `[(), ()]` is demonically valid from `(false, false)`. -/ +theorem twoSlot_validOpSeq : + TwoSlotAlloc.ValidOpSeq (false, false) [(), ()] := by + refine ⟨Or.inl rfl, fun s₁ a₁ h₁ => ?_⟩ + rcases h₁ with ⟨rfl, _, rfl⟩ | ⟨rfl, _, rfl⟩ + · exact ⟨Or.inr rfl, fun _ _ _ => trivial⟩ + · exact ⟨Or.inl rfl, fun _ _ _ => trivial⟩ + +/-- Flat-program execution on fresh zeroed memory via `RelSubroutineDS.run_ops_exact_fresh`. -/ +theorem twoSlot_run_ops_fresh (w base : ℕ) (h2 : Fits w 2) + {d₀ : Data 6} (hd₀ : d₀.Bounded w) (hfr : d₀.regs 1 = base) + (hz : ∀ a ∈ (Block.mk base 0).footprint, d₀.mem a = 0) : + ∃ pc₀ x₀ t_init tr s_fin z t_ops, + Runs w twoSlotCode.initFreshProg ⟨0, d₀⟩ ⟨pc₀, x₀⟩ t_init ∧ + (∃ out, step w twoSlotCode.initFreshProg ⟨pc₀, x₀⟩ = .halt out) ∧ + Modifies (Block.mk base 0).footprint d₀.mem x₀.mem ∧ + (twoSlotSubroutine w base h2).RunsRelOps + (twoSlotSubroutine w base h2).prepareRegs (false, false) x₀ [(), ()] tr s_fin z + t_ops ∧ + tr.ops = [(), ()] ∧ + TwoSlotAlloc.ValidTranscript (false, false) tr s_fin ∧ + (twoSlotSubroutine w base h2).rep s_fin z ∧ + t_init ≤ 2 ∧ + t_ops ≤ TwoSlotAlloc.totalCost (fun _ _ => 4) (false, false) tr := by + obtain ⟨pc₀, x₀, t_init, tr, s_fin, z, t_ops, hruns, hhalt, hmod, hops_run, hops, htr, hrep, + ht_init, ht_ops⟩ := + (twoSlotSubroutine w base h2).run_ops_exact_fresh + hd₀ hfr (fun j => j.elim0) hz [(), ()] twoSlot_validOpSeq + exact ⟨pc₀, x₀, t_init, tr, s_fin, z, t_ops, hruns, hhalt, hmod, hops_run, hops, htr, hrep, + ht_init, by simpa using ht_ops⟩ + +/-- Flat-program execution on reusable dirty memory via `RelSubroutineDS.run_ops_exact_reusable`. -/ +theorem twoSlot_run_ops_reusable (w base : ℕ) (h2 : Fits w 2) + {d₀ : Data 6} (hd₀ : d₀.Bounded w) (hfr : d₀.regs 1 = base) : + ∃ pc₀ x₀ t_init tr s_fin z t_ops, + Runs w twoSlotCode.initClearProg ⟨0, d₀⟩ ⟨pc₀, x₀⟩ t_init ∧ + (∃ out, step w twoSlotCode.initClearProg ⟨pc₀, x₀⟩ = .halt out) ∧ + Modifies (Block.mk base 0).footprint d₀.mem x₀.mem ∧ + (twoSlotSubroutine w base h2).RunsRelOps + (twoSlotSubroutine w base h2).prepareRegs (false, false) x₀ [(), ()] tr s_fin z + t_ops ∧ + tr.ops = [(), ()] ∧ + TwoSlotAlloc.ValidTranscript (false, false) tr s_fin ∧ + (twoSlotSubroutine w base h2).rep s_fin z ∧ + t_init ≤ 8 ∧ + t_ops ≤ TwoSlotAlloc.totalCost (fun _ _ => 4) (false, false) tr := by + obtain ⟨pc₀, x₀, t_init, tr, s_fin, z, t_ops, hruns, hhalt, hmod, hops_run, hops, htr, hrep, + ht_init, ht_ops⟩ := + (twoSlotSubroutine w base h2).run_ops_exact_reusable + hd₀ hfr (fun j => j.elim0) [(), ()] twoSlot_validOpSeq + exact ⟨pc₀, x₀, t_init, tr, s_fin, z, t_ops, hruns, hhalt, hmod, hops_run, hops, htr, hrep, + ht_init, by simpa using ht_ops⟩ + +/-! ## 4. Lifting a deterministic `SubroutineDS` via `SubroutineDS.toRelSubroutineDS` -/ + +/-- Deterministic specification of a bounded two-step counter (`0 → 1 → 2`). -/ +abbrev DetCounter2 : Spec where + State := ℕ + Op := Unit + Result _ := Fin 2 + valid n _ := n < 2 + step n _ := (n + 1, ⟨n % 2, Nat.mod_lt _ (by decide)⟩) + +/-- Deterministic `SubroutineDS` certificate for `twoSlotCode` over `DetCounter2`. -/ +abbrev detCounter2Subroutine (w base : ℕ) (h2 : Fits w 2) : + SubroutineDS twoSlotCode DetCounter2 w base Fin.elim0 0 where + space := 0 + spanTime := 1 + setupTime := 1 + initPotential := 0 + charge _ _ := 3 + rep n x := x.Bounded w ∧ x.regs 0 = base ∧ x.regs 5 = n ∧ n ≤ 2 + potential _ := 0 + encode _ _ := 0 + argMatch _ _ := True + decode _ regs := some ⟨regs 4 % 2, Nat.mod_lt _ (by decide)⟩ + bounded hr := hr.1 + rep_unique hr₁ hr₂ := hr₁.2.2.1.symm.trans hr₂.2.2.1 + arguments_fit _ _ _ _ := fits_zero w + encode_matches _ _ := trivial + rep_supported {s x x'} hregs _ hx' hr := by + refine ⟨hx', ?_, ?_, hr.2.2.2⟩ + · rw [hregs 0 rfl]; exact hr.2.1 + · rw [hregs 5 rfl]; exact hr.2.2.1 + potential_supported _ _ _ := rfl + clear_nodup := by decide + params_not_clear j := j.elim0 + incCur_eval {x} hone hfit := by + simp only [Op.eval_exactBin, BinOp.evalExact, hone, Option.bind_some, Data.put_of_fits hfit] + span_exec {x} _ hfr _ := by + refine ⟨x.set 0 (x.regs 1), ⟨1, Nat.le_refl 1, Exec.copy⟩, rfl, ?_, ?_, fun j => j.elim0⟩ + · simp [Data.set, hfr] + · simp [Data.set, hfr] + setup_exec {x₁} hx₁ hb₁ hfr₁ _ _ := by + refine ⟨x₁.set 5 0, ⟨1, Nat.le_refl 1, Exec.const (fits_zero w)⟩, ?_, ?_, Nat.le_refl 0, + fun _ _ => rfl⟩ + · simp [Data.set, hfr₁] + · refine ⟨hx₁.set (fits_zero w), ?_, ?_, Nat.zero_le 2⟩ + · simp [Data.set, hb₁] + · simp [Data.set] + step_exec {s x} _ hr hv _ := by + have h1 : Fits w 1 := h2.of_le (by decide) + obtain ⟨hx, hb, h5, _⟩ := hr + let x₁ := x.set 4 (x.regs 5) + let x₂ := x₁.set 3 1 + let y := x₂.set 5 (x₂.regs 5 + x₂.regs 3) + have hfit : Fits w (x₂.regs 5 + x₂.regs 3) := by + have hfit2 : Fits w (s + 1) := h2.of_le hv + simpa [x₂, x₁, Data.set, h5] using hfit2 + have heval : (Op.exactBin .add (5 : Fin 6) 5 3).eval w x₂ = some y := by + simp only [Op.eval_exactBin, BinOp.evalExact, Option.bind_some, Data.put_of_fits hfit, y] + have hex : Exec w twoSlotCode.code x y 3 := + Exec.copy.seq ((Exec.const h1).seq (Exec.op heval)) + refine ⟨y, 3, hex, ?_, ⟨hex.bounded hx, ?_, ?_, hv⟩, fun _ _ => rfl, Nat.le_refl 3⟩ + · simp [y, x₂, x₁, Data.set, h5] + · simp [y, x₂, x₁, Data.set, hb] + · simp [y, x₂, x₁, Data.set, h5] + +/-- Lifting `detCounter2Subroutine` to `RelSubroutineDS` via `SubroutineDS.toRelSubroutineDS`. -/ +def detCounter2RelSubroutine (w base : ℕ) (h2 : Fits w 2) : + RelSubroutineDS twoSlotCode DetCounter2.toRelSpec w base Fin.elim0 0 := + (detCounter2Subroutine w base h2).toRelSubroutineDS + +end Cslib.WordRAM.Tests From a7461e87d2534a4b73d2f0b05e9e06c0f41c541c Mon Sep 17 00:00:00 2001 From: Renfei Zhou Date: Thu, 29 Oct 2026 17:53:41 +0000 Subject: [PATCH 02/12] refactor(stateful,word-ram): share Execution/DynamicProgram/SubroutineBase and drop aliases --- .../Computability/WordRAM/RelSubroutine.lean | 521 +++--------------- .../Computability/WordRAM/Subroutine.lean | 349 ++++++------ .../Semantics/Stateful/Realization.lean | 16 +- .../Semantics/Stateful/Relational.lean | 138 ++--- ComplexityTests/StatefulRelational.lean | 8 +- ComplexityTests/WordRAMRelSubroutine.lean | 10 +- 6 files changed, 311 insertions(+), 731 deletions(-) diff --git a/Complexity/Computability/WordRAM/RelSubroutine.lean b/Complexity/Computability/WordRAM/RelSubroutine.lean index 9b92e4dee..7e3dece99 100644 --- a/Complexity/Computability/WordRAM/RelSubroutine.lean +++ b/Complexity/Computability/WordRAM/RelSubroutine.lean @@ -12,39 +12,40 @@ public import Complexity.Computability.WordRAM.Subroutine public import Complexity.Foundations.Semantics.Stateful.Relational /-! -# Relational Word-RAM dynamic programs and composable data-structure subroutines +# Relational Word-RAM dynamic certificates and composable data-structure subroutines This file extends `Complexity.Computability.WordRAM.Dynamic` and `Complexity.Computability.WordRAM.Subroutine` from deterministic specifications (`Stateful.Spec`) to relational specifications (`Stateful.RelSpec`): -1. **Standalone relational fixed-program implementations (`RelDynamicProgram`, - `RelDynamicCertificate`):** Generalizes `DynamicProgram` and `DynamicCertificate` to - `D : Stateful.RelSpec`, where `execute` witnesses an angelic outcome `(s', a)` satisfying - `D.step s o s' a`. Because the Word-RAM structured semantics `Exec` is deterministic, - `RelDynamicCertificate.realization` establishes `Stateful.RelRealization` directly via - `Exec.unique`. +1. **Standalone relational fixed-program certificates (`RelDynamicCertificate`):** Generalizes + `DynamicCertificate` over `DynamicProgram D r` for `D : Stateful.RelSpec`, where `execute` + witnesses an angelic outcome `(s', a)` satisfying `D.step s o s' a`. Because the Word-RAM + structured semantics `Exec` is deterministic, `RelDynamicCertificate.realization` establishes + `Stateful.RelRealization` directly via `Exec.unique`. 2. **Unified standalone and inline relational subroutine certificates (`RelSubroutineDS`):** - Mirrors `SubroutineDS` over `D : Stateful.RelSpec`, omitting `rep_unique` (since concrete - potential `potential : Data r_ds → ℕ` depends only on machine data) and existentially - quantifying over `(s', a)` with `D.step s o s' a` in `step_exec`. + Extends `SubroutineBase P D.Result D.valid w base params s₀` over `D : Stateful.RelSpec`, + inheriting `toDynamicProgram`, `initFresh_exec`, `initFresh_rename`, `zeroFillCode_exec`, + `initClear_exec`, `initClear_rename`, `frame_caller`, and `prepareRegs` without duplication, + omitting `rep_unique` (since concrete potential `potential : Data r_ds → ℕ` depends only on + machine data), and existentially quantifying over `(s', a)` with `D.step s o s' a` in + `step_exec`. 3. **Zero-cost embedding of deterministic subroutines (`SubroutineDS.toRelSubroutineDS`):** Every `SubroutineDS P D w base params s₀` embeds into `RelSubroutineDS P D.toRelSpec w base params s₀`. 4. **Basis lifting, standalone `Stateful` projections, inline subroutine calls, and flat-program - operation sequences:** Provides `mapSimulates`, `toStandard`, `toRelDynamicProgram`, - `toRelCertificate`, `toRelAmortized`, `toRelBound`, `run_client_amortized`, `run_client_bound`, - `initFresh_exec`, `initFresh_rename`, `zeroFillCode_exec`, `initClear_exec`, - `initClear_rename`, `code_rename`, `call_rename`, `frame_caller`, and flat-program sequence - execution (`RunsRelOps`, `seq_runsRelOps`, `run_ops_exact_fresh`, `run_ops_exact_reusable`). + operation sequences:** Provides `mapSimulates`, `toStandard`, `toRelCertificate`, + `toRelAmortized`, `toRelBound`, `run_client_amortized`, `run_client_bound`, `code_rename`, + `call_rename`, and flat-program sequence execution (`RunsRelOps`, `seq_runsRelOps`, + `run_ops_exact_fresh`, `run_ops_exact_reusable`). ## Main definitions -* `Cslib.WordRAM.RelDynamicProgram`, `Cslib.WordRAM.RelDynamicCertificate`: standalone fixed-program - realization and certificate for a relational specification `D : Stateful.RelSpec`. +* `Cslib.WordRAM.RelDynamicCertificate`: standalone fixed-program certificate for + `DynamicProgram D r` realizing a relational specification `D : Stateful.RelSpec`. * `Cslib.WordRAM.RelSubroutineDS`: unified standalone and inline subroutine specification and amortized resource certificate for `P : SubroutineCode B r_ds k_init` realizing - `D : Stateful.RelSpec` (without `rep_unique`). + `D : Stateful.RelSpec` (extending `SubroutineBase` without `rep_unique`). * `Cslib.WordRAM.SubroutineDS.toRelSubroutineDS`: embedding of a deterministic `SubroutineDS` into `RelSubroutineDS`. * `Cslib.WordRAM.RelSubroutineDS.RunsRelOps`: sequential flat-program execution of an operation list @@ -58,11 +59,9 @@ to relational specifications (`Stateful.RelSpec`): * `Cslib.WordRAM.RelSubroutineDS.toRelAmortized`, `Cslib.WordRAM.RelSubroutineDS.run_client_amortized`: standalone amortized potential certificate and adaptive-client bound over `Basis.standard`. -* `Cslib.WordRAM.RelSubroutineDS.initFresh_rename`, - `Cslib.WordRAM.RelSubroutineDS.initClear_rename`, - `Cslib.WordRAM.RelSubroutineDS.call_rename`, - `Cslib.WordRAM.RelSubroutineDS.frame_caller`: relocated inline initialization, inline operation - calls, and bidirectional framing. +* `Cslib.WordRAM.RelSubroutineDS.code_rename`, + `Cslib.WordRAM.RelSubroutineDS.call_rename`: relocated inline operation calls with angelic + relational step outcomes. * `Cslib.WordRAM.RelSubroutineDS.run_ops_exact_fresh`, `Cslib.WordRAM.RelSubroutineDS.run_ops_exact_reusable`: end-to-end flat-program execution of any demonically admissible operation sequence `D.ValidOpSeq s₀ ops`. @@ -80,136 +79,13 @@ namespace Cslib.WordRAM universe u v z -/-! ## Standalone relational dynamic programs (`RelDynamicProgram`, `RelDynamicCertificate`) -/ +/-! ## Standalone relational dynamic certificates (`RelDynamicCertificate`) -/ variable {r : ℕ} {D : Stateful.RelSpec.{u, v, z}} -/-- A single `.standard`-basis Word-RAM program serving all operations of a relational -specification `D : Stateful.RelSpec` through a fixed register calling convention. -/ -structure RelDynamicProgram (D : Stateful.RelSpec.{u, v, z}) (r : ℕ) where - /-- The same structured program is executed for every operation. -/ - code : Code .standard r - /-- Register returned by the final `halt` instruction. -/ - output : Fin r - /-- Registers overwritten by externally supplied operation arguments. -/ - input : Fin r → Bool - /-- Encoded arguments, independent of the maintained machine state. -/ - encode : D.Op → Fin r → ℕ - /-- Interpretation of the final register tuple as the operation's typed observation. -/ - decode : (o : D.Op) → (Fin r → ℕ) → Option (D.Result o) - -/-- Embed a deterministic `DynamicProgram D r` as a `RelDynamicProgram D.toRelSpec r`. -/ -abbrev DynamicProgram.toRelDynamicProgram {D : Stateful.Spec.{u, v, z}} {r : ℕ} - (P : DynamicProgram D r) : RelDynamicProgram D.toRelSpec r where - code := P.code - output := P.output - input := P.input - encode := P.encode - decode := P.decode - -namespace RelDynamicProgram - -variable (P : RelDynamicProgram D r) - -/-- Deliver operation arguments without changing maintained memory or non-input registers. -/ -def prepare (o : D.Op) (x : Data r) : Data r where - regs i := if P.input i then P.encode o i else x.regs i - mem := x.mem - -/-- Delivering operation arguments preserves the machine memory unchanged. -/ -@[simp] -theorem prepare_mem (o : D.Op) (x : Data r) : (P.prepare o x).mem = x.mem := rfl - -/-- Registers outside the calling convention retain their contents. -/ -theorem prepare_regs_of_not_input {i : Fin r} (hi : P.input i = false) (o : D.Op) (x : Data r) : - (P.prepare o x).regs i = x.regs i := by - simp [prepare, hi] - -/-- Argument delivery preserves bounded words when the arguments fit. -/ -theorem prepare_bounded {w : ℕ} {o : D.Op} {x : Data r} (hx : x.Bounded w) - (ho : ∀ i, P.input i = true → Fits w (P.encode o i)) : (P.prepare o x).Bounded w := by - refine ⟨fun i => ?_, hx.2⟩ - change Fits w (if P.input i then P.encode o i else x.regs i) - split - · exact ho i (by assumption) - · exact hx.1 i - -/-- Evaluate one typed call, delivering its arguments and decoding its observation. The returned -cost includes the final `halt`. -/ -def eval (w fuel : ℕ) (o : D.Op) (x : Data r) : Option (Data r × D.Result o × ℕ) := - match P.code.eval w fuel (P.prepare o x) with - | none => none - | some (y, n) => (P.decode o y.regs).map fun a => (y, a, n + 1) - -/-- A bounded machine call with native execution evidence (`DynamicProgram.OperationTrace`). -/ -def ExecOp (w : ℕ) : Stateful.RelExecution D (Data r) DynamicProgram.OperationTrace := - fun x o a y trace => - (P.prepare o x).Bounded w ∧ ∃ n, TraceExec w P.code (P.prepare o x) y n trace.probes ∧ - P.decode o y.regs = some a ∧ trace.instructions = n + 1 - -/-- Successful typed evaluation supplies an exact operation trace when the delivered state is -bounded. -/ -theorem ExecOp.of_eval {w fuel k : ℕ} {o : D.Op} {x y : Data r} {a : D.Result o} - (hb : (P.prepare o x).Bounded w) (h : P.eval w fuel o x = some (y, a, k)) : - ∃ probes, P.ExecOp w x o a y ⟨k, probes⟩ := by - cases he : P.code.eval w fuel (P.prepare o x) with - | none => simp [eval, he] at h - | some yn => - obtain ⟨z, n⟩ := yn - cases hd : P.decode o z.regs with - | none => simp [eval, he, hd] at h - | some b => - simp only [eval, he, hd, Option.map_some, Option.some.injEq, Prod.mk.injEq] at h - obtain ⟨rfl, rfl, rfl⟩ := h - obtain ⟨probes, hp⟩ := (Exec.of_eval he).exists_trace - exact ⟨probes, hb, n, hp, hd, rfl⟩ - -/-- Every call is an execution of one fixed flat machine program. -/ -theorem ExecOp.executes {w : ℕ} {x y : Data r} {o : D.Op} {a : D.Result o} - {trace : DynamicProgram.OperationTrace} (h : P.ExecOp w x o a y trace) : - Executes w (P.code.program P.output) ⟨0, P.prepare o x⟩ (y.regs P.output) - trace.instructions := by - obtain ⟨_, n, he, _, ht⟩ := h - rw [ht] - exact he.exec.executes P.output - -/-- A call preserves bounded words. -/ -theorem ExecOp.bounded {w : ℕ} {x y : Data r} {o : D.Op} {a : D.Result o} - {trace : DynamicProgram.OperationTrace} (h : P.ExecOp w x o a y trace) : y.Bounded w := by - obtain ⟨hb, _, he, _, _⟩ := h - exact he.exec.bounded hb - -/-- Calls are deterministic in their final representation, observation, and instruction count. -/ -theorem ExecOp.unique {w : ℕ} {x y y' : Data r} {o : D.Op} {a a' : D.Result o} - {trace trace' : DynamicProgram.OperationTrace} (h : P.ExecOp w x o a y trace) - (h' : P.ExecOp w x o a' y' trace') : - y = y' ∧ a = a' ∧ trace.instructions = trace'.instructions := by - obtain ⟨_, _, he, ha, ht⟩ := h - obtain ⟨_, _, he', ha', ht'⟩ := h' - obtain ⟨rfl, rfl⟩ := he.exec.unique he'.exec - exact ⟨rfl, Option.some.inj (ha.symm.trans ha'), ht.trans ht'.symm⟩ - -/-- A call's final state and instruction count agree with any structured execution of the code. -/ -theorem ExecOp.eq_of_exec {P : RelDynamicProgram D r} {w : ℕ} {x y z : Data r} {o : D.Op} - {a : D.Result o} {trace : DynamicProgram.OperationTrace} {m : ℕ} - (he : P.ExecOp w x o a y trace) (h : Exec w P.code (P.prepare o x) z m) : - y = z ∧ trace.instructions = m + 1 := by - obtain ⟨_, _, ht, _, hn⟩ := he - obtain ⟨rfl, rfl⟩ := ht.exec.unique h - exact ⟨rfl, hn⟩ - -/-- The write transcript supplies a frame rule for a call, including register-only delivery. -/ -theorem ExecOp.frame {w : ℕ} {x y : Data r} {o : D.Op} {a : D.Result o} - {trace : DynamicProgram.OperationTrace} (h : P.ExecOp w x o a y trace) {Q : HeapAssertion} - (hQ : Q.holds x.mem) (hd : Disjoint Q.footprint (Probe.writes trace.probes)) : - Q.holds y.mem := by - obtain ⟨_, _, he, _, _⟩ := h - exact he.frame hQ hd - -end RelDynamicProgram - -/-- Per-operation angelic machine proof obligations for a `RelDynamicProgram`. -/ -structure RelDynamicCertificate (P : RelDynamicProgram D r) (w : ℕ) where +/-- Per-operation angelic machine proof obligations for a `DynamicProgram D r` over a relational +specification `D : Stateful.RelSpec`. -/ +structure RelDynamicCertificate (P : DynamicProgram D r) (w : ℕ) where /-- Abstract state represented by the persistent machine data. -/ rep : D.State → Data r → Prop /-- Represented configurations contain only machine words. -/ @@ -225,7 +101,8 @@ structure RelDynamicCertificate (P : RelDynamicProgram D r) (w : ℕ) where /-- Embed a deterministic `DynamicCertificate` as a `RelDynamicCertificate`. -/ def DynamicCertificate.toRelDynamicCertificate {D : Stateful.Spec.{u, v, z}} {r w : ℕ} {P : DynamicProgram D r} (C : DynamicCertificate P w) : - RelDynamicCertificate P.toRelDynamicProgram w where + RelDynamicCertificate (D := D.toRelSpec) + ⟨P.code, P.output, P.input, P.encode, P.decode⟩ w where rep := C.rep bounded := C.bounded arguments_fit := C.arguments_fit @@ -235,14 +112,14 @@ def DynamicCertificate.toRelDynamicCertificate {D : Stateful.Spec.{u, v, z}} {r namespace RelDynamicCertificate -variable {P : RelDynamicProgram D r} {w : ℕ} (C : RelDynamicCertificate P w) +variable {P : DynamicProgram D r} {w : ℕ} (C : RelDynamicCertificate P w) /-- Turn a successful typed evaluation on a represented state and admissible operation into certified `ExecOp` evidence. -/ theorem execOp_of_eval {s : D.State} {x y : Data r} {o : D.Op} {a : D.Result o} {fuel k : ℕ} (hr : C.rep s x) (hv : D.valid s o) (h : P.eval w fuel o x = some (y, a, k)) : ∃ probes, P.ExecOp w x o a y ⟨k, probes⟩ := - RelDynamicProgram.ExecOp.of_eval P + DynamicProgram.ExecOp.of_eval P (P.prepare_bounded (C.bounded hr) (C.arguments_fit o hv)) h /-- Fixed-program relational certificates realize `D` via `Stateful.RelRealization`. -/ @@ -291,7 +168,7 @@ theorem run_client_const {K : ℕ} {α : Type*} (p : D.Client α) {s : D.State} {x : Data r} (hr : C.rep s x) (hv : D.DemonicValid s p) : ∃ a y traces s' tr, - Stateful.RelExecutes (P.ExecOp w) p x a y traces ∧ + Stateful.Executes (P.ExecOp w) p x a y traces ∧ D.ClientRun s p a s' tr ∧ C.rep s' y ∧ traces.length = tr.length ∧ @@ -331,7 +208,7 @@ theorem executes_client_frame {j : ℕ} {α : Type*} {p : D.Client α} {s : D.State} {x y : Data r} {val : α} {traces : List DynamicProgram.OperationTrace} (hr : C.rep s x) (hv : D.DemonicValid s p) - (he : Stateful.RelExecutes (P.ExecOp w) p x val y traces) : + (he : Stateful.Executes (P.ExecOp w) p x val y traces) : y.mem j = x.mem j := by induction he generalizing s with | pure _ _ => rfl @@ -348,7 +225,7 @@ theorem executes_client_modifies {F : Finset ℕ} {α : Type*} {p : D.Client α} {s : D.State} {x y : Data r} {val : α} {traces : List DynamicProgram.OperationTrace} (hr : C.rep s x) (hv : D.DemonicValid s p) - (he : Stateful.RelExecutes (P.ExecOp w) p x val y traces) : + (he : Stateful.Executes (P.ExecOp w) p x val y traces) : Modifies F x.mem y.mem := fun j hj => C.executes_client_frame (fun hr' hv' he' => hmod hr' hv' he' j hj) hr hv he @@ -388,70 +265,14 @@ end SubroutineCode `P : SubroutineCode B r_ds k_init` realizing a relational specification `D : Stateful.RelSpec` at word width `w`, base address `base`, runtime parameters `params`, and initial state `s₀`. -In contrast to `SubroutineDS`, `rep_unique` is omitted (because concrete potential -`potential : Data r_ds → ℕ` depends only on machine data) and `step_exec` existentially -quantifies over a permitted outcome `(s', a)` satisfying `D.step s o s' a`. -/ +Extends `SubroutineBase P D.Result D.valid w base params s₀` (inheriting `toDynamicProgram`, +`initFresh_exec`, `initFresh_rename`, `zeroFillCode_exec`, `initClear_exec`, `initClear_rename`, +`frame_caller`, and `prepareRegs`), omits `rep_unique` (because concrete potential +`potential : Data r_ds → ℕ` depends only on machine data), and existentially quantifies over a +permitted outcome `(s', a)` satisfying `D.step s o s' a` in `step_exec`. -/ structure RelSubroutineDS {B : Basis} {r_ds k_init : ℕ} (P : SubroutineCode B r_ds k_init) - (D : Stateful.RelSpec.{u, v, z}) (w base : ℕ) (params : Fin k_init → ℕ) (s₀ : D.State) where - /-- Contiguous memory footprint length `[base, base + space)`. -/ - space : ℕ - /-- Instruction bound for `P.allocSpan`. -/ - spanTime : ℕ - /-- Instruction bound for `P.initSetup`. -/ - setupTime : ℕ - /-- Upper bound on initial concrete potential after initialization. -/ - initPotential : ℕ - /-- Amortized instruction charge per operation (excluding trailing standalone `halt`). -/ - charge : D.State → D.Op → ℕ - /-- Representation invariant linking mathematical state `s` to concrete `Data r_ds`. -/ - rep : D.State → Data r_ds → Prop - /-- Concrete integer potential depending only on `Data r_ds`. -/ - potential : Data r_ds → ℕ - /-- Standalone register encoding for `RelDynamicProgram.prepare`. -/ - encode : D.Op → Fin r_ds → ℕ - /-- Partial argument-matching predicate for inline callers (refined by `encode`). -/ - argMatch : D.Op → (Fin r_ds → ℕ) → Prop - /-- Output decoder reading typed operation observations from final registers. -/ - decode : (o : D.Op) → (Fin r_ds → ℕ) → Option (D.Result o) - /-- Represented configurations are word-bounded. -/ - bounded : ∀ {s x}, rep s x → x.Bounded w - /-- Standalone encoded arguments fit in `w`-bit words on admissible calls. -/ - arguments_fit : ∀ {s} (o), D.valid s o → ∀ i, P.input i = true → Fits w (encode o i) - /-- Full standalone `prepare` delivery satisfies `argMatch`. -/ - encode_matches : ∀ (o : D.Op) (regs : Fin r_ds → ℕ), - argMatch o (fun i => if P.input i then encode o i else regs i) - /-- `rep` depends only on persistent registers (`P.input i = false`) and `[base, base + space)`. - -/ - rep_supported : ∀ {s x x'}, - (∀ i, P.input i = false → x'.regs i = x.regs i) → - (∀ a ∈ (Block.mk base space).footprint, x'.mem a = x.mem a) → - x'.Bounded w → rep s x → rep s x' - /-- `potential` depends only on persistent registers and `[base, base + space)` under `rep`. -/ - potential_supported : ∀ {s x x'}, - (∀ i, P.input i = false → x'.regs i = x.regs i) → - (∀ a ∈ (Block.mk base space).footprint, x'.mem a = x.mem a) → - rep s x → potential x' = potential x - /-- Distinctness of registers used by `zeroFillCode` relative to `baseReg` and `frontierReg`. -/ - clear_nodup : [P.curReg, P.zeroReg, P.oneReg, P.baseReg, P.frontierReg].Nodup - /-- Initialization parameter registers are not overwritten by `zeroFillCode`. -/ - params_not_clear : ∀ j, P.initParams j ∉ [P.curReg, P.zeroReg, P.oneReg] - /-- `P.incCur` increments `P.curReg` by `1` when `P.oneReg = 1` and the sum fits in `w` bits. -/ - incCur_eval : ∀ {x : Data r_ds}, x.regs P.oneReg = 1 → Fits w (x.regs P.curReg + 1) → - P.incCur.eval w x = some (x.set P.curReg (x.regs P.curReg + 1)) - /-- Execution of `P.allocSpan`: records `baseReg = base` and advances `frontierReg`. -/ - span_exec : ∀ {x : Data r_ds}, - x.Bounded w → x.regs P.frontierReg = base → (∀ j, x.regs (P.initParams j) = params j) → - ∃ x₁, ExecWithin w P.allocSpan x x₁ spanTime ∧ x₁.mem = x.mem ∧ - x₁.regs P.baseReg = base ∧ x₁.regs P.frontierReg = base + space ∧ - (∀ j, x₁.regs (P.initParams j) = params j) - /-- Execution of `P.initSetup` once `[base, base + space)` holds zeros. -/ - setup_exec : ∀ {x₁ : Data r_ds}, - x₁.Bounded w → x₁.regs P.baseReg = base → x₁.regs P.frontierReg = base + space → - (∀ j, x₁.regs (P.initParams j) = params j) → - (∀ a ∈ (Block.mk base space).footprint, x₁.mem a = 0) → - ∃ y, ExecWithin w P.initSetup x₁ y setupTime ∧ y.regs P.frontierReg = base + space ∧ - rep s₀ y ∧ potential y ≤ initPotential ∧ - Modifies (Block.mk base space).footprint x₁.mem y.mem + (D : Stateful.RelSpec.{u, v, z}) (w base : ℕ) (params : Fin k_init → ℕ) (s₀ : D.State) + extends SubroutineBase P D.Result D.valid w base params s₀ where /-- Angelic execution of `P.code` for any admissible operation `o` whose arguments match `x.regs`, witnessing some permitted outcome `(s', a)` with `D.step s o s' a`. -/ step_exec : ∀ {s : D.State} {x : Data r_ds} (o : D.Op), @@ -470,26 +291,7 @@ def SubroutineDS.toRelSubroutineDS {B : Basis} {r_ds k_init w base : ℕ} {params : Fin k_init → ℕ} {s₀ : D.State} (C : SubroutineDS P D w base params s₀) : RelSubroutineDS P D.toRelSpec w base params s₀ where - space := C.space - spanTime := C.spanTime - setupTime := C.setupTime - initPotential := C.initPotential - charge := C.charge - rep := C.rep - potential := C.potential - encode := C.encode - argMatch := C.argMatch - decode := C.decode - bounded := C.bounded - arguments_fit := C.arguments_fit - encode_matches := C.encode_matches - rep_supported := C.rep_supported - potential_supported := C.potential_supported - clear_nodup := C.clear_nodup - params_not_clear := C.params_not_clear - incCur_eval := C.incCur_eval - span_exec := C.span_exec - setup_exec := C.setup_exec + toSubroutineBase := C.toSubroutineBase step_exec o hr hv harg := by obtain ⟨y, n, he, hdec, hrep, hmod, hpot⟩ := C.step_exec o hr hv harg exact ⟨y, (D.step _ o).1, (D.step _ o).2, n, he, rfl, hdec, hrep, hmod, hpot⟩ @@ -500,39 +302,12 @@ variable {B B' : Basis} {r_ds r_caller k_init w base : ℕ} {P : SubroutineCode B r_ds k_init} {D : Stateful.RelSpec.{u, v, z}} {params : Fin k_init → ℕ} {s₀ : D.State} -/-- Total instruction bound for `P.initFresh`. -/ -def initTime (C : RelSubroutineDS P D w base params s₀) : ℕ := - C.spanTime + C.setupTime - -/-! ### Projection 1: Basis lifting and standalone `RelDynamicProgram` / `Stateful` theorems -/ +/-! ### Projection 1: Basis lifting and standalone `DynamicProgram` / `Stateful` theorems -/ /-- Lift a `RelSubroutineDS` certificate along any defined-evaluation basis simulation. -/ def mapSimulates (φ : B.Simulates B') (C : RelSubroutineDS P D w base params s₀) : RelSubroutineDS (P.mapSimulates φ) D w base params s₀ where - space := C.space - spanTime := C.spanTime - setupTime := C.setupTime - initPotential := C.initPotential - charge := C.charge - rep := C.rep - potential := C.potential - encode := C.encode - argMatch := C.argMatch - decode := C.decode - bounded := C.bounded - arguments_fit := C.arguments_fit - encode_matches := C.encode_matches - rep_supported := C.rep_supported - potential_supported := C.potential_supported - clear_nodup := C.clear_nodup - params_not_clear := C.params_not_clear - incCur_eval h1 hfit := Op.eval_mapSimulates_of_some φ (C.incCur_eval h1 hfit) - span_exec hx hf hp := - let ⟨x₁, he, hm, hb, hfr, hpar⟩ := C.span_exec hx hf hp - ⟨x₁, he.mapSimulates φ, hm, hb, hfr, hpar⟩ - setup_exec hx₁ hb hfr hpar hz := - let ⟨y, he, hfr', hrep, hpot, hmod⟩ := C.setup_exec hx₁ hb hfr hpar hz - ⟨y, he.mapSimulates φ, hfr', hrep, hpot, hmod⟩ + toSubroutineBase := C.toSubroutineBase.mapSimulates φ step_exec o hr hv harg := let ⟨y, s', a, n, he, hstep, hdec, hrep, hmod, hpot⟩ := C.step_exec o hr hv harg ⟨y, s', a, n, he.mapSimulates φ, hstep, hdec, hrep, hmod, hpot⟩ @@ -548,50 +323,42 @@ section Standard variable {P_std : SubroutineCode .standard r_ds k_init} (C : RelSubroutineDS P_std D w base params s₀) -/-- Project a `.standard`-basis `RelSubroutineDS` to a standalone `RelDynamicProgram`. -/ -def toRelDynamicProgram : RelDynamicProgram D r_ds where - code := P_std.code - output := P_std.output - input := P_std.input - encode := C.encode - decode := C.decode - /-- Project a `.standard`-basis `RelSubroutineDS` to a standalone `RelDynamicCertificate`. -/ -def toRelCertificate : RelDynamicCertificate C.toRelDynamicProgram w where +def toRelCertificate : RelDynamicCertificate (D := D) C.toDynamicProgram w where rep := C.rep bounded := C.bounded arguments_fit := C.arguments_fit execute {s x} o hr hv := by - have hb' : (C.toRelDynamicProgram.prepare o x).Bounded w := - C.toRelDynamicProgram.prepare_bounded (C.bounded hr) (C.arguments_fit o hv) - have hr' : C.rep s (C.toRelDynamicProgram.prepare o x) := + have hb' : (C.toDynamicProgram.prepare o x).Bounded w := + C.toDynamicProgram.prepare_bounded (C.bounded hr) (C.arguments_fit o hv) + have hr' : C.rep s (C.toDynamicProgram.prepare o x) := C.rep_supported - (fun i hi => C.toRelDynamicProgram.prepare_regs_of_not_input hi o x) + (fun i hi => C.toDynamicProgram.prepare_regs_of_not_input hi o x) (fun _ _ => rfl) hb' hr - have harg : C.argMatch o (C.toRelDynamicProgram.prepare o x).regs := + have harg : C.argMatch o (C.toDynamicProgram.prepare o x).regs := C.encode_matches o x.regs obtain ⟨y, s', a, n, he, hstep, hdec, hrep, _, _⟩ := C.step_exec o hr' hv harg exact ⟨y, s', a, n, he, hstep, hdec, hrep⟩ /-- Project a `.standard`-basis `RelSubroutineDS` to a standalone `Stateful.RelAmortized` -certificate, charging `+ 1` per operation for `RelDynamicProgram`'s trailing `halt` instruction. -/ +certificate, charging `+ 1` per operation for `DynamicProgram`'s trailing `halt` instruction. -/ theorem toRelAmortized : Stateful.RelAmortized C.toRelCertificate.realization DynamicProgram.OperationTrace.instructions (fun _ x => C.potential x) (fun s o => C.charge s o + 1) where step {s x o a y trace} hr hv he := by - have hb' : (C.toRelDynamicProgram.prepare o x).Bounded w := - C.toRelDynamicProgram.prepare_bounded (C.bounded hr) (C.arguments_fit o hv) - have hr' : C.rep s (C.toRelDynamicProgram.prepare o x) := + have hb' : (C.toDynamicProgram.prepare o x).Bounded w := + C.toDynamicProgram.prepare_bounded (C.bounded hr) (C.arguments_fit o hv) + have hr' : C.rep s (C.toDynamicProgram.prepare o x) := C.rep_supported - (fun i hi => C.toRelDynamicProgram.prepare_regs_of_not_input hi o x) + (fun i hi => C.toDynamicProgram.prepare_regs_of_not_input hi o x) (fun _ _ => rfl) hb' hr - have hp_eq : C.potential (C.toRelDynamicProgram.prepare o x) = C.potential x := + have hp_eq : C.potential (C.toDynamicProgram.prepare o x) = C.potential x := C.potential_supported - (fun i hi => C.toRelDynamicProgram.prepare_regs_of_not_input hi o x) + (fun i hi => C.toDynamicProgram.prepare_regs_of_not_input hi o x) (fun _ _ => rfl) hr - have harg : C.argMatch o (C.toRelDynamicProgram.prepare o x).regs := + have harg : C.argMatch o (C.toDynamicProgram.prepare o x).regs := C.encode_matches o x.regs obtain ⟨z, s', a', m, hz, hstep, hdec, hrep, _, hpot⟩ := C.step_exec o hr' hv harg obtain ⟨rfl, hinst⟩ := he.eq_of_exec hz @@ -603,9 +370,6 @@ theorem toRelAmortized : rw [hp_eq] at hpot omega -/-- Alias for `toRelAmortized` matching `SubroutineDS.toAmortized`. -/ -abbrev toAmortized := @toRelAmortized - /-- When `C.potential` is identically zero, `RelSubroutineDS` projects directly to a worst-case `Stateful.RelBound` certificate. -/ theorem toRelBound (hpot : ∀ x, C.potential x = 0) : @@ -617,14 +381,11 @@ theorem toRelBound (hpot : ∀ x, C.potential x = 0) : simp only [hpot] at h omega -/-- Alias for `toRelBound` matching `SubroutineDS.toBound`. -/ -abbrev toBound := @toRelBound - /-- Standalone adaptive-client amortized bound for any demonically admissible client `p`. -/ theorem run_client_amortized {α : Type*} (p : D.Client α) {s : D.State} {x : Data r_ds} (hr : C.rep s x) (hv : D.DemonicValid s p) : ∃ a y traces s' tr, - Stateful.RelExecutes (C.toRelDynamicProgram.ExecOp w) p x a y traces ∧ + Stateful.Executes (C.toDynamicProgram.ExecOp w) p x a y traces ∧ D.ClientRun s p a s' tr ∧ C.rep s' y ∧ traces.length = tr.length ∧ @@ -636,7 +397,7 @@ theorem run_client_amortized {α : Type*} (p : D.Client α) {s : D.State} {x : D theorem run_client_bound (hpot : ∀ x, C.potential x = 0) {α : Type*} (p : D.Client α) {s : D.State} {x : Data r_ds} (hr : C.rep s x) (hv : D.DemonicValid s p) : ∃ a y traces s' tr, - Stateful.RelExecutes (C.toRelDynamicProgram.ExecOp w) p x a y traces ∧ + Stateful.Executes (C.toDynamicProgram.ExecOp w) p x a y traces ∧ D.ClientRun s p a s' tr ∧ C.rep s' y ∧ traces.length = tr.length ∧ @@ -646,140 +407,7 @@ theorem run_client_bound (hpot : ∀ x, C.potential x = 0) {α : Type*} (p : D.C end Standard -/-! ### Projection 2: Fresh `O(1)` initialization and register relocation -/ - -/-- Execute `P.initFresh` on zeroed `[base, base + C.space)` in `C.initTime` instructions. -/ -theorem initFresh_exec (C : RelSubroutineDS P D w base params s₀) {x : Data r_ds} - (hx : x.Bounded w) (hfr : x.regs P.frontierReg = base) - (hpar : ∀ j, x.regs (P.initParams j) = params j) - (hz : ∀ a ∈ (Block.mk base C.space).footprint, x.mem a = 0) : - ∃ y, ExecWithin w P.initFresh x y C.initTime ∧ - y.regs P.frontierReg = base + C.space ∧ - C.rep s₀ y ∧ - C.potential y ≤ C.initPotential ∧ - Modifies (Block.mk base C.space).footprint x.mem y.mem := by - obtain ⟨x₁, he₁, hm₁, hb₁, hfr₁, hpar₁⟩ := C.span_exec hx hfr hpar - have hx₁ : x₁.Bounded w := he₁.bounded hx - have hz₁ : ∀ a ∈ (Block.mk base C.space).footprint, x₁.mem a = 0 := by - intro a ha - rw [hm₁] - exact hz a ha - obtain ⟨y, he₂, hfr₂, hrep, hpot, hmod⟩ := C.setup_exec hx₁ hb₁ hfr₁ hpar₁ hz₁ - rw [hm₁] at hmod - exact ⟨y, he₁.seq he₂, hfr₂, hrep, hpot, hmod⟩ - -/-- Relocated `O(1)` fresh initialization along any injective register embedding `f`. -/ -theorem initFresh_rename (C : RelSubroutineDS P D w base params s₀) - {f : Fin r_ds → Fin r_caller} (hf : f.Injective) {x : Data r_caller} - (hx : (x.comap f).Bounded w) (hfr : x.regs (f P.frontierReg) = base) - (hpar : ∀ j, x.regs (f (P.initParams j)) = params j) - (hz : ∀ a ∈ (Block.mk base C.space).footprint, x.mem a = 0) : - ∃ z, ExecWithin w (P.initFresh.rename f) x z C.initTime ∧ - z.regs (f P.frontierReg) = base + C.space ∧ - C.rep s₀ (z.comap f) ∧ - C.potential (z.comap f) ≤ C.initPotential ∧ - Modifies (Block.mk base C.space).footprint x.mem z.mem ∧ - (∀ j ∉ Set.range f, z.regs j = x.regs j) := by - obtain ⟨y, he, hfr', hrep, hpot, hmod⟩ := C.initFresh_exec hx hfr hpar hz - refine ⟨y.extend f x, he.rename hf, ?_, ?_, ?_, hmod, - fun j hj => Data.extend_regs_of_notMem y x hj⟩ - · change ((y.extend f x).comap f).regs P.frontierReg = base + C.space - rw [Data.comap_extend hf] - exact hfr' - · rw [Data.comap_extend hf] - exact hrep - · rw [Data.comap_extend hf] - exact hpot - -/-! ### Projection 3: Generic `O(space)` dirty-memory initialization (`initClear`) -/ - -/-- Auxiliary deterministic `SubroutineDS` sharing `C`'s initialization fields so -`zeroFillCode_exec` is reused without duplicating its loop proof. -/ -private def toInitSubroutineDS (C : RelSubroutineDS P D w base params s₀) : - SubroutineDS P - { State := PUnit.{1}, Op := PUnit.{1}, Result := fun _ => PUnit.{1}, - step := fun _ _ => (⟨⟩, ⟨⟩), valid := fun _ _ => False } - w base params ⟨⟩ where - space := C.space - spanTime := C.spanTime - setupTime := C.setupTime - initPotential := C.initPotential - charge _ _ := 0 - rep _ x := C.rep s₀ x - potential := C.potential - encode _ _ := 0 - argMatch _ _ := True - decode _ _ := some ⟨⟩ - bounded := C.bounded - rep_unique _ _ := rfl - arguments_fit _ hv := False.elim hv - encode_matches _ _ := trivial - rep_supported := C.rep_supported - potential_supported := C.potential_supported - clear_nodup := C.clear_nodup - params_not_clear := C.params_not_clear - incCur_eval := C.incCur_eval - span_exec := C.span_exec - setup_exec := C.setup_exec - step_exec _ _ hv := False.elim hv - -/-- Generic execution of `P.zeroFillCode` clearing `[base, base + C.space)` in `4 * C.space + 6` -instructions over any basis `B`. -/ -theorem zeroFillCode_exec (C : RelSubroutineDS P D w base params s₀) {x₁ : Data r_ds} - (hx₁ : x₁.Bounded w) (hb₁ : x₁.regs P.baseReg = base) - (hfr₁ : x₁.regs P.frontierReg = base + C.space) - (hpar₁ : ∀ j, x₁.regs (P.initParams j) = params j) : - ∃ x₂, ExecWithin w P.zeroFillCode x₁ x₂ (4 * C.space + 6) ∧ - x₂.Bounded w ∧ - x₂.regs P.baseReg = base ∧ - x₂.regs P.frontierReg = base + C.space ∧ - (∀ j, x₂.regs (P.initParams j) = params j) ∧ - (∀ a ∈ (Block.mk base C.space).footprint, x₂.mem a = 0) ∧ - Modifies (Block.mk base C.space).footprint x₁.mem x₂.mem := - C.toInitSubroutineDS.zeroFillCode_exec hx₁ hb₁ hfr₁ hpar₁ - -/-- Execute `P.initClear` on arbitrary dirty memory in `C.initTime + 4 * C.space + 6` -instructions. -/ -theorem initClear_exec (C : RelSubroutineDS P D w base params s₀) {x : Data r_ds} - (hx : x.Bounded w) (hfr : x.regs P.frontierReg = base) - (hpar : ∀ j, x.regs (P.initParams j) = params j) : - ∃ y, ExecWithin w P.initClear x y (C.initTime + 4 * C.space + 6) ∧ - y.regs P.frontierReg = base + C.space ∧ - C.rep s₀ y ∧ - C.potential y ≤ C.initPotential ∧ - Modifies (Block.mk base C.space).footprint x.mem y.mem := by - obtain ⟨x₁, he₁, hm₁, hb₁, hfr₁, hpar₁⟩ := C.span_exec hx hfr hpar - obtain ⟨x₂, he₂, hx₂, hb₂, hfr₂, hpar₂, hz₂, hmod₂⟩ := - C.zeroFillCode_exec (he₁.bounded hx) hb₁ hfr₁ hpar₁ - obtain ⟨y, he₃, hfr₃, hrep, hpot, hmod₃⟩ := C.setup_exec hx₂ hb₂ hfr₂ hpar₂ hz₂ - rw [hm₁] at hmod₂ - have hmod : Modifies (Block.mk base C.space).footprint x.mem y.mem := by - simpa only [Finset.union_idempotent] using hmod₂.trans hmod₃ - exact ⟨y, (he₁.seq (he₂.seq he₃)).mono (by unfold initTime; omega), hfr₃, hrep, hpot, hmod⟩ - -/-- Relocated `O(space)` dirty-memory initialization along any injective register embedding `f`. -/ -theorem initClear_rename (C : RelSubroutineDS P D w base params s₀) - {f : Fin r_ds → Fin r_caller} (hf : f.Injective) {x : Data r_caller} - (hx : (x.comap f).Bounded w) (hfr : x.regs (f P.frontierReg) = base) - (hpar : ∀ j, x.regs (f (P.initParams j)) = params j) : - ∃ z, ExecWithin w (P.initClear.rename f) x z (C.initTime + 4 * C.space + 6) ∧ - z.regs (f P.frontierReg) = base + C.space ∧ - C.rep s₀ (z.comap f) ∧ - C.potential (z.comap f) ≤ C.initPotential ∧ - Modifies (Block.mk base C.space).footprint x.mem z.mem ∧ - (∀ j ∉ Set.range f, z.regs j = x.regs j) := by - obtain ⟨y, he, hfr', hrep, hpot, hmod⟩ := C.initClear_exec hx hfr hpar - refine ⟨y.extend f x, he.rename hf, ?_, ?_, ?_, hmod, - fun j hj => Data.extend_regs_of_notMem y x hj⟩ - · change ((y.extend f x).comap f).regs P.frontierReg = base + C.space - rw [Data.comap_extend hf] - exact hfr' - · rw [Data.comap_extend hf] - exact hrep - · rw [Data.comap_extend hf] - exact hpot - -/-! ### Projection 4: Relocated inline subroutine calls (`code_rename`, `call_rename`) -/ +/-! ### Projection 2: Relocated inline subroutine calls (`code_rename`, `call_rename`) -/ /-- Execute `P.code.rename f` inline when arguments already match `(x.comap f).regs`, witnessing a permitted outcome `(s', a)` with `D.step s o s' a`. -/ @@ -831,30 +459,7 @@ theorem call_rename (C : RelSubroutineDS P D w base params s₀) exact ⟨z, s', a, t_prep + t_op, hprep.seq he_op, hstep, hdec, hrep_z, hmod_z, hregs_z, by rw [hp_eq] at hpot_z; omega⟩ -/-! ### Projection 5: Caller-to-DS bidirectional framing (`frame_caller`) -/ - -/-- Any caller state transition that preserves `(x'.comap f).Bounded w`, leaves persistent DS -registers (`P.input i = false`) unchanged, and writes only to a set `F` disjoint from -`[base, base + C.space)` preserves both `C.rep s (x'.comap f)` and `C.potential (x'.comap f)`. -/ -theorem frame_caller (C : RelSubroutineDS P D w base params s₀) - {f : Fin r_ds → Fin r_caller} {s : D.State} {x x' : Data r_caller} {F : Finset ℕ} - (hr : C.rep s (x.comap f)) - (hb' : (x'.comap f).Bounded w) - (hreg : ∀ i, P.input i = false → x'.regs (f i) = x.regs (f i)) - (hdisj : Disjoint (Block.mk base C.space).footprint F) - (hmem : Modifies F x.mem x'.mem) : - C.rep s (x'.comap f) ∧ C.potential (x'.comap f) = C.potential (x.comap f) := by - have hag : ∀ a ∈ (Block.mk base C.space).footprint, x'.mem a = x.mem a := fun a ha => - hmem a (fun hf => Finset.disjoint_left.mp hdisj ha hf) - exact ⟨C.rep_supported (x := x.comap f) (x' := x'.comap f) hreg hag hb' hr, - C.potential_supported (x := x.comap f) (x' := x'.comap f) hreg hag hr⟩ - -/-! ### Projection 6: Flat-program operation-sequence execution (`RunsRelOps`, `run_ops_exact_*`) -/ - -/-- Default register-preparation function overwriting `P.input` registers with `C.encode o`. -/ -def prepareRegs (C : RelSubroutineDS P D w base params s₀) (o : D.Op) - (regs : Fin r_ds → ℕ) : Fin r_ds → ℕ := - fun i => if P.input i then C.encode o i else regs i +/-! ### Projection 3: Flat-program operation-sequence execution (`RunsRelOps`, `run_ops_exact_*`) -/ /-- Sequential flat-program execution of `ops : List D.Op` by repeated calls to `P.opProg`: each call prepares input registers via `prepRegs`, runs `P.opProg` from `pc = 0` to `halt`, @@ -937,12 +542,12 @@ theorem seq_runsRelOps (C : RelSubroutineDS P D w base params s₀) D.totalCost (fun st o => C.charge st o + 1) s tr + C.potential x := by refine C.seq_runsRelOps_of_prep C.prepareRegs ?_ ?_ C.encode_matches ops hr hv · intro s' o regs hv_o hregs i - simp only [prepareRegs] + simp only [SubroutineBase.prepareRegs] split_ifs with hi · exact C.arguments_fit o hv_o i hi · exact hregs i · intro o regs i hi - simp [prepareRegs, hi] + simp [SubroutineBase.prepareRegs, hi] /-- Standalone flat-program operation-sequence theorem with `O(1)` fresh initialization on zeroed `[base, base + C.space)`. -/ diff --git a/Complexity/Computability/WordRAM/Subroutine.lean b/Complexity/Computability/WordRAM/Subroutine.lean index 2dae6c8e7..bb0969dcc 100644 --- a/Complexity/Computability/WordRAM/Subroutine.lean +++ b/Complexity/Computability/WordRAM/Subroutine.lean @@ -40,11 +40,12 @@ A data structure is packaged once as a `SubroutineCode B r_ds k_init` and certif ## Main definitions -* `Cslib.WordRAM.SubroutineCode`, `Cslib.WordRAM.SubroutineDS`: uniform relocatable machine code and - unified standalone / inline specification and resource certificate for a Word-RAM data structure. +* `Cslib.WordRAM.SubroutineCode`, `Cslib.WordRAM.SubroutineBase`, `Cslib.WordRAM.SubroutineDS`: + uniform relocatable machine code, step-independent initialization/framing bundle, and unified + standalone / inline specification and resource certificate for a Word-RAM data structure. * `Cslib.WordRAM.SubroutineCode.initFresh`, `Cslib.WordRAM.SubroutineCode.initClear`: `O(1)` fresh initialization on zeroed memory and generic `O(space)` dirty-memory re-initialization. -* `Cslib.WordRAM.SubroutineDS.toDynamicProgram`, `Cslib.WordRAM.SubroutineDS.toCertificate`: +* `Cslib.WordRAM.SubroutineBase.toDynamicProgram`, `Cslib.WordRAM.SubroutineDS.toCertificate`: standalone `.standard`-basis `DynamicProgram` and `DynamicCertificate` projections. ## Main results @@ -53,8 +54,8 @@ A data structure is packaged once as a `SubroutineCode B r_ds k_init` and certif * `Cslib.WordRAM.SubroutineDS.toAmortized`, `Cslib.WordRAM.SubroutineDS.toBound`, `Cslib.WordRAM.SubroutineDS.run_client_amortized`, `Cslib.WordRAM.SubroutineDS.run_client_bound`: standalone amortized and worst-case instruction bounds over `Basis.standard`. -* `Cslib.WordRAM.SubroutineDS.initFresh_rename`, `Cslib.WordRAM.SubroutineDS.initClear_rename`, - `Cslib.WordRAM.SubroutineDS.call_rename`, `Cslib.WordRAM.SubroutineDS.frame_caller`: relocated +* `Cslib.WordRAM.SubroutineBase.initFresh_rename`, `Cslib.WordRAM.SubroutineBase.initClear_rename`, + `Cslib.WordRAM.SubroutineDS.call_rename`, `Cslib.WordRAM.SubroutineBase.frame_caller`: relocated inline initialization, inline operation calls, and bidirectional register/memory framing. ## References @@ -209,10 +210,18 @@ end SubroutineCode universe u v z -/-- Unified standalone and subroutine specification/resource certificate for `P` realizing `D` at -word width `w`, base address `base`, runtime parameters `params`, and initial state `s₀`. -/ -structure SubroutineDS {B : Basis} {r_ds k_init : ℕ} (P : SubroutineCode B r_ds k_init) - (D : Stateful.Spec.{u, v, z}) (w base : ℕ) (params : Fin k_init → ℕ) (s₀ : D.State) where +/-- Step-independent specification, representation, calling-convention, and initialization bundle +for `P : SubroutineCode B r_ds k_init` over a state type `State`, operation type `Op`, observation +family `Result`, and admissibility predicate `valid` at word width `w`, base address `base`, +runtime parameters `params`, and initial state `s₀`. + +Extended by `SubroutineDS` (for deterministic `Stateful.Spec`) and `RelSubroutineDS` (for +relational `Stateful.RelSpec`) so that initialization (`initFresh`, `zeroFillCode`, `initClear`), +register relocation, standalone `toDynamicProgram`, and bidirectional framing (`frame_caller`) are +stated and proved once. -/ +structure SubroutineBase {B : Basis} {r_ds k_init : ℕ} (P : SubroutineCode B r_ds k_init) + {State : Type u} {O : Type v} (Result : O → Type z) (valid : State → O → Prop) + (w base : ℕ) (params : Fin k_init → ℕ) (s₀ : State) where /-- Contiguous memory footprint length `[base, base + space)`. -/ space : ℕ /-- Instruction bound for `P.allocSpan`. -/ @@ -222,25 +231,23 @@ structure SubroutineDS {B : Basis} {r_ds k_init : ℕ} (P : SubroutineCode B r_d /-- Upper bound on initial concrete potential after initialization. -/ initPotential : ℕ /-- Amortized instruction charge per operation (excluding trailing standalone `halt`). -/ - charge : D.State → D.Op → ℕ + charge : State → O → ℕ /-- Representation invariant linking mathematical state `s` to concrete `Data r_ds`. -/ - rep : D.State → Data r_ds → Prop + rep : State → Data r_ds → Prop /-- Concrete integer potential depending only on `Data r_ds`. -/ potential : Data r_ds → ℕ /-- Standalone register encoding for `DynamicProgram.prepare`. -/ - encode : D.Op → Fin r_ds → ℕ + encode : O → Fin r_ds → ℕ /-- Partial argument-matching predicate for inline callers (refined by `encode`). -/ - argMatch : D.Op → (Fin r_ds → ℕ) → Prop + argMatch : O → (Fin r_ds → ℕ) → Prop /-- Output decoder reading typed operation observations from final registers. -/ - decode : (o : D.Op) → (Fin r_ds → ℕ) → Option (D.Result o) + decode : (o : O) → (Fin r_ds → ℕ) → Option (Result o) /-- Represented configurations are word-bounded. -/ bounded : ∀ {s x}, rep s x → x.Bounded w - /-- Concrete machine data determines at most one represented abstract state. -/ - rep_unique : ∀ {s₁ s₂ x}, rep s₁ x → rep s₂ x → s₁ = s₂ /-- Standalone encoded arguments fit in `w`-bit words on admissible calls. -/ - arguments_fit : ∀ {s} (o), D.valid s o → ∀ i, P.input i = true → Fits w (encode o i) + arguments_fit : ∀ {s} (o), valid s o → ∀ i, P.input i = true → Fits w (encode o i) /-- Full standalone `prepare` delivery satisfies `argMatch`. -/ - encode_matches : ∀ (o : D.Op) (regs : Fin r_ds → ℕ), + encode_matches : ∀ (o : O) (regs : Fin r_ds → ℕ), argMatch o (fun i => if P.input i then encode o i else regs i) /-- `rep` depends only on persistent registers (`P.input i = false`) and `[base, base + space)`. -/ @@ -274,30 +281,25 @@ structure SubroutineDS {B : Basis} {r_ds k_init : ℕ} (P : SubroutineCode B r_d ∃ y, ExecWithin w P.initSetup x₁ y setupTime ∧ y.regs P.frontierReg = base + space ∧ rep s₀ y ∧ potential y ≤ initPotential ∧ Modifies (Block.mk base space).footprint x₁.mem y.mem - /-- Execution of `P.code` for any admissible operation `o` whose arguments match `x.regs`. -/ - step_exec : ∀ {s : D.State} {x : Data r_ds} (o : D.Op), - rep s x → D.valid s o → argMatch o x.regs → - ∃ y n, Exec w P.code x y n ∧ - decode o y.regs = some (D.step s o).2 ∧ - rep (D.step s o).1 y ∧ - Modifies (Block.mk base space).footprint x.mem y.mem ∧ - n + potential y ≤ charge s o + potential x -namespace SubroutineDS +namespace SubroutineBase variable {B B' : Basis} {r_ds r_caller k_init w base : ℕ} - {P : SubroutineCode B r_ds k_init} {D : Stateful.Spec.{u, v, z}} - {params : Fin k_init → ℕ} {s₀ : D.State} + {P : SubroutineCode B r_ds k_init} {State : Type u} {O : Type v} + {Result : O → Type z} {valid : State → O → Prop} {params : Fin k_init → ℕ} {s₀ : State} /-- Total instruction bound for `P.initFresh`. -/ -def initTime (C : SubroutineDS P D w base params s₀) : ℕ := +def initTime (C : SubroutineBase P Result valid w base params s₀) : ℕ := C.spanTime + C.setupTime -/-! ### Projection 1: Basis lifting and standalone `DynamicProgram` / `Stateful` theorems -/ +/-- Default register-preparation function overwriting `P.input` registers with `C.encode o`. -/ +def prepareRegs (C : SubroutineBase P Result valid w base params s₀) (o : O) + (regs : Fin r_ds → ℕ) : Fin r_ds → ℕ := + fun i => if P.input i then C.encode o i else regs i -/-- Lift a `SubroutineDS` certificate along any defined-evaluation basis simulation. -/ -def mapSimulates (φ : B.Simulates B') (C : SubroutineDS P D w base params s₀) : - SubroutineDS (P.mapSimulates φ) D w base params s₀ where +/-- Lift a `SubroutineBase` bundle along any defined-evaluation basis simulation. -/ +def mapSimulates (φ : B.Simulates B') (C : SubroutineBase P Result valid w base params s₀) : + SubroutineBase (P.mapSimulates φ) Result valid w base params s₀ where space := C.space spanTime := C.spanTime setupTime := C.setupTime @@ -309,7 +311,6 @@ def mapSimulates (φ : B.Simulates B') (C : SubroutineDS P D w base params s₀) argMatch := C.argMatch decode := C.decode bounded := C.bounded - rep_unique := C.rep_unique arguments_fit := C.arguments_fit encode_matches := C.encode_matches rep_supported := C.rep_supported @@ -323,110 +324,19 @@ def mapSimulates (φ : B.Simulates B') (C : SubroutineDS P D w base params s₀) setup_exec hx₁ hb hfr hpar hz := let ⟨y, he, hfr', hrep, hpot, hmod⟩ := C.setup_exec hx₁ hb hfr hpar hz ⟨y, he.mapSimulates φ, hfr', hrep, hpot, hmod⟩ - step_exec o hr hv harg := - let ⟨y, n, he, hdec, hrep, hmod, hpot⟩ := C.step_exec o hr hv harg - ⟨y, n, he.mapSimulates φ, hdec, hrep, hmod, hpot⟩ - -/-- Lift an exact-basis `SubroutineDS` certificate to `Basis.standard`. -/ -abbrev toStandard {P : SubroutineCode .exact r_ds k_init} - (C : SubroutineDS P D w base params s₀) : - SubroutineDS P.toStandard D w base params s₀ := - C.mapSimulates .exactStandard - -section Standard - -variable {P_std : SubroutineCode .standard r_ds k_init} - (C : SubroutineDS P_std D w base params s₀) -/-- Project a `.standard`-basis `SubroutineDS` to a standalone `DynamicProgram`. -/ -def toDynamicProgram : DynamicProgram D r_ds where +/-- Project a `.standard`-basis `SubroutineBase` to a standalone `DynamicProgram`. -/ +def toDynamicProgram {P_std : SubroutineCode .standard r_ds k_init} + (C : SubroutineBase P_std Result valid w base params s₀) : + DynamicProgram { State := Empty, Op := O, Result := Result, step := Empty.elim } r_ds where code := P_std.code output := P_std.output input := P_std.input encode := C.encode decode := C.decode -/-- Project a `.standard`-basis `SubroutineDS` to a standalone `DynamicCertificate`. -/ -def toCertificate : DynamicCertificate C.toDynamicProgram w where - rep := C.rep - bounded := C.bounded - arguments_fit := C.arguments_fit - execute {s x} o hr hv := by - have hb' : (C.toDynamicProgram.prepare o x).Bounded w := - C.toDynamicProgram.prepare_bounded (C.bounded hr) (C.arguments_fit o hv) - have hr' : C.rep s (C.toDynamicProgram.prepare o x) := - C.rep_supported - (fun i hi => C.toDynamicProgram.prepare_regs_of_not_input hi o x) - (fun _ _ => rfl) hb' hr - have harg : C.argMatch o (C.toDynamicProgram.prepare o x).regs := - C.encode_matches o x.regs - obtain ⟨y, n, he, hdec, hrep, _, _⟩ := C.step_exec o hr' hv harg - exact ⟨y, n, he, hdec, hrep⟩ - -/-- Project a `.standard`-basis `SubroutineDS` to a standalone `Stateful.Amortized` certificate, -charging `+ 1` per operation for `DynamicProgram`'s trailing `halt` instruction. -/ -theorem toAmortized : - Stateful.Amortized C.toCertificate.realization - DynamicProgram.OperationTrace.instructions - (fun _ x => C.potential x) - (fun s o => C.charge s o + 1) where - step {s x o a y trace} hr hv he := by - have hb' : (C.toDynamicProgram.prepare o x).Bounded w := - C.toDynamicProgram.prepare_bounded (C.bounded hr) (C.arguments_fit o hv) - have hr' : C.rep s (C.toDynamicProgram.prepare o x) := - C.rep_supported - (fun i hi => C.toDynamicProgram.prepare_regs_of_not_input hi o x) - (fun _ _ => rfl) hb' hr - have hp_eq : C.potential (C.toDynamicProgram.prepare o x) = C.potential x := - C.potential_supported - (fun i hi => C.toDynamicProgram.prepare_regs_of_not_input hi o x) - (fun _ _ => rfl) hr - have harg : C.argMatch o (C.toDynamicProgram.prepare o x).regs := - C.encode_matches o x.regs - obtain ⟨z, m, hz, _, _, _, hpot⟩ := C.step_exec o hr' hv harg - obtain ⟨rfl, hinst⟩ := he.eq_of_exec hz - rw [hinst] - rw [hp_eq] at hpot - omega - -/-- When `C.potential` is identically zero, `SubroutineDS` projects directly to a worst-case -`Stateful.Bound` certificate. -/ -theorem toBound (hpot : ∀ x, C.potential x = 0) : - Stateful.Bound C.toCertificate.realization - DynamicProgram.OperationTrace.instructions - (fun s o => C.charge s o + 1) := by - intro s x o a y trace hr hv he - have h := C.toAmortized.step hr hv he - simp only [hpot] at h - omega - -/-- Standalone adaptive-client amortized bound for any admissible client program `p`. -/ -theorem run_client_amortized {α : Type*} (p : D.Client α) {s : D.State} {x : Data r_ds} - (hr : C.rep s x) (hv : D.ValidHistory s (D.runClient s p).2.2) : - ∃ y traces, - Stateful.Executes (C.toDynamicProgram.ExecOp w) p x (D.runClient s p).1 y traces ∧ - C.rep (D.runClient s p).2.1 y ∧ - Stateful.total DynamicProgram.OperationTrace.instructions traces + C.potential y ≤ - D.totalCost (fun s o => C.charge s o + 1) s (D.runClient s p).2.2 + C.potential x := - C.toAmortized.exists_executes p hr hv - -/-- Standalone adaptive-client worst-case bound when `C.potential` is identically zero. -/ -theorem run_client_bound (hpot : ∀ x, C.potential x = 0) {α : Type*} (p : D.Client α) - {s : D.State} {x : Data r_ds} (hr : C.rep s x) - (hv : D.ValidHistory s (D.runClient s p).2.2) : - ∃ y traces, - Stateful.Executes (C.toDynamicProgram.ExecOp w) p x (D.runClient s p).1 y traces ∧ - C.rep (D.runClient s p).2.1 y ∧ - Stateful.total DynamicProgram.OperationTrace.instructions traces ≤ - D.totalCost (fun s o => C.charge s o + 1) s (D.runClient s p).2.2 := - Stateful.Bound.exists_executes (C.toBound hpot) p hr hv - -end Standard - -/-! ### Projection 2: Fresh `O(1)` initialization and register relocation -/ - /-- Execute `P.initFresh` on zeroed `[base, base + C.space)` in `C.initTime` instructions. -/ -theorem initFresh_exec (C : SubroutineDS P D w base params s₀) {x : Data r_ds} +theorem initFresh_exec (C : SubroutineBase P Result valid w base params s₀) {x : Data r_ds} (hx : x.Bounded w) (hfr : x.regs P.frontierReg = base) (hpar : ∀ j, x.regs (P.initParams j) = params j) (hz : ∀ a ∈ (Block.mk base C.space).footprint, x.mem a = 0) : @@ -446,7 +356,7 @@ theorem initFresh_exec (C : SubroutineDS P D w base params s₀) {x : Data r_ds} exact ⟨y, he₁.seq he₂, hfr₂, hrep, hpot, hmod⟩ /-- Relocated `O(1)` fresh initialization along any injective register embedding `f`. -/ -theorem initFresh_rename (C : SubroutineDS P D w base params s₀) +theorem initFresh_rename (C : SubroutineBase P Result valid w base params s₀) {f : Fin r_ds → Fin r_caller} (hf : f.Injective) {x : Data r_caller} (hx : (x.comap f).Bounded w) (hfr : x.regs (f P.frontierReg) = base) (hpar : ∀ j, x.regs (f (P.initParams j)) = params j) @@ -468,11 +378,9 @@ theorem initFresh_rename (C : SubroutineDS P D w base params s₀) · rw [Data.comap_extend hf] exact hpot -/-! ### Projection 3: Generic `O(space)` dirty-memory initialization (`initClear`) -/ - /-- Generic execution of `P.zeroFillCode` clearing `[base, base + C.space)` in `4 * C.space + 6` instructions over any basis `B`. -/ -theorem zeroFillCode_exec (C : SubroutineDS P D w base params s₀) {x₁ : Data r_ds} +theorem zeroFillCode_exec (C : SubroutineBase P Result valid w base params s₀) {x₁ : Data r_ds} (hx₁ : x₁.Bounded w) (hb₁ : x₁.regs P.baseReg = base) (hfr₁ : x₁.regs P.frontierReg = base + C.space) (hpar₁ : ∀ j, x₁.regs (P.initParams j) = params j) : @@ -618,7 +526,7 @@ theorem zeroFillCode_exec (C : SubroutineDS P D w base params s₀) {x₁ : Data /-- Execute `P.initClear` on **arbitrary dirty memory** in `C.initTime + 4 * C.space + 6` instructions. -/ -theorem initClear_exec (C : SubroutineDS P D w base params s₀) {x : Data r_ds} +theorem initClear_exec (C : SubroutineBase P Result valid w base params s₀) {x : Data r_ds} (hx : x.Bounded w) (hfr : x.regs P.frontierReg = base) (hpar : ∀ j, x.regs (P.initParams j) = params j) : ∃ y, ExecWithin w P.initClear x y (C.initTime + 4 * C.space + 6) ∧ @@ -636,7 +544,7 @@ theorem initClear_exec (C : SubroutineDS P D w base params s₀) {x : Data r_ds} exact ⟨y, (he₁.seq (he₂.seq he₃)).mono (by unfold initTime; omega), hfr₃, hrep, hpot, hmod⟩ /-- Relocated `O(space)` dirty-memory initialization along any injective register embedding `f`. -/ -theorem initClear_rename (C : SubroutineDS P D w base params s₀) +theorem initClear_rename (C : SubroutineBase P Result valid w base params s₀) {f : Fin r_ds → Fin r_caller} (hf : f.Injective) {x : Data r_caller} (hx : (x.comap f).Bounded w) (hfr : x.regs (f P.frontierReg) = base) (hpar : ∀ j, x.regs (f (P.initParams j)) = params j) : @@ -657,7 +565,154 @@ theorem initClear_rename (C : SubroutineDS P D w base params s₀) · rw [Data.comap_extend hf] exact hpot -/-! ### Projection 4: Relocated inline subroutine calls (`code_rename`, `call_rename`) -/ +/-- Any caller state transition that preserves `(x'.comap f).Bounded w`, leaves persistent DS +registers (`P.input i = false`) unchanged, and writes only to a set `F` disjoint from +`[base, base + C.space)` preserves both `C.rep s (x'.comap f)` and `C.potential (x'.comap f)`. -/ +theorem frame_caller (C : SubroutineBase P Result valid w base params s₀) + {f : Fin r_ds → Fin r_caller} {s : State} {x x' : Data r_caller} {F : Finset ℕ} + (hr : C.rep s (x.comap f)) + (hb' : (x'.comap f).Bounded w) + (hreg : ∀ i, P.input i = false → x'.regs (f i) = x.regs (f i)) + (hdisj : Disjoint (Block.mk base C.space).footprint F) + (hmem : Modifies F x.mem x'.mem) : + C.rep s (x'.comap f) ∧ C.potential (x'.comap f) = C.potential (x.comap f) := by + have hag : ∀ a ∈ (Block.mk base C.space).footprint, x'.mem a = x.mem a := fun a ha => + hmem a (fun hf => Finset.disjoint_left.mp hdisj ha hf) + exact ⟨C.rep_supported (x := x.comap f) (x' := x'.comap f) hreg hag hb' hr, + C.potential_supported (x := x.comap f) (x' := x'.comap f) hreg hag hr⟩ + +end SubroutineBase + +/-- Unified standalone and subroutine specification/resource certificate for `P` realizing `D` at +word width `w`, base address `base`, runtime parameters `params`, and initial state `s₀`. -/ +structure SubroutineDS {B : Basis} {r_ds k_init : ℕ} (P : SubroutineCode B r_ds k_init) + (D : Stateful.Spec.{u, v, z}) (w base : ℕ) (params : Fin k_init → ℕ) (s₀ : D.State) + extends SubroutineBase P D.Result D.valid w base params s₀ where + /-- Concrete machine data determines at most one represented abstract state. -/ + rep_unique : ∀ {s₁ s₂ x}, rep s₁ x → rep s₂ x → s₁ = s₂ + /-- Execution of `P.code` for any admissible operation `o` whose arguments match `x.regs`. -/ + step_exec : ∀ {s : D.State} {x : Data r_ds} (o : D.Op), + rep s x → D.valid s o → argMatch o x.regs → + ∃ y n, Exec w P.code x y n ∧ + decode o y.regs = some (D.step s o).2 ∧ + rep (D.step s o).1 y ∧ + Modifies (Block.mk base space).footprint x.mem y.mem ∧ + n + potential y ≤ charge s o + potential x + +namespace SubroutineDS + +variable {B B' : Basis} {r_ds r_caller k_init w base : ℕ} + {P : SubroutineCode B r_ds k_init} {D : Stateful.Spec.{u, v, z}} + {params : Fin k_init → ℕ} {s₀ : D.State} + +/-! ### Projection 1: Basis lifting and standalone `DynamicProgram` / `Stateful` theorems -/ + +/-- Lift a `SubroutineDS` certificate along any defined-evaluation basis simulation. -/ +def mapSimulates (φ : B.Simulates B') (C : SubroutineDS P D w base params s₀) : + SubroutineDS (P.mapSimulates φ) D w base params s₀ where + toSubroutineBase := C.toSubroutineBase.mapSimulates φ + rep_unique := C.rep_unique + step_exec o hr hv harg := + let ⟨y, n, he, hdec, hrep, hmod, hpot⟩ := C.step_exec o hr hv harg + ⟨y, n, he.mapSimulates φ, hdec, hrep, hmod, hpot⟩ + +/-- Lift an exact-basis `SubroutineDS` certificate to `Basis.standard`. -/ +abbrev toStandard {P : SubroutineCode .exact r_ds k_init} + (C : SubroutineDS P D w base params s₀) : + SubroutineDS P.toStandard D w base params s₀ := + C.mapSimulates .exactStandard + +section Standard + +variable {P_std : SubroutineCode .standard r_ds k_init} + (C : SubroutineDS P_std D w base params s₀) + +/-- Project a `.standard`-basis `SubroutineDS` to its underlying standalone `DynamicProgram`. -/ +def toDynamicProgram : DynamicProgram D r_ds where + code := P_std.code + output := P_std.output + input := P_std.input + encode := C.encode + decode := C.decode + +/-- Project a `.standard`-basis `SubroutineDS` to a standalone `DynamicCertificate`. -/ +def toCertificate : DynamicCertificate C.toDynamicProgram w where + rep := C.rep + bounded := C.bounded + arguments_fit := C.arguments_fit + execute {s x} o hr hv := by + have hb' : (C.toDynamicProgram.prepare o x).Bounded w := + C.toDynamicProgram.prepare_bounded (C.bounded hr) (C.arguments_fit o hv) + have hr' : C.rep s (C.toDynamicProgram.prepare o x) := + C.rep_supported + (fun i hi => C.toDynamicProgram.prepare_regs_of_not_input hi o x) + (fun _ _ => rfl) hb' hr + have harg : C.argMatch o (C.toDynamicProgram.prepare o x).regs := + C.encode_matches o x.regs + obtain ⟨y, n, he, hdec, hrep, _, _⟩ := C.step_exec o hr' hv harg + exact ⟨y, n, he, hdec, hrep⟩ + +/-- Project a `.standard`-basis `SubroutineDS` to a standalone `Stateful.Amortized` certificate, +charging `+ 1` per operation for `DynamicProgram`'s trailing `halt` instruction. -/ +theorem toAmortized : + Stateful.Amortized C.toCertificate.realization + DynamicProgram.OperationTrace.instructions + (fun _ x => C.potential x) + (fun s o => C.charge s o + 1) where + step {s x o a y trace} hr hv he := by + have hb' : (C.toDynamicProgram.prepare o x).Bounded w := + C.toDynamicProgram.prepare_bounded (C.bounded hr) (C.arguments_fit o hv) + have hr' : C.rep s (C.toDynamicProgram.prepare o x) := + C.rep_supported + (fun i hi => C.toDynamicProgram.prepare_regs_of_not_input hi o x) + (fun _ _ => rfl) hb' hr + have hp_eq : C.potential (C.toDynamicProgram.prepare o x) = C.potential x := + C.potential_supported + (fun i hi => C.toDynamicProgram.prepare_regs_of_not_input hi o x) + (fun _ _ => rfl) hr + have harg : C.argMatch o (C.toDynamicProgram.prepare o x).regs := + C.encode_matches o x.regs + obtain ⟨z, m, hz, _, _, _, hpot⟩ := C.step_exec o hr' hv harg + obtain ⟨rfl, hinst⟩ := he.eq_of_exec hz + rw [hinst] + rw [hp_eq] at hpot + omega + +/-- When `C.potential` is identically zero, `SubroutineDS` projects directly to a worst-case +`Stateful.Bound` certificate. -/ +theorem toBound (hpot : ∀ x, C.potential x = 0) : + Stateful.Bound C.toCertificate.realization + DynamicProgram.OperationTrace.instructions + (fun s o => C.charge s o + 1) := by + intro s x o a y trace hr hv he + have h := C.toAmortized.step hr hv he + simp only [hpot] at h + omega + +/-- Standalone adaptive-client amortized bound for any admissible client program `p`. -/ +theorem run_client_amortized {α : Type*} (p : D.Client α) {s : D.State} {x : Data r_ds} + (hr : C.rep s x) (hv : D.ValidHistory s (D.runClient s p).2.2) : + ∃ y traces, + Stateful.Executes (C.toDynamicProgram.ExecOp w) p x (D.runClient s p).1 y traces ∧ + C.rep (D.runClient s p).2.1 y ∧ + Stateful.total DynamicProgram.OperationTrace.instructions traces + C.potential y ≤ + D.totalCost (fun s o => C.charge s o + 1) s (D.runClient s p).2.2 + C.potential x := + C.toAmortized.exists_executes p hr hv + +/-- Standalone adaptive-client worst-case bound when `C.potential` is identically zero. -/ +theorem run_client_bound (hpot : ∀ x, C.potential x = 0) {α : Type*} (p : D.Client α) + {s : D.State} {x : Data r_ds} (hr : C.rep s x) + (hv : D.ValidHistory s (D.runClient s p).2.2) : + ∃ y traces, + Stateful.Executes (C.toDynamicProgram.ExecOp w) p x (D.runClient s p).1 y traces ∧ + C.rep (D.runClient s p).2.1 y ∧ + Stateful.total DynamicProgram.OperationTrace.instructions traces ≤ + D.totalCost (fun s o => C.charge s o + 1) s (D.runClient s p).2.2 := + Stateful.Bound.exists_executes (C.toBound hpot) p hr hv + +end Standard + +/-! ### Projection 2: Relocated inline subroutine calls (`code_rename`, `call_rename`) -/ /-- Execute `P.code.rename f` inline when arguments already match `(x.comap f).regs`. -/ theorem code_rename (C : SubroutineDS P D w base params s₀) @@ -706,24 +761,6 @@ theorem call_rename (C : SubroutineDS P D w base params s₀) exact ⟨z, t_prep + t_op, hprep.seq he_op, hdec, hrep_z, hmod_z, hregs_z, by rw [hp_eq] at hpot_z; omega⟩ -/-! ### Projection 5: Caller-to-DS bidirectional framing (`frame_caller`) -/ - -/-- Any caller state transition that preserves `(x'.comap f).Bounded w`, leaves persistent DS -registers (`P.input i = false`) unchanged, and writes only to a set `F` disjoint from -`[base, base + C.space)` preserves both `C.rep s (x'.comap f)` and `C.potential (x'.comap f)`. -/ -theorem frame_caller (C : SubroutineDS P D w base params s₀) - {f : Fin r_ds → Fin r_caller} {s : D.State} {x x' : Data r_caller} {F : Finset ℕ} - (hr : C.rep s (x.comap f)) - (hb' : (x'.comap f).Bounded w) - (hreg : ∀ i, P.input i = false → x'.regs (f i) = x.regs (f i)) - (hdisj : Disjoint (Block.mk base C.space).footprint F) - (hmem : Modifies F x.mem x'.mem) : - C.rep s (x'.comap f) ∧ C.potential (x'.comap f) = C.potential (x.comap f) := by - have hag : ∀ a ∈ (Block.mk base C.space).footprint, x'.mem a = x.mem a := fun a ha => - hmem a (fun hf => Finset.disjoint_left.mp hdisj ha hf) - exact ⟨C.rep_supported (x := x.comap f) (x' := x'.comap f) hreg hag hb' hr, - C.potential_supported (x := x.comap f) (x' := x'.comap f) hreg hag hr⟩ - end SubroutineDS end Cslib.WordRAM diff --git a/Complexity/Foundations/Semantics/Stateful/Realization.lean b/Complexity/Foundations/Semantics/Stateful/Realization.lean index 43afd738d..5761f7fb1 100644 --- a/Complexity/Foundations/Semantics/Stateful/Realization.lean +++ b/Complexity/Foundations/Semantics/Stateful/Realization.lean @@ -39,14 +39,16 @@ namespace Cslib.Stateful universe u v w x y -variable {D E : Spec.{u, v, w}} {C τ : Type x} {α β : Type y} +variable {S : PFunctor.{v, w}} {D E : Spec.{u, v, w}} {C τ : Type x} {α β : Type y} + +instance : Coe Spec.{u, v, w} PFunctor.{v, w} := ⟨Spec.signature⟩ /-- A backend chooses its own execution evidence, independently of a resource measure. -/ -abbrev Execution (D : Spec.{u, v, w}) (C Trace : Type x) := - C → (o : D.Op) → D.Result o → C → Trace → Prop +abbrev Execution (S : PFunctor.{v, w}) (C Trace : Type x) := + C → (o : S.A) → S.B o → C → Trace → Prop /-- Clients collect native execution evidence in call order; no costs occur in this semantics. -/ -inductive Executes (exec : Execution D C τ) : D.Client α → C → α → C → List τ → Prop +inductive Executes (exec : Execution S C τ) : S.FreeM α → C → α → C → List τ → Prop | pure (a c) : Executes exec (.pure a) c a c [] | call {o k c a c' trace b c'' traces} : exec c o a c' trace → Executes exec (k a) c' b c'' traces → @@ -97,12 +99,12 @@ end Realization /-- Execution of a sequential composition splits its native trace at the call boundary. -/ -theorem executes_bind_iff (exec : Execution D C τ) (p : D.Client α) - (k : α → D.Client β) {c c' : C} {b : β} {ts : List τ} : +theorem executes_bind_iff (exec : Execution S C τ) (p : S.FreeM α) + (k : α → S.FreeM β) {c c' : C} {b : β} {ts : List τ} : Executes exec (p.bind k) c b c' ts ↔ ∃ a mid front back, Executes exec p c a mid front ∧ Executes exec (k a) mid b c' back ∧ ts = front ++ back := by - induction p generalizing c ts with + induction p using PFunctor.FreeM.recOn generalizing c ts with | pure a => constructor · intro h; exact ⟨a, c, [], ts, .pure a c, h, rfl⟩ diff --git a/Complexity/Foundations/Semantics/Stateful/Relational.lean b/Complexity/Foundations/Semantics/Stateful/Relational.lean index 40d7761e7..722f77f02 100644 --- a/Complexity/Foundations/Semantics/Stateful/Relational.lean +++ b/Complexity/Foundations/Semantics/Stateful/Relational.lean @@ -52,9 +52,8 @@ deterministic counterparts on `D`. * `Cslib.Stateful.RelSpec.ClientRun`, `Cslib.Stateful.RelSpec.DemonicValid`, `Cslib.Stateful.RelSpec.Hoare`, `Cslib.Stateful.RelSpec.CostHoare`: adaptive client runs, demonic admissibility, and compositional Hoare / CostHoare triples. -* `Cslib.Stateful.RelExecution`, `Cslib.Stateful.RelExecutes`, - `Cslib.Stateful.RelRealization`, `Cslib.Stateful.RelBound`, `Cslib.Stateful.RelAmortized`: - native execution traces, angelic representation simulation, and potential-method certificates. +* `Cslib.Stateful.RelRealization`, `Cslib.Stateful.RelBound`, `Cslib.Stateful.RelAmortized`: + angelic representation simulation and potential-method certificates over `Execution` / `Executes`. ## Main results @@ -127,6 +126,19 @@ theorem exists_step [D.Total] {s : D.State} {o : D.Op} (hv : D.valid s o) : /-- The polynomial operation signature `⟨D.Op, D.Result⟩`. -/ abbrev signature : PFunctor.{v, w} := ⟨D.Op, D.Result⟩ +instance : Coe RelSpec.{u, v, w} PFunctor.{v, w} := ⟨RelSpec.signature⟩ + +/-- Project the operation signature `(D.Op, D.Result)` of a relational specification to a +canonical `Stateful.Spec` with `State := Empty`, allowing signature-only constructions over +`Stateful.Spec` (such as `WordRAM.DynamicProgram`) to apply directly to `D : RelSpec`. -/ +abbrev toSpec : Spec.{0, v, w} where + State := Empty + Op := D.Op + Result := D.Result + step s := s.elim + +instance : Coe RelSpec.{u, v, w} Spec.{0, v, w} := ⟨RelSpec.toSpec⟩ + /-- An adaptive client over `D`: each continuation may branch on the observed operation result. -/ abbrev Client (α : Type y) : Type (max v w y) := D.signature.FreeM α @@ -159,8 +171,6 @@ abbrev Spec.toRelSpec (D : Spec.{u, v, w}) : RelSpec.{u, v, w} where step s o s' a := (s', a) = D.step s o valid := D.valid -instance : Coe Spec.{u, v, w} RelSpec.{u, v, w} := ⟨Spec.toRelSpec⟩ - namespace Spec variable (D : Spec.{u, v, w}) @@ -858,74 +868,14 @@ theorem toRelSpec_costHoare_iff (charge : D.State → D.Op → ℕ) (pre : D.Sta end Spec -/-! ## Native backend executions (`RelExecution`, `RelExecutes`), `RelRealization`, `RelAmortized` --/ - -/-- A concrete backend execution relation for a relational specification `D : RelSpec`. -/ -abbrev RelExecution (D : RelSpec.{u, v, w}) (C Trace : Type x) := - C → (o : D.Op) → D.Result o → C → Trace → Prop - -/-- Adaptive client execution collecting native execution evidence in call order over a -relational specification `D : RelSpec`. -/ -inductive RelExecutes {D : RelSpec.{u, v, w}} {C τ : Type x} {α : Type y} - (exec : RelExecution D C τ) : D.Client α → C → α → C → List τ → Prop - | pure (a c) : RelExecutes exec (.pure a) c a c [] - | call {o k c a c' trace b c'' traces} : - exec c o a c' trace → RelExecutes exec (k a) c' b c'' traces → - RelExecutes exec (.liftBind o k) c b c'' (trace :: traces) - -/-- Sequential client execution splits its native trace at the call boundary. -/ -theorem relExecutes_bind_iff {D : RelSpec.{u, v, w}} {C τ : Type x} {α β : Type y} - (exec : RelExecution D C τ) (p : D.Client α) (k : α → D.Client β) - {c c' : C} {b : β} {ts : List τ} : - RelExecutes exec (p.bind k) c b c' ts ↔ - ∃ a mid front back, RelExecutes exec p c a mid front ∧ - RelExecutes exec (k a) mid b c' back ∧ ts = front ++ back := by - induction p generalizing c ts with - | pure a => - constructor - · intro h; exact ⟨a, c, [], ts, .pure a c, h, rfl⟩ - · rintro ⟨a', mid, front, back, hp, hk, ht⟩ - cases hp - simpa only [ht, List.nil_append, PFunctor.FreeM.bind] using hk - | liftBind o cont ih => - change RelExecutes exec (.liftBind o fun a => (cont a).bind k) c b c' ts ↔ _ - constructor - · intro h - cases h with - | call ho rest => - obtain ⟨a, mid, front, back, hp, hk, ht⟩ := (ih _).mp rest - exact ⟨a, mid, _, back, .call ho hp, hk, by simp [ht]⟩ - · rintro ⟨a, mid, front, back, hp, hk, ht⟩ - cases hp with - | call ho rest => - have hrest := (ih _).mpr ⟨a, mid, _, back, rest, hk, rfl⟩ - have h := RelExecutes.call (k := fun a => (cont a).bind k) ho hrest - simpa only [ht, List.cons_append] using h - -private theorem Spec.toRelSpec_relExecutes_imp {D : Spec.{u, v, w}} {C τ : Type x} {α : Type y} - {exec : Execution D C τ} {p : D.toRelSpec.Client α} {c : C} {a : α} {c' : C} - {traces : List τ} (h : RelExecutes (D := D.toRelSpec) exec p c a c' traces) : - Executes exec p c a c' traces := by - induction h with - | pure a c => exact .pure a c - | call ho _ ih => exact .call ho ih - -/-- On `D.toRelSpec`, `RelExecutes` coincides with `Executes`. -/ -theorem Spec.toRelSpec_relExecutes_iff {D : Spec.{u, v, w}} {C τ : Type x} {α : Type y} - (exec : Execution D C τ) (p : D.Client α) (c : C) (a : α) (c' : C) (traces : List τ) : - RelExecutes (D := D.toRelSpec) exec p c a c' traces ↔ Executes exec p c a c' traces := by - refine ⟨Spec.toRelSpec_relExecutes_imp, fun h => ?_⟩ - induction h with - | pure a c => exact RelExecutes.pure (D := D.toRelSpec) a c - | call ho _ ih => exact RelExecutes.call (D := D.toRelSpec) ho ih +/-! ## Angelic backend realizations (`RelRealization`, `RelBound`, `RelAmortized`) -/ /-- Angelic semantic realization of a relational specification `D : RelSpec`: * `total`: every represented state and admissible operation admits a native execution; * `correct`: every native execution from a represented state on an admissible operation realizes *some* permitted abstract post-state `s'` with `D.step s o s' a ∧ rep s' c'`. -/ structure RelRealization (D : RelSpec.{u, v, w}) {C τ : Type x} - (exec : RelExecution D C τ) where + (exec : Execution D C τ) where /-- Representation invariant linking abstract states to concrete backend states. -/ rep : D.State → C → Prop /-- Existence of a native execution for every represented state and admissible operation. -/ @@ -937,13 +887,13 @@ structure RelRealization (D : RelSpec.{u, v, w}) {C τ : Type x} namespace RelRealization variable {D : RelSpec.{u, v, w}} {C τ : Type x} {α : Type y} - {exec : RelExecution D C τ} (R : RelRealization D exec) + {exec : Execution D C τ} (R : RelRealization D exec) /-- From related states, every native execution of a demonically admissible client realizes a valid `ClientRun` ending in a related state. -/ theorem correct_client {p : D.Client α} {s : D.State} {c c' : C} {a : α} {traces : List τ} (hr : R.rep s c) (hv : D.DemonicValid s p) - (he : RelExecutes exec p c a c' traces) : + (he : Executes exec p c a c' traces) : ∃ s' tr, D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ traces.length = tr.length := by induction he generalizing s with | pure a c => @@ -959,7 +909,7 @@ theorem correct_client {p : D.Client α} {s : D.State} {c c' : C} {a : α} valid `ClientRun` ending in a related state. -/ theorem exists_executes (p : D.Client α) {s : D.State} {c : C} (hr : R.rep s c) (hv : D.DemonicValid s p) : - ∃ a c' traces s' tr, RelExecutes exec p c a c' traces ∧ + ∃ a c' traces s' tr, Executes exec p c a c' traces ∧ D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ traces.length = tr.length := by induction hv generalizing c with | pure s a => @@ -986,17 +936,17 @@ def Realization.toRelRealization {D : Spec.{u, v, w}} {C τ : Type x} /-- Every native execution of a verified demonic `Hoare` client satisfies its abstract postcondition in a related final state. -/ theorem RelSpec.Hoare.realize {D : RelSpec.{u, v, w}} {C Trace : Type x} {α : Type y} - {exec : RelExecution D C Trace} (R : RelRealization D exec) + {exec : Execution D C Trace} (R : RelRealization D exec) {pre : D.State → Prop} {post : α → D.State → Prop} {p : D.Client α} (h : D.Hoare pre p post) {s : D.State} {c c' : C} {a : α} {traces : List Trace} - (hp : pre s) (hr : R.rep s c) (he : RelExecutes exec p c a c' traces) : + (hp : pre s) (hr : R.rep s c) (he : Executes exec p c a c' traces) : ∃ s' tr, D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ post a s' := by obtain ⟨hv, hpost⟩ := h s hp obtain ⟨s', tr, hrun, hr', _⟩ := R.correct_client hr hv he exact ⟨s', tr, hrun, hr', hpost a s' tr hrun⟩ /-- Per-operation worst-case resource certificate over a relational realization `R`. -/ -def RelBound {D : RelSpec.{u, v, w}} {C τ : Type x} {exec : RelExecution D C τ} +def RelBound {D : RelSpec.{u, v, w}} {C τ : Type x} {exec : Execution D C τ} (R : RelRealization D exec) (weight : τ → ℕ) (charge : D.State → D.Op → ℕ) : Prop := ∀ {s c o a c' trace}, R.rep s c → D.valid s o → exec c o a c' trace → weight trace ≤ charge s o @@ -1013,7 +963,7 @@ for every native operation execution from `R.rep s c` on an admissible `o`, ther permitted abstract post-state `s'` satisfying `D.step s o s' a`, `R.rep s' c'`, and the single-step potential inequality `weight trace + potential s' c' ≤ charge s o + potential s c`. -/ structure RelAmortized {D : RelSpec.{u, v, w}} {C Trace : Type x} - {exec : RelExecution D C Trace} (R : RelRealization D exec) (weight : Trace → ℕ) + {exec : Execution D C Trace} (R : RelRealization D exec) (weight : Trace → ℕ) (potential : D.State → C → ℕ) (charge : D.State → D.Op → ℕ) : Prop where /-- Angelic single-step potential inequality witnessing a permitted post-state `s'`. -/ step : ∀ {s c o a c' trace}, R.rep s c → D.valid s o → exec c o a c' trace → @@ -1023,19 +973,19 @@ structure RelAmortized {D : RelSpec.{u, v, w}} {C Trace : Type x} namespace RelAmortized variable {D : RelSpec.{u, v, w}} {C Trace : Type x} {α : Type y} - {exec : RelExecution D C Trace} {R : RelRealization D exec} + {exec : Execution D C Trace} {R : RelRealization D exec} {weight : Trace → ℕ} {potential : D.State → C → ℕ} {charge : D.State → D.Op → ℕ} (A : RelAmortized R weight potential charge) include A in /-- **Amortized telescoping along adaptive clients (`executes_le`).** -For any demonically admissible client `p` and native execution `RelExecutes exec p c a c' traces`, +For any demonically admissible client `p` and native execution `Executes exec p c a c' traces`, there exist a final abstract state `s'` and transcript `tr` such that `D.ClientRun s p a s' tr`, `R.rep s' c'`, and `total weight traces + potential s' c' ≤ D.totalCost charge s tr + potential s c`. -/ theorem executes_le {p : D.Client α} {s : D.State} {c c' : C} {a : α} {traces : List Trace} (hr : R.rep s c) (hv : D.DemonicValid s p) - (he : RelExecutes exec p c a c' traces) : + (he : Executes exec p c a c' traces) : ∃ s' tr, D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ traces.length = tr.length ∧ total weight traces + potential s' c' ≤ @@ -1052,16 +1002,13 @@ theorem executes_le {p : D.Client α} {s : D.State} {c c' : C} {a : α} simp only [total_cons, RelSpec.totalCost_cons] omega -/-- Alias for `RelAmortized.executes_le` matching `Amortized.client`. -/ -abbrev client := @executes_le - include A in /-- **Existence, correctness, and amortized bound (`run_client_amortized`).** From related initial states, every demonically admissible client `p` admits a native execution satisfying `D.ClientRun`, `R.rep`, and the telescoping potential bound. -/ theorem run_client_amortized (p : D.Client α) {s : D.State} {c : C} (hr : R.rep s c) (hv : D.DemonicValid s p) : - ∃ a c' traces s' tr, RelExecutes exec p c a c' traces ∧ + ∃ a c' traces s' tr, Executes exec p c a c' traces ∧ D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ traces.length = tr.length ∧ total weight traces + potential s' c' ≤ @@ -1070,17 +1017,6 @@ theorem run_client_amortized (p : D.Client α) {s : D.State} {c : C} obtain ⟨s', tr, hrun, hr', hlen, hpot⟩ := A.executes_le hr hv he exact ⟨a, c', traces, s', tr, he, hrun, hr', hlen, hpot⟩ -include A in -/-- Alias for `RelAmortized.run_client_amortized` matching `Amortized.exists_executes`. -/ -theorem exists_executes (p : D.Client α) {s : D.State} {c : C} - (hr : R.rep s c) (hv : D.DemonicValid s p) : - ∃ a c' traces s' tr, RelExecutes exec p c a c' traces ∧ - D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ - traces.length = tr.length ∧ - total weight traces + potential s' c' ≤ - D.totalCost charge s tr + potential s c := - A.run_client_amortized p hr hv - /-- A worst-case `RelBound` is a zero-potential `RelAmortized` certificate. -/ theorem of_relBound (B : RelBound R weight charge) : RelAmortized R weight (fun _ _ => 0) charge where @@ -1104,7 +1040,7 @@ theorem Amortized.toRelAmortized {D : Spec.{u, v, w}} {C Trace : Type x} namespace RelBound variable {D : RelSpec.{u, v, w}} {C τ : Type x} {α : Type y} - {exec : RelExecution D C τ} {R : RelRealization D exec} + {exec : Execution D C τ} {R : RelRealization D exec} {weight : τ → ℕ} {charge : D.State → D.Op → ℕ} (B : RelBound R weight charge) @@ -1112,7 +1048,7 @@ include B in /-- Under a worst-case `RelBound`, every native execution of a demonically admissible client has total weight at most `D.totalCost charge s tr` for some valid `ClientRun` transcript `tr`. -/ theorem client {p : D.Client α} {s : D.State} {c c' : C} {a : α} {traces : List τ} - (hr : R.rep s c) (hv : D.DemonicValid s p) (he : RelExecutes exec p c a c' traces) : + (hr : R.rep s c) (hv : D.DemonicValid s p) (he : Executes exec p c a c' traces) : ∃ s' tr, D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ traces.length = tr.length ∧ total weight traces ≤ D.totalCost charge s tr := by @@ -1124,7 +1060,7 @@ include B in meeting the total charge bound. -/ theorem exists_executes (p : D.Client α) {s : D.State} {c : C} (hr : R.rep s c) (hv : D.DemonicValid s p) : - ∃ a c' traces s' tr, RelExecutes exec p c a c' traces ∧ + ∃ a c' traces s' tr, Executes exec p c a c' traces ∧ D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ traces.length = tr.length ∧ total weight traces ≤ D.totalCost charge s tr := by @@ -1137,13 +1073,13 @@ end RelBound /-- Transport a demonic `CostHoare` triple through a `RelAmortized` certificate to bound native execution weight plus final potential by `budget s + potential s c`. -/ theorem RelSpec.CostHoare.realize_amortized {D : RelSpec.{u, v, w}} {C τ : Type x} {α : Type y} - {exec : RelExecution D C τ} {R : RelRealization D exec} + {exec : Execution D C τ} {R : RelRealization D exec} {weight : τ → ℕ} {potential : D.State → C → ℕ} {charge : D.State → D.Op → ℕ} {pre : D.State → Prop} {post : α → D.State → Prop} {budget : D.State → ℕ} {p : D.Client α} (A : RelAmortized R weight potential charge) (h : D.CostHoare charge pre p post budget) {s : D.State} {c c' : C} {a : α} {traces : List τ} (hs : pre s) (hr : R.rep s c) - (he : RelExecutes exec p c a c' traces) : + (he : Executes exec p c a c' traces) : ∃ s' tr, D.ClientRun s p a s' tr ∧ R.rep s' c' ∧ post a s' ∧ total weight traces + potential s' c' ≤ budget s + potential s c := by obtain ⟨hv, hpost⟩ := h.1 s hs @@ -1153,13 +1089,13 @@ theorem RelSpec.CostHoare.realize_amortized {D : RelSpec.{u, v, w}} {C τ : Type /-- Transport a demonic `CostHoare` triple through a worst-case `RelBound` certificate. -/ theorem RelSpec.CostHoare.realize {D : RelSpec.{u, v, w}} {C τ : Type x} {α : Type y} - {exec : RelExecution D C τ} {R : RelRealization D exec} + {exec : Execution D C τ} {R : RelRealization D exec} {weight : τ → ℕ} {charge : D.State → D.Op → ℕ} {pre : D.State → Prop} {post : α → D.State → Prop} {budget : D.State → ℕ} {p : D.Client α} (B : RelBound R weight charge) (h : D.CostHoare charge pre p post budget) {s : D.State} {c c' : C} {a : α} {traces : List τ} (hs : pre s) (hr : R.rep s c) - (he : RelExecutes exec p c a c' traces) : + (he : Executes exec p c a c' traces) : (∃ s', R.rep s' c' ∧ post a s') ∧ total weight traces ≤ budget s := by obtain ⟨s', _, _, hr', hpost, hpot⟩ := h.realize_amortized (RelAmortized.of_relBound B) hs hr he @@ -1167,13 +1103,13 @@ theorem RelSpec.CostHoare.realize {D : RelSpec.{u, v, w}} {C τ : Type x} {α : /-- Existence of a native execution satisfying a demonic `CostHoare` contract under `RelBound`. -/ theorem RelSpec.CostHoare.exists_executes {D : RelSpec.{u, v, w}} {C τ : Type x} {α : Type y} - {exec : RelExecution D C τ} {R : RelRealization D exec} + {exec : Execution D C τ} {R : RelRealization D exec} {weight : τ → ℕ} {charge : D.State → D.Op → ℕ} {pre : D.State → Prop} {post : α → D.State → Prop} {budget : D.State → ℕ} {p : D.Client α} (B : RelBound R weight charge) (h : D.CostHoare charge pre p post budget) {s : D.State} {c : C} (hs : pre s) (hr : R.rep s c) : - ∃ a c' traces, RelExecutes exec p c a c' traces ∧ + ∃ a c' traces, Executes exec p c a c' traces ∧ (∃ s', R.rep s' c' ∧ post a s') ∧ total weight traces ≤ budget s := by obtain ⟨a, c', traces, _, _, he, _, _, _⟩ := R.exists_executes p hr (h.1 s hs).1 exact ⟨a, c', traces, he, h.realize B hs hr he⟩ diff --git a/ComplexityTests/StatefulRelational.lean b/ComplexityTests/StatefulRelational.lean index 8d3373331..1b6980b9c 100644 --- a/ComplexityTests/StatefulRelational.lean +++ b/ComplexityTests/StatefulRelational.lean @@ -21,7 +21,7 @@ backend realization and amortized analysis (`RelRealization`, `RelBound`, `RelAm @[expose] public section -namespace Cslib.Stateful.Tests +namespace ComplexityTests.StatefulRelational open Cslib.Stateful @@ -144,7 +144,7 @@ theorem allocTwoAndFreeFirst_hoare : /-- Concrete first-fit implementation of `TwoSlotAlloc`: `alloc` chooses slot `0` when free and slot `1` otherwise, recording `1` unit of execution trace cost per operation. -/ -def firstFitExec : RelExecution TwoSlotAlloc (Bool × Bool) ℕ +def firstFitExec : Execution TwoSlotAlloc (Bool × Bool) ℕ | c, .alloc, i, c', n => n = 1 ∧ if c.1 = false then i = 0 ∧ c' = (true, c.2) @@ -199,7 +199,7 @@ theorem firstFitAmortized : `RelAmortized.run_client_amortized` and `RelSpec.CostHoare.realize_amortized`. -/ theorem firstFit_allocTwoAndFreeFirst_executes : ∃ v c' traces s' tr, - RelExecutes firstFitExec allocTwoAndFreeFirst (false, false) v c' traces ∧ + Executes firstFitExec allocTwoAndFreeFirst (false, false) v c' traces ∧ TwoSlotAlloc.ClientRun (false, false) allocTwoAndFreeFirst v s' tr ∧ firstFitRealization.rep s' c' ∧ (v.1 ≠ v.2 ∧ (if v.1 = 0 then s'.1 = false else s'.2 = false)) ∧ @@ -238,4 +238,4 @@ theorem counterTwice_relHoare : subst hs exact ⟨⟨trivial, trivial, trivial⟩, rfl, rfl⟩ -end Cslib.Stateful.Tests +end ComplexityTests.StatefulRelational diff --git a/ComplexityTests/WordRAMRelSubroutine.lean b/ComplexityTests/WordRAMRelSubroutine.lean index 1eecc6baa..b8aeee2fd 100644 --- a/ComplexityTests/WordRAMRelSubroutine.lean +++ b/ComplexityTests/WordRAMRelSubroutine.lean @@ -13,7 +13,7 @@ public import Complexity.Computability.WordRAM.RelSubroutine /-! # Tests for Relational Word-RAM Subroutine Realizations -Concrete non-vacuous tests for `Cslib.WordRAM.RelSubroutineDS`, `RelDynamicProgram`, +Concrete non-vacuous tests for `Cslib.WordRAM.RelSubroutineDS`, `DynamicProgram`, `RelDynamicCertificate`, `SubroutineDS.toRelSubroutineDS`, `RelSubroutineDS.toStandard`, `RelSubroutineDS.call_rename`, `RelSubroutineDS.run_client_amortized`, `RelSubroutineDS.run_ops_exact_fresh`, and `RelSubroutineDS.run_ops_exact_reusable` on a @@ -22,7 +22,7 @@ genuinely nondeterministic two-slot allocator specification. @[expose] public section -namespace Cslib.WordRAM.Tests +namespace ComplexityTests.WordRAMRelSubroutine open Cslib Cslib.Stateful Cslib.WordRAM @@ -176,8 +176,8 @@ theorem allocPair_demonicValid : theorem twoSlot_run_client_amortized (w base : ℕ) (h2 : Fits w 2) {x : Data 6} (hr : (twoSlotSubroutine w base h2).rep (false, false) x) : ∃ a y traces s' tr, - Stateful.RelExecutes - ((twoSlotSubroutine w base h2).toStandard.toRelDynamicProgram.ExecOp w) + Stateful.Executes + ((twoSlotSubroutine w base h2).toStandard.toDynamicProgram.ExecOp w) allocPair x a y traces ∧ TwoSlotAlloc.ClientRun (false, false) allocPair a s' tr ∧ (twoSlotSubroutine w base h2).rep s' y ∧ @@ -348,4 +348,4 @@ def detCounter2RelSubroutine (w base : ℕ) (h2 : Fits w 2) : RelSubroutineDS twoSlotCode DetCounter2.toRelSpec w base Fin.elim0 0 := (detCounter2Subroutine w base h2).toRelSubroutineDS -end Cslib.WordRAM.Tests +end ComplexityTests.WordRAMRelSubroutine From e8b8c4d3092d62053d0c49fb08adc95784df4949 Mon Sep 17 00:00:00 2001 From: Renfei Zhou Date: Thu, 29 Oct 2026 18:06:57 +0000 Subject: [PATCH 03/12] feat(WordRAM/PriorityQueue): priority queue with handles (MinPQ) and key-value FibonacciHeap --- Complexity.lean | 2 + Complexity/Algorithms/Lean/MinPQ.lean | 522 +++++ .../WordRAM/PriorityQueue/FibonacciHeap.lean | 72 +- .../FibonacciHeap/Consolidate.lean | 190 +- .../PriorityQueue/FibonacciHeap/MinPQ.lean | 2025 +++++++++++++++++ .../PriorityQueue/FibonacciHeap/Program.lean | 21 +- .../Abstracts/FibonacciHeapTests.lean | 118 +- ComplexityTests/WordRAMFibonacciHeap.lean | 119 + .../FibonacciHeapAbstract.lean | 466 ++-- .../FibonacciHeapBridge.lean | 774 ++++--- 10 files changed, 3645 insertions(+), 664 deletions(-) create mode 100644 Complexity/Algorithms/Lean/MinPQ.lean create mode 100644 Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/MinPQ.lean diff --git a/Complexity.lean b/Complexity.lean index 5c5dbb976..11745df05 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -15,6 +15,7 @@ public import Complexity.Algorithms.Lean.FusionTree.Sketch public import Complexity.Algorithms.Lean.FusionTree.Tree public import Complexity.Algorithms.Lean.FusionTree.XorCorrection public import Complexity.Algorithms.Lean.IndexedMinPQ +public import Complexity.Algorithms.Lean.MinPQ public import Complexity.Algorithms.Lean.Queue public import Complexity.Algorithms.Lean.Retroactive public import Complexity.Algorithms.Lean.SearchTree.Basic @@ -291,6 +292,7 @@ public import Complexity.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.BasicOps public import Complexity.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.Consolidate public import Complexity.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.Cut public import Complexity.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.Forest +public import Complexity.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.MinPQ public import Complexity.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.Model public import Complexity.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.Program public import Complexity.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.Trees diff --git a/Complexity/Algorithms/Lean/MinPQ.lean b/Complexity/Algorithms/Lean/MinPQ.lean new file mode 100644 index 000000000..95b29e31c --- /dev/null +++ b/Complexity/Algorithms/Lean/MinPQ.lean @@ -0,0 +1,522 @@ +/- +Copyright (c) 2026 Renfei Zhou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Renfei Zhou +-/ + +module +-- upstream: candidate + +public import Complexity.Init +public import Complexity.Foundations.Semantics.Stateful.Relational +public import Complexity.Algorithms.Lean.IndexedMinPQ + +/-! +# Relational Priority Queue with Handles + +This module defines the pure relational specification `Cslib.Algorithms.Lean.MinPQ` of a +bounded-capacity min-priority queue storing key–value entries `(u, v)` (`u < U`, `v < V`) addressed +by handles `h : Fin n_max` allocated by the data structure. + +Unlike `Cslib.Algorithms.Lean.IndexedMinPQ`, where the caller chooses the vertex index `v : Fin n` +on `insert v k` (as required by graph algorithms such as Dijkstra's algorithm), here the caller +passes only a key–value pair `(u, v)` to `insert u v` and receives a handle `h : Fin n_max` chosen +by the data structure: + +* `insert u v` (`size s < n_max ∧ u < U ∧ v < V`): nondeterministically selects *any* unused handle + `h : Fin n_max` (`s h = none`), stores `some (u, v)` at `h`, and returns `some h`; +* `extractMin`: returns `none` when the queue is empty (`dom s = ∅`), or nondeterministically + selects *any* stored element `(u, v, h)` attaining the minimum key (`isMinEntry s h u v`), + removes `h`, and returns `some (u, v, h)`; +* `decreaseKey h u'` (`∃ u v, s h = some (u, v) ∧ u' ≤ u`): lowers the key of active handle `h` to + `u'` while preserving its satellite value `v`; +* `isEmpty` and `get h`: read-only queries returning `decide (dom s = ∅)` and `s h`. + +This module also defines the deterministic free-list handle allocator (`AllocState`, `stepAlloc`) +and proves that it refines `MinPQ.spec` while projecting to `IndexedMinPQ.spec` on keys. + +## Main definitions + +* `Cslib.Algorithms.Lean.MinPQ.State`: abstract priority-queue state `Fin n_max → Option (ℕ × ℕ)`. +* `Cslib.Algorithms.Lean.MinPQ.dom`, `size`: active handle set and current number of stored + elements. +* `Cslib.Algorithms.Lean.MinPQ.Op`, `Op.Result`: priority-queue operations and return types. +* `Cslib.Algorithms.Lean.MinPQ.isMinEntry`: predicate that a stored handle `h` attains the minimum + key in `s`. +* `Cslib.Algorithms.Lean.MinPQ.spec`: relational specification (`Stateful.RelSpec`). +* `Cslib.Algorithms.Lean.MinPQ.AllocState`, `stepAlloc`: deterministic free-list handle allocator + and lexicographic tie-breaking transition refining `spec`. + +## Main results + +* `Cslib.Algorithms.Lean.MinPQ.instTotalSpec`: `MinPQ.spec n_max U V` is total (`RelSpec.Total`). +* `Cslib.Algorithms.Lean.MinPQ.stepAlloc_refines_spec`: every valid `stepAlloc` transition satisfies + `(spec n_max U V).step`, preserves `AllocState.WellFormed`, and steps `toIndexed` via + `IndexedMinPQ.spec`. +-/ + +@[expose] public section + +namespace Cslib.Algorithms.Lean.MinPQ + +open Cslib.Stateful + +/-- Abstract state of a min-priority queue of capacity `n_max`: each handle `h : Fin n_max` is +either unused (`none`) or stores a key–value pair `some (u, v)`. -/ +abbrev State (n_max : ℕ) : Type := Fin n_max → Option (ℕ × ℕ) + +/-- Initial empty priority queue with all handles unused. -/ +def empty (n_max : ℕ) : State n_max := fun _ => none + +/-- The finite set of currently active handles in `s`. -/ +def dom {n_max : ℕ} (s : State n_max) : Finset (Fin n_max) := + Finset.univ.filter fun h => (s h).isSome + +/-- The current number of stored elements in `s`. -/ +def size {n_max : ℕ} (s : State n_max) : ℕ := + (dom s).card + +/-- Operations of a min-priority queue with handles of capacity `n_max`. -/ +inductive Op (n_max : ℕ) : Type where + /-- Test whether the priority queue currently stores no elements. -/ + | isEmpty + /-- Query the `(key, value)` pair currently stored at handle `h` (`none` if `h` is inactive). -/ + | get (h : Fin n_max) + /-- Insert a new entry with key `u` and value `v`, returning its allocated handle `some h`. -/ + | insert (u v : ℕ) + /-- Decrease the key at active handle `h` to `u'`. -/ + | decreaseKey (h : Fin n_max) (u' : ℕ) + /-- Remove and return a minimum-key entry `some (u, v, h)`, or `none` if empty. -/ + | extractMin + deriving DecidableEq + +/-- Operation return types for `Op n_max`. -/ +abbrev Op.Result {n_max : ℕ} : Op n_max → Type + | .isEmpty => Bool + | .get _ => Option (ℕ × ℕ) + | .insert _ _ => Option (Fin n_max) + | .decreaseKey _ _ => Unit + | .extractMin => Option (ℕ × ℕ × Fin n_max) + +/-! ## Domain, element count, and minimum-entry lemmas -/ + +@[simp] +theorem empty_apply (n_max : ℕ) (h : Fin n_max) : empty n_max h = none := rfl + +@[simp] +theorem mem_dom {n_max : ℕ} {s : State n_max} {h : Fin n_max} : + h ∈ dom s ↔ (s h).isSome = true := by + simp only [dom, Finset.mem_filter, Finset.mem_univ, true_and] + +theorem mem_dom_iff {n_max : ℕ} {s : State n_max} {h : Fin n_max} : + h ∈ dom s ↔ ∃ u v, s h = some (u, v) := by + rw [mem_dom, Option.isSome_iff_exists] + exact ⟨fun ⟨⟨u, v⟩, H⟩ => ⟨u, v, H⟩, fun ⟨u, v, H⟩ => ⟨(u, v), H⟩⟩ + +theorem notMem_dom_iff {n_max : ℕ} {s : State n_max} {h : Fin n_max} : + h ∉ dom s ↔ s h = none := by + rw [mem_dom, Bool.not_eq_true, Option.isSome_eq_false_iff, Option.isNone_iff_eq_none] + +@[simp] +theorem dom_empty (n_max : ℕ) : dom (empty n_max) = ∅ := by + ext h + simp only [mem_dom, empty_apply, Option.isSome_none, Bool.false_eq_true, + Finset.notMem_empty] + +@[simp] +theorem size_empty (n_max : ℕ) : size (empty n_max) = 0 := by + simp only [size, dom_empty, Finset.card_empty] + +theorem size_le {n_max : ℕ} (s : State n_max) : size s ≤ n_max := by + simpa only [size, Fintype.card_fin] using (dom s).card_le_univ + +theorem dom_eq_empty_iff {n_max : ℕ} {s : State n_max} : + dom s = ∅ ↔ ∀ h, s h = none := by + rw [Finset.eq_empty_iff_forall_notMem] + exact forall_congr' fun _ => notMem_dom_iff + +@[simp] +theorem size_eq_zero_iff {n_max : ℕ} {s : State n_max} : + size s = 0 ↔ dom s = ∅ := + Finset.card_eq_zero + +theorem dom_update_some {n_max : ℕ} (s : State n_max) (h : Fin n_max) (u v : ℕ) : + dom (Function.update s h (some (u, v))) = insert h (dom s) := by + ext x + simp only [mem_dom, Finset.mem_insert] + by_cases hxh : x = h + · subst hxh; simp only [Function.update_self, Option.isSome_some, true_or] + · simp only [Function.update_of_ne hxh, hxh, false_or] + +theorem dom_update_none {n_max : ℕ} (s : State n_max) (h : Fin n_max) : + dom (Function.update s h none) = (dom s).erase h := by + ext x + simp only [mem_dom, Finset.mem_erase] + by_cases hxh : x = h + · subst hxh + simp only [Function.update_self, Option.isSome_none, Bool.false_eq_true, ne_eq, + not_true_eq_false, false_and] + · simp only [Function.update_of_ne hxh, ne_eq, hxh, not_false_eq_true, true_and] + +theorem size_update_some_of_none {n_max : ℕ} {s : State n_max} {h : Fin n_max} + (hh : s h = none) (u v : ℕ) : + size (Function.update s h (some (u, v))) = size s + 1 := by + simp only [size, dom_update_some] + exact Finset.card_insert_of_notMem (notMem_dom_iff.mpr hh) + +theorem size_update_some_of_some {n_max : ℕ} {s : State n_max} {h : Fin n_max} {u v : ℕ} + (hh : s h = some (u, v)) (u' v' : ℕ) : + size (Function.update s h (some (u', v'))) = size s := by + simp only [size, dom_update_some] + rw [Finset.insert_eq_of_mem (mem_dom_iff.mpr ⟨u, v, hh⟩)] + +theorem size_update_none_of_some {n_max : ℕ} {s : State n_max} {h : Fin n_max} {u v : ℕ} + (hh : s h = some (u, v)) : + size (Function.update s h none) = size s - 1 := by + simp only [size, dom_update_none] + exact Finset.card_erase_of_mem (mem_dom_iff.mpr ⟨u, v, hh⟩) + +/-- If the current number of stored elements `size s` is strictly below `n_max`, at least one handle +`h : Fin n_max` is unused (`s h = none`). -/ +theorem exists_none_of_size_lt {n_max : ℕ} {s : State n_max} (h : size s < n_max) : + ∃ i : Fin n_max, s i = none := by + by_contra hall + have huniv : dom s = Finset.univ := by + ext i + simp only [mem_dom, Finset.mem_univ, iff_true, Option.isSome_iff_ne_none] + exact fun hi => hall ⟨i, hi⟩ + have hcard : size s = n_max := by + simp only [size, huniv, Finset.card_univ, Fintype.card_fin] + omega + +/-- Project a key–value priority-queue state to an `IndexedMinPQ.State n_max` by retaining only the +key at each handle. -/ +def toIndexed {n_max : ℕ} (s : State n_max) : IndexedMinPQ.State n_max := + fun h => (s h).map Prod.fst + +@[simp] +theorem toIndexed_empty (n_max : ℕ) : toIndexed (empty n_max) = IndexedMinPQ.empty n_max := + rfl + +@[simp] +theorem toIndexed_apply {n_max : ℕ} (s : State n_max) (h : Fin n_max) : + toIndexed s h = (s h).map Prod.fst := rfl + +@[simp] +theorem dom_toIndexed {n_max : ℕ} (s : State n_max) : + IndexedMinPQ.dom (toIndexed s) = dom s := by + ext h + simp only [IndexedMinPQ.dom, Finset.mem_filter, Finset.mem_univ, true_and, + mem_dom, toIndexed_apply, Option.isSome_map] + +theorem toIndexed_update_some {n_max : ℕ} (s : State n_max) (h : Fin n_max) (u v : ℕ) : + toIndexed (Function.update s h (some (u, v))) = + Function.update (toIndexed s) h (some u) := by + ext x + by_cases hxh : x = h + · subst hxh; simp only [toIndexed_apply, Function.update_self, Option.map_some] + · simp only [toIndexed_apply, Function.update_of_ne hxh] + +theorem toIndexed_update_none {n_max : ℕ} (s : State n_max) (h : Fin n_max) : + toIndexed (Function.update s h none) = Function.update (toIndexed s) h none := by + ext x + by_cases hxh : x = h + · subst hxh; simp only [toIndexed_apply, Function.update_self, Option.map_none] + · simp only [toIndexed_apply, Function.update_of_ne hxh] + +/-- Handle `h` is active in `s` with entry `(u, v)` and `u` is less than or equal to the key of +every active entry in `s`. -/ +def isMinEntry {n_max : ℕ} (s : State n_max) (h : Fin n_max) (u v : ℕ) : Prop := + s h = some (u, v) ∧ ∀ h' u' v', s h' = some (u', v') → u ≤ u' + +/-- Deterministic minimum-entry selector breaking key ties by smallest handle index via +`IndexedMinPQ.findMin (toIndexed s)`. -/ +def findMin {n_max : ℕ} (s : State n_max) : Option (ℕ × ℕ × Fin n_max) := + match IndexedMinPQ.findMin (toIndexed s) with + | none => none + | some (h, u) => + match s h with + | some (_, v) => some (u, v, h) + | none => none + +@[simp] +theorem findMin_eq_none_iff {n_max : ℕ} {s : State n_max} : + findMin s = none ↔ dom s = ∅ := by + unfold findMin + rcases hfm : IndexedMinPQ.findMin (toIndexed s) with _ | ⟨h, u⟩ + · simp only [true_iff] + rw [← dom_toIndexed, ← IndexedMinPQ.findMin_eq_none_iff] + exact hfm + · have hmem : toIndexed s h = some u := (IndexedMinPQ.findMin_eq_some_iff.mp hfm).1 + simp only [toIndexed_apply, Option.map_eq_some_iff] at hmem + obtain ⟨⟨_, v⟩, hsh, rfl⟩ := hmem + dsimp only + rw [hsh] + simp only [reduceCtorEq, false_iff] + intro hemp + have : h ∉ dom s := hemp ▸ Finset.notMem_empty h + exact this (mem_dom_iff.mpr ⟨_, v, hsh⟩) + +theorem findMin_eq_some_of_indexed {n_max : ℕ} {s : State n_max} {h : Fin n_max} {u : ℕ} + (hfm : IndexedMinPQ.findMin (toIndexed s) = some (h, u)) : + ∃ v, s h = some (u, v) ∧ findMin s = some (u, v, h) ∧ isMinEntry s h u v := by + obtain ⟨hmem, hle⟩ := IndexedMinPQ.findMin_eq_some_iff.mp hfm + simp only [toIndexed_apply, Option.map_eq_some_iff] at hmem + obtain ⟨⟨u₀, v⟩, hsh, rfl⟩ := hmem + refine ⟨v, hsh, ?_, hsh, ?_⟩ + · simp only [findMin, hfm, hsh] + · intro h' u' v' hsh' + have hidx' : toIndexed s h' = some u' := by simp only [toIndexed_apply, hsh', Option.map_some] + rcases hle h' u' hidx' with hlt | ⟨rfl, _⟩ + · exact Nat.le_of_lt hlt + · exact le_rfl + +theorem exists_isMinEntry_of_dom_ne_empty {n_max : ℕ} {s : State n_max} (hne : dom s ≠ ∅) : + ∃ h u v, isMinEntry s h u v := by + have hfm_ne : IndexedMinPQ.findMin (toIndexed s) ≠ none := by + rw [ne_eq, IndexedMinPQ.findMin_eq_none_iff, dom_toIndexed] + exact hne + obtain ⟨⟨h, u⟩, hfm⟩ := Option.ne_none_iff_exists'.mp hfm_ne + obtain ⟨v, _, _, hmin⟩ := findMin_eq_some_of_indexed hfm + exact ⟨h, u, v, hmin⟩ + +/-! ## Relational specification `MinPQ.spec` and totality -/ + +/-- Pure relational specification of a capacity-`n_max` min-priority queue with handles storing keys +`u < U` and values `v < V`: +* `insert u v` nondeterministically chooses *any* unused handle `h : Fin n_max` (`s h = none`); +* `extractMin` nondeterministically removes and returns *any* stored entry `(u, v, h)` attaining + the minimum key (`isMinEntry s h u v`), or `none` when `dom s = ∅`. -/ +def spec (n_max U V : ℕ) : RelSpec where + State := State n_max + Op := Op n_max + Result := Op.Result (n_max := n_max) + valid s + | .isEmpty => True + | .get _ => True + | .insert u v => size s < n_max ∧ u < U ∧ v < V + | .decreaseKey h u' => ∃ u v, s h = some (u, v) ∧ u' ≤ u + | .extractMin => True + step s o s' res := + match o with + | .isEmpty => s' = s ∧ res = decide (dom s = ∅) + | .get h => s' = s ∧ res = s h + | .insert u v => + ∃ h : Fin n_max, s h = none ∧ s' = Function.update s h (some (u, v)) ∧ res = some h + | .decreaseKey h u' => + ∃ u v, s h = some (u, v) ∧ s' = Function.update s h (some (u', v)) ∧ res = () + | .extractMin => + (dom s = ∅ ∧ s' = s ∧ res = none) ∨ + ∃ h u v, isMinEntry s h u v ∧ s' = Function.update s h none ∧ res = some (u, v, h) + +/-- Every admissible `MinPQ` operation has at least one valid relational transition: +`insert` finds an unused handle by pigeonhole (`exists_none_of_size_lt`), and `extractMin` on a +nonempty queue selects a minimum-key entry (`exists_isMinEntry_of_dom_ne_empty`). -/ +instance instTotalSpec (n_max U V : ℕ) : (spec n_max U V).Total where + step_total s o hv := by + cases o with + | isEmpty => exact ⟨s, decide (dom s = ∅), rfl, rfl⟩ + | get h => exact ⟨s, s h, rfl, rfl⟩ + | insert u v => + obtain ⟨h, hh⟩ := exists_none_of_size_lt hv.1 + exact ⟨Function.update s h (some (u, v)), some h, h, hh, rfl, rfl⟩ + | decreaseKey h u' => + obtain ⟨u, v, hh, _⟩ := hv + exact ⟨Function.update s h (some (u', v)), (), u, v, hh, rfl, rfl⟩ + | extractMin => + by_cases hemp : dom s = ∅ + · exact ⟨s, none, Or.inl ⟨hemp, rfl, rfl⟩⟩ + · obtain ⟨h, u, v, hmin⟩ := exists_isMinEntry_of_dom_ne_empty hemp + exact ⟨Function.update s h none, some (u, v, h), Or.inr ⟨h, u, v, hmin, rfl, rfl⟩⟩ + +/-! ## Deterministic free-list handle allocator refining `MinPQ.spec` -/ + +/-- Internal deterministic allocator state refining `State n_max`: combines the active entry map +`entries` with a LIFO recycled-handle stack `freeList` and a bump pointer `fresh ≤ n_max`. -/ +structure AllocState (n_max : ℕ) where + /-- Active key–value entries indexed by handle `h : Fin n_max`. -/ + entries : State n_max + /-- Recycled unused handles `< fresh`, ordered from top of stack (`head`) to bottom. -/ + freeList : List (Fin n_max) + /-- Bump pointer: all handles `h` with `fresh ≤ h.val` are unused and absent from `freeList`. -/ + fresh : ℕ + +/-- Initial empty allocator state (`entries = empty n_max`, `freeList = []`, `fresh = 0`). -/ +def AllocState.empty (n_max : ℕ) : AllocState n_max := + ⟨MinPQ.empty n_max, [], 0⟩ + +/-- Invariant of the free-list + bump-pointer handle allocator: +1. `s.fresh ≤ n_max`; +2. `s.freeList.Nodup`; +3. every `h ∈ s.freeList` has `h.val < s.fresh` and `s.entries h = none`; +4. every `h : Fin n_max` with `s.fresh ≤ h.val` has `s.entries h = none`; +5. `size s.entries + s.freeList.length = s.fresh`. -/ +def AllocState.WellFormed {n_max : ℕ} (s : AllocState n_max) : Prop := + s.fresh ≤ n_max ∧ + s.freeList.Nodup ∧ + (∀ h ∈ s.freeList, h.val < s.fresh ∧ s.entries h = none) ∧ + (∀ h : Fin n_max, s.fresh ≤ h.val → s.entries h = none) ∧ + size s.entries + s.freeList.length = s.fresh + +theorem AllocState.wellFormed_empty (n_max : ℕ) : (AllocState.empty n_max).WellFormed := + ⟨Nat.zero_le _, List.nodup_nil, fun _ h => absurd h List.not_mem_nil, + fun _ _ => rfl, by simp only [AllocState.empty, size_empty, List.length_nil, Nat.add_zero]⟩ + +/-- Deterministic handle allocation: pops the head of `s.freeList` when nonempty, or allocates the +bump-pointer handle `⟨s.fresh, _⟩` and increments `fresh` when `s.freeList = []` and +`s.fresh < n_max`. -/ +def allocHandle {n_max : ℕ} (s : AllocState n_max) : + Option (Fin n_max × List (Fin n_max) × ℕ) := + match s.freeList with + | h :: tl => some (h, tl, s.fresh) + | [] => + if hlt : s.fresh < n_max then + some (⟨s.fresh, hlt⟩, [], s.fresh + 1) + else + none + +/-- Deterministic transition on `AllocState n_max` using `allocHandle` for `insert` and +`IndexedMinPQ.findMin (toIndexed s.entries)` (lexicographic `(key, handle)` tie-breaking) for +`extractMin`. -/ +def stepAlloc {n_max : ℕ} (s : AllocState n_max) (o : Op n_max) : + AllocState n_max × o.Result := + match o with + | .isEmpty => (s, decide (dom s.entries = ∅)) + | .get h => (s, s.entries h) + | .insert u v => + match allocHandle s with + | some (h, freeList', fresh') => + (⟨Function.update s.entries h (some (u, v)), freeList', fresh'⟩, some h) + | none => (s, none) + | .decreaseKey h u' => + match s.entries h with + | some (_, v) => (⟨Function.update s.entries h (some (u', v)), s.freeList, s.fresh⟩, ()) + | none => (s, ()) + | .extractMin => + match IndexedMinPQ.findMin (toIndexed s.entries) with + | none => (s, none) + | some (h, u) => + match s.entries h with + | some (_, v) => + (⟨Function.update s.entries h none, h :: s.freeList, s.fresh⟩, some (u, v, h)) + | none => (s, none) + +/-- On any well-formed `AllocState` with `size s.entries < n_max`, `allocHandle s` succeeds, +returns an unused handle `h` (`s.entries h = none`), and preserves `AllocState.WellFormed` after +storing `some (u, v)` at `h`. -/ +theorem allocHandle_spec {n_max : ℕ} {s : AllocState n_max} + (hwf : s.WellFormed) (hsz : size s.entries < n_max) (u v : ℕ) : + ∃ h freeList' fresh', + allocHandle s = some (h, freeList', fresh') ∧ + s.entries h = none ∧ + (AllocState.mk (Function.update s.entries h (some (u, v))) freeList' fresh').WellFormed := by + obtain ⟨hfr_le, hnd, hfree, hbump, hsum⟩ := hwf + rcases hfl : s.freeList with _ | ⟨h, tl⟩ + · have hfr_lt : s.fresh < n_max := by + rw [hfl, List.length_nil, Nat.add_zero] at hsum + omega + let hfin : Fin n_max := ⟨s.fresh, hfr_lt⟩ + have hh_none : s.entries hfin = none := hbump hfin le_rfl + refine ⟨hfin, [], s.fresh + 1, ?_, hh_none, ?_⟩ + · simp only [allocHandle, hfl, hfr_lt, ↓reduceDIte, hfin] + · dsimp only [AllocState.WellFormed] + refine ⟨by omega, List.nodup_nil, fun _ hm => absurd hm List.not_mem_nil, ?_, ?_⟩ + · intro x hx + have hxh : x ≠ hfin := fun e => by subst e; change s.fresh + 1 ≤ s.fresh at hx; omega + rw [Function.update_of_ne hxh] + exact hbump x (by omega) + · rw [size_update_some_of_none hh_none, List.length_nil, Nat.add_zero] + rw [hfl, List.length_nil, Nat.add_zero] at hsum + omega + · have hh_mem : h ∈ s.freeList := hfl ▸ List.mem_cons_self + obtain ⟨hh_lt, hh_none⟩ := hfree h hh_mem + obtain ⟨hh_not_tl, htl_nd⟩ := List.nodup_cons.mp (hfl ▸ hnd) + refine ⟨h, tl, s.fresh, ?_, hh_none, ?_⟩ + · simp only [allocHandle, hfl] + · dsimp only [AllocState.WellFormed] + refine ⟨hfr_le, htl_nd, ?_, ?_, ?_⟩ + · intro x hx + have hxh : x ≠ h := fun e => hh_not_tl (e ▸ hx) + have hx_mem : x ∈ s.freeList := hfl ▸ List.mem_cons_of_mem h hx + exact ⟨(hfree x hx_mem).1, by rw [Function.update_of_ne hxh]; exact (hfree x hx_mem).2⟩ + · intro x hx + have hxh : x ≠ h := fun e => by subst e; omega + rw [Function.update_of_ne hxh] + exact hbump x hx + · rw [size_update_some_of_none hh_none] + rw [hfl, List.length_cons] at hsum + omega + +/-- Every valid operation on a well-formed `AllocState` stepped by `stepAlloc`: +1. satisfies the relational transition `(spec n_max U V).step s.entries o (stepAlloc s o).1.entries + (stepAlloc s o).2`, and +2. preserves `AllocState.WellFormed`. -/ +theorem stepAlloc_refines_spec {n_max U V : ℕ} {s : AllocState n_max} (hwf : s.WellFormed) + (o : Op n_max) (hv : (spec n_max U V).valid s.entries o) : + (spec n_max U V).step s.entries o (stepAlloc s o).1.entries (stepAlloc s o).2 ∧ + (stepAlloc s o).1.WellFormed := by + cases o with + | isEmpty => + exact ⟨⟨rfl, rfl⟩, hwf⟩ + | get h => + exact ⟨⟨rfl, rfl⟩, hwf⟩ + | insert u v => + obtain ⟨h, freeList', fresh', halloc, hh_none, hwf'⟩ := allocHandle_spec hwf hv.1 u v + simp only [stepAlloc, halloc] + exact ⟨⟨h, hh_none, rfl, rfl⟩, hwf'⟩ + | decreaseKey h u' => + obtain ⟨u, v, hsh, _⟩ := hv + obtain ⟨hfr_le, hnd, hfree, hbump, hsum⟩ := hwf + simp only [stepAlloc, hsh] + dsimp only [AllocState.WellFormed] + refine ⟨⟨u, v, hsh, rfl, rfl⟩, hfr_le, hnd, ?_, ?_, ?_⟩ + · intro x hx + have hxh : x ≠ h := fun e => by + subst e + rw [(hfree x hx).2] at hsh + cases hsh + exact ⟨(hfree x hx).1, by rw [Function.update_of_ne hxh]; exact (hfree x hx).2⟩ + · intro x hx + have hxh : x ≠ h := fun e => by + subst e + rw [hbump x hx] at hsh + cases hsh + rw [Function.update_of_ne hxh] + exact hbump x hx + · rw [size_update_some_of_some hsh] + exact hsum + | extractMin => + obtain ⟨hfr_le, hnd, hfree, hbump, hsum⟩ := hwf + rcases hfm : IndexedMinPQ.findMin (toIndexed s.entries) with _ | ⟨h, u⟩ + · have hemp : dom s.entries = ∅ := by + rw [← dom_toIndexed, ← IndexedMinPQ.findMin_eq_none_iff] + exact hfm + simp only [stepAlloc, hfm] + exact ⟨Or.inl ⟨hemp, rfl, rfl⟩, hfr_le, hnd, hfree, hbump, hsum⟩ + · obtain ⟨v, hsh, _, hmin⟩ := findMin_eq_some_of_indexed hfm + simp only [stepAlloc, hfm, hsh] + have hh_not_free : h ∉ s.freeList := fun hm => by + rw [(hfree h hm).2] at hsh + cases hsh + have hh_lt : h.val < s.fresh := by + by_contra hge + rw [hbump h (Nat.le_of_not_lt hge)] at hsh + cases hsh + have hsz_pos : 1 ≤ size s.entries := + Finset.card_pos.mpr ⟨h, mem_dom_iff.mpr ⟨u, v, hsh⟩⟩ + dsimp only [AllocState.WellFormed] + refine ⟨Or.inr ⟨h, u, v, hmin, rfl, rfl⟩, + hfr_le, List.nodup_cons.mpr ⟨hh_not_free, hnd⟩, ?_, ?_, ?_⟩ + · intro x hx + rcases List.mem_cons.mp hx with rfl | hx_tl + · exact ⟨hh_lt, Function.update_self _ _ _⟩ + · have hxh : x ≠ h := fun e => hh_not_free (e ▸ hx_tl) + exact ⟨(hfree x hx_tl).1, by rw [Function.update_of_ne hxh]; exact (hfree x hx_tl).2⟩ + · intro x hx + have hxh : x ≠ h := fun e => by subst e; omega + rw [Function.update_of_ne hxh] + exact hbump x hx + · rw [size_update_none_of_some hsh, List.length_cons] + omega + +end Cslib.Algorithms.Lean.MinPQ diff --git a/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap.lean b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap.lean index 4ecef9d46..cbc2f189c 100644 --- a/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap.lean +++ b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap.lean @@ -10,36 +10,45 @@ module public import Complexity.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.BasicOps public import Complexity.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.Cut public import Complexity.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.Consolidate +public import Complexity.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.MinPQ /-! # Static-array Word-RAM Fibonacci heap This file assembles the standalone static-array Word-RAM Fibonacci heap [Fredman and Tarjan][FredmanTarjan1987] [Cormen et al., Chapter 19][CLRS2009] over -`Cslib.WordRAM.Basis.exact` (and lifted to `Basis.standard`) for -`Cslib.Algorithms.Lean.IndexedMinPQ.spec`. +`Cslib.WordRAM.Basis.exact` (and lifted to `Basis.standard`) for both: -Over `n` vertex handles in a contiguous memory block `[base, base + 9 * n + 1)` with concrete -integer potential `potential x = 80 * (numRoots + 2 * numMarked)` (`initPotential = 0`, +* the fixed-vertex priority queue `Cslib.Algorithms.Lean.IndexedMinPQ.spec` (used by graph + algorithms such as Dijkstra's algorithm), in `9 * n + 1` words at `[base, base + 9 * n + 1)`; and +* the relational key–value priority queue with handles `Cslib.Algorithms.Lean.MinPQ.spec` (where + `insert u v` allocates and returns a handle `h : Fin n_max`), in `11 * n_max + 1` words at + `[base, base + 11 * n_max + 1)` under the `FibonacciHeap.MinPQ` namespace (and top-level aliases + `relSubroutineDS`, `relDynamicProgram`, `relCertificate`, `relAmortized`). + +Over capacity `n` (`n_max`) with concrete integer potential +`potential x = 80 * (numRoots + 2 * numMarked)` (`initPotential = 0`, [Fredman and Tarjan][FredmanTarjan1987], Section 2, p. 604 (the potential defined before Theorem 1); [Cormen et al.][CLRS2009], Section 19.1, eq. (19.1)): -* `initFresh` initializes an empty heap on zeroed `[base, base + 9 * n + 1)` in `O(1)` (`≤ 26`) +* `initFresh` initializes an empty heap on zeroed memory in `O(1)` instructions; +* `initClear` initializes an empty heap on arbitrary dirty `w`-bit memory in `O(n + 1)` instructions; -* `initClear` initializes an empty heap on arbitrary dirty `[base, base + 9 * n + 1)` in `O(n)` - (`≤ 36 * n + 36`) instructions; -* `isEmpty` and `getKey` run in `O(1)` worst-case time (`≤ 12` and `≤ 16` instructions); -* `insert` and `decreaseKey` (with cascading cuts) run in `O(1)` amortized time (`≤ 130` and - `≤ 340` instructions); -* `extractMin` (with degree-table consolidation and deterministic lexicographic `(key, handle)` - tie-breaking) runs in `O(log n)` amortized time (`≤ 420 * (Nat.log 2 n + 1)` instructions). +* `isEmpty` and `getKey` / `get` run in `O(1)` worst-case time; +* `insert` and `decreaseKey` (with cascading cuts) run in `O(1)` amortized time; +* `extractMin` (with degree-table consolidation) runs in `O(log |s| + 1)` amortized time where + `|s|` is the current number of stored elements (`(IndexedMinPQ.dom s).card` or `MinPQ.size s`). ## Main definitions * `Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.subroutineDS`: `SubroutineDS` certificate - over `Basis.exact`. + over `Basis.exact` for `IndexedMinPQ.spec`. * `Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.pkg`, `pkgStd`: `PQPackage` bundles over `Basis.exact` and `Basis.standard` for plug-and-play graph algorithms (such as Dijkstra). +* `Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.relSubroutineDS`, + `relDynamicProgram`, `relCertificate`, `MinPQ.run_ops_exact_fresh`, + `MinPQ.run_ops_exact_reusable`: `RelSubroutineDS` and flat-program realizations of the key–value + Fibonacci heap with handles (`Cslib.Algorithms.Lean.MinPQ.spec`). * `Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.initFreshProg`, `initClearProg`, `opProg`, `initRegs`, `prepareRegs`, `RunsOps`: compiled flat `Program .exact rFib` artifacts, register calling conventions, and sequential execution predicate for standalone multi-operation execution. @@ -186,7 +195,7 @@ def pkg : PQPackage .exact rFib where charge_getKey _ _ _ _ := le_rfl charge_insert _ _ _ _ _ := le_rfl charge_decreaseKey _ _ _ _ _ := le_rfl - charge_extractMin _ _ _ := le_rfl + charge_extractMin _ _ s := charge_extractMin_le_tExt _ s /-- Parametric `PQPackage .standard rFib` bundle lifted to `Basis.standard`. -/ abbrev pkgStd : PQPackage .standard rFib := pkg.toStandard @@ -337,10 +346,11 @@ private theorem seq_runsOps {n K_max w base : ℕ} (hS : Fits w (base + space n) step_program_halt dispatchCode outFlag y obtain ⟨z, rest, hrest, hinv_z, hpot_rest⟩ := seq_runsOps hS hK ops hinv_y hv_ops refine ⟨z, (m + 1) + rest, .cons hruns ⟨_, hhalt⟩ hdec hmod hrest, hinv_z, ?_⟩ + have hce := charge_extractMin_le_tExt n s cases o <;> simp only [charge, tEmpty, tGet, tIns, tDec, tExt, numQueries, numInserts, numDecreaseKeys, numExtractMins, - Nat.add_mul, Nat.one_mul] at hpot_m ⊢ <;> + Nat.add_mul, Nat.one_mul] at hce hpot_m ⊢ <;> omega private theorem initRegs_bounded {n base w : ℕ} (hS : Fits w (base + space n)) @@ -425,4 +435,36 @@ theorem run_ops_exact_reusable {n K_max w base : ℕ} (hS : Fits w (base + space · change potential x₀ ≤ 0 at hpot₀ omega +/-! ## Top-level aliases for the key–value priority-queue realization (`MinPQ`) -/ + +/-- `RelSubroutineDS` certificate for the key–value Fibonacci heap with handles (`MinPQ.spec`). -/ +abbrev relSubroutineDS {n_max U V w base : ℕ} + (hS : Fits w (base + MinPQ.space n_max)) (hU : Fits w U) (hV : Fits w V) : + RelSubroutineDS MinPQ.subroutineCode (Cslib.Algorithms.Lean.MinPQ.spec n_max U V) w base + ![n_max] (Cslib.Algorithms.Lean.MinPQ.empty n_max) := + MinPQ.relSubroutineDS hS hU hV + +/-- Standalone `RelDynamicProgram` for the key–value Fibonacci heap with handles (`MinPQ.spec`). -/ +abbrev relDynamicProgram {n_max U V w base : ℕ} + (hS : Fits w (base + MinPQ.space n_max)) (hU : Fits w U) (hV : Fits w V) : + RelDynamicProgram (Cslib.Algorithms.Lean.MinPQ.spec n_max U V) MinPQ.rMinPQ := + MinPQ.relDynamicProgram hS hU hV + +/-- Standalone `RelDynamicCertificate` for the key–value Fibonacci heap with handles +(`MinPQ.spec`). -/ +abbrev relCertificate {n_max U V w base : ℕ} + (hS : Fits w (base + MinPQ.space n_max)) (hU : Fits w U) (hV : Fits w V) : + RelDynamicCertificate (relDynamicProgram hS hU hV) w := + MinPQ.relCertificate hS hU hV + +/-- Standalone `Stateful.RelAmortized` theorem for the key–value Fibonacci heap with handles +(`MinPQ.spec`). -/ +theorem relAmortized {n_max U V w base : ℕ} + (hS : Fits w (base + MinPQ.space n_max)) (hU : Fits w U) (hV : Fits w V) : + Stateful.RelAmortized (relCertificate hS hU hV).realization + DynamicProgram.OperationTrace.instructions + (fun _ x => MinPQ.potential x) + (fun s o => MinPQ.charge n_max s o + 1) := + MinPQ.relAmortized hS hU hV + end Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap diff --git a/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/Consolidate.lean b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/Consolidate.lean index fbc84d4b1..62be02efe 100644 --- a/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/Consolidate.lean +++ b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/Consolidate.lean @@ -144,18 +144,18 @@ private theorem length_eraseIdx_add_one {α : Type*} : /-! ## Consolidation table invariant `SlotInv` -/ /-- Invariant for the degree consolidation table `st.cons` holding `slotTrees` within -`0 .. maxDeg`. -/ -def SlotInv (n : ℕ) (st : RawState n) (slotTrees : List (FHTree n)) (maxDeg : ℕ) : Prop := +`0 .. maxDeg`, where `sz` bounds the total number of nodes being consolidated. -/ +def SlotInv (n sz : ℕ) (st : RawState n) (slotTrees : List (FHTree n)) (maxDeg : ℕ) : Prop := (slotTrees.map FHTree.deg).Nodup ∧ (∀ T ∈ slotTrees, ValidRoot st none T ∧ T.deg ≤ maxDeg) ∧ (∀ T ∈ slotTrees, st.cons T.deg = T.root.val + 1) ∧ (∀ d ≤ n, (∀ T ∈ slotTrees, T.deg ≠ d) → st.cons d = 0) ∧ - maxDeg ≤ 2 * Nat.log 2 n + 1 ∧ + maxDeg ≤ 2 * Nat.log 2 sz + 1 ∧ (maxDeg = 0 ∨ maxDeg + 2 ≤ n) /-- Initial empty consolidation table when `∀ d ≤ n, st.cons d = 0`. -/ -theorem SlotInv.empty {n : ℕ} {st : RawState n} (hcons : ∀ d ≤ n, st.cons d = 0) : - SlotInv n st [] 0 := +theorem SlotInv.empty {n sz : ℕ} {st : RawState n} (hcons : ∀ d ≤ n, st.cons d = 0) : + SlotInv n sz st [] 0 := ⟨List.nodup_nil, fun _ h => absurd h List.not_mem_nil, fun _ h => absurd h List.not_mem_nil, @@ -163,11 +163,11 @@ theorem SlotInv.empty {n : ℕ} {st : RawState n} (hcons : ∀ d ≤ n, st.cons by omega, Or.inl rfl⟩ /-- Framing `SlotInv` across a transition preserving `cons` and `ValidRoot` on `slotTrees`. -/ -theorem SlotInv.frame {n maxDeg : ℕ} {st st' : RawState n} {slotTrees : List (FHTree n)} - (hs : SlotInv n st slotTrees maxDeg) +theorem SlotInv.frame {n sz maxDeg : ℕ} {st st' : RawState n} {slotTrees : List (FHTree n)} + (hs : SlotInv n sz st slotTrees maxDeg) (hcons : st'.cons = st.cons) (hvalid : ∀ T ∈ slotTrees, ValidRoot st' none T) : - SlotInv n st' slotTrees maxDeg := by + SlotInv n sz st' slotTrees maxDeg := by obtain ⟨hnd, htr, hhit, hemp, hmd1, hmd2⟩ := hs exact ⟨hnd, fun T hT => ⟨hvalid T hT, (htr T hT).2⟩, @@ -178,8 +178,8 @@ theorem SlotInv.frame {n maxDeg : ℕ} {st st' : RawState n} {slotTrees : List ( /-- Lookup in `st.cons d` (`d ≤ n`): either `st.cons d = 0` and no tree in `slotTrees` has degree `d`, or a unique index `i < slotTrees.length` has `(slotTrees[i]).deg = d` and `st.cons d = (slotTrees[i]).root.val + 1`. -/ -theorem SlotInv.lookup {n maxDeg : ℕ} {st : RawState n} {slotTrees : List (FHTree n)} - (hs : SlotInv n st slotTrees maxDeg) {d : ℕ} (hd : d ≤ n) : +theorem SlotInv.lookup {n sz maxDeg : ℕ} {st : RawState n} {slotTrees : List (FHTree n)} + (hs : SlotInv n sz st slotTrees maxDeg) {d : ℕ} (hd : d ≤ n) : (st.cons d = 0 ∧ ∀ T ∈ slotTrees, T.deg ≠ d) ∨ ∃ (i : ℕ) (hi : i < slotTrees.length), (slotTrees[i]).deg = d ∧ @@ -221,13 +221,13 @@ private theorem getElem_mem_eraseIdx_of_ne {α : Type*} : fun e => hki (congrArg Nat.succ e)) /-- Clearing slot `d = (slotTrees[i]).deg` (`d ≤ n`) removes `slotTrees[i]` from `SlotInv`. -/ -theorem SlotInv.step_collision {n maxDeg : ℕ} {st st' : RawState n} {slotTrees : List (FHTree n)} - (hs : SlotInv n st slotTrees maxDeg) {i d : ℕ} (hi : i < slotTrees.length) +theorem SlotInv.step_collision {n sz maxDeg : ℕ} {st st' : RawState n} {slotTrees : List (FHTree n)} + (hs : SlotInv n sz st slotTrees maxDeg) {i d : ℕ} (hi : i < slotTrees.length) (hdeg_i : (slotTrees[i]).deg = d) (_hd : d ≤ n) (hno_other : ∀ R ∈ slotTrees.eraseIdx i, R.deg ≠ d) (hcons' : st'.cons = Function.update st.cons d 0) (hvalid' : ∀ R ∈ slotTrees.eraseIdx i, ValidRoot st' none R) : - SlotInv n st' (slotTrees.eraseIdx i) maxDeg := by + SlotInv n sz st' (slotTrees.eraseIdx i) maxDeg := by obtain ⟨hnd, htr, hhit, hemp, hmd1, hmd2⟩ := hs refine ⟨by rw [map_eraseIdx_eq]; exact nodup_eraseIdx i hnd, ?_, ?_, ?_, hmd1, hmd2⟩ · intro R hR @@ -250,13 +250,13 @@ theorem SlotInv.step_collision {n maxDeg : ℕ} {st st' : RawState n} {slotTrees /-- Storing a consolidated tree `T_cur` of unoccupied degree `d` into `st.cons d` and updating `maxDeg` to `max maxDeg d` inserts `T_cur` into `SlotInv`. -/ -theorem SlotInv.insert_empty {n maxDeg : ℕ} {st : RawState n} {slotTrees : List (FHTree n)} - (hs : SlotInv n st slotTrees maxDeg) {T_cur : FHTree n} {d : ℕ} - (_hd_n : d + 2 ≤ n) (hd_log : d ≤ 2 * Nat.log 2 n + 1) +theorem SlotInv.insert_empty {n sz maxDeg : ℕ} {st : RawState n} {slotTrees : List (FHTree n)} + (hs : SlotInv n sz st slotTrees maxDeg) {T_cur : FHTree n} {d : ℕ} + (_hd_n : d + 2 ≤ n) (hd_log : d ≤ 2 * Nat.log 2 sz + 1) (hT_deg : T_cur.deg = d) (hnone : ∀ R ∈ slotTrees, R.deg ≠ d) (hT_valid : ValidRoot st none T_cur) : - SlotInv n { st with cons := Function.update st.cons d (T_cur.root.val + 1) } + SlotInv n sz { st with cons := Function.update st.cons d (T_cur.root.val + 1) } (T_cur :: slotTrees) (max maxDeg d) := by obtain ⟨hnd, htr, hhit, hemp, hmd1, _⟩ := hs let st' : RawState n := { st with cons := Function.update st.cons d (T_cur.root.val + 1) } @@ -287,8 +287,8 @@ theorem SlotInv.insert_empty {n maxDeg : ℕ} {st : RawState n} {slotTrees : Lis /-- Once every degree `< maxDeg + 1` has been cleared from `SlotInv`, `slotTrees = []` and all entries `st.cons d` (`d ≤ n`) are `0`. -/ -theorem SlotInv.done_of_cleared {n maxDeg : ℕ} {st : RawState n} {slotTrees : List (FHTree n)} - (hs : SlotInv n st slotTrees maxDeg) +theorem SlotInv.done_of_cleared {n sz maxDeg : ℕ} {st : RawState n} {slotTrees : List (FHTree n)} + (hs : SlotInv n sz st slotTrees maxDeg) (hcleared : ∀ d < maxDeg + 1, ∀ T ∈ slotTrees, T.deg ≠ d) : slotTrees = [] ∧ ∀ d ≤ n, st.cons d = 0 := by obtain ⟨_, htr, _, hemp, _, _⟩ := hs @@ -357,12 +357,12 @@ private abbrev scatterBody : Code .exact rFib := `T_slot` (`s5`) under `IndexedMinPQ.PrioLT`, links the loser as newest child of the winner via `ValidRoot.link`, advances `curD` to `curD + 1`, and decreases `slotTrees.length` by `1` in `≤ 43` steps. -/ -private theorem scatterBody_exec {n base w maxDeg curD : ℕ} {a : Data rFib} +private theorem scatterBody_exec {n sz base w maxDeg curD : ℕ} {a : Data rFib} {T_cur : FHTree n} {slotTrees : List (FHTree n)} {otherNodes : List (Fin n)} {z : Fin n} (hb : a.Bounded w) (hbr : BaseRegs n base a) (hz_mem : z ∈ otherNodes) (hnd : (T_cur.nodes ++ (forestNodes slotTrees ++ otherNodes)).Nodup) - (hs : SlotInv n (RawState.ofData n base a) slotTrees maxDeg) + (hs : SlotInv n sz (RawState.ofData n base a) slotTrees maxDeg) (hT_cur : ValidRoot (RawState.ofData n base a) none T_cur) (hcur_deg : T_cur.deg = curD) (ha_s4 : a.regs s4 = T_cur.root.val) @@ -379,7 +379,7 @@ private theorem scatterBody_exec {n base w maxDeg curD : ℕ} {a : Data rFib} slotTrees'.length + 1 = slotTrees.length ∧ (T_next.nodes ++ forestNodes slotTrees').Perm (T_cur.nodes ++ forestNodes slotTrees) ∧ (T_next.nodes ++ (forestNodes slotTrees' ++ otherNodes)).Nodup ∧ - SlotInv n (RawState.ofData n base a') slotTrees' maxDeg ∧ + SlotInv n sz (RawState.ofData n base a') slotTrees' maxDeg ∧ ValidRoot (RawState.ofData n base a') none T_next ∧ T_next.deg = curD + 1 ∧ a'.regs s4 = T_next.root.val ∧ @@ -1155,7 +1155,7 @@ private theorem scatterBody_exec {n base w maxDeg curD : ℕ} {a : Data rFib} exact ((hperm12.append_right (forestNodes slotTrees' ++ otherNodes)).nodup_iff).mpr hnd_assoc have hdisj_ro : ∀ u ∈ forestNodes slotTrees' ++ otherNodes, u ∉ T₁.nodes ++ T₂.nodes := fun u hu hm => (List.nodup_append.mp (hT_next_nodes ▸ hnd_next)).2.2 u hm u hu rfl - have hs6 : SlotInv n (RawState.ofData n base a6) slotTrees' maxDeg := by + have hs6 : SlotInv n sz (RawState.ofData n base a6) slotTrees' maxDeg := by rw [hst6] refine hs.step_collision hidx hslot_deg hd_le_n hno_other hco5 fun R hR => ?_ obtain ⟨j, hj, _, hR_eq⟩ := List.mem_eraseIdx_iff_getElem.mp hR @@ -1196,13 +1196,13 @@ private theorem scatterBody_exec {n base w maxDeg curD : ℕ} {a : Data rFib} /-- Full `while zeroP < s3 do scatterBody` loop by induction on `slotTrees.length`: terminates at an unoccupied degree slot `curD_f` in `t + 50 * slotTrees_f.length ≤ 2 + 50 * slotTrees.length` instructions. -/ -private theorem scatterLoop_exec {n base w maxDeg : ℕ} {otherNodes : List (Fin n)} {z : Fin n} +private theorem scatterLoop_exec {n sz base w maxDeg : ℕ} {otherNodes : List (Fin n)} {z : Fin n} (hz_mem : z ∈ otherNodes) : ∀ (k : ℕ) {a : Data rFib} {T_cur : FHTree n} {slotTrees : List (FHTree n)} {curD : ℕ}, slotTrees.length = k → a.Bounded w → BaseRegs n base a → (T_cur.nodes ++ (forestNodes slotTrees ++ otherNodes)).Nodup → - SlotInv n (RawState.ofData n base a) slotTrees maxDeg → + SlotInv n sz (RawState.ofData n base a) slotTrees maxDeg → ValidRoot (RawState.ofData n base a) none T_cur → T_cur.deg = curD → a.regs s4 = T_cur.root.val → @@ -1219,7 +1219,7 @@ private theorem scatterLoop_exec {n base w maxDeg : ℕ} {otherNodes : List (Fin z_lp.regs maxDegReg = maxDeg ∧ (T_f.nodes ++ forestNodes slotTrees_f).Perm (T_cur.nodes ++ forestNodes slotTrees) ∧ (T_f.nodes ++ (forestNodes slotTrees_f ++ otherNodes)).Nodup ∧ - SlotInv n (RawState.ofData n base z_lp) slotTrees_f maxDeg ∧ + SlotInv n sz (RawState.ofData n base z_lp) slotTrees_f maxDeg ∧ ValidRoot (RawState.ofData n base z_lp) none T_f ∧ T_f.deg = curD_f ∧ z_lp.regs s4 = T_f.root.val ∧ @@ -1274,12 +1274,13 @@ private theorem scatterLoop_exec {n base w maxDeg : ℕ} {otherNodes : List (Fin /-- `scatterRootCode` inserts root `T₀` (`iterCur = T₀.root.val`) into `cons`, linking equal-degree roots and updating `maxDegReg` in `t + 50 * slotTrees'.length ≤ 63 + 50 * slotTrees₀.length` instructions while preserving all registers `< 33` and framing `otherNodes`. -/ -theorem scatterRootCode_exec {n base w maxDeg₀ : ℕ} {x : Data rFib} +theorem scatterRootCode_exec {n sz base w maxDeg₀ : ℕ} {x : Data rFib} {T₀ : FHTree n} {slotTrees₀ : List (FHTree n)} {otherNodes : List (Fin n)} {z : Fin n} (hb : x.Bounded w) (hbr : BaseRegs n base x) (hz_mem : z ∈ otherNodes) (hnd : (T₀.nodes ++ (forestNodes slotTrees₀ ++ otherNodes)).Nodup) - (hs : SlotInv n (RawState.ofData n base x) slotTrees₀ maxDeg₀) + (hsz : (T₀.nodes ++ (forestNodes slotTrees₀ ++ otherNodes)).length ≤ sz) + (hs : SlotInv n sz (RawState.ofData n base x) slotTrees₀ maxDeg₀) (hT₀ : ValidRoot (RawState.ofData n base x) none T₀) (hx_ic : x.regs iterCur = T₀.root.val) (hx_md : x.regs maxDegReg = maxDeg₀) : @@ -1292,7 +1293,7 @@ theorem scatterRootCode_exec {n base w maxDeg₀ : ℕ} {x : Data rFib} y.regs maxDegReg = maxDeg' ∧ (forestNodes slotTrees').Perm (T₀.nodes ++ forestNodes slotTrees₀) ∧ (forestNodes slotTrees' ++ otherNodes).Nodup ∧ - SlotInv n (RawState.ofData n base y) slotTrees' maxDeg' ∧ + SlotInv n sz (RawState.ofData n base y) slotTrees' maxDeg' ∧ (let st := RawState.ofData n base x let st' := RawState.ofData n base y st'.key = st.key ∧ st'.mark = st.mark ∧ st'.inHeap = st.inHeap ∧ @@ -1507,7 +1508,15 @@ theorem scatterRootCode_exec {n base w maxDeg₀ : ℕ} {x : Data rFib} Function.update_of_ne ne_cd, Function.update_of_ne ne4] · simpa only [forestNodes, List.append_assoc] using hnd_lp · rw [hsty, hst_z2] - exact hs_lp.insert_empty hdf_bds.2 hdf_bds.1 hdeg_f hnone_f hTf + have hTf_sz : T_f.size ≤ sz := by + have hp_len := (hperm_lp.append_right otherNodes).length_eq + simp only [List.length_append] at hp_len hsz + unfold FHTree.size + omega + have hdf_log : curD_f ≤ 2 * Nat.log 2 sz + 1 := by + rw [← hdeg_f] + exact (hTf.1.deg_bounds hTf_sz).1 + exact hs_lp.insert_empty hdf_bds.2 hdf_log hdeg_f hnone_f hTf · dsimp only rw [hsty, hst_z2] exact ⟨hk_lp, hmk_lp, hin_lp, hmin_lp, hnr_lp, hnm_lp, hsz_lp, ho_lp⟩ @@ -1565,14 +1574,15 @@ private abbrev childScatterLoop : Code .exact rFib := /-- Phase A1 loop: detaches each child in `c_trees` along `c_order`, clears its `par` and `mark` (decrementing `numMarkedReg` when marked), and scatters it into `cons`. -/ -private theorem scatterChildrenLoop_exec {n base w : ℕ} +private theorem scatterChildrenLoop_exec {n sz base w : ℕ} (c_order : List (Fin n)) : ∀ (a : Data rFib) (c_trees slotTrees : List (FHTree n)) (fixedNodes : List (Fin n)) (z : Fin n) (maxDeg : ℕ), a.Bounded w → BaseRegs n base a → z ∈ fixedNodes → (forestNodes c_trees ++ (forestNodes slotTrees ++ fixedNodes)).Nodup → - SlotInv n (RawState.ofData n base a) slotTrees maxDeg → + (forestNodes c_trees ++ (forestNodes slotTrees ++ fixedNodes)).length ≤ sz → + SlotInv n sz (RawState.ofData n base a) slotTrees maxDeg → (∀ c ∈ c_trees, ValidSubtree (RawState.ofData n base a) none c) → c_order.Perm (c_trees.map FHTree.root) → RightChain (RawState.ofData n base a).right c_order → @@ -1590,7 +1600,7 @@ private theorem scatterChildrenLoop_exec {n base w : ℕ} b.regs maxDegReg = maxDeg' ∧ (forestNodes slotTrees').Perm (forestNodes c_trees ++ forestNodes slotTrees) ∧ (forestNodes slotTrees' ++ fixedNodes).Nodup ∧ - SlotInv n (RawState.ofData n base b) slotTrees' maxDeg' ∧ + SlotInv n sz (RawState.ofData n base b) slotTrees' maxDeg' ∧ (let st := RawState.ofData n base a let st' := RawState.ofData n base b st'.key = st.key ∧ st'.inHeap = st.inHeap ∧ @@ -1602,7 +1612,7 @@ private theorem scatterChildrenLoop_exec {n base w : ℕ} st'.deg v = st.deg v ∧ st'.mark v = st.mark v) := by induction c_order with | nil => - intro a c_trees slotTrees fixedNodes z maxDeg hb hbr _ hnd hs _ hperm _ hrem hmd hnm _ + intro a c_trees slotTrees fixedNodes z maxDeg hb hbr _ hnd _ hs _ hperm _ hrem hmd hnm _ have hz0 : a.regs zeroP = 0 := hbr.2.2.2.2.2.2.2.2.2.2.2.1 have hc : ¬(Cond.lt zeroP remReg).Holds a := by simp only [Cond.Holds, hz0, hrem, List.length_nil, Nat.lt_irrefl, not_false_eq_true] @@ -1618,8 +1628,8 @@ private theorem scatterChildrenLoop_exec {n base w : ℕ} by simpa only [forestNodes, List.nil_append] using hnd, hs, ⟨rfl, rfl, rfl, rfl, rfl, hnm, le_rfl, fun _ _ => ⟨rfl, rfl, rfl, rfl, rfl, rfl⟩⟩⟩ | cons u c_tl ih => - intro a c_trees slotTrees fixedNodes z maxDeg hb hbr hz_mem hnd hs hsub hperm hchain hrem hmd - hnm hic + intro a c_trees slotTrees fixedNodes z maxDeg hb hbr hz_mem hnd hsz hs hsub hperm hchain hrem + hmd hnm hic set st := RawState.ofData n base a with hst_def have hfit_stop := hbr.fits_stop hb have hz0 : a.regs zeroP = 0 := hbr.2.2.2.2.2.2.2.2.2.2.2.1 @@ -1864,7 +1874,7 @@ private theorem scatterChildrenLoop_exec {n base w : ℕ} exact ⟨by rw [hin_m], hm_other x hxu, by rw [hd_m], by rw [hch_m], by rw [hk_m]⟩ · have hxu : x ≠ u := fun e => hu_not_desc (e ▸ hx) exact ⟨by rw [hpar_m, Function.update_of_ne hxu], by rw [hl_m], by rw [hr_m], Iff.rfl⟩ - have hs_mid : SlotInv n (RawState.ofData n base a_mid) slotTrees maxDeg := by + have hs_mid : SlotInv n sz (RawState.ofData n base a_mid) slotTrees maxDeg := by refine hs.frame hcons_m fun R hR => (hs.2.1 R hR).1.frame_nodes fun x hx => ?_ have hxu : x ≠ u := fun e => hu_not_other (List.mem_append_right _ (List.mem_append_left _ @@ -1876,6 +1886,12 @@ private theorem scatterChildrenLoop_exec {n base w : ℕ} (T_u.nodes ++ (forestNodes slotTrees ++ (forestNodes c_rest ++ fixedNodes))).Nodup := (perm_reassoc_mid T_u.nodes (forestNodes c_rest) (forestNodes slotTrees) fixedNodes).nodup_iff.mpr hnd_split + have hsz_for_sc : + (T_u.nodes ++ (forestNodes slotTrees ++ (forestNodes c_rest ++ fixedNodes))).length ≤ + sz := by + have hp := (perm_reassoc_mid T_u.nodes (forestNodes c_rest) (forestNodes slotTrees) + fixedNodes).trans (hperm_fn.append_right _) + exact hp.length_eq.le.trans hsz have hmid_ic : a_mid.regs iterCur = T_u.root.val := by rw [hregs_mid iterCur (by decide) (by decide)] simp only [a1, Data.set_regs, Data.write_regs, @@ -1892,7 +1908,7 @@ private theorem scatterChildrenLoop_exec {n base w : ℕ} hmd_sc, hperm_sc, hnd_sc, hs_sc, hk_sc, hmk_sc, hin_sc, hmin_sc, hnr_sc, hnm_sc, hsz_sc, ho_sc⟩ := scatterRootCode_exec hb_mid hbr_mid (List.mem_append_right _ hz_mem) - hnd_for_sc hs_mid hTu_mid hmid_ic hmid_md + hnd_for_sc hsz_for_sc hs_mid hTu_mid hmid_ic hmid_md -- Step 4 (`a_sc → a_next`, 2 steps): `iterCur ← iterNxt; remReg ← remReg - oneP` have hsc_nxt : a_sc.regs iterNxt = nxtVal := by rw [hlow_sc iterNxt (by decide), hregs_mid iterNxt (by decide) (by decide)] @@ -1932,7 +1948,14 @@ private theorem scatterChildrenLoop_exec {n base w : ℕ} have hnd_next : (forestNodes c_rest ++ (forestNodes slotTrees_1 ++ fixedNodes)).Nodup := (perm_swap_front (forestNodes slotTrees_1) (forestNodes c_rest) fixedNodes).nodup_iff.mp hnd_sc - have hs_next : SlotInv n (RawState.ofData n base a_next) slotTrees_1 maxDeg_1 := by + have hsz_next : + (forestNodes c_rest ++ (forestNodes slotTrees_1 ++ fixedNodes)).length ≤ sz := by + have hp1 := perm_swap_front (forestNodes slotTrees_1) (forestNodes c_rest) fixedNodes + have hp2 := hperm_sc.append_right (forestNodes c_rest ++ fixedNodes) + have hp_len := (hp1.symm.trans hp2).length_eq + simp only [List.length_append] at hp_len hsz_for_sc ⊢ + omega + have hs_next : SlotInv n sz (RawState.ofData n base a_next) slotTrees_1 maxDeg_1 := by rw [hst_next]; exact hs_sc have hsub_next : ∀ c ∈ c_rest, ValidSubtree (RawState.ofData n base a_next) none c := by intro c hc_mem @@ -1976,8 +1999,8 @@ private theorem scatterChildrenLoop_exec {n base w : ℕ} obtain ⟨b, slotTrees', maxDeg', t_tl, he_tl, ht_tl, hb_b, hbr_b, hmod_tl, hregs_tl, hmd_b, hperm_b, hnd_b, hs_b, hk_b, hin_b, hmin_b, hnr_b, hsz_b, hnm_b, hnm_le_b, ho_b⟩ := - ih a_next c_rest slotTrees_1 fixedNodes z maxDeg_1 hb_next hbr_next hz_mem hnd_next hs_next - hsub_next hperm_tl hchain_next + ih a_next c_rest slotTrees_1 fixedNodes z maxDeg_1 hb_next hbr_next hz_mem hnd_next hsz_next + hs_next hsub_next hperm_tl hchain_next (by simp only [a_next, Data.set_regs, Function.update_self]) (by simp only [a_next, Data.set_regs, Function.update_of_ne (by decide : maxDegReg ≠ remReg), @@ -2036,14 +2059,15 @@ private abbrev rootScatterLoop : Code .exact rFib := .loop (.lt zeroP remReg) rootScatterBody /-- Phase A2 loop: scatters each remaining root in `r_trees` along `r_order` into `cons`. -/ -private theorem scatterRootsLoop_exec {n base w : ℕ} +private theorem scatterRootsLoop_exec {n sz base w : ℕ} (r_order : List (Fin n)) : ∀ (a : Data rFib) (r_trees slotTrees : List (FHTree n)) (fixedNodes : List (Fin n)) (z : Fin n) (maxDeg : ℕ), a.Bounded w → BaseRegs n base a → z ∈ fixedNodes → (forestNodes r_trees ++ (forestNodes slotTrees ++ fixedNodes)).Nodup → - SlotInv n (RawState.ofData n base a) slotTrees maxDeg → + (forestNodes r_trees ++ (forestNodes slotTrees ++ fixedNodes)).length ≤ sz → + SlotInv n sz (RawState.ofData n base a) slotTrees maxDeg → (∀ R ∈ r_trees, ValidRoot (RawState.ofData n base a) none R) → r_order.Perm (r_trees.map FHTree.root) → RightChain (RawState.ofData n base a).right r_order → @@ -2060,7 +2084,7 @@ private theorem scatterRootsLoop_exec {n base w : ℕ} b.regs maxDegReg = maxDeg' ∧ (forestNodes slotTrees').Perm (forestNodes r_trees ++ forestNodes slotTrees) ∧ (forestNodes slotTrees' ++ fixedNodes).Nodup ∧ - SlotInv n (RawState.ofData n base b) slotTrees' maxDeg' ∧ + SlotInv n sz (RawState.ofData n base b) slotTrees' maxDeg' ∧ (let st := RawState.ofData n base a let st' := RawState.ofData n base b st'.key = st.key ∧ st'.mark = st.mark ∧ st'.inHeap = st.inHeap ∧ @@ -2071,7 +2095,7 @@ private theorem scatterRootsLoop_exec {n base w : ℕ} st'.left v = st.left v ∧ st'.right v = st.right v ∧ st'.deg v = st.deg v) := by induction r_order with | nil => - intro a r_trees slotTrees fixedNodes _ maxDeg hb hbr _ hnd hs _ hperm _ hrem hmd _ + intro a r_trees slotTrees fixedNodes _ maxDeg hb hbr _ hnd _ hs _ hperm _ hrem hmd _ have hz0 : a.regs zeroP = 0 := hbr.2.2.2.2.2.2.2.2.2.2.2.1 have hc : ¬(Cond.lt zeroP remReg).Holds a := by simp only [Cond.Holds, hz0, hrem, List.length_nil, Nat.lt_irrefl, not_false_eq_true] @@ -2087,7 +2111,7 @@ private theorem scatterRootsLoop_exec {n base w : ℕ} by simpa only [forestNodes, List.nil_append] using hnd, hs, ⟨rfl, rfl, rfl, rfl, rfl, rfl, rfl, fun _ _ => ⟨rfl, rfl, rfl, rfl, rfl⟩⟩⟩ | cons u r_tl ih => - intro a r_trees slotTrees fixedNodes z maxDeg hb hbr hz_mem hnd hs hroots hperm hchain hrem + intro a r_trees slotTrees fixedNodes z maxDeg hb hbr hz_mem hnd hsz hs hroots hperm hchain hrem hmd hic set st := RawState.ofData n base a with hst_def have hfit_stop := hbr.fits_stop hb @@ -2108,6 +2132,12 @@ private theorem scatterRootsLoop_exec {n base w : ℕ} (T_u.nodes ++ (forestNodes slotTrees ++ (forestNodes r_rest ++ fixedNodes))).Nodup := (perm_reassoc_mid T_u.nodes (forestNodes r_rest) (forestNodes slotTrees) fixedNodes).nodup_iff.mpr hnd_split + have hsz_for_sc : + (T_u.nodes ++ (forestNodes slotTrees ++ (forestNodes r_rest ++ fixedNodes))).length ≤ + sz := by + have hp := (perm_reassoc_mid T_u.nodes (forestNodes r_rest) (forestNodes slotTrees) + fixedNodes).trans (hperm_fn.append_right _) + exact hp.length_eq.le.trans hsz -- Step 1 (`a → a1`, 2 steps): `s0 ← rightBase + iterCur; iterNxt ← *s0` let nxtVal := st.right u let a1 := (a.set s0 (base + 4 * n + u.val)).set iterNxt nxtVal @@ -2135,7 +2165,7 @@ private theorem scatterRootsLoop_exec {n base w : ℕ} hmd_sc, hperm_sc, hnd_sc, hs_sc, hk_sc, hmk_sc, hin_sc, hmin_sc, hnr_sc, hnm_sc, hsz_sc, ho_sc⟩ := scatterRootCode_exec hb1 hbr1 (List.mem_append_right _ hz_mem) - hnd_for_sc (by rw [hst1]; exact hs) (by rw [hst1]; exact hTu_valid) + hnd_for_sc hsz_for_sc (by rw [hst1]; exact hs) (by rw [hst1]; exact hTu_valid) (by simp only [a1, Data.set_regs, Function.update_of_ne (by decide : iterCur ≠ iterNxt), Function.update_of_ne (by decide : iterCur ≠ s0), hu_ic, hTu_r]) (by simp only [a1, Data.set_regs, Function.update_of_ne (by decide : maxDegReg ≠ iterNxt), @@ -2173,6 +2203,13 @@ private theorem scatterRootsLoop_exec {n base w : ℕ} have hnd_next : (forestNodes r_rest ++ (forestNodes slotTrees_1 ++ fixedNodes)).Nodup := (perm_swap_front (forestNodes slotTrees_1) (forestNodes r_rest) fixedNodes).nodup_iff.mp hnd_sc + have hsz_next : + (forestNodes r_rest ++ (forestNodes slotTrees_1 ++ fixedNodes)).length ≤ sz := by + have hp1 := perm_swap_front (forestNodes slotTrees_1) (forestNodes r_rest) fixedNodes + have hp2 := hperm_sc.append_right (forestNodes r_rest ++ fixedNodes) + have hp_len := (hp1.symm.trans hp2).length_eq + simp only [List.length_append] at hp_len hsz_for_sc ⊢ + omega have hroots_next : ∀ R ∈ r_rest, ValidRoot (RawState.ofData n base a_next) none R := by intro R hR_mem obtain ⟨j, hj, _, hR_eq⟩ := List.mem_eraseIdx_iff_getElem.mp hR_mem @@ -2206,7 +2243,7 @@ private theorem scatterRootsLoop_exec {n base w : ℕ} obtain ⟨b, slotTrees', maxDeg', t_tl, he_tl, ht_tl, hb_b, hbr_b, hmod_tl, hregs_tl, hmd_b, hperm_b, hnd_b, hs_b, hk_b, hmk_b, hin_b, hmin_b, hnr_b, hnm_b, hsz_b, ho_b⟩ := - ih a_next r_rest slotTrees_1 fixedNodes z maxDeg_1 hb_next hbr_next hz_mem hnd_next + ih a_next r_rest slotTrees_1 fixedNodes z maxDeg_1 hb_next hbr_next hz_mem hnd_next hsz_next (by rw [hst_next]; exact hs_sc) hroots_next hperm_tl hchain_next (by simp only [a_next, Data.set_regs, Function.update_self]) (by simp only [a_next, Data.set_regs, @@ -2455,14 +2492,14 @@ private abbrev gatherSlotsLoop : Code .exact rFib := /-- Phase B loop: scans `curD` up to `maxDeg + 1` (`curD + rem = maxDeg + 1`), clearing every occupied `cons[curD]` and splicing its consolidated root into `accRoots` via `addRootAndUpdateMin iterCur`. -/ -private theorem gatherSlotsLoop_exec {n base w maxDeg : ℕ} (hn_pos : 1 ≤ n) +private theorem gatherSlotsLoop_exec {n sz base w maxDeg : ℕ} (hn_pos : 1 ≤ n) (rem : ℕ) : ∀ (a : Data rFib) (curD : ℕ) (slotTrees accRoots : List (FHTree n)) (z : Fin n), curD + rem = maxDeg + 1 → a.Bounded w → BaseRegs n base a → a.regs curDReg = curD → a.regs maxDegReg = maxDeg + 1 → - SlotInv n (RawState.ofData n base a) slotTrees maxDeg → + SlotInv n sz (RawState.ofData n base a) slotTrees maxDeg → (∀ d < curD, ∀ T ∈ slotTrees, T.deg ≠ d) → (forestNodes slotTrees ++ (z :: forestNodes accRoots)).Nodup → (∀ T ∈ accRoots, ValidRoot (RawState.ofData n base a) none T) → @@ -2702,7 +2739,7 @@ private theorem gatherSlotsLoop_exec {n base w maxDeg : ℕ} (hn_pos : 1 ≤ n) ofData_set_scratch a4 (by decide : 17 ≤ curDReg.val) (curD + 1) have hmod5 : Modifies (Block.mk base (space n)).footprint a.mem a5.mem := modifies_block_trans (Modifies.write_of_owns ho_cons 0) hmod_add - have hs5 : SlotInv n (RawState.ofData n base a5) slotRest maxDeg := by + have hs5 : SlotInv n sz (RawState.ofData n base a5) slotRest maxDeg := by rw [hst5] refine hs.step_collision hidx hslot_deg hd_le_n hno_other (by rw [hcons4, hst3]) fun R hR => ?_ @@ -2795,8 +2832,9 @@ private theorem execWithin_seq₃ {B : Basis} {r w t₁ t₂ : ℕ} {a b c d : C rcases h₂ with ⟨_, hm₂, hd⟩ exact ⟨_, by omega, ha.seq (hb.seq (hc.seq hd))⟩ -/-- `extractMinCode` implements `.extractMin` on `FibInv` within `410 * (Nat.log 2 n + 1)` -amortized instructions (`t + potential y ≤ 410 * (Nat.log 2 n + 1) + potential x`). -/ +/-- `extractMinCode` implements `.extractMin` on `FibInv` within +`410 * (Nat.log 2 (IndexedMinPQ.dom s).card + 1)` amortized instructions +(`t + potential y ≤ 410 * (Nat.log 2 (IndexedMinPQ.dom s).card + 1) + potential x`). -/ theorem extractMinCode_exec {n K_max w base : ℕ} {s : IndexedMinPQ.State n} {x : Data rFib} (hinv : FibInv n K_max w base s x) : ∃ y t, ExecWithin w extractMinCode x y t ∧ @@ -2804,7 +2842,8 @@ theorem extractMinCode_exec {n K_max w base : ℕ} {s : IndexedMinPQ.State n} {x some ((IndexedMinPQ.spec n K_max).step s .extractMin).2 ∧ FibInv n K_max w base ((IndexedMinPQ.spec n K_max).step s .extractMin).1 y ∧ Modifies (Block.mk base (space n)).footprint x.mem y.mem ∧ - t + potential y ≤ 410 * (Nat.log 2 n + 1) + potential x := by + t + potential y ≤ + 410 * (Nat.log 2 (IndexedMinPQ.dom s).card + 1) + potential x := by obtain ⟨hb, hbr, hraw⟩ := hinv set st := RawState.ofData n base x with hst_def have hfit_stop := hbr.fits_stop hb @@ -2853,14 +2892,19 @@ theorem extractMinCode_exec {n K_max w base : ℕ} {s : IndexedMinPQ.State n} {x have hrtail_len : rtail.length = r_trees.length := by simpa only [List.length_map] using hperm_rtail.length_eq have hTz_val : ValidRoot st none T_z := hroots T_z (List.getElem_mem hidx_z) - have hts_len_le_n : (forestNodes ts).length ≤ n := by simpa using hnd.length_le_card - have hTz_size_le_n : T_z.size ≤ n := by + have hts_len_eq : (forestNodes ts).length = (IndexedMinPQ.dom s).card := by + rw [← List.toFinset_card_of_nodup hnd] + congr 1 + ext v + simp only [List.mem_toFinset, IndexedMinPQ.dom, Finset.mem_filter, Finset.mem_univ, + true_and, hdom v] + have hTz_size_le_sz : T_z.size ≤ (IndexedMinPQ.dom s).card := by have h1 := hperm_ts.length_eq simp only [List.length_append] at h1 - change (ts[idx_z]).nodes.length ≤ n + change (ts[idx_z]).nodes.length ≤ (IndexedMinPQ.dom s).card omega - have hTz_deg_log : T_z.deg ≤ 2 * Nat.log 2 n + 1 := - (hTz_val.1.deg_bounds hTz_size_le_n).1 + have hTz_deg_log : T_z.deg ≤ 2 * Nat.log 2 (IndexedMinPQ.dom s).card + 1 := + (hTz_val.1.deg_bounds hTz_size_le_sz).1 rcases hTz_eq : T_z with ⟨z', c_trees⟩ have hzz' : z' = z := by have hr : T_z.root = z := hTz_root @@ -3075,6 +3119,14 @@ theorem extractMinCode_exec {n K_max w base : ℕ} {s : IndexedMinPQ.State n} {x simp only [List.singleton_append, List.append_assoc] at hp rw [List.cons_append] at hnd_split exact hp.nodup_iff.mp hnd_split + have hsz_crz : + (forestNodes c_trees ++ ([] ++ (forestNodes r_trees ++ [z]))).length ≤ + (IndexedMinPQ.dom s).card := by + have hp0 : (T_z.nodes ++ forestNodes r_trees).Perm (forestNodes ts) := hperm_ts + have hp_len := hp0.length_eq + simp only [hTz_eq, FHTree.nodes, List.length_append, List.length_cons, + List.length_nil] at hp_len ⊢ + omega -- Phase A1 (`x_pre → x_A1`) have hA1 : ∃ x_A1 slotTrees_1 maxDeg_1 t_A1, ExecWithin w @@ -3090,7 +3142,7 @@ theorem extractMinCode_exec {n K_max w base : ℕ} {s : IndexedMinPQ.State n} {x x_A1.regs maxDegReg = maxDeg_1 ∧ (forestNodes slotTrees_1).Perm (forestNodes c_trees) ∧ (forestNodes slotTrees_1 ++ (forestNodes r_trees ++ [z])).Nodup ∧ - SlotInv n (RawState.ofData n base x_A1) slotTrees_1 maxDeg_1 ∧ + SlotInv n (IndexedMinPQ.dom s).card (RawState.ofData n base x_A1) slotTrees_1 maxDeg_1 ∧ (let st' := RawState.ofData n base x_A1 st'.key = st.key ∧ st'.inHeap = Function.update st.inHeap z 0 ∧ st'.minRoot = st.minRoot ∧ st'.numRoots = st.numRoots ∧ st'.sz = st.sz - 1 ∧ @@ -3203,6 +3255,7 @@ theorem extractMinCode_exec {n K_max w base : ℕ} {s : IndexedMinPQ.State n} {x hk_sc1, hin_sc1, hmin_sc1, hnr_sc1, hsz_sc1, hnm_sc1, hnm_le1, ho_sc1⟩ := scatterChildrenLoop_exec (h_c :: c_tail) x_c0 c_trees [] (forestNodes r_trees ++ [z]) z 0 hb_c0 hbr_c0 (List.mem_append_right _ (List.mem_cons_self : z ∈ [z])) hnd_crz + hsz_crz (SlotInv.empty (by rw [hst_c0, hst_pre]; exact hcons)) hsub_c0 hperm_c (by rw [hst_c0, hst_pre]; exact hcirc_c.rightChain) (by simp only [x_c0, x_pre, Data.set_regs, @@ -3276,6 +3329,14 @@ theorem extractMinCode_exec {n K_max w base : ℕ} {s : IndexedMinPQ.State n} {x -- Phase A2 (`x_tr → x_A2`, `rootScatterLoop`) have hnd_tr : (forestNodes r_trees ++ (forestNodes slotTrees_1 ++ [z])).Nodup := (perm_swap_front (forestNodes slotTrees_1) (forestNodes r_trees) [z]).nodup_iff.mp hnd_A1 + have hsz_tr : + (forestNodes r_trees ++ (forestNodes slotTrees_1 ++ [z])).length ≤ + (IndexedMinPQ.dom s).card := by + have hp1 := perm_swap_front (forestNodes slotTrees_1) (forestNodes r_trees) [z] + have hp2 := hperm_A1.append_right (forestNodes r_trees ++ [z]) + have hlen := (hp1.symm.trans hp2).length_eq + simp only [List.nil_append] at hsz_crz + omega have hroots_tr : ∀ R ∈ r_trees, ValidRoot (RawState.ofData n base x_tr) none R := by intro R hR obtain ⟨j, hj, _, hR_eq⟩ := List.mem_eraseIdx_iff_getElem.mp hR @@ -3307,7 +3368,8 @@ theorem extractMinCode_exec {n K_max w base : ℕ} {s : IndexedMinPQ.State n} {x hregs_A2, hmd_A2, hperm_A2, hnd_A2, hs_A2, hk_A2, hmk_A2, hin_A2, _, _, hnm_A2, hsz_A2, _⟩ := scatterRootsLoop_exec rtail x_tr r_trees slotTrees_1 [z] z maxDeg_1 hb_tr hbr_tr - (List.mem_cons_self : z ∈ [z]) hnd_tr (hst_tr ▸ hs_A1) hroots_tr hperm_rtail hchain_tr + (List.mem_cons_self : z ∈ [z]) hnd_tr hsz_tr (hst_tr ▸ hs_A1) hroots_tr hperm_rtail + hchain_tr (by simp only [x_tr, Data.set_regs, Function.update_of_ne (by decide : remReg ≠ iterCur), Function.update_self]) (by simp only [x_tr, Data.set_regs, @@ -3316,7 +3378,7 @@ theorem extractMinCode_exec {n K_max w base : ℕ} {s : IndexedMinPQ.State n} {x hic_tr rw [hst_tr] at hk_A2 hmk_A2 hin_A2 hnm_A2 hsz_A2 -- Phase B preamble (`x_A2 → x_B0`, 4 ops) - have hmd2_log : maxDeg_2 ≤ 2 * Nat.log 2 n + 1 := hs_A2.2.2.2.2.1 + have hmd2_log : maxDeg_2 ≤ 2 * Nat.log 2 (IndexedMinPQ.dom s).card + 1 := hs_A2.2.2.2.2.1 have hmd2_le_n : maxDeg_2 + 1 ≤ n := by rcases hs_A2.2.2.2.2.2 with h0 | h2 <;> omega let x_B0 := (((x_A2.set minRootReg 0).set numRootsReg 0).set maxDegReg @@ -3360,7 +3422,9 @@ theorem extractMinCode_exec {n K_max w base : ℕ} {s : IndexedMinPQ.State n} {x simp only [x_B0, ofData_set_scratch _ (by decide : 17 ≤ curDReg.val), ofData_set_scratch _ (by decide : 17 ≤ maxDegReg.val), ofData_set_numRoots, ofData_set_minRoot] - have hs_B0 : SlotInv n (RawState.ofData n base x_B0) slotTrees_2 maxDeg_2 := by + have hs_B0 : + SlotInv n (IndexedMinPQ.dom s).card (RawState.ofData n base x_B0) + slotTrees_2 maxDeg_2 := by rw [hst_B0] exact hs_A2.frame rfl fun T hT => (hs_A2.2.1 T hT).1.frame_nodes fun _ _ => ⟨rfl, rfl, rfl, rfl, rfl, rfl, rfl, rfl⟩ diff --git a/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/MinPQ.lean b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/MinPQ.lean new file mode 100644 index 000000000..12c6d06f8 --- /dev/null +++ b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/MinPQ.lean @@ -0,0 +1,2025 @@ +/- +Copyright (c) 2026 Renfei Zhou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Renfei Zhou +-/ + +module +-- upstream: candidate + +public import Complexity.Algorithms.Lean.MinPQ +public import Complexity.Computability.WordRAM.RelSubroutine +public import Complexity.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.BasicOps +public import Complexity.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.Cut +public import Complexity.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.Consolidate + +/-! +# Fibonacci Heap with Handles and Satellite Values + +This file realizes the relational priority-queue specification `Cslib.Algorithms.Lean.MinPQ.spec` +(returning an opaque handle `h : Fin n_max` on `insert` and `(u, v, h)` on `extractMin`) as a +Word-RAM `RelSubroutineDS` over `Cslib.WordRAM.Basis.exact` (and lifted to `Basis.standard`), +layered on top of `Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap`. + +Over capacity `n_max` in a contiguous memory block `[base, base + 11 * n_max + 1)`: +* `[base, base + 9 * n_max + 1)` holds the inner Fibonacci heap arrays (`key`, `par`, `child`, + `left`, `right`, `deg`, `mark`, `inHeap`, `cons`); +* `[base + (9 * n_max + 1), base + (10 * n_max + 1))` holds satellite values `val[0..n_max-1]`; +* `[base + (10 * n_max + 1), base + (11 * n_max + 1))` holds the recycled-handle stack + `freeStack[0..n_max-1]`, paired with persistent bump pointer `freshReg` and stack height + `freeTopReg`. + +## Main definitions + +* `Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.MinPQ.rMinPQ`, `space`, `subroutineCode`: + `48`-register, `(11 * n_max + 1)`-word `SubroutineCode .exact rMinPQ 1`. +* `Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.MinPQ.Rep`, `charge`: relational + representation invariant and per-operation amortized instruction charges (`O(log n + 1)` on + `extractMin` in the current number of stored elements `n = MinPQ.size s`). +* `Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.MinPQ.relSubroutineDS`: + `RelSubroutineDS` certificate over `Basis.exact`. + +## Main results + +* `Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.MinPQ.relAmortized`, + `run_client_amortized`: standalone `Stateful.RelAmortized` certificate and adaptive-client bound + over `Basis.standard`. +* `Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.MinPQ.run_ops_exact_fresh`, + `run_ops_exact_reusable`: standalone `Basis.exact` flat-program execution theorems. + +## 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*, + Chapter 19][CLRS2009] +-/ + +@[expose] public section + +namespace Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.MinPQ + +open Cslib.WordRAM +open Cslib.Algorithms.Lean +open scoped Cslib.WordRAM + +/-! ## Register file (`rMinPQ = 48`), embedding `f42`, and footprint size -/ + +/-- Total register count of the key–value Fibonacci heap with handle allocation. -/ +abbrev rMinPQ : ℕ := 48 + +/-- Outer bump-pointer frontier register (`base` before `allocSpan`, `base + space n_max` after). -/ +abbrev outerFrontierReg : Fin rMinPQ := ⟨1, by decide⟩ +/-- Persistent base address of `val[0..n_max-1]` (`base + 9 * n_max + 1`). Also serves as the +relocated image of the inner `FibonacciHeap.frontierReg`. -/ +abbrev valBaseReg : Fin rMinPQ := ⟨42, by decide⟩ +/-- Persistent base address of `freeStack[0..n_max-1]` (`base + 10 * n_max + 1`). -/ +abbrev freeBaseReg : Fin rMinPQ := ⟨43, by decide⟩ +/-- Persistent bump-pointer watermark `fresh` for never-allocated handles. -/ +abbrev freshReg : Fin rMinPQ := ⟨44, by decide⟩ +/-- Persistent stack height `freeTop` for recycled handles in `freeStack`. -/ +abbrev freeTopReg : Fin rMinPQ := ⟨45, by decide⟩ +/-- Caller input register carrying the satellite value `v` on `insert`. -/ +abbrev inValReg : Fin rMinPQ := ⟨46, by decide⟩ +/-- Output register carrying the satellite value `v` on `get` and `extractMin`. -/ +abbrev outValReg : Fin rMinPQ := ⟨47, by decide⟩ + +/-- Injective register embedding from the inner `rFib = 42` Fibonacci heap into `rMinPQ = 48`, +mapping `FibonacciHeap.frontierReg` (`R[1]`) to `valBaseReg` (`R[42]`) so `outerFrontierReg` +(`R[1]`) remains outside `Set.range f42`. -/ +def f42 (i : Fin rFib) : Fin rMinPQ := + if i = FibonacciHeap.frontierReg then valBaseReg else Fin.castLE (by decide) i + +theorem f42_injective : Function.Injective f42 := by + decide + +theorem outerFrontierReg_notMem_range : outerFrontierReg ∉ Set.range f42 := by + decide + +theorem freeBaseReg_notMem_range : freeBaseReg ∉ Set.range f42 := by + decide + +theorem freshReg_notMem_range : freshReg ∉ Set.range f42 := by + decide + +theorem freeTopReg_notMem_range : freeTopReg ∉ Set.range f42 := by + decide + +theorem inValReg_notMem_range : inValReg ∉ Set.range f42 := by + decide + +theorem outValReg_notMem_range : outValReg ∉ Set.range f42 := by + decide + +/-- Persistent register holding handle capacity `n_max` (`R[0]`). -/ +abbrev nReg : Fin rMinPQ := ⟨0, by decide⟩ +/-- Persistent base address of `key[0..n_max-1]` (`R[2]`). -/ +abbrev baseReg : Fin rMinPQ := ⟨2, by decide⟩ +/-- Persistent constant register `0` (`R[11]`). -/ +abbrev zeroP : Fin rMinPQ := ⟨11, by decide⟩ +/-- Persistent constant register `1` (`R[12]`). -/ +abbrev oneP : Fin rMinPQ := ⟨12, by decide⟩ +/-- Caller high tag bit (`R[17]`, `≠ 0` selects `extractMin`). -/ +abbrev tag2 : Fin rMinPQ := ⟨17, by decide⟩ +/-- Caller middle tag bit (`R[18]`). -/ +abbrev tag1 : Fin rMinPQ := ⟨18, by decide⟩ +/-- Caller low tag bit (`R[19]`). -/ +abbrev tag0 : Fin rMinPQ := ⟨19, by decide⟩ +/-- Handle register (`R[20]`, input for `get`/`decreaseKey`, scratch for `insert`). -/ +abbrev argV : Fin rMinPQ := ⟨20, by decide⟩ +/-- Key input register (`R[21]`, `u` for `insert`, `u'` for `decreaseKey`). -/ +abbrev argK : Fin rMinPQ := ⟨21, by decide⟩ +/-- Primary output flag register (`R[22]`). -/ +abbrev outFlag : Fin rMinPQ := ⟨22, by decide⟩ +/-- Output handle register (`R[23]`, `h.val` for `insert` and non-empty `extractMin`). -/ +abbrev outV : Fin rMinPQ := ⟨23, by decide⟩ +/-- Output key register (`R[24]`, `u` for present `get` and non-empty `extractMin`). -/ +abbrev outK : Fin rMinPQ := ⟨24, by decide⟩ +/-- Scratch pointer register for `zeroFillCode` (`R[25]`). -/ +abbrev curReg : Fin rMinPQ := ⟨25, by decide⟩ +/-- Scratch zero register for `zeroFillCode` (`R[26]`). -/ +abbrev zeroReg : Fin rMinPQ := ⟨26, by decide⟩ +/-- Scratch one register for `zeroFillCode` (`R[27]`). -/ +abbrev oneReg : Fin rMinPQ := ⟨27, by decide⟩ +/-- Scratch address register (`R[35]`). -/ +abbrev s0 : Fin rMinPQ := ⟨35, by decide⟩ + +/-- Persistent registers are `0..16` and `42..45` (`false`); caller/scratch registers are `17..41` +and `46..47` (`true`). -/ +def inputReg (i : Fin rMinPQ) : Bool := + decide ((17 ≤ i.val ∧ i.val < 42) ∨ 46 ≤ i.val) + +theorem inputReg_f42_of_false : + ∀ i : Fin rFib, FibonacciHeap.inputReg i = false → inputReg (f42 i) = false := by + decide + +/-- Static memory footprint on capacity `n_max`: `11 * n_max + 1` words (`9 * n_max + 1` for the +inner Fibonacci heap plus `n_max` for `val` and `n_max` for `freeStack`). -/ +def space (n_max : ℕ) : ℕ := + 11 * n_max + 1 + +theorem space_eq_fib_add (n_max : ℕ) : + space n_max = FibonacciHeap.space n_max + n_max + n_max := by + unfold space FibonacciHeap.space + omega + +theorem space_lower (n_max : ℕ) : n_max + 1 ≤ space n_max := by + unfold space + omega + +/-- Fresh-initialization instruction bound (`allocSpan` 15 + `initSetup` 18 = 33). -/ +def tInit (_n_max : ℕ) : ℕ := 33 +/-- Instruction bound for `isEmpty` (including dispatch). -/ +def tEmpty (_n_max : ℕ) : ℕ := 12 +/-- Instruction bound for `get` (including dispatch and value read). -/ +def tGet (_n_max : ℕ) : ℕ := 20 +/-- Amortized instruction bound for `insert` (including handle allocation, value write, and `+80` +root potential). -/ +def tIns (_n_max : ℕ) : ℕ := 140 +/-- Amortized instruction bound for `decreaseKey` (including dispatch and cascading cuts). -/ +def tDec (_n_max : ℕ) : ℕ := 340 +/-- Amortized instruction bound for `extractMin` (`420 * (Nat.log 2 n + 1)`). -/ +def tExt (n : ℕ) : ℕ := 420 * (Nat.log 2 n + 1) + +/-- Per-operation amortized instruction charge for the key–value Fibonacci heap, charging +`tExt (MinPQ.size s)` on `.extractMin` in terms of the current number of stored elements +`MinPQ.size s`. -/ +def charge (n_max : ℕ) (s : Cslib.Algorithms.Lean.MinPQ.State n_max) : + Cslib.Algorithms.Lean.MinPQ.Op n_max → ℕ + | .isEmpty => tEmpty n_max + | .get _ => tGet n_max + | .insert _ _ => tIns n_max + | .decreaseKey _ _ => tDec n_max + | .extractMin => tExt (Cslib.Algorithms.Lean.MinPQ.size s) + +/-- Since `MinPQ.size s ≤ n_max`, `charge n_max s .extractMin ≤ tExt n_max`. -/ +theorem charge_extractMin_le_tExt (n_max : ℕ) (s : Cslib.Algorithms.Lean.MinPQ.State n_max) : + charge n_max s .extractMin ≤ tExt n_max := by + simp only [charge, tExt] + have hlog : Nat.log 2 (Cslib.Algorithms.Lean.MinPQ.size s) ≤ Nat.log 2 n_max := + Nat.log_mono_right (Cslib.Algorithms.Lean.MinPQ.size_le s) + omega + +/-- Concrete integer potential `80 * (numRoots + 2 * numMarked)` inherited from the inner +Fibonacci heap. -/ +def potential (x : Data rMinPQ) : ℕ := + FibonacciHeap.potential (x.comap f42) + +/-! ## Structured `Basis.exact` subprograms and `subroutineCode` -/ + +/-- Copy `outerFrontierReg` into `valBaseReg`, run `FibonacciHeap.allocSpan.rename f42` to set +`baseReg = base` and `valBaseReg = base + 9 * n_max + 1`, then advance `freeBaseReg` and +`outerFrontierReg` by `n_max` each (`15` steps total). -/ +def allocSpan : Code .exact rMinPQ := + ram_exact[ + valBaseReg ← outerFrontierReg; + ⟪FibonacciHeap.allocSpan.rename f42⟫; + freeBaseReg ← valBaseReg + nReg; + outerFrontierReg ← freeBaseReg + nReg + ] + +/-- Initialize `freeBaseReg = outerFrontierReg - nReg`, `valBaseReg = freeBaseReg - nReg`, +`freshReg = 0`, `freeTopReg = 0`, and run `FibonacciHeap.initSetup.rename f42` (`18` steps +total). -/ +def initSetup : Code .exact rMinPQ := + ram_exact[ + freeBaseReg ← outerFrontierReg - nReg; + valBaseReg ← freeBaseReg - nReg; + freshReg ← #0; + freeTopReg ← #0; + ⟪FibonacciHeap.initSetup.rename f42⟫ + ] + +/-- `isEmpty`: delegates directly to `FibonacciHeap.isEmptyCode.rename f42`. -/ +def isEmptyCode : Code .exact rMinPQ := + FibonacciHeap.isEmptyCode.rename f42 + +/-- `get h`: runs `FibonacciHeap.getKeyCode.rename f42` and, when `outFlag ≠ 0`, loads the +satellite value `outValReg ← val[argV]`. -/ +def getCode : Code .exact rMinPQ := + ram_exact[ + ⟪FibonacciHeap.getKeyCode.rename f42⟫; + if outFlag = zeroP then [ + s0 ← zeroP + ] else [ + s0 ← valBaseReg + argV; + outValReg ← *s0 + ] + ] + +/-- `insert u v`: allocates a handle `argV` from `freeStack` (if `freeTopReg > 0`) or bumps +`freshReg`, stores `val[argV] ← inValReg`, runs `FibonacciHeap.insertCode.rename f42` with key +`argK = u`, and outputs `outV ← argV`. -/ +def insertCode : Code .exact rMinPQ := + ram_exact[ + if freeTopReg = zeroP then [ + argV ← freshReg; + freshReg ← freshReg + oneP + ] else [ + freeTopReg ← freeTopReg - oneP; + s0 ← freeBaseReg + freeTopReg; + argV ← *s0 + ]; + s0 ← valBaseReg + argV; + *s0 ← inValReg; + ⟪FibonacciHeap.insertCode.rename f42⟫; + outV ← argV + ] + +/-- `decreaseKey h u'`: delegates directly to `FibonacciHeap.decreaseKeyCode.rename f42`. -/ +def decreaseKeyCode : Code .exact rMinPQ := + FibonacciHeap.decreaseKeyCode.rename f42 + +/-- `extractMin`: runs `FibonacciHeap.extractMinCode.rename f42` and, when `outFlag ≠ 0`, loads +`outValReg ← val[outV]` and pushes `outV` onto `freeStack[freeTopReg]`. -/ +def extractMinCode : Code .exact rMinPQ := + ram_exact[ + ⟪FibonacciHeap.extractMinCode.rename f42⟫; + if outFlag = zeroP then [ + s0 ← zeroP + ] else [ + s0 ← valBaseReg + outV; + outValReg ← *s0; + s0 ← freeBaseReg + freeTopReg; + *s0 ← outV; + freeTopReg ← freeTopReg + oneP + ] + ] + +/-- Unified dispatcher over 1-bit tags `(tag2, tag1, tag0)`. -/ +def dispatchCode : Code .exact rMinPQ := + ram_exact[ + if tag2 = zeroP then [ + if tag1 = zeroP then [ + if tag0 = zeroP then [ + ⟪isEmptyCode⟫ + ] else [ + ⟪getCode⟫ + ] + ] else [ + if tag0 = zeroP then [ + ⟪insertCode⟫ + ] else [ + ⟪decreaseKeyCode⟫ + ] + ] + ] else [ + ⟪extractMinCode⟫ + ] + ] + +/-- Uniform `SubroutineCode .exact rMinPQ 1` for the key–value Fibonacci heap with handles. -/ +def subroutineCode : SubroutineCode .exact rMinPQ 1 where + allocSpan := allocSpan + initSetup := initSetup + code := dispatchCode + frontierReg := outerFrontierReg + baseReg := baseReg + initParams := ![nReg] + curReg := curReg + zeroReg := zeroReg + oneReg := oneReg + incCur := .exactBin .add curReg curReg oneReg + input := inputReg + output := outFlag + +/-! ## Calling convention: `encode`, `argMatch`, `decode` -/ + +/-- Raw register encoding for `Cslib.Algorithms.Lean.MinPQ.Op n_max` using 1-bit tags +`(tag2, tag1, tag0)`. -/ +def rawEncode {n_max : ℕ} : Cslib.Algorithms.Lean.MinPQ.Op n_max → Fin rMinPQ → ℕ + | .isEmpty => fun _ => 0 + | .get h => fun i => if i = tag0 then 1 else if i = argV then h.val else 0 + | .insert u v => fun i => + if i = tag1 then 1 else if i = argK then u else if i = inValReg then v else 0 + | .decreaseKey h u' => fun i => + if i = tag1 then 1 else if i = tag0 then 1 + else if i = argV then h.val else if i = argK then u' else 0 + | .extractMin => fun i => if i = tag2 then 1 else 0 + +/-- Register encoding for `Cslib.Algorithms.Lean.MinPQ.Op n_max` bounded by `U` on `decreaseKey` +so `arguments_fit` holds on arbitrary states; coincides with `rawEncode` on every represented +state (`encode_eq_rawEncode_of_valid`). -/ +def encode {n_max : ℕ} (U : ℕ) : Cslib.Algorithms.Lean.MinPQ.Op n_max → Fin rMinPQ → ℕ + | .decreaseKey h u' => fun i => + if i = tag1 then 1 else if i = tag0 then 1 + else if i = argV then h.val else if i = argK then (if u' < U then u' else 0) else 0 + | o => rawEncode o + +/-- Standard argument-matching predicate for `Cslib.Algorithms.Lean.MinPQ.Op n_max`. -/ +def rawArgMatch {n_max : ℕ} : Cslib.Algorithms.Lean.MinPQ.Op n_max → (Fin rMinPQ → ℕ) → Prop + | .isEmpty => fun regs => regs tag2 = 0 ∧ regs tag1 = 0 ∧ regs tag0 = 0 + | .get h => fun regs => + regs tag2 = 0 ∧ regs tag1 = 0 ∧ regs tag0 ≠ 0 ∧ regs argV = h.val + | .insert u v => fun regs => + regs tag2 = 0 ∧ regs tag1 ≠ 0 ∧ regs tag0 = 0 ∧ regs argK = u ∧ regs inValReg = v + | .decreaseKey h u' => fun regs => + regs tag2 = 0 ∧ regs tag1 ≠ 0 ∧ regs tag0 ≠ 0 ∧ regs argV = h.val ∧ regs argK = u' + | .extractMin => fun regs => regs tag2 ≠ 0 + +/-- Argument-matching predicate paired with `encode U` for `RelSubroutineDS`. -/ +def argMatch {n_max : ℕ} (U : ℕ) : Cslib.Algorithms.Lean.MinPQ.Op n_max → (Fin rMinPQ → ℕ) → Prop + | .decreaseKey h u' => fun regs => + regs tag2 = 0 ∧ regs tag1 ≠ 0 ∧ regs tag0 ≠ 0 ∧ regs argV = h.val ∧ + regs argK = (if u' < U then u' else 0) + | o => rawArgMatch o + +/-- Output decoder for `Cslib.Algorithms.Lean.MinPQ.spec n_max U V`. -/ +def decode {n_max U V : ℕ} : + (o : (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).Op) → (Fin rMinPQ → ℕ) → + Option ((Cslib.Algorithms.Lean.MinPQ.spec n_max U V).Result o) + | .isEmpty, regs => some (decide (regs outFlag ≠ 0)) + | .get _, regs => + if regs outFlag = 0 then some none else some (some (regs outK, regs outValReg)) + | .insert _ _, regs => + if h : regs outV < n_max then some (some ⟨regs outV, h⟩) else none + | .decreaseKey _ _, _ => some () + | .extractMin, regs => + if regs outFlag = 0 then some none + else if h : regs outV < n_max then some (some (regs outK, regs outValReg, ⟨regs outV, h⟩)) + else none + +theorem arguments_fit {n_max U V w base : ℕ} + (hS : Fits w (base + space n_max)) (hU : Fits w U) (hV : Fits w V) + {s : Cslib.Algorithms.Lean.MinPQ.State n_max} (o : Cslib.Algorithms.Lean.MinPQ.Op n_max) + (hv : (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).valid s o) (i : Fin rMinPQ) : + Fits w (encode U o i) := by + have hsp := space_lower n_max + have h0 : Fits w 0 := hS.of_le (Nat.zero_le _) + have h1 : Fits w 1 := hS.of_le (by omega) + cases o with + | isEmpty => exact h0 + | get h => + simp only [encode, rawEncode] + split_ifs + · exact h1 + · exact hS.of_le (by have := h.isLt; omega) + · exact h0 + | insert u v => + obtain ⟨_, hu, hv_lt⟩ := hv + simp only [encode, rawEncode] + split_ifs + · exact h1 + · exact hU.of_le (Nat.le_of_lt hu) + · exact hV.of_le (Nat.le_of_lt hv_lt) + · exact h0 + | decreaseKey h u' => + simp only [encode] + split_ifs with _ _ _ _ hu' + · exact h1 + · exact h1 + · exact hS.of_le (by have := h.isLt; omega) + · exact hU.of_le (Nat.le_of_lt hu') + · exact h0 + · exact h0 + | extractMin => + simp only [encode, rawEncode] + split_ifs + · exact h1 + · exact h0 + +theorem encode_matches {n_max U : ℕ} (o : Cslib.Algorithms.Lean.MinPQ.Op n_max) + (regs : Fin rMinPQ → ℕ) : + argMatch U o (fun i => if subroutineCode.input i then encode U o i else regs i) := by + cases o with + | isEmpty => + refine ⟨rfl, rfl, rfl⟩ + | get h => + refine ⟨rfl, rfl, Nat.one_ne_zero, rfl⟩ + | insert u v => + refine ⟨rfl, Nat.one_ne_zero, rfl, rfl, rfl⟩ + | decreaseKey h u' => + refine ⟨rfl, Nat.one_ne_zero, Nat.one_ne_zero, rfl, rfl⟩ + | extractMin => + exact Nat.one_ne_zero + + +/-! ## Representation invariant (`AllocRep`, `Rep`) and framing lemmas -/ + +/-- Full machine-state representation invariant for an internal allocator state +`s : Cslib.Algorithms.Lean.MinPQ.AllocState n_max`. -/ +def AllocRep (n_max U V w base : ℕ) (s : Cslib.Algorithms.Lean.MinPQ.AllocState n_max) + (x : Data rMinPQ) : Prop := + x.Bounded w ∧ + FibonacciHeap.FibInv n_max U w base (Cslib.Algorithms.Lean.MinPQ.toIndexed s.entries) + (x.comap f42) ∧ + s.WellFormed ∧ + x.regs outerFrontierReg = base + space n_max ∧ + x.regs freeBaseReg = base + FibonacciHeap.space n_max + n_max ∧ + x.regs freshReg = s.fresh ∧ + x.regs freeTopReg = s.freeList.length ∧ + (∀ (h : Fin n_max) (u v : ℕ), s.entries h = some (u, v) → + u < U ∧ v < V ∧ x.mem (base + FibonacciHeap.space n_max + h.val) = v) ∧ + (∀ (i : ℕ) (hi : i < s.freeList.length), + x.mem (base + FibonacciHeap.space n_max + n_max + (s.freeList.length - 1 - i)) = + (s.freeList[i]).val) + +/-- Existential relational representation invariant over abstract state +`e : Cslib.Algorithms.Lean.MinPQ.State n_max`. -/ +def Rep (n_max U V w base : ℕ) (e : Cslib.Algorithms.Lean.MinPQ.State n_max) + (x : Data rMinPQ) : Prop := + ∃ s : Cslib.Algorithms.Lean.MinPQ.AllocState n_max, + s.entries = e ∧ AllocRep n_max U V w base s x + +theorem owns_val_addr {n_max base idx : ℕ} (hidx : idx < n_max) : + (Block.mk base (space n_max)).Owns (base + FibonacciHeap.space n_max + idx) := by + dsimp only [Block.Owns, space, FibonacciHeap.space] + omega + +theorem owns_free_addr {n_max base idx : ℕ} (hidx : idx < n_max) : + (Block.mk base (space n_max)).Owns (base + FibonacciHeap.space n_max + n_max + idx) := by + dsimp only [Block.Owns, space, FibonacciHeap.space] + omega + +theorem notMem_fib_footprint_of_ge {n_max base a : ℕ} (ha : base + FibonacciHeap.space n_max ≤ a) : + a ∉ (Block.mk base (FibonacciHeap.space n_max)).footprint := by + rw [Block.mem_footprint, Block.Owns] + dsimp only + omega + +theorem fib_footprint_subset {n_max base : ℕ} : + (Block.mk base (FibonacciHeap.space n_max)).footprint ⊆ + (Block.mk base (space n_max)).footprint := by + intro a ha + rw [Block.mem_footprint, Block.Owns] at ha ⊢ + dsimp only [space, FibonacciHeap.space] at ha ⊢ + omega + +theorem modifies_of_fib {n_max base : ℕ} {m₁ m₂ : ℕ → ℕ} + (h : Modifies (Block.mk base (FibonacciHeap.space n_max)).footprint m₁ m₂) : + Modifies (Block.mk base (space n_max)).footprint m₁ m₂ := + fun a ha => h a fun ha' => ha (fib_footprint_subset ha') + +theorem modifies_outer_trans {n_max base : ℕ} {m₁ m₂ m₃ : ℕ → ℕ} + (h₁ : Modifies (Block.mk base (space n_max)).footprint m₁ m₂) + (h₂ : Modifies (Block.mk base (space n_max)).footprint m₂ m₃) : + Modifies (Block.mk base (space n_max)).footprint m₁ m₃ := by + simpa only [Finset.union_idempotent] using h₁.trans h₂ + +theorem AllocRep.supported {n_max U V w base : ℕ} + {s : Cslib.Algorithms.Lean.MinPQ.AllocState n_max} {x x' : Data rMinPQ} + (hreg : ∀ i : Fin rMinPQ, inputReg i = false → x'.regs i = x.regs i) + (hmem : ∀ a ∈ (Block.mk base (space n_max)).footprint, x'.mem a = x.mem a) + (hb' : x'.Bounded w) (h : AllocRep n_max U V w base s x) : + AllocRep n_max U V w base s x' := by + obtain ⟨_, hfib, hwf, hfr, hfb, hfresh, htop, hval, hfree⟩ := h + refine ⟨hb', ?_, hwf, + (hreg outerFrontierReg (by decide)).trans hfr, + (hreg freeBaseReg (by decide)).trans hfb, + (hreg freshReg (by decide)).trans hfresh, + (hreg freeTopReg (by decide)).trans htop, ?_, ?_⟩ + · refine FibonacciHeap.FibInv.supported (fun j hj => ?_) (fun a ha => ?_) (hb'.comap f42) hfib + · exact hreg (f42 j) (inputReg_f42_of_false j hj) + · exact hmem a (fib_footprint_subset ha) + · intro h u v hsh + obtain ⟨hu, hv, hm⟩ := hval h u v hsh + refine ⟨hu, hv, ?_⟩ + rw [hmem _ (Block.mem_footprint.mpr (owns_val_addr h.isLt))] + exact hm + · intro i hi + have hlt : s.freeList.length - 1 - i < n_max := by + have := hwf.1 + have := hwf.2.2.2.2 + omega + rw [hmem _ (Block.mem_footprint.mpr (owns_free_addr hlt))] + exact hfree i hi + +theorem Rep.supported {n_max U V w base : ℕ} + {e : Cslib.Algorithms.Lean.MinPQ.State n_max} {x x' : Data rMinPQ} + (hreg : ∀ i : Fin rMinPQ, inputReg i = false → x'.regs i = x.regs i) + (hmem : ∀ a ∈ (Block.mk base (space n_max)).footprint, x'.mem a = x.mem a) + (hb' : x'.Bounded w) (h : Rep n_max U V w base e x) : + Rep n_max U V w base e x' := by + obtain ⟨s, rfl, hs⟩ := h + exact ⟨s, rfl, hs.supported hreg hmem hb'⟩ + +theorem potential_supported {x x' : Data rMinPQ} + (hreg : ∀ i : Fin rMinPQ, inputReg i = false → x'.regs i = x.regs i) : + potential x' = potential x := + FibonacciHeap.potential_supported fun j hj => hreg (f42 j) (inputReg_f42_of_false j hj) + +theorem rawArgMatch_of_argMatch {n_max U V w base : ℕ} + {s : Cslib.Algorithms.Lean.MinPQ.AllocState n_max} {x : Data rMinPQ} + {o : Cslib.Algorithms.Lean.MinPQ.Op n_max} + (hrep : AllocRep n_max U V w base s x) + (hv : (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).valid s.entries o) + (harg : argMatch U o x.regs) : + rawArgMatch o x.regs := by + cases o with + | isEmpty | get _ | insert _ _ | extractMin => exact harg + | decreaseKey h u' => + obtain ⟨u, v, hsh, hu'⟩ := hv + have hu_lt : u < U := (hrep.2.2.2.2.2.2.2.1 h u v hsh).1 + have hu'_lt : u' < U := Nat.lt_of_le_of_lt hu' hu_lt + simp only [argMatch, hu'_lt, ↓reduceIte] at harg + exact harg + +theorem encode_eq_rawEncode_of_rep {n_max U V w base : ℕ} + {e : Cslib.Algorithms.Lean.MinPQ.State n_max} {x : Data rMinPQ} + {o : Cslib.Algorithms.Lean.MinPQ.Op n_max} + (hr : Rep n_max U V w base e x) + (hv : (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).valid e o) : + encode U o = rawEncode o := by + cases o with + | isEmpty | get _ | insert _ _ | extractMin => rfl + | decreaseKey h u' => + obtain ⟨s, rfl, hrep⟩ := hr + obtain ⟨u, v, hsh, hu'⟩ := hv + have hu_lt : u < U := (hrep.2.2.2.2.2.2.2.1 h u v hsh).1 + have hu'_lt : u' < U := Nat.lt_of_le_of_lt hu' hu_lt + funext i + simp only [encode, rawEncode, hu'_lt, ↓reduceIte] + +/-! ## Initialization: `incCur_eval`, `allocSpan_exec`, `initSetup_exec` -/ + +private theorem execWithin_exactAdd48 {w : ℕ} {x : Data rMinPQ} {d i j : Fin rMinPQ} + (hfit : Fits w (x.regs i + x.regs j)) : + ExecWithin (B := .exact) w (.op (.exactBin .add d i j)) x + (x.set d (x.regs i + x.regs j)) 1 := + ExecWithin.op (by + rw [Op.eval_exactBin] + simp only [BinOp.evalExact, Option.bind_some] + exact Data.put_of_fits hfit) + +private theorem execWithin_exactSub48 {w : ℕ} {x : Data rMinPQ} {d i j : Fin rMinPQ} + (hle : x.regs j ≤ x.regs i) (hfit : Fits w (x.regs i - x.regs j)) : + ExecWithin (B := .exact) w (.op (.exactBin .sub d i j)) x + (x.set d (x.regs i - x.regs j)) 1 := + ExecWithin.op (by + rw [Op.eval_exactBin] + simp only [BinOp.evalExact, hle, ↓reduceIte, Option.bind_some] + exact Data.put_of_fits hfit) + +theorem incCur_eval {w : ℕ} {x : Data rMinPQ} (h1 : x.regs oneReg = 1) + (hfit : Fits w (x.regs curReg + 1)) : + (Op.exactBin .add curReg curReg oneReg).eval w x = + some (x.set curReg (x.regs curReg + 1)) := by + rw [Op.eval_exactBin] + simp only [BinOp.evalExact, h1, Option.bind_some] + exact Data.put_of_fits hfit + +theorem allocSpan_exec {n_max w base : ℕ} (hS : Fits w (base + space n_max)) + {x : Data rMinPQ} (hx : x.Bounded w) (hfr : x.regs outerFrontierReg = base) + (hpar : ∀ j : Fin 1, x.regs (![nReg] j) = ![n_max] j) : + ∃ x₁, ExecWithin w allocSpan x x₁ 15 ∧ x₁.mem = x.mem ∧ + x₁.regs baseReg = base ∧ x₁.regs outerFrontierReg = base + space n_max ∧ + (∀ j : Fin 1, x₁.regs (![nReg] j) = ![n_max] j) := by + have hn : x.regs nReg = n_max := hpar 0 + have hS_fib : Fits w (base + FibonacciHeap.space n_max) := by + rw [space_eq_fib_add] at hS + exact hS.of_le (by omega) + let x0 := x.set valBaseReg base + have e0 : ExecWithin (B := .exact) w (.op (.copy valBaseReg outerFrontierReg)) x x0 1 := by + simpa only [hfr] using + (ExecWithin.copy (B := .exact) (w := w) (x := x) (d := valBaseReg) (s := outerFrontierReg)) + have hx0_b : (x0.comap f42).Bounded w := (e0.bounded hx).comap f42 + have hx0_fr : (x0.comap f42).regs FibonacciHeap.frontierReg = base := by + change x0.regs valBaseReg = base + simp only [x0, Data.set_regs, Function.update_self] + have hx0_par : ∀ j : Fin 1, (x0.comap f42).regs (![FibonacciHeap.nReg] j) = ![n_max] j := by + intro j + fin_cases j + change x0.regs nReg = n_max + simp only [x0, Data.set_regs, Function.update_of_ne (by decide : nReg ≠ valBaseReg), hn] + obtain ⟨y_fib, he_fib, hm_fib, hb_fib, hfr_fib, hpar_fib⟩ := + FibonacciHeap.allocSpan_exec hS_fib hx0_b hx0_fr hx0_par + let x1 := y_fib.extend f42 x0 + have e1 : ExecWithin w (FibonacciHeap.allocSpan.rename f42) x0 x1 12 := + he_fib.rename f42_injective + have hx1_vb : x1.regs valBaseReg = base + FibonacciHeap.space n_max := by + change (x1.comap f42).regs FibonacciHeap.frontierReg = base + FibonacciHeap.space n_max + rw [Data.comap_extend f42_injective] + exact hfr_fib + have hx1_b : x1.regs baseReg = base := by + change (x1.comap f42).regs FibonacciHeap.baseReg = base + rw [Data.comap_extend f42_injective] + exact hb_fib + have hx1_n : x1.regs nReg = n_max := by + change (x1.comap f42).regs FibonacciHeap.nReg = n_max + rw [Data.comap_extend f42_injective] + exact hpar_fib 0 + let x2 := x1.set freeBaseReg (base + FibonacciHeap.space n_max + n_max) + have e2 : ExecWithin w (.op (.exactBin .add freeBaseReg valBaseReg nReg)) x1 x2 1 := by + simpa only [hx1_vb, hx1_n] using + execWithin_exactAdd48 (x := x1) (d := freeBaseReg) (i := valBaseReg) (j := nReg) + (by rw [hx1_vb, hx1_n]; rw [space_eq_fib_add] at hS; exact hS.of_le (by omega)) + have hx2_fb : x2.regs freeBaseReg = base + FibonacciHeap.space n_max + n_max := by + simp only [x2, Data.set_regs, Function.update_self] + have hx2_n : x2.regs nReg = n_max := by + simp only [x2, Data.set_regs, Function.update_of_ne (by decide : nReg ≠ freeBaseReg), hx1_n] + let x3 := x2.set outerFrontierReg (base + space n_max) + have e3 : ExecWithin w (.op (.exactBin .add outerFrontierReg freeBaseReg nReg)) x2 x3 1 := by + have heq : base + FibonacciHeap.space n_max + n_max + n_max = base + space n_max := by + rw [space_eq_fib_add]; omega + simpa only [hx2_fb, hx2_n, heq] using + execWithin_exactAdd48 (x := x2) (d := outerFrontierReg) (i := freeBaseReg) (j := nReg) + (by rw [hx2_fb, hx2_n, heq]; exact hS) + have he : ExecWithin w allocSpan x x3 15 := by + unfold allocSpan + exact (e0.seq (e1.seq (e2.seq e3))).mono (by omega) + refine ⟨x3, he, hm_fib, ?_, ?_, ?_⟩ + · simp only [x3, x2, Data.set_regs, + Function.update_of_ne (by decide : baseReg ≠ outerFrontierReg), + Function.update_of_ne (by decide : baseReg ≠ freeBaseReg), hx1_b] + · simp only [x3, Data.set_regs, Function.update_self] + · intro j + fin_cases j + change x3.regs nReg = n_max + simp only [x3, Data.set_regs, + Function.update_of_ne (by decide : nReg ≠ outerFrontierReg), hx2_n] + +theorem initSetup_exec {n_max U V w base : ℕ} {x₁ : Data rMinPQ} + (hx₁ : x₁.Bounded w) (hb₁ : x₁.regs baseReg = base) + (hfr₁ : x₁.regs outerFrontierReg = base + space n_max) + (hpar₁ : ∀ j : Fin 1, x₁.regs (![nReg] j) = ![n_max] j) + (hz : ∀ a ∈ (Block.mk base (space n_max)).footprint, x₁.mem a = 0) : + ∃ y, ExecWithin w initSetup x₁ y 18 ∧ y.regs outerFrontierReg = base + space n_max ∧ + Rep n_max U V w base (Cslib.Algorithms.Lean.MinPQ.empty n_max) y ∧ potential y ≤ 0 ∧ + Modifies (Block.mk base (space n_max)).footprint x₁.mem y.mem := by + have hn : x₁.regs nReg = n_max := hpar₁ 0 + have hS : Fits w (base + space n_max) := hfr₁ ▸ hx₁.1 outerFrontierReg + have hfit0 : Fits w 0 := hS.of_le (Nat.zero_le _) + let s1 := x₁.set freeBaseReg (base + FibonacciHeap.space n_max + n_max) + have e1 : ExecWithin w (.op (.exactBin .sub freeBaseReg outerFrontierReg nReg)) x₁ s1 1 := by + have hsub : base + space n_max - n_max = base + FibonacciHeap.space n_max + n_max := by + rw [space_eq_fib_add]; omega + simpa only [hfr₁, hn, hsub] using + execWithin_exactSub48 (x := x₁) (d := freeBaseReg) (i := outerFrontierReg) (j := nReg) + (by rw [hfr₁, hn, space_eq_fib_add]; omega) + (by rw [hfr₁, hn, hsub]; rw [space_eq_fib_add] at hS; exact hS.of_le (by omega)) + have hs1_fb : s1.regs freeBaseReg = base + FibonacciHeap.space n_max + n_max := by + simp only [s1, Data.set_regs, Function.update_self] + have hs1_n : s1.regs nReg = n_max := by + simp only [s1, Data.set_regs, Function.update_of_ne (by decide : nReg ≠ freeBaseReg), hn] + let s2 := s1.set valBaseReg (base + FibonacciHeap.space n_max) + have e2 : ExecWithin w (.op (.exactBin .sub valBaseReg freeBaseReg nReg)) s1 s2 1 := by + simpa only [hs1_fb, hs1_n, Nat.add_sub_cancel] using + execWithin_exactSub48 (x := s1) (d := valBaseReg) (i := freeBaseReg) (j := nReg) + (by rw [hs1_fb, hs1_n]; omega) + (by + rw [hs1_fb, hs1_n, Nat.add_sub_cancel] + rw [space_eq_fib_add] at hS + exact hS.of_le (by omega)) + let s3 := s2.set freshReg 0 + have e3 : ExecWithin (B := .exact) w (.op (.const freshReg 0)) s2 s3 1 := + ExecWithin.const hfit0 + let s4 := s3.set freeTopReg 0 + have e4 : ExecWithin (B := .exact) w (.op (.const freeTopReg 0)) s3 s4 1 := + ExecWithin.const hfit0 + have hs4_b : s4.Bounded w := e4.bounded (e3.bounded (e2.bounded (e1.bounded hx₁))) + have hs4_base : (s4.comap f42).regs FibonacciHeap.baseReg = base := by + change s4.regs baseReg = base + simp only [s4, s3, s2, s1, Data.set_regs, + Function.update_of_ne (by decide : baseReg ≠ freeTopReg), + Function.update_of_ne (by decide : baseReg ≠ freshReg), + Function.update_of_ne (by decide : baseReg ≠ valBaseReg), + Function.update_of_ne (by decide : baseReg ≠ freeBaseReg), hb₁] + have hs4_fr : (s4.comap f42).regs FibonacciHeap.frontierReg = + base + FibonacciHeap.space n_max := by + change s4.regs valBaseReg = base + FibonacciHeap.space n_max + simp only [s4, s3, s2, Data.set_regs, + Function.update_of_ne (by decide : valBaseReg ≠ freeTopReg), + Function.update_of_ne (by decide : valBaseReg ≠ freshReg), + Function.update_self] + have hs4_par : ∀ j : Fin 1, (s4.comap f42).regs (![FibonacciHeap.nReg] j) = ![n_max] j := by + intro j + fin_cases j + change s4.regs nReg = n_max + simp only [s4, s3, s2, Data.set_regs, + Function.update_of_ne (by decide : nReg ≠ freeTopReg), + Function.update_of_ne (by decide : nReg ≠ freshReg), + Function.update_of_ne (by decide : nReg ≠ valBaseReg), hs1_n] + have hz_fib : ∀ a ∈ (Block.mk base (FibonacciHeap.space n_max)).footprint, + (s4.comap f42).mem a = 0 := + fun a ha => hz a (fib_footprint_subset ha) + obtain ⟨y_fib, he_fib, hfr_fib, hinv_fib, hpot_fib, hmod_fib⟩ := + FibonacciHeap.initSetup_exec (K_max := U) (hs4_b.comap f42) hs4_base hs4_fr hs4_par hz_fib + let y := y_fib.extend f42 s4 + have e5 : ExecWithin w (FibonacciHeap.initSetup.rename f42) s4 y 14 := + he_fib.rename f42_injective + have he : ExecWithin w initSetup x₁ y 18 := by + unfold initSetup + exact (e1.seq (e2.seq (e3.seq (e4.seq e5)))).mono (by omega) + have hy_ofr : y.regs outerFrontierReg = base + space n_max := by + rw [Data.extend_regs_of_notMem y_fib s4 outerFrontierReg_notMem_range] + simp only [s4, s3, s2, s1, Data.set_regs, + Function.update_of_ne (by decide : outerFrontierReg ≠ freeTopReg), + Function.update_of_ne (by decide : outerFrontierReg ≠ freshReg), + Function.update_of_ne (by decide : outerFrontierReg ≠ valBaseReg), + Function.update_of_ne (by decide : outerFrontierReg ≠ freeBaseReg), hfr₁] + refine ⟨y, he, hy_ofr, + ⟨Cslib.Algorithms.Lean.MinPQ.AllocState.empty n_max, rfl, + he.bounded hx₁, ?_, + Cslib.Algorithms.Lean.MinPQ.AllocState.wellFormed_empty n_max, + hy_ofr, ?_, ?_, ?_, ?_, + fun _ hi => absurd hi (Nat.not_lt_zero _)⟩, + ?_, modifies_of_fib hmod_fib⟩ + · rw [Data.comap_extend f42_injective] + exact hinv_fib + · rw [Data.extend_regs_of_notMem y_fib s4 freeBaseReg_notMem_range] + simp only [s4, s3, s2, Data.set_regs, + Function.update_of_ne (by decide : freeBaseReg ≠ freeTopReg), + Function.update_of_ne (by decide : freeBaseReg ≠ freshReg), + Function.update_of_ne (by decide : freeBaseReg ≠ valBaseReg), hs1_fb] + · rw [Data.extend_regs_of_notMem y_fib s4 freshReg_notMem_range] + simp only [s4, s3, Data.set_regs, + Function.update_of_ne (by decide : freshReg ≠ freeTopReg), Function.update_self] + rfl + · rw [Data.extend_regs_of_notMem y_fib s4 freeTopReg_notMem_range] + simp only [s4, Data.set_regs, Function.update_self] + rfl + · rintro _ _ _ ⟨⟩ + · unfold potential + rw [Data.comap_extend f42_injective] + exact hpot_fib + +/-! ## Operation specifications: `isEmptyCode`, `getCode`, `insertCode` -/ + +theorem AllocRep.fits_stop {n_max U V w base : ℕ} + {s : Cslib.Algorithms.Lean.MinPQ.AllocState n_max} {x : Data rMinPQ} + (hrep : AllocRep n_max U V w base s x) : Fits w (base + space n_max) := + hrep.2.2.2.1 ▸ hrep.1.1 outerFrontierReg + +theorem AllocRep.valBase_eq {n_max U V w base : ℕ} + {s : Cslib.Algorithms.Lean.MinPQ.AllocState n_max} {x : Data rMinPQ} + (hrep : AllocRep n_max U V w base s x) : + x.regs valBaseReg = base + FibonacciHeap.space n_max := + hrep.2.1.2.1.2.1 + +theorem AllocRep.zeroP_eq {n_max U V w base : ℕ} + {s : Cslib.Algorithms.Lean.MinPQ.AllocState n_max} {x : Data rMinPQ} + (hrep : AllocRep n_max U V w base s x) : x.regs zeroP = 0 := + hrep.2.1.2.1.2.2.2.2.2.2.2.2.2.2.2.1 + +theorem AllocRep.oneP_eq {n_max U V w base : ℕ} + {s : Cslib.Algorithms.Lean.MinPQ.AllocState n_max} {x : Data rMinPQ} + (hrep : AllocRep n_max U V w base s x) : x.regs oneP = 1 := + hrep.2.1.2.1.2.2.2.2.2.2.2.2.2.2.2.2 + +theorem isEmptyCode_exec {n_max U V w base : ℕ} + {s : Cslib.Algorithms.Lean.MinPQ.AllocState n_max} {x : Data rMinPQ} + (hrep : AllocRep n_max U V w base s x) : + ∃ y t, ExecWithin w isEmptyCode x y t ∧ + decode (n_max := n_max) (U := U) (V := V) .isEmpty y.regs = + some (Cslib.Algorithms.Lean.MinPQ.stepAlloc s .isEmpty).2 ∧ + AllocRep n_max U V w base (Cslib.Algorithms.Lean.MinPQ.stepAlloc s .isEmpty).1 y ∧ + Modifies (Block.mk base (space n_max)).footprint x.mem y.mem ∧ + t + potential y ≤ 3 + potential x := by + obtain ⟨hb, hfib, hwf, hfr, hfb, hfresh, htop, hval, hfree⟩ := hrep + obtain ⟨y_fib, t, he_fib, hdec_fib, hinv_fib, hmod_fib, hpot_fib⟩ := + FibonacciHeap.isEmptyCode_exec hfib + let y := y_fib.extend f42 x + have he : ExecWithin w isEmptyCode x y t := he_fib.rename f42_injective + have hmem_ge : ∀ a, base + FibonacciHeap.space n_max ≤ a → y.mem a = x.mem a := + fun a ha => hmod_fib a (notMem_fib_footprint_of_ge ha) + refine ⟨y, t, he, ?_, + ⟨he.bounded hb, ?_, hwf, + (Data.extend_regs_of_notMem y_fib x outerFrontierReg_notMem_range).trans hfr, + (Data.extend_regs_of_notMem y_fib x freeBaseReg_notMem_range).trans hfb, + (Data.extend_regs_of_notMem y_fib x freshReg_notMem_range).trans hfresh, + (Data.extend_regs_of_notMem y_fib x freeTopReg_notMem_range).trans htop, + fun h u v hsh => ⟨(hval h u v hsh).1, (hval h u v hsh).2.1, + (hmem_ge _ (Nat.le_add_right _ _)).trans (hval h u v hsh).2.2⟩, + fun i hi => (hmem_ge _ (by omega)).trans (hfree i hi)⟩, + modifies_of_fib hmod_fib, ?_⟩ + · simp only [PQCode.decode, FibonacciHeap.code, Cslib.Algorithms.Lean.MinPQ.dom_toIndexed] + at hdec_fib + have hfl_eq : y.regs outFlag = y_fib.regs FibonacciHeap.outFlag := by + change (y.comap f42).regs FibonacciHeap.outFlag = y_fib.regs FibonacciHeap.outFlag + rw [Data.comap_extend f42_injective] + simp only [decode, Cslib.Algorithms.Lean.MinPQ.stepAlloc, hfl_eq] + exact hdec_fib + · simp only [Cslib.Algorithms.Lean.MinPQ.stepAlloc] + rw [Data.comap_extend f42_injective] + exact hinv_fib + · unfold potential + rw [Data.comap_extend f42_injective] + exact hpot_fib + +theorem getCode_exec {n_max U V w base : ℕ} + {s : Cslib.Algorithms.Lean.MinPQ.AllocState n_max} {x : Data rMinPQ} + (h : Fin n_max) (hrep : AllocRep n_max U V w base s x) (hv_reg : x.regs argV = h.val) : + ∃ y t, ExecWithin w getCode x y t ∧ + decode (n_max := n_max) (U := U) (V := V) (.get h) y.regs = + some (Cslib.Algorithms.Lean.MinPQ.stepAlloc s (.get h)).2 ∧ + AllocRep n_max U V w base (Cslib.Algorithms.Lean.MinPQ.stepAlloc s (.get h)).1 y ∧ + Modifies (Block.mk base (space n_max)).footprint x.mem y.mem ∧ + t + potential y ≤ 11 + potential x := by + have hfit_stop := hrep.fits_stop + obtain ⟨hb, hfib, hwf, hfr, hfb, hfresh, htop, hval, hfree⟩ := hrep + obtain ⟨y_fib, t1, he_fib, hdec_fib, hinv_fib, hmod_fib, hpot_fib⟩ := + FibonacciHeap.getKeyCode_exec h hfib hv_reg + let x1 := y_fib.extend f42 x + have he1 : ExecWithin w (FibonacciHeap.getKeyCode.rename f42) x x1 t1 := + he_fib.rename f42_injective + have hmem1_ge : ∀ a, base + FibonacciHeap.space n_max ≤ a → x1.mem a = x.mem a := + fun a ha => hmod_fib a (notMem_fib_footprint_of_ge ha) + have hrep1 : AllocRep n_max U V w base s x1 := + ⟨he1.bounded hb, by rw [Data.comap_extend f42_injective]; exact hinv_fib, hwf, + (Data.extend_regs_of_notMem y_fib x outerFrontierReg_notMem_range).trans hfr, + (Data.extend_regs_of_notMem y_fib x freeBaseReg_notMem_range).trans hfb, + (Data.extend_regs_of_notMem y_fib x freshReg_notMem_range).trans hfresh, + (Data.extend_regs_of_notMem y_fib x freeTopReg_notMem_range).trans htop, + fun h' u' v' hsh' => ⟨(hval h' u' v' hsh').1, (hval h' u' v' hsh').2.1, + (hmem1_ge _ (Nat.le_add_right _ _)).trans (hval h' u' v' hsh').2.2⟩, + fun i hi => (hmem1_ge _ (by omega)).trans (hfree i hi)⟩ + have hx1_z0 : x1.regs zeroP = 0 := hrep1.zeroP_eq + have hx1_vb : x1.regs valBaseReg = base + FibonacciHeap.space n_max := hrep1.valBase_eq + have hx1_v : x1.regs argV = h.val := by + change (x1.comap f42).regs FibonacciHeap.argV = h.val + rw [Data.comap_extend f42_injective] + exact (he_fib.regs_eq (by decide)).trans hv_reg + have hx1_fl : x1.regs outFlag = y_fib.regs FibonacciHeap.outFlag := by + change (x1.comap f42).regs FibonacciHeap.outFlag = y_fib.regs FibonacciHeap.outFlag + rw [Data.comap_extend f42_injective] + have hx1_ok : x1.regs outK = y_fib.regs FibonacciHeap.outK := by + change (x1.comap f42).regs FibonacciHeap.outK = y_fib.regs FibonacciHeap.outK + rw [Data.comap_extend f42_injective] + cases hsh : s.entries h with + | none => + have hfl0 : x1.regs outFlag = 0 := by + rw [hx1_fl] + simp only [PQCode.decode, FibonacciHeap.code, Cslib.Algorithms.Lean.MinPQ.toIndexed_apply, + hsh, Option.map_none] at hdec_fib + by_contra hne + simp only [hne, ↓reduceIte] at hdec_fib + nomatch hdec_fib + have hc : (Cond.eq outFlag zeroP).Holds x1 := by simp only [Cond.Holds, hx1_z0, hfl0] + let y := x1.set s0 0 + have he2 : ExecWithin (B := .exact) w + (.branch (.eq outFlag zeroP) (.op (.copy s0 zeroP)) + (.seq (.op (.exactBin .add s0 valBaseReg argV)) (.op (.load outValReg s0)))) x1 y 2 := + ExecWithin.branch_pos hc (by simpa only [hx1_z0] using + (ExecWithin.copy (B := .exact) (w := w) (x := x1) (d := s0) (s := zeroP))) + have hreg_y : ∀ i : Fin rMinPQ, inputReg i = false → y.regs i = x1.regs i := fun i hi => by + have hne : i ≠ s0 := fun e => by subst e; cases hi + simp only [y, Data.set_regs, Function.update_of_ne hne] + refine ⟨y, t1 + 2, he1.seq he2, ?_, + hrep1.supported hreg_y (fun _ _ => rfl) (he2.bounded hrep1.1), + modifies_of_fib hmod_fib, ?_⟩ + · simp only [decode, Cslib.Algorithms.Lean.MinPQ.stepAlloc, hsh, y, Data.set_regs, + Function.update_of_ne (by decide : outFlag ≠ s0), hfl0, ↓reduceIte] + rfl + · rw [potential_supported hreg_y] + change t1 + 2 + FibonacciHeap.potential (x1.comap f42) ≤ 11 + potential x + rw [Data.comap_extend f42_injective] + change t1 + FibonacciHeap.potential y_fib ≤ 7 + FibonacciHeap.potential (x.comap f42) + at hpot_fib + unfold potential + omega + | some uv => + rcases uv with ⟨u, v⟩ + simp only [PQCode.decode, FibonacciHeap.code, Cslib.Algorithms.Lean.MinPQ.toIndexed_apply, + hsh, Option.map_some] at hdec_fib + have hfl_ne : x1.regs outFlag ≠ 0 := by + rw [hx1_fl] + intro h0 + simp only [h0, ↓reduceIte] at hdec_fib + nomatch hdec_fib + have hok_eq : x1.regs outK = u := by + rw [hx1_ok] + simp only [hx1_fl ▸ hfl_ne, ↓reduceIte] at hdec_fib + exact Option.some.inj (Option.some.inj hdec_fib) + have hc : ¬(Cond.eq outFlag zeroP).Holds x1 := by simp only [Cond.Holds, hx1_z0]; exact hfl_ne + let y := (x1.set s0 (base + FibonacciHeap.space n_max + h.val)).set outValReg v + have he2 : ExecWithin (B := .exact) w + (.branch (.eq outFlag zeroP) (.op (.copy s0 zeroP)) + (.seq (.op (.exactBin .add s0 valBaseReg argV)) (.op (.load outValReg s0)))) x1 y 4 := by + have hh_lt := h.isLt + have ea : ExecWithin w (.op (.exactBin .add s0 valBaseReg argV)) x1 + (x1.set s0 (base + FibonacciHeap.space n_max + h.val)) 1 := by + simpa only [hx1_vb, hx1_v] using + execWithin_exactAdd48 (x := x1) (d := s0) (i := valBaseReg) (j := argV) + (by rw [hx1_vb, hx1_v]; rw [space_eq_fib_add] at hfit_stop; + exact hfit_stop.of_le (by omega)) + have el : ExecWithin (B := .exact) w (.op (.load outValReg s0)) + (x1.set s0 (base + FibonacciHeap.space n_max + h.val)) y 1 := by + have hm_v : x1.mem (base + FibonacciHeap.space n_max + h.val) = v := + (hrep1.2.2.2.2.2.2.2.1 h u v hsh).2.2 + simpa only [Data.set_mem, Data.set_regs, Function.update_self, hm_v] using + (ExecWithin.load (B := .exact) (w := w) + (x := x1.set s0 (base + FibonacciHeap.space n_max + h.val)) + (d := outValReg) (a := s0)) + exact ExecWithin.branch_neg hc (ea.seq el) + have hreg_y : ∀ i : Fin rMinPQ, inputReg i = false → y.regs i = x1.regs i := fun i hi => by + have h1 : i ≠ outValReg := fun e => by subst e; cases hi + have h2 : i ≠ s0 := fun e => by subst e; cases hi + simp only [y, Data.set_regs, Function.update_of_ne h1, Function.update_of_ne h2] + refine ⟨y, t1 + 4, he1.seq he2, ?_, + hrep1.supported hreg_y (fun _ _ => rfl) (he2.bounded hrep1.1), + modifies_of_fib hmod_fib, ?_⟩ + · simp only [decode, Cslib.Algorithms.Lean.MinPQ.stepAlloc, hsh, y, Data.set_regs, + Function.update_of_ne (by decide : outFlag ≠ outValReg), + Function.update_of_ne (by decide : outFlag ≠ s0), + Function.update_of_ne (by decide : outK ≠ outValReg), + Function.update_of_ne (by decide : outK ≠ s0), + Function.update_self, hfl_ne, hok_eq, ↓reduceIte] + rfl + · rw [potential_supported hreg_y] + change t1 + 4 + FibonacciHeap.potential (x1.comap f42) ≤ 11 + potential x + rw [Data.comap_extend f42_injective] + change t1 + FibonacciHeap.potential y_fib ≤ 7 + FibonacciHeap.potential (x.comap f42) + at hpot_fib + unfold potential + omega + +private def allocHandleBranch : Code .exact rMinPQ := + ram_exact[ + if freeTopReg = zeroP then [ + argV ← freshReg; + freshReg ← freshReg + oneP + ] else [ + freeTopReg ← freeTopReg - oneP; + s0 ← freeBaseReg + freeTopReg; + argV ← *s0 + ] + ] + +private theorem allocHandleBranch_exec {n_max U V w base u v : ℕ} + {s : Cslib.Algorithms.Lean.MinPQ.AllocState n_max} {x : Data rMinPQ} + (hrep : AllocRep n_max U V w base s x) + (hsz : Cslib.Algorithms.Lean.MinPQ.size s.entries < n_max) : + ∃ h freeList' fresh' x1, + Cslib.Algorithms.Lean.MinPQ.allocHandle s = some (h, freeList', fresh') ∧ + s.entries h = none ∧ + (Cslib.Algorithms.Lean.MinPQ.AllocState.mk + (Function.update s.entries h (some (u, v))) freeList' fresh').WellFormed ∧ + ExecWithin w allocHandleBranch x x1 5 ∧ + x1.Bounded w ∧ + x1.mem = x.mem ∧ + x1.regs argV = h.val ∧ + x1.regs freshReg = fresh' ∧ + x1.regs freeTopReg = freeList'.length ∧ + (∀ i : Fin rMinPQ, i ≠ argV → i ≠ freshReg → i ≠ freeTopReg → i ≠ s0 → + x1.regs i = x.regs i) ∧ + (∀ (i : ℕ) (hi : i < freeList'.length), + x.mem (base + FibonacciHeap.space n_max + n_max + (freeList'.length - 1 - i)) = + (freeList'[i]).val) := by + have hfit_stop := hrep.fits_stop + have hz0 := hrep.zeroP_eq + have ho1 := hrep.oneP_eq + obtain ⟨hb, _, hwf, _, hfb, hfresh, htop, _, hfree⟩ := hrep + obtain ⟨h, freeList', fresh', halloc, hh_none, hwf'⟩ := + Cslib.Algorithms.Lean.MinPQ.allocHandle_spec hwf hsz u v + have halloc_eq := halloc + rcases hfl : s.freeList with _ | ⟨hd, tl⟩ + · -- Bump-pointer case (`freeList = []`) + have hfr_lt : s.fresh < n_max := by + have hsum := hwf.2.2.2.2 + rw [hfl, List.length_nil, Nat.add_zero] at hsum + omega + simp only [Cslib.Algorithms.Lean.MinPQ.allocHandle, hfl, hfr_lt, ↓reduceDIte, + Option.some.injEq, Prod.mk.injEq] at halloc + obtain ⟨rfl, rfl, rfl⟩ := halloc + have hc : (Cond.eq freeTopReg zeroP).Holds x := by + simp only [Cond.Holds, htop, hfl, List.length_nil, hz0] + let x1 := (x.set argV s.fresh).set freshReg (s.fresh + 1) + have e1 : ExecWithin (B := .exact) w (.op (.copy argV freshReg)) x (x.set argV s.fresh) 1 := by + simpa only [hfresh] using + (ExecWithin.copy (B := .exact) (w := w) (x := x) (d := argV) (s := freshReg)) + have e2 : ExecWithin w (.op (.exactBin .add freshReg freshReg oneP)) + (x.set argV s.fresh) x1 1 := by + have hfr1 : (x.set argV s.fresh).regs freshReg = s.fresh := by + simp only [Data.set_regs, Function.update_of_ne (by decide : freshReg ≠ argV), hfresh] + have ho1' : (x.set argV s.fresh).regs oneP = 1 := by + simp only [Data.set_regs, Function.update_of_ne (by decide : oneP ≠ argV), ho1] + simpa only [hfr1, ho1'] using + execWithin_exactAdd48 (x := x.set argV s.fresh) (d := freshReg) (i := freshReg) (j := oneP) + (by rw [hfr1, ho1']; have := space_lower n_max; exact hfit_stop.of_le (by omega)) + have he : ExecWithin w allocHandleBranch x x1 5 := by + unfold allocHandleBranch + exact (ExecWithin.branch_pos hc (e1.seq e2)).mono (by omega) + refine ⟨⟨s.fresh, hfr_lt⟩, [], s.fresh + 1, x1, halloc_eq, hh_none, hwf', he, + he.bounded hb, rfl, + by simp only [x1, Data.set_regs, Function.update_of_ne (by decide : argV ≠ freshReg), + Function.update_self], + by simp only [x1, Data.set_regs, Function.update_self], + by simp only [x1, Data.set_regs, Function.update_of_ne (by decide : freeTopReg ≠ freshReg), + Function.update_of_ne (by decide : freeTopReg ≠ argV), htop, hfl, List.length_nil], + fun i h1 h2 _ _ => by simp only [x1, Data.set_regs, Function.update_of_ne h2, + Function.update_of_ne h1], + fun _ hi => absurd hi (Nat.not_lt_zero _)⟩ + · -- Free-stack pop case (`freeList = hd :: tl`) + simp only [Cslib.Algorithms.Lean.MinPQ.allocHandle, hfl, Option.some.injEq, + Prod.mk.injEq] at halloc + obtain ⟨rfl, rfl, rfl⟩ := halloc + have htop_eq : x.regs freeTopReg = tl.length + 1 := by + rw [htop, hfl, List.length_cons] + have hc : ¬(Cond.eq freeTopReg zeroP).Holds x := by + simp only [Cond.Holds, htop_eq, hz0]; omega + have htl_lt : tl.length < n_max := by + have hsum := hwf.2.2.2.2 + have hfr_le := hwf.1 + rw [hfl, List.length_cons] at hsum + omega + have hm_top : x.mem (base + FibonacciHeap.space n_max + n_max + tl.length) = hd.val := by + have h0 := hfree 0 (by simp only [hfl, List.length_cons]; omega) + simpa only [hfl, List.length_cons, Nat.add_sub_cancel, Nat.sub_zero, + List.getElem_cons_zero] using h0 + let a1 := x.set freeTopReg tl.length + let a2 := a1.set s0 (base + FibonacciHeap.space n_max + n_max + tl.length) + let x1 := a2.set argV hd.val + have e1 : ExecWithin w (.op (.exactBin .sub freeTopReg freeTopReg oneP)) x a1 1 := by + simpa only [htop_eq, ho1, Nat.add_sub_cancel] using + execWithin_exactSub48 (x := x) (d := freeTopReg) (i := freeTopReg) (j := oneP) + (by rw [htop_eq, ho1]; omega) + (by rw [htop_eq, ho1, Nat.add_sub_cancel]; have := space_lower n_max; + exact hfit_stop.of_le (by omega)) + have e2 : ExecWithin w (.op (.exactBin .add s0 freeBaseReg freeTopReg)) a1 a2 1 := by + have ha1_fb : a1.regs freeBaseReg = base + FibonacciHeap.space n_max + n_max := by + simp only [a1, Data.set_regs, + Function.update_of_ne (by decide : freeBaseReg ≠ freeTopReg), hfb] + have ha1_top : a1.regs freeTopReg = tl.length := by + simp only [a1, Data.set_regs, Function.update_self] + simpa only [ha1_fb, ha1_top] using + execWithin_exactAdd48 (x := a1) (d := s0) (i := freeBaseReg) (j := freeTopReg) + (by rw [ha1_fb, ha1_top]; rw [space_eq_fib_add] at hfit_stop; + exact hfit_stop.of_le (by omega)) + have e3 : ExecWithin (B := .exact) w (.op (.load argV s0)) a2 x1 1 := by + simpa only [a2, a1, Data.set_mem, Data.set_regs, Function.update_self, hm_top] using + (ExecWithin.load (B := .exact) (w := w) (x := a2) (d := argV) (a := s0)) + have he : ExecWithin w allocHandleBranch x x1 5 := by + unfold allocHandleBranch + exact ExecWithin.branch_neg hc (e1.seq (e2.seq e3)) + refine ⟨hd, tl, s.fresh, x1, halloc_eq, hh_none, hwf', he, he.bounded hb, rfl, + by simp only [x1, Data.set_regs, Function.update_self], + by simp only [x1, a2, a1, Data.set_regs, + Function.update_of_ne (by decide : freshReg ≠ argV), + Function.update_of_ne (by decide : freshReg ≠ s0), + Function.update_of_ne (by decide : freshReg ≠ freeTopReg), hfresh], + by simp only [x1, a2, a1, Data.set_regs, + Function.update_of_ne (by decide : freeTopReg ≠ argV), + Function.update_of_ne (by decide : freeTopReg ≠ s0), Function.update_self], + fun i h1 _ h3 h4 => by simp only [x1, a2, a1, Data.set_regs, + Function.update_of_ne h1, Function.update_of_ne h4, Function.update_of_ne h3], + fun i hi => ?_⟩ + have hi' : i + 1 < s.freeList.length := by simp only [hfl, List.length_cons]; omega + have hfi := hfree (i + 1) hi' + have hidx : s.freeList.length - 1 - (i + 1) = tl.length - 1 - i := by + simp only [hfl, List.length_cons]; omega + have hget : (s.freeList[i + 1]'hi') = tl[i] := by simp only [hfl, List.getElem_cons_succ] + rw [hidx, hget] at hfi + exact hfi + +theorem insertCode_exec {n_max U V w base u v : ℕ} + {s : Cslib.Algorithms.Lean.MinPQ.AllocState n_max} {x : Data rMinPQ} + (hrep : AllocRep n_max U V w base s x) + (hv : (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).valid s.entries (.insert u v)) + (hk_reg : x.regs argK = u) (hval_reg : x.regs inValReg = v) : + ∃ y t, ExecWithin w insertCode x y t ∧ + decode (n_max := n_max) (U := U) (V := V) (.insert u v) y.regs = + some (Cslib.Algorithms.Lean.MinPQ.stepAlloc s (.insert u v)).2 ∧ + AllocRep n_max U V w base (Cslib.Algorithms.Lean.MinPQ.stepAlloc s (.insert u v)).1 y ∧ + Modifies (Block.mk base (space n_max)).footprint x.mem y.mem ∧ + t + potential y ≤ 129 + potential x := by + have hfit_stop := hrep.fits_stop + have hvb := hrep.valBase_eq + obtain ⟨hsz, hu_lt, hv_lt⟩ := hv + obtain ⟨h, freeList', fresh', x1, halloc, hh_none, hwf', he_alloc, hb1, hm1, + hx1_v, hx1_fresh, hx1_top, hx1_regs, hfree'⟩ := + allocHandleBranch_exec (u := u) (v := v) hrep hsz + have hh_lt := h.isLt + have ho_val := owns_val_addr (base := base) hh_lt + have hx1_vb : x1.regs valBaseReg = base + FibonacciHeap.space n_max := + (hx1_regs valBaseReg (by decide) (by decide) (by decide) (by decide)).trans hvb + have hx1_inVal : x1.regs inValReg = v := + (hx1_regs inValReg (by decide) (by decide) (by decide) (by decide)).trans hval_reg + let x2 := (x1.set s0 (base + FibonacciHeap.space n_max + h.val)).write + (base + FibonacciHeap.space n_max + h.val) v + have ew1 : ExecWithin w (.op (.exactBin .add s0 valBaseReg argV)) x1 + (x1.set s0 (base + FibonacciHeap.space n_max + h.val)) 1 := by + simpa only [hx1_vb, hx1_v] using + execWithin_exactAdd48 (x := x1) (d := s0) (i := valBaseReg) (j := argV) + (by rw [hx1_vb, hx1_v]; rw [space_eq_fib_add] at hfit_stop; + exact hfit_stop.of_le (by omega)) + have ew2 : ExecWithin (B := .exact) w (.op (.store s0 inValReg)) + (x1.set s0 (base + FibonacciHeap.space n_max + h.val)) x2 1 := by + simpa only [Data.set_regs, Function.update_self, + Function.update_of_ne (by decide : inValReg ≠ s0), hx1_inVal] using + (ExecWithin.store (B := .exact) (w := w) + (x := x1.set s0 (base + FibonacciHeap.space n_max + h.val)) (a := s0) (s := inValReg)) + have hb2 : x2.Bounded w := ew2.bounded (ew1.bounded hb1) + have hreg2 : ∀ j : Fin rFib, FibonacciHeap.inputReg j = false → + (x2.comap f42).regs j = (x.comap f42).regs j := fun j hj => by + have hj_in : inputReg (f42 j) = false := inputReg_f42_of_false j hj + change x2.regs (f42 j) = x.regs (f42 j) + have h1 : f42 j ≠ argV := fun e => by rw [e] at hj_in; cases hj_in + have h2 : f42 j ≠ freshReg := fun e => freshReg_notMem_range ⟨j, e⟩ + have h3 : f42 j ≠ freeTopReg := fun e => freeTopReg_notMem_range ⟨j, e⟩ + have h4 : f42 j ≠ s0 := fun e => by rw [e] at hj_in; cases hj_in + simp only [x2, Data.write_regs, Data.set_regs, Function.update_of_ne h4] + exact hx1_regs (f42 j) h1 h2 h3 h4 + have hmem2_fib : ∀ a ∈ (Block.mk base (FibonacciHeap.space n_max)).footprint, + (x2.comap f42).mem a = (x.comap f42).mem a := fun a ha => by + have hne : a ≠ base + FibonacciHeap.space n_max + h.val := fun e => + notMem_fib_footprint_of_ge (by omega) (e ▸ ha) + simp only [x2, Data.comap, Data.write_mem, Data.set_mem, Function.update_of_ne hne, hm1] + have hinv2 : FibonacciHeap.FibInv n_max U w base + (Cslib.Algorithms.Lean.MinPQ.toIndexed s.entries) (x2.comap f42) := + FibonacciHeap.FibInv.supported hreg2 hmem2_fib (hb2.comap f42) hrep.2.1 + have hpot2 : potential x2 = potential x := + FibonacciHeap.potential_supported hreg2 + have hx2_v : (x2.comap f42).regs FibonacciHeap.argV = h.val := by + change x2.regs argV = h.val + simp only [x2, Data.write_regs, Data.set_regs, + Function.update_of_ne (by decide : argV ≠ s0), hx1_v] + have hx2_k : (x2.comap f42).regs FibonacciHeap.argK = u := by + change x2.regs argK = u + simp only [x2, Data.write_regs, Data.set_regs, + Function.update_of_ne (by decide : argK ≠ s0)] + exact (hx1_regs argK (by decide) (by decide) (by decide) (by decide)).trans hk_reg + have hval_fib : Cslib.Algorithms.Lean.MinPQ.toIndexed s.entries h = none ∧ u ≤ U := by + simp only [Cslib.Algorithms.Lean.MinPQ.toIndexed_apply, hh_none, Option.map_none, true_and] + exact Nat.le_of_lt hu_lt + obtain ⟨y_fib, t_fib, he_fib, hinv_fib, hmod_fib, hpot_fib⟩ := + FibonacciHeap.insertCode_exec h u hinv2 hval_fib hx2_v hx2_k + let x3 := y_fib.extend f42 x2 + have he3 : ExecWithin w (FibonacciHeap.insertCode.rename f42) x2 x3 t_fib := + he_fib.rename f42_injective + have hx3_v : x3.regs argV = h.val := by + change (x3.comap f42).regs FibonacciHeap.argV = h.val + rw [Data.comap_extend f42_injective] + exact (he_fib.regs_eq (by decide)).trans hx2_v + let y := x3.set outV h.val + have he4 : ExecWithin (B := .exact) w (.op (.copy outV argV)) x3 y 1 := by + simpa only [hx3_v] using + (ExecWithin.copy (B := .exact) (w := w) (x := x3) (d := outV) (s := argV)) + have he : ExecWithin w insertCode x y (5 + 1 + 1 + t_fib + 1) := by + unfold insertCode + exact (he_alloc.seq (ew1.seq (ew2.seq (he3.seq he4)))).mono (by omega) + have hby : y.Bounded w := he4.bounded (he3.bounded hb2) + have hreg_y3 : ∀ i : Fin rMinPQ, inputReg i = false → y.regs i = x3.regs i := fun i hi => by + have hne : i ≠ outV := fun e => by subst e; cases hi + simp only [y, Data.set_regs, Function.update_of_ne hne] + have hmem3_ge : ∀ a, base + FibonacciHeap.space n_max ≤ a → x3.mem a = x2.mem a := + fun a ha => hmod_fib a (notMem_fib_footprint_of_ge ha) + have hmod_all : Modifies (Block.mk base (space n_max)).footprint x.mem y.mem := by + have hm_x2 : Modifies (Block.mk base (space n_max)).footprint x.mem x2.mem := by + change Modifies (Block.mk base (space n_max)).footprint x.mem + (Function.update x1.mem (base + FibonacciHeap.space n_max + h.val) v) + rw [hm1] + exact Modifies.write_of_owns ho_val v + exact modifies_outer_trans hm_x2 (modifies_of_fib hmod_fib) + refine ⟨y, 5 + 1 + 1 + t_fib + 1, he, ?_, ?_, hmod_all, ?_⟩ + · simp only [decode, Cslib.Algorithms.Lean.MinPQ.stepAlloc, halloc, y, Data.set_regs, + Function.update_self, hh_lt, ↓reduceDIte, Fin.eta] + rfl + · simp only [Cslib.Algorithms.Lean.MinPQ.stepAlloc, halloc] + refine AllocRep.supported hreg_y3 (fun _ _ => rfl) hby ⟨he3.bounded hb2, ?_, hwf', + ?_, ?_, ?_, ?_, ?_, ?_⟩ + · dsimp only + rw [Data.comap_extend f42_injective, + Cslib.Algorithms.Lean.MinPQ.toIndexed_update_some s.entries h u v] + exact hinv_fib + · rw [Data.extend_regs_of_notMem y_fib x2 outerFrontierReg_notMem_range] + simp only [x2, Data.write_regs, Data.set_regs, + Function.update_of_ne (by decide : outerFrontierReg ≠ s0)] + exact (hx1_regs outerFrontierReg (by decide) (by decide) (by decide) (by decide)).trans + hrep.2.2.2.1 + · rw [Data.extend_regs_of_notMem y_fib x2 freeBaseReg_notMem_range] + simp only [x2, Data.write_regs, Data.set_regs, + Function.update_of_ne (by decide : freeBaseReg ≠ s0)] + exact (hx1_regs freeBaseReg (by decide) (by decide) (by decide) (by decide)).trans + hrep.2.2.2.2.1 + · rw [Data.extend_regs_of_notMem y_fib x2 freshReg_notMem_range] + simp only [x2, Data.write_regs, Data.set_regs, + Function.update_of_ne (by decide : freshReg ≠ s0), hx1_fresh] + · rw [Data.extend_regs_of_notMem y_fib x2 freeTopReg_notMem_range] + simp only [x2, Data.write_regs, Data.set_regs, + Function.update_of_ne (by decide : freeTopReg ≠ s0), hx1_top] + · intro h' u' v' hsh' + rw [hmem3_ge _ (Nat.le_add_right _ _)] + by_cases hh' : h' = h + · subst hh' + simp only [Function.update_self, Option.some.injEq, Prod.mk.injEq] at hsh' + obtain ⟨rfl, rfl⟩ := hsh' + exact ⟨hu_lt, hv_lt, by simp only [x2, Data.write_mem, Function.update_self]⟩ + · simp only [Function.update_of_ne hh'] at hsh' + have hne_addr : base + FibonacciHeap.space n_max + h'.val ≠ + base + FibonacciHeap.space n_max + h.val := by + have := Fin.val_ne_of_ne hh'; omega + obtain ⟨hu', hv', hm'⟩ := hrep.2.2.2.2.2.2.2.1 h' u' v' hsh' + exact ⟨hu', hv', by simp only [x2, Data.write_mem, Data.set_mem, + Function.update_of_ne hne_addr, hm1, hm']⟩ + · intro i hi + rw [hmem3_ge _ (by omega)] + have hne_addr : + base + FibonacciHeap.space n_max + n_max + (freeList'.length - 1 - i) ≠ + base + FibonacciHeap.space n_max + h.val := by omega + simp only [x2, Data.write_mem, Data.set_mem, Function.update_of_ne hne_addr, hm1] + exact hfree' i hi + · rw [potential_supported hreg_y3] + change 5 + 1 + 1 + t_fib + 1 + FibonacciHeap.potential (x3.comap f42) ≤ 129 + potential x + rw [Data.comap_extend f42_injective] + change t_fib + FibonacciHeap.potential y_fib ≤ 121 + FibonacciHeap.potential (x2.comap f42) + at hpot_fib + change FibonacciHeap.potential (x2.comap f42) = potential x at hpot2 + omega + +theorem decreaseKeyCode_exec {n_max U V w base : ℕ} + {s : Cslib.Algorithms.Lean.MinPQ.AllocState n_max} {x : Data rMinPQ} + (h : Fin n_max) (u' : ℕ) (hrep : AllocRep n_max U V w base s x) + (hv : (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).valid s.entries (.decreaseKey h u')) + (hv_reg : x.regs argV = h.val) (hk_reg : x.regs argK = u') : + ∃ y t, ExecWithin w decreaseKeyCode x y t ∧ + decode (n_max := n_max) (U := U) (V := V) (.decreaseKey h u') y.regs = + some (Cslib.Algorithms.Lean.MinPQ.stepAlloc s (.decreaseKey h u')).2 ∧ + AllocRep n_max U V w base (Cslib.Algorithms.Lean.MinPQ.stepAlloc s (.decreaseKey h u')).1 y ∧ + Modifies (Block.mk base (space n_max)).footprint x.mem y.mem ∧ + t + potential y ≤ 330 + potential x := by + obtain ⟨hb, hfib, hwf, hfr, hfb, hfresh, htop, hval, hfree⟩ := hrep + obtain ⟨u, v, hsh, hu'_le⟩ := hv + obtain ⟨hu_lt, hv_lt, _⟩ := hval h u v hsh + have hu'_lt : u' < U := Nat.lt_of_le_of_lt hu'_le hu_lt + have hval_fib : + (∃ k₀, Cslib.Algorithms.Lean.MinPQ.toIndexed s.entries h = some k₀ ∧ u' ≤ k₀) ∧ u' ≤ U := by + refine ⟨⟨u, ?_, hu'_le⟩, Nat.le_of_lt hu'_lt⟩ + simp only [Cslib.Algorithms.Lean.MinPQ.toIndexed_apply, hsh, Option.map_some] + obtain ⟨y_fib, t, he_fib, hinv_fib, hmod_fib, hpot_fib⟩ := + FibonacciHeap.decreaseKeyCode_exec h u' hfib hval_fib hv_reg hk_reg + let y := y_fib.extend f42 x + have he : ExecWithin w decreaseKeyCode x y t := he_fib.rename f42_injective + have hmem_ge : ∀ a, base + FibonacciHeap.space n_max ≤ a → y.mem a = x.mem a := + fun a ha => hmod_fib a (notMem_fib_footprint_of_ge ha) + have hwf' := + (Cslib.Algorithms.Lean.MinPQ.stepAlloc_refines_spec (U := U) (V := V) hwf + (.decreaseKey h u') ⟨u, v, hsh, hu'_le⟩).2 + refine ⟨y, t, he, rfl, ?_, modifies_of_fib hmod_fib, ?_⟩ + · refine ⟨he.bounded hb, ?_, hwf', + (Data.extend_regs_of_notMem y_fib x outerFrontierReg_notMem_range).trans hfr, + (Data.extend_regs_of_notMem y_fib x freeBaseReg_notMem_range).trans hfb, + by simp only [Cslib.Algorithms.Lean.MinPQ.stepAlloc, hsh]; + exact (Data.extend_regs_of_notMem y_fib x freshReg_notMem_range).trans hfresh, + by simp only [Cslib.Algorithms.Lean.MinPQ.stepAlloc, hsh]; + exact (Data.extend_regs_of_notMem y_fib x freeTopReg_notMem_range).trans htop, + ?_, ?_⟩ + · simp only [Cslib.Algorithms.Lean.MinPQ.stepAlloc, hsh] + rw [Data.comap_extend f42_injective, + Cslib.Algorithms.Lean.MinPQ.toIndexed_update_some s.entries h u' v] + exact hinv_fib + · intro h' u₁ v₁ hsh' + simp only [Cslib.Algorithms.Lean.MinPQ.stepAlloc, hsh] at hsh' + rw [hmem_ge _ (Nat.le_add_right _ _)] + by_cases hh' : h' = h + · subst hh' + simp only [Function.update_self, Option.some.injEq, Prod.mk.injEq] at hsh' + obtain ⟨rfl, rfl⟩ := hsh' + exact ⟨hu'_lt, hv_lt, (hval h' u v hsh).2.2⟩ + · simp only [Function.update_of_ne hh'] at hsh' + exact hval h' u₁ v₁ hsh' + · intro i hi + simp only [Cslib.Algorithms.Lean.MinPQ.stepAlloc, hsh] at hi ⊢ + rw [hmem_ge _ (by omega)] + exact hfree i hi + · unfold potential + rw [Data.comap_extend f42_injective] + exact hpot_fib + +theorem extractMinCode_exec {n_max U V w base : ℕ} + {s : Cslib.Algorithms.Lean.MinPQ.AllocState n_max} {x : Data rMinPQ} + (hrep : AllocRep n_max U V w base s x) : + ∃ y t, ExecWithin w extractMinCode x y t ∧ + decode (n_max := n_max) (U := U) (V := V) .extractMin y.regs = + some (Cslib.Algorithms.Lean.MinPQ.stepAlloc s .extractMin).2 ∧ + AllocRep n_max U V w base (Cslib.Algorithms.Lean.MinPQ.stepAlloc s .extractMin).1 y ∧ + Modifies (Block.mk base (space n_max)).footprint x.mem y.mem ∧ + t + potential y ≤ + 418 * (Nat.log 2 (Cslib.Algorithms.Lean.MinPQ.size s.entries) + 1) + potential x := by + have hfit_stop := hrep.fits_stop + obtain ⟨hb, hfib, hwf, hfr, hfb, hfresh, htop, hval, hfree⟩ := hrep + obtain ⟨y_fib, t1, he_fib, hdec_fib, hinv_fib, hmod_fib, hpot_fib⟩ := + FibonacciHeap.extractMinCode_exec hfib + rw [Cslib.Algorithms.Lean.MinPQ.dom_toIndexed] at hpot_fib + change t1 + FibonacciHeap.potential y_fib ≤ + 410 * (Nat.log 2 (Cslib.Algorithms.Lean.MinPQ.size s.entries) + 1) + + FibonacciHeap.potential (x.comap f42) at hpot_fib + let x1 := y_fib.extend f42 x + have he1 : ExecWithin w (FibonacciHeap.extractMinCode.rename f42) x x1 t1 := + he_fib.rename f42_injective + have hb1 : x1.Bounded w := he1.bounded hb + have hmem1_ge : ∀ a, base + FibonacciHeap.space n_max ≤ a → x1.mem a = x.mem a := + fun a ha => hmod_fib a (notMem_fib_footprint_of_ge ha) + have hx1_z0 : x1.regs zeroP = 0 := by + change (x1.comap f42).regs FibonacciHeap.zeroP = 0 + rw [Data.comap_extend f42_injective] + exact hinv_fib.2.1.2.2.2.2.2.2.2.2.2.2.2.1 + have hx1_o1 : x1.regs oneP = 1 := by + change (x1.comap f42).regs FibonacciHeap.oneP = 1 + rw [Data.comap_extend f42_injective] + exact hinv_fib.2.1.2.2.2.2.2.2.2.2.2.2.2.2 + have hx1_vb : x1.regs valBaseReg = base + FibonacciHeap.space n_max := by + change (x1.comap f42).regs FibonacciHeap.frontierReg = base + FibonacciHeap.space n_max + rw [Data.comap_extend f42_injective] + exact hinv_fib.2.1.2.1 + have hx1_fb : x1.regs freeBaseReg = base + FibonacciHeap.space n_max + n_max := + (Data.extend_regs_of_notMem y_fib x freeBaseReg_notMem_range).trans hfb + have hx1_fresh : x1.regs freshReg = s.fresh := + (Data.extend_regs_of_notMem y_fib x freshReg_notMem_range).trans hfresh + have hx1_top : x1.regs freeTopReg = s.freeList.length := + (Data.extend_regs_of_notMem y_fib x freeTopReg_notMem_range).trans htop + have hx1_ofr : x1.regs outerFrontierReg = base + space n_max := + (Data.extend_regs_of_notMem y_fib x outerFrontierReg_notMem_range).trans hfr + have hx1_fl : x1.regs outFlag = y_fib.regs FibonacciHeap.outFlag := by + change (x1.comap f42).regs FibonacciHeap.outFlag = y_fib.regs FibonacciHeap.outFlag + rw [Data.comap_extend f42_injective] + have hx1_ov : x1.regs outV = y_fib.regs FibonacciHeap.outV := by + change (x1.comap f42).regs FibonacciHeap.outV = y_fib.regs FibonacciHeap.outV + rw [Data.comap_extend f42_injective] + have hx1_ok : x1.regs outK = y_fib.regs FibonacciHeap.outK := by + change (x1.comap f42).regs FibonacciHeap.outK = y_fib.regs FibonacciHeap.outK + rw [Data.comap_extend f42_injective] + have hwf' := + (Cslib.Algorithms.Lean.MinPQ.stepAlloc_refines_spec (U := U) (V := V) hwf .extractMin + trivial).2 + rcases hfm : IndexedMinPQ.findMin (Cslib.Algorithms.Lean.MinPQ.toIndexed s.entries) with + _ | ⟨h, u⟩ + · -- Empty queue (`findMin = none`) + simp only [PQCode.decode, FibonacciHeap.code, IndexedMinPQ.spec, hfm] at hdec_fib hinv_fib + have hfl0 : x1.regs outFlag = 0 := by + rw [hx1_fl] + by_contra hne + simp only [hne, ↓reduceIte] at hdec_fib + by_cases hlt : y_fib.regs FibonacciHeap.outV < n_max <;> + simp only [hlt, ↓reduceDIte] at hdec_fib <;> + nomatch hdec_fib + have hc : (Cond.eq outFlag zeroP).Holds x1 := by simp only [Cond.Holds, hx1_z0, hfl0] + let y := x1.set s0 0 + have he2 : ExecWithin (B := .exact) w + (.branch (.eq outFlag zeroP) (.op (.copy s0 zeroP)) + (.seq (.op (.exactBin .add s0 valBaseReg outV)) <| + .seq (.op (.load outValReg s0)) <| + .seq (.op (.exactBin .add s0 freeBaseReg freeTopReg)) <| + .seq (.op (.store s0 outV)) + (.op (.exactBin .add freeTopReg freeTopReg oneP)))) x1 y 2 := + ExecWithin.branch_pos hc (by simpa only [hx1_z0] using + (ExecWithin.copy (B := .exact) (w := w) (x := x1) (d := s0) (s := zeroP))) + have hreg_y : ∀ i : Fin rMinPQ, inputReg i = false → y.regs i = x1.regs i := fun i hi => by + have hne : i ≠ s0 := fun e => by subst e; cases hi + simp only [y, Data.set_regs, Function.update_of_ne hne] + have hrep1 : AllocRep n_max U V w base s x1 := + ⟨hb1, by rw [Data.comap_extend f42_injective]; exact hinv_fib, hwf, + hx1_ofr, hx1_fb, hx1_fresh, hx1_top, + fun h' u' v' hsh' => ⟨(hval h' u' v' hsh').1, (hval h' u' v' hsh').2.1, + (hmem1_ge _ (Nat.le_add_right _ _)).trans (hval h' u' v' hsh').2.2⟩, + fun i hi => (hmem1_ge _ (by omega)).trans (hfree i hi)⟩ + refine ⟨y, t1 + 2, he1.seq he2, ?_, ?_, modifies_of_fib hmod_fib, ?_⟩ + · simp only [decode, Cslib.Algorithms.Lean.MinPQ.stepAlloc, hfm, y, Data.set_regs, + Function.update_of_ne (by decide : outFlag ≠ s0), hfl0, ↓reduceIte] + rfl + · simp only [Cslib.Algorithms.Lean.MinPQ.stepAlloc, hfm] + exact hrep1.supported hreg_y (fun _ _ => rfl) (he2.bounded hb1) + · rw [potential_supported hreg_y] + change t1 + 2 + FibonacciHeap.potential (x1.comap f42) ≤ _ + potential x + rw [Data.comap_extend f42_injective] + unfold potential + omega + · -- Non-empty queue (`findMin = some (h, u)`) + obtain ⟨v, hsh, _, _⟩ := Cslib.Algorithms.Lean.MinPQ.findMin_eq_some_of_indexed hfm + simp only [PQCode.decode, FibonacciHeap.code, IndexedMinPQ.spec, hfm] at hdec_fib hinv_fib + have hfl_ne : x1.regs outFlag ≠ 0 := by + rw [hx1_fl] + intro h0 + simp only [h0, ↓reduceIte] at hdec_fib + nomatch hdec_fib + simp only [hx1_fl ▸ hfl_ne, ↓reduceIte] at hdec_fib + have hlt_ov : y_fib.regs FibonacciHeap.outV < n_max := by + by_contra hge + simp only [hge, ↓reduceDIte] at hdec_fib + nomatch hdec_fib + simp only [hlt_ov, ↓reduceDIte, Option.some.injEq, Prod.mk.injEq, Fin.ext_iff] at hdec_fib + have hov_eq : x1.regs outV = h.val := hx1_ov.trans hdec_fib.1 + have hok_eq : x1.regs outK = u := hx1_ok.trans hdec_fib.2 + have hc : ¬(Cond.eq outFlag zeroP).Holds x1 := by simp only [Cond.Holds, hx1_z0]; exact hfl_ne + have hh_lt := h.isLt + have hsz_pos : 1 ≤ Cslib.Algorithms.Lean.MinPQ.size s.entries := + Finset.card_pos.mpr ⟨h, Cslib.Algorithms.Lean.MinPQ.mem_dom_iff.mpr ⟨u, v, hsh⟩⟩ + have hfl_lt : s.freeList.length < n_max := by + have := hwf.1 + have := hwf.2.2.2.2 + omega + have ho_free := owns_free_addr (base := base) hfl_lt + let a1 := x1.set s0 (base + FibonacciHeap.space n_max + h.val) + let a2 := a1.set outValReg v + let a3 := a2.set s0 (base + FibonacciHeap.space n_max + n_max + s.freeList.length) + let a4 := a3.write (base + FibonacciHeap.space n_max + n_max + s.freeList.length) h.val + let y := a4.set freeTopReg (s.freeList.length + 1) + have eb1 : ExecWithin w (.op (.exactBin .add s0 valBaseReg outV)) x1 a1 1 := by + simpa only [hx1_vb, hov_eq] using + execWithin_exactAdd48 (x := x1) (d := s0) (i := valBaseReg) (j := outV) + (by rw [hx1_vb, hov_eq]; rw [space_eq_fib_add] at hfit_stop; + exact hfit_stop.of_le (by omega)) + have eb2 : ExecWithin (B := .exact) w (.op (.load outValReg s0)) a1 a2 1 := by + have hm_v : x1.mem (base + FibonacciHeap.space n_max + h.val) = v := + (hmem1_ge _ (Nat.le_add_right _ _)).trans (hval h u v hsh).2.2 + simpa only [a1, Data.set_mem, Data.set_regs, Function.update_self, hm_v] using + (ExecWithin.load (B := .exact) (w := w) (x := a1) (d := outValReg) (a := s0)) + have eb3 : ExecWithin w (.op (.exactBin .add s0 freeBaseReg freeTopReg)) a2 a3 1 := by + have ha2_fb : a2.regs freeBaseReg = base + FibonacciHeap.space n_max + n_max := by + simp only [a2, a1, Data.set_regs, + Function.update_of_ne (by decide : freeBaseReg ≠ outValReg), + Function.update_of_ne (by decide : freeBaseReg ≠ s0), hx1_fb] + have ha2_top : a2.regs freeTopReg = s.freeList.length := by + simp only [a2, a1, Data.set_regs, + Function.update_of_ne (by decide : freeTopReg ≠ outValReg), + Function.update_of_ne (by decide : freeTopReg ≠ s0), hx1_top] + simpa only [ha2_fb, ha2_top] using + execWithin_exactAdd48 (x := a2) (d := s0) (i := freeBaseReg) (j := freeTopReg) + (by rw [ha2_fb, ha2_top]; rw [space_eq_fib_add] at hfit_stop; + exact hfit_stop.of_le (by omega)) + have eb4 : ExecWithin (B := .exact) w (.op (.store s0 outV)) a3 a4 1 := by + have ha3_ov : a3.regs outV = h.val := by + simp only [a3, a2, a1, Data.set_regs, + Function.update_of_ne (by decide : outV ≠ s0), + Function.update_of_ne (by decide : outV ≠ outValReg), hov_eq] + simpa only [a3, Data.set_regs, Function.update_self, ha3_ov] using + (ExecWithin.store (B := .exact) (w := w) (x := a3) (a := s0) (s := outV)) + have eb5 : ExecWithin w (.op (.exactBin .add freeTopReg freeTopReg oneP)) a4 y 1 := by + have ha4_top : a4.regs freeTopReg = s.freeList.length := by + simp only [a4, a3, a2, a1, Data.write_regs, Data.set_regs, + Function.update_of_ne (by decide : freeTopReg ≠ s0), + Function.update_of_ne (by decide : freeTopReg ≠ outValReg), hx1_top] + have ha4_o1 : a4.regs oneP = 1 := by + simp only [a4, a3, a2, a1, Data.write_regs, Data.set_regs, + Function.update_of_ne (by decide : oneP ≠ s0), + Function.update_of_ne (by decide : oneP ≠ outValReg), hx1_o1] + simpa only [ha4_top, ha4_o1] using + execWithin_exactAdd48 (x := a4) (d := freeTopReg) (i := freeTopReg) (j := oneP) + (by rw [ha4_top, ha4_o1]; have := space_lower n_max; + exact hfit_stop.of_le (by omega)) + have he2 : ExecWithin (B := .exact) w + (.branch (.eq outFlag zeroP) (.op (.copy s0 zeroP)) + (.seq (.op (.exactBin .add s0 valBaseReg outV)) <| + .seq (.op (.load outValReg s0)) <| + .seq (.op (.exactBin .add s0 freeBaseReg freeTopReg)) <| + .seq (.op (.store s0 outV)) + (.op (.exactBin .add freeTopReg freeTopReg oneP)))) x1 y 7 := + ExecWithin.branch_neg hc (eb1.seq (eb2.seq (eb3.seq (eb4.seq eb5)))) + have hby : y.Bounded w := he2.bounded hb1 + have hreg_fib : ∀ j : Fin rFib, FibonacciHeap.inputReg j = false → + (y.comap f42).regs j = (x1.comap f42).regs j := fun j hj => by + have hj_in : inputReg (f42 j) = false := inputReg_f42_of_false j hj + change y.regs (f42 j) = x1.regs (f42 j) + have h1 : f42 j ≠ freeTopReg := fun e => freeTopReg_notMem_range ⟨j, e⟩ + have h2 : f42 j ≠ s0 := fun e => by rw [e] at hj_in; cases hj_in + have h3 : f42 j ≠ outValReg := fun e => outValReg_notMem_range ⟨j, e⟩ + simp only [y, a4, a3, a2, a1, Data.set_regs, Data.write_regs, + Function.update_of_ne h1, Function.update_of_ne h2, Function.update_of_ne h3] + have hmem_fib : ∀ a ∈ (Block.mk base (FibonacciHeap.space n_max)).footprint, + (y.comap f42).mem a = (x1.comap f42).mem a := fun a ha => by + have hne : a ≠ base + FibonacciHeap.space n_max + n_max + s.freeList.length := fun e => + notMem_fib_footprint_of_ge (by omega) (e ▸ ha) + simp only [y, a4, a3, a2, a1, Data.comap, Data.set_mem, Data.write_mem, + Function.update_of_ne hne] + have hmod_all : Modifies (Block.mk base (space n_max)).footprint x.mem y.mem := by + have hm_y : Modifies (Block.mk base (space n_max)).footprint x1.mem y.mem := + Modifies.write_of_owns ho_free h.val + exact modifies_outer_trans (modifies_of_fib hmod_fib) hm_y + refine ⟨y, t1 + 7, he1.seq he2, ?_, ?_, hmod_all, ?_⟩ + · simp only [decode, Cslib.Algorithms.Lean.MinPQ.stepAlloc, hfm, hsh, y, a4, a3, a2, a1, + Data.set_regs, Data.write_regs, + Function.update_of_ne (by decide : outFlag ≠ freeTopReg), + Function.update_of_ne (by decide : outFlag ≠ s0), + Function.update_of_ne (by decide : outFlag ≠ outValReg), + Function.update_of_ne (by decide : outV ≠ freeTopReg), + Function.update_of_ne (by decide : outV ≠ s0), + Function.update_of_ne (by decide : outV ≠ outValReg), + Function.update_of_ne (by decide : outK ≠ freeTopReg), + Function.update_of_ne (by decide : outK ≠ s0), + Function.update_of_ne (by decide : outK ≠ outValReg), + Function.update_of_ne (by decide : outValReg ≠ freeTopReg), + Function.update_of_ne (by decide : outValReg ≠ s0), + Function.update_self, hfl_ne, hov_eq, hok_eq, hh_lt, ↓reduceIte, ↓reduceDIte, Fin.eta] + rfl + · simp only [Cslib.Algorithms.Lean.MinPQ.stepAlloc, hfm, hsh] at hwf' ⊢ + refine ⟨hby, ?_, hwf', ?_, ?_, ?_, ?_, ?_, ?_⟩ + · refine FibonacciHeap.FibInv.supported hreg_fib hmem_fib (hby.comap f42) ?_ + dsimp only + rw [Data.comap_extend f42_injective, + Cslib.Algorithms.Lean.MinPQ.toIndexed_update_none s.entries h] + exact hinv_fib + · simp only [y, a4, a3, a2, a1, Data.set_regs, Data.write_regs, + Function.update_of_ne (by decide : outerFrontierReg ≠ freeTopReg), + Function.update_of_ne (by decide : outerFrontierReg ≠ s0), + Function.update_of_ne (by decide : outerFrontierReg ≠ outValReg), hx1_ofr] + · simp only [y, a4, a3, a2, a1, Data.set_regs, Data.write_regs, + Function.update_of_ne (by decide : freeBaseReg ≠ freeTopReg), + Function.update_of_ne (by decide : freeBaseReg ≠ s0), + Function.update_of_ne (by decide : freeBaseReg ≠ outValReg), hx1_fb] + · simp only [y, a4, a3, a2, a1, Data.set_regs, Data.write_regs, + Function.update_of_ne (by decide : freshReg ≠ freeTopReg), + Function.update_of_ne (by decide : freshReg ≠ s0), + Function.update_of_ne (by decide : freshReg ≠ outValReg), hx1_fresh] + · simp only [y, Data.set_regs, Function.update_self, List.length_cons] + · intro h' u' v' hsh' + by_cases hh' : h' = h + · subst hh'; simp only [Function.update_self, reduceCtorEq] at hsh' + · simp only [Function.update_of_ne hh'] at hsh' + have hne_addr : base + FibonacciHeap.space n_max + h'.val ≠ + base + FibonacciHeap.space n_max + n_max + s.freeList.length := by + have := h'.isLt; omega + obtain ⟨hu', hv', hm'⟩ := hval h' u' v' hsh' + refine ⟨hu', hv', ?_⟩ + simp only [y, a4, a3, a2, a1, Data.set_mem, Data.write_mem, + Function.update_of_ne hne_addr] + exact (hmem1_ge _ (Nat.le_add_right _ _)).trans hm' + · intro i hi + simp only [List.length_cons] at hi + rcases i with _ | j + · simp only [List.length_cons, Nat.add_sub_cancel, Nat.sub_zero, List.getElem_cons_zero, + y, a4, a3, a2, a1, Data.set_mem, Data.write_mem, Function.update_self] + · have hj : j < s.freeList.length := by omega + have hidx : (h :: s.freeList).length - 1 - (j + 1) = s.freeList.length - 1 - j := by + simp only [List.length_cons]; omega + have hne_addr : + base + FibonacciHeap.space n_max + n_max + (s.freeList.length - 1 - j) ≠ + base + FibonacciHeap.space n_max + n_max + s.freeList.length := by omega + rw [hidx] + simp only [List.getElem_cons_succ, y, a4, a3, a2, a1, Data.set_mem, Data.write_mem, + Function.update_of_ne hne_addr] + exact (hmem1_ge _ (by omega)).trans (hfree j hj) + · have hp_y : potential y = FibonacciHeap.potential y_fib := by + unfold potential + rw [FibonacciHeap.potential_supported hreg_fib, Data.comap_extend f42_injective] + rw [hp_y] + unfold potential + omega + +/-! ## Unified dispatcher and `RelSubroutineDS` certificate -/ + +/-- Unified dispatcher `dispatchCode` implements all five `MinPQ` operations within +`charge n_max e o` amortized instructions over `Basis.exact`. -/ +theorem dispatchCode_exec_raw {n_max U V w base : ℕ} + {e : Cslib.Algorithms.Lean.MinPQ.State n_max} {x : Data rMinPQ} + (o : Cslib.Algorithms.Lean.MinPQ.Op n_max) (hr : Rep n_max U V w base e x) + (hv : (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).valid e o) + (harg : rawArgMatch o x.regs) : + ∃ y s' a m, Exec w dispatchCode x y m ∧ + (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).step e o s' a ∧ + decode (n_max := n_max) (U := U) (V := V) o y.regs = some a ∧ + Rep n_max U V w base s' y ∧ + Modifies (Block.mk base (space n_max)).footprint x.mem y.mem ∧ + m + potential y ≤ charge n_max e o + potential x := by + obtain ⟨s, rfl, hrep⟩ := hr + have hz0 : x.regs zeroP = 0 := hrep.zeroP_eq + obtain ⟨hstep_s, _⟩ := + Cslib.Algorithms.Lean.MinPQ.stepAlloc_refines_spec (U := U) (V := V) hrep.2.2.1 o hv + cases o with + | isEmpty => + obtain ⟨ht2, ht1, ht0⟩ := harg + have c2 : (Cond.eq tag2 zeroP).Holds x := by simp only [Cond.Holds, hz0]; exact ht2 + have c1 : (Cond.eq tag1 zeroP).Holds x := by simp only [Cond.Holds, hz0]; exact ht1 + have c0 : (Cond.eq tag0 zeroP).Holds x := by simp only [Cond.Holds, hz0]; exact ht0 + obtain ⟨y, t, ⟨m, hm, he⟩, hdec, hrep_y, hmod, hpot⟩ := isEmptyCode_exec hrep + refine ⟨y, _, _, m + 1 + 1 + 1, + Exec.branch_pos c2 (Exec.branch_pos c1 (Exec.branch_pos c0 he)), + hstep_s, hdec, ⟨_, rfl, hrep_y⟩, hmod, ?_⟩ + simp only [charge, tEmpty] + omega + | get h => + obtain ⟨ht2, ht1, ht0, hv_reg⟩ := harg + have c2 : (Cond.eq tag2 zeroP).Holds x := by simp only [Cond.Holds, hz0]; exact ht2 + have c1 : (Cond.eq tag1 zeroP).Holds x := by simp only [Cond.Holds, hz0]; exact ht1 + have c0 : ¬(Cond.eq tag0 zeroP).Holds x := by simp only [Cond.Holds, hz0]; exact ht0 + obtain ⟨y, t, ⟨m, hm, he⟩, hdec, hrep_y, hmod, hpot⟩ := getCode_exec h hrep hv_reg + refine ⟨y, _, _, m + 2 + 1 + 1, + Exec.branch_pos c2 (Exec.branch_pos c1 (Exec.branch_neg c0 he)), + hstep_s, hdec, ⟨_, rfl, hrep_y⟩, hmod, ?_⟩ + simp only [charge, tGet] + omega + | insert u v => + obtain ⟨ht2, ht1, ht0, hk_reg, hval_reg⟩ := harg + have c2 : (Cond.eq tag2 zeroP).Holds x := by simp only [Cond.Holds, hz0]; exact ht2 + have c1 : ¬(Cond.eq tag1 zeroP).Holds x := by simp only [Cond.Holds, hz0]; exact ht1 + have c0 : (Cond.eq tag0 zeroP).Holds x := by simp only [Cond.Holds, hz0]; exact ht0 + obtain ⟨y, t, ⟨m, hm, he⟩, hdec, hrep_y, hmod, hpot⟩ := + insertCode_exec hrep hv hk_reg hval_reg + refine ⟨y, _, _, m + 1 + 2 + 1, + Exec.branch_pos c2 (Exec.branch_neg c1 (Exec.branch_pos c0 he)), + hstep_s, hdec, ⟨_, rfl, hrep_y⟩, hmod, ?_⟩ + simp only [charge, tIns] + omega + | decreaseKey h u' => + obtain ⟨ht2, ht1, ht0, hv_reg, hk_reg⟩ := harg + have c2 : (Cond.eq tag2 zeroP).Holds x := by simp only [Cond.Holds, hz0]; exact ht2 + have c1 : ¬(Cond.eq tag1 zeroP).Holds x := by simp only [Cond.Holds, hz0]; exact ht1 + have c0 : ¬(Cond.eq tag0 zeroP).Holds x := by simp only [Cond.Holds, hz0]; exact ht0 + obtain ⟨y, t, ⟨m, hm, he⟩, hdec, hrep_y, hmod, hpot⟩ := + decreaseKeyCode_exec h u' hrep hv hv_reg hk_reg + refine ⟨y, _, _, m + 2 + 2 + 1, + Exec.branch_pos c2 (Exec.branch_neg c1 (Exec.branch_neg c0 he)), + hstep_s, hdec, ⟨_, rfl, hrep_y⟩, hmod, ?_⟩ + simp only [charge, tDec] + omega + | extractMin => + have c2 : ¬(Cond.eq tag2 zeroP).Holds x := by simp only [Cond.Holds, hz0]; exact harg + obtain ⟨y, t, ⟨m, hm, he⟩, hdec, hrep_y, hmod, hpot⟩ := extractMinCode_exec hrep + refine ⟨y, _, _, m + 2, Exec.branch_neg c2 he, hstep_s, hdec, ⟨_, rfl, hrep_y⟩, hmod, ?_⟩ + simp only [charge, tExt] + omega + +theorem dispatchCode_exec {n_max U V w base : ℕ} + {e : Cslib.Algorithms.Lean.MinPQ.State n_max} {x : Data rMinPQ} + (o : Cslib.Algorithms.Lean.MinPQ.Op n_max) (hr : Rep n_max U V w base e x) + (hv : (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).valid e o) + (harg : argMatch U o x.regs) : + ∃ y s' a m, Exec w dispatchCode x y m ∧ + (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).step e o s' a ∧ + decode (n_max := n_max) (U := U) (V := V) o y.regs = some a ∧ + Rep n_max U V w base s' y ∧ + Modifies (Block.mk base (space n_max)).footprint x.mem y.mem ∧ + m + potential y ≤ charge n_max e o + potential x := by + obtain ⟨s, rfl, hrep⟩ := hr + exact dispatchCode_exec_raw o ⟨s, rfl, hrep⟩ hv (rawArgMatch_of_argMatch hrep hv harg) + +/-- Unified standalone and inline-subroutine relational certificate for the key–value +Fibonacci heap with handles over `Basis.exact`. -/ +def relSubroutineDS {n_max U V w base : ℕ} + (hS : Fits w (base + space n_max)) (hU : Fits w U) (hV : Fits w V) : + RelSubroutineDS subroutineCode (Cslib.Algorithms.Lean.MinPQ.spec n_max U V) w base ![n_max] + (Cslib.Algorithms.Lean.MinPQ.empty n_max) where + space := space n_max + spanTime := 15 + setupTime := 18 + initPotential := 0 + charge := charge n_max + rep := Rep n_max U V w base + potential := potential + encode := encode U + argMatch := argMatch U + decode := decode + bounded := fun ⟨_, _, h⟩ => h.1 + arguments_fit o hv i _ := arguments_fit hS hU hV o hv i + encode_matches := encode_matches + rep_supported := Rep.supported + potential_supported hreg _ _ := potential_supported hreg + clear_nodup := by decide + params_not_clear := by decide + incCur_eval := incCur_eval + span_exec := allocSpan_exec hS + setup_exec := initSetup_exec + step_exec := dispatchCode_exec + +/-! ## Standalone `Basis.standard` `RelDynamicProgram` and `Stateful.RelAmortized` realizations -/ + +/-- Standalone `RelDynamicProgram` realization of the key–value Fibonacci heap over +`Basis.standard`. -/ +def relDynamicProgram {n_max U V w base : ℕ} + (hS : Fits w (base + space n_max)) (hU : Fits w U) (hV : Fits w V) : + RelDynamicProgram (Cslib.Algorithms.Lean.MinPQ.spec n_max U V) rMinPQ := + (relSubroutineDS (n_max := n_max) (U := U) (V := V) hS hU hV).toStandard.toRelDynamicProgram + +/-- Standalone `RelDynamicCertificate` for the key–value Fibonacci heap over `Basis.standard`. -/ +def relCertificate {n_max U V w base : ℕ} + (hS : Fits w (base + space n_max)) (hU : Fits w U) (hV : Fits w V) : + RelDynamicCertificate (relDynamicProgram hS hU hV) w := + (relSubroutineDS hS hU hV).toStandard.toRelCertificate + +/-- Standalone `Stateful.RelAmortized` certificate for the key–value Fibonacci heap over +`Basis.standard`, charging `+ 1` per operation for the trailing `halt` instruction. -/ +theorem relAmortized {n_max U V w base : ℕ} + (hS : Fits w (base + space n_max)) (hU : Fits w U) (hV : Fits w V) : + Stateful.RelAmortized (relCertificate hS hU hV).realization + DynamicProgram.OperationTrace.instructions + (fun _ x => potential x) + (fun s o => charge n_max s o + 1) := + (relSubroutineDS hS hU hV).toStandard.toRelAmortized + +/-- Adaptive-client amortized execution bound for any demonically admissible `MinPQ` client `p` +over `Basis.standard`. -/ +theorem run_client_amortized {n_max U V w base : ℕ} + (hS : Fits w (base + space n_max)) (hU : Fits w U) (hV : Fits w V) + {α : Type*} (p : (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).Client α) + {s : Cslib.Algorithms.Lean.MinPQ.State n_max} {x : Data rMinPQ} + (hr : Rep n_max U V w base s x) + (hv : (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).DemonicValid s p) : + ∃ a y traces s' tr, + Stateful.RelExecutes ((relDynamicProgram hS hU hV).ExecOp w) p x a y traces ∧ + (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).ClientRun s p a s' tr ∧ + Rep n_max U V w base s' y ∧ + traces.length = tr.length ∧ + Stateful.total DynamicProgram.OperationTrace.instructions traces + potential y ≤ + (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).totalCost + (fun st o => charge n_max st o + 1) s tr + potential x := + (relSubroutineDS hS hU hV).toStandard.run_client_amortized p hr hv + +/-! ## Standalone end-to-end `Basis.exact` flat-program operation-sequence theorems -/ + +/-- Compiled flat `Program .exact rMinPQ` for `O(1)` fresh zeroed-memory initialization. -/ +def initFreshProg : Program .exact rMinPQ := subroutineCode.initFreshProg + +/-- Compiled flat `Program .exact rMinPQ` for `O(n_max)` dirty-memory reusable initialization. -/ +def initClearProg : Program .exact rMinPQ := subroutineCode.initClearProg + +/-- Compiled flat `Program .exact rMinPQ` serving all five priority-queue operations. -/ +def opProg : Program .exact rMinPQ := subroutineCode.opProg + +/-- Initial register assignment supplying `n_max` in `nReg` (`R[0]`), `base` in `outerFrontierReg` +(`R[1]`), and `0` elsewhere. -/ +def initRegs (n_max base : ℕ) : Fin rMinPQ → ℕ := + fun i => if i = nReg then n_max else if i = outerFrontierReg then base else 0 + +/-- Deliver operation `o`'s 3-bit tag into `tag2..tag0` (`R[17..19]`), handle/key arguments into +`argV, argK` (`R[20..21]`), and satellite value into `inValReg` (`R[46]`), leaving all other +registers unchanged. -/ +def prepareRegs {n_max : ℕ} (o : Cslib.Algorithms.Lean.MinPQ.Op n_max) + (regs : Fin rMinPQ → ℕ) : Fin rMinPQ → ℕ := + fun i => + if i = tag2 ∨ i = tag1 ∨ i = tag0 ∨ i = argV ∨ i = argK ∨ i = inValReg then + rawEncode o i + else + regs i + +/-- Count `isEmpty` and `get` queries in an operation sequence. -/ +def numQueries {n_max : ℕ} : List (Cslib.Algorithms.Lean.MinPQ.Op n_max) → ℕ + | [] => 0 + | .isEmpty :: ops | .get _ :: ops => 1 + numQueries ops + | _ :: ops => numQueries ops + +/-- Count `insert` operations in an operation sequence. -/ +def numInserts {n_max : ℕ} : List (Cslib.Algorithms.Lean.MinPQ.Op n_max) → ℕ + | [] => 0 + | .insert _ _ :: ops => 1 + numInserts ops + | _ :: ops => numInserts ops + +/-- Count `decreaseKey` operations in an operation sequence. -/ +def numDecreaseKeys {n_max : ℕ} : List (Cslib.Algorithms.Lean.MinPQ.Op n_max) → ℕ + | [] => 0 + | .decreaseKey _ _ :: ops => 1 + numDecreaseKeys ops + | _ :: ops => numDecreaseKeys ops + +/-- Count `extractMin` operations in an operation sequence. -/ +def numExtractMins {n_max : ℕ} : List (Cslib.Algorithms.Lean.MinPQ.Op n_max) → ℕ + | [] => 0 + | .extractMin :: ops => 1 + numExtractMins ops + | _ :: ops => numExtractMins ops + +/-- Sum of `Nat.log 2 (MinPQ.size s) + 1` over all `extractMin` steps along a relational +transcript `tr` starting from state `s`, where `MinPQ.size s` is the number of stored elements +immediately before each `extractMin`. -/ +def extractLogSum {n_max U V : ℕ} : + Cslib.Algorithms.Lean.MinPQ.State n_max → + (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).Transcript → ℕ + | _, [] => 0 + | s, e :: tr => + (match e.op with + | .extractMin => Nat.log 2 (Cslib.Algorithms.Lean.MinPQ.size s) + 1 + | _ => 0) + extractLogSum e.nextState tr + +theorem extractLogSum_le_numExtractMins {n_max U V : ℕ} : + ∀ (tr : (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).Transcript) + (s : Cslib.Algorithms.Lean.MinPQ.State n_max), + extractLogSum s tr ≤ numExtractMins tr.ops * (Nat.log 2 n_max + 1) + | [], _ => Nat.zero_le _ + | ⟨o, res, s₁⟩ :: tr, s => by + have ih := extractLogSum_le_numExtractMins tr s₁ + have hlog : Nat.log 2 (Cslib.Algorithms.Lean.MinPQ.size s) ≤ Nat.log 2 n_max := + Nat.log_mono_right (Cslib.Algorithms.Lean.MinPQ.size_le s) + cases o with + | extractMin => + simp only [extractLogSum, Stateful.RelSpec.Transcript.ops_cons, numExtractMins, + Nat.add_mul, Nat.one_mul] + omega + | _ => + simp only [extractLogSum, Stateful.RelSpec.Transcript.ops_cons, numExtractMins, + Nat.zero_add] + omega + +/-- Sequential flat-program execution of `ops` by repeated calls to `opProg`: each call prepares +input registers via `prepareRegs`, runs `opProg` from `pc = 0` to `halt`, decodes a valid +`MinPQ.spec` transition `(s₁, a)`, modifies memory only within `[base, base + space n_max)`, +records the resulting transcript `tr`, and accumulates total instructions executed (including +each trailing `halt`). -/ +inductive RunsOps {n_max U V : ℕ} (w base : ℕ) : + Cslib.Algorithms.Lean.MinPQ.State n_max → Data rMinPQ → + List (Cslib.Algorithms.Lean.MinPQ.Op n_max) → + (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).Transcript → + Cslib.Algorithms.Lean.MinPQ.State n_max → Data rMinPQ → ℕ → Prop + | nil {s x} : RunsOps w base s x [] [] s x 0 + | cons {s s₁ s₂ x o a ops tr pc y z steps rest} : + Runs w opProg ⟨0, ⟨prepareRegs o x.regs, x.mem⟩⟩ ⟨pc, y⟩ steps → + (∃ out, step w opProg ⟨pc, y⟩ = .halt out) → + (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).step s o s₁ a → + decode (n_max := n_max) (U := U) (V := V) o y.regs = some a → + Modifies (Block.mk base (space n_max)).footprint x.mem y.mem → + RunsOps w base s₁ y ops tr s₂ z rest → + RunsOps w base s x (o :: ops) (⟨o, a, s₁⟩ :: tr) s₂ z ((steps + 1) + rest) + +private theorem step_program_halt {w : ℕ} (c : Code .exact rMinPQ) (out : Fin rMinPQ) + (y : Data rMinPQ) : step w (c.program out) ⟨0 + c.size, y⟩ = .halt (y.regs out) := + step_halt (by + simp only [Code.program, Nat.zero_add, + List.getElem?_append_right (Code.length_assemble c 0).le, + Code.length_assemble, Nat.sub_self, List.getElem?_cons_zero]) + +private theorem seq_runsOps {n_max U V w base : ℕ} + (hS : Fits w (base + space n_max)) (hU : Fits w U) (hV : Fits w V) : + ∀ (ops : List (Cslib.Algorithms.Lean.MinPQ.Op n_max)) + {s : Cslib.Algorithms.Lean.MinPQ.State n_max} {x : Data rMinPQ}, + Rep n_max U V w base s x → + (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).ValidOpSeq s ops → + ∃ tr s_fin z total, + RunsOps (U := U) (V := V) w base s x ops tr s_fin z total ∧ + tr.ops = ops ∧ + (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).ValidTranscript s tr s_fin ∧ + Rep n_max U V w base s_fin z ∧ + total + potential z ≤ + 421 * (numQueries ops + numInserts ops + numDecreaseKeys ops + + extractLogSum s tr) + potential x + | [], s, x, hr, _ => + ⟨[], s, x, 0, .nil, rfl, .nil (D := Cslib.Algorithms.Lean.MinPQ.spec n_max U V) s, hr, + by simp only [numQueries, numInserts, numDecreaseKeys, extractLogSum]; omega⟩ + | o :: ops, s, x, hr, ⟨hv_o, hv_rest⟩ => by + let x' : Data rMinPQ := ⟨prepareRegs o x.regs, x.mem⟩ + have hbx : x.Bounded w := hr.choose_spec.2.1 + have henc_eq : encode U o = rawEncode o := encode_eq_rawEncode_of_rep hr hv_o + have hb' : x'.Bounded w := by + refine ⟨fun i => ?_, hbx.2⟩ + change Fits w (if _ then rawEncode o i else x.regs i) + split_ifs + · rw [← henc_eq] + exact arguments_fit hS hU hV o hv_o i + · exact hbx.1 i + have hreg' : ∀ i, inputReg i = false → x'.regs i = x.regs i := fun i hi => by + have hne : ¬(i = tag2 ∨ i = tag1 ∨ i = tag0 ∨ i = argV ∨ i = argK ∨ i = inValReg) := by + rintro (rfl | rfl | rfl | rfl | rfl | rfl) <;> exact absurd hi (by decide) + simp only [x', prepareRegs, hne, ↓reduceIte] + have hr' : Rep n_max U V w base s x' := hr.supported hreg' (fun _ _ => rfl) hb' + have hpot' : potential x' = potential x := potential_supported hreg' + have harg' : rawArgMatch o x'.regs := by + cases o with + | isEmpty => exact ⟨rfl, rfl, rfl⟩ + | get _ => exact ⟨rfl, rfl, Nat.one_ne_zero, rfl⟩ + | insert _ _ => exact ⟨rfl, Nat.one_ne_zero, rfl, rfl, rfl⟩ + | decreaseKey _ _ => exact ⟨rfl, Nat.one_ne_zero, Nat.one_ne_zero, rfl, rfl⟩ + | extractMin => exact Nat.one_ne_zero + obtain ⟨y, s₁, a, m, he_op, hstep, hdec, hr_y, hmod, hpot_m⟩ := + dispatchCode_exec_raw o hr' hv_o harg' + rw [hpot'] at hpot_m + have hruns : Runs w opProg ⟨0, x'⟩ ⟨0 + dispatchCode.size, y⟩ m := + he_op.runs (pc := 0) (p := opProg) (Program.Contains.self _).append_left + have hhalt : step w opProg ⟨0 + dispatchCode.size, y⟩ = .halt (y.regs outFlag) := + step_program_halt dispatchCode outFlag y + obtain ⟨tr, s_fin, z, rest, hrest, hops, htr, hr_z, hpot_rest⟩ := + seq_runsOps hS hU hV ops hr_y (hv_rest s₁ a hstep) + refine ⟨⟨o, a, s₁⟩ :: tr, s_fin, z, (m + 1) + rest, + .cons hruns ⟨_, hhalt⟩ hstep hdec hmod hrest, + congrArg (o :: ·) hops, .cons ⟨o, a, s₁⟩ hv_o hstep htr, hr_z, ?_⟩ + cases o <;> + simp only [charge, tEmpty, tGet, tIns, tDec, tExt, + numQueries, numInserts, numDecreaseKeys, extractLogSum] at hpot_m ⊢ <;> + omega + +private theorem initRegs_bounded {n_max base w : ℕ} (hS : Fits w (base + space n_max)) + {mem₀ : ℕ → ℕ} (hmem : ∀ a, Fits w (mem₀ a)) : + (⟨initRegs n_max base, mem₀⟩ : Data rMinPQ).Bounded w := by + refine ⟨fun i => ?_, hmem⟩ + simp only [initRegs] + split_ifs + · exact hS.of_le (by have := space_lower n_max; omega) + · exact hS.of_le (Nat.le_add_right base _) + · exact hS.of_le (Nat.zero_le _) + +/-- Standalone `Basis.exact` operation-sequence theorem with `O(1)` fresh initialization on zeroed +`[base, base + 11 * n_max + 1)` and per-extraction `O(log n + 1)` amortized cost in the current +number of stored elements `n = MinPQ.size s`. -/ +theorem run_ops_exact_fresh {n_max U V w base : ℕ} + (hS : Fits w (base + space n_max)) (hU : Fits w U) (hV : Fits w V) + {mem₀ : ℕ → ℕ} (hmem : ∀ a, Fits w (mem₀ a)) + (hzero : ∀ a ∈ (Block.mk base (space n_max)).footprint, mem₀ a = 0) + (ops : List (Cslib.Algorithms.Lean.MinPQ.Op n_max)) + (hv : (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).ValidOpSeq + (Cslib.Algorithms.Lean.MinPQ.empty n_max) ops) : + ∃ pc₀ x₀ t_init tr s_fin z t_ops, + Runs w initFreshProg ⟨0, ⟨initRegs n_max base, mem₀⟩⟩ ⟨pc₀, x₀⟩ t_init ∧ + (∃ out, step w initFreshProg ⟨pc₀, x₀⟩ = .halt out) ∧ + Modifies (Block.mk base (space n_max)).footprint mem₀ x₀.mem ∧ + RunsOps (U := U) (V := V) w base (Cslib.Algorithms.Lean.MinPQ.empty n_max) x₀ ops tr + s_fin z t_ops ∧ + tr.ops = ops ∧ + (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).ValidTranscript + (Cslib.Algorithms.Lean.MinPQ.empty n_max) tr s_fin ∧ + t_init + 1 ≤ 421 ∧ + t_ops ≤ + 421 * (numQueries ops + numInserts ops + numDecreaseKeys ops + + extractLogSum (Cslib.Algorithms.Lean.MinPQ.empty n_max) tr) ∧ + t_ops ≤ + 421 * (numQueries ops + numInserts ops + numDecreaseKeys ops + + numExtractMins ops * (Nat.log 2 n_max + 1)) := by + let d₀ : Data rMinPQ := ⟨initRegs n_max base, mem₀⟩ + have hfr_eq : d₀.regs outerFrontierReg = base := by + simp only [d₀, initRegs, show outerFrontierReg ≠ nReg by decide, ↓reduceIte] + have hpar : ∀ j : Fin 1, d₀.regs (![nReg] j) = ![n_max] j := fun j => by + fin_cases j; rfl + obtain ⟨x₀, ⟨t_init, ht_init, he_init⟩, _, hr₀, hpot₀, hmod₀⟩ := + (relSubroutineDS hS hU hV).initFresh_exec (initRegs_bounded hS hmem) hfr_eq hpar hzero + have hruns₀ : Runs w initFreshProg ⟨0, d₀⟩ + ⟨0 + subroutineCode.initFresh.size, x₀⟩ t_init := + he_init.runs (pc := 0) (p := initFreshProg) (Program.Contains.self _).append_left + have hhalt₀ : step w initFreshProg ⟨0 + subroutineCode.initFresh.size, x₀⟩ = + .halt (x₀.regs outFlag) := + step_program_halt subroutineCode.initFresh outFlag x₀ + obtain ⟨tr, s_fin, z, t_ops, hruns_ops, hops, htr, _, hbound⟩ := + seq_runsOps hS hU hV ops hr₀ hv + have hlog_le := extractLogSum_le_numExtractMins tr (Cslib.Algorithms.Lean.MinPQ.empty n_max) + rw [hops] at hlog_le + refine ⟨_, x₀, t_init, tr, s_fin, z, t_ops, hruns₀, ⟨_, hhalt₀⟩, hmod₀, hruns_ops, + hops, htr, ?_, ?_, ?_⟩ + · change t_init ≤ 33 at ht_init + omega + · change potential x₀ ≤ 0 at hpot₀ + omega + · change potential x₀ ≤ 0 at hpot₀ + omega + +/-- Standalone `Basis.exact` operation-sequence theorem with `O(n_max)` reusable initialization on +arbitrary `w`-bounded memory `mem₀` and per-extraction `O(log n + 1)` amortized cost in the current +number of stored elements `n = MinPQ.size s`. -/ +theorem run_ops_exact_reusable {n_max U V w base : ℕ} + (hS : Fits w (base + space n_max)) (hU : Fits w U) (hV : Fits w V) + {mem₀ : ℕ → ℕ} (hmem : ∀ a, Fits w (mem₀ a)) + (ops : List (Cslib.Algorithms.Lean.MinPQ.Op n_max)) + (hv : (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).ValidOpSeq + (Cslib.Algorithms.Lean.MinPQ.empty n_max) ops) : + ∃ pc₀ x₀ t_init tr s_fin z t_ops, + Runs w initClearProg ⟨0, ⟨initRegs n_max base, mem₀⟩⟩ ⟨pc₀, x₀⟩ t_init ∧ + (∃ out, step w initClearProg ⟨pc₀, x₀⟩ = .halt out) ∧ + Modifies (Block.mk base (space n_max)).footprint mem₀ x₀.mem ∧ + RunsOps (U := U) (V := V) w base (Cslib.Algorithms.Lean.MinPQ.empty n_max) x₀ ops tr + s_fin z t_ops ∧ + tr.ops = ops ∧ + (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).ValidTranscript + (Cslib.Algorithms.Lean.MinPQ.empty n_max) tr s_fin ∧ + t_init + 1 ≤ 421 * (n_max + 1) ∧ + t_ops ≤ + 421 * (numQueries ops + numInserts ops + numDecreaseKeys ops + + extractLogSum (Cslib.Algorithms.Lean.MinPQ.empty n_max) tr) ∧ + t_ops ≤ + 421 * (numQueries ops + numInserts ops + numDecreaseKeys ops + + numExtractMins ops * (Nat.log 2 n_max + 1)) := by + let d₀ : Data rMinPQ := ⟨initRegs n_max base, mem₀⟩ + have hfr_eq : d₀.regs outerFrontierReg = base := by + simp only [d₀, initRegs, show outerFrontierReg ≠ nReg by decide, ↓reduceIte] + have hpar : ∀ j : Fin 1, d₀.regs (![nReg] j) = ![n_max] j := fun j => by + fin_cases j; rfl + obtain ⟨x₀, ⟨t_init, ht_init, he_init⟩, _, hr₀, hpot₀, hmod₀⟩ := + (relSubroutineDS hS hU hV).initClear_exec (initRegs_bounded hS hmem) hfr_eq hpar + have hruns₀ : Runs w initClearProg ⟨0, d₀⟩ + ⟨0 + subroutineCode.initClear.size, x₀⟩ t_init := + he_init.runs (pc := 0) (p := initClearProg) (Program.Contains.self _).append_left + have hhalt₀ : step w initClearProg ⟨0 + subroutineCode.initClear.size, x₀⟩ = + .halt (x₀.regs outFlag) := + step_program_halt subroutineCode.initClear outFlag x₀ + obtain ⟨tr, s_fin, z, t_ops, hruns_ops, hops, htr, _, hbound⟩ := + seq_runsOps hS hU hV ops hr₀ hv + have hlog_le := extractLogSum_le_numExtractMins tr (Cslib.Algorithms.Lean.MinPQ.empty n_max) + rw [hops] at hlog_le + refine ⟨_, x₀, t_init, tr, s_fin, z, t_ops, hruns₀, ⟨_, hhalt₀⟩, hmod₀, hruns_ops, + hops, htr, ?_, ?_, ?_⟩ + · change t_init ≤ 33 + 4 * (11 * n_max + 1) + 6 at ht_init + omega + · change potential x₀ ≤ 0 at hpot₀ + omega + · change potential x₀ ≤ 0 at hpot₀ + omega + +end Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.MinPQ diff --git a/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/Program.lean b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/Program.lean index f891a9fe6..f0507a767 100644 --- a/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/Program.lean +++ b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/Program.lean @@ -672,16 +672,29 @@ def tGet (_n : ℕ) : ℕ := 16 def tIns (_n : ℕ) : ℕ := 130 /-- Amortized instruction bound for `decreaseKey` (including dispatch and cascading cuts). -/ def tDec (_n : ℕ) : ℕ := 340 -/-- Amortized instruction bound for `extractMin` (`O(log n)`). -/ +/-- Amortized instruction bound for `extractMin` (`O(log n + 1)`). -/ def tExt (n : ℕ) : ℕ := 420 * (Nat.log 2 n + 1) -/-- Per-operation amortized instruction charge for `FibonacciHeap`. -/ -def charge (n : ℕ) (_s : IndexedMinPQ.State n) : IndexedMinPQ.Op n → ℕ +/-- Per-operation amortized instruction charge for `FibonacciHeap`, charging +`tExt (IndexedMinPQ.dom s).card` on `.extractMin` in terms of the current number of stored +elements `(IndexedMinPQ.dom s).card`. -/ +def charge (n : ℕ) (s : IndexedMinPQ.State n) : IndexedMinPQ.Op n → ℕ | .isEmpty => tEmpty n | .getKey _ => tGet n | .insert _ _ => tIns n | .decreaseKey _ _ => tDec n - | .extractMin => tExt n + | .extractMin => tExt (IndexedMinPQ.dom s).card + +/-- The current number of stored elements `(IndexedMinPQ.dom s).card` is at most `n`, so +`charge n s .extractMin ≤ tExt n`. -/ +theorem charge_extractMin_le_tExt (n : ℕ) (s : IndexedMinPQ.State n) : + charge n s .extractMin ≤ tExt n := by + simp only [charge, tExt] + have hcard : (IndexedMinPQ.dom s).card ≤ n := by + simpa using (IndexedMinPQ.dom s).card_le_univ + have hlog : Nat.log 2 (IndexedMinPQ.dom s).card ≤ Nat.log 2 n := + Nat.log_mono_right hcard + omega /-! ## Exact-ALU step rules, footprint framing, and `RawState.ofData` update lemmas -/ diff --git a/ComplexityTests/Abstracts/FibonacciHeapTests.lean b/ComplexityTests/Abstracts/FibonacciHeapTests.lean index 55799938e..64150fe04 100644 --- a/ComplexityTests/Abstracts/FibonacciHeapTests.lean +++ b/ComplexityTests/Abstracts/FibonacciHeapTests.lean @@ -13,86 +13,112 @@ import ComplexityAbstracts.FibonacciHeapAbstract Instantiates both `fibonacciHeap_amortized` and `fibonacciHeap_amortized_reusable` on a concrete non-empty operation sequence exercising all five priority-queue operations and checks memory -confinement outside `[base, base + 9 n + 1)`. +confinement outside `[base, base + 11 * n_max + 1)`. -/ namespace ComplexityTests.Abstracts.FibonacciHeapTests open ComplexityAbstracts.FibonacciHeapAbstract -/-- Concrete 6-operation sequence on `Fin 4` exercising all five `Op` constructors. -/ -def sampleOps : List (Op 4) := - [.insert 2 30, .insert 1 30, .decreaseKey 2 10, .getKey 2, .extractMin, .isEmpty] +/-- Concrete 6-operation sequence on capacity `n_max = 2` exercising all five `Op` constructors: +two insertions fill all `2` handles with key `30` (and satellite values `100`, `200`), so handle +`0` is guaranteed to hold key `30` regardless of which handle the relational specification +allocated first. -/ +def sampleOps : List (Op 2) := + [.insert 30 100, .insert 30 200, .decreaseKey 0 10, .get 0, .extractMin, .isEmpty] -theorem sampleOps_valid : ValidSeq 50 (emptyQueue 4) sampleOps := by - refine ⟨⟨rfl, by decide⟩, ⟨⟨by decide, by decide⟩, ⟨⟨⟨30, rfl, by decide⟩, by decide⟩, - ⟨trivial, ⟨trivial, ⟨trivial, trivial⟩⟩⟩⟩⟩⟩ +theorem sampleOps_valid : ValidSeq 50 500 (emptyQueue 2) sampleOps := by + refine ⟨⟨by decide, by decide, by decide⟩, ?_⟩ + rintro q₁ _ ⟨h₁, _, rfl, rfl⟩ + fin_cases h₁ + · refine ⟨⟨by decide, by decide, by decide⟩, ?_⟩ + rintro q₂ _ ⟨h₂, hh₂, rfl, rfl⟩ + fin_cases h₂ + · simp [Function.update] at hh₂ + · refine ⟨⟨30, 100, rfl, by decide⟩, ?_⟩ + exact fun _ _ _ => + ⟨trivial, fun _ _ _ => ⟨trivial, fun _ _ _ => ⟨trivial, fun _ _ _ => trivial⟩⟩⟩ + · refine ⟨⟨by decide, by decide, by decide⟩, ?_⟩ + rintro q₂ _ ⟨h₂, hh₂, rfl, rfl⟩ + fin_cases h₂ + · refine ⟨⟨30, 200, rfl, by decide⟩, ?_⟩ + exact fun _ _ _ => + ⟨trivial, fun _ _ _ => ⟨trivial, fun _ _ _ => ⟨trivial, fun _ _ _ => trivial⟩⟩⟩ + · simp [Function.update] at hh₂ private theorem unchanged_trans {base len : ℕ} {m₁ m₂ m₃ : ℕ → ℕ} (h₁ : UnchangedOutside base len m₁ m₂) (h₂ : UnchangedOutside base len m₂ m₃) : UnchangedOutside base len m₁ m₃ := fun a ha => (h₂ a ha).trans (h₁ a ha) -private theorem runsOps_unchanged {r n w : ℕ} {p : Program r} {base len : ℕ} - {q : Queue n} {reg reg' : Fin r → ℕ} {mem mem' : ℕ → ℕ} {ops : List (Op n)} {total : ℕ} - (h : RunsOps w p base len q reg mem ops reg' mem' total) : +private theorem runsOps_unchanged {r n_max w : ℕ} {p : Program r} {base len : ℕ} + {q q' : Queue n_max} {reg reg' : Fin r → ℕ} {mem mem' : ℕ → ℕ} {ops : List (Op n_max)} + {total extLog : ℕ} + (h : RunsOps w p base len q reg mem ops q' reg' mem' total extLog) : UnchangedOutside base len mem mem' := by induction h with | nil => intro _ _; rfl - | cons _ _ _ hmod _ ih => exact unchanged_trans hmod ih + | cons _ _ _ _ hmod _ ih => exact unchanged_trans hmod ih /-- Non-vacuity of `fibonacciHeap_amortized` (`O(1)` fresh initialization): runs `sampleOps` on -`[10, 47)` at word size `10` with sentinel `77` outside `[10, 47)`, preserving `mem_f 9 = 77` and -`mem_f 47 = 77`. -/ +`[10, 33)` (`11 * 2 + 1 = 23` words) at word size `10` with sentinel `77` outside `[10, 33)`, +preserving `mem_f 9 = 77` and `mem_f 33 = 77`. -/ example : - ∃ r, ∃ p_init p_op : Program r, ∃ K t₀ t_init reg_f mem_f t_ops, - let mem₀ : ℕ → ℕ := fun a => if a < 10 ∨ 47 ≤ a then 77 else 0 - Runs 10 p_init ⟨0, initRegs 4 10, mem₀⟩ t₀ t_init ∧ + ∃ r, ∃ p_init p_op : Program r, ∃ K t₀ t_init q_f reg_f mem_f t_ops extLog, + let mem₀ : ℕ → ℕ := fun a => if a < 10 ∨ 33 ≤ a then 77 else 0 + Runs 10 p_init ⟨0, initRegs 2 10, mem₀⟩ t₀ t_init ∧ (∃ out, step 10 p_init t₀ = .halt out) ∧ - RunsOps 10 p_op 10 37 (emptyQueue 4) t₀.reg t₀.mem sampleOps reg_f mem_f t_ops ∧ + RunsOps 10 p_op 10 23 (emptyQueue 2) t₀.reg t₀.mem sampleOps q_f reg_f mem_f t_ops extLog ∧ mem_f 9 = 77 ∧ - mem_f 47 = 77 ∧ + mem_f 33 = 77 ∧ t_init + 1 ≤ K ∧ - t_ops ≤ K * 8 := by + t_ops ≤ K * (5 + extLog) ∧ + extLog ≤ 2 := by obtain ⟨r, p_init, p_op, K, hfib⟩ := fibonacciHeap_amortized - let mem₀ : ℕ → ℕ := fun a => if a < 10 ∨ 47 ≤ a then 77 else 0 + let mem₀ : ℕ → ℕ := fun a => if a < 10 ∨ 33 ≤ a then 77 else 0 have hmem : ∀ a, mem₀ a < 2 ^ 10 := fun a => by dsimp only [mem₀]; split_ifs <;> decide - have hzero : ∀ a, 10 ≤ a → a < 10 + (9 * 4 + 1) → mem₀ a = 0 := fun a h1 h2 => by + have hzero : ∀ a, 10 ≤ a → a < 10 + (11 * 2 + 1) → mem₀ a = 0 := fun a h1 h2 => by dsimp only [mem₀] - have : ¬(a < 10 ∨ 47 ≤ a) := by omega + have : ¬(a < 10 ∨ 33 ≤ a) := by omega simp [this] - obtain ⟨t₀, t_init, reg_f, mem_f, t_ops, hr₀, hh₀, hu₀, hruns, ht_init, ht_ops⟩ := - hfib 4 50 10 10 mem₀ sampleOps (by decide) (by decide) hmem hzero sampleOps_valid + obtain ⟨t₀, t_init, q_f, reg_f, mem_f, t_ops, extLog, + hr₀, hh₀, hu₀, hruns, ht_init, ht_ops, hext⟩ := + hfib 2 50 500 10 10 mem₀ sampleOps (by decide) (by decide) (by decide) hmem hzero + sampleOps_valid have hu_all := unchanged_trans hu₀ (runsOps_unchanged hruns) have hm9 : mem_f 9 = 77 := hu_all 9 (Or.inl (by decide)) - have hm47 : mem_f 47 = 77 := hu_all 47 (Or.inr (by decide)) - have hlog : Nat.log 2 4 = 2 := Nat.log_eq_of_pow_le_of_lt_pow (by decide) (by decide) - simp only [sampleOps, numQueries, numInserts, numDecreaseKeys, numExtractMins, hlog] at ht_ops - exact ⟨r, p_init, p_op, K, t₀, t_init, reg_f, mem_f, t_ops, hr₀, hh₀, hruns, - hm9, hm47, ht_init, ht_ops⟩ + have hm33 : mem_f 33 = 77 := hu_all 33 (Or.inr (by decide)) + have hlog : Nat.log 2 2 = 1 := Nat.log_eq_of_pow_le_of_lt_pow (by decide) (by decide) + simp only [sampleOps, numQueries, numInserts, numDecreaseKeys, numExtractMins, hlog] + at ht_ops hext + exact ⟨r, p_init, p_op, K, t₀, t_init, q_f, reg_f, mem_f, t_ops, extLog, + hr₀, hh₀, hruns, hm9, hm33, ht_init, ht_ops, hext⟩ -/-- Non-vacuity of `fibonacciHeap_amortized_reusable` (`O(n)` clear initialization): runs -`sampleOps` on `[10, 47)` starting from dirty memory `mem₀ = fun _ => 99` everywhere, preserving -`mem_f 9 = 99` and `mem_f 47 = 99`. -/ +/-- Non-vacuity of `fibonacciHeap_amortized_reusable` (`O(n_max + 1)` clear initialization): runs +`sampleOps` on `[10, 33)` starting from dirty memory `mem₀ = fun _ => 99` everywhere, preserving +`mem_f 9 = 99` and `mem_f 33 = 99`. -/ example : - ∃ r, ∃ p_init p_op : Program r, ∃ K t₀ t_init reg_f mem_f t_ops, - Runs 10 p_init ⟨0, initRegs 4 10, fun _ => 99⟩ t₀ t_init ∧ + ∃ r, ∃ p_init p_op : Program r, ∃ K t₀ t_init q_f reg_f mem_f t_ops extLog, + Runs 10 p_init ⟨0, initRegs 2 10, fun _ => 99⟩ t₀ t_init ∧ (∃ out, step 10 p_init t₀ = .halt out) ∧ - RunsOps 10 p_op 10 37 (emptyQueue 4) t₀.reg t₀.mem sampleOps reg_f mem_f t_ops ∧ + RunsOps 10 p_op 10 23 (emptyQueue 2) t₀.reg t₀.mem sampleOps q_f reg_f mem_f t_ops extLog ∧ mem_f 9 = 99 ∧ - mem_f 47 = 99 ∧ - t_init + 1 ≤ K * 5 ∧ - t_ops ≤ K * 8 := by + mem_f 33 = 99 ∧ + t_init + 1 ≤ K * 3 ∧ + t_ops ≤ K * (5 + extLog) ∧ + extLog ≤ 2 := by obtain ⟨r, p_init, p_op, K, hfib⟩ := fibonacciHeap_amortized_reusable - obtain ⟨t₀, t_init, reg_f, mem_f, t_ops, hr₀, hh₀, hu₀, hruns, ht_init, ht_ops⟩ := - hfib 4 50 10 10 (fun _ => 99) sampleOps (by decide) (by decide) (fun _ => by decide) - sampleOps_valid + obtain ⟨t₀, t_init, q_f, reg_f, mem_f, t_ops, extLog, + hr₀, hh₀, hu₀, hruns, ht_init, ht_ops, hext⟩ := + hfib 2 50 500 10 10 (fun _ => 99) sampleOps (by decide) (by decide) (by decide) + (fun _ => by decide) sampleOps_valid have hu_all := unchanged_trans hu₀ (runsOps_unchanged hruns) have hm9 : mem_f 9 = 99 := hu_all 9 (Or.inl (by decide)) - have hm47 : mem_f 47 = 99 := hu_all 47 (Or.inr (by decide)) - have hlog : Nat.log 2 4 = 2 := Nat.log_eq_of_pow_le_of_lt_pow (by decide) (by decide) - simp only [sampleOps, numQueries, numInserts, numDecreaseKeys, numExtractMins, hlog] at ht_ops - exact ⟨r, p_init, p_op, K, t₀, t_init, reg_f, mem_f, t_ops, hr₀, hh₀, hruns, - hm9, hm47, ht_init, ht_ops⟩ + have hm33 : mem_f 33 = 99 := hu_all 33 (Or.inr (by decide)) + have hlog : Nat.log 2 2 = 1 := Nat.log_eq_of_pow_le_of_lt_pow (by decide) (by decide) + simp only [sampleOps, numQueries, numInserts, numDecreaseKeys, numExtractMins, hlog] + at ht_ops hext + exact ⟨r, p_init, p_op, K, t₀, t_init, q_f, reg_f, mem_f, t_ops, extLog, + hr₀, hh₀, hruns, hm9, hm33, ht_init, ht_ops, hext⟩ end ComplexityTests.Abstracts.FibonacciHeapTests diff --git a/ComplexityTests/WordRAMFibonacciHeap.lean b/ComplexityTests/WordRAMFibonacciHeap.lean index 1c3f0e812..2a9ba3db6 100644 --- a/ComplexityTests/WordRAMFibonacciHeap.lean +++ b/ComplexityTests/WordRAMFibonacciHeap.lean @@ -270,4 +270,123 @@ example : rw [hp₀, Nat.add_zero] at hcost exact ⟨y₀, y, traces, hr₀, hp₀, hex, hcost⟩ +/-! ### 5. Key–value Fibonacci heap with handles (`FibonacciHeap.MinPQ`) -/ + +/-- Tabulate registers `0..rMinPQ - 1` (`48`) and memory `0..memCap - 1` into flat lists between +interpreter calls for `FibonacciHeap.MinPQ`. -/ +def compactDataMinPQ (memCap : ℕ) (d : Data MinPQ.rMinPQ) : Option (Data MinPQ.rMinPQ) := do + let rs ← forceList ((List.finRange MinPQ.rMinPQ).map d.regs) + let ms ← forceList ((List.range memCap).map d.mem) + let tail ← forceNat (d.mem memCap) + pure + { regs := fun i => rs.getD i.val 0 + mem := fun a => if a < memCap then ms.getD a 0 else tail } + +/-- Run a single `Cslib.Algorithms.Lean.MinPQ.Op` via `MinPQ.dispatchCode.eval`. -/ +def stepEvalMinPQ {n_max : ℕ} (w fuel : ℕ) (dt : Data MinPQ.rMinPQ × ℕ) + (o : Cslib.Algorithms.Lean.MinPQ.Op n_max) : + Option (Data MinPQ.rMinPQ × ℕ) := do + let (d', t) ← MinPQ.dispatchCode.eval w fuel ⟨MinPQ.prepareRegs o dt.1.regs, dt.1.mem⟩ + let dc ← compactDataMinPQ 80 d' + pure (dc, dt.2 + t) + +/-- Concrete interpreter test for `FibonacciHeap.MinPQ`: +* `insert 30 300` allocates handle `0`, `insert 20 200` allocates handle `1`; +* `get 0` returns key `30` and satellite value `300`; +* `decreaseKey 0 5` lowers handle `0`'s key to `5`; +* `extractMin` returns `(u = 5, v = 300, h = 0)` and pushes handle `0` onto the free stack; +* `insert 15 150` reuses handle `0` from the free stack; +* two more `extractMin`s return `(15, 150, 0)` and `(20, 200, 1)`, followed by `none`. -/ +example : + (do + let d0 ← MinPQ.subroutineCode.initFresh.eval 12 16 ⟨MinPQ.initRegs 4 10, fun _ => 0⟩ + let d1 ← stepEvalMinPQ (n_max := 4) 12 16 d0 (.insert 30 300) + let d2 ← stepEvalMinPQ (n_max := 4) 12 16 d1 (.insert 20 200) + let d3 ← stepEvalMinPQ (n_max := 4) 12 16 d2 (.get 0) + let d4 ← stepEvalMinPQ (n_max := 4) 12 16 d3 (.decreaseKey 0 5) + let d5 ← stepEvalMinPQ (n_max := 4) 12 16 d4 .extractMin + let d6 ← stepEvalMinPQ (n_max := 4) 12 16 d5 (.insert 15 150) + let d7 ← stepEvalMinPQ (n_max := 4) 12 16 d6 .extractMin + let d8 ← stepEvalMinPQ (n_max := 4) 12 16 d7 .extractMin + let d9 ← stepEvalMinPQ (n_max := 4) 12 16 d8 .extractMin + pure + [d1.1.regs MinPQ.outV, d2.1.regs MinPQ.outV, + d3.1.regs MinPQ.outFlag, d3.1.regs MinPQ.outK, d3.1.regs MinPQ.outValReg, + d5.1.regs MinPQ.outFlag, d5.1.regs MinPQ.outK, d5.1.regs MinPQ.outValReg, + d5.1.regs MinPQ.outV, + d6.1.regs MinPQ.outV, + d7.1.regs MinPQ.outK, d7.1.regs MinPQ.outValReg, d7.1.regs MinPQ.outV, + d8.1.regs MinPQ.outK, d8.1.regs MinPQ.outValReg, d8.1.regs MinPQ.outV, + d9.1.regs MinPQ.outFlag]) = + some [0, 1, 1, 30, 300, 1, 5, 300, 0, 0, 15, 150, 0, 20, 200, 1, 0] := by + decide +kernel + +/-- Non-vacuity of `FibonacciHeap.relAmortized` over `Basis.standard`. -/ +example : + let hS : Fits 10 (8 + MinPQ.space 4) := by unfold MinPQ.space Fits; decide + let hU : Fits 10 50 := by decide + let hV : Fits 10 500 := by decide + Stateful.RelAmortized (relCertificate hS hU hV).realization + DynamicProgram.OperationTrace.instructions + (fun _ x => MinPQ.potential x) + (fun s o => MinPQ.charge 4 s o + 1) := + relAmortized _ _ _ + +/-- Lift a single `Cslib.Algorithms.Lean.MinPQ.Op` into an adaptive `Client`. -/ +abbrev callMinPQOp (o : Cslib.Algorithms.Lean.MinPQ.Op 4) : + (Cslib.Algorithms.Lean.MinPQ.spec 4 50 500).Client + ((Cslib.Algorithms.Lean.MinPQ.spec 4 50 500).Result o) := + PFunctor.FreeM.lift (P := (Cslib.Algorithms.Lean.MinPQ.spec 4 50 500).signature) o + +/-- Concrete adaptive client that inserts `(30, 300)`, receives the allocated handle `h`, lowers +`h`'s key to `5`, and extracts the minimum entry. -/ +def sampleMinPQClient : + (Cslib.Algorithms.Lean.MinPQ.spec 4 50 500).Client (Option (ℕ × ℕ × Fin 4)) := do + let hOpt ← callMinPQOp (.insert 30 300) + match hOpt with + | some h => + callMinPQOp (.decreaseKey h 5) + callMinPQOp .extractMin + | none => + callMinPQOp .extractMin + +/-- Non-vacuity of `MinPQ.relSubroutineDS`, `MinPQ.Rep`, and `MinPQ.run_client_amortized` for an +adaptive handle-passing client over `Basis.standard`. -/ +example : + let hS : Fits 10 (8 + MinPQ.space 4) := by unfold MinPQ.space Fits; decide + let hU : Fits 10 50 := by decide + let hV : Fits 10 500 := by decide + ∃ a y₀ y traces s' tr, + MinPQ.Rep 4 50 500 10 8 (Cslib.Algorithms.Lean.MinPQ.empty 4) y₀ ∧ + MinPQ.potential y₀ = 0 ∧ + Stateful.RelExecutes ((relDynamicProgram hS hU hV).ExecOp 10) sampleMinPQClient y₀ + a y traces ∧ + (Cslib.Algorithms.Lean.MinPQ.spec 4 50 500).ClientRun + (Cslib.Algorithms.Lean.MinPQ.empty 4) sampleMinPQClient a s' tr ∧ + Stateful.total DynamicProgram.OperationTrace.instructions traces + MinPQ.potential y ≤ + (Cslib.Algorithms.Lean.MinPQ.spec 4 50 500).totalCost + (fun st o => MinPQ.charge 4 st o + 1) + (Cslib.Algorithms.Lean.MinPQ.empty 4) tr := by + intro hS hU hV + let x₀ : Data MinPQ.rMinPQ := ⟨MinPQ.initRegs 4 8, fun _ => 0⟩ + have hx₀ : x₀.Bounded 10 := + ⟨fun i => by fin_cases i <;> decide, fun _ => show Fits 10 0 by decide⟩ + have hfr : x₀.regs MinPQ.outerFrontierReg = 8 := by decide + have hpar : ∀ j : Fin 1, x₀.regs (![MinPQ.nReg] j) = ![4] j := fun j => by fin_cases j; rfl + have hz : ∀ a ∈ (Block.mk 8 (MinPQ.space 4)).footprint, x₀.mem a = 0 := fun _ _ => rfl + obtain ⟨y₀, _, _, hr₀, hpot₀, _⟩ := + (relSubroutineDS hS hU hV).initFresh_exec hx₀ hfr hpar hz + have hp₀ : MinPQ.potential y₀ = 0 := Nat.eq_zero_of_le_zero hpot₀ + have hv : (Cslib.Algorithms.Lean.MinPQ.spec 4 50 500).DemonicValid + (Cslib.Algorithms.Lean.MinPQ.empty 4) sampleMinPQClient := by + refine .liftBind _ _ ⟨by decide, by decide, by decide⟩ ?_ + rintro s₁ _ ⟨h, _, rfl, rfl⟩ + refine .liftBind _ _ ⟨30, 300, by simp [Function.update], by decide⟩ ?_ + rintro s₂ _ _ + exact .liftBind _ _ trivial fun s₃ a _ => .pure s₃ a + obtain ⟨a, y, traces, s', tr, hex, hrun, _, _, hcost⟩ := + MinPQ.run_client_amortized hS hU hV sampleMinPQClient hr₀ hv + rw [hp₀, Nat.add_zero] at hcost + exact ⟨a, y₀, y, traces, s', tr, hr₀, hp₀, hex, hrun, hcost⟩ + end WordRAMFibonacciHeapTests diff --git a/abstracts/ComplexityAbstracts/FibonacciHeapAbstract.lean b/abstracts/ComplexityAbstracts/FibonacciHeapAbstract.lean index 4170ec8ac..8b75a789e 100644 --- a/abstracts/ComplexityAbstracts/FibonacciHeapAbstract.lean +++ b/abstracts/ComplexityAbstracts/FibonacciHeapAbstract.lean @@ -11,30 +11,34 @@ import ComplexityAbstracts.FibonacciHeapBridge /-! # Fibonacci heaps: amortized priority queues on the word RAM -An indexed min-priority queue maintains a subset of the handles `0, …, n - 1` (the type `Fin n`), -each associated with a natural-number key at most `K_max`. It supports membership/key queries -(`isEmpty`, `getKey`), inserting an absent handle (`insert`), lowering the key of a present handle -(`decreaseKey`), and removing the present `(handle, key)` pair of minimum key (`extractMin`), -breaking equal-key ties by smallest handle index. Fredman and Tarjan's Fibonacci heap supports -queries in `O(1)` time, `insert` and `decreaseKey` in `O(1)` amortized time, and `extractMin` in -`O(log n)` amortized time. +A min-priority queue with capacity `n_max`, key bound `U`, and value bound `V` maintains at most +`n_max` elements, where each stored element is a key–value pair `(u, v)` with `u < U` and `v < V` +identified by a handle `h : Fin n_max` allocated by the data structure. It supports emptiness and +handle-lookup queries (`isEmpty`, `get h`), inserting a new `(key, value)` pair (`insert u v`, which +allocates and returns an unused handle `h : Fin n_max`), lowering the key of a currently stored +handle (`decreaseKey h u'`), and removing a stored element of minimum key (`extractMin`, which +returns `some (u, v, h)` or `none` when empty). Fredman and Tarjan's Fibonacci heap supports queries +in `O(1)` time, `insert` and `decreaseKey` in `O(1)` amortized time, and `extractMin` in +`O(log n + 1)` amortized time, where `n` is the current number of stored elements. The theorems below state this guarantee on the word RAM over the exact basis of operations, inside a -caller-chosen contiguous block `[base, base + 9 n + 1)` of `9 n + 1` words: - -* `fibonacciHeap_amortized` initializes an empty heap on zeroed `[base, base + 9 n + 1)` in `O(1)` - instructions and executes any valid sequence of `m_q` queries, `m_ins` insertions, `m_dec` key - decreases, and `m_ext` minimum extractions in - `O(m_q + m_ins + m_dec + m_ext (log n + 1))` total instructions; +caller-chosen contiguous block `[base, base + 11 * n_max + 1)` of `11 * n_max + 1` words: + +* `fibonacciHeap_amortized` initializes an empty heap on zeroed `[base, base + 11 * n_max + 1)` in + `O(1)` instructions and executes any admissible sequence `ops` of `m_q` queries, `m_ins` + insertions, `m_dec` key decreases, and `m_ext` minimum extractions in + `O(m_q + m_ins + m_dec + ∑ (log n_t + 1))` total instructions, where `n_t = size q_t` is the + number of stored elements immediately before the `t`-th `extractMin` (bounded in turn by + `m_ext * (log n_max + 1)`); * `fibonacciHeap_amortized_reusable` initializes an empty heap on arbitrary `w`-bit memory in - `O(n + 1)` instructions and achieves the same amortized operation bound. + `O(n_max + 1)` instructions and achieves the same amortized operation bound. In both theorems, neither initialization nor any operation modifies memory outside -`[base, base + 9 n + 1)`. Every concept in the statements—the priority queue, its tie-breaking -minimum, admissible operation sequences, the exact word RAM, the register calling convention and -memory confinement—is defined from scratch in this file. Lean checks the proofs through -`FibonacciHeapBridge`, and `#check_abstract` verifies mechanically that no definition or theorem -statement here depends on implementation modules. +`[base, base + 11 * n_max + 1)`. Every concept in the statements—the priority queue, its relational +transition specification, admissible operation sequences, the exact word RAM, the register calling +convention and memory confinement—is defined from scratch in this file. Lean checks the proofs +through `FibonacciHeapBridge`, and `#check_abstract` verifies mechanically that no definition or +theorem statement here depends on implementation modules. ## References @@ -47,131 +51,133 @@ statement here depends on implementation modules. namespace ComplexityAbstracts.FibonacciHeapAbstract -/-! ## Indexed priority queues +/-! ## Priority queues with handles -A priority-queue state `q : Queue n` maps each handle `v : Fin n` to `none` when `v` is absent and -to `some k` when `v` is present with key `k`. To make `extractMin` a deterministic function of `q` -alone (independent of insertion history), `PrioLE` orders `(handle, key)` pairs lexicographically by -`(key, handle)`. An operation sequence is admissible (`ValidSeq K_max`) when every `insert v k` acts -on an absent handle with `k ≤ K_max` and every `decreaseKey v k` lowers the current key of a present -handle with `k ≤ K_max`. +A priority-queue state `q : Queue n_max` maps each handle `h : Fin n_max` to `none` when `h` is +currently unused and to `some (u, v)` when `h` is present with key `u` and satellite value `v`. The +current number of stored elements is `size q`. Because the data structure chooses which unused +handle to allocate on `insert u v` and which minimum-key entry to remove on `extractMin` when keys +tie, transitions are specified relationally by `StepRel`. An operation sequence is admissible +(`ValidSeq U V`) when every operation is valid in the current state and the remaining suffix is +admissible after every valid relational outcome. -/ -/-- Operations on an indexed min-priority queue over handles `Fin n` and natural-number keys. -/ -inductive Op (n : ℕ) +/-- Operations on a min-priority queue with capacity `n_max`, natural-number keys, and +natural-number satellite values. -/ +inductive Op (n_max : ℕ) | isEmpty - | getKey (v : Fin n) - | insert (v : Fin n) (k : ℕ) - | decreaseKey (v : Fin n) (k : ℕ) + | get (h : Fin n_max) + | insert (u v : ℕ) + | decreaseKey (h : Fin n_max) (u' : ℕ) | extractMin -/-- Abstract state of an indexed min-priority queue on `Fin n`: `none` when absent, `some k` when -present with key `k`. -/ -abbrev Queue (n : ℕ) := Fin n → Option ℕ - -/-- The empty priority queue on `Fin n`. -/ -def emptyQueue (n : ℕ) : Queue n := fun _ => none - -/-- Lexicographic priority order on `(handle, key)` pairs: smaller key first, breaking equal-key -ties by smaller handle index. -/ -abbrev PrioLE {n : ℕ} (a b : Fin n × ℕ) : Prop := - a.2 < b.2 ∨ (a.2 = b.2 ∧ (a.1 : ℕ) ≤ (b.1 : ℕ)) +/-- Abstract state of a min-priority queue with capacity `n_max`: `none` when handle `h` is unused, +`some (u, v)` when `h` stores key `u` and satellite value `v`. -/ +abbrev Queue (n_max : ℕ) := Fin n_max → Option (ℕ × ℕ) -/-- Smaller of two `(handle, key)` pairs under `PrioLE`. -/ -def chooseMin {n : ℕ} (a b : Fin n × ℕ) : Fin n × ℕ := - if PrioLE a b then a else b +/-- The empty priority queue of capacity `n_max`. -/ +def emptyQueue (n_max : ℕ) : Queue n_max := fun _ => none -/-- Minimum `(handle, key)` pair in a list under `PrioLE`, or `none` on the empty list. -/ -def foldMin {n : ℕ} : List (Fin n × ℕ) → Option (Fin n × ℕ) - | [] => none - | a :: l => - match foldMin l with - | none => some a - | some b => some (chooseMin a b) +/-- Current number of elements stored in `q`. -/ +def size {n_max : ℕ} (q : Queue n_max) : ℕ := + (Finset.univ.filter fun h => (q h).isSome).card -/-- Present `(handle, key)` pair minimizing `(key, handle)` in `q`, or `none` when `q` is empty. -/ -def findMin {n : ℕ} (q : Queue n) : Option (Fin n × ℕ) := - foldMin ((List.finRange n).filterMap fun v => (q v).map (v, ·)) +/-- Handle `h` is present in `q` with `(u, v)` and `u` is a minimum key among all stored elements. +-/ +def IsMinEntry {n_max : ℕ} (q : Queue n_max) (h : Fin n_max) (u v : ℕ) : Prop := + q h = some (u, v) ∧ ∀ h' u' v', q h' = some (u', v') → u ≤ u' /-- Return type of each priority-queue operation. -/ -def OpResult {n : ℕ} : Op n → Type +def OpResult {n_max : ℕ} : Op n_max → Type | .isEmpty => Bool - | .getKey _ => Option ℕ - | .insert _ _ => Unit + | .get _ => Option (ℕ × ℕ) + | .insert _ _ => Option (Fin n_max) | .decreaseKey _ _ => Unit - | .extractMin => Option (Fin n × ℕ) - -/-- Abstract state transition and return value of operation `o` on queue `q`. -/ -def stepOp {n : ℕ} (q : Queue n) : (o : Op n) → Queue n × OpResult o - | .isEmpty => (q, decide (∀ v, q v = none)) - | .getKey v => (q, q v) - | .insert v k => (Function.update q v (some k), ()) - | .decreaseKey v k => (Function.update q v (some k), ()) - | .extractMin => - match findMin q with - | none => (q, none) - | some (u, k) => (Function.update q u none, some (u, k)) - -/-- Precondition for a single operation under key bound `K_max`: `insert` requires an absent handle -and `k ≤ K_max`; `decreaseKey` requires a present handle whose key does not increase and -`k ≤ K_max`. -/ -def ValidOp {n : ℕ} (K_max : ℕ) (q : Queue n) : Op n → Prop - | .isEmpty | .getKey _ | .extractMin => True - | .insert v k => q v = none ∧ k ≤ K_max - | .decreaseKey v k => (∃ k₀, q v = some k₀ ∧ k ≤ k₀) ∧ k ≤ K_max - -/-- Sequential admissibility of an operation list starting from queue `q`. -/ -def ValidSeq {n : ℕ} (K_max : ℕ) : Queue n → List (Op n) → Prop + | .extractMin => Option (ℕ × ℕ × Fin n_max) + +/-- Relational transition and return value of operation `o` on queue `q`: `insert u v` allocates any +currently unused handle `h : Fin n_max` and stores `(u, v)` at `h`; `extractMin` removes and returns +any stored entry `(u, v, h)` of minimum key `u` (or `none` when `q` is empty). -/ +def StepRel {n_max : ℕ} (q : Queue n_max) : (o : Op n_max) → Queue n_max → OpResult o → Prop + | .isEmpty, q', res => q' = q ∧ res = decide (∀ h, q h = none) + | .get h, q', res => q' = q ∧ res = q h + | .insert u v, q', res => + ∃ h : Fin n_max, q h = none ∧ q' = Function.update q h (some (u, v)) ∧ res = some h + | .decreaseKey h u', q', res => + (∃ u₀ v, q h = some (u₀, v) ∧ q' = Function.update q h (some (u', v))) ∧ res = () + | .extractMin, q', res => + ((∀ h, q h = none) ∧ q' = q ∧ res = none) ∨ + (∃ h u v, IsMinEntry q h u v ∧ q' = Function.update q h none ∧ res = some (u, v, h)) + +/-- Precondition for a single operation under key bound `U` and value bound `V`: `insert u v` +requires `size q < n_max`, `u < U`, and `v < V`; `decreaseKey h u'` requires `h` to be present with +some current key `u₀ ≥ u'`. -/ +def ValidOp {n_max : ℕ} (U V : ℕ) (q : Queue n_max) : Op n_max → Prop + | .isEmpty | .get _ | .extractMin => True + | .insert u v => size q < n_max ∧ u < U ∧ v < V + | .decreaseKey h u' => ∃ u₀ v, q h = some (u₀, v) ∧ u' ≤ u₀ + +/-- Sequential admissibility of an operation list starting from queue `q`: each operation is valid +in the current state, and the remaining suffix is valid after every relational transition `StepRel` +that the operation may take. -/ +def ValidSeq {n_max : ℕ} (U V : ℕ) : Queue n_max → List (Op n_max) → Prop | _, [] => True - | q, o :: ops => ValidOp K_max q o ∧ ValidSeq K_max (stepOp q o).1 ops + | q, o :: ops => ValidOp U V q o ∧ ∀ q' res, StepRel q o q' res → ValidSeq U V q' ops -/-- Number of `isEmpty` and `getKey` queries in `ops`. -/ -def numQueries {n : ℕ} : List (Op n) → ℕ +/-- Number of `isEmpty` and `get` queries in `ops`. -/ +def numQueries {n_max : ℕ} : List (Op n_max) → ℕ | [] => 0 | .isEmpty :: ops => 1 + numQueries ops - | .getKey _ :: ops => 1 + numQueries ops + | .get _ :: ops => 1 + numQueries ops | .insert _ _ :: ops => numQueries ops | .decreaseKey _ _ :: ops => numQueries ops | .extractMin :: ops => numQueries ops /-- Number of `insert` operations in `ops`. -/ -def numInserts {n : ℕ} : List (Op n) → ℕ +def numInserts {n_max : ℕ} : List (Op n_max) → ℕ | [] => 0 | .isEmpty :: ops => numInserts ops - | .getKey _ :: ops => numInserts ops + | .get _ :: ops => numInserts ops | .insert _ _ :: ops => 1 + numInserts ops | .decreaseKey _ _ :: ops => numInserts ops | .extractMin :: ops => numInserts ops /-- Number of `decreaseKey` operations in `ops`. -/ -def numDecreaseKeys {n : ℕ} : List (Op n) → ℕ +def numDecreaseKeys {n_max : ℕ} : List (Op n_max) → ℕ | [] => 0 | .isEmpty :: ops => numDecreaseKeys ops - | .getKey _ :: ops => numDecreaseKeys ops + | .get _ :: ops => numDecreaseKeys ops | .insert _ _ :: ops => numDecreaseKeys ops | .decreaseKey _ _ :: ops => 1 + numDecreaseKeys ops | .extractMin :: ops => numDecreaseKeys ops /-- Number of `extractMin` operations in `ops`. -/ -def numExtractMins {n : ℕ} : List (Op n) → ℕ +def numExtractMins {n_max : ℕ} : List (Op n_max) → ℕ | [] => 0 | .isEmpty :: ops => numExtractMins ops - | .getKey _ :: ops => numExtractMins ops + | .get _ :: ops => numExtractMins ops | .insert _ _ :: ops => numExtractMins ops | .decreaseKey _ _ :: ops => numExtractMins ops | .extractMin :: ops => 1 + numExtractMins ops +/-- Logarithmic cost factor `Nat.log 2 n + 1` in the current number of stored elements `n = size q` +for an `extractMin` step from queue `q`, and `0` for all other operations. -/ +def extractStepLog {n_max : ℕ} (q : Queue n_max) : Op n_max → ℕ + | .extractMin => Nat.log 2 (size q) + 1 + | _ => 0 + /-! ## Memory layout, calling convention and cost -The data structure occupies `9 n + 1` words at addresses `[base, base + 9 n + 1)`, assuming -`base + (9 n + 1) < 2 ^ w`, `K_max < 2 ^ w`, and every initial memory cell holds a `w`-bit word -(`< 2 ^ w`). Initialization (`p_init`) starts at `pc = 0` with `R[0] = n`, `R[1] = base`, and `0` in -all other registers (`initRegs`). Each subsequent operation call (`p_op`) starts at `pc = 0` after -writing the 3-bit operation tag and `(handle, key)` arguments into `R[17..21]` while leaving all -other registers unchanged (`prepareRegs`), runs to a `halt` instruction, and returns its observation -in `R[22..24]` (`decodeResult`), leaving every memory cell outside `[base, base + 9 n + 1)` -unchanged (`UnchangedOutside`). Every instruction costs one unit of time, each `halt` included. The -appendix defines the exact word RAM (`Program`, `State`, `step`, `Runs`) and the register and memory +The data structure occupies `11 * n_max + 1` words at addresses `[base, base + 11 * n_max + 1)`, +assuming `base + (11 * n_max + 1) < 2 ^ w`, `U < 2 ^ w`, `V < 2 ^ w`, and every initial memory cell +holds a `w`-bit word (`< 2 ^ w`). Initialization (`p_init`) starts at `pc = 0` with `R[0] = n_max`, +`R[1] = base`, and `0` in all other registers (`initRegs`). Each subsequent operation call (`p_op`) +starts at `pc = 0` after writing the 3-bit operation tag, handle/key arguments into `R[17..21]`, and +satellite value argument into `R[46]` while leaving all other registers unchanged (`prepareRegs`), +runs to a `halt` instruction, and returns its observation in `R[22..24]` and `R[47]` +(`decodeResult`), leaving every memory cell outside `[base, base + 11 * n_max + 1)` unchanged +(`UnchangedOutside`). Every instruction costs one unit of time, each `halt` included. The appendix +defines the exact word RAM (`Program`, `State`, `step`, `Runs`) and the register and memory conventions. -/ @@ -261,49 +267,55 @@ def step (w : ℕ) (p : Program r) (s : State r) : Outcome r := def Runs (w : ℕ) (p : Program r) : State r → State r → ℕ → Prop := Relation.RelatesInSteps fun s t => step w p s = .next t -/-! **Calling convention and memory confinement.** Registers `R[0..16]` hold persistent heap state -across calls (`p_init` reads `n` in `R[0]` and `base` in `R[1]`), `R[17..21]` carry each operation's -3-bit tag and `(handle, key)` arguments, `R[22..24]` return its result, and `R[25..]` are scratch +/-! **Calling convention and memory confinement.** Registers `R[0..16]` and `R[42..45]` hold +persistent heap and allocator state across calls (`p_init` reads `n_max` in `R[0]` and `base` in +`R[1]`), `R[17..21]` and `R[46]` carry each operation's 3-bit tag and `(handle, key, value)` +arguments, `R[22..24]` and `R[47]` return its result, and the remaining registers are scratch registers. -/ -/-- Initial register assignment for `p_init`: `R[0] = n`, `R[1] = base`, and `0` elsewhere. -/ -def initRegs (n base : ℕ) (i : Fin r) : ℕ := - if (i : ℕ) = 0 then n else if (i : ℕ) = 1 then base else 0 +/-- Initial register assignment for `p_init`: `R[0] = n_max`, `R[1] = base`, and `0` elsewhere. -/ +def initRegs (n_max base : ℕ) (i : Fin r) : ℕ := + if (i : ℕ) = 0 then n_max else if (i : ℕ) = 1 then base else 0 -/-- Write `(t₂, t₁, t₀, a, b)` into `R[17..21]`, leaving every other register unchanged. -/ -def setArgs (t₂ t₁ t₀ a b : ℕ) (reg : Fin r → ℕ) (i : Fin r) : ℕ := +/-- Write `(t₂, t₁, t₀, a, b)` into `R[17..21]` and `val` into `R[46]`, leaving every other register +unchanged. -/ +def setArgs (t₂ t₁ t₀ a b val : ℕ) (reg : Fin r → ℕ) (i : Fin r) : ℕ := if (i : ℕ) = 17 then t₂ else if (i : ℕ) = 18 then t₁ else if (i : ℕ) = 19 then t₀ else if (i : ℕ) = 20 then a else if (i : ℕ) = 21 then b + else if (i : ℕ) = 46 then val else reg i /-- Prepare registers before calling `p_op`: write operation `o`'s tag and arguments into -`R[17..21]` and leave all other registers intact. -/ -def prepareRegs {n : ℕ} : Op n → (Fin r → ℕ) → Fin r → ℕ - | .isEmpty, reg => setArgs 0 0 0 0 0 reg - | .getKey v, reg => setArgs 0 0 1 v 0 reg - | .insert v k, reg => setArgs 0 1 0 v k reg - | .decreaseKey v k, reg => setArgs 0 1 1 v k reg - | .extractMin, reg => setArgs 1 0 0 0 0 reg +`R[17..21]` and `R[46]`, leaving all other registers intact. -/ +def prepareRegs {n_max : ℕ} : Op n_max → (Fin r → ℕ) → Fin r → ℕ + | .isEmpty, reg => setArgs 0 0 0 0 0 0 reg + | .get h, reg => setArgs 0 0 1 h 0 0 reg + | .insert u v, reg => setArgs 0 1 0 0 u v reg + | .decreaseKey h u', reg => setArgs 0 1 1 h u' 0 reg + | .extractMin, reg => setArgs 1 0 0 0 0 0 reg /-- Read register `idx`, or `0` when `r ≤ idx`. -/ def regAt (reg : Fin r → ℕ) (idx : ℕ) : ℕ := if h : idx < r then reg ⟨idx, h⟩ else 0 -/-- Decode operation `o`'s return value from `R[22..24]`: `R[22]` is the boolean result for -`isEmpty` and the presence flag for `getKey`/`extractMin`, `R[23]` is the extracted handle index, -and `R[24]` is the queried or extracted key. -/ -def decodeResult {n : ℕ} : (o : Op n) → (Fin r → ℕ) → Option (OpResult o) +/-- Decode operation `o`'s return value from `R[22..24]` and `R[47]`: `R[22]` is the boolean result +for `isEmpty` and the presence flag for `get` and `extractMin`, `R[23]` is the allocated or +extracted handle index, `R[24]` is the queried or extracted key, and `R[47]` is the queried or +extracted satellite value. -/ +def decodeResult {n_max : ℕ} : (o : Op n_max) → (Fin r → ℕ) → Option (OpResult o) | .isEmpty, reg => some (decide (regAt reg 22 ≠ 0)) - | .getKey _, reg => - if regAt reg 22 = 0 then some none else some (some (regAt reg 24)) - | .insert _ _, _ => some () + | .get _, reg => + if regAt reg 22 = 0 then some none else some (some (regAt reg 24, regAt reg 47)) + | .insert _ _, reg => + if h : regAt reg 23 < n_max then some (some ⟨regAt reg 23, h⟩) else none | .decreaseKey _ _, _ => some () | .extractMin, reg => if regAt reg 22 = 0 then some none - else if h : regAt reg 23 < n then some (some (⟨regAt reg 23, h⟩, regAt reg 24)) + else if h : regAt reg 23 < n_max then + some (some (regAt reg 24, regAt reg 47, ⟨regAt reg 23, h⟩)) else none /-- Every memory address outside `[base, base + len)` retains its previous value. -/ @@ -312,48 +324,59 @@ def UnchangedOutside (base len : ℕ) (m m' : ℕ → ℕ) : Prop := /-! ## Multi-operation execution and main theorems -/ -/-- `RunsOps w p base len q reg mem ops reg' mem' total`: starting from abstract queue `q`, -registers `reg`, and memory `mem`, executing `ops` sequentially by preparing `R[17..21]` -(`prepareRegs`), running `p` from `pc = 0` to `halt`, decoding the exact `stepOp` return value -(`decodeResult`), and modifying memory only within `[base, base + len)` (`UnchangedOutside`) reaches -registers `reg'` and memory `mem'` in `total` instructions (each operation's `halt` included). -/ -inductive RunsOps {n : ℕ} (w : ℕ) (p : Program r) (base len : ℕ) : - Queue n → (Fin r → ℕ) → (ℕ → ℕ) → List (Op n) → (Fin r → ℕ) → (ℕ → ℕ) → ℕ → Prop - | nil {q reg mem} : RunsOps w p base len q reg mem [] reg mem 0 - | cons {q reg mem o ops t reg' mem' steps rest} : +/-- `RunsOps w p base len q reg mem ops q' reg' mem' total extLog`: starting from abstract queue +`q`, registers `reg`, and memory `mem`, executing `ops` sequentially by preparing `R[17..21]` and +`R[46]` (`prepareRegs`), running `p` from `pc = 0` to `halt`, advancing `q` to some next queue state +`q₁` with return value `res` satisfying `StepRel q o q₁ res` and `decodeResult o t.reg = some res`, +and modifying memory only within `[base, base + len)` (`UnchangedOutside`) reaches final queue `q'`, +registers `reg'`, and memory `mem'` in `total` instructions (each operation's `halt` included) with +cumulative extraction log cost `extLog` (the sum of `Nat.log 2 (size q_t) + 1` over all `extractMin` +steps along the execution). -/ +inductive RunsOps {n_max : ℕ} (w : ℕ) (p : Program r) (base len : ℕ) : + Queue n_max → (Fin r → ℕ) → (ℕ → ℕ) → List (Op n_max) → + Queue n_max → (Fin r → ℕ) → (ℕ → ℕ) → ℕ → ℕ → Prop + | nil {q reg mem} : RunsOps w p base len q reg mem [] q reg mem 0 0 + | cons {q q₁ q' reg mem o res ops t reg' mem' steps rest extRest} : Runs w p ⟨0, prepareRegs o reg, mem⟩ t steps → (∃ out, step w p t = .halt out) → - decodeResult o t.reg = some (stepOp q o).2 → + StepRel q o q₁ res → + decodeResult o t.reg = some res → UnchangedOutside base len mem t.mem → - RunsOps w p base len (stepOp q o).1 t.reg t.mem ops reg' mem' rest → - RunsOps w p base len q reg mem (o :: ops) reg' mem' ((steps + 1) + rest) + RunsOps w p base len q₁ t.reg t.mem ops q' reg' mem' rest extRest → + RunsOps w p base len q reg mem (o :: ops) q' reg' mem' + ((steps + 1) + rest) (extractStepLog q o + extRest) /-- **Fibonacci heap (`O(1)` fresh initialization).** There exist a register count `r`, flat programs `p_init` and `p_op` over `r` registers on the exact word RAM, and a constant `K` such that -for all `n`, `K_max`, `base`, `w`, `w`-bit memory `mem₀` zeroed on `[base, base + 9 n + 1)` with -`base + (9 n + 1) < 2 ^ w` and `K_max < 2 ^ w`, and every admissible sequence `ops` starting from -`emptyQueue n`: `p_init` halts in `t_init + 1 ≤ K` instructions without modifying memory outside -`[base, base + 9 n + 1)`, and `p_op` executes `ops` (with `m_q = numQueries ops`, -`m_ins = numInserts ops`, `m_dec = numDecreaseKeys ops`, and `m_ext = numExtractMins ops`) in -`t_ops ≤ K (m_q + m_ins + m_dec + m_ext (Nat.log 2 n + 1))` total instructions while producing every -exact `stepOp` result and leaving memory outside `[base, base + 9 n + 1)` unchanged. -/ +for all `n_max`, `U`, `V`, `base`, `w`, `w`-bit memory `mem₀` zeroed on +`[base, base + 11 * n_max + 1)` with `base + (11 * n_max + 1) < 2 ^ w`, `U < 2 ^ w`, `V < 2 ^ w`, +and every admissible sequence `ops` starting from `emptyQueue n_max`: `p_init` halts in +`t_init + 1 ≤ K` instructions without modifying memory outside `[base, base + 11 * n_max + 1)`, and +`p_op` executes `ops` (with `m_q = numQueries ops`, `m_ins = numInserts ops`, +`m_dec = numDecreaseKeys ops`, and `m_ext = numExtractMins ops`) in +`t_ops ≤ K * (m_q + m_ins + m_dec + extLog)` total instructions, where `extLog` is the sum of +`Nat.log 2 (size q_t) + 1` in the current number of stored elements `size q_t` over all `extractMin` +steps (satisfying `extLog ≤ m_ext * (Nat.log 2 n_max + 1)`), while producing valid relational +`StepRel` results and leaving memory outside `[base, base + 11 * n_max + 1)` unchanged. -/ theorem fibonacciHeap_amortized : ∃ r, ∃ p_init p_op : Program r, ∃ K, - ∀ (n K_max base w : ℕ) (mem₀ : ℕ → ℕ) (ops : List (Op n)), - base + (9 * n + 1) < 2 ^ w → - K_max < 2 ^ w → + ∀ (n_max U V base w : ℕ) (mem₀ : ℕ → ℕ) (ops : List (Op n_max)), + base + (11 * n_max + 1) < 2 ^ w → + U < 2 ^ w → + V < 2 ^ w → (∀ a, mem₀ a < 2 ^ w) → - (∀ a, base ≤ a → a < base + (9 * n + 1) → mem₀ a = 0) → - ValidSeq K_max (emptyQueue n) ops → - ∃ t₀ t_init reg_f mem_f t_ops, - Runs w p_init ⟨0, initRegs n base, mem₀⟩ t₀ t_init ∧ + (∀ a, base ≤ a → a < base + (11 * n_max + 1) → mem₀ a = 0) → + ValidSeq U V (emptyQueue n_max) ops → + ∃ t₀ t_init q_f reg_f mem_f t_ops extLog, + Runs w p_init ⟨0, initRegs n_max base, mem₀⟩ t₀ t_init ∧ (∃ out, step w p_init t₀ = .halt out) ∧ - UnchangedOutside base (9 * n + 1) mem₀ t₀.mem ∧ - RunsOps w p_op base (9 * n + 1) (emptyQueue n) t₀.reg t₀.mem ops reg_f mem_f t_ops ∧ + UnchangedOutside base (11 * n_max + 1) mem₀ t₀.mem ∧ + RunsOps w p_op base (11 * n_max + 1) (emptyQueue n_max) t₀.reg t₀.mem ops + q_f reg_f mem_f t_ops extLog ∧ t_init + 1 ≤ K ∧ t_ops ≤ - K * (numQueries ops + numInserts ops + numDecreaseKeys ops + - numExtractMins ops * (Nat.log 2 n + 1)) := + K * (numQueries ops + numInserts ops + numDecreaseKeys ops + extLog) ∧ + extLog ≤ numExtractMins ops * (Nat.log 2 n_max + 1) := FibonacciHeapBridge.amortized_fresh ⟨AluOp, .add, .sub, .mul, .div, .mod, .and, .or, .xor, .shl, .shr, @AluOp.rec, AluOp.eval, Instr, .const, .copy, .alu, .width, .load, .store, .jump, .branchEq, .branchLt, .halt, @@ -363,49 +386,74 @@ theorem fibonacciHeap_amortized : fun _ _ => True⟩ (by constructor <;> simp_all [step, ComplexityTests.Abstracts.WordRAMBridge.haltsVia, AluOp.eval]) - ⟨Op, .isEmpty, .getKey, .insert, .decreaseKey, .extractMin, @Op.rec, @chooseMin, @foldMin, - @findMin, fun q o => (stepOp q o).1, fun q o reg => decodeResult o reg = some (stepOp q o).2, + ⟨Op, .isEmpty, .get, .insert, .decreaseKey, .extractMin, @Op.rec, @size, @extractStepLog, + fun q o q' => ∃ res, StepRel q o q' res, + fun q o q' reg => ∃ res, StepRel q o q' res ∧ decodeResult o reg = some res, @ValidOp, @ValidSeq, @numQueries, @numInserts, @numDecreaseKeys, @numExtractMins, @initRegs, - @prepareRegs 42, @State.reg, @State.mem, @RunsOps⟩ - ⟨fun _ _ => ⟨fun h => by simp [chooseMin, h], fun h => by simp [chooseMin, h]⟩, - rfl, fun _ _ => rfl, fun _ => rfl, - fun _ => rfl, fun _ _ => rfl, fun _ _ _ => rfl, fun _ _ _ => rfl, - fun q => by simp only [stepOp]; cases findMin q <;> rfl, - fun _ _ h => congrArg some (decide_eq_decide.mpr h), - fun _ _ _ h => h, fun _ _ _ _ => rfl, fun _ _ _ _ => rfl, - fun q _ h => h.trans (congrArg some (by simp only [stepOp]; cases findMin q <;> rfl)), - fun _ _ _ h => h, fun _ _ _ h => h, fun _ _ _ h => h, + @prepareRegs 48, @State.reg, @State.mem, @RunsOps⟩ + ⟨fun _ => rfl, + fun _ => rfl, fun _ _ => rfl, fun _ _ _ => rfl, fun _ _ _ => rfl, fun _ => rfl, + fun _ => ⟨_, rfl, rfl⟩, + fun _ _ => ⟨_, rfl, rfl⟩, + fun _ _ _ h hnone => ⟨some h, h, hnone, rfl, rfl⟩, + fun _ _ _ u₀ v hq => ⟨(), ⟨u₀, v, hq, rfl⟩, rfl⟩, + fun _ hemp => ⟨none, Or.inl ⟨hemp, rfl, rfl⟩⟩, + fun _ h u v hq hmin => ⟨some (u, v, h), Or.inr ⟨h, u, v, ⟨hq, hmin⟩, rfl, rfl⟩⟩, + fun q _ h => ⟨decide (∀ h, q h = none), ⟨rfl, rfl⟩, congrArg some (decide_eq_decide.mpr h)⟩, + fun q h _ hd => ⟨q h, ⟨rfl, rfl⟩, hd⟩, + fun _ _ _ h _ hnone hv => + ⟨some h, ⟨h, hnone, rfl, rfl⟩, by + simp only [decodeResult, regAt, show (23 : ℕ) < 48 by decide, ↓reduceDIte, hv, + Fin.is_lt, Fin.eta]⟩, + fun _ _ _ u₀ v _ hq => ⟨(), ⟨⟨u₀, v, hq, rfl⟩, rfl⟩, rfl⟩, + fun _ _ hemp hflag => + ⟨none, Or.inl ⟨hemp, rfl, rfl⟩, by + simp only [decodeResult, regAt, show (22 : ℕ) < 48 by decide, ↓reduceDIte, hflag, + ↓reduceIte]⟩, + fun _ h u v _ hq hmin hflag hv hk hval => + ⟨some (u, v, h), Or.inr ⟨h, u, v, ⟨hq, hmin⟩, rfl, rfl⟩, by + simp only [decodeResult, regAt, show (22 : ℕ) < 48 by decide, + show (23 : ℕ) < 48 by decide, show (24 : ℕ) < 48 by decide, + show (47 : ℕ) < 48 by decide, ↓reduceDIte, hflag, ↓reduceIte, + hv, hk, hval, Fin.is_lt, Fin.eta]⟩, + fun _ _ _ h => h, + fun _ _ _ h => h, + fun _ _ _ h => ⟨h.1, fun q' hex => hex.elim fun res hstep => h.2 q' res hstep⟩, fun _ => rfl, fun _ _ => rfl, fun _ _ _ => rfl, fun _ _ _ => rfl, fun _ => rfl, rfl, fun _ => rfl, fun _ _ => rfl, fun _ _ _ => rfl, fun _ _ _ => rfl, fun _ => rfl, rfl, fun _ => rfl, fun _ _ => rfl, fun _ _ _ => rfl, fun _ _ _ => rfl, fun _ => rfl, rfl, fun _ => rfl, fun _ _ => rfl, fun _ _ _ => rfl, fun _ _ _ => rfl, fun _ => rfl, rfl, fun _ _ _ => rfl, fun _ _ => rfl, fun _ _ _ => rfl, fun _ _ _ _ => rfl, fun _ _ _ _ => rfl, fun _ _ => rfl, fun _ _ _ => rfl, fun _ _ _ => rfl, - RunsOps.nil, RunsOps.cons⟩ - -/-- **Fibonacci heap (`O(n)` reusable initialization on arbitrary memory).** Under the same -word-size conditions (`base + (9 n + 1) < 2 ^ w`, `K_max < 2 ^ w`, and every cell of `mem₀` below -`2 ^ w`), without assuming `[base, base + 9 n + 1)` is initially zeroed, `p_init` clears the block -and initializes an empty heap in `t_init + 1 ≤ K (n + 1)` instructions, and `p_op` executes `ops` in -`t_ops ≤ K (numQueries ops + numInserts ops + numDecreaseKeys ops + -numExtractMins ops * (Nat.log 2 n + 1))` instructions while preserving memory -outside `[base, base + 9 n + 1)`. -/ + RunsOps.nil, + fun hr hh hd hmod hrest => hd.elim fun _ hsd => RunsOps.cons hr hh hsd.1 hsd.2 hmod hrest⟩ + +/-- **Fibonacci heap (`O(n_max + 1)` reusable initialization on arbitrary memory).** Under the same +word-size conditions (`base + (11 * n_max + 1) < 2 ^ w`, `U < 2 ^ w`, `V < 2 ^ w`, and every cell of +`mem₀` below `2 ^ w`), without assuming `[base, base + 11 * n_max + 1)` is initially zeroed, +`p_init` clears the block and initializes an empty heap in `t_init + 1 ≤ K * (n_max + 1)` +instructions, and `p_op` executes `ops` in +`t_ops ≤ K * (numQueries ops + numInserts ops + numDecreaseKeys ops + extLog)` instructions with +`extLog ≤ numExtractMins ops * (Nat.log 2 n_max + 1)` while preserving memory outside +`[base, base + 11 * n_max + 1)`. -/ theorem fibonacciHeap_amortized_reusable : ∃ r, ∃ p_init p_op : Program r, ∃ K, - ∀ (n K_max base w : ℕ) (mem₀ : ℕ → ℕ) (ops : List (Op n)), - base + (9 * n + 1) < 2 ^ w → - K_max < 2 ^ w → + ∀ (n_max U V base w : ℕ) (mem₀ : ℕ → ℕ) (ops : List (Op n_max)), + base + (11 * n_max + 1) < 2 ^ w → + U < 2 ^ w → + V < 2 ^ w → (∀ a, mem₀ a < 2 ^ w) → - ValidSeq K_max (emptyQueue n) ops → - ∃ t₀ t_init reg_f mem_f t_ops, - Runs w p_init ⟨0, initRegs n base, mem₀⟩ t₀ t_init ∧ + ValidSeq U V (emptyQueue n_max) ops → + ∃ t₀ t_init q_f reg_f mem_f t_ops extLog, + Runs w p_init ⟨0, initRegs n_max base, mem₀⟩ t₀ t_init ∧ (∃ out, step w p_init t₀ = .halt out) ∧ - UnchangedOutside base (9 * n + 1) mem₀ t₀.mem ∧ - RunsOps w p_op base (9 * n + 1) (emptyQueue n) t₀.reg t₀.mem ops reg_f mem_f t_ops ∧ - t_init + 1 ≤ K * (n + 1) ∧ + UnchangedOutside base (11 * n_max + 1) mem₀ t₀.mem ∧ + RunsOps w p_op base (11 * n_max + 1) (emptyQueue n_max) t₀.reg t₀.mem ops + q_f reg_f mem_f t_ops extLog ∧ + t_init + 1 ≤ K * (n_max + 1) ∧ t_ops ≤ - K * (numQueries ops + numInserts ops + numDecreaseKeys ops + - numExtractMins ops * (Nat.log 2 n + 1)) := + K * (numQueries ops + numInserts ops + numDecreaseKeys ops + extLog) ∧ + extLog ≤ numExtractMins ops * (Nat.log 2 n_max + 1) := FibonacciHeapBridge.amortized_reusable ⟨AluOp, .add, .sub, .mul, .div, .mod, .and, .or, .xor, .shl, .shr, @AluOp.rec, AluOp.eval, Instr, .const, .copy, .alu, .width, .load, .store, .jump, .branchEq, .branchLt, .halt, @@ -415,29 +463,51 @@ theorem fibonacciHeap_amortized_reusable : fun _ _ => True⟩ (by constructor <;> simp_all [step, ComplexityTests.Abstracts.WordRAMBridge.haltsVia, AluOp.eval]) - ⟨Op, .isEmpty, .getKey, .insert, .decreaseKey, .extractMin, @Op.rec, @chooseMin, @foldMin, - @findMin, fun q o => (stepOp q o).1, fun q o reg => decodeResult o reg = some (stepOp q o).2, + ⟨Op, .isEmpty, .get, .insert, .decreaseKey, .extractMin, @Op.rec, @size, @extractStepLog, + fun q o q' => ∃ res, StepRel q o q' res, + fun q o q' reg => ∃ res, StepRel q o q' res ∧ decodeResult o reg = some res, @ValidOp, @ValidSeq, @numQueries, @numInserts, @numDecreaseKeys, @numExtractMins, @initRegs, - @prepareRegs 42, @State.reg, @State.mem, @RunsOps⟩ - ⟨fun _ _ => ⟨fun h => by simp [chooseMin, h], fun h => by simp [chooseMin, h]⟩, - rfl, fun _ _ => rfl, fun _ => rfl, - fun _ => rfl, fun _ _ => rfl, fun _ _ _ => rfl, fun _ _ _ => rfl, - fun q => by simp only [stepOp]; cases findMin q <;> rfl, - fun _ _ h => congrArg some (decide_eq_decide.mpr h), - fun _ _ _ h => h, fun _ _ _ _ => rfl, fun _ _ _ _ => rfl, - fun q _ h => h.trans (congrArg some (by simp only [stepOp]; cases findMin q <;> rfl)), - fun _ _ _ h => h, fun _ _ _ h => h, fun _ _ _ h => h, + @prepareRegs 48, @State.reg, @State.mem, @RunsOps⟩ + ⟨fun _ => rfl, + fun _ => rfl, fun _ _ => rfl, fun _ _ _ => rfl, fun _ _ _ => rfl, fun _ => rfl, + fun _ => ⟨_, rfl, rfl⟩, + fun _ _ => ⟨_, rfl, rfl⟩, + fun _ _ _ h hnone => ⟨some h, h, hnone, rfl, rfl⟩, + fun _ _ _ u₀ v hq => ⟨(), ⟨u₀, v, hq, rfl⟩, rfl⟩, + fun _ hemp => ⟨none, Or.inl ⟨hemp, rfl, rfl⟩⟩, + fun _ h u v hq hmin => ⟨some (u, v, h), Or.inr ⟨h, u, v, ⟨hq, hmin⟩, rfl, rfl⟩⟩, + fun q _ h => ⟨decide (∀ h, q h = none), ⟨rfl, rfl⟩, congrArg some (decide_eq_decide.mpr h)⟩, + fun q h _ hd => ⟨q h, ⟨rfl, rfl⟩, hd⟩, + fun _ _ _ h _ hnone hv => + ⟨some h, ⟨h, hnone, rfl, rfl⟩, by + simp only [decodeResult, regAt, show (23 : ℕ) < 48 by decide, ↓reduceDIte, hv, + Fin.is_lt, Fin.eta]⟩, + fun _ _ _ u₀ v _ hq => ⟨(), ⟨⟨u₀, v, hq, rfl⟩, rfl⟩, rfl⟩, + fun _ _ hemp hflag => + ⟨none, Or.inl ⟨hemp, rfl, rfl⟩, by + simp only [decodeResult, regAt, show (22 : ℕ) < 48 by decide, ↓reduceDIte, hflag, + ↓reduceIte]⟩, + fun _ h u v _ hq hmin hflag hv hk hval => + ⟨some (u, v, h), Or.inr ⟨h, u, v, ⟨hq, hmin⟩, rfl, rfl⟩, by + simp only [decodeResult, regAt, show (22 : ℕ) < 48 by decide, + show (23 : ℕ) < 48 by decide, show (24 : ℕ) < 48 by decide, + show (47 : ℕ) < 48 by decide, ↓reduceDIte, hflag, ↓reduceIte, + hv, hk, hval, Fin.is_lt, Fin.eta]⟩, + fun _ _ _ h => h, + fun _ _ _ h => h, + fun _ _ _ h => ⟨h.1, fun q' hex => hex.elim fun res hstep => h.2 q' res hstep⟩, fun _ => rfl, fun _ _ => rfl, fun _ _ _ => rfl, fun _ _ _ => rfl, fun _ => rfl, rfl, fun _ => rfl, fun _ _ => rfl, fun _ _ _ => rfl, fun _ _ _ => rfl, fun _ => rfl, rfl, fun _ => rfl, fun _ _ => rfl, fun _ _ _ => rfl, fun _ _ _ => rfl, fun _ => rfl, rfl, fun _ => rfl, fun _ _ => rfl, fun _ _ _ => rfl, fun _ _ _ => rfl, fun _ => rfl, rfl, fun _ _ _ => rfl, fun _ _ => rfl, fun _ _ _ => rfl, fun _ _ _ _ => rfl, fun _ _ _ _ => rfl, fun _ _ => rfl, fun _ _ _ => rfl, fun _ _ _ => rfl, - RunsOps.nil, RunsOps.cons⟩ + RunsOps.nil, + fun hr hh hd hmod hrest => hd.elim fun _ hsd => RunsOps.cons hr hh hsd.1 hsd.2 hmod hrest⟩ /-- -info: abstract audit passed for `ComplexityAbstracts.FibonacciHeapAbstract`: 308 root -declarations, 259 dependencies checked +info: abstract audit passed for `ComplexityAbstracts.FibonacciHeapAbstract`: 303 root +declarations, 260 dependencies checked -/ #guard_msgs (whitespace := lax) in #check_abstract ComplexityAbstracts.FibonacciHeapAbstract diff --git a/abstracts/ComplexityAbstracts/FibonacciHeapBridge.lean b/abstracts/ComplexityAbstracts/FibonacciHeapBridge.lean index 16e635bae..4d61ce1cb 100644 --- a/abstracts/ComplexityAbstracts/FibonacciHeapBridge.lean +++ b/abstracts/ComplexityAbstracts/FibonacciHeapBridge.lean @@ -12,24 +12,24 @@ import Complexity.Algorithms.WordRAM.PriorityQueue.FibonacciHeap /-! # Bridge for the Fibonacci-heap formal abstract -`FibonacciHeapAbstract.lean` defines an indexed min-priority queue from scratch, together with its -own exact word-RAM presentation, register calling convention, memory-confinement predicate and -multi-operation execution relation `RunsOps`. This file proves, for every word-RAM presentation `S` -satisfying `WordRAMBridge.Laws S` and every priority-queue presentation `P` satisfying `PQLaws S P`, -that the compiled library programs `initFreshProg`, `initClearProg` and `opProg` of -`Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap` realize `RunsOps` within the claimed -`O(1)` / `O(n)` initialization bounds and `O(m_q + m_ins + m_dec + m_ext (log n + 1))` amortized -operation bound (for `m_q` queries, `m_ins` insertions, `m_dec` key decreases, and `m_ext` minimum -extractions). +`FibonacciHeapAbstract.lean` defines a min-priority queue with handles storing key–value pairs from +scratch, together with its own exact word-RAM presentation, register calling convention, +memory-confinement predicate and multi-operation execution relation `RunsOps`. This file proves, for +every word-RAM presentation `S` satisfying `WordRAMBridge.Laws S` and every priority-queue +presentation `P` satisfying `PQLaws S P`, that the compiled library programs `initFreshProg`, +`initClearProg` and `opProg` of `Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.MinPQ` realize +`RunsOps` within the claimed `O(1)` / `O(n_max + 1)` initialization bounds and +`O(m_q + m_ins + m_dec + ∑ (log n_t + 1))` amortized operation bound in the current number of +stored elements `n_t`. ## Main results -* `PQPresentation.runsOps_map`: multi-operation runs of `FibonacciHeap.opProg` over `Basis.exact` - translate step-for-step to `P.RunsOps` via `WordRAMBridge.Machine.runs_map`. -* `amortized_fresh`: transfers `FibonacciHeap.run_ops_exact_fresh` (`O(1)` fresh initialization on - zeroed `[base, base + 9 n + 1)`) to any `S` and `P`. -* `amortized_reusable`: transfers `FibonacciHeap.run_ops_exact_reusable` (`O(n)` initialization on - arbitrary `w`-bit memory) to any `S` and `P`. +* `PQPresentation.runsOps_map`: multi-operation runs of `FibonacciHeap.MinPQ.opProg` over + `Basis.exact` translate step-for-step to `P.RunsOps` via `WordRAMBridge.Machine.runs_map`. +* `amortized_fresh`: transfers `FibonacciHeap.MinPQ.run_ops_exact_fresh` (`O(1)` fresh + initialization on zeroed `[base, base + 11 * n_max + 1)`) to any `S` and `P`. +* `amortized_reusable`: transfers `FibonacciHeap.MinPQ.run_ops_exact_reusable` (`O(n_max + 1)` + initialization on arbitrary `w`-bit memory) to any `S` and `P`. ## Syntax in the imports @@ -50,200 +50,223 @@ open Cslib.Algorithms.WordRAM.PriorityQueue open ComplexityTests.Abstracts open WordRAMBridge -/-! ## Priority-queue presentation and agreement with `IndexedMinPQ` -/ +/-! ## Priority-queue presentation and agreement with `MinPQ` -/ /-- Polymorphic signature of the priority-queue definitions in `FibonacciHeapAbstract`, specialized -at register count `FibonacciHeap.rFib` (`42`) where the concrete programs live. -/ +at register count `FibonacciHeap.MinPQ.rMinPQ` (`48`) where the concrete programs live. -/ structure PQPresentation (S : WordRAMBridge.Presentation) where Op : ℕ → Type - isEmpty {n : ℕ} : Op n - getKey {n : ℕ} : Fin n → Op n - insert {n : ℕ} : Fin n → ℕ → Op n - decreaseKey {n : ℕ} : Fin n → ℕ → Op n - extractMin {n : ℕ} : Op n - op_induction {n : ℕ} {P : Op n → Prop} : - P isEmpty → (∀ v, P (getKey v)) → (∀ v k, P (insert v k)) → - (∀ v k, P (decreaseKey v k)) → P extractMin → ∀ o, P o - chooseMin {n : ℕ} : Fin n × ℕ → Fin n × ℕ → Fin n × ℕ - foldMin {n : ℕ} : List (Fin n × ℕ) → Option (Fin n × ℕ) - findMin {n : ℕ} : (Fin n → Option ℕ) → Option (Fin n × ℕ) - nextQueue {n : ℕ} : (Fin n → Option ℕ) → Op n → (Fin n → Option ℕ) - DecodesStep {n : ℕ} : (Fin n → Option ℕ) → Op n → (Fin 42 → ℕ) → Prop - ValidOp {n : ℕ} : ℕ → (Fin n → Option ℕ) → Op n → Prop - ValidSeq {n : ℕ} : ℕ → (Fin n → Option ℕ) → List (Op n) → Prop - numQueries {n : ℕ} : List (Op n) → ℕ - numInserts {n : ℕ} : List (Op n) → ℕ - numDecreaseKeys {n : ℕ} : List (Op n) → ℕ - numExtractMins {n : ℕ} : List (Op n) → ℕ + isEmpty {n_max : ℕ} : Op n_max + get {n_max : ℕ} : Fin n_max → Op n_max + insert {n_max : ℕ} : ℕ → ℕ → Op n_max + decreaseKey {n_max : ℕ} : Fin n_max → ℕ → Op n_max + extractMin {n_max : ℕ} : Op n_max + op_induction {n_max : ℕ} {P : Op n_max → Prop} : + P isEmpty → (∀ h, P (get h)) → (∀ u v, P (insert u v)) → + (∀ h u', P (decreaseKey h u')) → P extractMin → ∀ o, P o + size {n_max : ℕ} : (Fin n_max → Option (ℕ × ℕ)) → ℕ + extractStepLog {n_max : ℕ} : (Fin n_max → Option (ℕ × ℕ)) → Op n_max → ℕ + StepState {n_max : ℕ} : + (Fin n_max → Option (ℕ × ℕ)) → Op n_max → (Fin n_max → Option (ℕ × ℕ)) → Prop + StepDecoded {n_max : ℕ} : + (Fin n_max → Option (ℕ × ℕ)) → Op n_max → (Fin n_max → Option (ℕ × ℕ)) → (Fin 48 → ℕ) → Prop + ValidOp {n_max : ℕ} : ℕ → ℕ → (Fin n_max → Option (ℕ × ℕ)) → Op n_max → Prop + ValidSeq {n_max : ℕ} : ℕ → ℕ → (Fin n_max → Option (ℕ × ℕ)) → List (Op n_max) → Prop + numQueries {n_max : ℕ} : List (Op n_max) → ℕ + numInserts {n_max : ℕ} : List (Op n_max) → ℕ + numDecreaseKeys {n_max : ℕ} : List (Op n_max) → ℕ + numExtractMins {n_max : ℕ} : List (Op n_max) → ℕ initRegs {r : ℕ} : ℕ → ℕ → Fin r → ℕ - prepareRegs {n : ℕ} : Op n → (Fin 42 → ℕ) → Fin 42 → ℕ + prepareRegs {n_max : ℕ} : Op n_max → (Fin 48 → ℕ) → Fin 48 → ℕ stateReg {r : ℕ} : S.State r → Fin r → ℕ stateMem {r : ℕ} : S.State r → ℕ → ℕ - RunsOps {r n : ℕ} : - ℕ → List (S.Instr r) → ℕ → ℕ → (Fin n → Option ℕ) → (Fin r → ℕ) → (ℕ → ℕ) → - List (Op n) → (Fin r → ℕ) → (ℕ → ℕ) → ℕ → Prop + RunsOps {r n_max : ℕ} : + ℕ → List (S.Instr r) → ℕ → ℕ → (Fin n_max → Option (ℕ × ℕ)) → (Fin r → ℕ) → (ℕ → ℕ) → + List (Op n_max) → (Fin n_max → Option (ℕ × ℕ)) → (Fin r → ℕ) → (ℕ → ℕ) → ℕ → ℕ → Prop -/-- Equational laws connecting a `PQPresentation` to the definitions in `FibonacciHeapAbstract`. -/ +/-- Equational and relational laws connecting a `PQPresentation` to the definitions in +`FibonacciHeapAbstract`. -/ structure PQLaws (S : WordRAMBridge.Presentation) (P : PQPresentation S) : Prop where - chooseMin_spec : ∀ {n} (a b : Fin n × ℕ), - ((a.2 < b.2 ∨ (a.2 = b.2 ∧ (a.1 : ℕ) ≤ (b.1 : ℕ))) → P.chooseMin a b = a) ∧ - (¬(a.2 < b.2 ∨ (a.2 = b.2 ∧ (a.1 : ℕ) ≤ (b.1 : ℕ))) → P.chooseMin a b = b) - foldMin_nil : ∀ {n}, P.foldMin (n := n) [] = none - foldMin_cons : ∀ {n} (a : Fin n × ℕ) (l : List (Fin n × ℕ)), - P.foldMin (a :: l) = - match P.foldMin l with - | none => some a - | some b => some (P.chooseMin a b) - findMin_eq : ∀ {n} (q : Fin n → Option ℕ), - P.findMin q = P.foldMin ((List.finRange n).filterMap fun v => (q v).map (v, ·)) - next_isEmpty : ∀ {n} (q : Fin n → Option ℕ), P.nextQueue q P.isEmpty = q - next_getKey : ∀ {n} (q : Fin n → Option ℕ) (v : Fin n), P.nextQueue q (P.getKey v) = q - next_insert : ∀ {n} (q : Fin n → Option ℕ) (v : Fin n) (k : ℕ), - P.nextQueue q (P.insert v k) = Function.update q v (some k) - next_decreaseKey : ∀ {n} (q : Fin n → Option ℕ) (v : Fin n) (k : ℕ), - P.nextQueue q (P.decreaseKey v k) = Function.update q v (some k) - next_extractMin : ∀ {n} (q : Fin n → Option ℕ), - P.nextQueue q P.extractMin = - match P.findMin q with - | none => q - | some (u, _) => Function.update q u none - decodes_isEmpty : ∀ {n} (q : Fin n → Option ℕ) (reg : Fin 42 → ℕ), - (reg ⟨22, by decide⟩ ≠ 0 ↔ ∀ v, q v = none) → P.DecodesStep q P.isEmpty reg - decodes_getKey : ∀ {n} (q : Fin n → Option ℕ) (v : Fin n) (reg : Fin 42 → ℕ), - (if reg ⟨22, by decide⟩ = 0 then some none else some (some (reg ⟨24, by decide⟩))) = - some (q v) → P.DecodesStep q (P.getKey v) reg - decodes_insert : ∀ {n} (q : Fin n → Option ℕ) (v : Fin n) (k : ℕ) (reg : Fin 42 → ℕ), - P.DecodesStep q (P.insert v k) reg - decodes_decreaseKey : ∀ {n} (q : Fin n → Option ℕ) (v : Fin n) (k : ℕ) (reg : Fin 42 → ℕ), - P.DecodesStep q (P.decreaseKey v k) reg - decodes_extractMin : ∀ {n} (q : Fin n → Option ℕ) (reg : Fin 42 → ℕ), + size_eq : ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)), + P.size q = (Finset.univ.filter fun h => (q h).isSome).card + extractStepLog_isEmpty : ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)), + P.extractStepLog q P.isEmpty = 0 + extractStepLog_get : ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)) (h : Fin n_max), + P.extractStepLog q (P.get h) = 0 + extractStepLog_insert : ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)) (u v : ℕ), + P.extractStepLog q (P.insert u v) = 0 + extractStepLog_decreaseKey : ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)) (h : Fin n_max) (u' : ℕ), + P.extractStepLog q (P.decreaseKey h u') = 0 + extractStepLog_extractMin : ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)), + P.extractStepLog q P.extractMin = Nat.log 2 (P.size q) + 1 + stepState_isEmpty : ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)), + P.StepState q P.isEmpty q + stepState_get : ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)) (h : Fin n_max), + P.StepState q (P.get h) q + stepState_insert : ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)) (u v : ℕ) (h : Fin n_max), + q h = none → P.StepState q (P.insert u v) (Function.update q h (some (u, v))) + stepState_decreaseKey : + ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)) (h : Fin n_max) (u' u₀ v : ℕ), + q h = some (u₀, v) → P.StepState q (P.decreaseKey h u') (Function.update q h (some (u', v))) + stepState_extractMin_empty : ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)), + (∀ h, q h = none) → P.StepState q P.extractMin q + stepState_extractMin_some : + ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)) (h : Fin n_max) (u v : ℕ), + q h = some (u, v) → (∀ h' u' v', q h' = some (u', v') → u ≤ u') → + P.StepState q P.extractMin (Function.update q h none) + decodes_isEmpty : ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)) (reg : Fin 48 → ℕ), + (reg ⟨22, by decide⟩ ≠ 0 ↔ ∀ h, q h = none) → P.StepDecoded q P.isEmpty q reg + decodes_get : ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)) (h : Fin n_max) (reg : Fin 48 → ℕ), (if reg ⟨22, by decide⟩ = 0 then some none - else if h : reg ⟨23, by decide⟩ < n then - some (some (⟨reg ⟨23, by decide⟩, h⟩, reg ⟨24, by decide⟩)) - else none) = - some (match P.findMin q with | none => none | some (u, k) => some (u, k)) → - P.DecodesStep q P.extractMin reg - valid_insert : ∀ {n K_max} (q : Fin n → Option ℕ) (v : Fin n) (k : ℕ), - P.ValidOp K_max q (P.insert v k) → q v = none ∧ k ≤ K_max - valid_decreaseKey : ∀ {n K_max} (q : Fin n → Option ℕ) (v : Fin n) (k : ℕ), - P.ValidOp K_max q (P.decreaseKey v k) → (∃ k₀, q v = some k₀ ∧ k ≤ k₀) ∧ k ≤ K_max - validSeq_cons : ∀ {n K_max} (q : Fin n → Option ℕ) (o : P.Op n) (ops : List (P.Op n)), - P.ValidSeq K_max q (o :: ops) → P.ValidOp K_max q o ∧ P.ValidSeq K_max (P.nextQueue q o) ops - queries_isEmpty : ∀ {n} (ops : List (P.Op n)), + else some (some (reg ⟨24, by decide⟩, reg ⟨47, by decide⟩))) = + some (q h) → P.StepDecoded q (P.get h) q reg + decodes_insert : + ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)) (u v : ℕ) (h : Fin n_max) (reg : Fin 48 → ℕ), + q h = none → reg ⟨23, by decide⟩ = (h : ℕ) → + P.StepDecoded q (P.insert u v) (Function.update q h (some (u, v))) reg + decodes_decreaseKey : + ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)) (h : Fin n_max) (u' u₀ v : ℕ) (reg : Fin 48 → ℕ), + q h = some (u₀, v) → + P.StepDecoded q (P.decreaseKey h u') (Function.update q h (some (u', v))) reg + decodes_extractMin_empty : ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)) (reg : Fin 48 → ℕ), + (∀ h, q h = none) → reg ⟨22, by decide⟩ = 0 → P.StepDecoded q P.extractMin q reg + decodes_extractMin_some : + ∀ {n_max} (q : Fin n_max → Option (ℕ × ℕ)) (h : Fin n_max) (u v : ℕ) (reg : Fin 48 → ℕ), + q h = some (u, v) → (∀ h' u' v', q h' = some (u', v') → u ≤ u') → + reg ⟨22, by decide⟩ ≠ 0 → reg ⟨23, by decide⟩ = (h : ℕ) → + reg ⟨24, by decide⟩ = u → reg ⟨47, by decide⟩ = v → + P.StepDecoded q P.extractMin (Function.update q h none) reg + valid_insert : ∀ {n_max U V} (q : Fin n_max → Option (ℕ × ℕ)) (u v : ℕ), + P.ValidOp U V q (P.insert u v) → P.size q < n_max ∧ u < U ∧ v < V + valid_decreaseKey : ∀ {n_max U V} (q : Fin n_max → Option (ℕ × ℕ)) (h : Fin n_max) (u' : ℕ), + P.ValidOp U V q (P.decreaseKey h u') → ∃ u₀ v, q h = some (u₀, v) ∧ u' ≤ u₀ + validSeq_cons : + ∀ {n_max U V} (q : Fin n_max → Option (ℕ × ℕ)) (o : P.Op n_max) (ops : List (P.Op n_max)), + P.ValidSeq U V q (o :: ops) → + P.ValidOp U V q o ∧ ∀ q', P.StepState q o q' → P.ValidSeq U V q' ops + queries_isEmpty : ∀ {n_max} (ops : List (P.Op n_max)), P.numQueries (P.isEmpty :: ops) = 1 + P.numQueries ops - queries_getKey : ∀ {n} (v : Fin n) (ops : List (P.Op n)), - P.numQueries (P.getKey v :: ops) = 1 + P.numQueries ops - queries_insert : ∀ {n} (v : Fin n) (k : ℕ) (ops : List (P.Op n)), - P.numQueries (P.insert v k :: ops) = P.numQueries ops - queries_decreaseKey : ∀ {n} (v : Fin n) (k : ℕ) (ops : List (P.Op n)), - P.numQueries (P.decreaseKey v k :: ops) = P.numQueries ops - queries_extractMin : ∀ {n} (ops : List (P.Op n)), + queries_get : ∀ {n_max} (h : Fin n_max) (ops : List (P.Op n_max)), + P.numQueries (P.get h :: ops) = 1 + P.numQueries ops + queries_insert : ∀ {n_max} (u v : ℕ) (ops : List (P.Op n_max)), + P.numQueries (P.insert u v :: ops) = P.numQueries ops + queries_decreaseKey : ∀ {n_max} (h : Fin n_max) (u' : ℕ) (ops : List (P.Op n_max)), + P.numQueries (P.decreaseKey h u' :: ops) = P.numQueries ops + queries_extractMin : ∀ {n_max} (ops : List (P.Op n_max)), P.numQueries (P.extractMin :: ops) = P.numQueries ops - queries_nil : ∀ {n}, P.numQueries (n := n) [] = 0 - inserts_isEmpty : ∀ {n} (ops : List (P.Op n)), + queries_nil : ∀ {n_max}, P.numQueries (n_max := n_max) [] = 0 + inserts_isEmpty : ∀ {n_max} (ops : List (P.Op n_max)), P.numInserts (P.isEmpty :: ops) = P.numInserts ops - inserts_getKey : ∀ {n} (v : Fin n) (ops : List (P.Op n)), - P.numInserts (P.getKey v :: ops) = P.numInserts ops - inserts_insert : ∀ {n} (v : Fin n) (k : ℕ) (ops : List (P.Op n)), - P.numInserts (P.insert v k :: ops) = 1 + P.numInserts ops - inserts_decreaseKey : ∀ {n} (v : Fin n) (k : ℕ) (ops : List (P.Op n)), - P.numInserts (P.decreaseKey v k :: ops) = P.numInserts ops - inserts_extractMin : ∀ {n} (ops : List (P.Op n)), + inserts_get : ∀ {n_max} (h : Fin n_max) (ops : List (P.Op n_max)), + P.numInserts (P.get h :: ops) = P.numInserts ops + inserts_insert : ∀ {n_max} (u v : ℕ) (ops : List (P.Op n_max)), + P.numInserts (P.insert u v :: ops) = 1 + P.numInserts ops + inserts_decreaseKey : ∀ {n_max} (h : Fin n_max) (u' : ℕ) (ops : List (P.Op n_max)), + P.numInserts (P.decreaseKey h u' :: ops) = P.numInserts ops + inserts_extractMin : ∀ {n_max} (ops : List (P.Op n_max)), P.numInserts (P.extractMin :: ops) = P.numInserts ops - inserts_nil : ∀ {n}, P.numInserts (n := n) [] = 0 - dec_isEmpty : ∀ {n} (ops : List (P.Op n)), + inserts_nil : ∀ {n_max}, P.numInserts (n_max := n_max) [] = 0 + dec_isEmpty : ∀ {n_max} (ops : List (P.Op n_max)), P.numDecreaseKeys (P.isEmpty :: ops) = P.numDecreaseKeys ops - dec_getKey : ∀ {n} (v : Fin n) (ops : List (P.Op n)), - P.numDecreaseKeys (P.getKey v :: ops) = P.numDecreaseKeys ops - dec_insert : ∀ {n} (v : Fin n) (k : ℕ) (ops : List (P.Op n)), - P.numDecreaseKeys (P.insert v k :: ops) = P.numDecreaseKeys ops - dec_decreaseKey : ∀ {n} (v : Fin n) (k : ℕ) (ops : List (P.Op n)), - P.numDecreaseKeys (P.decreaseKey v k :: ops) = 1 + P.numDecreaseKeys ops - dec_extractMin : ∀ {n} (ops : List (P.Op n)), + dec_get : ∀ {n_max} (h : Fin n_max) (ops : List (P.Op n_max)), + P.numDecreaseKeys (P.get h :: ops) = P.numDecreaseKeys ops + dec_insert : ∀ {n_max} (u v : ℕ) (ops : List (P.Op n_max)), + P.numDecreaseKeys (P.insert u v :: ops) = P.numDecreaseKeys ops + dec_decreaseKey : ∀ {n_max} (h : Fin n_max) (u' : ℕ) (ops : List (P.Op n_max)), + P.numDecreaseKeys (P.decreaseKey h u' :: ops) = 1 + P.numDecreaseKeys ops + dec_extractMin : ∀ {n_max} (ops : List (P.Op n_max)), P.numDecreaseKeys (P.extractMin :: ops) = P.numDecreaseKeys ops - dec_nil : ∀ {n}, P.numDecreaseKeys (n := n) [] = 0 - ext_isEmpty : ∀ {n} (ops : List (P.Op n)), + dec_nil : ∀ {n_max}, P.numDecreaseKeys (n_max := n_max) [] = 0 + ext_isEmpty : ∀ {n_max} (ops : List (P.Op n_max)), P.numExtractMins (P.isEmpty :: ops) = P.numExtractMins ops - ext_getKey : ∀ {n} (v : Fin n) (ops : List (P.Op n)), - P.numExtractMins (P.getKey v :: ops) = P.numExtractMins ops - ext_insert : ∀ {n} (v : Fin n) (k : ℕ) (ops : List (P.Op n)), - P.numExtractMins (P.insert v k :: ops) = P.numExtractMins ops - ext_decreaseKey : ∀ {n} (v : Fin n) (k : ℕ) (ops : List (P.Op n)), - P.numExtractMins (P.decreaseKey v k :: ops) = P.numExtractMins ops - ext_extractMin : ∀ {n} (ops : List (P.Op n)), + ext_get : ∀ {n_max} (h : Fin n_max) (ops : List (P.Op n_max)), + P.numExtractMins (P.get h :: ops) = P.numExtractMins ops + ext_insert : ∀ {n_max} (u v : ℕ) (ops : List (P.Op n_max)), + P.numExtractMins (P.insert u v :: ops) = P.numExtractMins ops + ext_decreaseKey : ∀ {n_max} (h : Fin n_max) (u' : ℕ) (ops : List (P.Op n_max)), + P.numExtractMins (P.decreaseKey h u' :: ops) = P.numExtractMins ops + ext_extractMin : ∀ {n_max} (ops : List (P.Op n_max)), P.numExtractMins (P.extractMin :: ops) = 1 + P.numExtractMins ops - ext_nil : ∀ {n}, P.numExtractMins (n := n) [] = 0 - initRegs_spec : ∀ n base (i : Fin 42), - P.initRegs n base i = if (i : ℕ) = 0 then n else if (i : ℕ) = 1 then base else 0 - prep_isEmpty : ∀ {n} (reg : Fin 42 → ℕ) (i : Fin 42), - P.prepareRegs (n := n) P.isEmpty reg i = + ext_nil : ∀ {n_max}, P.numExtractMins (n_max := n_max) [] = 0 + initRegs_spec : ∀ n_max base (i : Fin 48), + P.initRegs n_max base i = if (i : ℕ) = 0 then n_max else if (i : ℕ) = 1 then base else 0 + prep_isEmpty : ∀ {n_max} (reg : Fin 48 → ℕ) (i : Fin 48), + P.prepareRegs (n_max := n_max) P.isEmpty reg i = if (i : ℕ) = 17 then 0 else if (i : ℕ) = 18 then 0 else if (i : ℕ) = 19 then 0 - else if (i : ℕ) = 20 then 0 else if (i : ℕ) = 21 then 0 else reg i - prep_getKey : ∀ {n} (v : Fin n) (reg : Fin 42 → ℕ) (i : Fin 42), - P.prepareRegs (P.getKey v) reg i = + else if (i : ℕ) = 20 then 0 else if (i : ℕ) = 21 then 0 else if (i : ℕ) = 46 then 0 + else reg i + prep_get : ∀ {n_max} (h : Fin n_max) (reg : Fin 48 → ℕ) (i : Fin 48), + P.prepareRegs (P.get h) reg i = if (i : ℕ) = 17 then 0 else if (i : ℕ) = 18 then 0 else if (i : ℕ) = 19 then 1 - else if (i : ℕ) = 20 then (v : ℕ) else if (i : ℕ) = 21 then 0 else reg i - prep_insert : ∀ {n} (v : Fin n) (k : ℕ) (reg : Fin 42 → ℕ) (i : Fin 42), - P.prepareRegs (P.insert v k) reg i = + else if (i : ℕ) = 20 then (h : ℕ) else if (i : ℕ) = 21 then 0 else if (i : ℕ) = 46 then 0 + else reg i + prep_insert : ∀ {n_max} (u v : ℕ) (reg : Fin 48 → ℕ) (i : Fin 48), + P.prepareRegs (n_max := n_max) (P.insert u v) reg i = if (i : ℕ) = 17 then 0 else if (i : ℕ) = 18 then 1 else if (i : ℕ) = 19 then 0 - else if (i : ℕ) = 20 then (v : ℕ) else if (i : ℕ) = 21 then k else reg i - prep_decreaseKey : ∀ {n} (v : Fin n) (k : ℕ) (reg : Fin 42 → ℕ) (i : Fin 42), - P.prepareRegs (P.decreaseKey v k) reg i = + else if (i : ℕ) = 20 then 0 else if (i : ℕ) = 21 then u else if (i : ℕ) = 46 then v + else reg i + prep_decreaseKey : ∀ {n_max} (h : Fin n_max) (u' : ℕ) (reg : Fin 48 → ℕ) (i : Fin 48), + P.prepareRegs (P.decreaseKey h u') reg i = if (i : ℕ) = 17 then 0 else if (i : ℕ) = 18 then 1 else if (i : ℕ) = 19 then 1 - else if (i : ℕ) = 20 then (v : ℕ) else if (i : ℕ) = 21 then k else reg i - prep_extractMin : ∀ {n} (reg : Fin 42 → ℕ) (i : Fin 42), - P.prepareRegs (n := n) P.extractMin reg i = + else if (i : ℕ) = 20 then (h : ℕ) else if (i : ℕ) = 21 then u' else if (i : ℕ) = 46 then 0 + else reg i + prep_extractMin : ∀ {n_max} (reg : Fin 48 → ℕ) (i : Fin 48), + P.prepareRegs (n_max := n_max) P.extractMin reg i = if (i : ℕ) = 17 then 1 else if (i : ℕ) = 18 then 0 else if (i : ℕ) = 19 then 0 - else if (i : ℕ) = 20 then 0 else if (i : ℕ) = 21 then 0 else reg i - stateReg_eq : ∀ (pc : ℕ) (reg : Fin 42 → ℕ) (m : ℕ → ℕ), P.stateReg (S.state pc reg m) = reg - stateMem_eq : ∀ (pc : ℕ) (reg : Fin 42 → ℕ) (m : ℕ → ℕ), P.stateMem (S.state pc reg m) = m - runsOps_nil : ∀ {n w} {p : List (S.Instr 42)} {base len} {q : Fin n → Option ℕ} - {reg : Fin 42 → ℕ} {mem : ℕ → ℕ}, - P.RunsOps w p base len q reg mem [] reg mem 0 - runsOps_cons : ∀ {n w} {p : List (S.Instr 42)} {base len} {q : Fin n → Option ℕ} - {reg : Fin 42 → ℕ} {mem : ℕ → ℕ} {o : P.Op n} {ops : List (P.Op n)} {t : S.State 42} - {reg' : Fin 42 → ℕ} {mem' : ℕ → ℕ} {steps rest : ℕ}, + else if (i : ℕ) = 20 then 0 else if (i : ℕ) = 21 then 0 else if (i : ℕ) = 46 then 0 + else reg i + stateReg_eq : ∀ (pc : ℕ) (reg : Fin 48 → ℕ) (m : ℕ → ℕ), P.stateReg (S.state pc reg m) = reg + stateMem_eq : ∀ (pc : ℕ) (reg : Fin 48 → ℕ) (m : ℕ → ℕ), P.stateMem (S.state pc reg m) = m + runsOps_nil : ∀ {n_max w} {p : List (S.Instr 48)} {base len} + {q : Fin n_max → Option (ℕ × ℕ)} {reg : Fin 48 → ℕ} {mem : ℕ → ℕ}, + P.RunsOps w p base len q reg mem [] q reg mem 0 0 + runsOps_cons : ∀ {n_max w} {p : List (S.Instr 48)} {base len} + {q q₁ q' : Fin n_max → Option (ℕ × ℕ)} {reg : Fin 48 → ℕ} {mem : ℕ → ℕ} + {o : P.Op n_max} {ops : List (P.Op n_max)} {t : S.State 48} + {reg' : Fin 48 → ℕ} {mem' : ℕ → ℕ} {steps rest extRest : ℕ}, Relation.RelatesInSteps (fun a b => S.step w p a = S.next b) (S.state 0 (P.prepareRegs o reg) mem) t steps → (∃ out, S.step w p t = S.halted out) → - P.DecodesStep q o (P.stateReg t) → + P.StepDecoded q o q₁ (P.stateReg t) → (∀ a, a < base ∨ base + len ≤ a → P.stateMem t a = mem a) → - P.RunsOps w p base len (P.nextQueue q o) (P.stateReg t) (P.stateMem t) ops reg' mem' rest → - P.RunsOps w p base len q reg mem (o :: ops) reg' mem' ((steps + 1) + rest) + P.RunsOps w p base len q₁ (P.stateReg t) (P.stateMem t) ops q' reg' mem' rest extRest → + P.RunsOps w p base len q reg mem (o :: ops) q' reg' mem' + ((steps + 1) + rest) (P.extractStepLog q o + extRest) -theorem forall_none_iff_dom_empty {n : ℕ} (q : Fin n → Option ℕ) : - (∀ v, q v = none) ↔ IndexedMinPQ.dom q = ∅ := by +theorem forall_none_iff_dom_empty {n_max : ℕ} (q : Fin n_max → Option (ℕ × ℕ)) : + (∀ h, q h = none) ↔ MinPQ.dom q = ∅ := by rw [Finset.eq_empty_iff_forall_notMem] - exact forall_congr' fun v => IndexedMinPQ.notMem_dom_iff.symm + exact forall_congr' fun h => MinPQ.notMem_dom_iff.symm -theorem unchangedOutside_of_modifies {base n : ℕ} {m m' : ℕ → ℕ} - (hm : Modifies (Block.mk base (FibonacciHeap.space n)).footprint m m') : - ∀ a, a < base ∨ base + (9 * n + 1) ≤ a → m' a = m a := by +theorem unchangedOutside_of_modifies {base n_max : ℕ} {m m' : ℕ → ℕ} + (hm : Modifies (Block.mk base (FibonacciHeap.MinPQ.space n_max)).footprint m m') : + ∀ a, a < base ∨ base + (11 * n_max + 1) ≤ a → m' a = m a := by intro a ha apply hm a rw [Block.mem_footprint, Block.Owns] - dsimp only [FibonacciHeap.space] + dsimp only [FibonacciHeap.MinPQ.space] omega namespace PQPresentation variable {S : WordRAMBridge.Presentation} (P : PQPresentation S) -/-- Translate a library `IndexedMinPQ.Op n` into `P.Op n`. -/ -def opOf {n : ℕ} : IndexedMinPQ.Op n → P.Op n +/-- Translate a library `MinPQ.Op n_max` into `P.Op n_max`. -/ +def opOf {n_max : ℕ} : MinPQ.Op n_max → P.Op n_max | .isEmpty => P.isEmpty - | .getKey v => P.getKey v - | .insert v k => P.insert v k - | .decreaseKey v k => P.decreaseKey v k + | .get h => P.get h + | .insert u v => P.insert u v + | .decreaseKey h u' => P.decreaseKey h u' | .extractMin => P.extractMin -theorem opOf_surjective {n : ℕ} (o : P.Op n) : ∃ g : IndexedMinPQ.Op n, P.opOf g = o := - P.op_induction (P := fun o => ∃ g, P.opOf g = o) ⟨.isEmpty, rfl⟩ (fun v => ⟨.getKey v, rfl⟩) - (fun v k => ⟨.insert v k, rfl⟩) (fun v k => ⟨.decreaseKey v k, rfl⟩) ⟨.extractMin, rfl⟩ o +theorem opOf_surjective {n_max : ℕ} (o : P.Op n_max) : ∃ g : MinPQ.Op n_max, P.opOf g = o := + P.op_induction (P := fun o => ∃ g, P.opOf g = o) ⟨.isEmpty, rfl⟩ (fun h => ⟨.get h, rfl⟩) + (fun u v => ⟨.insert u v, rfl⟩) (fun h u' => ⟨.decreaseKey h u', rfl⟩) + ⟨.extractMin, rfl⟩ o -theorem list_opOf_surjective {n : ℕ} (ops : List (P.Op n)) : - ∃ gs : List (IndexedMinPQ.Op n), gs.map P.opOf = ops := by - choose f hf using P.opOf_surjective (n := n) +theorem list_opOf_surjective {n_max : ℕ} (ops : List (P.Op n_max)) : + ∃ gs : List (MinPQ.Op n_max), gs.map P.opOf = ops := by + choose f hf using P.opOf_surjective (n_max := n_max) refine ⟨ops.map f, ?_⟩ rw [List.map_map] conv_rhs => rw [← List.map_id ops] @@ -256,198 +279,262 @@ section WithLaws variable {P} (hP : PQLaws S P) include hP -theorem chooseMin_eq {n : ℕ} (a b : Fin n × ℕ) : - P.chooseMin a b = IndexedMinPQ.chooseMin a b := by - by_cases h : IndexedMinPQ.PrioLE a b - · simp only [IndexedMinPQ.chooseMin, h, ↓reduceIte] - exact (hP.chooseMin_spec a b).1 h - · simp only [IndexedMinPQ.chooseMin, h, ↓reduceIte] - exact (hP.chooseMin_spec a b).2 h - -theorem foldMin_eq {n : ℕ} (l : List (Fin n × ℕ)) : - P.foldMin l = IndexedMinPQ.foldMin l := by - induction l with - | nil => exact hP.foldMin_nil - | cons a l ih => - rw [hP.foldMin_cons, ih] - simp only [IndexedMinPQ.foldMin] - cases IndexedMinPQ.foldMin l with - | none => rfl - | some b => - dsimp only - rw [chooseMin_eq hP] - -theorem findMin_eq {n : ℕ} (q : Fin n → Option ℕ) : - P.findMin q = IndexedMinPQ.findMin q := by - rw [hP.findMin_eq, foldMin_eq hP, IndexedMinPQ.findMin] - -theorem nextQueue_eq {n K_max : ℕ} (q : Fin n → Option ℕ) (g : IndexedMinPQ.Op n) : - P.nextQueue q (P.opOf g) = ((IndexedMinPQ.spec n K_max).step q g).1 := by +theorem size_eq_lib {n_max : ℕ} (q : Fin n_max → Option (ℕ × ℕ)) : + P.size q = MinPQ.size q := + hP.size_eq q + +theorem extractStepLog_eq {n_max : ℕ} (q : Fin n_max → Option (ℕ × ℕ)) (g : MinPQ.Op n_max) : + P.extractStepLog q (P.opOf g) = + match g with + | .extractMin => Nat.log 2 (MinPQ.size q) + 1 + | _ => 0 := by + cases g with + | isEmpty => exact hP.extractStepLog_isEmpty q + | get h => exact hP.extractStepLog_get q h + | insert u v => exact hP.extractStepLog_insert q u v + | decreaseKey h u' => exact hP.extractStepLog_decreaseKey q h u' + | extractMin => + rw [opOf, hP.extractStepLog_extractMin, size_eq_lib hP] + +theorem stepState_of_lib {n_max U V : ℕ} {q q' : Fin n_max → Option (ℕ × ℕ)} + {g : MinPQ.Op n_max} {a : (MinPQ.spec n_max U V).Result g} + (hs : (MinPQ.spec n_max U V).step q g q' a) : + P.StepState q (P.opOf g) q' := by cases g with - | isEmpty => exact hP.next_isEmpty q - | getKey v => exact hP.next_getKey q v - | insert v k => exact hP.next_insert q v k - | decreaseKey v k => exact hP.next_decreaseKey q v k + | isEmpty => + rcases hs with ⟨hqq, _⟩ + subst q' + exact hP.stepState_isEmpty q + | get h => + rcases hs with ⟨hqq, _⟩ + subst q' + exact hP.stepState_get q h + | insert u v => + rcases hs with ⟨h, hnone, hqq, _⟩ + subst q' + exact hP.stepState_insert q u v h hnone + | decreaseKey h u' => + rcases hs with ⟨u₀, v, hq, hqq, _⟩ + subst q' + exact hP.stepState_decreaseKey q h u' u₀ v hq | extractMin => - rw [opOf, hP.next_extractMin, findMin_eq hP] - simp only [IndexedMinPQ.spec] - cases IndexedMinPQ.findMin q <;> rfl - -theorem decodesStep_of_lib {n K_max : ℕ} (q : Fin n → Option ℕ) (g : IndexedMinPQ.Op n) - (reg : Fin 42 → ℕ) - (hd : FibonacciHeap.code.decode (n := n) (K_max := K_max) g reg = - some ((IndexedMinPQ.spec n K_max).step q g).2) : - P.DecodesStep q (P.opOf g) reg := by + rcases hs with ⟨hemp, hqq, _⟩ | ⟨h, u, v, ⟨hq, hmin⟩, hqq, _⟩ + · subst q' + exact hP.stepState_extractMin_empty q ((forall_none_iff_dom_empty q).mpr hemp) + · subst q' + exact hP.stepState_extractMin_some q h u v hq hmin + +theorem stepDecoded_of_lib {n_max U V : ℕ} {q q' : Fin n_max → Option (ℕ × ℕ)} + {g : MinPQ.Op n_max} {a : (MinPQ.spec n_max U V).Result g} {reg : Fin 48 → ℕ} + (hs : (MinPQ.spec n_max U V).step q g q' a) + (hd : FibonacciHeap.MinPQ.decode (n_max := n_max) (U := U) (V := V) g reg = some a) : + P.StepDecoded q (P.opOf g) q' reg := by cases g with | isEmpty => + dsimp only [MinPQ.spec, MinPQ.Op.Result] at a hs hd + rcases hs with ⟨hqq, rfl⟩ + subst q' apply hP.decodes_isEmpty - dsimp only [PQCode.decode, FibonacciHeap.code, FibonacciHeap.outFlag, - IndexedMinPQ.spec] at hd - have hd' : decide (reg ⟨22, _⟩ ≠ 0) = decide (IndexedMinPQ.dom q = ∅) := - Option.some.inj hd + dsimp only [FibonacciHeap.MinPQ.decode, FibonacciHeap.MinPQ.outFlag] at hd + have hd' : decide (reg ⟨22, _⟩ ≠ 0) = decide (MinPQ.dom q = ∅) := Option.some.inj hd exact (decide_eq_decide.mp hd').trans (forall_none_iff_dom_empty q).symm - | getKey v => - apply hP.decodes_getKey - dsimp only [PQCode.decode, FibonacciHeap.code, FibonacciHeap.outFlag, FibonacciHeap.outK, - IndexedMinPQ.spec] at hd + | get h => + dsimp only [MinPQ.spec, MinPQ.Op.Result] at a hs hd + rcases hs with ⟨hqq, rfl⟩ + subst q' + apply hP.decodes_get exact hd - | insert v k => exact hP.decodes_insert q v k reg - | decreaseKey v k => exact hP.decodes_decreaseKey q v k reg + | insert u v => + dsimp only [MinPQ.spec, MinPQ.Op.Result] at a hs hd + rcases hs with ⟨h, hnone, hqq, rfl⟩ + subst q' + dsimp only [FibonacciHeap.MinPQ.decode, FibonacciHeap.MinPQ.outV] at hd + by_cases hlt : reg ⟨23, by decide⟩ < n_max + · simp only [hlt, ↓reduceDIte] at hd + have hh : (⟨reg ⟨23, by decide⟩, hlt⟩ : Fin n_max) = h := + Option.some.inj (Option.some.inj hd) + exact hP.decodes_insert q u v h reg hnone (congrArg Fin.val hh) + · simp only [hlt, ↓reduceDIte] at hd + cases hd + | decreaseKey h u' => + rcases hs with ⟨u₀, v, hq, hqq, _⟩ + subst q' + exact hP.decodes_decreaseKey q h u' u₀ v reg hq | extractMin => - apply hP.decodes_extractMin - rw [findMin_eq hP] - dsimp only [PQCode.decode, FibonacciHeap.code, FibonacciHeap.outFlag, FibonacciHeap.outV, - FibonacciHeap.outK, IndexedMinPQ.spec] at hd - rcases hm : IndexedMinPQ.findMin q with _ | ⟨u, k⟩ <;> rw [hm] at hd <;> exact hd - -theorem initRegs_eq (n base : ℕ) : - P.initRegs (r := 42) n base = FibonacciHeap.initRegs n base := by + dsimp only [MinPQ.spec, MinPQ.Op.Result] at a hs hd + dsimp only [FibonacciHeap.MinPQ.decode, FibonacciHeap.MinPQ.outFlag, + FibonacciHeap.MinPQ.outV, FibonacciHeap.MinPQ.outK, + FibonacciHeap.MinPQ.outValReg] at hd + rcases hs with ⟨hemp, hqq, rfl⟩ | ⟨h, u, v, ⟨hq, hmin⟩, hqq, rfl⟩ + · subst q' + by_cases hf : reg ⟨22, by decide⟩ = 0 + · exact hP.decodes_extractMin_empty q reg ((forall_none_iff_dom_empty q).mpr hemp) hf + · simp only [hf, ↓reduceIte] at hd + by_cases hlt : reg ⟨23, by decide⟩ < n_max + · simp only [hlt, ↓reduceDIte] at hd + cases Option.some.inj hd + · simp only [hlt, ↓reduceDIte] at hd + cases hd + · subst q' + by_cases hf : reg ⟨22, by decide⟩ = 0 + · simp only [hf, ↓reduceIte] at hd + cases Option.some.inj hd + · simp only [hf, ↓reduceIte] at hd + by_cases hlt : reg ⟨23, by decide⟩ < n_max + · simp only [hlt, ↓reduceDIte] at hd + have hprod := Option.some.inj (Option.some.inj hd) + simp only [Prod.mk.injEq] at hprod + rcases hprod with ⟨hk, hval, hh⟩ + exact hP.decodes_extractMin_some q h u v reg hq hmin hf + (congrArg Fin.val hh) hk hval + · simp only [hlt, ↓reduceDIte] at hd + cases hd + +theorem initRegs_eq (n_max base : ℕ) : + P.initRegs (r := 48) n_max base = FibonacciHeap.MinPQ.initRegs n_max base := by funext i rw [hP.initRegs_spec] - simp only [FibonacciHeap.initRegs, FibonacciHeap.nReg, FibonacciHeap.frontierReg, Fin.ext_iff] + simp only [FibonacciHeap.MinPQ.initRegs, FibonacciHeap.MinPQ.nReg, + FibonacciHeap.MinPQ.outerFrontierReg, Fin.ext_iff] -theorem prepareRegs_eq {n : ℕ} (g : IndexedMinPQ.Op n) (reg : Fin 42 → ℕ) : - P.prepareRegs (P.opOf g) reg = FibonacciHeap.prepareRegs g reg := by +theorem prepareRegs_eq {n_max : ℕ} (g : MinPQ.Op n_max) (reg : Fin 48 → ℕ) : + P.prepareRegs (P.opOf g) reg = FibonacciHeap.MinPQ.prepareRegs g reg := by funext i cases g with | isEmpty => rw [opOf, hP.prep_isEmpty] - simp only [FibonacciHeap.prepareRegs, PQCode.encode, - FibonacciHeap.tag2, FibonacciHeap.tag1, FibonacciHeap.tag0, - FibonacciHeap.argV, FibonacciHeap.argK, Fin.ext_iff] + simp only [FibonacciHeap.MinPQ.prepareRegs, FibonacciHeap.MinPQ.rawEncode, + FibonacciHeap.MinPQ.tag2, FibonacciHeap.MinPQ.tag1, FibonacciHeap.MinPQ.tag0, + FibonacciHeap.MinPQ.argV, FibonacciHeap.MinPQ.argK, FibonacciHeap.MinPQ.inValReg, + Fin.ext_iff] split_ifs <;> omega - | getKey v => - rw [opOf, hP.prep_getKey] - simp only [FibonacciHeap.prepareRegs, PQCode.encode, FibonacciHeap.code, - FibonacciHeap.tag2, FibonacciHeap.tag1, FibonacciHeap.tag0, - FibonacciHeap.argV, FibonacciHeap.argK, Fin.ext_iff] + | get h => + rw [opOf, hP.prep_get] + simp only [FibonacciHeap.MinPQ.prepareRegs, FibonacciHeap.MinPQ.rawEncode, + FibonacciHeap.MinPQ.tag2, FibonacciHeap.MinPQ.tag1, FibonacciHeap.MinPQ.tag0, + FibonacciHeap.MinPQ.argV, FibonacciHeap.MinPQ.argK, FibonacciHeap.MinPQ.inValReg, + Fin.ext_iff] split_ifs <;> omega - | insert v k => + | insert u v => rw [opOf, hP.prep_insert] - simp only [FibonacciHeap.prepareRegs, PQCode.encode, FibonacciHeap.code, - FibonacciHeap.tag2, FibonacciHeap.tag1, FibonacciHeap.tag0, - FibonacciHeap.argV, FibonacciHeap.argK, Fin.ext_iff] + simp only [FibonacciHeap.MinPQ.prepareRegs, FibonacciHeap.MinPQ.rawEncode, + FibonacciHeap.MinPQ.tag2, FibonacciHeap.MinPQ.tag1, FibonacciHeap.MinPQ.tag0, + FibonacciHeap.MinPQ.argV, FibonacciHeap.MinPQ.argK, FibonacciHeap.MinPQ.inValReg, + Fin.ext_iff] split_ifs <;> omega - | decreaseKey v k => + | decreaseKey h u' => rw [opOf, hP.prep_decreaseKey] - simp only [FibonacciHeap.prepareRegs, PQCode.encode, FibonacciHeap.code, - FibonacciHeap.tag2, FibonacciHeap.tag1, FibonacciHeap.tag0, - FibonacciHeap.argV, FibonacciHeap.argK, Fin.ext_iff] + simp only [FibonacciHeap.MinPQ.prepareRegs, FibonacciHeap.MinPQ.rawEncode, + FibonacciHeap.MinPQ.tag2, FibonacciHeap.MinPQ.tag1, FibonacciHeap.MinPQ.tag0, + FibonacciHeap.MinPQ.argV, FibonacciHeap.MinPQ.argK, FibonacciHeap.MinPQ.inValReg, + Fin.ext_iff] split_ifs <;> omega | extractMin => rw [opOf, hP.prep_extractMin] - simp only [FibonacciHeap.prepareRegs, PQCode.encode, FibonacciHeap.code, - FibonacciHeap.tag2, FibonacciHeap.tag1, FibonacciHeap.tag0, - FibonacciHeap.argV, FibonacciHeap.argK, Fin.ext_iff] + simp only [FibonacciHeap.MinPQ.prepareRegs, FibonacciHeap.MinPQ.rawEncode, + FibonacciHeap.MinPQ.tag2, FibonacciHeap.MinPQ.tag1, FibonacciHeap.MinPQ.tag0, + FibonacciHeap.MinPQ.argV, FibonacciHeap.MinPQ.argK, FibonacciHeap.MinPQ.inValReg, + Fin.ext_iff] split_ifs <;> omega -theorem validSeq_to_lib {n K_max : ℕ} : - ∀ (gs : List (IndexedMinPQ.Op n)) (q : Fin n → Option ℕ), - P.ValidSeq K_max q (gs.map P.opOf) → (IndexedMinPQ.spec n K_max).ValidHistory q gs +theorem validSeq_to_lib {n_max U V : ℕ} : + ∀ (gs : List (MinPQ.Op n_max)) (q : Fin n_max → Option (ℕ × ℕ)), + P.ValidSeq U V q (gs.map P.opOf) → (MinPQ.spec n_max U V).ValidOpSeq q gs | [], _, _ => trivial | g :: gs, q, hv => by obtain ⟨hv_g, hv_gs⟩ := hP.validSeq_cons q (P.opOf g) (gs.map P.opOf) hv - rw [nextQueue_eq hP (K_max := K_max)] at hv_gs - refine ⟨?_, validSeq_to_lib gs _ hv_gs⟩ + refine ⟨?_, fun q' a hs => validSeq_to_lib gs q' (hv_gs q' (stepState_of_lib hP hs))⟩ cases g with - | isEmpty | getKey _ | extractMin => trivial - | insert v k => exact hP.valid_insert q v k hv_g - | decreaseKey v k => exact hP.valid_decreaseKey q v k hv_g - -theorem numQueries_eq {n : ℕ} : - ∀ (gs : List (IndexedMinPQ.Op n)), - FibonacciHeap.numQueries gs = P.numQueries (gs.map P.opOf) + | isEmpty | get _ | extractMin => trivial + | insert u v => + have h := hP.valid_insert q u v hv_g + rw [size_eq_lib hP] at h + exact h + | decreaseKey h u' => exact hP.valid_decreaseKey q h u' hv_g + +theorem numQueries_eq {n_max : ℕ} : + ∀ (gs : List (MinPQ.Op n_max)), + FibonacciHeap.MinPQ.numQueries gs = P.numQueries (gs.map P.opOf) | [] => hP.queries_nil.symm | g :: gs => by have ih := numQueries_eq gs cases g <;> - simp only [List.map_cons, opOf, FibonacciHeap.numQueries, ih, - hP.queries_isEmpty, hP.queries_getKey, hP.queries_insert, + simp only [List.map_cons, opOf, FibonacciHeap.MinPQ.numQueries, ih, + hP.queries_isEmpty, hP.queries_get, hP.queries_insert, hP.queries_decreaseKey, hP.queries_extractMin] -theorem numInserts_eq {n : ℕ} : - ∀ (gs : List (IndexedMinPQ.Op n)), - FibonacciHeap.numInserts gs = P.numInserts (gs.map P.opOf) +theorem numInserts_eq {n_max : ℕ} : + ∀ (gs : List (MinPQ.Op n_max)), + FibonacciHeap.MinPQ.numInserts gs = P.numInserts (gs.map P.opOf) | [] => hP.inserts_nil.symm | g :: gs => by have ih := numInserts_eq gs cases g <;> - simp only [List.map_cons, opOf, FibonacciHeap.numInserts, ih, - hP.inserts_isEmpty, hP.inserts_getKey, hP.inserts_insert, + simp only [List.map_cons, opOf, FibonacciHeap.MinPQ.numInserts, ih, + hP.inserts_isEmpty, hP.inserts_get, hP.inserts_insert, hP.inserts_decreaseKey, hP.inserts_extractMin] -theorem numDecreaseKeys_eq {n : ℕ} : - ∀ (gs : List (IndexedMinPQ.Op n)), - FibonacciHeap.numDecreaseKeys gs = P.numDecreaseKeys (gs.map P.opOf) +theorem numDecreaseKeys_eq {n_max : ℕ} : + ∀ (gs : List (MinPQ.Op n_max)), + FibonacciHeap.MinPQ.numDecreaseKeys gs = P.numDecreaseKeys (gs.map P.opOf) | [] => hP.dec_nil.symm | g :: gs => by have ih := numDecreaseKeys_eq gs cases g <;> - simp only [List.map_cons, opOf, FibonacciHeap.numDecreaseKeys, ih, - hP.dec_isEmpty, hP.dec_getKey, hP.dec_insert, + simp only [List.map_cons, opOf, FibonacciHeap.MinPQ.numDecreaseKeys, ih, + hP.dec_isEmpty, hP.dec_get, hP.dec_insert, hP.dec_decreaseKey, hP.dec_extractMin] -theorem numExtractMins_eq {n : ℕ} : - ∀ (gs : List (IndexedMinPQ.Op n)), - FibonacciHeap.numExtractMins gs = P.numExtractMins (gs.map P.opOf) +theorem numExtractMins_eq {n_max : ℕ} : + ∀ (gs : List (MinPQ.Op n_max)), + FibonacciHeap.MinPQ.numExtractMins gs = P.numExtractMins (gs.map P.opOf) | [] => hP.ext_nil.symm | g :: gs => by have ih := numExtractMins_eq gs cases g <;> - simp only [List.map_cons, opOf, FibonacciHeap.numExtractMins, ih, - hP.ext_isEmpty, hP.ext_getKey, hP.ext_insert, + simp only [List.map_cons, opOf, FibonacciHeap.MinPQ.numExtractMins, ih, + hP.ext_isEmpty, hP.ext_get, hP.ext_insert, hP.ext_decreaseKey, hP.ext_extractMin] -theorem runsOps_map (hS : WordRAMBridge.Laws S) {n K_max w base : ℕ} : - ∀ {q : Fin n → Option ℕ} {x z : Data 42} {gs : List (IndexedMinPQ.Op n)} {total : ℕ}, - FibonacciHeap.RunsOps (K_max := K_max) w base q x gs z total → - P.RunsOps w (S.programOf FibonacciHeap.opProg) base (9 * n + 1) q x.regs x.mem - (gs.map P.opOf) z.regs z.mem total - | _, _, _, _, _, .nil => hP.runsOps_nil - | q, x, z, g :: gs, _, - @FibonacciHeap.RunsOps.cons _ _ _ _ _ _ _ _ pc y _ steps rest hr ⟨out, hh⟩ hdec hmod hrest => +theorem runsOps_map (hS : WordRAMBridge.Laws S) {n_max U V w base : ℕ} : + ∀ {q q' : Fin n_max → Option (ℕ × ℕ)} {x z : Data 48} {gs : List (MinPQ.Op n_max)} + {tr : (MinPQ.spec n_max U V).Transcript} {total : ℕ}, + FibonacciHeap.MinPQ.RunsOps (U := U) (V := V) w base q x gs tr q' z total → + P.RunsOps w (S.programOf FibonacciHeap.MinPQ.opProg) base (11 * n_max + 1) q x.regs x.mem + (gs.map P.opOf) q' z.regs z.mem total (FibonacciHeap.MinPQ.extractLogSum q tr) + | _, _, _, _, _, _, _, .nil => hP.runsOps_nil + | q, q', x, z, g :: gs, _, _, + @FibonacciHeap.MinPQ.RunsOps.cons _ _ _ _ _ _ q₁ _ _ _ a _ tr_rest pc y _ steps rest + hr ⟨out, hh⟩ hstep hdec hmod hrest => by have hr' : Relation.RelatesInSteps - (fun a b => S.step w (S.programOf FibonacciHeap.opProg) a = S.next b) + (fun a b => S.step w (S.programOf FibonacciHeap.MinPQ.opProg) a = S.next b) (S.state 0 (P.prepareRegs (P.opOf g) x.regs) x.mem) (S.state pc y.regs y.mem) steps := by rw [prepareRegs_eq hP] exact Machine.runs_map hS hr - have hh' : S.step w (S.programOf FibonacciHeap.opProg) (S.state pc y.regs y.mem) = + have hh' : S.step w (S.programOf FibonacciHeap.MinPQ.opProg) (S.state pc y.regs y.mem) = S.halted out := Machine.step_halt hS hh - have hdec' : P.DecodesStep q (P.opOf g) (P.stateReg (S.state pc y.regs y.mem)) := by + have hdec' : P.StepDecoded q (P.opOf g) q₁ (P.stateReg (S.state pc y.regs y.mem)) := by rw [hP.stateReg_eq] - exact decodesStep_of_lib hP q g y.regs hdec - have hmod' : ∀ a, a < base ∨ base + (9 * n + 1) ≤ a → + exact stepDecoded_of_lib hP hstep hdec + have hmod' : ∀ a, a < base ∨ base + (11 * n_max + 1) ≤ a → P.stateMem (S.state pc y.regs y.mem) a = x.mem a := by rw [hP.stateMem_eq] exact unchangedOutside_of_modifies hmod have ih := runsOps_map hS hrest - rw [← nextQueue_eq hP (K_max := K_max)] at ih - refine hP.runsOps_cons hr' ⟨out, hh'⟩ hdec' hmod' ?_ - rw [hP.stateReg_eq, hP.stateMem_eq] - exact ih + have hstep_Res := hP.runsOps_cons hr' ⟨out, hh'⟩ hdec' hmod' + (by rw [hP.stateReg_eq, hP.stateMem_eq]; exact ih) + have hext : FibonacciHeap.MinPQ.extractLogSum q + ({ op := g, result := a, nextState := q₁ } :: tr_rest) = + P.extractStepLog q (P.opOf g) + FibonacciHeap.MinPQ.extractLogSum q₁ tr_rest := by + cases g <;> + simp only [FibonacciHeap.MinPQ.extractLogSum, opOf, + hP.extractStepLog_isEmpty, hP.extractStepLog_get, hP.extractStepLog_insert, + hP.extractStepLog_decreaseKey, hP.extractStepLog_extractMin, size_eq_lib hP] + rw [List.map_cons, hext] + exact hstep_Res end WithLaws @@ -455,88 +542,99 @@ end PQPresentation /-! ## Transfer of the standalone Fibonacci-heap theorems -/ -/-- Transfer of `FibonacciHeap.run_ops_exact_fresh` (`O(1)` fresh initialization on zeroed -`[base, base + 9 n + 1)`) to any exact word-RAM presentation `S` and priority-queue presentation -`P`. -/ +/-- Transfer of `FibonacciHeap.MinPQ.run_ops_exact_fresh` (`O(1)` fresh initialization on zeroed +`[base, base + 11 * n_max + 1)`) to any exact word-RAM presentation `S` and priority-queue +presentation `P`. -/ theorem amortized_fresh (S : WordRAMBridge.Presentation) (hS : WordRAMBridge.Laws S) (P : PQPresentation S) (hP : PQLaws S P) : ∃ r, ∃ p_init p_op : List (S.Instr r), ∃ K, - ∀ (n K_max base w : ℕ) (mem₀ : ℕ → ℕ) (ops : List (P.Op n)), - base + (9 * n + 1) < 2 ^ w → - K_max < 2 ^ w → + ∀ (n_max U V base w : ℕ) (mem₀ : ℕ → ℕ) (ops : List (P.Op n_max)), + base + (11 * n_max + 1) < 2 ^ w → + U < 2 ^ w → + V < 2 ^ w → (∀ a, mem₀ a < 2 ^ w) → - (∀ a, base ≤ a → a < base + (9 * n + 1) → mem₀ a = 0) → - P.ValidSeq K_max (fun _ => none) ops → - ∃ t₀ t_init reg_f mem_f t_ops, + (∀ a, base ≤ a → a < base + (11 * n_max + 1) → mem₀ a = 0) → + P.ValidSeq U V (fun _ => none) ops → + ∃ t₀ t_init q_f reg_f mem_f t_ops extLog, Relation.RelatesInSteps (fun a b => S.step w p_init a = S.next b) - (S.state 0 (P.initRegs n base) mem₀) t₀ t_init ∧ + (S.state 0 (P.initRegs n_max base) mem₀) t₀ t_init ∧ (∃ out, S.step w p_init t₀ = S.halted out) ∧ - (∀ a, a < base ∨ base + (9 * n + 1) ≤ a → P.stateMem t₀ a = mem₀ a) ∧ - P.RunsOps w p_op base (9 * n + 1) (fun _ => none) (P.stateReg t₀) (P.stateMem t₀) ops - reg_f mem_f t_ops ∧ + (∀ a, a < base ∨ base + (11 * n_max + 1) ≤ a → P.stateMem t₀ a = mem₀ a) ∧ + P.RunsOps w p_op base (11 * n_max + 1) (fun _ => none) (P.stateReg t₀) (P.stateMem t₀) + ops q_f reg_f mem_f t_ops extLog ∧ t_init + 1 ≤ K ∧ t_ops ≤ - K * (P.numQueries ops + P.numInserts ops + P.numDecreaseKeys ops + - P.numExtractMins ops * (Nat.log 2 n + 1)) := by - refine ⟨42, S.programOf FibonacciHeap.initFreshProg, S.programOf FibonacciHeap.opProg, 421, - fun n K_max base w mem₀ ops hsp hK hmem hzero hv => ?_⟩ + K * (P.numQueries ops + P.numInserts ops + P.numDecreaseKeys ops + extLog) ∧ + extLog ≤ P.numExtractMins ops * (Nat.log 2 n_max + 1) := by + refine ⟨48, S.programOf FibonacciHeap.MinPQ.initFreshProg, + S.programOf FibonacciHeap.MinPQ.opProg, 421, + fun n_max U V base w mem₀ ops hsp hU hV hmem hzero hv => ?_⟩ obtain ⟨gs, rfl⟩ := P.list_opOf_surjective ops - have hzero' : ∀ a ∈ (Block.mk base (FibonacciHeap.space n)).footprint, mem₀ a = 0 := by + have hzero' : ∀ a ∈ (Block.mk base (FibonacciHeap.MinPQ.space n_max)).footprint, mem₀ a = 0 := by intro a ha rw [Block.mem_footprint, Block.Owns] at ha exact hzero a ha.1 ha.2 - obtain ⟨pc₀, x₀, t_init, z, t_ops, hr₀, ⟨out, hh₀⟩, hmod₀, hruns, ht_init, ht_ops⟩ := - FibonacciHeap.run_ops_exact_fresh (K_max := K_max) hsp hK hmem hzero' gs + obtain ⟨pc₀, x₀, t_init, tr, q_f, z, t_ops, hr₀, ⟨out, hh₀⟩, hmod₀, hruns, hops, _, + ht_init, ht_ops, _⟩ := + FibonacciHeap.MinPQ.run_ops_exact_fresh (U := U) (V := V) hsp hU hV hmem hzero' gs (P.validSeq_to_lib hP gs _ hv) - refine ⟨S.state pc₀ x₀.regs x₀.mem, t_init, z.regs, z.mem, t_ops, ?_, - ⟨out, Machine.step_halt hS hh₀⟩, ?_, ?_, ht_init, ?_⟩ + have hlog_le := FibonacciHeap.MinPQ.extractLogSum_le_numExtractMins tr (MinPQ.empty n_max) + rw [hops, P.numExtractMins_eq hP] at hlog_le + refine ⟨S.state pc₀ x₀.regs x₀.mem, t_init, q_f, z.regs, z.mem, t_ops, + FibonacciHeap.MinPQ.extractLogSum (MinPQ.empty n_max) tr, ?_, + ⟨out, Machine.step_halt hS hh₀⟩, ?_, ?_, ht_init, ?_, hlog_le⟩ · rw [P.initRegs_eq hP] exact Machine.runs_map hS hr₀ · rw [hP.stateMem_eq] exact unchangedOutside_of_modifies hmod₀ · rw [hP.stateReg_eq, hP.stateMem_eq] exact P.runsOps_map hP hS hruns - · rw [← P.numQueries_eq hP, ← P.numInserts_eq hP, ← P.numDecreaseKeys_eq hP, - ← P.numExtractMins_eq hP] + · rw [← P.numQueries_eq hP, ← P.numInserts_eq hP, ← P.numDecreaseKeys_eq hP] exact ht_ops -/-- Transfer of `FibonacciHeap.run_ops_exact_reusable` (`O(n)` clear initialization on arbitrary -`w`-bit memory) to any exact word-RAM presentation `S` and priority-queue presentation `P`. -/ +/-- Transfer of `FibonacciHeap.MinPQ.run_ops_exact_reusable` (`O(n_max + 1)` clear initialization +on arbitrary `w`-bit memory) to any exact word-RAM presentation `S` and priority-queue presentation +`P`. -/ theorem amortized_reusable (S : WordRAMBridge.Presentation) (hS : WordRAMBridge.Laws S) (P : PQPresentation S) (hP : PQLaws S P) : ∃ r, ∃ p_init p_op : List (S.Instr r), ∃ K, - ∀ (n K_max base w : ℕ) (mem₀ : ℕ → ℕ) (ops : List (P.Op n)), - base + (9 * n + 1) < 2 ^ w → - K_max < 2 ^ w → + ∀ (n_max U V base w : ℕ) (mem₀ : ℕ → ℕ) (ops : List (P.Op n_max)), + base + (11 * n_max + 1) < 2 ^ w → + U < 2 ^ w → + V < 2 ^ w → (∀ a, mem₀ a < 2 ^ w) → - P.ValidSeq K_max (fun _ => none) ops → - ∃ t₀ t_init reg_f mem_f t_ops, + P.ValidSeq U V (fun _ => none) ops → + ∃ t₀ t_init q_f reg_f mem_f t_ops extLog, Relation.RelatesInSteps (fun a b => S.step w p_init a = S.next b) - (S.state 0 (P.initRegs n base) mem₀) t₀ t_init ∧ + (S.state 0 (P.initRegs n_max base) mem₀) t₀ t_init ∧ (∃ out, S.step w p_init t₀ = S.halted out) ∧ - (∀ a, a < base ∨ base + (9 * n + 1) ≤ a → P.stateMem t₀ a = mem₀ a) ∧ - P.RunsOps w p_op base (9 * n + 1) (fun _ => none) (P.stateReg t₀) (P.stateMem t₀) ops - reg_f mem_f t_ops ∧ - t_init + 1 ≤ K * (n + 1) ∧ + (∀ a, a < base ∨ base + (11 * n_max + 1) ≤ a → P.stateMem t₀ a = mem₀ a) ∧ + P.RunsOps w p_op base (11 * n_max + 1) (fun _ => none) (P.stateReg t₀) (P.stateMem t₀) + ops q_f reg_f mem_f t_ops extLog ∧ + t_init + 1 ≤ K * (n_max + 1) ∧ t_ops ≤ - K * (P.numQueries ops + P.numInserts ops + P.numDecreaseKeys ops + - P.numExtractMins ops * (Nat.log 2 n + 1)) := by - refine ⟨42, S.programOf FibonacciHeap.initClearProg, S.programOf FibonacciHeap.opProg, 421, - fun n K_max base w mem₀ ops hsp hK hmem hv => ?_⟩ + K * (P.numQueries ops + P.numInserts ops + P.numDecreaseKeys ops + extLog) ∧ + extLog ≤ P.numExtractMins ops * (Nat.log 2 n_max + 1) := by + refine ⟨48, S.programOf FibonacciHeap.MinPQ.initClearProg, + S.programOf FibonacciHeap.MinPQ.opProg, 421, + fun n_max U V base w mem₀ ops hsp hU hV hmem hv => ?_⟩ obtain ⟨gs, rfl⟩ := P.list_opOf_surjective ops - obtain ⟨pc₀, x₀, t_init, z, t_ops, hr₀, ⟨out, hh₀⟩, hmod₀, hruns, ht_init, ht_ops⟩ := - FibonacciHeap.run_ops_exact_reusable (K_max := K_max) hsp hK hmem gs + obtain ⟨pc₀, x₀, t_init, tr, q_f, z, t_ops, hr₀, ⟨out, hh₀⟩, hmod₀, hruns, hops, _, + ht_init, ht_ops, _⟩ := + FibonacciHeap.MinPQ.run_ops_exact_reusable (U := U) (V := V) hsp hU hV hmem gs (P.validSeq_to_lib hP gs _ hv) - refine ⟨S.state pc₀ x₀.regs x₀.mem, t_init, z.regs, z.mem, t_ops, ?_, - ⟨out, Machine.step_halt hS hh₀⟩, ?_, ?_, ht_init, ?_⟩ + have hlog_le := FibonacciHeap.MinPQ.extractLogSum_le_numExtractMins tr (MinPQ.empty n_max) + rw [hops, P.numExtractMins_eq hP] at hlog_le + refine ⟨S.state pc₀ x₀.regs x₀.mem, t_init, q_f, z.regs, z.mem, t_ops, + FibonacciHeap.MinPQ.extractLogSum (MinPQ.empty n_max) tr, ?_, + ⟨out, Machine.step_halt hS hh₀⟩, ?_, ?_, ht_init, ?_, hlog_le⟩ · rw [P.initRegs_eq hP] exact Machine.runs_map hS hr₀ · rw [hP.stateMem_eq] exact unchangedOutside_of_modifies hmod₀ · rw [hP.stateReg_eq, hP.stateMem_eq] exact P.runsOps_map hP hS hruns - · rw [← P.numQueries_eq hP, ← P.numInserts_eq hP, ← P.numDecreaseKeys_eq hP, - ← P.numExtractMins_eq hP] + · rw [← P.numQueries_eq hP, ← P.numInserts_eq hP, ← P.numDecreaseKeys_eq hP] exact ht_ops end ComplexityAbstracts.FibonacciHeapBridge From 03683792b471bd8772568defcb04fd9901792df7 Mon Sep 17 00:00:00 2001 From: Renfei Zhou Date: Thu, 29 Oct 2026 18:09:00 +0000 Subject: [PATCH 04/12] refactor(WordRAM/PriorityQueue): adapt FibonacciHeap.MinPQ to shared DynamicProgram/Executes --- .../WordRAM/PriorityQueue/FibonacciHeap.lean | 4 ++-- .../WordRAM/PriorityQueue/FibonacciHeap/MinPQ.lean | 10 +++++----- ComplexityTests/WordRAMFibonacciHeap.lean | 2 +- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap.lean b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap.lean index cbc2f189c..e436031d1 100644 --- a/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap.lean +++ b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap.lean @@ -444,10 +444,10 @@ abbrev relSubroutineDS {n_max U V w base : ℕ} ![n_max] (Cslib.Algorithms.Lean.MinPQ.empty n_max) := MinPQ.relSubroutineDS hS hU hV -/-- Standalone `RelDynamicProgram` for the key–value Fibonacci heap with handles (`MinPQ.spec`). -/ +/-- Standalone `DynamicProgram` for the key–value Fibonacci heap with handles (`MinPQ.spec`). -/ abbrev relDynamicProgram {n_max U V w base : ℕ} (hS : Fits w (base + MinPQ.space n_max)) (hU : Fits w U) (hV : Fits w V) : - RelDynamicProgram (Cslib.Algorithms.Lean.MinPQ.spec n_max U V) MinPQ.rMinPQ := + DynamicProgram (Cslib.Algorithms.Lean.MinPQ.spec n_max U V) MinPQ.rMinPQ := MinPQ.relDynamicProgram hS hU hV /-- Standalone `RelDynamicCertificate` for the key–value Fibonacci heap with handles diff --git a/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/MinPQ.lean b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/MinPQ.lean index 12c6d06f8..e36285e68 100644 --- a/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/MinPQ.lean +++ b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/MinPQ.lean @@ -1699,14 +1699,14 @@ def relSubroutineDS {n_max U V w base : ℕ} setup_exec := initSetup_exec step_exec := dispatchCode_exec -/-! ## Standalone `Basis.standard` `RelDynamicProgram` and `Stateful.RelAmortized` realizations -/ +/-! ## Standalone `Basis.standard` `DynamicProgram` and `Stateful.RelAmortized` realizations -/ -/-- Standalone `RelDynamicProgram` realization of the key–value Fibonacci heap over +/-- Standalone `DynamicProgram` realization of the key–value Fibonacci heap over `Basis.standard`. -/ def relDynamicProgram {n_max U V w base : ℕ} (hS : Fits w (base + space n_max)) (hU : Fits w U) (hV : Fits w V) : - RelDynamicProgram (Cslib.Algorithms.Lean.MinPQ.spec n_max U V) rMinPQ := - (relSubroutineDS (n_max := n_max) (U := U) (V := V) hS hU hV).toStandard.toRelDynamicProgram + DynamicProgram (Cslib.Algorithms.Lean.MinPQ.spec n_max U V) rMinPQ := + (relSubroutineDS (n_max := n_max) (U := U) (V := V) hS hU hV).toStandard.toDynamicProgram /-- Standalone `RelDynamicCertificate` for the key–value Fibonacci heap over `Basis.standard`. -/ def relCertificate {n_max U V w base : ℕ} @@ -1733,7 +1733,7 @@ theorem run_client_amortized {n_max U V w base : ℕ} (hr : Rep n_max U V w base s x) (hv : (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).DemonicValid s p) : ∃ a y traces s' tr, - Stateful.RelExecutes ((relDynamicProgram hS hU hV).ExecOp w) p x a y traces ∧ + Stateful.Executes ((relDynamicProgram hS hU hV).ExecOp w) p x a y traces ∧ (Cslib.Algorithms.Lean.MinPQ.spec n_max U V).ClientRun s p a s' tr ∧ Rep n_max U V w base s' y ∧ traces.length = tr.length ∧ diff --git a/ComplexityTests/WordRAMFibonacciHeap.lean b/ComplexityTests/WordRAMFibonacciHeap.lean index 2a9ba3db6..d393f96bd 100644 --- a/ComplexityTests/WordRAMFibonacciHeap.lean +++ b/ComplexityTests/WordRAMFibonacciHeap.lean @@ -359,7 +359,7 @@ example : ∃ a y₀ y traces s' tr, MinPQ.Rep 4 50 500 10 8 (Cslib.Algorithms.Lean.MinPQ.empty 4) y₀ ∧ MinPQ.potential y₀ = 0 ∧ - Stateful.RelExecutes ((relDynamicProgram hS hU hV).ExecOp 10) sampleMinPQClient y₀ + Stateful.Executes ((relDynamicProgram hS hU hV).ExecOp 10) sampleMinPQClient y₀ a y traces ∧ (Cslib.Algorithms.Lean.MinPQ.spec 4 50 500).ClientRun (Cslib.Algorithms.Lean.MinPQ.empty 4) sampleMinPQClient a s' tr ∧ From a1a69b8e48af01e68d78e5ca4885ab8d8c2f9cb1 Mon Sep 17 00:00:00 2001 From: Renfei Zhou Date: Thu, 29 Oct 2026 18:35:31 +0000 Subject: [PATCH 05/12] Address code review feedback on MinPQ, Consolidate, and FibonacciHeap.MinPQ --- Complexity/Algorithms/Lean/MinPQ.lean | 30 +++--- .../FibonacciHeap/Consolidate.lean | 56 +++++----- .../PriorityQueue/FibonacciHeap/MinPQ.lean | 101 +++++++----------- .../PriorityQueue/FibonacciHeap/Program.lean | 4 +- 4 files changed, 85 insertions(+), 106 deletions(-) diff --git a/Complexity/Algorithms/Lean/MinPQ.lean b/Complexity/Algorithms/Lean/MinPQ.lean index 95b29e31c..f424ca976 100644 --- a/Complexity/Algorithms/Lean/MinPQ.lean +++ b/Complexity/Algorithms/Lean/MinPQ.lean @@ -32,8 +32,10 @@ by the data structure: `u'` while preserving its satellite value `v`; * `isEmpty` and `get h`: read-only queries returning `decide (dom s = ∅)` and `s h`. -This module also defines the deterministic free-list handle allocator (`AllocState`, `stepAlloc`) -and proves that it refines `MinPQ.spec` while projecting to `IndexedMinPQ.spec` on keys. +This module also defines the deterministic free-list handle allocator (`AllocState`, `stepAlloc`), +proves that `stepAlloc` refines `MinPQ.spec` while preserving `AllocState.WellFormed`, and provides +the key-projection lemmas `toIndexed_update_some` and `toIndexed_update_none` connecting `State` to +`IndexedMinPQ.State`. ## Main definitions @@ -51,8 +53,9 @@ and proves that it refines `MinPQ.spec` while projecting to `IndexedMinPQ.spec` * `Cslib.Algorithms.Lean.MinPQ.instTotalSpec`: `MinPQ.spec n_max U V` is total (`RelSpec.Total`). * `Cslib.Algorithms.Lean.MinPQ.stepAlloc_refines_spec`: every valid `stepAlloc` transition satisfies - `(spec n_max U V).step`, preserves `AllocState.WellFormed`, and steps `toIndexed` via - `IndexedMinPQ.spec`. + `(spec n_max U V).step` and preserves `AllocState.WellFormed`. +* `Cslib.Algorithms.Lean.MinPQ.toIndexed_update_some`, `toIndexed_update_none`: `toIndexed` + commutes with `Function.update` on active and cleared handles. -/ @[expose] public section @@ -376,8 +379,7 @@ def allocHandle {n_max : ℕ} (s : AllocState n_max) : none /-- Deterministic transition on `AllocState n_max` using `allocHandle` for `insert` and -`IndexedMinPQ.findMin (toIndexed s.entries)` (lexicographic `(key, handle)` tie-breaking) for -`extractMin`. -/ +`findMin s.entries` (lexicographic `(key, handle)` tie-breaking) for `extractMin`. -/ def stepAlloc {n_max : ℕ} (s : AllocState n_max) (o : Op n_max) : AllocState n_max × o.Result := match o with @@ -393,13 +395,10 @@ def stepAlloc {n_max : ℕ} (s : AllocState n_max) (o : Op n_max) : | some (_, v) => (⟨Function.update s.entries h (some (u', v)), s.freeList, s.fresh⟩, ()) | none => (s, ()) | .extractMin => - match IndexedMinPQ.findMin (toIndexed s.entries) with + match findMin s.entries with | none => (s, none) - | some (h, u) => - match s.entries h with - | some (_, v) => - (⟨Function.update s.entries h none, h :: s.freeList, s.fresh⟩, some (u, v, h)) - | none => (s, none) + | some (u, v, h) => + (⟨Function.update s.entries h none, h :: s.freeList, s.fresh⟩, some (u, v, h)) /-- On any well-formed `AllocState` with `size s.entries < n_max`, `allocHandle s` succeeds, returns an unused handle `h` (`s.entries h = none`), and preserves `AllocState.WellFormed` after @@ -491,10 +490,11 @@ theorem stepAlloc_refines_spec {n_max U V : ℕ} {s : AllocState n_max} (hwf : s · have hemp : dom s.entries = ∅ := by rw [← dom_toIndexed, ← IndexedMinPQ.findMin_eq_none_iff] exact hfm - simp only [stepAlloc, hfm] + have hfm' : findMin s.entries = none := findMin_eq_none_iff.mpr hemp + simp only [stepAlloc, hfm'] exact ⟨Or.inl ⟨hemp, rfl, rfl⟩, hfr_le, hnd, hfree, hbump, hsum⟩ - · obtain ⟨v, hsh, _, hmin⟩ := findMin_eq_some_of_indexed hfm - simp only [stepAlloc, hfm, hsh] + · obtain ⟨v, hsh, hfm', hmin⟩ := findMin_eq_some_of_indexed hfm + simp only [stepAlloc, hfm'] have hh_not_free : h ∉ s.freeList := fun hm => by rw [(hfree h hm).2] at hsh cases hsh diff --git a/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/Consolidate.lean b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/Consolidate.lean index 62be02efe..dfd1fc415 100644 --- a/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/Consolidate.lean +++ b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/Consolidate.lean @@ -12,13 +12,15 @@ public import Complexity.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.BasicOps /-! # Degree-indexed root consolidation and `extractMin` for a Fibonacci heap -This file proves the correctness, memory-safety, and `O(log n)` amortized instruction bound of -`scatterRootCode` and `extractMinCode` [Fredman and Tarjan][FredmanTarjan1987] +This file proves the correctness, memory-safety, and `O(log |dom s| + 1)` amortized instruction +bound of `scatterRootCode` and `extractMinCode` in the current number of stored elements +`sz = (IndexedMinPQ.dom s).card` [Fredman and Tarjan][FredmanTarjan1987] [Cormen et al., Section 19.2][CLRS2009]: * **Degree-table invariant (`SlotInv`):** Tracks the subset `slotTrees` of consolidated root trees - currently stored in `cons[0..maxDeg]`, maintaining pairwise-distinct degrees, `maxDeg ≤ - 2 * Nat.log 2 n + 1`, and zeroing of all unoccupied entries `cons[d]` (`d ≤ n`). + currently stored in `cons[0..maxDeg]` when consolidating at most `sz` nodes, maintaining + pairwise-distinct degrees, `maxDeg ≤ 2 * Nat.log 2 sz + 1`, and zeroing of all unoccupied entries + `cons[d]` (`d ≤ n`). * **Root scattering (`scatterRootCode_exec`):** Repeatedly links equal-degree roots via `ValidRoot.link` under lexicographic `IndexedMinPQ.PrioLT` using internal potential `50 * slotTrees.length`, @@ -26,9 +28,9 @@ This file proves the correctness, memory-safety, and `O(log n)` amortized instru other live nodes. * **Minimum extraction (`extractMinCode_exec`):** Removes `z = minRoot - 1` (agreeing with `IndexedMinPQ.findMin`), scatters `z`'s children and the `numRoots - 1` remaining roots into - `cons`, and scans only `0 .. maxDeg` (`≤ 2 * Nat.log 2 n + 2` slots) to rebuild the root circular - list and `minRootReg` while restoring `cons = 0` in `t + potential y ≤ 410 * (Nat.log 2 n + 1) + - potential x` instructions. + `cons`, and scans only `0 .. maxDeg` (`≤ 2 * Nat.log 2 (IndexedMinPQ.dom s).card + 2` slots) to + rebuild the root circular list and `minRootReg` while restoring `cons = 0` in + `t + potential y ≤ 410 * (Nat.log 2 (IndexedMinPQ.dom s).card + 1) + potential x` instructions. ## Main definitions @@ -39,8 +41,9 @@ This file proves the correctness, memory-safety, and `O(log n)` amortized instru * `Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.scatterRootCode_exec`: amortized root scattering and equal-degree linking specification. -* `Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.extractMinCode_exec`: `O(log n)` amortized - `extractMin` specification. +* `Cslib.Algorithms.WordRAM.PriorityQueue.FibonacciHeap.extractMinCode_exec`: + `O(log |dom s| + 1)` amortized `extractMin` specification in the current number of stored + elements. ## References @@ -97,11 +100,11 @@ theorem ValidRoot.frame_nodes {n : ℕ} {st st' : RawState n} {T : FHTree n} let hu' := h u (T.nodes_eq ▸ List.mem_cons_of_mem T.root hu) hu'.2.2.2.2.2.2) -/-- Every valid subtree `T` disjoint from at least one other handle `z : Fin n` satisfies both -`T.deg ≤ 2 * Nat.log 2 n + 1` and `T.deg + 2 ≤ n`. -/ -theorem deg_bounds_of_extra {n : ℕ} {st : RawState n} {T : FHTree n} {z : Fin n} - (hT : ValidSubtree st none T) (hnd : (z :: T.nodes).Nodup) : - T.deg ≤ 2 * Nat.log 2 n + 1 ∧ T.deg + 2 ≤ n := by +/-- Every valid subtree `T` with `T.size ≤ sz` disjoint from at least one other handle `z : Fin n` +satisfies both `T.deg ≤ 2 * Nat.log 2 sz + 1` and `T.deg + 2 ≤ n`. -/ +theorem deg_bounds_of_extra {n sz : ℕ} {st : RawState n} {T : FHTree n} {z : Fin n} + (hsz : T.size ≤ sz) (hT : ValidSubtree st none T) (hnd : (z :: T.nodes).Nodup) : + T.deg ≤ 2 * Nat.log 2 sz + 1 ∧ T.deg + 2 ≤ n := by have hlen : 1 + T.size ≤ n := by have h : (z :: T.nodes).length ≤ n := by simpa using hnd.length_le_card simp only [List.length_cons] at h @@ -109,8 +112,7 @@ theorem deg_bounds_of_extra {n : ℕ} {st : RawState n} {T : FHTree n} {z : Fin omega have hfib : Nat.fib (T.deg + 2) ≤ T.size := hT.fib_le_size have hd_size : T.deg + 1 ≤ T.size := (deg_add_one_le_fib T.deg).trans hfib - have hd_log : T.deg ≤ 2 * Nat.log 2 n + 1 := - (hT.deg_bounds (m := n) (by omega)).1 + have hd_log : T.deg ≤ 2 * Nat.log 2 sz + 1 := (hT.deg_bounds hsz).1 exact ⟨hd_log, by omega⟩ private theorem nodup_eraseIdx {α : Type*} : @@ -409,7 +411,8 @@ private theorem scatterBody_exec {n sz base w maxDeg curD : ℕ} {a : Data rFib} have hnd_cur_rest := List.nodup_append.mp hnd have hz_in_ro : z ∈ forestNodes slotTrees ++ otherNodes := List.mem_append_right _ hz_mem have hz_not_cur : z ∉ T_cur.nodes := fun hm => hnd_cur_rest.2.2 z hm z hz_in_ro rfl - have hdeg_bds := deg_bounds_of_extra hT_cur.1 (List.nodup_cons.mpr ⟨hz_not_cur, hnd_cur_rest.1⟩) + have hdeg_bds := + deg_bounds_of_extra le_rfl hT_cur.1 (List.nodup_cons.mpr ⟨hz_not_cur, hnd_cur_rest.1⟩) rw [hcur_deg] at hdeg_bds have hd_le_n : curD ≤ n := by omega have hd1_le_n : curD + 1 ≤ n := by omega @@ -1311,7 +1314,7 @@ theorem scatterRootCode_exec {n sz base w maxDeg₀ : ℕ} {x : Data rFib} have hnd_0 := List.nodup_append.mp hnd have hz_not_0 : z ∉ T₀.nodes := fun hm => hnd_0.2.2 z hm z (List.mem_append_right _ hz_mem) rfl - have hd0_bds := deg_bounds_of_extra hT₀.1 (List.nodup_cons.mpr ⟨hz_not_0, hnd_0.1⟩) + have hd0_bds := deg_bounds_of_extra le_rfl hT₀.1 (List.nodup_cons.mpr ⟨hz_not_0, hnd_0.1⟩) have hd0_le_n : d0 ≤ n := by omega have hdeg_u0 : st.deg u0 = d0 := by cases hT₀.1 with @@ -1395,7 +1398,12 @@ theorem scatterRootCode_exec {n sz base w maxDeg₀ : ℕ} {x : Data rFib} have hnd_f := List.nodup_append.mp hnd_lp have hz_not_f : z ∉ T_f.nodes := fun hm => hnd_f.2.2 z hm z (List.mem_append_right _ hz_mem) rfl - have hdf_bds := deg_bounds_of_extra hTf.1 (List.nodup_cons.mpr ⟨hz_not_f, hnd_f.1⟩) + have hTf_sz : T_f.size ≤ sz := by + have hp_len := (hperm_lp.append_right otherNodes).length_eq + simp only [List.length_append] at hp_len hsz + unfold FHTree.size + omega + have hdf_bds := deg_bounds_of_extra hTf_sz hTf.1 (List.nodup_cons.mpr ⟨hz_not_f, hnd_f.1⟩) rw [hdeg_f] at hdf_bds have hdf_le_n : curD_f ≤ n := by omega have hcons_f_zero : st_lp.cons curD_f = 0 := by @@ -1508,15 +1516,7 @@ theorem scatterRootCode_exec {n sz base w maxDeg₀ : ℕ} {x : Data rFib} Function.update_of_ne ne_cd, Function.update_of_ne ne4] · simpa only [forestNodes, List.append_assoc] using hnd_lp · rw [hsty, hst_z2] - have hTf_sz : T_f.size ≤ sz := by - have hp_len := (hperm_lp.append_right otherNodes).length_eq - simp only [List.length_append] at hp_len hsz - unfold FHTree.size - omega - have hdf_log : curD_f ≤ 2 * Nat.log 2 sz + 1 := by - rw [← hdeg_f] - exact (hTf.1.deg_bounds hTf_sz).1 - exact hs_lp.insert_empty hdf_bds.2 hdf_log hdeg_f hnone_f hTf + exact hs_lp.insert_empty hdf_bds.2 hdf_bds.1 hdeg_f hnone_f hTf · dsimp only rw [hsty, hst_z2] exact ⟨hk_lp, hmk_lp, hin_lp, hmin_lp, hnr_lp, hnm_lp, hsz_lp, ho_lp⟩ diff --git a/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/MinPQ.lean b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/MinPQ.lean index e36285e68..97d0431e1 100644 --- a/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/MinPQ.lean +++ b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/MinPQ.lean @@ -247,10 +247,10 @@ def getCode : Code .exact rMinPQ := ] ] -/-- `insert u v`: allocates a handle `argV` from `freeStack` (if `freeTopReg > 0`) or bumps -`freshReg`, stores `val[argV] ← inValReg`, runs `FibonacciHeap.insertCode.rename f42` with key -`argK = u`, and outputs `outV ← argV`. -/ -def insertCode : Code .exact rMinPQ := +/-- Handle-allocation branch of `insertCode`: pops a recycled handle from +`freeStack[freeTopReg - 1]` when `freeTopReg ≠ 0`, or allocates `freshReg` and increments +`freshReg` when `freeTopReg = 0`. -/ +def allocHandleBranch : Code .exact rMinPQ := ram_exact[ if freeTopReg = zeroP then [ argV ← freshReg; @@ -259,7 +259,15 @@ def insertCode : Code .exact rMinPQ := freeTopReg ← freeTopReg - oneP; s0 ← freeBaseReg + freeTopReg; argV ← *s0 - ]; + ] + ] + +/-- `insert u v`: allocates a handle `argV` from `freeStack` (if `freeTopReg > 0`) or bumps +`freshReg` via `allocHandleBranch`, stores `val[argV] ← inValReg`, runs +`FibonacciHeap.insertCode.rename f42` with key `argK = u`, and outputs `outV ← argV`. -/ +def insertCode : Code .exact rMinPQ := + ram_exact[ + ⟪allocHandleBranch⟫; s0 ← valBaseReg + argV; *s0 ← inValReg; ⟪FibonacciHeap.insertCode.rename f42⟫; @@ -339,7 +347,7 @@ def rawEncode {n_max : ℕ} : Cslib.Algorithms.Lean.MinPQ.Op n_max → Fin rMinP /-- Register encoding for `Cslib.Algorithms.Lean.MinPQ.Op n_max` bounded by `U` on `decreaseKey` so `arguments_fit` holds on arbitrary states; coincides with `rawEncode` on every represented -state (`encode_eq_rawEncode_of_valid`). -/ +state (`encode_eq_rawEncode_of_rep`). -/ def encode {n_max : ℕ} (U : ℕ) : Cslib.Algorithms.Lean.MinPQ.Op n_max → Fin rMinPQ → ℕ | .decreaseKey h u' => fun i => if i = tag1 then 1 else if i = tag0 then 1 @@ -490,12 +498,6 @@ theorem modifies_of_fib {n_max base : ℕ} {m₁ m₂ : ℕ → ℕ} Modifies (Block.mk base (space n_max)).footprint m₁ m₂ := fun a ha => h a fun ha' => ha (fib_footprint_subset ha') -theorem modifies_outer_trans {n_max base : ℕ} {m₁ m₂ m₃ : ℕ → ℕ} - (h₁ : Modifies (Block.mk base (space n_max)).footprint m₁ m₂) - (h₂ : Modifies (Block.mk base (space n_max)).footprint m₂ m₃) : - Modifies (Block.mk base (space n_max)).footprint m₁ m₃ := by - simpa only [Finset.union_idempotent] using h₁.trans h₂ - theorem AllocRep.supported {n_max U V w base : ℕ} {s : Cslib.Algorithms.Lean.MinPQ.AllocState n_max} {x x' : Data rMinPQ} (hreg : ∀ i : Fin rMinPQ, inputReg i = false → x'.regs i = x.regs i) @@ -572,24 +574,6 @@ theorem encode_eq_rawEncode_of_rep {n_max U V w base : ℕ} /-! ## Initialization: `incCur_eval`, `allocSpan_exec`, `initSetup_exec` -/ -private theorem execWithin_exactAdd48 {w : ℕ} {x : Data rMinPQ} {d i j : Fin rMinPQ} - (hfit : Fits w (x.regs i + x.regs j)) : - ExecWithin (B := .exact) w (.op (.exactBin .add d i j)) x - (x.set d (x.regs i + x.regs j)) 1 := - ExecWithin.op (by - rw [Op.eval_exactBin] - simp only [BinOp.evalExact, Option.bind_some] - exact Data.put_of_fits hfit) - -private theorem execWithin_exactSub48 {w : ℕ} {x : Data rMinPQ} {d i j : Fin rMinPQ} - (hle : x.regs j ≤ x.regs i) (hfit : Fits w (x.regs i - x.regs j)) : - ExecWithin (B := .exact) w (.op (.exactBin .sub d i j)) x - (x.set d (x.regs i - x.regs j)) 1 := - ExecWithin.op (by - rw [Op.eval_exactBin] - simp only [BinOp.evalExact, hle, ↓reduceIte, Option.bind_some] - exact Data.put_of_fits hfit) - theorem incCur_eval {w : ℕ} {x : Data rMinPQ} (h1 : x.regs oneReg = 1) (hfit : Fits w (x.regs curReg + 1)) : (Op.exactBin .add curReg curReg oneReg).eval w x = @@ -641,7 +625,7 @@ theorem allocSpan_exec {n_max w base : ℕ} (hS : Fits w (base + space n_max)) let x2 := x1.set freeBaseReg (base + FibonacciHeap.space n_max + n_max) have e2 : ExecWithin w (.op (.exactBin .add freeBaseReg valBaseReg nReg)) x1 x2 1 := by simpa only [hx1_vb, hx1_n] using - execWithin_exactAdd48 (x := x1) (d := freeBaseReg) (i := valBaseReg) (j := nReg) + FibonacciHeap.execWithin_exactAdd (x := x1) (d := freeBaseReg) (i := valBaseReg) (j := nReg) (by rw [hx1_vb, hx1_n]; rw [space_eq_fib_add] at hS; exact hS.of_le (by omega)) have hx2_fb : x2.regs freeBaseReg = base + FibonacciHeap.space n_max + n_max := by simp only [x2, Data.set_regs, Function.update_self] @@ -652,7 +636,8 @@ theorem allocSpan_exec {n_max w base : ℕ} (hS : Fits w (base + space n_max)) have heq : base + FibonacciHeap.space n_max + n_max + n_max = base + space n_max := by rw [space_eq_fib_add]; omega simpa only [hx2_fb, hx2_n, heq] using - execWithin_exactAdd48 (x := x2) (d := outerFrontierReg) (i := freeBaseReg) (j := nReg) + FibonacciHeap.execWithin_exactAdd + (x := x2) (d := outerFrontierReg) (i := freeBaseReg) (j := nReg) (by rw [hx2_fb, hx2_n, heq]; exact hS) have he : ExecWithin w allocSpan x x3 15 := by unfold allocSpan @@ -684,7 +669,8 @@ theorem initSetup_exec {n_max U V w base : ℕ} {x₁ : Data rMinPQ} have hsub : base + space n_max - n_max = base + FibonacciHeap.space n_max + n_max := by rw [space_eq_fib_add]; omega simpa only [hfr₁, hn, hsub] using - execWithin_exactSub48 (x := x₁) (d := freeBaseReg) (i := outerFrontierReg) (j := nReg) + FibonacciHeap.execWithin_exactSub + (x := x₁) (d := freeBaseReg) (i := outerFrontierReg) (j := nReg) (by rw [hfr₁, hn, space_eq_fib_add]; omega) (by rw [hfr₁, hn, hsub]; rw [space_eq_fib_add] at hS; exact hS.of_le (by omega)) have hs1_fb : s1.regs freeBaseReg = base + FibonacciHeap.space n_max + n_max := by @@ -694,7 +680,7 @@ theorem initSetup_exec {n_max U V w base : ℕ} {x₁ : Data rMinPQ} let s2 := s1.set valBaseReg (base + FibonacciHeap.space n_max) have e2 : ExecWithin w (.op (.exactBin .sub valBaseReg freeBaseReg nReg)) s1 s2 1 := by simpa only [hs1_fb, hs1_n, Nat.add_sub_cancel] using - execWithin_exactSub48 (x := s1) (d := valBaseReg) (i := freeBaseReg) (j := nReg) + FibonacciHeap.execWithin_exactSub (x := s1) (d := valBaseReg) (i := freeBaseReg) (j := nReg) (by rw [hs1_fb, hs1_n]; omega) (by rw [hs1_fb, hs1_n, Nat.add_sub_cancel] @@ -929,7 +915,7 @@ theorem getCode_exec {n_max U V w base : ℕ} have ea : ExecWithin w (.op (.exactBin .add s0 valBaseReg argV)) x1 (x1.set s0 (base + FibonacciHeap.space n_max + h.val)) 1 := by simpa only [hx1_vb, hx1_v] using - execWithin_exactAdd48 (x := x1) (d := s0) (i := valBaseReg) (j := argV) + FibonacciHeap.execWithin_exactAdd (x := x1) (d := s0) (i := valBaseReg) (j := argV) (by rw [hx1_vb, hx1_v]; rw [space_eq_fib_add] at hfit_stop; exact hfit_stop.of_le (by omega)) have el : ExecWithin (B := .exact) w (.op (.load outValReg s0)) @@ -963,18 +949,6 @@ theorem getCode_exec {n_max U V w base : ℕ} unfold potential omega -private def allocHandleBranch : Code .exact rMinPQ := - ram_exact[ - if freeTopReg = zeroP then [ - argV ← freshReg; - freshReg ← freshReg + oneP - ] else [ - freeTopReg ← freeTopReg - oneP; - s0 ← freeBaseReg + freeTopReg; - argV ← *s0 - ] - ] - private theorem allocHandleBranch_exec {n_max U V w base u v : ℕ} {s : Cslib.Algorithms.Lean.MinPQ.AllocState n_max} {x : Data rMinPQ} (hrep : AllocRep n_max U V w base s x) @@ -1024,7 +998,8 @@ private theorem allocHandleBranch_exec {n_max U V w base u v : ℕ} have ho1' : (x.set argV s.fresh).regs oneP = 1 := by simp only [Data.set_regs, Function.update_of_ne (by decide : oneP ≠ argV), ho1] simpa only [hfr1, ho1'] using - execWithin_exactAdd48 (x := x.set argV s.fresh) (d := freshReg) (i := freshReg) (j := oneP) + FibonacciHeap.execWithin_exactAdd + (x := x.set argV s.fresh) (d := freshReg) (i := freshReg) (j := oneP) (by rw [hfr1, ho1']; have := space_lower n_max; exact hfit_stop.of_le (by omega)) have he : ExecWithin w allocHandleBranch x x1 5 := by unfold allocHandleBranch @@ -1061,7 +1036,7 @@ private theorem allocHandleBranch_exec {n_max U V w base u v : ℕ} let x1 := a2.set argV hd.val have e1 : ExecWithin w (.op (.exactBin .sub freeTopReg freeTopReg oneP)) x a1 1 := by simpa only [htop_eq, ho1, Nat.add_sub_cancel] using - execWithin_exactSub48 (x := x) (d := freeTopReg) (i := freeTopReg) (j := oneP) + FibonacciHeap.execWithin_exactSub (x := x) (d := freeTopReg) (i := freeTopReg) (j := oneP) (by rw [htop_eq, ho1]; omega) (by rw [htop_eq, ho1, Nat.add_sub_cancel]; have := space_lower n_max; exact hfit_stop.of_le (by omega)) @@ -1072,7 +1047,7 @@ private theorem allocHandleBranch_exec {n_max U V w base u v : ℕ} have ha1_top : a1.regs freeTopReg = tl.length := by simp only [a1, Data.set_regs, Function.update_self] simpa only [ha1_fb, ha1_top] using - execWithin_exactAdd48 (x := a1) (d := s0) (i := freeBaseReg) (j := freeTopReg) + FibonacciHeap.execWithin_exactAdd (x := a1) (d := s0) (i := freeBaseReg) (j := freeTopReg) (by rw [ha1_fb, ha1_top]; rw [space_eq_fib_add] at hfit_stop; exact hfit_stop.of_le (by omega)) have e3 : ExecWithin (B := .exact) w (.op (.load argV s0)) a2 x1 1 := by @@ -1129,7 +1104,7 @@ theorem insertCode_exec {n_max U V w base u v : ℕ} have ew1 : ExecWithin w (.op (.exactBin .add s0 valBaseReg argV)) x1 (x1.set s0 (base + FibonacciHeap.space n_max + h.val)) 1 := by simpa only [hx1_vb, hx1_v] using - execWithin_exactAdd48 (x := x1) (d := s0) (i := valBaseReg) (j := argV) + FibonacciHeap.execWithin_exactAdd (x := x1) (d := s0) (i := valBaseReg) (j := argV) (by rw [hx1_vb, hx1_v]; rw [space_eq_fib_add] at hfit_stop; exact hfit_stop.of_le (by omega)) have ew2 : ExecWithin (B := .exact) w (.op (.store s0 inValReg)) @@ -1199,7 +1174,7 @@ theorem insertCode_exec {n_max U V w base u v : ℕ} (Function.update x1.mem (base + FibonacciHeap.space n_max + h.val) v) rw [hm1] exact Modifies.write_of_owns ho_val v - exact modifies_outer_trans hm_x2 (modifies_of_fib hmod_fib) + exact FibonacciHeap.modifies_block_trans hm_x2 (modifies_of_fib hmod_fib) refine ⟨y, 5 + 1 + 1 + t_fib + 1, he, ?_, ?_, hmod_all, ?_⟩ · simp only [decode, Cslib.Algorithms.Lean.MinPQ.stepAlloc, halloc, y, Data.set_regs, Function.update_self, hh_lt, ↓reduceDIte, Fin.eta] @@ -1403,10 +1378,14 @@ theorem extractMinCode_exec {n_max U V w base : ℕ} (hmem1_ge _ (Nat.le_add_right _ _)).trans (hval h' u' v' hsh').2.2⟩, fun i hi => (hmem1_ge _ (by omega)).trans (hfree i hi)⟩ refine ⟨y, t1 + 2, he1.seq he2, ?_, ?_, modifies_of_fib hmod_fib, ?_⟩ - · simp only [decode, Cslib.Algorithms.Lean.MinPQ.stepAlloc, hfm, y, Data.set_regs, + · have hfm' : Cslib.Algorithms.Lean.MinPQ.findMin s.entries = none := by + simp only [Cslib.Algorithms.Lean.MinPQ.findMin, hfm] + simp only [decode, Cslib.Algorithms.Lean.MinPQ.stepAlloc, hfm', y, Data.set_regs, Function.update_of_ne (by decide : outFlag ≠ s0), hfl0, ↓reduceIte] rfl - · simp only [Cslib.Algorithms.Lean.MinPQ.stepAlloc, hfm] + · have hfm' : Cslib.Algorithms.Lean.MinPQ.findMin s.entries = none := by + simp only [Cslib.Algorithms.Lean.MinPQ.findMin, hfm] + simp only [Cslib.Algorithms.Lean.MinPQ.stepAlloc, hfm'] exact hrep1.supported hreg_y (fun _ _ => rfl) (he2.bounded hb1) · rw [potential_supported hreg_y] change t1 + 2 + FibonacciHeap.potential (x1.comap f42) ≤ _ + potential x @@ -1414,7 +1393,7 @@ theorem extractMinCode_exec {n_max U V w base : ℕ} unfold potential omega · -- Non-empty queue (`findMin = some (h, u)`) - obtain ⟨v, hsh, _, _⟩ := Cslib.Algorithms.Lean.MinPQ.findMin_eq_some_of_indexed hfm + obtain ⟨v, hsh, hfm', _⟩ := Cslib.Algorithms.Lean.MinPQ.findMin_eq_some_of_indexed hfm simp only [PQCode.decode, FibonacciHeap.code, IndexedMinPQ.spec, hfm] at hdec_fib hinv_fib have hfl_ne : x1.regs outFlag ≠ 0 := by rw [hx1_fl] @@ -1445,7 +1424,7 @@ theorem extractMinCode_exec {n_max U V w base : ℕ} let y := a4.set freeTopReg (s.freeList.length + 1) have eb1 : ExecWithin w (.op (.exactBin .add s0 valBaseReg outV)) x1 a1 1 := by simpa only [hx1_vb, hov_eq] using - execWithin_exactAdd48 (x := x1) (d := s0) (i := valBaseReg) (j := outV) + FibonacciHeap.execWithin_exactAdd (x := x1) (d := s0) (i := valBaseReg) (j := outV) (by rw [hx1_vb, hov_eq]; rw [space_eq_fib_add] at hfit_stop; exact hfit_stop.of_le (by omega)) have eb2 : ExecWithin (B := .exact) w (.op (.load outValReg s0)) a1 a2 1 := by @@ -1463,7 +1442,7 @@ theorem extractMinCode_exec {n_max U V w base : ℕ} Function.update_of_ne (by decide : freeTopReg ≠ outValReg), Function.update_of_ne (by decide : freeTopReg ≠ s0), hx1_top] simpa only [ha2_fb, ha2_top] using - execWithin_exactAdd48 (x := a2) (d := s0) (i := freeBaseReg) (j := freeTopReg) + FibonacciHeap.execWithin_exactAdd (x := a2) (d := s0) (i := freeBaseReg) (j := freeTopReg) (by rw [ha2_fb, ha2_top]; rw [space_eq_fib_add] at hfit_stop; exact hfit_stop.of_le (by omega)) have eb4 : ExecWithin (B := .exact) w (.op (.store s0 outV)) a3 a4 1 := by @@ -1483,7 +1462,7 @@ theorem extractMinCode_exec {n_max U V w base : ℕ} Function.update_of_ne (by decide : oneP ≠ s0), Function.update_of_ne (by decide : oneP ≠ outValReg), hx1_o1] simpa only [ha4_top, ha4_o1] using - execWithin_exactAdd48 (x := a4) (d := freeTopReg) (i := freeTopReg) (j := oneP) + FibonacciHeap.execWithin_exactAdd (x := a4) (d := freeTopReg) (i := freeTopReg) (j := oneP) (by rw [ha4_top, ha4_o1]; have := space_lower n_max; exact hfit_stop.of_le (by omega)) have he2 : ExecWithin (B := .exact) w @@ -1513,9 +1492,9 @@ theorem extractMinCode_exec {n_max U V w base : ℕ} have hmod_all : Modifies (Block.mk base (space n_max)).footprint x.mem y.mem := by have hm_y : Modifies (Block.mk base (space n_max)).footprint x1.mem y.mem := Modifies.write_of_owns ho_free h.val - exact modifies_outer_trans (modifies_of_fib hmod_fib) hm_y + exact FibonacciHeap.modifies_block_trans (modifies_of_fib hmod_fib) hm_y refine ⟨y, t1 + 7, he1.seq he2, ?_, ?_, hmod_all, ?_⟩ - · simp only [decode, Cslib.Algorithms.Lean.MinPQ.stepAlloc, hfm, hsh, y, a4, a3, a2, a1, + · simp only [decode, Cslib.Algorithms.Lean.MinPQ.stepAlloc, hfm', y, a4, a3, a2, a1, Data.set_regs, Data.write_regs, Function.update_of_ne (by decide : outFlag ≠ freeTopReg), Function.update_of_ne (by decide : outFlag ≠ s0), @@ -1530,7 +1509,7 @@ theorem extractMinCode_exec {n_max U V w base : ℕ} Function.update_of_ne (by decide : outValReg ≠ s0), Function.update_self, hfl_ne, hov_eq, hok_eq, hh_lt, ↓reduceIte, ↓reduceDIte, Fin.eta] rfl - · simp only [Cslib.Algorithms.Lean.MinPQ.stepAlloc, hfm, hsh] at hwf' ⊢ + · simp only [Cslib.Algorithms.Lean.MinPQ.stepAlloc, hfm'] at hwf' ⊢ refine ⟨hby, ?_, hwf', ?_, ?_, ?_, ?_, ?_, ?_⟩ · refine FibonacciHeap.FibInv.supported hreg_fib hmem_fib (hby.comap f42) ?_ dsimp only diff --git a/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/Program.lean b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/Program.lean index f0507a767..4fe3a7979 100644 --- a/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/Program.lean +++ b/Complexity/Algorithms/WordRAM/PriorityQueue/FibonacciHeap/Program.lean @@ -698,7 +698,7 @@ theorem charge_extractMin_le_tExt (n : ℕ) (s : IndexedMinPQ.State n) : /-! ## Exact-ALU step rules, footprint framing, and `RawState.ofData` update lemmas -/ -theorem execWithin_exactAdd {w : ℕ} {x : Data rFib} {d i j : Fin rFib} +theorem execWithin_exactAdd {w r : ℕ} {x : Data r} {d i j : Fin r} (hfit : Fits w (x.regs i + x.regs j)) : ExecWithin (B := .exact) w (.op (.exactBin .add d i j)) x (x.set d (x.regs i + x.regs j)) 1 := @@ -707,7 +707,7 @@ theorem execWithin_exactAdd {w : ℕ} {x : Data rFib} {d i j : Fin rFib} simp only [BinOp.evalExact, Option.bind_some] exact Data.put_of_fits hfit) -theorem execWithin_exactSub {w : ℕ} {x : Data rFib} {d i j : Fin rFib} +theorem execWithin_exactSub {w r : ℕ} {x : Data r} {d i j : Fin r} (hle : x.regs j ≤ x.regs i) (hfit : Fits w (x.regs i - x.regs j)) : ExecWithin (B := .exact) w (.op (.exactBin .sub d i j)) x (x.set d (x.regs i - x.regs j)) 1 := From 888918d31bf556a04215a38559542b30a557bc44 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Thu, 29 Oct 2026 15:10:19 -0400 Subject: [PATCH 06/12] chore(deps): track CSLib main and Lean rc2 Advance CSLib to 8a8ad748 and synchronize Mathlib, the documentation generator, Verso, and all three lockfiles with Lean v4.36.0-rc2. Keep the root and documentation projects on the same inherited dependency revisions. --- docbuild/lake-manifest.json | 34 +++++++++++++++++----------------- docbuild/lakefile.toml | 2 +- guide/lake-manifest.json | 30 +++++++++++++++--------------- guide/lakefile.toml | 2 +- lake-manifest.json | 26 +++++++++++++------------- lakefile.toml | 2 +- lean-toolchain | 2 +- 7 files changed, 49 insertions(+), 49 deletions(-) diff --git a/docbuild/lake-manifest.json b/docbuild/lake-manifest.json index 3609d26b5..a1f5e4692 100644 --- a/docbuild/lake-manifest.json +++ b/docbuild/lake-manifest.json @@ -5,10 +5,10 @@ "type": "git", "subDir": null, "scope": "leanprover", - "rev": "0656b7ebd305f089c8d6bd8684a0797f19414cc2", + "rev": "20afd4ddabd2ef38ffb1a8b930ee0f375e3f75e8", "name": "«doc-gen4»", "manifestFile": "lake-manifest.json", - "inputRev": "v4.36.0-rc1", + "inputRev": "v4.36.0-rc2", "inherited": false, "configFile": "lakefile.lean"}, {"type": "path", @@ -23,7 +23,7 @@ "type": "git", "subDir": null, "scope": "", - "rev": "e1faac1842cb10b3a68c644643b6e3568766343c", + "rev": "f582e4bc64d6f43e6e711f89b09567d2088fab8d", "name": "leansqlite", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -33,7 +33,7 @@ "type": "git", "subDir": null, "scope": "", - "rev": "34d2efffcb6dc8d5f3537cf6a7f88bfaa999ec49", + "rev": "c09cb1e4f1e6e1c231a1175a12b681b075054a1b", "name": "Cli", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -43,7 +43,7 @@ "type": "git", "subDir": null, "scope": "", - "rev": "a24bcde05a7971144ba0c0b5b1d60c3a0f0bc4af", + "rev": "91ece4f8d8f93aac566e247874f6b27b57249f1b", "name": "UnicodeBasic", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -53,7 +53,7 @@ "type": "git", "subDir": null, "scope": "", - "rev": "78f28e27259a4b2f5a8199800334cebd92730f3d", + "rev": "cdf8963f8b4c9a5593c5aaa9fa4f2759f8dec1c1", "name": "BibtexQuery", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -73,27 +73,27 @@ "type": "git", "subDir": null, "scope": "", - "rev": "f4a472560f78c59bbedd795fe041ec507f7d0582", + "rev": "8a8ad7489cdccb007ad7279bfb9d03bbda2229ad", "name": "cslib", "manifestFile": "lake-manifest.json", - "inputRev": "f4a472560f78c59bbedd795fe041ec507f7d0582", + "inputRev": "8a8ad7489cdccb007ad7279bfb9d03bbda2229ad", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/mathlib4", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "625d8914199bc567cca9b91f90e8e5afafa5ae51", + "rev": "9d581dfff2e41de989072ea63abf3daf69311520", "name": "mathlib", "manifestFile": "lake-manifest.json", - "inputRev": "v4.36.0-rc1", + "inputRev": "v4.36.0-rc2", "inherited": true, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/plausible", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "c2d7840c65673533e15b499f25beecdc6227f7d8", + "rev": "129d1ba9a16bc0660f46c79e9fb041ef5d5d80de", "name": "plausible", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -103,7 +103,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "9d39f9bb0c30aa2f6200808805ff16e6ce950890", + "rev": "c61286b7b63cbfd563b28e11e81d0a18233a044a", "name": "LeanSearchClient", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -113,7 +113,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "b3cc36c295aa5e3e3c0197b09a6556298e710447", + "rev": "b8cc5dd0a36233b88a6ed5a7dbf1207d09338c60", "name": "importGraph", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -123,7 +123,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "17137fad38a2cc782ff00b323a13c3a991d085ab", + "rev": "16259c0d07d61ee37d999d05b5cf96338b8daa11", "name": "proofwidgets", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -133,7 +133,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "cbdde3aa2665915fb286c48bcd4cdf885c629511", + "rev": "7d11bfa88558f8d3d90afdf6bd877ed70001498d", "name": "aesop", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -143,7 +143,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "6d26f8bb4b2bb78f929ad160feac508866821316", + "rev": "b0256621cb88178e9ad932a53633077b3029e621", "name": "Qq", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -153,7 +153,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "4453b52d2468f4c346a8711d728c0742e7483c9b", + "rev": "d4c39b228d4a06f3b00748c2c445a7b9f056a6e3", "name": "batteries", "manifestFile": "lake-manifest.json", "inputRev": "main", diff --git a/docbuild/lakefile.toml b/docbuild/lakefile.toml index ed4689727..b9c4092df 100644 --- a/docbuild/lakefile.toml +++ b/docbuild/lakefile.toml @@ -12,4 +12,4 @@ path = ".." [[require]] scope = "leanprover" name = "doc-gen4" -rev = "v4.36.0-rc1" +rev = "v4.36.0-rc2" diff --git a/guide/lake-manifest.json b/guide/lake-manifest.json index b8da10f21..3f19786a0 100644 --- a/guide/lake-manifest.json +++ b/guide/lake-manifest.json @@ -5,10 +5,10 @@ "type": "git", "subDir": null, "scope": "", - "rev": "f7a4dc6867f8df27778b2b320763ec9e3b7be070", + "rev": "71a2035b44e7f54a797ce799fd1b03cdd3a44684", "name": "verso", "manifestFile": "lake-manifest.json", - "inputRev": "v4.36.0-rc1", + "inputRev": "v4.36.0-rc2", "inherited": false, "configFile": "lakefile.lean"}, {"type": "path", @@ -23,7 +23,7 @@ "type": "git", "subDir": null, "scope": "", - "rev": "34d2efffcb6dc8d5f3537cf6a7f88bfaa999ec49", + "rev": "c09cb1e4f1e6e1c231a1175a12b681b075054a1b", "name": "Cli", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -33,7 +33,7 @@ "type": "git", "subDir": null, "scope": "", - "rev": "d22e76ef3d2a925132315af902ea432233b4a44a", + "rev": "758bff3509b8e90ca82e37aa5de81de3c9e70fc0", "name": "illuminate", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -43,7 +43,7 @@ "type": "git", "subDir": null, "scope": "", - "rev": "c2d7840c65673533e15b499f25beecdc6227f7d8", + "rev": "129d1ba9a16bc0660f46c79e9fb041ef5d5d80de", "name": "plausible", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -73,27 +73,27 @@ "type": "git", "subDir": null, "scope": "", - "rev": "f4a472560f78c59bbedd795fe041ec507f7d0582", + "rev": "8a8ad7489cdccb007ad7279bfb9d03bbda2229ad", "name": "cslib", "manifestFile": "lake-manifest.json", - "inputRev": "f4a472560f78c59bbedd795fe041ec507f7d0582", + "inputRev": "8a8ad7489cdccb007ad7279bfb9d03bbda2229ad", "inherited": true, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/mathlib4", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "625d8914199bc567cca9b91f90e8e5afafa5ae51", + "rev": "9d581dfff2e41de989072ea63abf3daf69311520", "name": "mathlib", "manifestFile": "lake-manifest.json", - "inputRev": "v4.36.0-rc1", + "inputRev": "v4.36.0-rc2", "inherited": true, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/LeanSearchClient", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "9d39f9bb0c30aa2f6200808805ff16e6ce950890", + "rev": "c61286b7b63cbfd563b28e11e81d0a18233a044a", "name": "LeanSearchClient", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -103,7 +103,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "b3cc36c295aa5e3e3c0197b09a6556298e710447", + "rev": "b8cc5dd0a36233b88a6ed5a7dbf1207d09338c60", "name": "importGraph", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -113,7 +113,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "17137fad38a2cc782ff00b323a13c3a991d085ab", + "rev": "16259c0d07d61ee37d999d05b5cf96338b8daa11", "name": "proofwidgets", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -123,7 +123,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "cbdde3aa2665915fb286c48bcd4cdf885c629511", + "rev": "7d11bfa88558f8d3d90afdf6bd877ed70001498d", "name": "aesop", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -133,7 +133,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "6d26f8bb4b2bb78f929ad160feac508866821316", + "rev": "b0256621cb88178e9ad932a53633077b3029e621", "name": "Qq", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -143,7 +143,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "4453b52d2468f4c346a8711d728c0742e7483c9b", + "rev": "d4c39b228d4a06f3b00748c2c445a7b9f056a6e3", "name": "batteries", "manifestFile": "lake-manifest.json", "inputRev": "main", diff --git a/guide/lakefile.toml b/guide/lakefile.toml index fb7601692..f62d2a91a 100644 --- a/guide/lakefile.toml +++ b/guide/lakefile.toml @@ -21,7 +21,7 @@ path = ".." [[require]] name = "verso" git = "https://github.com/leanprover/verso" -rev = "v4.36.0-rc1" +rev = "v4.36.0-rc2" [[lean_lib]] name = "ComplexityGuide" diff --git a/lake-manifest.json b/lake-manifest.json index a4892b4fc..a2c1eaffd 100644 --- a/lake-manifest.json +++ b/lake-manifest.json @@ -5,27 +5,27 @@ "type": "git", "subDir": null, "scope": "", - "rev": "f4a472560f78c59bbedd795fe041ec507f7d0582", + "rev": "8a8ad7489cdccb007ad7279bfb9d03bbda2229ad", "name": "cslib", "manifestFile": "lake-manifest.json", - "inputRev": "f4a472560f78c59bbedd795fe041ec507f7d0582", + "inputRev": "8a8ad7489cdccb007ad7279bfb9d03bbda2229ad", "inherited": false, "configFile": "lakefile.toml"}, {"url": "https://github.com/leanprover-community/mathlib4", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "625d8914199bc567cca9b91f90e8e5afafa5ae51", + "rev": "9d581dfff2e41de989072ea63abf3daf69311520", "name": "mathlib", "manifestFile": "lake-manifest.json", - "inputRev": "v4.36.0-rc1", + "inputRev": "v4.36.0-rc2", "inherited": true, "configFile": "lakefile.lean"}, {"url": "https://github.com/leanprover-community/plausible", "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "c2d7840c65673533e15b499f25beecdc6227f7d8", + "rev": "129d1ba9a16bc0660f46c79e9fb041ef5d5d80de", "name": "plausible", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -35,7 +35,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "9d39f9bb0c30aa2f6200808805ff16e6ce950890", + "rev": "c61286b7b63cbfd563b28e11e81d0a18233a044a", "name": "LeanSearchClient", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -45,7 +45,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "b3cc36c295aa5e3e3c0197b09a6556298e710447", + "rev": "b8cc5dd0a36233b88a6ed5a7dbf1207d09338c60", "name": "importGraph", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -55,7 +55,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "17137fad38a2cc782ff00b323a13c3a991d085ab", + "rev": "16259c0d07d61ee37d999d05b5cf96338b8daa11", "name": "proofwidgets", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -65,7 +65,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "cbdde3aa2665915fb286c48bcd4cdf885c629511", + "rev": "7d11bfa88558f8d3d90afdf6bd877ed70001498d", "name": "aesop", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -75,7 +75,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "6d26f8bb4b2bb78f929ad160feac508866821316", + "rev": "b0256621cb88178e9ad932a53633077b3029e621", "name": "Qq", "manifestFile": "lake-manifest.json", "inputRev": "master", @@ -85,7 +85,7 @@ "type": "git", "subDir": null, "scope": "leanprover-community", - "rev": "4453b52d2468f4c346a8711d728c0742e7483c9b", + "rev": "d4c39b228d4a06f3b00748c2c445a7b9f056a6e3", "name": "batteries", "manifestFile": "lake-manifest.json", "inputRev": "main", @@ -95,10 +95,10 @@ "type": "git", "subDir": null, "scope": "leanprover", - "rev": "34d2efffcb6dc8d5f3537cf6a7f88bfaa999ec49", + "rev": "c09cb1e4f1e6e1c231a1175a12b681b075054a1b", "name": "Cli", "manifestFile": "lake-manifest.json", - "inputRev": "v4.36.0-rc1", + "inputRev": "v4.36.0-rc2", "inherited": true, "configFile": "lakefile.toml"}], "name": "complexitylib", diff --git a/lakefile.toml b/lakefile.toml index ce7b8cd77..00f09a874 100644 --- a/lakefile.toml +++ b/lakefile.toml @@ -33,7 +33,7 @@ autoImplicit = false [[require]] name = "cslib" git = "https://github.com/leanprover/cslib" -rev = "f4a472560f78c59bbedd795fe041ec507f7d0582" +rev = "8a8ad7489cdccb007ad7279bfb9d03bbda2229ad" [[lean_lib]] name = "Complexity" diff --git a/lean-toolchain b/lean-toolchain index 2afd38716..0fc433692 100644 --- a/lean-toolchain +++ b/lean-toolchain @@ -1 +1 @@ -leanprover/lean4:v4.36.0-rc1 +leanprover/lean4:v4.36.0-rc2 From 9a1b75416b7723a073411f0ee9a7d2ccfdd49ec9 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Thu, 29 Oct 2026 15:10:24 -0400 Subject: [PATCH 07/12] refactor(probability): use generic infinite-sum lemmas Replace 187 deprecated ENNReal wrapper uses across 55 proof files with their generic counterparts. The exact mapping is: - ENNReal.tsum_le_tsum -> tsum_le_tsum (94) - ENNReal.tsum_add -> tsum_add (54) - ENNReal.tsum_eq_zero -> tsum_eq_zero_iff (14) - ENNReal.summable -> CompleteLattice.summable (6) - ENNReal.tsum_comm -> tsum_comm (6) - ENNReal.tsum_prod' -> tsum_prod' (5) - ENNReal.le_tsum -> le_tsum (5) - ENNReal.tsum_eq_add_tsum_ite -> tsum_eq_add_tsum_ite (2) - ENNReal.tsum_sigma -> tsum_sigma (1) The old wrappers invoke these same theorems specialized to ENNReal. All five le_tsum calls already pass the function by name. No statements or definitions change. --- .../Algorithms/WordRAM/Karger/FastCut.lean | 2 +- .../Algorithms/WordRAM/Karger/Graph.lean | 6 +-- .../Algorithms/WordRAM/KargerMinCut.lean | 2 +- .../Algorithms/WordRAM/KargerStein.lean | 6 +-- .../Computability/Complexity/Classes/IP.lean | 2 +- .../Classes/IP/GraphNonIsomorphism.lean | 2 +- .../Complexity/Classes/IP/Guessing.lean | 6 +-- .../Complexity/Classes/IP/OptimalProver.lean | 8 ++-- .../Complexity/Classes/IP/Repetition.lean | 6 +-- .../LogSpace/Randomized/Amplification.lean | 2 +- .../Complexity/Classes/MIP/OptimalProver.lean | 4 +- .../Complexity/FineGrained/PPSZ/Basic.lean | 2 +- .../Complexity/FineGrained/PPZ.lean | 2 +- .../Computability/Interactive/Plain.lean | 4 +- .../Computability/Kolmogorov/AverageCase.lean | 4 +- .../Computability/PCP/TwoProverGame.lean | 2 +- .../WordRAM/Randomized/Expected.lean | 12 ++--- .../CramerShoup/ProjectiveHash.lean | 4 +- .../Computational/CramerShoup/Scheme.lean | 2 +- .../Crypto/Computational/DiffieHellman.lean | 16 +++---- .../Computational/DiffieHellman/Order.lean | 4 +- .../Encryption/Authenticated.lean | 14 +++--- .../Encryption/EncryptThenMAC.lean | 8 ++-- .../Crypto/Computational/GMW/Soundness.lean | 6 +-- Complexity/Crypto/Computational/MAC.lean | 8 ++-- .../Computational/NaorReingold/Security.lean | 10 ++-- .../Computational/OneWay/LiuPassConverse.lean | 2 +- .../Computational/OneWayToSignature.lean | 6 +-- .../Crypto/Computational/PRGToOneWay.lean | 2 +- .../Computational/PedersenCommitment.lean | 8 ++-- .../Pseudoentropy/MaskedExtraction.lean | 2 +- Complexity/Crypto/Game.lean | 20 ++++---- Complexity/Crypto/Game/UntilBad.lean | 16 +++---- Complexity/Crypto/Primitives/PRG/NextBit.lean | 4 +- .../Crypto/Protocols/Cipher/EvenMansour.lean | 6 +-- .../Crypto/Protocols/Cipher/LubyRackoff.lean | 48 +++++++++---------- .../Crypto/Protocols/MAC/CarterWegman.lean | 16 +++---- .../Protocols/SigmaProtocol/FiatShamir.lean | 6 +-- .../Probabilistic/BoundedUniform.lean | 6 +-- .../Languages/Probabilistic/Expect.lean | 8 ++-- .../Probabilistic/Oracle/Interaction.lean | 2 +- .../Probabilistic/RandomPermutation.lean | 8 ++-- .../Languages/Probabilistic/UntilBad.lean | 10 ++-- .../Languages/Probabilistic/Vector.lean | 2 +- Complexity/Probability/Conditioning.lean | 6 +-- .../Probability/CorrelatedSampling.lean | 2 +- Complexity/Probability/Forking.lean | 2 +- Complexity/Probability/IID.lean | 2 +- Complexity/Probability/MinEntropy.lean | 2 +- Complexity/Probability/Minimax.lean | 4 +- Complexity/Probability/PMF/Bind.lean | 14 +++--- Complexity/Probability/PMF/Event.lean | 16 +++---- Complexity/Probability/PMF/Map.lean | 2 +- .../ProductConditioning/SideInformation.lean | 2 +- Complexity/Probability/RejectionSampling.lean | 4 +- 55 files changed, 186 insertions(+), 186 deletions(-) diff --git a/Complexity/Algorithms/WordRAM/Karger/FastCut.lean b/Complexity/Algorithms/WordRAM/Karger/FastCut.lean index a216c2ae8..30a2afa92 100644 --- a/Complexity/Algorithms/WordRAM/Karger/FastCut.lean +++ b/Complexity/Algorithms/WordRAM/Karger/FastCut.lean @@ -658,7 +658,7 @@ theorem two_branch_hit_prob_ge {α β γ : Type} (m₁ : ProbComp α) (m₂ : α have ha : a ∈ m₁.support := (ProbComp.support_eval m₁) ▸ ha_eval have ha_hit : a ∈ hit₁ := not_not.mp ha_not_miss rw [PMF.toOuterMeasure_map_apply, PMF.toOuterMeasure_apply] - refine ENNReal.tsum_eq_zero.mpr fun b => ?_ + refine tsum_eq_zero_iff.mpr fun b => ?_ by_cases hb_eval : b ∈ (m₂ a).eval.support · have hb : b ∈ (m₂ a).support := (ProbComp.support_eval (m₂ a)) ▸ hb_eval have hmem : f a b ∈ hit := hprop₁ a ha ha_hit b hb diff --git a/Complexity/Algorithms/WordRAM/Karger/Graph.lean b/Complexity/Algorithms/WordRAM/Karger/Graph.lean index 9afa1d805..c03da4013 100644 --- a/Complexity/Algorithms/WordRAM/Karger/Graph.lean +++ b/Complexity/Algorithms/WordRAM/Karger/Graph.lean @@ -1107,7 +1107,7 @@ theorem toOuterMeasure_bind_ge_mul_ennreal {α β : Type*} (p : PMF α) (kernel s₁ * s₂ ≤ p.toOuterMeasure pre * s₂ := mul_le_mul_of_nonneg_right hp zero_le _ ≤ (p.bind kernel).toOuterMeasure event := by rw [PMF.toOuterMeasure_bind_apply, PMF.toOuterMeasure_apply, ← ENNReal.tsum_mul_right] - refine ENNReal.tsum_le_tsum fun a => ?_ + refine tsum_le_tsum fun a => ?_ by_cases ha : a ∈ pre · simp only [Set.indicator_of_mem ha] by_cases hs : a ∈ p.support @@ -1131,7 +1131,7 @@ theorem toOuterMeasure_bind_le_mul_ennreal {α β : Type*} (p : PMF α) (kernel (p.bind kernel).toOuterMeasure failure ≤ p.toOuterMeasure stillFailing * q₂ := by rw [PMF.toOuterMeasure_bind_apply, PMF.toOuterMeasure_apply, ← ENNReal.tsum_mul_right] - refine ENNReal.tsum_le_tsum fun a => ?_ + refine tsum_le_tsum fun a => ?_ by_cases hs : a ∈ p.support · by_cases ha : a ∈ stillFailing · simp only [Set.indicator_of_mem ha] @@ -1146,7 +1146,7 @@ valid on arbitrary types without measurability hypotheses. -/ theorem toOuterMeasure_add_compl_ennreal {α : Type*} (p : PMF α) (s : Set α) : p.toOuterMeasure s + p.toOuterMeasure sᶜ = 1 := by classical - rw [PMF.toOuterMeasure_apply, PMF.toOuterMeasure_apply, ← ENNReal.tsum_add] + rw [PMF.toOuterMeasure_apply, PMF.toOuterMeasure_apply, ← tsum_add] have hpt : (fun x => s.indicator p x + sᶜ.indicator p x) = p := by ext x by_cases hx : x ∈ s <;> simp [hx] diff --git a/Complexity/Algorithms/WordRAM/KargerMinCut.lean b/Complexity/Algorithms/WordRAM/KargerMinCut.lean index b3ef003a5..c07c84a3c 100644 --- a/Complexity/Algorithms/WordRAM/KargerMinCut.lean +++ b/Complexity/Algorithms/WordRAM/KargerMinCut.lean @@ -1181,7 +1181,7 @@ theorem ampLoop_spec {w sb n R : ℕ} {W : Fin n → Fin n → ℕ} {mem₀ : obtain ⟨m_r, hm_r, _, hsup_r, _⟩ := hnext z₁ hz₁ rw [hml_def, hm_r.codeComp_eq, PMF.toOuterMeasure_map_apply, PMF.toOuterMeasure_apply] - convert ENNReal.tsum_eq_zero.mpr _ + convert tsum_eq_zero_iff.mpr _ intro z₂ by_cases hz₂_eval : z₂ ∈ m_r.eval.support · have hz₂ : z₂ ∈ m_r.support := (ProbComp.support_eval m_r) ▸ hz₂_eval diff --git a/Complexity/Algorithms/WordRAM/KargerStein.lean b/Complexity/Algorithms/WordRAM/KargerStein.lean index 92368fc36..5a2a42a1a 100644 --- a/Complexity/Algorithms/WordRAM/KargerStein.lean +++ b/Complexity/Algorithms/WordRAM/KargerStein.lean @@ -168,7 +168,7 @@ private theorem toOuterMeasure_mono_support {α : Type} (m : ProbComp α) {S T : m.eval.toOuterMeasure S ≤ m.eval.toOuterMeasure T := by classical rw [PMF.toOuterMeasure_apply, PMF.toOuterMeasure_apply] - refine ENNReal.tsum_le_tsum fun a => ?_ + refine tsum_le_tsum fun a => ?_ by_cases ha : a ∈ S · simp only [Set.indicator_of_mem ha] by_cases hs : a ∈ m.support @@ -2684,7 +2684,7 @@ theorem fastCutNode_spec {n w : ℕ} {W₀ : Fin n → Fin n → ℕ} have hcompl0 : (ms2_fn z₂.1).eval.toOuterMeasure {zs | zs.1.regs retVal = minCut W₀}ᶜ = 0 := by rw [PMF.toOuterMeasure_apply] - refine ENNReal.tsum_eq_zero.mpr fun zs => ?_ + refine tsum_eq_zero_iff.mpr fun zs => ?_ by_cases hzs_ev : zs ∈ (ms2_fn z₂.1).eval.support · have hzs : zs ∈ (ms2_fn z₂.1).support := (ProbComp.support_eval (ms2_fn z₂.1)) ▸ hzs_ev @@ -3679,7 +3679,7 @@ theorem fastCutAmpLoop_spec {w sb n R : ℕ} {W : Fin n → Fin n → ℕ} {mem have hbv₁ : z₁.1.regs bestVal = minCut W := not_not.mp hhit obtain ⟨m_r, hm_r, _, hsup_r, _⟩ := hnext z₁ hz₁ rw [hml_def, hm_r.codeComp_eq, PMF.toOuterMeasure_map_apply, PMF.toOuterMeasure_apply] - refine ENNReal.tsum_eq_zero.mpr fun z₂ => ?_ + refine tsum_eq_zero_iff.mpr fun z₂ => ?_ by_cases hz₂_eval : z₂ ∈ m_r.eval.support · have hz₂ : z₂ ∈ m_r.support := (ProbComp.support_eval m_r) ▸ hz₂_eval have hbv₂ : z₂.1.regs bestVal = minCut W := diff --git a/Complexity/Computability/Complexity/Classes/IP.lean b/Complexity/Computability/Complexity/Classes/IP.lean index d2c73a5bc..d583e0f90 100644 --- a/Complexity/Computability/Complexity/Classes/IP.lean +++ b/Complexity/Computability/Complexity/Classes/IP.lean @@ -148,7 +148,7 @@ theorem acceptProb_eq_acceptProbWith (verifier : WordOracleComp Operation Bool) /-- The acceptance probability sums the masses of the accepting outcomes over final states. -/ theorem acceptProb_eq_tsum (verifier : WordOracleComp Operation Bool) (P : Prover Operation) : acceptProb verifier P = ∑' s, P.run verifier P.init (true, s) := by - rw [acceptProb, PMF.map_apply, ENNReal.tsum_prod', tsum_bool] + rw [acceptProb, PMF.map_apply, tsum_prod', tsum_bool] simp /-- Private coins drawn before any message average the acceptance probabilities of the diff --git a/Complexity/Computability/Complexity/Classes/IP/GraphNonIsomorphism.lean b/Complexity/Computability/Complexity/Classes/IP/GraphNonIsomorphism.lean index dfce7de33..659f372bf 100644 --- a/Complexity/Computability/Complexity/Classes/IP/GraphNonIsomorphism.lean +++ b/Complexity/Computability/Complexity/Classes/IP/GraphNonIsomorphism.lean @@ -413,7 +413,7 @@ private theorem card_filter_not_injective_div_le (n : ℕ) : private theorem tsum_map_mul {β γ : Type*} (μ : PMF β) (m : β → γ) (f : γ → ENNReal) : ∑' c, μ.map m c * f c = ∑' b, μ b * f (m b) := by simp only [PMF.map_apply, ENNReal.tsum_mul_right.symm] - rw [ENNReal.tsum_comm] + rw [tsum_comm] refine tsum_congr fun b => ?_ rw [tsum_eq_single (m b)] · simp diff --git a/Complexity/Computability/Complexity/Classes/IP/Guessing.lean b/Complexity/Computability/Complexity/Classes/IP/Guessing.lean index 6eaedc8da..02e8929d3 100644 --- a/Complexity/Computability/Complexity/Classes/IP/Guessing.lean +++ b/Complexity/Computability/Complexity/Classes/IP/Guessing.lean @@ -77,8 +77,8 @@ noncomputable def Prover.guessProb (P : Prover Unit) (s : P.State) (m : List Boo theorem Prover.guessProb_add_le_one (P : Prover Unit) (s : P.State) (m : List Bool) : P.guessProb s m false + P.guessProb s m true ≤ 1 := by simp only [Prover.guessProb, PMF.map_apply] - rw [← ENNReal.tsum_add, ← PMF.tsum_coe ((P.respond ((), m)).run s)] - refine ENNReal.tsum_le_tsum fun y => ?_ + rw [← tsum_add, ← PMF.tsum_coe ((P.respond ((), m)).run s)] + refine tsum_le_tsum fun y => ?_ by_cases h : List.take 1 y.1 = [false] · simp [h] · by_cases h' : List.take 1 y.1 = [true] <;> simp [h, h'] @@ -120,7 +120,7 @@ theorem acceptProb_guessingRound_le {message : Bool → ProbComp (List Bool)} { exact hclose _ fun m => PMF.coe_le_one _ _ _ = ∑' m, ProbComp.eval (message false) m * (P.guessProb P.init m false + P.guessProb P.init m true) + δ := by - rw [← add_assoc, ← ENNReal.tsum_add] + rw [← add_assoc, ← tsum_add] simp only [mul_add] _ ≤ 1 + δ := by gcongr diff --git a/Complexity/Computability/Complexity/Classes/IP/OptimalProver.lean b/Complexity/Computability/Complexity/Classes/IP/OptimalProver.lean index 3ad366c14..7fd4eec66 100644 --- a/Complexity/Computability/Complexity/Classes/IP/OptimalProver.lean +++ b/Complexity/Computability/Complexity/Classes/IP/OptimalProver.lean @@ -304,7 +304,7 @@ private theorem sum_acceptFrom_after_le (hF : IsBounded F D L) (P : Prover Unit) lia rw [Finset.sum_eq_zero fun m _ => ?_, add_zero] · split_ifs <;> simp - · refine ENNReal.tsum_eq_zero.mpr fun ys => ?_ + · refine tsum_eq_zero_iff.mpr fun ys => ?_ rw [after_append] unfold outcome at hnil rcases hah : after (F r) h with _ | ⟨b⟩ | ⟨q, next⟩ @@ -320,12 +320,12 @@ private theorem sum_acceptFrom_after_le (hF : IsBounded F D L) (P : Prover Unit) exact (Finset.sum_congr rfl fun r _ => by split_ifs <;> simp).le rw [Finset.sum_comm] refine Finset.sum_le_sum fun m _ => ?_ - rw [← Summable.tsum_finsetSum fun r _ => ENNReal.summable] + rw [← Summable.tsum_finsetSum fun r _ => CompleteLattice.summable] calc ∑' ys : List Bool × P.State, ∑ r, (P.respond ((), m)).run s ys * acceptFrom P ys.2 (after (F r) (h ++ [(m, ys.1)])) ≤ ∑' ys : List Bool × P.State, (P.respond ((), m)).run s ys * ((BitString.shortWords L).sup fun y => value F L n (h ++ [(m, y)]) : ℕ) := by - refine ENNReal.tsum_le_tsum fun ys => ?_ + refine tsum_le_tsum fun ys => ?_ rw [← Finset.mul_sum] refine mul_le_mul_right ?_ _ refine (ih (h ++ [(m, ys.1)]) (by @@ -395,7 +395,7 @@ private theorem sum_acceptFrom_optimalProver_after (hF : IsBounded F D L) (n : lia rw [Finset.sum_eq_zero fun m _ => ?_, add_zero] · split_ifs <;> simp - · refine ENNReal.tsum_eq_zero.mpr fun ys => ?_ + · refine tsum_eq_zero_iff.mpr fun ys => ?_ rw [after_append] unfold outcome at hnil rcases hah : after (F r) h with _ | ⟨b⟩ | ⟨q, next⟩ diff --git a/Complexity/Computability/Complexity/Classes/IP/Repetition.lean b/Complexity/Computability/Complexity/Classes/IP/Repetition.lean index 66023d528..77f8fb503 100644 --- a/Complexity/Computability/Complexity/Classes/IP/Repetition.lean +++ b/Complexity/Computability/Complexity/Classes/IP/Repetition.lean @@ -64,7 +64,7 @@ private theorem acceptProb_bind_ite (P : Prover Operation) acceptProb (do let ok ← round; if ok then rest else pure false) P = ∑' s, P.run round P.init (true, s) * acceptProb rest { P with init := s } := by simp only [acceptProb, Prover.run_bind, PMF.map_bind] - rw [PMF.bind_apply, ENNReal.tsum_prod', tsum_bool] + rw [PMF.bind_apply, tsum_prod', tsum_bool] simp only [Bool.false_eq_true, Bool.true_eq_false, ↓reduceIte, Prover.run_pure, PMF.pure_map, PMF.pure_apply, mul_zero, tsum_zero, zero_add] rfl @@ -81,7 +81,7 @@ theorem acceptProb_sequentialRepeat_le {round : WordOracleComp Operation Bool} { calc ∑' s, P.run round P.init (true, s) * acceptProb (sequentialRepeat k round) { P with init := s } ≤ ∑' s, P.run round P.init (true, s) * ε ^ k := - ENNReal.tsum_le_tsum fun s => mul_le_mul' le_rfl (ih _) + tsum_le_tsum fun s => mul_le_mul' le_rfl (ih _) _ = (∑' s, P.run round P.init (true, s)) * ε ^ k := ENNReal.tsum_mul_right _ ≤ ε * ε ^ k := by gcongr @@ -103,7 +103,7 @@ theorem le_acceptProb_sequentialRepeat {round : WordOracleComp Operation Bool} { gcongr exact (h s).trans_eq (acceptProb_eq_tsum round _) _ = ∑' s', P.run round s (true, s') * c ^ k := ENNReal.tsum_mul_right.symm - _ ≤ _ := ENNReal.tsum_le_tsum fun s' => mul_le_mul' le_rfl (ih s') + _ ≤ _ := tsum_le_tsum fun s' => mul_le_mul' le_rfl (ih s') /-- A constant number of sequential runs of a strict oracle PPT verifier is strict oracle PPT. -/ theorem isOraclePPTOn_sequentialRepeat [DecidableEq Operation] [Finite Operation] diff --git a/Complexity/Computability/Complexity/Classes/LogSpace/Randomized/Amplification.lean b/Complexity/Computability/Complexity/Classes/LogSpace/Randomized/Amplification.lean index 1c3606355..56fd01273 100644 --- a/Complexity/Computability/Complexity/Classes/LogSpace/Randomized/Amplification.lean +++ b/Complexity/Computability/Complexity/Classes/LogSpace/Randomized/Amplification.lean @@ -126,7 +126,7 @@ theorem eval_runClosed_orElse_apply (h₁ : first.toNTM.RunsInTime input t₁) exact congrArg _ (PMF.pure_apply_self _) · rw [add_zero] _ = q + ProbComp.eval (first.runClosed t₁ input) [true] * (1 - q) := by - rw [ENNReal.tsum_add, ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul, tsum_ite_eq] + rw [tsum_add, ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul, tsum_ite_eq] /-- **Rejections multiply under `orElse`.** Counted on coin strings, the probability that `first.orElse second` does not accept is the product of the probabilities that `first` and diff --git a/Complexity/Computability/Complexity/Classes/MIP/OptimalProver.lean b/Complexity/Computability/Complexity/Classes/MIP/OptimalProver.lean index ebf6834a9..0f1a57869 100644 --- a/Complexity/Computability/Complexity/Classes/MIP/OptimalProver.lean +++ b/Complexity/Computability/Complexity/Classes/MIP/OptimalProver.lean @@ -581,7 +581,7 @@ private theorem tsum_mul_le_bestOfList (μ : PMF α) (g : α → ℝ≥0∞) (de ∑' x, μ x * g x ≤ g (bestOfList g default l) := by calc ∑' x, μ x * g x ≤ ∑' x, μ x * g (bestOfList g default l) := by - refine ENNReal.tsum_le_tsum fun x => ?_ + refine tsum_le_tsum fun x => ?_ by_cases hx : x ∈ μ.support · exact mul_le_mul_right (le_bestOfList g default l (hsupp x hx)) (μ x) · rw [PMF.mem_support_iff, not_not] at hx @@ -618,7 +618,7 @@ theorem exists_deterministic_prover_family [Finite ι] [DecidableEq ι] {γ : Ty rw [run_eq_bind_piPresample (hF c) P (fun _ => d) (fun _ => le_rfl) (Prover.independent P).init, PMF.bind_apply] simp only [hc, ← ENNReal.tsum_mul_left] - rw [← Summable.tsum_finsetSum fun _ _ => ENNReal.summable] + rw [← Summable.tsum_finsetSum fun _ _ => CompleteLattice.summable] refine tsum_congr fun f => ?_ rw [Finset.mul_sum] exact Finset.sum_congr rfl fun c _ => by rw [mul_left_comm] diff --git a/Complexity/Computability/Complexity/FineGrained/PPSZ/Basic.lean b/Complexity/Computability/Complexity/FineGrained/PPSZ/Basic.lean index e47a1f654..a73035873 100644 --- a/Complexity/Computability/Complexity/FineGrained/PPSZ/Basic.lean +++ b/Complexity/Computability/Complexity/FineGrained/PPSZ/Basic.lean @@ -276,7 +276,7 @@ theorem ppz_round_apply_le {φ : CNF (Fin n)} {w : ℕ} (hw : 1 ≤ w) {σ : Fin (hσ : φ.eval σ = true) : PPZ.round φ (fun x => some (σ x)) ≤ round φ w (fun x => some (σ x)) := by rw [PPZ.round, round, PPZ.roundWith, PPZ.roundWith, PMF.bind_apply, PMF.bind_apply] - refine ENNReal.tsum_le_tsum fun π => mul_le_mul_right ?_ _ + refine tsum_le_tsum fun π => mul_le_mul_right ?_ _ rw [← PPZ.restrict_prefixSet_self σ π] rw [PPZ.runWith_apply_restrict (O := PPZ.forced φ) (fun _ hτ _ _ h => PPZ.forced_eq hσ hτ h) π le_rfl, PPZ.runWith_apply_restrict (O := implied φ w) (fun _ hτ _ _ h => implied_eq hσ hτ h) π diff --git a/Complexity/Computability/Complexity/FineGrained/PPZ.lean b/Complexity/Computability/Complexity/FineGrained/PPZ.lean index 29084952a..a7c4fa2c3 100644 --- a/Complexity/Computability/Complexity/FineGrained/PPZ.lean +++ b/Complexity/Computability/Complexity/FineGrained/PPZ.lean @@ -458,7 +458,7 @@ theorem runWith_apply_restrict {O : (Fin n → Option Bool) → Fin n → Option by_cases hsupp : τ ∈ (runWith O π i).support · rw [PMF.map_apply] convert mul_zero _ - refine ENNReal.tsum_eq_zero.mpr fun b => ite_eq_right fun e => hτ ?_ + refine tsum_eq_zero_iff.mpr fun b => ite_eq_right fun e => hτ ?_ funext y by_cases hy : y = x · subst hy diff --git a/Complexity/Computability/Interactive/Plain.lean b/Complexity/Computability/Interactive/Plain.lean index 23a157b84..822083780 100644 --- a/Complexity/Computability/Interactive/Plain.lean +++ b/Complexity/Computability/Interactive/Plain.lean @@ -201,9 +201,9 @@ private theorem rbrFrom_le : ∀ (s : Spec) (smp : PerChallenge ProbComp s) st' calc ∑' c, ProbComp.eval smp.1 c * _ ≤ ∑' c, ProbComp.eval smp.1 c * (A.indicator 1 c + PerChallenge.sum s ε.2) := - ENNReal.tsum_le_tsum fun c => by gcongr; exact hinner c + tsum_le_tsum fun c => by gcongr; exact hinner c _ = (ProbComp.eval smp.1).toOuterMeasure A + PerChallenge.sum s ε.2 := by - simp only [mul_add, ENNReal.tsum_add, ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul, + simp only [mul_add, tsum_add, ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul, PMF.toOuterMeasure_apply] congr 1 refine tsum_congr fun c => ?_ diff --git a/Complexity/Computability/Kolmogorov/AverageCase.lean b/Complexity/Computability/Kolmogorov/AverageCase.lean index 0ead74cf0..86083ba86 100644 --- a/Complexity/Computability/Kolmogorov/AverageCase.lean +++ b/Complexity/Computability/Kolmogorov/AverageCase.lean @@ -277,7 +277,7 @@ private theorem pmf_map_true_le_one_sub_of_imp_false {α : Type*} (q : PMF α) ( ((q.map P) true).toReal ≤ 1 - ((q.map Q) true).toReal := by have hle : (q.map P) true ≤ (q.map Q) false := by rw [PMF.map_apply, PMF.map_apply] - refine ENNReal.tsum_le_tsum fun v => ?_ + refine tsum_le_tsum fun v => ?_ by_cases hp : P v = true · have hq : Q v = false := hdisj v hp simp [hp, hq] @@ -292,7 +292,7 @@ private theorem pmf_map_true_le_of_imp_true {α : Type*} (q : PMF α) (P Q : α ((q.map P) true).toReal ≤ ((q.map Q) true).toReal := by apply ENNReal.toReal_mono (PMF.apply_ne_top _ _) rw [PMF.map_apply, PMF.map_apply] - refine ENNReal.tsum_le_tsum fun v => ?_ + refine tsum_le_tsum fun v => ?_ by_cases hp : P v = true · have hq : Q v = true := himp v hp simp [hp, hq] diff --git a/Complexity/Computability/PCP/TwoProverGame.lean b/Complexity/Computability/PCP/TwoProverGame.lean index d918d1eba..e742d8fc8 100644 --- a/Complexity/Computability/PCP/TwoProverGame.lean +++ b/Complexity/Computability/PCP/TwoProverGame.lean @@ -117,7 +117,7 @@ theorem winProb_shared_le_value [Nonempty A] [Nonempty B] {R : Type*} (ρ : PMF exact ENNReal.ofReal_le_ofReal (G.winProb_le_value (fun x => ha x r) (fun y => hb y r)) calc ∑' r, ρ r * (G.questions.map fun q => (q, ha q.1 r, hb q.2 r)).toOuterMeasure {z | G.accepts z.1.1 z.1.2 z.2.1 z.2.2} - ≤ ∑' r, ρ r * ENNReal.ofReal G.value := ENNReal.tsum_le_tsum fun r => by gcongr; exact hr r + ≤ ∑' r, ρ r * ENNReal.ofReal G.value := tsum_le_tsum fun r => by gcongr; exact hr r _ = ENNReal.ofReal G.value := by rw [ENNReal.tsum_mul_right, ρ.tsum_coe, one_mul] end Finite diff --git a/Complexity/Computability/WordRAM/Randomized/Expected.lean b/Complexity/Computability/WordRAM/Randomized/Expected.lean index 7d9e1844a..4f1881163 100644 --- a/Complexity/Computability/WordRAM/Randomized/Expected.lean +++ b/Complexity/Computability/WordRAM/Randomized/Expected.lean @@ -117,7 +117,7 @@ theorem evalRand_haltedSet_mono (w : ℕ) (p : Program B r) (s : State r) : rw [evalRand, runRand_add w p T 1, ProbComp.eval_bind] simp only [evalRand, runRand_succ, runRand_zero, bind_pure] rw [hstep, PMF.toOuterMeasure_bind_apply, PMF.toOuterMeasure_apply] - refine ENNReal.tsum_le_tsum fun cfg => ?_ + refine tsum_le_tsum fun cfg => ?_ by_cases hcfg : cfg ∈ RandCfg.haltedSet r · have hmem := hcfg obtain ⟨v, d, rfl⟩ := hcfg @@ -139,7 +139,7 @@ theorem RandHaltsWithin.almostSurelyHalts {w T : ℕ} {p : Program B r} {s : Sta exact hnot (h cfg hmem) have hsum : (evalRand w p T s).toOuterMeasure (RandCfg.haltedSet r) + (evalRand w p T s).toOuterMeasure (RandCfg.haltedSet r)ᶜ = 1 := by - rw [PMF.toOuterMeasure_apply, PMF.toOuterMeasure_apply, ← ENNReal.tsum_add] + rw [PMF.toOuterMeasure_apply, PMF.toOuterMeasure_apply, ← tsum_add] convert (evalRand w p T s).tsum_coe using 1 congr 1 funext cfg @@ -172,7 +172,7 @@ theorem expectedStepsFrom_faulted (w : ℕ) (p : Program B r) : private theorem tsum_nat_eq_zero_add (g : ℕ → ℝ≥0∞) : ∑' t : ℕ, g t = g 0 + ∑' t : ℕ, g (t + 1) := by - rw [ENNReal.tsum_eq_add_tsum_ite (f := g) 0] + rw [tsum_eq_add_tsum_ite (f := g) 0] congr 1 have hsh := Function.Injective.tsum_eq Nat.succ_injective (f := fun t => if t = 0 then 0 else g t) fun t ht => by @@ -199,7 +199,7 @@ theorem expectedStepsFrom_running (w : ℕ) (p : Program B r) (s : State r) : intro t rw [runRand_succ, ProbComp.eval_bind, PMF.toOuterMeasure_bind_apply] simp only [hsucc] - rw [ENNReal.tsum_comm] + rw [tsum_comm] simp only [ProbComp.expect, expectedStepsFrom, ENNReal.tsum_mul_left] /-- Under `RandFaultFree`, every horizon partitions probability `1` between `.running` and @@ -208,7 +208,7 @@ theorem RandFaultFree.running_add_halted_eq_one {w : ℕ} {p : Program B r} {s : (hf : RandFaultFree w p s) (t : ℕ) : (evalRand w p t s).toOuterMeasure {cfg | ∃ u, cfg = .running u} + (evalRand w p t s).toOuterMeasure (RandCfg.haltedSet r) = 1 := by - rw [PMF.toOuterMeasure_apply, PMF.toOuterMeasure_apply, ← ENNReal.tsum_add] + rw [PMF.toOuterMeasure_apply, PMF.toOuterMeasure_apply, ← tsum_add] convert (evalRand w p t s).tsum_coe using 1 congr 1 funext cfg @@ -242,7 +242,7 @@ theorem AlmostSurelyHalts.of_expectedTime_ne_top {w : ℕ} {p : Program B r} {s have hinf : (⊤ : ℝ≥0∞) ≤ expectedTime w p s := by calc (⊤ : ℝ≥0∞) = ∑' _ : ℕ, (1 - supH) := (ENNReal.tsum_const_eq_top_of_ne_zero hpos.ne').symm - _ ≤ expectedTime w p s := ENNReal.tsum_le_tsum hle_run + _ ≤ expectedTime w p s := tsum_le_tsum hle_run exact htop (top_unique hinf) /-- Under `RandHaltsWithin w p s T`, the active-configuration tail sum vanishes from `T` onward and diff --git a/Complexity/Crypto/Computational/CramerShoup/ProjectiveHash.lean b/Complexity/Crypto/Computational/CramerShoup/ProjectiveHash.lean index 09e298a66..c52fe95e6 100644 --- a/Complexity/Crypto/Computational/CramerShoup/ProjectiveHash.lean +++ b/Complexity/Crypto/Computational/CramerShoup/ProjectiveHash.lean @@ -555,8 +555,8 @@ theorem uniform_projHash2_fiber_any_le (d : F.Desc) [DecidableEq (F.Carrier d)] have hor : (μ.map (fun τ₂ => (q :: qs).any (fun q' => hit q' τ₂))) true ≤ (μ.map (hit q)) true + (μ.map (fun τ₂ => qs.any (fun q' => hit q' τ₂))) true := by - simp only [List.any_cons, PMF.map_apply, ← ENNReal.tsum_add] - refine ENNReal.tsum_le_tsum fun τ₂ => ?_ + simp only [List.any_cons, PMF.map_apply, ← tsum_add] + refine tsum_le_tsum fun τ₂ => ?_ cases hit q τ₂ <;> cases qs.any (fun q' => hit q' τ₂) <;> simp have hsingle : (μ.map (hit q)) true = (F.order d : ℝ≥0∞)⁻¹ := by have heq : diff --git a/Complexity/Crypto/Computational/CramerShoup/Scheme.lean b/Complexity/Crypto/Computational/CramerShoup/Scheme.lean index 58a4a0937..0e6744c8c 100644 --- a/Complexity/Crypto/Computational/CramerShoup/Scheme.lean +++ b/Complexity/Crypto/Computational/CramerShoup/Scheme.lean @@ -1008,7 +1008,7 @@ private theorem tsum_and_isCramerShoupBadDH_le rw [hpre, Bool.true_and, ← hvElem, ← hwElem, encodeProjHash2_encode, he_equiv τ] rw [hbad_eq] cases cond <;> cases F.encode d (e_equiv τ • F.generator d) == parts.2.2.2 <;> simp - exact (ENNReal.tsum_le_tsum fun τ => + exact (tsum_le_tsum fun τ => mul_le_mul_of_nonneg_left (hle τ) zero_le).trans (F.tsum_uniform_smul_generator_eq e_equiv parts.2.2.2) · simp only [Bool.not_eq_true] at hpre diff --git a/Complexity/Crypto/Computational/DiffieHellman.lean b/Complexity/Crypto/Computational/DiffieHellman.lean index 00a002fc8..2f8a35c45 100644 --- a/Complexity/Crypto/Computational/DiffieHellman.lean +++ b/Complexity/Crypto/Computational/DiffieHellman.lean @@ -173,14 +173,14 @@ theorem succProbability_discreteLogGame_le_cdhGame (setup : ℕ → PMF F.Desc) simp only [discreteLogGame, cdhGame, dlToCDHAdversary, ProbComp.eval_bind, ProbComp.eval_pure, PMF.monad_bind_eq_bind, PMF.monad_pure_eq_pure, PMF.bind_bind, PMF.pure_bind] rw [PMF.bind_apply, PMF.bind_apply] - refine ENNReal.tsum_le_tsum fun d => mul_le_mul_of_nonneg_left ?_ zero_le + refine tsum_le_tsum fun d => mul_le_mul_of_nonneg_left ?_ zero_le rw [PMF.bind_apply, PMF.bind_apply] - refine ENNReal.tsum_le_tsum fun α => mul_le_mul_of_nonneg_left ?_ zero_le + refine tsum_le_tsum fun α => mul_le_mul_of_nonneg_left ?_ zero_le rw [← PMF.bind_const (PMF.uniformOfFintype (ZMod (F.order d))) ((ProbComp.eval (adversary n (d, F.encode d (α • F.generator d)))).bind _)] rw [PMF.bind_apply, PMF.bind_apply] - refine ENNReal.tsum_le_tsum fun β => mul_le_mul_of_nonneg_left ?_ zero_le - refine ENNReal.tsum_le_tsum fun guess => mul_le_mul_of_nonneg_left ?_ zero_le + refine tsum_le_tsum fun β => mul_le_mul_of_nonneg_left ?_ zero_le + refine tsum_le_tsum fun guess => mul_le_mul_of_nonneg_left ?_ zero_le by_cases hα : (ofBits guess : ZMod (F.order d)) = α · simp only [hα, F.smul_encode, smul_smul, decide_true, le_rfl] · simp only [hα, decide_false, PMF.pure_apply, Bool.true_eq_false, ↓reduceIte, zero_le] @@ -301,7 +301,7 @@ theorem ddhIdealGame_cdhToDDHDistinguisher_true_le (setup : ℕ → PMF F.Desc) fun guess => PMF.pure (decide (guess = F.encode d (γ • F.generator d)))) true ≤ ∑' d, setup n d * (m : ℝ≥0∞)⁻¹ := by - refine ENNReal.tsum_le_tsum fun d => ?_ + refine tsum_le_tsum fun d => ?_ by_cases hd : d ∈ (setup n).support · refine mul_le_mul_of_nonneg_left ?_ zero_le have hord : (F.order d : ℝ≥0∞)⁻¹ ≤ (m : ℝ≥0∞)⁻¹ := @@ -315,8 +315,8 @@ theorem ddhIdealGame_cdhToDDHDistinguisher_true_le (setup : ℕ → PMF F.Desc) PMF.pure (decide (guess = F.encode d (γ • F.generator d)))) true ≤ ∑' α, PMF.uniformOfFintype (ZMod (F.order d)) α * ∑' β, PMF.uniformOfFintype (ZMod (F.order d)) β * (m : ℝ≥0∞)⁻¹ := by - refine ENNReal.tsum_le_tsum fun α => mul_le_mul_of_nonneg_left ?_ zero_le - refine ENNReal.tsum_le_tsum fun β => mul_le_mul_of_nonneg_left ?_ zero_le + refine tsum_le_tsum fun α => mul_le_mul_of_nonneg_left ?_ zero_le + refine tsum_le_tsum fun β => mul_le_mul_of_nonneg_left ?_ zero_le rw [PMF.bind_comm, PMF.bind_apply] calc ∑' guess, ProbComp.eval (adversary n (d, F.encode d (α • F.generator d), F.encode d (β • F.generator d))) guess * @@ -325,7 +325,7 @@ theorem ddhIdealGame_cdhToDDHDistinguisher_true_le (setup : ℕ → PMF F.Desc) ≤ ∑' guess, ProbComp.eval (adversary n (d, F.encode d (α • F.generator d), F.encode d (β • F.generator d))) guess * (m : ℝ≥0∞)⁻¹ := by - refine ENNReal.tsum_le_tsum fun guess => + refine tsum_le_tsum fun guess => mul_le_mul_of_nonneg_left ((F.uniform_decide_eq_encode_le d guess).trans hord) zero_le _ = (m : ℝ≥0∞)⁻¹ := by rw [ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul] diff --git a/Complexity/Crypto/Computational/DiffieHellman/Order.lean b/Complexity/Crypto/Computational/DiffieHellman/Order.lean index b0a3dbafa..478cd484b 100644 --- a/Complexity/Crypto/Computational/DiffieHellman/Order.lean +++ b/Complexity/Crypto/Computational/DiffieHellman/Order.lean @@ -138,7 +138,7 @@ private theorem expected_inv_order_le_two_mul_advantage_ddh (F : PrimeOrderGroup (((F.order d - 1 : ℕ) : ℝ≥0∞) * ((F.order d : ℝ≥0∞)⁻¹ * (F.order d : ℝ≥0∞)⁻¹))) := by dsimp only [ddhRealGame, ddhZeroDistinguisher] simp only [ProbComp.eval_pure, PMF.monad_bind_eq_bind, PMF.bind_apply] - rw [← ENNReal.tsum_add] + rw [← tsum_add] refine tsum_congr fun d => ?_ have hstep : (∑' α, PMF.uniformOfFintype (ZMod (F.order d)) α * @@ -164,7 +164,7 @@ private theorem expected_inv_order_le_two_mul_advantage_ddh (F : PrimeOrderGroup 2 * ∑' d, setup n d * (((F.order d - 1 : ℕ) : ℝ≥0∞) * ((F.order d : ℝ≥0∞)⁻¹ * (F.order d : ℝ≥0∞)⁻¹)) := by rw [← ENNReal.tsum_mul_left] - refine ENNReal.tsum_le_tsum fun d => ?_ + refine tsum_le_tsum fun d => ?_ rw [← mul_assoc, mul_comm (2 : ℝ≥0∞) (setup n d), mul_assoc] refine mul_le_mul_of_nonneg_left ?_ zero_le have hq2 : 2 ≤ F.order d := (F.prime_order d).two_le diff --git a/Complexity/Crypto/Computational/Encryption/Authenticated.lean b/Complexity/Crypto/Computational/Encryption/Authenticated.lean index a177011ae..951e29dce 100644 --- a/Complexity/Crypto/Computational/Encryption/Authenticated.lean +++ b/Complexity/Crypto/Computational/Encryption/Authenticated.lean @@ -1662,7 +1662,7 @@ private theorem ennreal_tsum_finsetSum {α β : Type*} induction s using Finset.induction_on with | empty => simp | insert b s hb ih => - simp only [Finset.sum_insert hb, ENNReal.tsum_add, ih] + simp only [Finset.sum_insert hb, tsum_add, ih] private theorem eval_ccaRejectWithBadOracle_false (E : SymmetricCipher) (n : ℕ) (k : List Bool) (bit : Bool) (request : Bool × List Bool) (queried : List (List Bool)) : @@ -1761,7 +1761,7 @@ private theorem bad_ccaRejectWithBad_le_sum_ciCombined {α : Type} (E : Symmetri (fun x => PMF.pure (!x.2.2.contains x.2.1.2.2 && (E.decrypt n k x.2.1.2.2).isSome)) true := - ENNReal.tsum_le_tsum fun a => mul_le_mul_of_nonneg_left (ih a queried) zero_le + tsum_le_tsum fun a => mul_le_mul_of_nonneg_left (ih a queried) zero_le _ = _ := by simp only [Finset.mul_sum] rw [ennreal_tsum_finsetSum] @@ -1818,7 +1818,7 @@ private theorem bad_ccaRejectWithBad_le_sum_ciCombined {α : Type} (E : Symmetri PMF.pure (!x.2.2.contains x.2.1.2.2 && (E.decrypt n k x.2.1.2.2).isSome)) true := - ENNReal.tsum_le_tsum fun ct => + tsum_le_tsum fun ct => mul_le_mul_of_nonneg_left (ih ct (ct :: queried)) zero_le _ = _ := by simp only [Finset.mul_sum] @@ -1993,8 +1993,8 @@ private theorem advantage_ccaGame_ccaRejectGame_le_sum (E : SymmetricCipher) (ct ProbOracleComp.eval_run_interpret, hrejEq] exact PMF.bind_apply _ _ _ have hle1 : pCCA ≤ pRej + pSum := by - rw [hCCA_eq, hRej_eq, hsum_eq, ← ENNReal.tsum_add] - refine ENNReal.tsum_le_tsum fun k => ?_ + rw [hCCA_eq, hRej_eq, hsum_eq, ← tsum_add] + refine tsum_le_tsum fun k => ?_ rw [← mul_add] by_cases hk : k ∈ (ProbComp.eval (E.keyGen n)).support · refine mul_le_mul_of_nonneg_left ?_ zero_le @@ -2007,8 +2007,8 @@ private theorem advantage_ccaGame_ccaRejectGame_le_sum (E : SymmetricCipher) (ct rw [eval_ciGame_ccaToCIAtIndexAdversary_key E ctBound j bit adversary n k hk hctBound] · rw [(PMF.apply_eq_zero_iff _ _).mpr hk, zero_mul, zero_mul] have hle2 : pRej ≤ pCCA + pSum := by - rw [hCCA_eq, hRej_eq, hsum_eq, ← ENNReal.tsum_add] - refine ENNReal.tsum_le_tsum fun k => ?_ + rw [hCCA_eq, hRej_eq, hsum_eq, ← tsum_add] + refine tsum_le_tsum fun k => ?_ rw [← mul_add] by_cases hk : k ∈ (ProbComp.eval (E.keyGen n)).support · refine mul_le_mul_of_nonneg_left ?_ zero_le diff --git a/Complexity/Crypto/Computational/Encryption/EncryptThenMAC.lean b/Complexity/Crypto/Computational/Encryption/EncryptThenMAC.lean index d8d240fb8..e33925650 100644 --- a/Complexity/Crypto/Computational/Encryption/EncryptThenMAC.lean +++ b/Complexity/Crypto/Computational/Encryption/EncryptThenMAC.lean @@ -1629,7 +1629,7 @@ private theorem step_bad_prfCipherForgetfulWithBadOracle_le (n : ℕ) (bit : Boo {x | x.2.2 = true} ≤ ∑' r, (BitString.uniformList n) r * {r : List Bool | (cache.lookup r).isSome}.indicator 1 r := by - refine ENNReal.tsum_le_tsum fun r => mul_le_mul_of_nonneg_left ?_ zero_le + refine tsum_le_tsum fun r => mul_le_mul_of_nonneg_left ?_ zero_le by_cases hr : (cache.lookup r).isSome = true · rw [Set.indicator_of_mem (show r ∈ {r : List Bool | (cache.lookup r).isSome} from hr), Pi.one_apply] @@ -1697,7 +1697,7 @@ private theorem bad_prfCipherForgetfulWithBadOracle_le {α : Type} (n : ℕ) (bi (cont y.1)).run y.2).toOuterMeasure {x | x.2.2 = true} ≤ ∑' y, ProbOracleComp.handler (fun m => StateT.lift (ProbComp.unifOracle m)) (prfCipherForgetfulWithBadOracle n bit) (Sum.inl m) (cache, false) y * B := by - refine ENNReal.tsum_le_tsum fun y => ?_ + refine tsum_le_tsum fun y => ?_ by_cases hy : y ∈ (ProbOracleComp.handler (fun m => StateT.lift (ProbComp.unifOracle m)) (prfCipherForgetfulWithBadOracle n bit) (Sum.inl m) (cache, false)).support @@ -1749,10 +1749,10 @@ private theorem bad_prfCipherForgetfulWithBadOracle_le {α : Type} (n : ℕ) (bi ≤ ∑' y, prfCipherForgetfulWithBadOracle n bit request (cache, false) y * ({x : List Bool × (List (List Bool × List Bool) × Bool) | x.2.2 = true}.indicator 1 y + K) := - ENNReal.tsum_le_tsum hterm + tsum_le_tsum hterm _ = (prfCipherForgetfulWithBadOracle n bit request (cache, false)).toOuterMeasure {x | x.2.2 = true} + K := by - simp only [mul_add, ENNReal.tsum_add, ENNReal.tsum_mul_right, PMF.tsum_coe, + simp only [mul_add, tsum_add, ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul, PMF.toOuterMeasure_apply] congr 1 refine tsum_congr fun y => ?_ diff --git a/Complexity/Crypto/Computational/GMW/Soundness.lean b/Complexity/Crypto/Computational/GMW/Soundness.lean index 7841dd8ec..99dcd2c2f 100644 --- a/Complexity/Crypto/Computational/GMW/Soundness.lean +++ b/Complexity/Crypto/Computational/GMW/Soundness.lean @@ -562,7 +562,7 @@ theorem acceptProb_gmwVerifier_le {α : Type} {generator : List Bool → List Bo P.init x * ProbOracleComp.acceptProbWith P.respond (step2 r x.1) x.2 ≤ ∑' x, ProbOracleComp.runWith P.respond (List.take (K * m) <$> ProbOracleComp.query ((), r)) P.init x * (1 / 8) := - ENNReal.tsum_le_tsum fun x => mul_le_mul_right (hstep2_le r x.1 x.2 hbind) _ + tsum_le_tsum fun x => mul_le_mul_right (hstep2_le r x.1 x.2 hbind) _ _ = (∑' x, ProbOracleComp.runWith P.respond (List.take (K * m) <$> ProbOracleComp.query ((), r)) P.init x) * (1 / 8) := ENNReal.tsum_mul_right @@ -591,9 +591,9 @@ theorem acceptProb_gmwVerifier_le {α : Type} {generator : List Bool → List Bo calc ∑' r, BitString.uniformList m r * acceptProb (step1 r) P ≤ ∑' r, (({r | ¬ NaorBinding generator s r}.indicator (BitString.uniformList m) r) + - BitString.uniformList m r * (1 / 8)) := ENNReal.tsum_le_tsum hterm_le + BitString.uniformList m r * (1 / 8)) := tsum_le_tsum hterm_le _ = (∑' r, {r | ¬ NaorBinding generator s r}.indicator (BitString.uniformList m) r) + - ∑' r, BitString.uniformList m r * (1 / 8) := ENNReal.tsum_add + ∑' r, BitString.uniformList m r * (1 / 8) := tsum_add _ = naorBindingProb generator length s + 1 / 8 := by rw [← PMF.toOuterMeasure_apply, ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul] rfl diff --git a/Complexity/Crypto/Computational/MAC.lean b/Complexity/Crypto/Computational/MAC.lean index 5b35fad27..5d8f4e36f 100644 --- a/Complexity/Crypto/Computational/MAC.lean +++ b/Complexity/Crypto/Computational/MAC.lean @@ -797,7 +797,7 @@ private theorem pmf_bind_pure_bool_le {α : Type} (p : PMF α) (f g : α → Boo (p.bind (fun a => PMF.pure (f a))) true ≤ (p.bind (fun a => PMF.pure (g a))) true := by rw [PMF.bind_apply, PMF.bind_apply] - refine ENNReal.tsum_le_tsum fun a => ?_ + refine tsum_le_tsum fun a => ?_ by_cases ha : a ∈ p.support · refine mul_le_mul_of_nonneg_left ?_ zero_le cases hf : f a @@ -816,7 +816,7 @@ theorem succProbability_eufCmaGame_le_sufCmaGame (M : MACScheme) simp only [Game.succProbability, sufCmaGame, ProbComp.eval_bind, ProbComp.eval_pure] refine ENNReal.toNNReal_mono (PMF.apply_ne_top _ true) ?_ rw [PMF.bind_apply, PMF.bind_apply] - refine ENNReal.tsum_le_tsum fun sk => ?_ + refine tsum_le_tsum fun sk => ?_ refine mul_le_mul_of_nonneg_left (pmf_bind_pure_bool_le _ _ _ fun out _ hout => ?_) zero_le simp only [Bool.and_eq_true, Bool.not_eq_true'] at hout ⊢ refine ⟨⟨hout.1.1, ?_⟩, hout.2⟩ @@ -1450,7 +1450,7 @@ theorem succProbability_prfIdealGame_macToPrfDistinguisher_le (adversary : Forge zero_le] have htotal : (phase1.bind phase2) true ≤ (1 : ℝ≥0∞) / 2 ^ n := by rw [PMF.bind_apply] - refine (ENNReal.tsum_le_tsum fun a => ?_).trans + refine (tsum_le_tsum fun a => ?_).trans (PMF.tsum_mul_le_of_forall_le phase1 fun _ => le_rfl) by_cases ha : a ∈ phase1.support · exact mul_le_mul_right (hstep_bound a ha) _ @@ -2012,7 +2012,7 @@ theorem succProbability_eufCmaGame_le_sufCmaGame (M : NonceMACScheme) simp only [Game.succProbability, eufCmaGame, sufCmaGame, ProbComp.eval_bind, ProbComp.eval_pure] refine ENNReal.toNNReal_mono (PMF.apply_ne_top _ true) ?_ rw [PMF.bind_apply, PMF.bind_apply] - refine ENNReal.tsum_le_tsum fun sk => ?_ + refine tsum_le_tsum fun sk => ?_ refine mul_le_mul_of_nonneg_left (MACScheme.pmf_bind_pure_bool_le _ _ _ fun out _ hout => ?_) zero_le simp only [Bool.and_eq_true, Bool.not_eq_true'] at hout ⊢ diff --git a/Complexity/Crypto/Computational/NaorReingold/Security.lean b/Complexity/Crypto/Computational/NaorReingold/Security.lean index ad05595ed..bcc1e4022 100644 --- a/Complexity/Crypto/Computational/NaorReingold/Security.lean +++ b/Complexity/Crypto/Computational/NaorReingold/Security.lean @@ -2995,7 +2995,7 @@ theorem DDH.negligible_naorReingoldHashedGame_const {F : PrimeOrderGroupFamily} refine ne_of_lt (lt_of_le_of_lt ?_ ENNReal.one_lt_top) calc (∑' d, setup n d * (F.order d : ℝ≥0∞)⁻¹) ≤ ∑' d, setup n d * 1 := by - refine ENNReal.tsum_le_tsum fun d => mul_le_mul_of_nonneg_left ?_ (by positivity) + refine tsum_le_tsum fun d => mul_le_mul_of_nonneg_left ?_ (by positivity) exact ENNReal.inv_le_one.mpr (by exact_mod_cast (F.prime_order d).pos) _ = 1 := by simp [(setup n).tsum_coe] have hε_pos : 0 < ε n := by @@ -3007,7 +3007,7 @@ theorem DDH.negligible_naorReingoldHashedGame_const {F : PrimeOrderGroupFamily} ENNReal.mul_pos hd₀_ne hord_ne exact ENNReal.toNNReal_pos (ne_of_gt (lt_of_lt_of_le hterm_pos - (ENNReal.le_tsum (f := fun d => setup n d * (F.order d : ℝ≥0∞)⁻¹) d₀))) + (le_tsum (f := fun d => setup n d * (F.order d : ℝ≥0∞)⁻¹) d₀))) hexp_top let τ : ℝ≥0 := NNReal.sqrt (ε n) have hτ_pos : 0 < τ := NNReal.sqrt_pos.mpr hε_pos @@ -3079,7 +3079,7 @@ theorem DDH.negligible_naorReingoldHashedGame_const {F : PrimeOrderGroupFamily} have hsum_err : (∑' d, setup n d * errTerm d) = ((lhlBound n : ℝ≥0) : ℝ≥0∞) := by dsimp only [errTerm, lhlBound] - simp_rw [mul_add, ENNReal.tsum_add, ← mul_assoc] + simp_rw [mul_add, tsum_add, ← mul_assoc] rw [ENNReal.tsum_mul_right, ENNReal.tsum_mul_right, (setup n).tsum_coe, one_mul, ENNReal.coe_add] congr 1 @@ -3095,8 +3095,8 @@ theorem DDH.negligible_naorReingoldHashedGame_const {F : PrimeOrderGroupFamily} (hfg : ∀ d ∈ (setup n).support, f d true ≤ g d true + ((Game.advantage (g1 d) (g2 d) : ℝ≥0) : ℝ≥0∞)) : ((setup n).bind f) true ≤ ((setup n).bind g) true + ((lhlBound n : ℝ≥0) : ℝ≥0∞) := by - rw [← hsum_err, PMF.bind_apply, PMF.bind_apply, ← ENNReal.tsum_add] - refine ENNReal.tsum_le_tsum fun d => ?_ + rw [← hsum_err, PMF.bind_apply, PMF.bind_apply, ← tsum_add] + refine tsum_le_tsum fun d => ?_ by_cases hd : d ∈ (setup n).support · rw [← mul_add] exact mul_le_mul_of_nonneg_left ((hfg d hd).trans (add_le_add le_rfl (hpoint d hd))) diff --git a/Complexity/Crypto/Computational/OneWay/LiuPassConverse.lean b/Complexity/Crypto/Computational/OneWay/LiuPassConverse.lean index 3c997b6a5..2350d6382 100644 --- a/Complexity/Crypto/Computational/OneWay/LiuPassConverse.lean +++ b/Complexity/Crypto/Computational/OneWay/LiuPassConverse.lean @@ -610,7 +610,7 @@ private theorem heuristic_fail_mul_le_family_fail {t : ℕ → ℕ} (ht : ∀ n, rw [hfailA_eq] dsimp only [failH] rw [PMF.map_apply, PMF.map_apply] - refine ENNReal.tsum_le_tsum fun coins => ?_ + refine tsum_le_tsum fun coins => ?_ split_ifs with h1 h2 · rfl · exfalso diff --git a/Complexity/Crypto/Computational/OneWayToSignature.lean b/Complexity/Crypto/Computational/OneWayToSignature.lean index ce784ba7d..a3cc11acb 100644 --- a/Complexity/Crypto/Computational/OneWayToSignature.lean +++ b/Complexity/Crypto/Computational/OneWayToSignature.lean @@ -663,7 +663,7 @@ private theorem map_bool_apply_true {α : Type*} (p : PMF α) (P : α → Bool) private theorem ennreal_tsum_finsetSum {α ι : Type*} (s : Finset ι) (g : ι → α → ℝ≥0∞) : (∑' a, ∑ i ∈ s, g i a) = ∑ i ∈ s, ∑' a, g i a := - Summable.tsum_finsetSum fun _ _ => ENNReal.summable + Summable.tsum_finsetSum fun _ _ => CompleteLattice.summable /-- **Lamport's one-time signature theorem**: for any one-way function `f`, `lamportScheme f` is existentially unforgeable under one-time adaptive chosen-message attack (`OneTimeEUFCMA`). -/ @@ -817,7 +817,7 @@ theorem OneWay.oneTimeEUFCMA_lamport {f : List Bool → List Bool} (hf : OneWay ≤ ∑' out, ∑ j : Fin (dyadicSize (2 * n)), if j.val < 2 * n then runWith (pkOf w) (dummySkOf w j.val) out * (if invWin w j.val out then 1 else 0) - else 0 := ENNReal.tsum_le_tsum (hpointwise w hw) + else 0 := tsum_le_tsum (hpointwise w hw) _ = ∑ j : Fin (dyadicSize (2 * n)), ∑' out, if j.val < 2 * n then runWith (pkOf w) (dummySkOf w j.val) out * (if invWin w j.val out then 1 else 0) @@ -845,7 +845,7 @@ theorem OneWay.oneTimeEUFCMA_lamport {f : List Bool → List Bool} (hf : OneWay if j.val < 2 * n then ((runWith (pkOf w) (dummySkOf w j.val)).map (invWin w j.val)) true else 0 := by - refine ENNReal.tsum_le_tsum fun w => ?_ + refine tsum_le_tsum fun w => ?_ by_cases hw : w ∈ μ.support · exact mul_le_mul_right (hw_sum w hw) (μ w) · simp [(PMF.apply_eq_zero_iff μ w).mpr hw] diff --git a/Complexity/Crypto/Computational/PRGToOneWay.lean b/Complexity/Crypto/Computational/PRGToOneWay.lean index 1fb8c7c47..70e7f7aea 100644 --- a/Complexity/Crypto/Computational/PRGToOneWay.lean +++ b/Complexity/Crypto/Computational/PRGToOneWay.lean @@ -107,7 +107,7 @@ theorem succProbability_uniformList_test_le {generator : List Bool → List Bool split_ifs with hr · exact PMF.coe_le_one _ _ simp only [test, ProbComp.eval_bind, ProbComp.eval_pure, PMF.bind_apply, PMF.pure_apply] - refine le_of_eq (ENNReal.tsum_eq_zero.2 fun x => ?_) + refine le_of_eq (tsum_eq_zero_iff.2 fun x => ?_) have hne : generator x ≠ List.ofFn r := fun hx => hr <| mem_image.2 ⟨x, hP x (by rw [← hlen x, hx, List.length_ofFn]), hx⟩ simp [hne] diff --git a/Complexity/Crypto/Computational/PedersenCommitment.lean b/Complexity/Crypto/Computational/PedersenCommitment.lean index e77853f5a..09842b79b 100644 --- a/Complexity/Crypto/Computational/PedersenCommitment.lean +++ b/Complexity/Crypto/Computational/PedersenCommitment.lean @@ -405,11 +405,11 @@ theorem pedersenHidingGame_apply_true_le (setup : ℕ → PMF F.Desc) ≤ ∑' α, (PMF.uniformOfFintype (ZMod (F.order d)) α * F.pedersenScheme.hidingForKey ⟨d, α • F.generator d⟩ adversary b₂ n true + if α = 0 then (F.order d : ℝ≥0∞)⁻¹ else 0) := - ENNReal.tsum_le_tsum hα + tsum_le_tsum hα _ = (∑' α, PMF.uniformOfFintype (ZMod (F.order d)) α * F.pedersenScheme.hidingForKey ⟨d, α • F.generator d⟩ adversary b₂ n true) + (F.order d : ℝ≥0∞)⁻¹ := by - rw [ENNReal.tsum_add, tsum_ite_eq] + rw [tsum_add, tsum_ite_eq] _ ≤ (∑' α, PMF.uniformOfFintype (ZMod (F.order d)) α * F.pedersenScheme.hidingForKey ⟨d, α • F.generator d⟩ adversary b₂ n true) + (m : ℝ≥0∞)⁻¹ := add_le_add le_rfl hord @@ -423,7 +423,7 @@ theorem pedersenHidingGame_apply_true_le (setup : ℕ → PMF F.Desc) (((PMF.uniformOfFintype (ZMod (F.order d))).bind fun α => F.pedersenScheme.hidingForKey ⟨d, α • F.generator d⟩ adversary b₂ n) true + (m : ℝ≥0∞)⁻¹) := by - refine ENNReal.tsum_le_tsum fun d => ?_ + refine tsum_le_tsum fun d => ?_ by_cases hd : d ∈ (setup n).support · exact mul_le_mul_of_nonneg_left (hd_bound d hd) zero_le · have hd0 : setup n d = 0 := by rwa [PMF.mem_support_iff, not_not] at hd @@ -432,7 +432,7 @@ theorem pedersenHidingGame_apply_true_le (setup : ℕ → PMF F.Desc) ((PMF.uniformOfFintype (ZMod (F.order d))).bind fun α => F.pedersenScheme.hidingForKey ⟨d, α • F.generator d⟩ adversary b₂ n) true) + (m : ℝ≥0∞)⁻¹ := by - simp only [mul_add, ENNReal.tsum_add, ENNReal.tsum_mul_right, (setup n).tsum_coe, one_mul] + simp only [mul_add, tsum_add, ENNReal.tsum_mul_right, (setup n).tsum_coe, one_mul] /-- **Unconditional hiding bound for Pedersen commitments**: when every supported group at parameter `n` has order at least `m > 0`, any (even computationally unbounded) diff --git a/Complexity/Crypto/Computational/Pseudoentropy/MaskedExtraction.lean b/Complexity/Crypto/Computational/Pseudoentropy/MaskedExtraction.lean index 9a46827f4..ffd5f9b0b 100644 --- a/Complexity/Crypto/Computational/Pseudoentropy/MaskedExtraction.lean +++ b/Complexity/Crypto/Computational/Pseudoentropy/MaskedExtraction.lean @@ -109,7 +109,7 @@ theorem maskedSample_mass_ge {α β : Type} (source : ProbComp α) rw [← ENNReal.toReal_mul] apply ENNReal.toReal_mono (PMF.apply_ne_top _ _) rw [PMF.bind_apply] - exact ENNReal.le_tsum (f := fun x => ProbComp.eval source x * + exact le_tsum (f := fun x => ProbComp.eval source x * ((ProbComp.eval (maskBit (mask x) (truth x))).map (observe x, ·)) (observe value, bit)) value exact (mul_le_mul (hsource value hvalue) (hbitMass.trans hmap) diff --git a/Complexity/Crypto/Game.lean b/Complexity/Crypto/Game.lean index e289aabc6..4f37d2714 100644 --- a/Complexity/Crypto/Game.lean +++ b/Complexity/Crypto/Game.lean @@ -295,16 +295,16 @@ theorem advantage_bind_le {α : Type*} (d : PMF α) (game1 game2 : α → Game) rw [PMF.bind_apply, PMF.bind_apply] calc ∑' a, d a * game1 a true ≤ ∑' a, d a * (game2 a true + ENNReal.ofReal ε) := - ENNReal.tsum_le_tsum fun a => mul_le_mul_of_nonneg_left (h1 a) zero_le + tsum_le_tsum fun a => mul_le_mul_of_nonneg_left (h1 a) zero_le _ = (∑' a, d a * game2 a true) + ENNReal.ofReal ε := by - simp only [mul_add, ENNReal.tsum_add, ENNReal.tsum_mul_right, d.tsum_coe, one_mul] + simp only [mul_add, tsum_add, ENNReal.tsum_mul_right, d.tsum_coe, one_mul] have hsum2 : (d.bind game2) true ≤ (d.bind game1) true + ENNReal.ofReal ε := by rw [PMF.bind_apply, PMF.bind_apply] calc ∑' a, d a * game2 a true ≤ ∑' a, d a * (game1 a true + ENNReal.ofReal ε) := - ENNReal.tsum_le_tsum fun a => mul_le_mul_of_nonneg_left (h2 a) zero_le + tsum_le_tsum fun a => mul_le_mul_of_nonneg_left (h2 a) zero_le _ = (∑' a, d a * game1 a true) + ENNReal.ofReal ε := by - simp only [mul_add, ENNReal.tsum_add, ENNReal.tsum_mul_right, d.tsum_coe, one_mul] + simp only [mul_add, tsum_add, ENNReal.tsum_mul_right, d.tsum_coe, one_mul] have hadv := advantage_le_of_apply_le ENNReal.ofReal_ne_top hsum1 hsum2 rwa [ENNReal.toReal_ofReal hε0] at hadv @@ -324,8 +324,8 @@ theorem advantage_bind_uniformOfFintype_of_ne_le {α : Type*} [Fintype α] [None have hle₁ : ((PMF.uniformOfFintype α).bind g) true ≤ p true + (Fintype.card α : ℝ≥0∞)⁻¹ := by rw [← PMF.bind_const (PMF.uniformOfFintype α) p, ← hsingle, PMF.bind_apply, PMF.bind_apply, - PMF.bind_apply, ← ENNReal.tsum_add] - refine ENNReal.tsum_le_tsum fun a => ?_ + PMF.bind_apply, ← tsum_add] + refine tsum_le_tsum fun a => ?_ rw [← mul_add] refine mul_le_mul_of_nonneg_left ?_ zero_le by_cases ha : a = a₀ @@ -335,8 +335,8 @@ theorem advantage_bind_uniformOfFintype_of_ne_le {α : Type*} [Fintype α] [None have hle₂ : p true ≤ ((PMF.uniformOfFintype α).bind g) true + (Fintype.card α : ℝ≥0∞)⁻¹ := by nth_rw 1 [← PMF.bind_const (PMF.uniformOfFintype α) p] - rw [← hsingle, PMF.bind_apply, PMF.bind_apply, PMF.bind_apply, ← ENNReal.tsum_add] - refine ENNReal.tsum_le_tsum fun a => ?_ + rw [← hsingle, PMF.bind_apply, PMF.bind_apply, PMF.bind_apply, ← tsum_add] + refine tsum_le_tsum fun a => ?_ rw [← mul_add] refine mul_le_mul_of_nonneg_left ?_ zero_le by_cases ha : a = a₀ @@ -363,8 +363,8 @@ theorem bind_apply_le_add_bind_apply {β : Type*} (μ : PMF β) (μ.bind game2) b ≤ (μ.bind game1) b + (μ.bind err) b := by have h1 (f g : β → Game) (hle : ∀ x, f x b ≤ g x b + err x b) : (μ.bind f) b ≤ (μ.bind g) b + (μ.bind err) b := by - simp only [PMF.bind_apply, ← ENNReal.tsum_add, ← mul_add] - exact ENNReal.tsum_le_tsum fun x => mul_le_mul_of_nonneg_left (hle x) zero_le + simp only [PMF.bind_apply, ← tsum_add, ← mul_add] + exact tsum_le_tsum fun x => mul_le_mul_of_nonneg_left (hle x) zero_le exact ⟨h1 game1 game2 fun x => (h x).1, h1 game2 game1 fun x => (h x).2⟩ /-- Averaging pointwise acceptance-probability bounds `game1 x true ≤ game2 x true + err x true` diff --git a/Complexity/Crypto/Game/UntilBad.lean b/Complexity/Crypto/Game/UntilBad.lean index 52f3c2892..f80d1e46d 100644 --- a/Complexity/Crypto/Game/UntilBad.lean +++ b/Complexity/Crypto/Game/UntilBad.lean @@ -164,9 +164,9 @@ theorem runStatelessOracle_bind_le {T α : Type} (μ : PMF T) (∑' x, PMF.uniformOfFintype (Fin (m + 1)) x * g x) + (Q : ℝ≥0∞) * δ := by calc ∑' x, PMF.uniformOfFintype (Fin (m + 1)) x * f x ≤ ∑' x, PMF.uniformOfFintype (Fin (m + 1)) x * (g x + (Q : ℝ≥0∞) * δ) := - ENNReal.tsum_le_tsum fun x => mul_le_mul_of_nonneg_left (hle x) zero_le + tsum_le_tsum fun x => mul_le_mul_of_nonneg_left (hle x) zero_le _ = (∑' x, PMF.uniformOfFintype (Fin (m + 1)) x * g x) + (Q : ℝ≥0∞) * δ := by - simp only [mul_add, ENNReal.tsum_add, ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul] + simp only [mul_add, tsum_add, ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul] exact ⟨hsum _ _ (fun x => (ih x).1), hsum _ _ (fun x => (ih x).2)⟩ · simp only [Sum.elim_inr] have hinr₁ : @@ -184,13 +184,13 @@ theorem runStatelessOracle_bind_le {T α : Type} (μ : PMF T) simp only [PMF.bind_apply] calc ∑' τ, μ τ * f τ b ≤ ∑' τ, (μ τ * g τ b + μ τ * if isBad τ req.2 then 1 else 0) := by - refine ENNReal.tsum_le_tsum fun τ => ?_ + refine tsum_le_tsum fun τ => ?_ by_cases hb : isBad τ req.2 = true · simp only [hb, ↓reduceIte, mul_one] exact le_add_of_le_right (mul_le_of_le_one_right zero_le (PMF.coe_le_one _ _)) · simp only [Bool.not_eq_true] at hb rw [hfg τ hb]; simp [hb] - _ = (∑' τ, μ τ * g τ b) + ∑' τ, μ τ * if isBad τ req.2 then 1 else 0 := ENNReal.tsum_add + _ = (∑' τ, μ τ * g τ b) + ∑' τ, μ τ * if isBad τ req.2 then 1 else 0 := tsum_add _ ≤ (∑' τ, μ τ * g τ b) + δ := add_le_add le_rfl (hbad req.2) have hstep1 := hstep (fun τ => runStatelessOracle (o₁ τ) (k (o₁ τ req.2)) (next τ)) @@ -372,20 +372,20 @@ theorem runStatelessOracle_le_runFinderOracle {α : Type} ≤ ∑' x, PMF.uniformOfFintype (Fin (m + 1)) x * (runStatelessOracle o₂ (k x) next b + runFinderOracle o₂ isBad extract (k x) none isGood true) := - ENNReal.tsum_le_tsum fun x => mul_le_mul_of_nonneg_left (ih x).1 zero_le + tsum_le_tsum fun x => mul_le_mul_of_nonneg_left (ih x).1 zero_le _ = (∑' x, PMF.uniformOfFintype (Fin (m + 1)) x * runStatelessOracle o₂ (k x) next b) + ∑' x, PMF.uniformOfFintype (Fin (m + 1)) x * runFinderOracle o₂ isBad extract (k x) none isGood true := by - simp only [mul_add, ENNReal.tsum_add] + simp only [mul_add, tsum_add] · calc ∑' x, PMF.uniformOfFintype (Fin (m + 1)) x * runStatelessOracle o₂ (k x) next b ≤ ∑' x, PMF.uniformOfFintype (Fin (m + 1)) x * (runStatelessOracle o₁ (k x) next b + runFinderOracle o₂ isBad extract (k x) none isGood true) := - ENNReal.tsum_le_tsum fun x => mul_le_mul_of_nonneg_left (ih x).2 zero_le + tsum_le_tsum fun x => mul_le_mul_of_nonneg_left (ih x).2 zero_le _ = (∑' x, PMF.uniformOfFintype (Fin (m + 1)) x * runStatelessOracle o₁ (k x) next b) + ∑' x, PMF.uniformOfFintype (Fin (m + 1)) x * runFinderOracle o₂ isBad extract (k x) none isGood true := by - simp only [mul_add, ENNReal.tsum_add] + simp only [mul_add, tsum_add] · rw [runStatelessOracle_query_inr, runStatelessOracle_query_inr, runFinderOracle_query_inr] by_cases hb : isBad req.2 = true · simp only [hb, ↓reduceIte] diff --git a/Complexity/Crypto/Primitives/PRG/NextBit.lean b/Complexity/Crypto/Primitives/PRG/NextBit.lean index 886b68555..76fe10070 100644 --- a/Complexity/Crypto/Primitives/PRG/NextBit.lean +++ b/Complexity/Crypto/Primitives/PRG/NextBit.lean @@ -121,9 +121,9 @@ private theorem bind_apply_add_of_forall {α β : Type*} (μ : PMF α) {f g h : {c : ℝ≥0∞} (hfg : ∀ x, f x b + g x b = h x b + c) : μ.bind f b + μ.bind g b = μ.bind h b + c := by simp only [PMF.bind_apply] - rw [← ENNReal.tsum_add] + rw [← tsum_add] simp_rw [← mul_add, hfg, mul_add] - rw [ENNReal.tsum_add, ENNReal.tsum_mul_right, μ.tsum_coe, one_mul] + rw [tsum_add, ENNReal.tsum_mul_right, μ.tsum_coe, one_mul] /-- **The distinguisher/predictor lemma** [Boneh and Shoup, Lemma 3.5][BonehShoup2023]. Draw `x` from `μ`. The guess `guessOfDistinguisher (d x)` equals `target x` with probability `1 / 2`, plus diff --git a/Complexity/Crypto/Protocols/Cipher/EvenMansour.lean b/Complexity/Crypto/Protocols/Cipher/EvenMansour.lean index b88c043a5..ca41828a6 100644 --- a/Complexity/Crypto/Protocols/Cipher/EvenMansour.lean +++ b/Complexity/Crypto/Protocols/Cipher/EvenMansour.lean @@ -1955,7 +1955,7 @@ private theorem idealGame_apply_le_realGame_add_of_keyDist (keyDist : PMF (G × calc (∑' res : Bool × (Cache G × Cache G), M_ideal res * keyDist.toOuterMeasure {k | isBadEvenMansourKey res.2.1 res.2.2 k = true}) ≤ ∑' res : Bool × (Cache G × Cache G), M_ideal res * ε := by - refine ENNReal.tsum_le_tsum fun res => ?_ + refine tsum_le_tsum fun res => ?_ by_cases hmem : res ∈ M_ideal.support · refine mul_le_mul_of_nonneg_left (hbad_le res.2.1 res.2.2 ?_ ?_) zero_le · simpa using length_fst_idealLazyHandler_le hcall.1 hmem @@ -1968,14 +1968,14 @@ private theorem idealGame_apply_le_realGame_add_of_keyDist (keyDist : PMF (G × ≤ ∑' k : G × G, keyDist k * ((((OracleComp.interpret (realLazyHandler k) program).run []).map Prod.fst) b + M_ideal.toOuterMeasure {res | isBadEvenMansourKey res.2.1 res.2.2 k = true}) := - ENNReal.tsum_le_tsum fun k => mul_le_mul_of_nonneg_left (hpoint k) zero_le + tsum_le_tsum fun k => mul_le_mul_of_nonneg_left (hpoint k) zero_le _ = (∑' k : G × G, keyDist k * (((OracleComp.interpret (realLazyHandler k) program).run []).map Prod.fst) b) + (∑' k : G × G, keyDist k * M_ideal.toOuterMeasure {res | isBadEvenMansourKey res.2.1 res.2.2 k = true}) := by - simp_rw [mul_add, ENNReal.tsum_add] + simp_rw [mul_add, tsum_add] _ ≤ _ := add_le_add le_rfl hsum_bad private theorem advantage_le_of_forall_bool_le {g₁ g₂ : Game} {ε : ℝ≥0∞} (hε : ε ≠ ⊤) diff --git a/Complexity/Crypto/Protocols/Cipher/LubyRackoff.lean b/Complexity/Crypto/Protocols/Cipher/LubyRackoff.lean index ac6f10219..a46a9a06e 100644 --- a/Complexity/Crypto/Protocols/Cipher/LubyRackoff.lean +++ b/Complexity/Crypto/Protocols/Cipher/LubyRackoff.lean @@ -1013,7 +1013,7 @@ private theorem tsum_seed_toOuterMeasure_hasCollision_le {seed₁ : PMF K₁} {h ∑' x, idealRun x * ∑' k₁, ({k₁ : K₁ | hasUCollision (h₁ k₁) x.2 = true}.indicator seed₁ k₁) := by simp only [← ENNReal.tsum_mul_left] - rw [ENNReal.tsum_comm] + rw [tsum_comm] refine tsum_congr fun x => tsum_congr fun k₁ => ?_ by_cases hx : hasUCollision (h₁ k₁) x.2 = true · rw [Set.indicator_of_mem hx, Set.indicator_of_mem hx, mul_comm] @@ -1022,7 +1022,7 @@ private theorem tsum_seed_toOuterMeasure_hasCollision_le {seed₁ : PMF K₁} {h calc ∑' x, idealRun x * ∑' k₁, ({k₁ : K₁ | hasUCollision (h₁ k₁) x.2 = true}.indicator seed₁ k₁) ≤ ∑' x, idealRun x * (Q.choose 2 * ε) := by - refine ENNReal.tsum_le_tsum fun x => ?_ + refine tsum_le_tsum fun x => ?_ by_cases hmem : x ∈ idealRun.support · refine mul_le_mul_of_nonneg_left ?_ zero_le rw [← PMF.toOuterMeasure_apply] @@ -1045,10 +1045,10 @@ private theorem tsum_seed_toOuterMeasure_hasCollision_le {seed₁ : PMF K₁} {h ≤ ∑' k₁, seed₁ k₁ * (idealRun.toOuterMeasure {x | hasUCollision (h₁ k₁) x.2 = true} + idealRun.toOuterMeasure {x | hasVCollision x.2 = true}) := - ENNReal.tsum_le_tsum fun k₁ => mul_le_mul_of_nonneg_left (hsplit k₁) zero_le + tsum_le_tsum fun k₁ => mul_le_mul_of_nonneg_left (hsplit k₁) zero_le _ = (∑' k₁, seed₁ k₁ * idealRun.toOuterMeasure {x | hasUCollision (h₁ k₁) x.2 = true}) + (∑' k₁, seed₁ k₁ * idealRun.toOuterMeasure {x | hasVCollision x.2 = true}) := by - simp only [mul_add, ENNReal.tsum_add] + simp only [mul_add, tsum_add] _ ≤ Q.choose 2 * ε + Q.choose 2 * (Fintype.card G : ℝ≥0∞)⁻¹ := add_le_add hu hv /-- For every fixed `f₁`, the acceptance probability of `feistel3FixedGame f₁ program` and @@ -1092,13 +1092,13 @@ theorem feistel3HashIdealGame_apply_le {seed₁ : PMF K₁} {h₁ : K₁ → G ≤ ∑' k₁, seed₁ k₁ * (randomFunctionGame program b + ((OracleComp.interpret (memoize (fun _ : G × G => PMF.uniformOfFintype (G × G))) program).run []).toOuterMeasure {x | hasCollision (h₁ k₁) x.2 = true}) := - ENNReal.tsum_le_tsum fun k₁ => + tsum_le_tsum fun k₁ => mul_le_mul_of_nonneg_left (feistel3FixedGame_apply_le (h₁ k₁) program b) zero_le _ = randomFunctionGame program b + ∑' k₁, seed₁ k₁ * ((OracleComp.interpret (memoize (fun _ : G × G => PMF.uniformOfFintype (G × G))) program).run []).toOuterMeasure {x | hasCollision (h₁ k₁) x.2 = true} := by - simp only [mul_add, ENNReal.tsum_add, ENNReal.tsum_mul_right, seed₁.tsum_coe, one_mul] + simp only [mul_add, tsum_add, ENNReal.tsum_mul_right, seed₁.tsum_coe, one_mul] _ ≤ randomFunctionGame program b + (Q.choose 2 * ε + Q.choose 2 * (Fintype.card G : ℝ≥0∞)⁻¹) := add_le_add le_rfl (tsum_seed_toOuterMeasure_hasCollision_le hh₁ hQ) @@ -1120,14 +1120,14 @@ theorem randomFunctionGame_apply_le_feistel3HashIdealGame {seed₁ : PMF K₁} { ≤ ∑' k₁, seed₁ k₁ * (feistel3FixedGame (h₁ k₁) program b + ((OracleComp.interpret (memoize (fun _ : G × G => PMF.uniformOfFintype (G × G))) program).run []).toOuterMeasure {x | hasCollision (h₁ k₁) x.2 = true}) := - ENNReal.tsum_le_tsum fun k₁ => + tsum_le_tsum fun k₁ => mul_le_mul_of_nonneg_left (randomFunctionGame_apply_le_feistel3FixedGame (h₁ k₁) program b) zero_le _ = (∑' k₁, seed₁ k₁ * feistel3FixedGame (h₁ k₁) program b) + ∑' k₁, seed₁ k₁ * ((OracleComp.interpret (memoize (fun _ : G × G => PMF.uniformOfFintype (G × G))) program).run []).toOuterMeasure {x | hasCollision (h₁ k₁) x.2 = true} := by - simp only [mul_add, ENNReal.tsum_add] + simp only [mul_add, tsum_add] _ ≤ (∑' k₁, seed₁ k₁ * feistel3FixedGame (h₁ k₁) program b) + (Q.choose 2 * ε + Q.choose 2 * (Fintype.card G : ℝ≥0∞)⁻¹) := add_le_add le_rfl (tsum_seed_toOuterMeasure_hasCollision_le hh₁ hQ) @@ -1619,7 +1619,7 @@ theorem le_idealStrongGame_feistel3CCAAttack_false {l₀ l₁ l₂ r₀ : G} _ ≤ ∑' π : Equiv.Perm (G × G), PMF.uniformOfFintype (Equiv.Perm (G × G)) π * OracleComp.interpret (feistelStrongOracle π) (feistel3CCAAttack l₀ l₁ r₀) false := - ENNReal.le_tsum (f := fun π : Equiv.Perm (G × G) => + le_tsum (f := fun π : Equiv.Perm (G × G) => PMF.uniformOfFintype (Equiv.Perm (G × G)) π * OracleComp.interpret (feistelStrongOracle π) (feistel3CCAAttack l₀ l₁ r₀) false) π₀ @@ -1875,9 +1875,9 @@ theorem idealStrongGame_feistel3CCAAttack_true_le {l₀ l₁ : G} (r₀ : G) (h0 (fun x => decide (-vw₀.1 + x.1.2 = -vw₁.1 + r₀))) true ≤ ∑' vw₁, ((PMF.uniformOfFintype (G × G)) vw₁ * (Fintype.card G : ℝ≥0∞)⁻¹ + ({q₃} : Set (G × G)).indicator (PMF.uniformOfFintype (G × G)) vw₁) := - ENNReal.tsum_le_tsum hvw₁ + tsum_le_tsum hvw₁ _ = (Fintype.card G : ℝ≥0∞)⁻¹ + (Fintype.card (G × G) : ℝ≥0∞)⁻¹ := by - rw [ENNReal.tsum_add, ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul, + rw [tsum_add, ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul, ← PMF.toOuterMeasure_apply, PMF.toOuterMeasure_apply_singleton, PMF.uniformOfFintype_apply] calc ∑' vw₀, (PMF.uniformOfFintype (G × G)) vw₀ * @@ -1888,7 +1888,7 @@ theorem idealStrongGame_feistel3CCAAttack_true_le {l₀ l₁ : G} (r₀ : G) (h0 (fun x => decide (-vw₀.1 + x.1.2 = -vw₁.1 + r₀))) true ≤ ∑' vw₀, (PMF.uniformOfFintype (G × G)) vw₀ * ((Fintype.card G : ℝ≥0∞)⁻¹ + (Fintype.card (G × G) : ℝ≥0∞)⁻¹) := - ENNReal.tsum_le_tsum fun vw₀ => mul_le_mul_of_nonneg_left (hvw₀ vw₀) zero_le + tsum_le_tsum fun vw₀ => mul_le_mul_of_nonneg_left (hvw₀ vw₀) zero_le _ = (Fintype.card G : ℝ≥0∞)⁻¹ + (Fintype.card (G × G) : ℝ≥0∞)⁻¹ := by rw [ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul] have hchoose : ((Nat.choose 3 2 : ℕ) : ℝ≥0∞) = 3 := rfl @@ -3043,7 +3043,7 @@ private theorem tsum_toOuterMeasure_of_pointwise_le {α β : Type} (μ : PMF α) (∑' a, μ a * ∑' y, {y | P a y}.indicator d y) = ∑' y, d y * ∑' a, {a | P a y}.indicator μ a := by simp only [← ENNReal.tsum_mul_left] - rw [ENNReal.tsum_comm] + rw [tsum_comm] refine tsum_congr fun y => tsum_congr fun a => ?_ by_cases h : P a y · rw [Set.indicator_of_mem h, Set.indicator_of_mem h, mul_comm] @@ -3051,7 +3051,7 @@ private theorem tsum_toOuterMeasure_of_pointwise_le {α β : Type} (μ : PMF α) rw [hcomm] calc ∑' y, d y * ∑' a, {a | P a y}.indicator μ a ≤ ∑' y, d y * M := - ENNReal.tsum_le_tsum fun y => mul_le_mul_of_nonneg_left (by + tsum_le_tsum fun y => mul_le_mul_of_nonneg_left (by rw [← PMF.toOuterMeasure_apply] exact hM y) zero_le _ = M := by rw [ENNReal.tsum_mul_right, d.tsum_coe, one_mul] @@ -3155,14 +3155,14 @@ private theorem tsum_uniform_toOuterMeasure_hasCollision4_le d.toOuterMeasure {x | IsGoodCache4 Q x.2 ∧ hasVCollision4 f₄ x.2 = true} + (Q.choose 2 : ℝ≥0∞) * (Fintype.card (G × G) : ℝ≥0∞)⁻¹) := - ENNReal.tsum_le_tsum fun f₄ => + tsum_le_tsum fun f₄ => mul_le_mul_of_nonneg_left (toOuterMeasure_hasCollision4_le f₁ f₄ hQ) zero_le _ = d.toOuterMeasure {x | IsGoodCache4 Q x.2 ∧ hasUCollision f₁ x.2 = true} + (∑' f₄, unif f₄ * d.toOuterMeasure {x | IsGoodCache4 Q x.2 ∧ hasVCollision4 f₄ x.2 = true}) + (Q.choose 2 : ℝ≥0∞) * (Fintype.card (G × G) : ℝ≥0∞)⁻¹ := by - simp only [mul_add, ENNReal.tsum_add, ENNReal.tsum_mul_right, unif.tsum_coe, one_mul] + simp only [mul_add, tsum_add, ENNReal.tsum_mul_right, unif.tsum_coe, one_mul] _ ≤ _ := add_le_add (add_le_add le_rfl (tsum_uniform_toOuterMeasure_hasVCollision4_le d Q)) le_rfl calc ∑' f₁, unif f₁ * ∑' f₄, unif f₄ * d.toOuterMeasure {x | hasCollision4 f₁ f₄ x.2 = true} @@ -3171,12 +3171,12 @@ private theorem tsum_uniform_toOuterMeasure_hasCollision4_le {x | IsGoodCache4 Q x.2 ∧ hasUCollision f₁ x.2 = true} + Q.choose 2 * (Fintype.card G : ℝ≥0∞)⁻¹ + (Q.choose 2 : ℝ≥0∞) * (Fintype.card (G × G) : ℝ≥0∞)⁻¹) := - ENNReal.tsum_le_tsum fun f₁ => mul_le_mul_of_nonneg_left (hinner f₁) zero_le + tsum_le_tsum fun f₁ => mul_le_mul_of_nonneg_left (hinner f₁) zero_le _ = (∑' f₁, unif f₁ * d.toOuterMeasure {x | IsGoodCache4 Q x.2 ∧ hasUCollision f₁ x.2 = true}) + Q.choose 2 * (Fintype.card G : ℝ≥0∞)⁻¹ + (Q.choose 2 : ℝ≥0∞) * (Fintype.card (G × G) : ℝ≥0∞)⁻¹ := by - simp only [mul_add, ENNReal.tsum_add, ENNReal.tsum_mul_right, unif.tsum_coe, one_mul] + simp only [mul_add, tsum_add, ENNReal.tsum_mul_right, unif.tsum_coe, one_mul] _ ≤ Q.choose 2 * (Fintype.card G : ℝ≥0∞)⁻¹ + Q.choose 2 * (Fintype.card G : ℝ≥0∞)⁻¹ + (Q.choose 2 : ℝ≥0∞) * (Fintype.card (G × G) : ℝ≥0∞)⁻¹ := @@ -3253,13 +3253,13 @@ theorem feistel4StrongRandomRoundsGame_apply_le (forgetVal + ((OracleComp.interpret RandomPermutation.forgetfulAnswer prog).run []).toOuterMeasure {x | hasCollision4 f₁ f₄ x.2 = true}) := - ENNReal.tsum_le_tsum fun f₁ => mul_le_mul_of_nonneg_left - (ENNReal.tsum_le_tsum fun f₄ => mul_le_mul_of_nonneg_left + tsum_le_tsum fun f₁ => mul_le_mul_of_nonneg_left + (tsum_le_tsum fun f₄ => mul_le_mul_of_nonneg_left (feistel4StrongFixedGame_apply_le f₁ f₄ program b) zero_le) zero_le _ = forgetVal + ∑' f₁, unif f₁ * ∑' f₄, unif f₄ * ((OracleComp.interpret RandomPermutation.forgetfulAnswer prog).run []).toOuterMeasure {x | hasCollision4 f₁ f₄ x.2 = true} := by - simp only [mul_add, ENNReal.tsum_add, ENNReal.tsum_mul_right, unif.tsum_coe, one_mul] + simp only [mul_add, tsum_add, ENNReal.tsum_mul_right, unif.tsum_coe, one_mul] _ ≤ _ := add_le_add le_rfl (tsum_uniform_toOuterMeasure_hasCollision4_le hQ') have hperm := RandomPermutation.forgetfulAnswer_bind_apply_le_uniformPerm hQ' PMF.pure b simp only [Probability.PMF.monad_bind_eq_bind, PMF.bind_pure] at hperm @@ -3303,14 +3303,14 @@ theorem idealStrongGame_apply_le_feistel4StrongRandomRoundsGame (feistel4StrongFixedGame f₁ f₄ program b + ((OracleComp.interpret RandomPermutation.forgetfulAnswer prog).run []).toOuterMeasure {x | hasCollision4 f₁ f₄ x.2 = true}) := - ENNReal.tsum_le_tsum fun f₁ => mul_le_mul_of_nonneg_left - (ENNReal.tsum_le_tsum fun f₄ => mul_le_mul_of_nonneg_left + tsum_le_tsum fun f₁ => mul_le_mul_of_nonneg_left + (tsum_le_tsum fun f₄ => mul_le_mul_of_nonneg_left (forgetfulAnswer_apply_le_feistel4StrongFixedGame f₁ f₄ program b) zero_le) zero_le _ = (∑' f₁, unif f₁ * ∑' f₄, unif f₄ * feistel4StrongFixedGame f₁ f₄ program b) + ∑' f₁, unif f₁ * ∑' f₄, unif f₄ * ((OracleComp.interpret RandomPermutation.forgetfulAnswer prog).run []).toOuterMeasure {x | hasCollision4 f₁ f₄ x.2 = true} := by - simp only [mul_add, ENNReal.tsum_add] + simp only [mul_add, tsum_add] _ ≤ _ := add_le_add le_rfl (tsum_uniform_toOuterMeasure_hasCollision4_le hQ') have hperm := RandomPermutation.uniformPerm_bind_apply_le_forgetful hQ' PMF.pure b simp only [Probability.PMF.monad_bind_eq_bind, PMF.bind_pure] at hperm diff --git a/Complexity/Crypto/Protocols/MAC/CarterWegman.lean b/Complexity/Crypto/Protocols/MAC/CarterWegman.lean index dd32115b4..4b4f2bb30 100644 --- a/Complexity/Crypto/Protocols/MAC/CarterWegman.lean +++ b/Complexity/Crypto/Protocols/MAC/CarterWegman.lean @@ -3802,10 +3802,10 @@ theorem randomNonceSimHandler_not_nodup_le {α : Type} [Fintype N] [Nonempty N] PMF.pure (!decide (res.2.map (fun e => e.1.2)).Nodup)) true ≤ ∑' x, PMF.uniformOfFintype N x * ((PMF.pure (decide (x ∈ tr.map (fun e => e.1.2)))) true + B) := - ENNReal.tsum_le_tsum fun x => mul_le_mul_of_nonneg_left (hx_bound x) zero_le + tsum_le_tsum fun x => mul_le_mul_of_nonneg_left (hx_bound x) zero_le _ = ((PMF.uniformOfFintype N).bind fun x => PMF.pure (decide (x ∈ tr.map (fun e => e.1.2)))) true + B := by - simp only [mul_add, ENNReal.tsum_add, ENNReal.tsum_mul_right, + simp only [mul_add, tsum_add, ENNReal.tsum_mul_right, (PMF.uniformOfFintype N).tsum_coe, one_mul, PMF.bind_apply] _ ≤ (tr.length : ℝ≥0∞) / Fintype.card N + B := add_le_add hmem_le le_rfl _ = ((∑ i ∈ Finset.range (Q + 1), (tr.length + i) : ℕ) : ℝ≥0∞) / Fintype.card N := by @@ -4029,11 +4029,11 @@ theorem randomNonceStrongGame_le_sum_add_max {seed : PMF K} {hash : K → M → ≤ ∑' res, simPMF res * ((PMF.pure (!decide (res.2.map (fun e => e.1.2)).Nodup)) true + max ε (Fintype.card Y : ℝ≥0∞)⁻¹) := - ENNReal.tsum_le_tsum fun res => mul_le_mul_of_nonneg_left (hpoint res) zero_le + tsum_le_tsum fun res => mul_le_mul_of_nonneg_left (hpoint res) zero_le _ = (simPMF.bind fun res => PMF.pure (!decide (res.2.map (fun e => e.1.2)).Nodup)) true + max ε (Fintype.card Y : ℝ≥0∞)⁻¹ := by - simp only [mul_add, ENNReal.tsum_add, ENNReal.tsum_mul_right, simPMF.tsum_coe, one_mul, + simp only [mul_add, tsum_add, ENNReal.tsum_mul_right, simPMF.tsum_coe, one_mul, PMF.bind_apply] _ ≤ ((∑ i ∈ Finset.range Q, i : ℕ) : ℝ≥0∞) / Fintype.card N + max ε (Fintype.card Y : ℝ≥0∞)⁻¹ := by @@ -4485,10 +4485,10 @@ theorem probOracleComp_randomNonceSimHandler_not_nodup_le {α : Type} PMF.pure (!decide (res.2.map (fun e => e.1.2)).Nodup)) true ≤ ∑' x, PMF.uniformOfFintype N x * ((PMF.pure (decide (x ∈ tr.map (fun e => e.1.2)))) true + B) := - ENNReal.tsum_le_tsum fun x => mul_le_mul_of_nonneg_left (hx_bound x) zero_le + tsum_le_tsum fun x => mul_le_mul_of_nonneg_left (hx_bound x) zero_le _ = ((PMF.uniformOfFintype N).bind fun x => PMF.pure (decide (x ∈ tr.map (fun e => e.1.2)))) true + B := by - simp only [mul_add, ENNReal.tsum_add, ENNReal.tsum_mul_right, + simp only [mul_add, tsum_add, ENNReal.tsum_mul_right, (PMF.uniformOfFintype N).tsum_coe, one_mul, PMF.bind_apply] _ ≤ (tr.length : ℝ≥0∞) / Fintype.card N + B := add_le_add hmem_le le_rfl _ = ((∑ i ∈ Finset.range (Q + 1), (tr.length + i) : ℕ) : ℝ≥0∞) / Fintype.card N := by @@ -4610,11 +4610,11 @@ theorem seed_uniform_probOracleComp_checkRandomNonceSUF_le {α : Type} ≤ ∑' res, simPMF res * ((PMF.pure (!decide (res.2.map (fun e => e.1.2)).Nodup)) true + max ε (Fintype.card Y : ℝ≥0∞)⁻¹) := - ENNReal.tsum_le_tsum fun res => mul_le_mul_of_nonneg_left (hpoint res) zero_le + tsum_le_tsum fun res => mul_le_mul_of_nonneg_left (hpoint res) zero_le _ = (simPMF.bind fun res => PMF.pure (!decide (res.2.map (fun e => e.1.2)).Nodup)) true + max ε (Fintype.card Y : ℝ≥0∞)⁻¹ := by - simp only [mul_add, ENNReal.tsum_add, ENNReal.tsum_mul_right, simPMF.tsum_coe, one_mul, + simp only [mul_add, tsum_add, ENNReal.tsum_mul_right, simPMF.tsum_coe, one_mul, PMF.bind_apply] _ ≤ ((∑ i ∈ Finset.range Q, i : ℕ) : ℝ≥0∞) / Fintype.card N + max ε (Fintype.card Y : ℝ≥0∞)⁻¹ := by diff --git a/Complexity/Crypto/Protocols/SigmaProtocol/FiatShamir.lean b/Complexity/Crypto/Protocols/SigmaProtocol/FiatShamir.lean index 2075b932a..39a83a0cb 100644 --- a/Complexity/Crypto/Protocols/SigmaProtocol/FiatShamir.lean +++ b/Complexity/Crypto/Protocols/SigmaProtocol/FiatShamir.lean @@ -391,7 +391,7 @@ private theorem toOuterMeasure_flag_le (P : SigmaProtocol X Y T C Z) (key : X × {x | x.2.2 = true} ≤ ∑' ts, (P.commit key.1 key.2) ts * {ts : T × P.State | (st.1.1.lookup (m, ts.1)).isSome}.indicator 1 ts := by - refine ENNReal.tsum_le_tsum fun ts => mul_le_mul_of_nonneg_left ?_ zero_le + refine tsum_le_tsum fun ts => mul_le_mul_of_nonneg_left ?_ zero_le by_cases hts : (st.1.1.lookup (m, ts.1)).isSome · rw [Set.indicator_of_mem (show ts ∈ {ts : T × P.State | (st.1.1.lookup (m, ts.1)).isSome} from hts), Pi.one_apply] @@ -828,12 +828,12 @@ private theorem bind_apply_le_add {α β : Type} {μ : PMF α} {f g : α → PMF (μ.bind f) b ≤ (μ.bind g) b + K := by simp only [PMF.bind_apply] calc ∑' a, μ a * f a b ≤ ∑' a, μ a * (g a b + K) := by - refine ENNReal.tsum_le_tsum fun a => ?_ + refine tsum_le_tsum fun a => ?_ by_cases ha : a ∈ μ.support · exact mul_le_mul_of_nonneg_left (h a ha) zero_le · rw [(PMF.apply_eq_zero_iff _ _).mpr ha, zero_mul, zero_mul] _ = ∑' a, μ a * g a b + K := by - simp only [mul_add, ENNReal.tsum_add, ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul] + simp only [mul_add, tsum_add, ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul] omit [DecidableEq C] in /-- **The game hops** for one key and one choice of the forger's coins: the experiment wins at diff --git a/Complexity/Languages/Probabilistic/BoundedUniform.lean b/Complexity/Languages/Probabilistic/BoundedUniform.lean index 6fa41f00f..a4166310d 100644 --- a/Complexity/Languages/Probabilistic/BoundedUniform.lean +++ b/Complexity/Languages/Probabilistic/BoundedUniform.lean @@ -187,7 +187,7 @@ private theorem retry_some (bound value : ℕ) (next : PMF (Option ℕ)) : simp [hib, hiv] change (∑' i, μ i * (if i < bound then PMF.pure (some i) else next) (some value)) = _ simp_rw [hterm] - rw [ENNReal.tsum_add] + rw [tsum_add] simp only [tsum_ite_eq] rw [show μ bound = (intervalFailure bound : ℝ≥0∞) from eval_sampleBoundedIndex_sentinel bound] by_cases hv : value < bound @@ -342,7 +342,7 @@ private theorem uniformFin_nat_apply (bound value : ℕ) [NeZero bound] : · intro i hi have : value ≠ i.val := fun h => hi (Fin.ext h.symm) simp [this] - · rw [ENNReal.tsum_eq_zero.mpr] + · rw [tsum_eq_zero_iff.mpr] · simp [hv] · intro i have : value ≠ i.val := by omega @@ -364,7 +364,7 @@ theorem eval_sampleUniformInterval_some_eq (bound attempts value : ℕ) [NeZero private theorem tsum_option_eq {α : Type} (f : Option α → ℝ≥0∞) : ∑' x, f x = f none + ∑' x, f (some x) := by rw [← (Equiv.optionEquivSumPUnit.{0, 0} α).symm.tsum_eq f] - rw [ENNReal.summable.tsum_sum ENNReal.summable] + rw [CompleteLattice.summable.tsum_sum CompleteLattice.summable] simp [add_comm] private theorem optional_map_density {α β : Type} (μ : PMF (Option α)) (ν : PMF α) diff --git a/Complexity/Languages/Probabilistic/Expect.lean b/Complexity/Languages/Probabilistic/Expect.lean index 3785b103e..6b22d82f8 100644 --- a/Complexity/Languages/Probabilistic/Expect.lean +++ b/Complexity/Languages/Probabilistic/Expect.lean @@ -70,7 +70,7 @@ theorem expect_zero (m : ProbComp α) : expect m (fun _ => 0) = 0 := theorem expect_add (m : ProbComp α) (f g : α → ℝ≥0∞) : expect m (fun a => f a + g a) = expect m f + expect m g := by - simp only [expect, mul_add, ENNReal.tsum_add] + simp only [expect, mul_add, tsum_add] theorem expect_mul_left (m : ProbComp α) (c : ℝ≥0∞) (f : α → ℝ≥0∞) : expect m (fun a => c * f a) = c * expect m f := by @@ -86,7 +86,7 @@ theorem expect_mul_right (m : ProbComp α) (f : α → ℝ≥0∞) (c : ℝ≥0 theorem expect_bind (m : ProbComp α) (k : α → ProbComp β) (f : β → ℝ≥0∞) : expect (m >>= k) f = expect m (fun a => expect (k a) f) := by simp only [expect, eval_bind, PMF.bind_apply, ← ENNReal.tsum_mul_right] - rw [ENNReal.tsum_comm] + rw [tsum_comm] congr 1 funext a simp only [mul_assoc, ENNReal.tsum_mul_left] @@ -107,7 +107,7 @@ theorem expect_congr_on_support {m : ProbComp α} {f g : α → ℝ≥0∞} theorem expect_mono_on_support {m : ProbComp α} {f g : α → ℝ≥0∞} (h : ∀ a ∈ m.support, f a ≤ g a) : expect m f ≤ expect m g := by - refine ENNReal.tsum_le_tsum fun a => ?_ + refine tsum_le_tsum fun a => ?_ by_cases ha : a ∈ m.support · exact mul_le_mul_right (h a ha) _ · have hzero : (eval m) a = 0 := (PMF.apply_eq_zero_iff (eval m) a).mpr (by @@ -129,7 +129,7 @@ theorem expect_eq_top_of_mem_support {m : ProbComp α} {f : α → ℝ≥0∞} { refine top_unique ?_ calc (⊤ : ℝ≥0∞) = (eval m) a * f a := by rw [hf, ENNReal.mul_top hpos] - _ ≤ expect m f := ENNReal.le_tsum (f := fun b => (eval m) b * f b) a + _ ≤ expect m f := le_tsum (f := fun b => (eval m) b * f b) a theorem expect_unifFin (n : ℕ) (f : Fin (n + 1) → ℝ≥0∞) : expect (unifFin n) f = (∑ k : Fin (n + 1), f k) / (n + 1 : ℝ≥0∞) := by diff --git a/Complexity/Languages/Probabilistic/Oracle/Interaction.lean b/Complexity/Languages/Probabilistic/Oracle/Interaction.lean index 6aa1215f3..d822a739c 100644 --- a/Complexity/Languages/Probabilistic/Oracle/Interaction.lean +++ b/Complexity/Languages/Probabilistic/Oracle/Interaction.lean @@ -168,7 +168,7 @@ theorem acceptProbWith_bind_ite_le (program : ProbOracleComp spec Bool) acceptProbWith oracle program s := by conv_rhs => rw [← bind_pure program, acceptProbWith_bind] rw [acceptProbWith_bind] - refine ENNReal.tsum_le_tsum fun x => mul_le_mul_right ?_ _ + refine tsum_le_tsum fun x => mul_le_mul_right ?_ _ cases x.1 · simp only [Bool.false_eq_true, ↓reduceIte, le_refl] · simp only [↓reduceIte, acceptProbWith_pure] diff --git a/Complexity/Languages/Probabilistic/RandomPermutation.lean b/Complexity/Languages/Probabilistic/RandomPermutation.lean index f8b175e6d..153ac0a84 100644 --- a/Complexity/Languages/Probabilistic/RandomPermutation.lean +++ b/Complexity/Languages/Probabilistic/RandomPermutation.lean @@ -1175,9 +1175,9 @@ theorem toOuterMeasure_bad_choose_two_le {ι σ β : Type} {spec : ι → Type} calc ∑' y, (handler q s) y * ((OracleComp.interpret handler (cont y.1)).run y.2).toOuterMeasure {x | bad x.2} ≤ ∑' y, (handler q s) y * ({x : spec q × σ | bad x.2}.indicator 1 y + K) := - ENNReal.tsum_le_tsum hterm + tsum_le_tsum hterm _ = (handler q s).toOuterMeasure {x | bad x.2} + K := by - simp only [mul_add, ENNReal.tsum_add, ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul, + simp only [mul_add, tsum_add, ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul, PMF.toOuterMeasure_apply] congr 1 refine tsum_congr fun y => ?_ @@ -1413,8 +1413,8 @@ theorem toOuterMeasure_forgetfulAnswer_le_pairwise_and_length_le_add {β : Type} {x | (x.2.Pairwise (fun a b => a.1 ≠ b.1) ∧ x.2.Pairwise (fun a b => a.2 ≠ b.2) ∧ x.2.length ≤ Q) ∧ P x.2}) + q.toOuterMeasure {x | x.2.2 = true} - simp only [PMF.toOuterMeasure_apply, ← ENNReal.tsum_add] - refine ENNReal.tsum_le_tsum fun ⟨a, c, b⟩ => ?_ + simp only [PMF.toOuterMeasure_apply, ← tsum_add] + refine tsum_le_tsum fun ⟨a, c, b⟩ => ?_ by_cases hmem : (a, (c, b)) ∈ q.support · by_cases hP : P c · cases b with diff --git a/Complexity/Languages/Probabilistic/UntilBad.lean b/Complexity/Languages/Probabilistic/UntilBad.lean index 7bcd7e202..ac26422b6 100644 --- a/Complexity/Languages/Probabilistic/UntilBad.lean +++ b/Complexity/Languages/Probabilistic/UntilBad.lean @@ -129,8 +129,8 @@ theorem bind_apply_le (h : IdenticalUntilBad first second bad) (program : Oracle ((interpret first program).run s).toOuterMeasure {x | bad x.2} := by classical simp only [PMF.bind_apply, PMF.toOuterMeasure_apply] - rw [← ENNReal.tsum_add] - refine ENNReal.tsum_le_tsum fun x => ?_ + rw [← tsum_add] + refine tsum_le_tsum fun x => ?_ by_cases hx : bad x.2 · have hbad : x ∈ {x : α × σ | bad x.2} := hx rw [Set.indicator_of_mem hbad] @@ -153,7 +153,7 @@ private theorem toOuterMeasure_bad_add_good (p : PMF (α × σ)) : p.toOuterMeasure {x | bad x.2} + p.toOuterMeasure {x | ¬bad x.2} = 1 := by classical simp only [PMF.toOuterMeasure_apply] - rw [← ENNReal.tsum_add, ← p.tsum_coe] + rw [← tsum_add, ← p.tsum_coe] refine tsum_congr fun x => ?_ by_cases hx : bad x.2 · rw [Set.indicator_of_mem (show x ∈ {x : α × σ | bad x.2} from hx), @@ -244,9 +244,9 @@ theorem toOuterMeasure_bad_le {handler : (q : ι) → StateT σ PMF (spec q)} {b calc ∑' y, (handler q s) y * ((interpret handler (cont y.1)).run y.2).toOuterMeasure {x | bad x.2} ≤ ∑' y, (handler q s) y * ({x : spec q × σ | bad x.2}.indicator 1 y + K) := - ENNReal.tsum_le_tsum hterm + tsum_le_tsum hterm _ = (handler q s).toOuterMeasure {x | bad x.2} + K := by - simp only [mul_add, ENNReal.tsum_add, ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul, + simp only [mul_add, tsum_add, ENNReal.tsum_mul_right, PMF.tsum_coe, one_mul, PMF.toOuterMeasure_apply] congr 1 refine tsum_congr fun y => ?_ diff --git a/Complexity/Languages/Probabilistic/Vector.lean b/Complexity/Languages/Probabilistic/Vector.lean index 5e43aaaa5..4f3e7ead7 100644 --- a/Complexity/Languages/Probabilistic/Vector.lean +++ b/Complexity/Languages/Probabilistic/Vector.lean @@ -274,7 +274,7 @@ theorem eval_pi {m : ℕ} {α : Fin m → Type} [∀ i, Finite (α i)] funext i simpa using (congrFun hEq (Fin.succ i)).symm · intro a ha - simp only [mul_eq_zero, ENNReal.tsum_eq_zero] + simp only [mul_eq_zero, tsum_eq_zero_iff] right intro b rw [ite_eq_right] diff --git a/Complexity/Probability/Conditioning.lean b/Complexity/Probability/Conditioning.lean index faca6d699..340e70ef4 100644 --- a/Complexity/Probability/Conditioning.lean +++ b/Complexity/Probability/Conditioning.lean @@ -48,7 +48,7 @@ variable {α β : Type*} theorem map_fst_apply (joint : PMF (α × β)) (a : α) : (joint.map Prod.fst) a = ∑' b, joint (a, b) := by classical - rw [PMF.map_apply, ENNReal.tsum_prod'] + rw [PMF.map_apply, tsum_prod'] rw [tsum_eq_single a] · simp · intro x hx @@ -72,9 +72,9 @@ theorem conditionalSnd_apply (joint : PMF (α × β)) (a : α) conditionalSnd joint a b = joint (a, b) / (joint.map Prod.fst) a := by classical have hpost : a ∈ (joint.bind (fun pair => PMF.pure pair.1)).support := ha - simp only [conditionalSnd, hpost, dite_true, PMF.map_apply, ENNReal.tsum_prod', + simp only [conditionalSnd, hpost, dite_true, PMF.map_apply, tsum_prod', posteriorDist_apply, bind_pair_apply, PMF.pure_apply] - simp [ENNReal.tsum_prod', div_eq_mul_inv] + simp [tsum_prod', div_eq_mul_inv] /-- Multiplying by the marginal recovers the joint mass, also at zero-probability observations. -/ theorem marginal_mul_conditionalSnd (joint : PMF (α × β)) (a : α) (b : β) : diff --git a/Complexity/Probability/CorrelatedSampling.lean b/Complexity/Probability/CorrelatedSampling.lean index 5e9f61775..ae9ebd647 100644 --- a/Complexity/Probability/CorrelatedSampling.lean +++ b/Complexity/Probability/CorrelatedSampling.lean @@ -171,7 +171,7 @@ theorem map_firstIn_weightedOrderAux (w : Ω → ℝ≥0) : rcases o with _ | c · rw [PMF.bind_apply, PMF.map_apply] simp only [reduceCtorEq, ite_false, tsum_zero] - refine ENNReal.tsum_eq_zero.mpr fun a => ?_ + refine tsum_eq_zero_iff.mpr fun a => ?_ split_ifs <;> simp [PMF.map_apply] rw [PMF.bind_apply, tsum_fintype, hrhs] set du := weightedDraw w U hU0 diff --git a/Complexity/Probability/Forking.lean b/Complexity/Probability/Forking.lean index 960ea5e2e..b13827992 100644 --- a/Complexity/Probability/Forking.lean +++ b/Complexity/Probability/Forking.lean @@ -215,7 +215,7 @@ private theorem bind_match_apply {X : Type} (μ : PMF X) (index : X → Option ( | some j => decide (event j x))) true = ∑ j, (μ.bind fun x => PMF.pure (decide (index x = some j ∧ event j x))) true := by simp only [PMF.bind_apply, PMF.pure_apply] - rw [← Summable.tsum_finsetSum fun _ _ => ENNReal.summable] + rw [← Summable.tsum_finsetSum fun _ _ => CompleteLattice.summable] refine tsum_congr fun x => ?_ rw [← Finset.mul_sum] congr 1 diff --git a/Complexity/Probability/IID.lean b/Complexity/Probability/IID.lean index 74388f5b5..0a600cf4a 100644 --- a/Complexity/Probability/IID.lean +++ b/Complexity/Probability/IID.lean @@ -73,7 +73,7 @@ noncomputable def iid (μ : PMF α) : (k : ℕ) → PMF (Fin k → α) intro h exact absurd (by rw [h, Fin.tail_cons]) hw · intro a ha - rw [PMF.map_apply, ENNReal.tsum_eq_zero.mpr, mul_zero] + rw [PMF.map_apply, tsum_eq_zero_iff.mpr, mul_zero] intro w simp only [ite_eq_right_iff] intro h diff --git a/Complexity/Probability/MinEntropy.lean b/Complexity/Probability/MinEntropy.lean index 15120ffd6..29fd28b12 100644 --- a/Complexity/Probability/MinEntropy.lean +++ b/Complexity/Probability/MinEntropy.lean @@ -183,7 +183,7 @@ theorem le_minEntropy_bind (μ : PMF β) (f : β → PMF α) {k : ℝ} apply ENNReal.toReal_le_of_le_ofReal hk calc μ.bind f a = ∑' b, μ b * f b a := PMF.bind_apply μ f a - _ ≤ ∑' b, μ b * ENNReal.ofReal (2 ^ (-k)) := ENNReal.tsum_le_tsum hcomponent + _ ≤ ∑' b, μ b * ENNReal.ofReal (2 ^ (-k)) := tsum_le_tsum hcomponent _ = ENNReal.ofReal (2 ^ (-k)) := by rw [ENNReal.tsum_mul_right, μ.tsum_coe, one_mul] /-! ### Weak random sources -/ diff --git a/Complexity/Probability/Minimax.lean b/Complexity/Probability/Minimax.lean index e34129b86..ba395a192 100644 --- a/Complexity/Probability/Minimax.lean +++ b/Complexity/Probability/Minimax.lean @@ -213,10 +213,10 @@ theorem exists_mem_support_tsum_mul_le (μ : PMF α) (ν : PMF β) (loss : α calc ∑' a, μ a * ∑' b, ν b * loss a b = ∑' b, ν b * ∑' a, μ a * loss a b := by simp only [← ENNReal.tsum_mul_left] - rw [ENNReal.tsum_comm] + rw [tsum_comm] exact tsum_congr fun b => tsum_congr fun a => by ring _ ≤ ∑' b, ν b * ε := by - refine ENNReal.tsum_le_tsum fun b => ?_ + refine tsum_le_tsum fun b => ?_ by_cases hb : b ∈ ν.support · gcongr exact h b hb diff --git a/Complexity/Probability/PMF/Bind.lean b/Complexity/Probability/PMF/Bind.lean index fcdd9502b..c3b9858bc 100644 --- a/Complexity/Probability/PMF/Bind.lean +++ b/Complexity/Probability/PMF/Bind.lean @@ -53,7 +53,7 @@ theorem bind_sigma_apply {β : α → Type*} (p : PMF α) (f : (a : α) → PMF (p.bind (fun a => (f a).map (Sigma.mk a))) ⟨a, b⟩ = p a * f a b := by classical simp only [PMF.bind_apply, PMF.map_apply, ← ENNReal.tsum_mul_left, mul_ite, mul_zero] - rw [← ENNReal.tsum_sigma] + rw [← tsum_sigma] simp /-- A continuation only needs to agree on outcomes the preceding distribution can produce. -/ @@ -76,7 +76,7 @@ theorem le_bind_apply_on_support (μ : PMF α) {f : α → PMF β} {b : β} {c : (h : ∀ a ∈ μ.support, c ≤ f a b) : c ≤ μ.bind f b := by rw [PMF.bind_apply] calc c = ∑' a, μ a * c := by rw [ENNReal.tsum_mul_right, μ.tsum_coe, one_mul] - _ ≤ ∑' a, μ a * f a b := ENNReal.tsum_le_tsum fun a => by + _ ≤ ∑' a, μ a * f a b := tsum_le_tsum fun a => by by_cases ha : a ∈ μ.support · exact mul_le_mul_right (h a ha) _ · simp [(PMF.apply_eq_zero_iff μ a).2 ha] @@ -87,7 +87,7 @@ theorem bind_apply_le_on_support (μ : PMF α) {f : α → PMF β} {b : β} {c : (h : ∀ a ∈ μ.support, f a b ≤ c) : μ.bind f b ≤ c := by rw [PMF.bind_apply] calc ∑' a, μ a * f a b - _ ≤ ∑' a, μ a * c := ENNReal.tsum_le_tsum fun a => by + _ ≤ ∑' a, μ a * c := tsum_le_tsum fun a => by by_cases ha : a ∈ μ.support · exact mul_le_mul_right (h a ha) _ · simp [(PMF.apply_eq_zero_iff μ a).2 ha] @@ -98,7 +98,7 @@ probability in the whole experiment. The sample spaces may be infinite. -/ theorem bind_apply_mono_on_support (μ : PMF α) {f g : α → PMF β} (b : β) (h : ∀ a ∈ μ.support, f a b ≤ g a b) : μ.bind f b ≤ μ.bind g b := by simp only [PMF.bind_apply] - apply ENNReal.tsum_le_tsum + apply tsum_le_tsum intro a by_cases ha : a ∈ μ.support · exact mul_le_mul_right (h a ha) _ @@ -117,7 +117,7 @@ theorem exists_bind_apply_le [Finite α] (μ : PMF α) (f : α → PMF β) (b : /-- An average of values at most `B` is at most `B`. -/ theorem tsum_mul_le_of_forall_le (μ : PMF α) {f : α → ℝ≥0∞} {B : ℝ≥0∞} (h : ∀ a, f a ≤ B) : ∑' a, μ a * f a ≤ B := - calc ∑' a, μ a * f a ≤ ∑' a, μ a * B := ENNReal.tsum_le_tsum fun a => mul_le_mul_right (h a) _ + calc ∑' a, μ a * f a ≤ ∑' a, μ a * B := tsum_le_tsum fun a => mul_le_mul_right (h a) _ _ = B := by rw [ENNReal.tsum_mul_right, μ.tsum_coe, one_mul] /-- Values at most `1` on a finite set `T` and at most `B` elsewhere average to at most @@ -126,9 +126,9 @@ theorem tsum_mul_le_card_mul_add [DecidableEq α] (μ : PMF α) {ε : ℝ≥0∞ (T : Finset α) {f : α → ℝ≥0∞} {B : ℝ≥0∞} (h : ∀ a, f a ≤ (if a ∈ T then 1 else 0) + B) : ∑' a, μ a * f a ≤ T.card * ε + B := by calc ∑' a, μ a * f a ≤ ∑' a, (μ a * (if a ∈ T then 1 else 0) + μ a * B) := - ENNReal.tsum_le_tsum fun a => (mul_le_mul_right (h a) _).trans_eq (mul_add _ _ _) + tsum_le_tsum fun a => (mul_le_mul_right (h a) _).trans_eq (mul_add _ _ _) _ = ∑ a ∈ T, μ a + B := by - rw [ENNReal.tsum_add, ENNReal.tsum_mul_right, μ.tsum_coe, one_mul, + rw [tsum_add, ENNReal.tsum_mul_right, μ.tsum_coe, one_mul, tsum_eq_sum (s := T) fun a ha => by simp only [ha, ↓reduceIte, mul_zero]] congr 1 exact Finset.sum_congr rfl fun a ha => by simp only [ha, ↓reduceIte, mul_one] diff --git a/Complexity/Probability/PMF/Event.lean b/Complexity/Probability/PMF/Event.lean index ce673d7ce..16a45d6e8 100644 --- a/Complexity/Probability/PMF/Event.lean +++ b/Complexity/Probability/PMF/Event.lean @@ -73,7 +73,7 @@ theorem toOuterMeasure_ne_top (p : PMF α) (event : Set α) : p.toOuterMeasure e /-- An event has probability at most one. -/ theorem toOuterMeasure_le_one (p : PMF α) (event : Set α) : p.toOuterMeasure event ≤ 1 := by rw [PMF.toOuterMeasure_apply, ← p.tsum_coe] - exact ENNReal.tsum_le_tsum (fun a => Set.indicator_apply_le (fun _ => le_rfl)) + exact tsum_le_tsum (fun a => Set.indicator_apply_le (fun _ => le_rfl)) /-- The event that `f a` deviates from `m` by at least `ε` is covered by the upper tail `m + ε ≤ f a` and the lower tail `f a ≤ m - ε`. -/ @@ -111,7 +111,7 @@ theorem toOuterMeasure_apply_toReal [Fintype α] (p : PMF α) (event : Set α) : theorem toOuterMeasure_toReal_add_compl (p : PMF α) (event : Set α) : (p.toOuterMeasure event).toReal + (p.toOuterMeasure eventᶜ).toReal = 1 := by have h : p.toOuterMeasure event + p.toOuterMeasure eventᶜ = 1 := by - rw [PMF.toOuterMeasure_apply, PMF.toOuterMeasure_apply, ← ENNReal.tsum_add] + rw [PMF.toOuterMeasure_apply, PMF.toOuterMeasure_apply, ← tsum_add] convert p.tsum_coe using 1 congr 1 funext a @@ -154,7 +154,7 @@ theorem toOuterMeasure_bind_failure_le (p : PMF α) (kernel : α → PMF β) rw [PMF.toOuterMeasure_bind_apply, PMF.toOuterMeasure_apply] calc _ ≤ ∑' a, ((preᶜ).indicator p a + p a * error) := by - apply ENNReal.tsum_le_tsum + apply tsum_le_tsum intro a by_cases ha : a ∈ pre · simp only [Set.indicator_of_notMem (show a ∉ preᶜ by simpa), zero_add] @@ -165,7 +165,7 @@ theorem toOuterMeasure_bind_failure_le (p : PMF α) (kernel : α → PMF β) · simp only [Set.indicator_of_mem (show a ∈ preᶜ from ha)] exact (mul_le_mul_of_nonneg_left (toOuterMeasure_le_one (kernel a) failure) zero_le).trans (by simp) - _ = _ := by rw [ENNReal.tsum_add, ENNReal.tsum_mul_right, p.tsum_coe, one_mul] + _ = _ := by rw [tsum_add, ENNReal.tsum_mul_right, p.tsum_coe, one_mul] /-- The real-valued error rule for a randomized continuation. -/ theorem toOuterMeasure_bind_failure_toReal_le (p : PMF α) (kernel : α → PMF β) @@ -193,7 +193,7 @@ theorem toOuterMeasure_bind_ge_mul (p : PMF α) (kernel : α → PMF β) classical have hle : p.toOuterMeasure pre * ENNReal.ofReal s₂ ≤ (p.bind kernel).toOuterMeasure event := by rw [PMF.toOuterMeasure_bind_apply, PMF.toOuterMeasure_apply, ← ENNReal.tsum_mul_right] - refine ENNReal.tsum_le_tsum fun a => ?_ + refine tsum_le_tsum fun a => ?_ by_cases ha : a ∈ pre · simp only [Set.indicator_of_mem ha] by_cases hs : a ∈ p.support @@ -242,7 +242,7 @@ theorem map_true_mono (p : PMF α) {E F : α → Bool} (h : ∀ a ∈ p.support, E a = true → F a = true) : (p.map E) true ≤ (p.map F) true := by rw [PMF.map_apply, PMF.map_apply] - refine ENNReal.tsum_le_tsum fun a => ?_ + refine tsum_le_tsum fun a => ?_ by_cases ha : a ∈ p.support · by_cases hE : true = E a · simp [← hE, h a ha hE.symm] @@ -253,8 +253,8 @@ theorem map_true_mono (p : PMF α) {E F : α → Bool} theorem map_true_le_add (p : PMF α) {E A B : α → Bool} (h : ∀ a ∈ p.support, E a = true → A a = true ∨ B a = true) : (p.map E) true ≤ (p.map A) true + (p.map B) true := by - rw [PMF.map_apply, PMF.map_apply, PMF.map_apply, ← ENNReal.tsum_add] - refine ENNReal.tsum_le_tsum fun a => ?_ + rw [PMF.map_apply, PMF.map_apply, PMF.map_apply, ← tsum_add] + refine tsum_le_tsum fun a => ?_ by_cases ha : a ∈ p.support · by_cases hE : true = E a · rcases h a ha hE.symm with hA | hB diff --git a/Complexity/Probability/PMF/Map.lean b/Complexity/Probability/PMF/Map.lean index eed796d9b..4aad0a45d 100644 --- a/Complexity/Probability/PMF/Map.lean +++ b/Complexity/Probability/PMF/Map.lean @@ -40,7 +40,7 @@ variable {α β : Type*} theorem le_map_apply (p : PMF α) (f : α → β) (a : α) : p a ≤ (p.map f) (f a) := by classical rw [PMF.map_apply] - simpa using ENNReal.le_tsum (f := fun x => if f a = f x then p x else 0) a + simpa using le_tsum (f := fun x => if f a = f x then p x else 0) a /-- Relabeling a distribution by an equivalence preserves each corresponding point mass. -/ theorem map_equiv_apply (p : PMF α) (e : α ≃ β) (b : β) : diff --git a/Complexity/Probability/ProductConditioning/SideInformation.lean b/Complexity/Probability/ProductConditioning/SideInformation.lean index 316b7c63c..11c12f8fe 100644 --- a/Complexity/Probability/ProductConditioning/SideInformation.lean +++ b/Complexity/Probability/ProductConditioning/SideInformation.lean @@ -186,7 +186,7 @@ theorem sideJoint_apply (μ : PMF T) (J : T → PMF ((∀ i, β i) × V)) (t : T exact hx (Prod.ext (congrArg Prod.snd h).symm (congrArg (·.2) (congrArg Prod.fst h)).symm) · intro t' ht' rw [PMF.map_apply] - refine mul_eq_zero_of_right _ (ENNReal.tsum_eq_zero.mpr fun x => ite_eq_right fun h => ?_) + refine mul_eq_zero_of_right _ (tsum_eq_zero_iff.mpr fun x => ite_eq_right fun h => ?_) exact absurd (congrArg (·.1) (congrArg Prod.fst h)) (Ne.symm ht') /-- The pairs `(u, v)` that complete `(t, v)` to an outcome in `W`. -/ diff --git a/Complexity/Probability/RejectionSampling.lean b/Complexity/Probability/RejectionSampling.lean index d317c0d2f..83b85bf82 100644 --- a/Complexity/Probability/RejectionSampling.lean +++ b/Complexity/Probability/RejectionSampling.lean @@ -144,7 +144,7 @@ theorem shiftReject_apply_some (hv : ∀ z ∈ S, z - v ∈ B) (z : α) : · intro y hy have hyz : y + v ≠ z := fun h => hy (eq_sub_of_add_eq h) split_ifs <;> simp_all [eq_comm] - · refine ENNReal.tsum_eq_zero.mpr fun y => ?_ + · refine tsum_eq_zero_iff.mpr fun y => ?_ split_ifs with h₁ h₂ <;> simp_all /-- **Rejection sampling, aborts.** Under the same hypothesis, the sampler aborts with @@ -156,7 +156,7 @@ theorem shiftReject_apply_none (hv : ∀ z ∈ S, z - v ∈ B) : rw [tsum_eq_sum (s := S) fun z hz => by simp [hz], Finset.sum_ite_mem, Finset.inter_self, Finset.sum_const, nsmul_eq_mul, div_eq_mul_inv] have htotal := (shiftReject B S hB v).tsum_coe - rw [ENNReal.tsum_eq_add_tsum_ite none, ← (Option.some_injective α).tsum_eq] at htotal + rw [tsum_eq_add_tsum_ite none, ← (Option.some_injective α).tsum_eq] at htotal · simp only [reduceCtorEq, ite_false, hsome] at htotal exact ENNReal.eq_sub_of_add_eq (ENNReal.div_ne_top (ENNReal.natCast_ne_top _) (by simpa using hB.ne_empty)) htotal From d7dcd7985e43c0678127230df389fa8ea3e3ea61 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Thu, 29 Oct 2026 15:21:52 -0400 Subject: [PATCH 08/12] fix(build): adapt proofs to the rc2 Mathlib API Qualify newly protected matrix and finite-sum lemmas, publicly import the relocated Matrix.Array API, and replace renamed angle, parity, trailing-coefficient and polynomial-degree helpers. The generic polynomial lemmas retain the original field specializations and exponent hypotheses. No theorem statement or definition body changes. Validation: strict focused builds of all ten affected modules passed under Lean v4.36.0-rc2. Source comparison against d6ccb24f shows all Lean edits are inside theorem proofs except the required Bird import. --- Complexity/Computability/Circuit/Bird.lean | 1 + Complexity/Computability/Circuit/Quantum/Basic.lean | 4 ++-- Complexity/Computability/Circuit/Rational/Wronskian.lean | 2 +- .../Foundations/BooleanAnalysis/LowDegree/Addition.lean | 2 +- .../Foundations/BooleanAnalysis/SparseEquations.lean | 2 +- .../FieldTheory/Finite/LinearizedPolynomial.lean | 6 +++--- Complexity/Foundations/LinearAlgebra/Matrix/ListProd.lean | 4 ++-- Complexity/Foundations/LinearAlgebra/Matrix/Rank.lean | 2 +- .../Foundations/LinearAlgebra/Matrix/SubmatrixRobust.lean | 8 ++++---- Complexity/Foundations/Probability/Gaussian/Sheppard.lean | 2 +- 10 files changed, 17 insertions(+), 16 deletions(-) diff --git a/Complexity/Computability/Circuit/Bird.lean b/Complexity/Computability/Circuit/Bird.lean index 62b11531b..a39c61ae9 100644 --- a/Complexity/Computability/Circuit/Bird.lean +++ b/Complexity/Computability/Circuit/Bird.lean @@ -8,6 +8,7 @@ module -- upstream: candidate public import Complexity.Init +public import Mathlib.LinearAlgebra.Matrix.Array public import Mathlib.LinearAlgebra.Matrix.Determinant.Bird.Defs public import Mathlib.LinearAlgebra.Matrix.Determinant.Basic import Mathlib.Algebra.Order.BigOperators.Group.LocallyFinite diff --git a/Complexity/Computability/Circuit/Quantum/Basic.lean b/Complexity/Computability/Circuit/Quantum/Basic.lean index 7797874a4..c9265f0f4 100644 --- a/Complexity/Computability/Circuit/Quantum/Basic.lean +++ b/Complexity/Computability/Circuit/Quantum/Basic.lean @@ -172,7 +172,7 @@ theorem place_apply (A : Fin k ↪ Fin n) (U : unitaryGroup (Fin k → Bool) ℂ (place A U : Matrix _ _ ℂ) y x = if ∀ j, (¬∃ i, A i = j) → y j = x j then (U : Matrix _ _ ℂ) (y ∘ A) (x ∘ A) else 0 := by simp only [place, MonoidHom.coe_mk, OneHom.coe_mk, submatrix_apply, kroneckerMap_apply, - splitEquiv_apply_fst, splitEquiv_apply_snd, one_apply, funext_iff, Subtype.forall] + splitEquiv_apply_fst, splitEquiv_apply_snd, Matrix.one_apply, funext_iff, Subtype.forall] split_ifs <;> simp namespace PlacedGate @@ -281,7 +281,7 @@ theorem hadamardMatrix_mem_unitaryGroup : hadamardMatrix ∈ unitaryGroup Bool rw [mem_unitaryGroup_iff] ext b c cases b <;> cases c <;> - simp [hadamardMatrix, mul_apply, star_eq_conjTranspose, Complex.conj_ofReal, h2, h1] + simp [hadamardMatrix, Matrix.mul_apply, star_eq_conjTranspose, Complex.conj_ofReal, h2, h1] theorem star_hadamardMatrix : star hadamardMatrix = hadamardMatrix := by ext b c diff --git a/Complexity/Computability/Circuit/Rational/Wronskian.lean b/Complexity/Computability/Circuit/Rational/Wronskian.lean index f2ce76817..138a37718 100644 --- a/Complexity/Computability/Circuit/Rational/Wronskian.lean +++ b/Complexity/Computability/Circuit/Rational/Wronskian.lean @@ -148,7 +148,7 @@ lemma wronskian_order_of_distinct_orders {K : Type*} [Field K] [CharZero K] Matrix.det_mul_row (fun j => (f j).trailingCoeff) (Matrix.of fun i j : Fin h => ((f j).natTrailingDegree.descFactorial i.val : K))] exact mul_ne_zero (Finset.prod_ne_zero_iff.mpr fun j _ => - trailingCoeff_nonzero_iff_nonzero.mpr (hf j)) (det_descFactorial_ne_zero _ hd) + trailingCoeff_ne_zero.mpr (hf j)) (det_descFactorial_ne_zero _ hd) have hB0 : B.det ≠ 0 := fun hz => by simp [hz] at hBc have hA0 : A.det ≠ 0 := hdet ▸ mul_ne_zero (pow_ne_zero _ X_ne_zero) hB0 have hscale : A.det = X ^ (∑ i : Fin h, i.val) * wronskianFamily f := by diff --git a/Complexity/Foundations/BooleanAnalysis/LowDegree/Addition.lean b/Complexity/Foundations/BooleanAnalysis/LowDegree/Addition.lean index 905b6c11a..271991b3b 100644 --- a/Complexity/Foundations/BooleanAnalysis/LowDegree/Addition.lean +++ b/Complexity/Foundations/BooleanAnalysis/LowDegree/Addition.lean @@ -82,7 +82,7 @@ theorem hasSliceDecomposition_add (p q : ℕ) : have hexpand : (fun x y : ι → Bool => monomial K S.1 (x + y)) = ∑ T ∈ S.1.powerset, (fun x y => monomial K T x * monomial K (S.1 \ T) y) := by funext x y - simp only [sum_apply, monomial_add] + simp only [Finset.sum_apply, monomial_add] rw [hexpand] apply (sliceSpace (lowDegree K ι p) (lowDegree K ι q)).sum_mem intro T hT diff --git a/Complexity/Foundations/BooleanAnalysis/SparseEquations.lean b/Complexity/Foundations/BooleanAnalysis/SparseEquations.lean index d9daca94e..d1bc719e3 100644 --- a/Complexity/Foundations/BooleanAnalysis/SparseEquations.lean +++ b/Complexity/Foundations/BooleanAnalysis/SparseEquations.lean @@ -143,7 +143,7 @@ is even. -/ theorem monomialSum_zmod_two_eq_zero_iff_even (𝓜 : Finset (Finset ι)) (x : ι → Bool) : monomialSum (ZMod 2) 𝓜 x = 0 ↔ Even (monomialSum ℤ 𝓜 x) := by rw [monomialSum_eq_card_filter (ZMod 2), monomialSum_eq_card_filter ℤ, - ZMod.natCast_eq_zero_iff_even, Int.even_coe_nat] + ZMod.natCast_eq_zero_iff_even, Int.even_natCast] /-- An assignment `x : ι → Bool` is a common zero of the family `{P i}_{i ∈ I}` over `𝔽₂` if every equation `P i` (`i ∈ I`) evaluates to `0` in `ZMod 2` at `x`. -/ diff --git a/Complexity/Foundations/FieldTheory/Finite/LinearizedPolynomial.lean b/Complexity/Foundations/FieldTheory/Finite/LinearizedPolynomial.lean index 09309146e..a27032be5 100644 --- a/Complexity/Foundations/FieldTheory/Finite/LinearizedPolynomial.lean +++ b/Complexity/Foundations/FieldTheory/Finite/LinearizedPolynomial.lean @@ -252,7 +252,7 @@ private theorem comp_eq_X_pow_card_sub_X [Fintype F] {P Q : F[X]} ⟨by rw [natDegree_comp, hdeg], hQm.comp hPm hPdeg⟩ have hX : IsMonicOfDegree (X ^ Fintype.card F - X : F[X]) (Fintype.card F) := by rw [isMonicOfDegree_iff] - refine ⟨(FiniteField.X_pow_card_sub_X_natDegree_eq F hq1).le, ?_⟩ + refine ⟨(natDegree_X_pow_sub_X (R := F) hq1).le, ?_⟩ have h1 : (1 : ℕ) ≠ Fintype.card F := hq1.ne simp [coeff_X, h1] rw [← sub_eq_zero] @@ -410,10 +410,10 @@ theorem exists_subfield_card_le [Finite F] {n k : ℕ} (hn : finrank (ZMod 2) F have h1 : 1 < 2 ^ k := Nat.one_lt_two_pow hk0.ne' have hcard : Fintype.card F = 2 ^ n := by rw [Module.card_eq_pow_finrank (K := ZMod 2) (V := F), ZMod.card, hn] - refine FiniteField.X_pow_card_sub_X_ne_zero F h1 + refine X_pow_sub_X_ne_zero (R := F) h1 (eq_zero_of_natDegree_lt_card_of_eval_eq_zero _ (f := id) Function.injective_id (fun x => by simp [hall x]) ?_) - rw [FiniteField.X_pow_card_sub_X_natDegree_eq F h1, hcard] + rw [natDegree_X_pow_sub_X (R := F) h1, hcard] exact Nat.pow_lt_pow_right (by norm_num) hkn · by_cases hW : ∃ y₀ ∈ W, y₀ ≠ 0 · obtain ⟨y₀, hy₀W, hy₀⟩ := hW diff --git a/Complexity/Foundations/LinearAlgebra/Matrix/ListProd.lean b/Complexity/Foundations/LinearAlgebra/Matrix/ListProd.lean index 11579b762..50ea8c7ef 100644 --- a/Complexity/Foundations/LinearAlgebra/Matrix/ListProd.lean +++ b/Complexity/Foundations/LinearAlgebra/Matrix/ListProd.lean @@ -38,7 +38,7 @@ theorem list_prod_ofFn_apply : ∀ {d : ℕ} (M : Fin d → Matrix ι ι R) (a b if p 0 = a ∧ p (Fin.last d) = b then ∏ i : Fin d, M i (p i.castSucc) (p i.succ) else 0 | 0, M, a, b => by rw [← (Equiv.funUnique (Fin 1) ι).symm.sum_comp] - simp only [List.ofFn_zero, List.prod_nil, one_apply, Finset.univ_eq_empty, + simp only [List.ofFn_zero, List.prod_nil, Matrix.one_apply, Finset.univ_eq_empty, Finset.prod_empty, Equiv.funUnique_symm_apply, Fin.last_zero, uniqueElim_const] by_cases hab : a = b · subst hab @@ -51,7 +51,7 @@ theorem list_prod_ofFn_apply : ∀ {d : ℕ} (M : Fin d → Matrix ι ι R) (a b have hL : (List.ofFn M).prod a b = ∑ q : Fin (d + 1) → ι, if q (Fin.last d) = b then M 0 a (q 0) * ∏ i : Fin d, M i.succ (q i.castSucc) (q i.succ) else 0 := by - rw [List.ofFn_succ, List.prod_cons, mul_apply] + rw [List.ofFn_succ, List.prod_cons, Matrix.mul_apply] simp only [list_prod_ofFn_apply (fun i => M i.succ), Finset.mul_sum, mul_ite, mul_zero] rw [Finset.sum_comm] refine Finset.sum_congr rfl fun q _ => ?_ diff --git a/Complexity/Foundations/LinearAlgebra/Matrix/Rank.lean b/Complexity/Foundations/LinearAlgebra/Matrix/Rank.lean index 04e6d3604..de84069b6 100644 --- a/Complexity/Foundations/LinearAlgebra/Matrix/Rank.lean +++ b/Complexity/Foundations/LinearAlgebra/Matrix/Rank.lean @@ -87,7 +87,7 @@ theorem exists_eq_mul_rank (A : Matrix m n K) : (b.sum_repr (col j)) simp only [Submodule.coe_sum, Submodule.coe_smul, Finset.sum_apply, Pi.smul_apply, smul_eq_mul] at h - simpa [mul_apply, col, mul_comm] using h.symm + simpa [Matrix.mul_apply, col, mul_comm] using h.symm /-- The natural rank of a finite matrix agrees with the cardinal rank of its linear map. -/ theorem natCast_rank_eq_rank_toLin' [DecidableEq n] (M : Matrix m n K) : diff --git a/Complexity/Foundations/LinearAlgebra/Matrix/SubmatrixRobust.lean b/Complexity/Foundations/LinearAlgebra/Matrix/SubmatrixRobust.lean index 16c25ab37..7d6f58267 100644 --- a/Complexity/Foundations/LinearAlgebra/Matrix/SubmatrixRobust.lean +++ b/Complexity/Foundations/LinearAlgebra/Matrix/SubmatrixRobust.lean @@ -340,17 +340,17 @@ theorem add_blockRank_le_cutRank_add_transpose [Finite ι] (hfg.symm.mono inter_subset_right inter_subset_right) (fun i hi j hj hj' => by have hjY : j ∉ Y := fun h => hj' ⟨hj, h⟩ - simp only [add_apply, transpose_apply, hMY i j hjY, hMY j i (hnotY i hi.2), add_zero]) + simp only [Matrix.add_apply, transpose_apply, hMY i j hjY, hMY j i (hnotY i hi.2), add_zero]) (fun i hi j hj hj' => by have hjX : j ∉ X := fun h => hj' ⟨hj, h⟩ - simp only [add_apply, transpose_apply, hMX i j (hnotX i hi.2), hMX j i hjX, add_zero]) + simp only [Matrix.add_apply, transpose_apply, hMX i j (hnotX i hi.2), hMX j i hjX, add_zero]) have hb₁ : R.blockRank (f ⁻¹' U) (g ⁻¹' Uᶜ) ≤ (M + Mᵀ).blockRank (U ∩ X) Uᶜ := by calc R.blockRank (f ⁻¹' U) (g ⁻¹' Uᶜ) = M.blockRank (U ∩ X) (Uᶜ ∩ Y) := by rw [← hMR, M.blockRank_submatrix hf hg, image_preimage_eq_inter_range, image_preimage_eq_inter_range] _ = (M + Mᵀ).blockRank (U ∩ X) (Uᶜ ∩ Y) := blockRank_congr fun i hi j _ => by - simp only [add_apply, transpose_apply, hMY j i (hnotY i hi.2), add_zero] + simp only [Matrix.add_apply, transpose_apply, hMY j i (hnotY i hi.2), add_zero] _ ≤ (M + Mᵀ).blockRank (U ∩ X) Uᶜ := blockRank_mono_right _ _ inter_subset_left have hb₂ : R.blockRank (f ⁻¹' Uᶜ) (g ⁻¹' U) ≤ (M + Mᵀ).blockRank (U ∩ Y) Uᶜ := by calc R.blockRank (f ⁻¹' Uᶜ) (g ⁻¹' U) @@ -359,7 +359,7 @@ theorem add_blockRank_le_cutRank_add_transpose [Finite ι] image_preimage_eq_inter_range] _ = Mᵀ.blockRank (U ∩ Y) (Uᶜ ∩ X) := (M.blockRank_transpose _ _).symm _ = (M + Mᵀ).blockRank (U ∩ Y) (Uᶜ ∩ X) := blockRank_congr fun i hi j _ => by - simp only [add_apply, transpose_apply, hMX i j (hnotX i hi.2), zero_add] + simp only [Matrix.add_apply, transpose_apply, hMX i j (hnotX i hi.2), zero_add] _ ≤ (M + Mᵀ).blockRank (U ∩ Y) Uᶜ := blockRank_mono_right _ _ inter_subset_left unfold cutRank omega diff --git a/Complexity/Foundations/Probability/Gaussian/Sheppard.lean b/Complexity/Foundations/Probability/Gaussian/Sheppard.lean index e3c419ba0..e18ca8f6d 100644 --- a/Complexity/Foundations/Probability/Gaussian/Sheppard.lean +++ b/Complexity/Foundations/Probability/Gaussian/Sheppard.lean @@ -308,7 +308,7 @@ theorem measureReal_stdGaussian_mem_uIoc_le_angle {u v : E} (huv : ‖u‖ = ‖ simp only [hu, hv, inner_zero_left, uIoc_of_le le_rfl, Ioc_self, mem_empty_iff_false, ofPred_false, measureReal_empty] exact div_nonneg (InnerProductGeometry.angle_nonneg _ _) pi_pos.le - · rw [eq_neg_of_add_eq_zero_right hne, InnerProductGeometry.angle_self_neg_of_nonzero hu, + · rw [eq_neg_of_add_eq_zero_right hne, InnerProductGeometry.angle_self_neg_of_ne_zero hu, div_self pi_ne_zero] exact measureReal_le_one · rw [InnerProductGeometry.angle_eq_two_mul_arctan huv hne] From f5a70cb9826c88744c1dfbc560340d3efebbfb04 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Thu, 29 Oct 2026 15:26:19 -0400 Subject: [PATCH 09/12] test(quantum): qualify the protected matrix lemma Preserve the existing non-unitary matrix counterexample under rc2 Mathlib by explicitly selecting Matrix.mul_apply, as in the library proof repairs. --- ComplexityTests/QuantumCircuit.lean | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ComplexityTests/QuantumCircuit.lean b/ComplexityTests/QuantumCircuit.lean index a440e1a4b..cca9dbe2c 100644 --- a/ComplexityTests/QuantumCircuit.lean +++ b/ComplexityTests/QuantumCircuit.lean @@ -158,7 +158,7 @@ example : ¬Circuit.IsOver {⟨3, Gate.toffoli⟩} [h₀] := fun h => example : !![(1 : ℂ), 1; 0, 1] ∉ unitaryGroup (Fin 2) ℂ := by intro h have := congrFun (congrFun (mem_unitaryGroup_iff.mp h) 0) 0 - simp [mul_apply, Fin.sum_univ_two, star_eq_conjTranspose] at this + simp [Matrix.mul_apply, Fin.sum_univ_two, star_eq_conjTranspose] at this -- A two-qubit gate cannot be placed on a one-qubit register: the wires must be distinct. example : IsEmpty (Fin 2 ↪ Fin 1) := From bb3e910dfc197e46f4b11e0c666b6546a075b7c8 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Thu, 29 Oct 2026 15:46:20 -0400 Subject: [PATCH 10/12] fix(build): normalize goals before proof automation Use expected-type-directed refinement for the generic zero-sum lemma and expose the determinant variable-count function before fun_prop. Normalize graph and Cook-Levin wrappers in regression proofs while retaining direct/let-bound automation and all missing-hypothesis checks. Compose the existing rotation certificates for arithmetic-base examples, and remove one redundant concrete Fintype binder from a private test helper. Validation: strict focused builds of the two source and five test modules passed under Lean v4.36.0-rc2. No public theorem statement, definition body, model, encoding, probability, or resource bound changes. No heartbeat or fun_prop compatibility option was introduced. --- Complexity/Algorithms/WordRAM/KargerMinCut.lean | 2 +- .../Computability/Circuit/Arithmetic/Determinant.lean | 4 +++- ComplexityTests/ExpanderContraction.lean | 3 ++- ComplexityTests/ExpanderFamily.lean | 1 + ComplexityTests/ExplicitExpanders.lean | 8 ++++++-- ComplexityTests/Iteration/SparseDisplacement.lean | 2 +- ComplexityTests/MultiTapePolyTime.lean | 1 + 7 files changed, 15 insertions(+), 6 deletions(-) diff --git a/Complexity/Algorithms/WordRAM/KargerMinCut.lean b/Complexity/Algorithms/WordRAM/KargerMinCut.lean index c07c84a3c..5cf511394 100644 --- a/Complexity/Algorithms/WordRAM/KargerMinCut.lean +++ b/Complexity/Algorithms/WordRAM/KargerMinCut.lean @@ -1181,7 +1181,7 @@ theorem ampLoop_spec {w sb n R : ℕ} {W : Fin n → Fin n → ℕ} {mem₀ : obtain ⟨m_r, hm_r, _, hsup_r, _⟩ := hnext z₁ hz₁ rw [hml_def, hm_r.codeComp_eq, PMF.toOuterMeasure_map_apply, PMF.toOuterMeasure_apply] - convert tsum_eq_zero_iff.mpr _ + refine tsum_eq_zero_iff.mpr ?_ intro z₂ by_cases hz₂_eval : z₂ ∈ m_r.eval.support · have hz₂ : z₂ ∈ m_r.support := (ProbComp.support_eval m_r) ▸ hz₂_eval diff --git a/Complexity/Computability/Circuit/Arithmetic/Determinant.lean b/Complexity/Computability/Circuit/Arithmetic/Determinant.lean index 1f231b4cf..01cf49231 100644 --- a/Complexity/Computability/Circuit/Arithmetic/Determinant.lean +++ b/Complexity/Computability/Circuit/Arithmetic/Determinant.lean @@ -272,7 +272,9 @@ generic determinants has `n * n` variables, degree at most `n` and arithmetic ci `3 * n ^ 4 + 4` gates. -/ theorem detFamily_mem_VP : detFamily K ∈ VP K := by choose c hc hsize using exists_circuit_det (K := K) - refine ⟨⟨by fun_prop, PolynomiallyBounded.id.mono_of_le fun n => + refine ⟨⟨?_, PolynomiallyBounded.id.mono_of_le fun n => totalDegree_det_genericMatrix_le n⟩, c, PolynomiallyBounded.mono_of_le (by fun_prop) hsize, hc⟩ + change PolynomiallyBounded (fun n : ℕ => n * n) + fun_prop end Cslib.Circuits.Arithmetic diff --git a/ComplexityTests/ExpanderContraction.lean b/ComplexityTests/ExpanderContraction.lean index ac59474d9..1bd9d7150 100644 --- a/ComplexityTests/ExpanderContraction.lean +++ b/ComplexityTests/ExpanderContraction.lean @@ -68,7 +68,7 @@ example : ComputableInPolyTime threeVertices.rot have hg : ComputableInPolyTime completeFive.rot (encPair (encFinEnum (Fin 5)) (encFinEnum (Fin 5))) (encPair (encFinEnum (Fin 5)) (encFinEnum (Fin 5))) := .of_finite _ - fun_prop [threeVertices, RotationMap.contractFin] + exact ComputableInPolyTime.rotationMap_contract he hd hg example {V W I D : Type} (G : RotationMap V D) (encode : V → W × I) (decode : W × I → Option V) (hinv : Function.IsPartialInv encode decode) @@ -80,6 +80,7 @@ example {V W I D : Type} (G : RotationMap V D) (encode : V → W × I) (fun p : (W × (I × D)) × Bool => ((RotationMap.contract encode decode hinv G).rot p.1, !p.2)) (encPair (encPair ew (encPair ei ed)) encBool) (encPair (encPair ew (encPair ei ed)) encBool) := by + dsimp only [RotationMap.contract, RotationMap.contractRot, RotationMap.contractDart] fail_if_success (clear he; fun_prop) fail_if_success (clear hd; fun_prop) fail_if_success (clear hg; fun_prop) diff --git a/ComplexityTests/ExpanderFamily.lean b/ComplexityTests/ExpanderFamily.lean index 0dd5ac6e9..51163712e 100644 --- a/ComplexityTests/ExpanderFamily.lean +++ b/ComplexityTests/ExpanderFamily.lean @@ -96,6 +96,7 @@ example {V W D : Type} (G : RotationMap V D) (e : V ≃ W) let next := (G.reindex e).rot p.1 (next, !p.2)) (encPair (encPair ew ed) encBool) (encPair (encPair ew ed) encBool) := by + dsimp only [RotationMap.reindex, RotationMap.reindexRot] fail_if_success (clear hf; fun_prop) fail_if_success (clear hb; fun_prop) fail_if_success (clear hg; fun_prop) diff --git a/ComplexityTests/ExplicitExpanders.lean b/ComplexityTests/ExplicitExpanders.lean index a912aabc8..c8d706921 100644 --- a/ComplexityTests/ExplicitExpanders.lean +++ b/ComplexityTests/ExplicitExpanders.lean @@ -64,7 +64,8 @@ example {K : Type} [Field K] (encode : K ↪ List Bool) ComputableInPolyTime (RotationMap.affinePlaneTowerBase K).rot (encPair (baseEncoding encode) (planeEncoding encode)) (encPair (baseEncoding encode) (planeEncoding encode)) := by - fun_prop [RotationMap.affinePlaneTowerBase] + have hplane := ComputableInPolyTime.rotationMap_affinePlane hmul hsub + exact ((hplane.rotationMap_tensor hplane).rotationMap_zigzag hplane).rotationMap_zigzag hplane -- Only the fixed field operations use the finite-domain theorem; graph products compose them. example (encode : ZMod 257 ↪ List Bool) : @@ -75,7 +76,8 @@ example (encode : ZMod 257 ↪ List Bool) : (planeEncoding encode) encode := .of_finite _ have hsub : ComputableInPolyTime (fun p : ZMod 257 × ZMod 257 => p.1 - p.2) (planeEncoding encode) encode := .of_finite _ - fun_prop [RotationMap.affinePlaneTowerBase] + have hplane := ComputableInPolyTime.rotationMap_affinePlane hmul hsub + exact ((hplane.rotationMap_tensor hplane).rotationMap_zigzag hplane).rotationMap_zigzag hplane -- Equivalent direct and let-bound spellings, with a supplied rotation on an arbitrary type. example {V D E : Type} (G : RotationMap V D) (H : RotationMap D E) @@ -86,6 +88,7 @@ example {V D E : Type} (G : RotationMap V D) (H : RotationMap D E) (fun p : ((V × D) × (E × E)) × Bool => ((G.zigzag H).rot p.1, !p.2)) (encPair (encPair (encPair vertex label) (encPair small small)) encBool) (encPair (encPair (encPair vertex label) (encPair small small)) encBool) := by + dsimp only [RotationMap.zigzag, RotationMap.zigzagRot] fail_if_success (clear hG; fun_prop) fail_if_success (clear hH; fun_prop) fun_prop @@ -100,6 +103,7 @@ example {V D E : Type} (G : RotationMap V D) (H : RotationMap D E) (next, !p.2)) (encPair (encPair (encPair vertex label) (encPair small small)) encBool) (encPair (encPair (encPair vertex label) (encPair small small)) encBool) := by + dsimp only [RotationMap.zigzag, RotationMap.zigzagRot] fun_prop end ComplexityTests.ExplicitExpanders diff --git a/ComplexityTests/Iteration/SparseDisplacement.lean b/ComplexityTests/Iteration/SparseDisplacement.lean index 634e74f09..fbe746f4f 100644 --- a/ComplexityTests/Iteration/SparseDisplacement.lean +++ b/ComplexityTests/Iteration/SparseDisplacement.lean @@ -34,7 +34,7 @@ example : private def editedCounter : Equiv.Perm (BitVec 2) := (Equiv.swap 0 1).trans (Equiv.addRight 1) -private theorem editedCounter_disagreement [Fintype (BitVec 2)] : +private theorem editedCounter_disagreement : disagreement editedCounter (fun x => x + 1) = {0, 1} := by ext x simp only [mem_disagreement, Finset.mem_insert, Finset.mem_singleton] diff --git a/ComplexityTests/MultiTapePolyTime.lean b/ComplexityTests/MultiTapePolyTime.lean index 2042aace5..8fde4c4a0 100644 --- a/ComplexityTests/MultiTapePolyTime.lean +++ b/ComplexityTests/MultiTapePolyTime.lean @@ -139,6 +139,7 @@ example {α : Type} (enc : α ↪ List Bool) (p : Polynomial ℕ) (c d : ℕ) : ComputableTidilyInPolyTime (fun a => List.range (Cslib.Complexity.CookLevin.parameters p c d enc a).2.2) enc (encList encUnary) := by + dsimp only [Cslib.Complexity.CookLevin.parameters] fun_prop private def finish (move : SignType) (symbol : Bool) : Turing.MultiTapeTM 0 Bool Unit := From e62c359d802b888d1576882481152dfe650bce0d Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Thu, 29 Oct 2026 18:09:05 -0400 Subject: [PATCH 11/12] refactor(wordram): index dynamic programs by operation signatures Remove the implicit relational-to-Empty-state deterministic specification. Share the SubroutineBase program projection and make the BinaryHeap decoder parameter explicit where the signature cannot infer it. Validation: scripts/check.sh passed all six gates under the published rc2 support candidate 0d38523e. Hygiene, changed-file lints and the tidy-surface audit passed. Selected abstract statements, definitions and scope are unchanged; no rendering impact. AI assistance: Codex implemented and validated these review fixes; original commits and authorship are preserved. --- .../WordRAM/PriorityQueue/BinaryHeap.lean | 2 +- Complexity/Computability/WordRAM/Dynamic.lean | 38 ++++++++++--------- .../Computability/WordRAM/Subroutine.lean | 10 +---- .../Semantics/Stateful/Relational.lean | 11 ------ 4 files changed, 22 insertions(+), 39 deletions(-) diff --git a/Complexity/Algorithms/WordRAM/PriorityQueue/BinaryHeap.lean b/Complexity/Algorithms/WordRAM/PriorityQueue/BinaryHeap.lean index f0605c71b..b9de086eb 100644 --- a/Complexity/Algorithms/WordRAM/PriorityQueue/BinaryHeap.lean +++ b/Complexity/Algorithms/WordRAM/PriorityQueue/BinaryHeap.lean @@ -691,7 +691,7 @@ def dynamicProgram (n K_max : ℕ) : DynamicProgram (IndexedMinPQ.spec n K_max) output := pqCode.output input := pqCode.input encode := pqCode.encode - decode := pqCode.decode + decode := pqCode.decode (K_max := K_max) /-- Standalone `.standard`-basis `DynamicCertificate` for the binary min-heap. -/ def certificate {n K_max w base : ℕ} (hS : Fits w (base + space n)) (hK : Fits w K_max) : diff --git a/Complexity/Computability/WordRAM/Dynamic.lean b/Complexity/Computability/WordRAM/Dynamic.lean index ab80464d6..3121bebc1 100644 --- a/Complexity/Computability/WordRAM/Dynamic.lean +++ b/Complexity/Computability/WordRAM/Dynamic.lean @@ -74,8 +74,10 @@ universe u v z variable {r : ℕ} {D : Stateful.Spec.{u, v, z}} -/-- A single program serving all operations through a fixed register calling convention. -/ -structure DynamicProgram (D : Stateful.Spec.{u, v, z}) (r : ℕ) where +/-- A single program serving an operation signature through a fixed register calling convention. +Deterministic and relational stateful specifications supply their signatures by coercion; +the program itself makes no assumption about abstract states or permitted transitions. -/ +structure DynamicProgram (S : PFunctor.{v, z}) (r : ℕ) where /-- The same code is executed for every operation. -/ code : Code .standard r /-- Register returned by the final halt instruction. -/ @@ -83,30 +85,30 @@ structure DynamicProgram (D : Stateful.Spec.{u, v, z}) (r : ℕ) where /-- Registers overwritten by externally supplied operation arguments. -/ input : Fin r → Bool /-- Encoded arguments, independent of the maintained machine state. -/ - encode : D.Op → Fin r → ℕ + encode : S.A → Fin r → ℕ /-- Interpretation of the final register tuple as the operation's typed observation. -/ - decode : (o : D.Op) → (Fin r → ℕ) → Option (D.Result o) + decode : (o : S.A) → (Fin r → ℕ) → Option (S.B o) namespace DynamicProgram -variable (P : DynamicProgram D r) +variable {S : PFunctor.{v, z}} (P : DynamicProgram S r) /-- Deliver operation arguments without changing maintained memory or non-input registers. -/ -def prepare (o : D.Op) (x : Data r) : Data r where +def prepare (o : S.A) (x : Data r) : Data r where regs i := if P.input i then P.encode o i else x.regs i mem := x.mem /-- Delivering operation arguments preserves the machine memory unchanged. -/ @[simp] -theorem prepare_mem (o : D.Op) (x : Data r) : (P.prepare o x).mem = x.mem := rfl +theorem prepare_mem (o : S.A) (x : Data r) : (P.prepare o x).mem = x.mem := rfl /-- Registers outside the calling convention retain their contents. -/ -theorem prepare_regs_of_not_input {i : Fin r} (hi : P.input i = false) (o : D.Op) (x : Data r) : +theorem prepare_regs_of_not_input {i : Fin r} (hi : P.input i = false) (o : S.A) (x : Data r) : (P.prepare o x).regs i = x.regs i := by simp [prepare, hi] /-- Argument delivery preserves bounded words when the arguments fit. -/ -theorem prepare_bounded {w : ℕ} {o : D.Op} {x : Data r} (hx : x.Bounded w) +theorem prepare_bounded {w : ℕ} {o : S.A} {x : Data r} (hx : x.Bounded w) (ho : ∀ i, P.input i = true → Fits w (P.encode o i)) : (P.prepare o x).Bounded w := by refine ⟨fun i => ?_, hx.2⟩ change Fits w (if P.input i then P.encode o i else x.regs i) @@ -120,7 +122,7 @@ instructions; exhaustion, a machine fault, or decoder failure returns `none`. This interpreter does not check the initial state's global word bound or operation admissibility. Use `DynamicCertificate.execOp_of_eval` to connect a successful call to certified execution. -/ -def eval (w fuel : ℕ) (o : D.Op) (x : Data r) : Option (Data r × D.Result o × ℕ) := +def eval (w fuel : ℕ) (o : S.A) (x : Data r) : Option (Data r × S.B o × ℕ) := match P.code.eval w fuel (P.prepare o x) with | none => none | some (y, n) => (P.decode o y.regs).map fun a => (y, a, n + 1) @@ -133,13 +135,13 @@ structure OperationTrace where probes : List Probe /-- A bounded machine call with native execution evidence independent of any resource bound. -/ -def ExecOp (w : ℕ) : Stateful.Execution D (Data r) OperationTrace := fun x o a y trace => +def ExecOp (w : ℕ) : Stateful.Execution S (Data r) OperationTrace := fun x o a y trace => (P.prepare o x).Bounded w ∧ ∃ n, TraceExec w P.code (P.prepare o x) y n trace.probes ∧ P.decode o y.regs = some a ∧ trace.instructions = n + 1 /-- Successful typed evaluation supplies an exact operation trace when the delivered state is bounded. Evaluator success alone does not imply a bound on untouched memory. -/ -theorem ExecOp.of_eval {w fuel k : ℕ} {o : D.Op} {x y : Data r} {a : D.Result o} +theorem ExecOp.of_eval {w fuel k : ℕ} {o : S.A} {x y : Data r} {a : S.B o} (hb : (P.prepare o x).Bounded w) (h : P.eval w fuel o x = some (y, a, k)) : ∃ probes, P.ExecOp w x o a y ⟨k, probes⟩ := by cases he : P.code.eval w fuel (P.prepare o x) with @@ -156,7 +158,7 @@ theorem ExecOp.of_eval {w fuel k : ℕ} {o : D.Op} {x y : Data r} {a : D.Result /-- Every call is an execution of one fixed flat machine program. The returned register tuple is observed at the final state; the designated output register is also the halt value. -/ -theorem ExecOp.executes {w : ℕ} {x y : Data r} {o : D.Op} {a : D.Result o} +theorem ExecOp.executes {w : ℕ} {x y : Data r} {o : S.A} {a : S.B o} {trace : OperationTrace} (h : P.ExecOp w x o a y trace) : Executes w (P.code.program P.output) ⟨0, P.prepare o x⟩ (y.regs P.output) trace.instructions := by @@ -165,13 +167,13 @@ theorem ExecOp.executes {w : ℕ} {x y : Data r} {o : D.Op} {a : D.Result o} exact he.exec.executes P.output /-- A call preserves bounded words, including every word in the observed register tuple. -/ -theorem ExecOp.bounded {w : ℕ} {x y : Data r} {o : D.Op} {a : D.Result o} +theorem ExecOp.bounded {w : ℕ} {x y : Data r} {o : S.A} {a : S.B o} {trace : OperationTrace} (h : P.ExecOp w x o a y trace) : y.Bounded w := by obtain ⟨hb, n, he, _, _⟩ := h exact he.exec.bounded hb /-- Calls are deterministic in their final representation, observation, and instruction count. -/ -theorem ExecOp.unique {w : ℕ} {x y y' : Data r} {o : D.Op} {a a' : D.Result o} +theorem ExecOp.unique {w : ℕ} {x y y' : Data r} {o : S.A} {a a' : S.B o} {trace trace' : OperationTrace} (h : P.ExecOp w x o a y trace) (h' : P.ExecOp w x o a' y' trace') : y = y' ∧ a = a' ∧ trace.instructions = trace'.instructions := by @@ -181,8 +183,8 @@ theorem ExecOp.unique {w : ℕ} {x y y' : Data r} {o : D.Op} {a a' : D.Result o} exact ⟨rfl, Option.some.inj (ha.symm.trans ha'), ht.trans ht'.symm⟩ /-- A call's final state and instruction count agree with any structured execution of the code. -/ -theorem ExecOp.eq_of_exec {P : DynamicProgram D r} {w : ℕ} {x y z : Data r} {o : D.Op} - {a : D.Result o} {trace : OperationTrace} {m : ℕ} (he : P.ExecOp w x o a y trace) +theorem ExecOp.eq_of_exec {P : DynamicProgram S r} {w : ℕ} {x y z : Data r} {o : S.A} + {a : S.B o} {trace : OperationTrace} {m : ℕ} (he : P.ExecOp w x o a y trace) (h : Exec w P.code (P.prepare o x) z m) : y = z ∧ trace.instructions = m + 1 := by obtain ⟨_, n, ht, _, hn⟩ := he @@ -190,7 +192,7 @@ theorem ExecOp.eq_of_exec {P : DynamicProgram D r} {w : ℕ} {x y z : Data r} {o exact ⟨rfl, hn⟩ /-- The write transcript supplies a frame rule for a call, including register-only delivery. -/ -theorem ExecOp.frame {w : ℕ} {x y : Data r} {o : D.Op} {a : D.Result o} +theorem ExecOp.frame {w : ℕ} {x y : Data r} {o : S.A} {a : S.B o} {trace : OperationTrace} (h : P.ExecOp w x o a y trace) {Q : HeapAssertion} (hQ : Q.holds x.mem) (hd : Disjoint Q.footprint (Probe.writes trace.probes)) : Q.holds y.mem := by diff --git a/Complexity/Computability/WordRAM/Subroutine.lean b/Complexity/Computability/WordRAM/Subroutine.lean index bb0969dcc..feffa199e 100644 --- a/Complexity/Computability/WordRAM/Subroutine.lean +++ b/Complexity/Computability/WordRAM/Subroutine.lean @@ -328,7 +328,7 @@ def mapSimulates (φ : B.Simulates B') (C : SubroutineBase P Result valid w base /-- Project a `.standard`-basis `SubroutineBase` to a standalone `DynamicProgram`. -/ def toDynamicProgram {P_std : SubroutineCode .standard r_ds k_init} (C : SubroutineBase P_std Result valid w base params s₀) : - DynamicProgram { State := Empty, Op := O, Result := Result, step := Empty.elim } r_ds where + DynamicProgram ⟨O, Result⟩ r_ds where code := P_std.code output := P_std.output input := P_std.input @@ -627,14 +627,6 @@ section Standard variable {P_std : SubroutineCode .standard r_ds k_init} (C : SubroutineDS P_std D w base params s₀) -/-- Project a `.standard`-basis `SubroutineDS` to its underlying standalone `DynamicProgram`. -/ -def toDynamicProgram : DynamicProgram D r_ds where - code := P_std.code - output := P_std.output - input := P_std.input - encode := C.encode - decode := C.decode - /-- Project a `.standard`-basis `SubroutineDS` to a standalone `DynamicCertificate`. -/ def toCertificate : DynamicCertificate C.toDynamicProgram w where rep := C.rep diff --git a/Complexity/Foundations/Semantics/Stateful/Relational.lean b/Complexity/Foundations/Semantics/Stateful/Relational.lean index 722f77f02..6a709a6d1 100644 --- a/Complexity/Foundations/Semantics/Stateful/Relational.lean +++ b/Complexity/Foundations/Semantics/Stateful/Relational.lean @@ -128,17 +128,6 @@ abbrev signature : PFunctor.{v, w} := ⟨D.Op, D.Result⟩ instance : Coe RelSpec.{u, v, w} PFunctor.{v, w} := ⟨RelSpec.signature⟩ -/-- Project the operation signature `(D.Op, D.Result)` of a relational specification to a -canonical `Stateful.Spec` with `State := Empty`, allowing signature-only constructions over -`Stateful.Spec` (such as `WordRAM.DynamicProgram`) to apply directly to `D : RelSpec`. -/ -abbrev toSpec : Spec.{0, v, w} where - State := Empty - Op := D.Op - Result := D.Result - step s := s.elim - -instance : Coe RelSpec.{u, v, w} Spec.{0, v, w} := ⟨RelSpec.toSpec⟩ - /-- An adaptive client over `D`: each continuation may branch on the observed operation result. -/ abbrev Client (α : Type y) : Type (max v w y) := D.signature.FreeM α From a115e42b53774978d96e2202cb74ea05bea5f7e7 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Thu, 29 Oct 2026 18:14:24 -0400 Subject: [PATCH 12/12] refactor(wordram): share basis-preserving subroutine plumbing Keep the standard DynamicProgram specialization while allowing an explicit basis. Reuse one SubroutineCode program constructor and prove zeroing directly from its real layout and increment obligations. Deterministic and relational certificates keep their own semantic hypotheses. Validation: scripts/check.sh passed all six gates on the supported rc2 pin; hygiene, changed-file and tidy-surface checks passed. Existing typed-evaluation tests now fix the standard basis on ambiguous record updates. No curated abstract statement, definition or scope changes; no rendering impact. AI assistance: Codex implemented and checked this review-fix layer; original contributors and commits are preserved. --- Complexity/Computability/WordRAM/Dynamic.lean | 12 +- .../Computability/WordRAM/RelSubroutine.lean | 4 +- .../Computability/WordRAM/Subroutine.lean | 327 +++++++++--------- ComplexityTests/WordRAMDynamic.lean | 6 +- 4 files changed, 184 insertions(+), 165 deletions(-) diff --git a/Complexity/Computability/WordRAM/Dynamic.lean b/Complexity/Computability/WordRAM/Dynamic.lean index 3121bebc1..ace6fd08a 100644 --- a/Complexity/Computability/WordRAM/Dynamic.lean +++ b/Complexity/Computability/WordRAM/Dynamic.lean @@ -14,6 +14,10 @@ public import Complexity.Computability.WordRAM.Trace /-! # Fixed-program implementations of dynamic data structures +`DynamicProgram` depends only on the existing `PFunctor` operation signature and its instruction +basis, which defaults to `.standard`. Deterministic and relational specifications supply their +signatures by coercion; correctness certificates retain the actual specification separately. + An implementation has one structured program, one output register, and a register-only calling convention. Each call replaces designated input registers with encoded words, preserving all other registers and the entire memory. Argument encoding, external delivery, and result decoding @@ -77,9 +81,9 @@ variable {r : ℕ} {D : Stateful.Spec.{u, v, z}} /-- A single program serving an operation signature through a fixed register calling convention. Deterministic and relational stateful specifications supply their signatures by coercion; the program itself makes no assumption about abstract states or permitted transitions. -/ -structure DynamicProgram (S : PFunctor.{v, z}) (r : ℕ) where +structure DynamicProgram (S : PFunctor.{v, z}) (r : ℕ) (B : Basis := .standard) where /-- The same code is executed for every operation. -/ - code : Code .standard r + code : Code B r /-- Register returned by the final halt instruction. -/ output : Fin r /-- Registers overwritten by externally supplied operation arguments. -/ @@ -91,7 +95,7 @@ structure DynamicProgram (S : PFunctor.{v, z}) (r : ℕ) where namespace DynamicProgram -variable {S : PFunctor.{v, z}} (P : DynamicProgram S r) +variable {S : PFunctor.{v, z}} {B : Basis} (P : DynamicProgram S r B) /-- Deliver operation arguments without changing maintained memory or non-input registers. -/ def prepare (o : S.A) (x : Data r) : Data r where @@ -183,7 +187,7 @@ theorem ExecOp.unique {w : ℕ} {x y y' : Data r} {o : S.A} {a a' : S.B o} exact ⟨rfl, Option.some.inj (ha.symm.trans ha'), ht.trans ht'.symm⟩ /-- A call's final state and instruction count agree with any structured execution of the code. -/ -theorem ExecOp.eq_of_exec {P : DynamicProgram S r} {w : ℕ} {x y z : Data r} {o : S.A} +theorem ExecOp.eq_of_exec {P : DynamicProgram S r B} {w : ℕ} {x y z : Data r} {o : S.A} {a : S.B o} {trace : OperationTrace} {m : ℕ} (he : P.ExecOp w x o a y trace) (h : Exec w P.code (P.prepare o x) z m) : y = z ∧ trace.instructions = m + 1 := by diff --git a/Complexity/Computability/WordRAM/RelSubroutine.lean b/Complexity/Computability/WordRAM/RelSubroutine.lean index 7e3dece99..ba187f24c 100644 --- a/Complexity/Computability/WordRAM/RelSubroutine.lean +++ b/Complexity/Computability/WordRAM/RelSubroutine.lean @@ -25,7 +25,7 @@ to relational specifications (`Stateful.RelSpec`): `Stateful.RelRealization` directly via `Exec.unique`. 2. **Unified standalone and inline relational subroutine certificates (`RelSubroutineDS`):** Extends `SubroutineBase P D.Result D.valid w base params s₀` over `D : Stateful.RelSpec`, - inheriting `toDynamicProgram`, `initFresh_exec`, `initFresh_rename`, `zeroFillCode_exec`, + inheriting `toDynamicProgram`, `initFresh_exec`, `initFresh_rename`, `initClear_exec`, `initClear_rename`, `frame_caller`, and `prepareRegs` without duplication, omitting `rep_unique` (since concrete potential `potential : Data r_ds → ℕ` depends only on machine data), and existentially quantifying over `(s', a)` with `D.step s o s' a` in @@ -266,7 +266,7 @@ end SubroutineCode at word width `w`, base address `base`, runtime parameters `params`, and initial state `s₀`. Extends `SubroutineBase P D.Result D.valid w base params s₀` (inheriting `toDynamicProgram`, -`initFresh_exec`, `initFresh_rename`, `zeroFillCode_exec`, `initClear_exec`, `initClear_rename`, +`initFresh_exec`, `initFresh_rename`, `initClear_exec`, `initClear_rename`, `frame_caller`, and `prepareRegs`), omits `rep_unique` (because concrete potential `potential : Data r_ds → ℕ` depends only on machine data), and existentially quantifies over a permitted outcome `(s', a)` satisfying `D.step s o s' a` in `step_exec`. -/ diff --git a/Complexity/Computability/WordRAM/Subroutine.lean b/Complexity/Computability/WordRAM/Subroutine.lean index feffa199e..b6cd0bd1b 100644 --- a/Complexity/Computability/WordRAM/Subroutine.lean +++ b/Complexity/Computability/WordRAM/Subroutine.lean @@ -45,7 +45,7 @@ A data structure is packaged once as a `SubroutineCode B r_ds k_init` and certif standalone / inline specification and resource certificate for a Word-RAM data structure. * `Cslib.WordRAM.SubroutineCode.initFresh`, `Cslib.WordRAM.SubroutineCode.initClear`: `O(1)` fresh initialization on zeroed memory and generic `O(space)` dirty-memory re-initialization. -* `Cslib.WordRAM.SubroutineBase.toDynamicProgram`, `Cslib.WordRAM.SubroutineDS.toCertificate`: +* `Cslib.WordRAM.SubroutineCode.toDynamicProgram`, `Cslib.WordRAM.SubroutineDS.toCertificate`: standalone `.standard`-basis `DynamicProgram` and `DynamicCertificate` projections. ## Main results @@ -206,6 +206,169 @@ def mapSimulates (φ : B.Simulates B') (P : SubroutineCode B r_ds k_init) : abbrev toStandard (P : SubroutineCode .exact r_ds k_init) : SubroutineCode .standard r_ds k_init := P.mapSimulates .exactStandard +/-- Project subroutine code and its calling convention to the same operation signature. +The basis is retained, so this projection does not translate instructions or resource claims. -/ +def toDynamicProgram (P : SubroutineCode B r_ds k_init) {O : Type*} {Result : O → Type*} + (encode : O → Fin r_ds → ℕ) (decode : (o : O) → (Fin r_ds → ℕ) → Option (Result o)) : + DynamicProgram ⟨O, Result⟩ r_ds B where + code := P.code + output := P.output + input := P.input + encode := encode + decode := decode + +/-- Generic execution of `P.zeroFillCode` clearing `[base, base + space)` in `4 * space + 6` +instructions over any basis `B`. -/ +theorem zeroFillCode_exec (P : SubroutineCode B r_ds k_init) + {w base space : ℕ} {params : Fin k_init → ℕ} + (hclear : [P.curReg, P.zeroReg, P.oneReg, P.baseReg, P.frontierReg].Nodup) + (hparams : ∀ j, P.initParams j ∉ [P.curReg, P.zeroReg, P.oneReg]) + (hinc : ∀ {x : Data r_ds}, x.regs P.oneReg = 1 → Fits w (x.regs P.curReg + 1) → + P.incCur.eval w x = some (x.set P.curReg (x.regs P.curReg + 1))) + {x₁ : Data r_ds} + (hx₁ : x₁.Bounded w) (hb₁ : x₁.regs P.baseReg = base) + (hfr₁ : x₁.regs P.frontierReg = base + space) + (hpar₁ : ∀ j, x₁.regs (P.initParams j) = params j) : + ∃ x₂, ExecWithin w P.zeroFillCode x₁ x₂ (4 * space + 6) ∧ + x₂.Bounded w ∧ + x₂.regs P.baseReg = base ∧ + x₂.regs P.frontierReg = base + space ∧ + (∀ j, x₂.regs (P.initParams j) = params j) ∧ + (∀ a ∈ (Block.mk base space).footprint, x₂.mem a = 0) ∧ + Modifies (Block.mk base space).footprint x₁.mem x₂.mem := by + have hfit0 : Fits w 0 := (hx₁.1 P.baseReg).of_le (Nat.zero_le _) + have hfit_stop : Fits w (base + space) := hfr₁ ▸ hx₁.1 P.frontierReg + obtain ⟨hcur_not, hzero_not, hone_not, hbase_ne_fr, _⟩ := + (List.nodup_cons.mp hclear).imp_right fun h => + (List.nodup_cons.mp h).imp_right fun h => + (List.nodup_cons.mp h).imp_right List.nodup_cons.mp + have hcur_ne_zero : P.curReg ≠ P.zeroReg := fun h => hcur_not (by simp [h]) + have hcur_ne_one : P.curReg ≠ P.oneReg := fun h => hcur_not (by simp [h]) + have hcur_ne_base : P.curReg ≠ P.baseReg := fun h => hcur_not (by simp [h]) + have hcur_ne_fr : P.curReg ≠ P.frontierReg := fun h => hcur_not (by simp [h]) + have hzero_ne_one : P.zeroReg ≠ P.oneReg := fun h => hzero_not (by simp [h]) + have hzero_ne_base : P.zeroReg ≠ P.baseReg := fun h => hzero_not (by simp [h]) + have hzero_ne_fr : P.zeroReg ≠ P.frontierReg := fun h => hzero_not (by simp [h]) + have hone_ne_base : P.oneReg ≠ P.baseReg := fun h => hone_not (by simp [h]) + have hone_ne_fr : P.oneReg ≠ P.frontierReg := fun h => hone_not (by simp [h]) + by_cases hsp : 0 < space + · have hc_pos : (Cond.lt P.baseReg P.frontierReg).Holds x₁ := by + simp only [Cond.Holds, hb₁, hfr₁] + omega + have hfit1 : Fits w 1 := hfit_stop.of_le (by omega) + let x_z := x₁.set P.zeroReg 0 + let x_o := x_z.set P.oneReg 1 + let x_c := x_o.set P.curReg (x_o.regs P.baseReg) + have hxc_base : x_c.regs P.baseReg = base := by + simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hcur_ne_base.symm, + Function.update_of_ne hone_ne_base.symm, Function.update_of_ne hzero_ne_base.symm, hb₁] + have hxc_fr : x_c.regs P.frontierReg = base + space := by + simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hcur_ne_fr.symm, + Function.update_of_ne hone_ne_fr.symm, Function.update_of_ne hzero_ne_fr.symm, hfr₁] + have hxc_zero : x_c.regs P.zeroReg = 0 := by + simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hcur_ne_zero.symm, + Function.update_of_ne hzero_ne_one] + have hxc_one : x_c.regs P.oneReg = 1 := by + simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hcur_ne_one.symm] + have hxc_cur : x_c.regs P.curReg = base := by + simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hone_ne_base.symm, + Function.update_of_ne hzero_ne_base.symm, hb₁] + let xs : ℕ → Data r_ds := fun i => + ⟨Function.update x_c.regs P.curReg (base + i), clear x₁.mem base i⟩ + have hxs0 : xs 0 = x_c := by + ext r + · by_cases hr : r = P.curReg + · subst hr + simp [xs, hxc_cur] + · simp [xs, Function.update_of_ne hr, x_c, x_o, x_z, Data.set] + · simp [xs, x_c, x_o, x_z, Data.set] + have hloop_cond : ∀ i < space, (Cond.lt P.curReg P.frontierReg).Holds (xs i) := by + intro i hi + simp only [Cond.Holds, xs, Function.update_self, + Function.update_of_ne hcur_ne_fr.symm, hxc_fr] + omega + have hloop_exit : ¬(Cond.lt P.curReg P.frontierReg).Holds (xs space) := by + simp only [Cond.Holds, xs, Function.update_self, + Function.update_of_ne hcur_ne_fr.symm, hxc_fr] + omega + have hloop_body : ∀ i < space, + ExecWithin w (.seq (.op (.store P.curReg P.zeroReg)) (.op P.incCur)) + (xs i) (xs (i + 1)) 2 := by + intro i hi + have hsi_zero : (xs i).regs P.zeroReg = 0 := by + simp [xs, Function.update_of_ne hcur_ne_zero.symm, hxc_zero] + have hsi_one : (xs i).regs P.oneReg = 1 := by + simp [xs, Function.update_of_ne hcur_ne_one.symm, hxc_one] + have hsi_cur : (xs i).regs P.curReg = base + i := by simp [xs] + let x_st := (xs i).write ((xs i).regs P.curReg) ((xs i).regs P.zeroReg) + have hst_one : x_st.regs P.oneReg = 1 := hsi_one + have hst_fit : Fits w (x_st.regs P.curReg + 1) := by + change Fits w ((xs i).regs P.curReg + 1) + rw [hsi_cur] + exact hfit_stop.of_le (by omega) + have hinc : ExecWithin w (.op P.incCur) x_st (x_st.set P.curReg (x_st.regs P.curReg + 1)) 1 := + (Exec.op (hinc hst_one hst_fit)).within + have htarget : x_st.set P.curReg (x_st.regs P.curReg + 1) = xs (i + 1) := by + ext r + · simp only [x_st, Data.set, Data.write, xs, hsi_cur] + by_cases hr : r = P.curReg + · subst hr + simp [Nat.add_assoc] + · simp [Function.update_of_ne hr] + · simp only [x_st, Data.set, Data.write, hsi_cur, hsi_zero] + simp [xs, clear_succ] + rw [htarget] at hinc + exact ExecWithin.store.seq hinc + have hloop : ExecWithin w + (.loop (.lt P.curReg P.frontierReg) (.seq (.op (.store P.curReg P.zeroReg)) (.op P.incCur))) + x_c (xs space) (space * (2 + 2) + 2) := by + simpa [hxs0] using ExecWithin.loop xs space 2 hloop_cond hloop_exit hloop_body + have hbranch : ExecWithin w P.zeroFillCode x₁ (xs space) (4 * space + 6) := by + have hseq : ExecWithin w + (.seq (.op (.const P.zeroReg 0)) <| + .seq (.op (.const P.oneReg 1)) <| + .seq (.op (.copy P.curReg P.baseReg)) <| + .loop (.lt P.curReg P.frontierReg) + (.seq (.op (.store P.curReg P.zeroReg)) (.op P.incCur))) + x₁ (xs space) (3 + (space * 4 + 2)) := by + obtain ⟨n₁, hn₁, he₁⟩ := (ExecWithin.const (x := x₁) (d := P.zeroReg) hfit0) + obtain ⟨n₂, hn₂, he₂⟩ := (ExecWithin.const (x := x_z) (d := P.oneReg) hfit1) + obtain ⟨n₃, hn₃, he₃⟩ := (ExecWithin.copy (B := B) (w := w) (x := x_o) + (d := P.curReg) (s := P.baseReg)) + obtain ⟨n₄, hn₄, he₄⟩ := hloop + exact ⟨n₁ + (n₂ + (n₃ + n₄)), by omega, he₁.seq (he₂.seq (he₃.seq he₄))⟩ + exact (ExecWithin.branch_pos hc_pos hseq).mono (by omega) + refine ⟨xs space, hbranch, hbranch.bounded hx₁, ?_, ?_, ?_, ?_, ?_⟩ + · simp [xs, Function.update_of_ne hcur_ne_base.symm, hxc_base] + · simp [xs, Function.update_of_ne hcur_ne_fr.symm, hxc_fr] + · intro j + have hne := hparams j + have h1 : P.initParams j ≠ P.curReg := fun h => hne (by simp [h]) + have h2 : P.initParams j ≠ P.zeroReg := fun h => hne (by simp [h]) + have h3 : P.initParams j ≠ P.oneReg := fun h => hne (by simp [h]) + simp [xs, x_c, x_o, x_z, Data.set, Function.update_of_ne h1, Function.update_of_ne h2, + Function.update_of_ne h3, hpar₁ j] + · intro a ha + exact clear_of_owns (Block.mem_footprint.mp ha) + · intro a ha + exact clear_of_not_owns (mt Block.mem_footprint.mpr ha) + · have hsp0 : space = 0 := by omega + have hc_neg : ¬(Cond.lt P.baseReg P.frontierReg).Holds x₁ := by + simp only [Cond.Holds, hb₁, hfr₁, hsp0] + omega + have hbranch : ExecWithin w P.zeroFillCode x₁ (x₁.set P.zeroReg 0) (4 * space + 6) := + (ExecWithin.branch_neg hc_neg (ExecWithin.const hfit0)).mono (by omega) + refine ⟨x₁.set P.zeroReg 0, hbranch, hbranch.bounded hx₁, ?_, ?_, ?_, ?_, ?_⟩ + · simp [Data.set, Function.update_of_ne hzero_ne_base.symm, hb₁] + · simp [Data.set, Function.update_of_ne hzero_ne_fr.symm, hfr₁] + · intro j + have hne := hparams j + have h2 : P.initParams j ≠ P.zeroReg := fun h => hne (by simp [h]) + simp [Data.set, Function.update_of_ne h2, hpar₁ j] + · intro a ha + simp [hsp0, Block.footprint] at ha + · exact Modifies.refl _ _ + end SubroutineCode universe u v z @@ -325,15 +488,10 @@ def mapSimulates (φ : B.Simulates B') (C : SubroutineBase P Result valid w base let ⟨y, he, hfr', hrep, hpot, hmod⟩ := C.setup_exec hx₁ hb hfr hpar hz ⟨y, he.mapSimulates φ, hfr', hrep, hpot, hmod⟩ -/-- Project a `.standard`-basis `SubroutineBase` to a standalone `DynamicProgram`. -/ -def toDynamicProgram {P_std : SubroutineCode .standard r_ds k_init} - (C : SubroutineBase P_std Result valid w base params s₀) : - DynamicProgram ⟨O, Result⟩ r_ds where - code := P_std.code - output := P_std.output - input := P_std.input - encode := C.encode - decode := C.decode +/-- Project a subroutine bundle to its signature-level program, retaining the instruction basis. -/ +def toDynamicProgram (C : SubroutineBase P Result valid w base params s₀) : + DynamicProgram ⟨O, Result⟩ r_ds B := + P.toDynamicProgram C.encode C.decode /-- Execute `P.initFresh` on zeroed `[base, base + C.space)` in `C.initTime` instructions. -/ theorem initFresh_exec (C : SubroutineBase P Result valid w base params s₀) {x : Data r_ds} @@ -378,152 +536,6 @@ theorem initFresh_rename (C : SubroutineBase P Result valid w base params s₀) · rw [Data.comap_extend hf] exact hpot -/-- Generic execution of `P.zeroFillCode` clearing `[base, base + C.space)` in `4 * C.space + 6` -instructions over any basis `B`. -/ -theorem zeroFillCode_exec (C : SubroutineBase P Result valid w base params s₀) {x₁ : Data r_ds} - (hx₁ : x₁.Bounded w) (hb₁ : x₁.regs P.baseReg = base) - (hfr₁ : x₁.regs P.frontierReg = base + C.space) - (hpar₁ : ∀ j, x₁.regs (P.initParams j) = params j) : - ∃ x₂, ExecWithin w P.zeroFillCode x₁ x₂ (4 * C.space + 6) ∧ - x₂.Bounded w ∧ - x₂.regs P.baseReg = base ∧ - x₂.regs P.frontierReg = base + C.space ∧ - (∀ j, x₂.regs (P.initParams j) = params j) ∧ - (∀ a ∈ (Block.mk base C.space).footprint, x₂.mem a = 0) ∧ - Modifies (Block.mk base C.space).footprint x₁.mem x₂.mem := by - have hfit0 : Fits w 0 := (hx₁.1 P.baseReg).of_le (Nat.zero_le _) - have hfit_stop : Fits w (base + C.space) := hfr₁ ▸ hx₁.1 P.frontierReg - obtain ⟨hcur_not, hzero_not, hone_not, hbase_ne_fr, _⟩ := - (List.nodup_cons.mp C.clear_nodup).imp_right fun h => - (List.nodup_cons.mp h).imp_right fun h => - (List.nodup_cons.mp h).imp_right List.nodup_cons.mp - have hcur_ne_zero : P.curReg ≠ P.zeroReg := fun h => hcur_not (by simp [h]) - have hcur_ne_one : P.curReg ≠ P.oneReg := fun h => hcur_not (by simp [h]) - have hcur_ne_base : P.curReg ≠ P.baseReg := fun h => hcur_not (by simp [h]) - have hcur_ne_fr : P.curReg ≠ P.frontierReg := fun h => hcur_not (by simp [h]) - have hzero_ne_one : P.zeroReg ≠ P.oneReg := fun h => hzero_not (by simp [h]) - have hzero_ne_base : P.zeroReg ≠ P.baseReg := fun h => hzero_not (by simp [h]) - have hzero_ne_fr : P.zeroReg ≠ P.frontierReg := fun h => hzero_not (by simp [h]) - have hone_ne_base : P.oneReg ≠ P.baseReg := fun h => hone_not (by simp [h]) - have hone_ne_fr : P.oneReg ≠ P.frontierReg := fun h => hone_not (by simp [h]) - by_cases hsp : 0 < C.space - · have hc_pos : (Cond.lt P.baseReg P.frontierReg).Holds x₁ := by - simp only [Cond.Holds, hb₁, hfr₁] - omega - have hfit1 : Fits w 1 := hfit_stop.of_le (by omega) - let x_z := x₁.set P.zeroReg 0 - let x_o := x_z.set P.oneReg 1 - let x_c := x_o.set P.curReg (x_o.regs P.baseReg) - have hxc_base : x_c.regs P.baseReg = base := by - simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hcur_ne_base.symm, - Function.update_of_ne hone_ne_base.symm, Function.update_of_ne hzero_ne_base.symm, hb₁] - have hxc_fr : x_c.regs P.frontierReg = base + C.space := by - simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hcur_ne_fr.symm, - Function.update_of_ne hone_ne_fr.symm, Function.update_of_ne hzero_ne_fr.symm, hfr₁] - have hxc_zero : x_c.regs P.zeroReg = 0 := by - simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hcur_ne_zero.symm, - Function.update_of_ne hzero_ne_one] - have hxc_one : x_c.regs P.oneReg = 1 := by - simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hcur_ne_one.symm] - have hxc_cur : x_c.regs P.curReg = base := by - simp [x_c, x_o, x_z, Data.set, Function.update_of_ne hone_ne_base.symm, - Function.update_of_ne hzero_ne_base.symm, hb₁] - let xs : ℕ → Data r_ds := fun i => - ⟨Function.update x_c.regs P.curReg (base + i), clear x₁.mem base i⟩ - have hxs0 : xs 0 = x_c := by - ext r - · by_cases hr : r = P.curReg - · subst hr - simp [xs, hxc_cur] - · simp [xs, Function.update_of_ne hr, x_c, x_o, x_z, Data.set] - · simp [xs, x_c, x_o, x_z, Data.set] - have hloop_cond : ∀ i < C.space, (Cond.lt P.curReg P.frontierReg).Holds (xs i) := by - intro i hi - simp only [Cond.Holds, xs, Function.update_self, - Function.update_of_ne hcur_ne_fr.symm, hxc_fr] - omega - have hloop_exit : ¬(Cond.lt P.curReg P.frontierReg).Holds (xs C.space) := by - simp only [Cond.Holds, xs, Function.update_self, - Function.update_of_ne hcur_ne_fr.symm, hxc_fr] - omega - have hloop_body : ∀ i < C.space, - ExecWithin w (.seq (.op (.store P.curReg P.zeroReg)) (.op P.incCur)) - (xs i) (xs (i + 1)) 2 := by - intro i hi - have hsi_zero : (xs i).regs P.zeroReg = 0 := by - simp [xs, Function.update_of_ne hcur_ne_zero.symm, hxc_zero] - have hsi_one : (xs i).regs P.oneReg = 1 := by - simp [xs, Function.update_of_ne hcur_ne_one.symm, hxc_one] - have hsi_cur : (xs i).regs P.curReg = base + i := by simp [xs] - let x_st := (xs i).write ((xs i).regs P.curReg) ((xs i).regs P.zeroReg) - have hst_one : x_st.regs P.oneReg = 1 := hsi_one - have hst_fit : Fits w (x_st.regs P.curReg + 1) := by - change Fits w ((xs i).regs P.curReg + 1) - rw [hsi_cur] - exact hfit_stop.of_le (by omega) - have hinc : ExecWithin w (.op P.incCur) x_st (x_st.set P.curReg (x_st.regs P.curReg + 1)) 1 := - (Exec.op (C.incCur_eval hst_one hst_fit)).within - have htarget : x_st.set P.curReg (x_st.regs P.curReg + 1) = xs (i + 1) := by - ext r - · simp only [x_st, Data.set, Data.write, xs, hsi_cur] - by_cases hr : r = P.curReg - · subst hr - simp [Nat.add_assoc] - · simp [Function.update_of_ne hr] - · simp only [x_st, Data.set, Data.write, hsi_cur, hsi_zero] - simp [xs, clear_succ] - rw [htarget] at hinc - exact ExecWithin.store.seq hinc - have hloop : ExecWithin w - (.loop (.lt P.curReg P.frontierReg) (.seq (.op (.store P.curReg P.zeroReg)) (.op P.incCur))) - x_c (xs C.space) (C.space * (2 + 2) + 2) := by - simpa [hxs0] using ExecWithin.loop xs C.space 2 hloop_cond hloop_exit hloop_body - have hbranch : ExecWithin w P.zeroFillCode x₁ (xs C.space) (4 * C.space + 6) := by - have hseq : ExecWithin w - (.seq (.op (.const P.zeroReg 0)) <| - .seq (.op (.const P.oneReg 1)) <| - .seq (.op (.copy P.curReg P.baseReg)) <| - .loop (.lt P.curReg P.frontierReg) - (.seq (.op (.store P.curReg P.zeroReg)) (.op P.incCur))) - x₁ (xs C.space) (3 + (C.space * 4 + 2)) := by - obtain ⟨n₁, hn₁, he₁⟩ := (ExecWithin.const (x := x₁) (d := P.zeroReg) hfit0) - obtain ⟨n₂, hn₂, he₂⟩ := (ExecWithin.const (x := x_z) (d := P.oneReg) hfit1) - obtain ⟨n₃, hn₃, he₃⟩ := (ExecWithin.copy (B := B) (w := w) (x := x_o) - (d := P.curReg) (s := P.baseReg)) - obtain ⟨n₄, hn₄, he₄⟩ := hloop - exact ⟨n₁ + (n₂ + (n₃ + n₄)), by omega, he₁.seq (he₂.seq (he₃.seq he₄))⟩ - exact (ExecWithin.branch_pos hc_pos hseq).mono (by omega) - refine ⟨xs C.space, hbranch, hbranch.bounded hx₁, ?_, ?_, ?_, ?_, ?_⟩ - · simp [xs, Function.update_of_ne hcur_ne_base.symm, hxc_base] - · simp [xs, Function.update_of_ne hcur_ne_fr.symm, hxc_fr] - · intro j - have hne := C.params_not_clear j - have h1 : P.initParams j ≠ P.curReg := fun h => hne (by simp [h]) - have h2 : P.initParams j ≠ P.zeroReg := fun h => hne (by simp [h]) - have h3 : P.initParams j ≠ P.oneReg := fun h => hne (by simp [h]) - simp [xs, x_c, x_o, x_z, Data.set, Function.update_of_ne h1, Function.update_of_ne h2, - Function.update_of_ne h3, hpar₁ j] - · intro a ha - exact clear_of_owns (Block.mem_footprint.mp ha) - · intro a ha - exact clear_of_not_owns (mt Block.mem_footprint.mpr ha) - · have hsp0 : C.space = 0 := by omega - have hc_neg : ¬(Cond.lt P.baseReg P.frontierReg).Holds x₁ := by - simp only [Cond.Holds, hb₁, hfr₁, hsp0] - omega - have hbranch : ExecWithin w P.zeroFillCode x₁ (x₁.set P.zeroReg 0) (4 * C.space + 6) := - (ExecWithin.branch_neg hc_neg (ExecWithin.const hfit0)).mono (by omega) - refine ⟨x₁.set P.zeroReg 0, hbranch, hbranch.bounded hx₁, ?_, ?_, ?_, ?_, ?_⟩ - · simp [Data.set, Function.update_of_ne hzero_ne_base.symm, hb₁] - · simp [Data.set, Function.update_of_ne hzero_ne_fr.symm, hfr₁] - · intro j - have hne := C.params_not_clear j - have h2 : P.initParams j ≠ P.zeroReg := fun h => hne (by simp [h]) - simp [Data.set, Function.update_of_ne h2, hpar₁ j] - · intro a ha - simp [hsp0, Block.footprint] at ha - · exact Modifies.refl _ _ - /-- Execute `P.initClear` on **arbitrary dirty memory** in `C.initTime + 4 * C.space + 6` instructions. -/ theorem initClear_exec (C : SubroutineBase P Result valid w base params s₀) {x : Data r_ds} @@ -536,7 +548,8 @@ theorem initClear_exec (C : SubroutineBase P Result valid w base params s₀) {x Modifies (Block.mk base C.space).footprint x.mem y.mem := by obtain ⟨x₁, he₁, hm₁, hb₁, hfr₁, hpar₁⟩ := C.span_exec hx hfr hpar obtain ⟨x₂, he₂, hx₂, hb₂, hfr₂, hpar₂, hz₂, hmod₂⟩ := - C.zeroFillCode_exec (he₁.bounded hx) hb₁ hfr₁ hpar₁ + P.zeroFillCode_exec C.clear_nodup C.params_not_clear C.incCur_eval + (he₁.bounded hx) hb₁ hfr₁ hpar₁ obtain ⟨y, he₃, hfr₃, hrep, hpot, hmod₃⟩ := C.setup_exec hx₂ hb₂ hfr₂ hpar₂ hz₂ rw [hm₁] at hmod₂ have hmod : Modifies (Block.mk base C.space).footprint x.mem y.mem := by diff --git a/ComplexityTests/WordRAMDynamic.lean b/ComplexityTests/WordRAMDynamic.lean index 3e98d9e66..d27a344b5 100644 --- a/ComplexityTests/WordRAMDynamic.lean +++ b/ComplexityTests/WordRAMDynamic.lean @@ -147,9 +147,11 @@ example : (fun (_, answer, _) => answer) = some none ∧ ((Stack.implementation 4 2).eval 4 0 .size (Stack.initial 3)).map (fun (_, answer, _) => answer) = some 0 ∧ - ({ exchangeProgram 4 with decode := fun _ _ => none }).eval 4 0 7 + ({ exchangeProgram 4 with decode := fun _ _ => none } : + DynamicProgram (exchangeSpec 4) 3 .standard).eval 4 0 7 ⟨fun _ => 0, fun _ => 0⟩ = none ∧ - ({ exchangeProgram 4 with code := .loop (.eq 0 0) (.op (.copy 0 0)) }).eval 4 2 7 + ({ exchangeProgram 4 with code := .loop (.eq 0 0) (.op (.copy 0 0)) } : + DynamicProgram (exchangeSpec 4) 3 .standard).eval 4 2 7 ⟨fun _ => 0, fun _ => 0⟩ = none := by decide