From c33195005eae3e6da0e33ad648b13d3cefaf9b42 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 17:41:28 -0400 Subject: [PATCH 01/19] feat(circuit/frontier): Boolean tensor networks and their contraction Tensor networks over a commutative semiring as the weighted form of the frontier constraint networks (shared Multigraph and locality), with the contraction Z, subdivision by equality tensors (preserves Z, bipartite, keeps degree bounds), explicit tables with ordered ports and size measures, the write-out theorem, and the 0-1 bridge from constraint networks. Tracking: #1833 (T1), #1538. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 3 + .../Circuit/Frontier/TensorNetwork.lean | 251 ++++++++++++++++++ .../Frontier/TensorNetwork/Constraint.lean | 81 ++++++ .../Frontier/TensorNetwork/Explicit.lean | 210 +++++++++++++++ .../Circuit/Frontier/TensorNetwork.lean | 116 ++++++++ 5 files changed, 661 insertions(+) create mode 100644 Complexity/Computability/Circuit/Frontier/TensorNetwork.lean create mode 100644 Complexity/Computability/Circuit/Frontier/TensorNetwork/Constraint.lean create mode 100644 Complexity/Computability/Circuit/Frontier/TensorNetwork/Explicit.lean create mode 100644 ComplexityTests/Computability/Circuit/Frontier/TensorNetwork.lean diff --git a/Complexity.lean b/Complexity.lean index 3942e2e28b..3e53d5172a 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -857,6 +857,9 @@ public import Complexity.Computability.Circuit.Frontier.Projection public import Complexity.Computability.Circuit.Frontier.Rectangle public import Complexity.Computability.Circuit.Frontier.Reduction public import Complexity.Computability.Circuit.Frontier.Sweep +public import Complexity.Computability.Circuit.Frontier.TensorNetwork +public import Complexity.Computability.Circuit.Frontier.TensorNetwork.Constraint +public import Complexity.Computability.Circuit.Frontier.TensorNetwork.Explicit public import Complexity.Computability.Circuit.Frontier.TwoSidedWitness public import Complexity.Computability.Circuit.Frontier.Unconditional public import Complexity.Computability.Circuit.Frontier.Witness diff --git a/Complexity/Computability/Circuit/Frontier/TensorNetwork.lean b/Complexity/Computability/Circuit/Frontier/TensorNetwork.lean new file mode 100644 index 0000000000..cf45df7f82 --- /dev/null +++ b/Complexity/Computability/Circuit/Frontier/TensorNetwork.lean @@ -0,0 +1,251 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Circuit.Frontier.Multigraph +public import Mathlib.Algebra.BigOperators.Group.Finset.Basic +public import Mathlib.Combinatorics.SimpleGraph.Bipartite +public import Mathlib.Basic.Finite.Sum +public import Mathlib.Data.Fintype.Pi +import Mathlib.Algebra.BigOperators.GroupWithZero.Finset +import Mathlib.Algebra.BigOperators.Ring.Finset + +/-! +# Tensor networks and their contraction + +A *tensor network* over a commutative semiring `R` and an alphabet `U` is a multigraph whose +edges carry values in `U`, with a *tensor* at each vertex `v`: a value `N.tensor v x ∈ R` for each +assignment `x : E → U` of values to the edges, which depends only on the values on the edges at +`v`. Its *contraction* sums, over all assignments, the product of the tensors: + + `Z(N) = ∑ x : E → U, ∏ v, N.tensor v x`. + +A *Boolean* tensor network has `U = Bool`, one bit per edge. The usual presentation gives the +tensor at `v` as a function `F_v` of the bits on the ordered list `δ(v)` of edges at `v`, with +`Z = ∑ x ∏ v F_v (x|δ(v))`. Here the tensor is a function of the whole assignment, constrained to +read only the edges at `v` (`TensorNetwork.tensor_congr`); the ordered presentation, with +explicit tables, is `Cslib.Circuits.Frontier.ExplicitTensorNetwork`, and +`Cslib.Circuits.Frontier.TensorNetwork.contraction_toExplicit` shows that the two contractions +agree. Parallel edges are distinct elements of `E` and so give distinct ports. + +A tensor network is the weighted form of a constraint network +(`Cslib.Circuits.Frontier.Network`) on a fixed input: the two share the multigraph and the +locality condition, and a constraint becomes its `0`–`1` indicator tensor, whose contraction +counts the satisfying assignments +(`Cslib.Circuits.Frontier.Network.contraction_toTensorNetwork`). + +**Subdivision** (`TensorNetwork.subdivide`). Splitting every edge `e` into two edges joined at a +new vertex that carries the *equality tensor* `[y₁ = y₂]` preserves the contraction +(`TensorNetwork.contraction_subdivide`): each assignment of the old network extends in exactly one +way to an assignment of the new one with nonzero weight. The subdivided network is bipartite +(`TensorNetwork.isBipartite_subdivide`), with the old vertices on one side and the new ones on the +other, and it keeps the degree bound of a loopless network (`TensorNetwork.maxDegreeLE_subdivide`). +It has twice as many edges and one new vertex per old edge. + +## Main definitions + +* `Cslib.Circuits.Frontier.Multigraph.IsBipartite`: the vertices split into two sides and every + edge joins the two sides. +* `Cslib.Circuits.Frontier.TensorNetwork`: a tensor network. +* `Cslib.Circuits.Frontier.TensorNetwork.contraction`: its contraction `Z`. +* `Cslib.Circuits.Frontier.TensorNetwork.subdivide`: subdivision of every edge by an equality + tensor. + +## Main results + +* `Cslib.Circuits.Frontier.Multigraph.isBipartite_iff`: a multigraph is bipartite iff it has no + loops and its underlying simple graph is bipartite (`SimpleGraph.IsBipartite`). +* `Cslib.Circuits.Frontier.TensorNetwork.contraction_subdivide`: subdivision preserves the + contraction. +* `Cslib.Circuits.Frontier.TensorNetwork.isBipartite_subdivide`: a subdivided network is + bipartite. +* `Cslib.Circuits.Frontier.TensorNetwork.maxDegreeLE_subdivide`: subdividing a loopless network of + maximum degree at most `d ≥ 2` gives maximum degree at most `d`. + +## References + +* [OpenAI, *The Exponential Time Hypothesis is False*][OpenAI2026ETH], Appendix D.1 (p. 53) and + the subdivision step of Appendix D.2 (p. 54). +-/ + +@[expose] public section + +namespace Cslib.Circuits.Frontier + +open Set + +/-! ### Bipartite multigraphs -/ + +namespace Multigraph + +variable {V E : Type*} (G : Multigraph V E) + +/-- A multigraph is *bipartite* when its vertices split into two sides, `side v = true` and +`side v = false`, and every edge joins the two sides. A bipartite multigraph has no loops +(`Multigraph.IsBipartite.loopless`). -/ +def IsBipartite : Prop := + ∃ side : V → Bool, ∀ e, side (G.src e) ≠ side (G.tgt e) + +variable {G} + +/-- A bipartite multigraph has no loops. -/ +theorem IsBipartite.loopless (h : G.IsBipartite) : G.Loopless := by + obtain ⟨side, hside⟩ := h + exact fun e he => hside e (congrArg side he) + +/-- A multigraph is bipartite exactly when it has no loops and its underlying simple graph is +bipartite in the sense of Mathlib (`SimpleGraph.IsBipartite`, a `2`-colouring). -/ +theorem isBipartite_iff : G.IsBipartite ↔ G.Loopless ∧ G.toSimpleGraph.IsBipartite := by + constructor + · intro h + refine ⟨h.loopless, ?_⟩ + obtain ⟨side, hside⟩ := h + have hcol : G.toSimpleGraph.Coloring Bool := SimpleGraph.Coloring.mk side fun {u v} huv => by + obtain ⟨-, e, he⟩ := toSimpleGraph_adj.mp huv + rcases Sym2.eq_iff.mp he with ⟨hu, hv⟩ | ⟨hu, hv⟩ + · exact hu ▸ hv ▸ hside e + · exact hu ▸ hv ▸ (hside e).symm + simpa using hcol.colorable + · rintro ⟨hloop, ⟨c⟩⟩ + refine ⟨fun v => decide (c v = 0), fun e he => ?_⟩ + have hadj : G.toSimpleGraph.Adj (G.src e) (G.tgt e) := toSimpleGraph_adj.mpr ⟨hloop e, e, rfl⟩ + have key : ∀ a b : Fin 2, a ≠ b → decide (a = 0) ≠ decide (b = 0) := by decide + exact key _ _ (c.valid hadj) he + +end Multigraph + +/-! ### Tensor networks -/ + +/-- A *tensor network* over the commutative semiring `R` with alphabet `U`: a multigraph on the +vertices `V` and edges `E`, whose edges carry values in `U`, and at each vertex a *tensor*, a value +in `R` for each assignment of values to the edges, that sees only the values on the edges at that +vertex. A *Boolean* tensor network has `U = Bool`. -/ +structure TensorNetwork (R U V E : Type*) extends Multigraph V E where + /-- The tensor at a vertex: its value on an assignment of values to the edges. -/ + tensor : V → (E → U) → R + /-- Tensors are local: the tensor at `v` sees only the values on the edges incident to `v`. -/ + tensor_congr : ∀ v x y, (∀ e, src e = v ∨ tgt e = v → x e = y e) → tensor v x = tensor v y + +namespace TensorNetwork + +variable {R U V E : Type*} + +section Contraction + +variable [CommSemiring R] [Fintype U] [Fintype V] [Fintype E] [DecidableEq E] + +/-- The *contraction* of a tensor network: the sum over all assignments of values to the edges of +the product of the tensors at all vertices. -/ +def contraction (N : TensorNetwork R U V E) : R := + ∑ x : E → U, ∏ v, N.tensor v x + +end Contraction + +/-! ### Subdivision by equality tensors -/ + +section Subdivide + +variable [DecidableEq U] [DecidableEq V] [Zero R] [One R] (N : TensorNetwork R U V E) + +/-- The *subdivision* of a tensor network by equality tensors. Each edge `e` becomes a new vertex +`Sum.inr e` and two edges: `Sum.inl e`, from the source of `e`, and `Sum.inr e`, from its target, +both ending at `Sum.inr e`. The new vertex carries the *equality tensor*, one when its two edges +carry the same value and zero otherwise. An old vertex reads the value of `e` on the half of `e` +at its end. -/ +def subdivide : TensorNetwork R U (V ⊕ E) (E ⊕ E) where + src := Sum.elim (fun e => .inl (N.src e)) (fun e => .inl (N.tgt e)) + tgt := Sum.elim .inr .inr + tensor + | .inl v, y => N.tensor v fun e => if N.src e = v then y (.inl e) else y (.inr e) + | .inr e, y => if y (.inl e) = y (.inr e) then 1 else 0 + tensor_congr := by + rintro (v | e) y y' h + · refine N.tensor_congr v _ _ fun e he => ?_ + by_cases hs : N.src e = v + · simp only [hs, ite_true] + exact h (.inl e) (Or.inl (by simp [hs])) + · simp only [hs, ite_false] + exact h (.inr e) (Or.inl (by simp [he.resolve_left hs])) + · simp only + rw [h (.inl e) (Or.inr rfl), h (.inr e) (Or.inr rfl)] + +@[simp] theorem subdivide_src_inl (e : E) : N.subdivide.src (.inl e) = .inl (N.src e) := rfl + +@[simp] theorem subdivide_src_inr (e : E) : N.subdivide.src (.inr e) = .inl (N.tgt e) := rfl + +@[simp] theorem subdivide_tgt_inl (e : E) : N.subdivide.tgt (.inl e) = .inr e := rfl + +@[simp] theorem subdivide_tgt_inr (e : E) : N.subdivide.tgt (.inr e) = .inr e := rfl + +/-- The tensor at an old vertex of the subdivision. -/ +theorem subdivide_tensor_inl (v : V) (y : E ⊕ E → U) : + N.subdivide.tensor (.inl v) y = + N.tensor v fun e => if N.src e = v then y (.inl e) else y (.inr e) := rfl + +/-- The equality tensor at a new vertex of the subdivision. -/ +theorem subdivide_tensor_inr (e : E) (y : E ⊕ E → U) : + N.subdivide.tensor (.inr e) y = if y (.inl e) = y (.inr e) then 1 else 0 := rfl + +/-- **Subdivision is bipartite.** Every edge of the subdivision joins an old vertex to a new one. -/ +theorem isBipartite_subdivide : N.subdivide.IsBipartite := + ⟨Sum.isLeft, fun e => by cases e <;> simp⟩ + +/-- **Subdivision preserves the contraction.** An assignment of the subdivision has nonzero +weight only when the two halves of every edge carry the same value, and such assignments are +exactly the assignments of the original network. -/ +theorem contraction_subdivide {R : Type*} [CommSemiring R] [Fintype U] [Fintype V] [Fintype E] + [DecidableEq E] (N : TensorNetwork R U V E) : N.subdivide.contraction = N.contraction := by + classical + -- Split an assignment of the subdivision into its values `a` on the source halves and `b` on + -- the target halves. + rw [contraction, contraction, ← (Equiv.sumArrowEquivProdArrow E E U).symm.sum_comp, + Fintype.sum_prod_type] + refine Finset.sum_congr rfl fun a _ => ?_ + simp only [Fintype.prod_sum_type, subdivide_tensor_inl, subdivide_tensor_inr, + Equiv.sumArrowEquivProdArrow_symm_apply_inl, Equiv.sumArrowEquivProdArrow_symm_apply_inr] + rw [Finset.sum_eq_single a] + · -- Equal halves: every equality tensor is one, and the old vertices read `a`. + simp only [ite_self, ite_true, Finset.prod_const_one, mul_one] + · -- Unequal halves on some edge `e`: the equality tensor at `e` vanishes. + intro b _ hb + obtain ⟨e, he⟩ := Function.ne_iff.mp hb + exact mul_eq_zero_of_right _ + (Finset.prod_eq_zero (Finset.mem_univ e) (ite_eq_right fun h => he h.symm)) + · exact fun h => absurd (Finset.mem_univ a) h + +/-- The edges at an old vertex of the subdivision are the halves of its old edges at it. -/ +theorem incidenceSet_subdivide_inl (v : V) : + N.subdivide.incidenceSet (.inl v) = + Sum.inl '' {e | N.src e = v} ∪ Sum.inr '' {e | N.tgt e = v} := by + ext (e | e) <;> simp [Multigraph.mem_incidenceSet] + +/-- The edges at a new vertex of the subdivision are the two halves of its edge. -/ +theorem incidenceSet_subdivide_inr (e : E) : + N.subdivide.incidenceSet (.inr e) = {.inl e, .inr e} := by + ext (e' | e') <;> simp [Multigraph.mem_incidenceSet, eq_comm] + +/-- **Subdivision keeps the degree bound.** In a loopless network, the edges at a vertex are those +with it as source and those with it as target, and they are the halves at its old vertex in the +subdivision; a new vertex has degree two. -/ +theorem maxDegreeLE_subdivide [Finite E] {d : ℕ} (hloop : N.Loopless) + (hd : N.MaxDegreeLE d) (h2 : 2 ≤ d) : N.subdivide.MaxDegreeLE d := by + rintro (v | e) + · rw [incidenceSet_subdivide_inl, ncard_union_eq _ (toFinite _) (toFinite _), + ncard_image_of_injective _ Sum.inl_injective, ncard_image_of_injective _ Sum.inr_injective, + ← ncard_union_eq _ (toFinite _) (toFinite _)] + · exact hd v + · exact disjoint_left.mpr fun e hs ht => hloop e (hs.trans ht.symm) + · exact disjoint_left.mpr fun _ ⟨_, _, h⟩ ⟨_, _, h'⟩ => Sum.inl_ne_inr (h.trans h'.symm) + · rw [incidenceSet_subdivide_inr, ncard_pair Sum.inl_ne_inr] + exact h2 + +end Subdivide + +end TensorNetwork + +end Cslib.Circuits.Frontier diff --git a/Complexity/Computability/Circuit/Frontier/TensorNetwork/Constraint.lean b/Complexity/Computability/Circuit/Frontier/TensorNetwork/Constraint.lean new file mode 100644 index 0000000000..08c80a6649 --- /dev/null +++ b/Complexity/Computability/Circuit/Frontier/TensorNetwork/Constraint.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Circuit.Frontier.Network +public import Complexity.Computability.Circuit.Frontier.TensorNetwork +import Mathlib.Algebra.BigOperators.GroupWithZero.Finset +import Mathlib.Algebra.BigOperators.Ring.Finset + +/-! +# Constraint networks as `0`–`1` tensor networks + +A constraint network (`Cslib.Circuits.Frontier.Network`) on a fixed input is a tensor network +whose tensors take only the values zero and one: the tensor at `v` is the indicator of the +constraint at `v` (`Network.toTensorNetwork`). The two share the multigraph, and the locality of +the constraints is the locality of the tensors. The contraction of this tensor network is the +number of satisfying assignments (`Network.contraction_toTensorNetwork`), so over `ℕ` it is +nonzero exactly at the accepted inputs (`Network.mem_accepted_iff_contraction_ne_zero`). + +A general tensor network is thus the weighted form of a constraint network, and the frontier +constraint networks of circuits (`Cslib.Circuits.Frontier.Compiler.network`) are special cases. + +## Main definitions + +* `Cslib.Circuits.Frontier.Network.toTensorNetwork`: the indicator tensor network of a constraint + network on an input. + +## Main results + +* `Cslib.Circuits.Frontier.Network.contraction_toTensorNetwork`: its contraction counts the + satisfying assignments. +* `Cslib.Circuits.Frontier.Network.mem_accepted_iff_contraction_ne_zero`: an input is accepted iff + the contraction over `ℕ` is nonzero. +-/ + +@[expose] public section + +namespace Cslib.Circuits.Frontier.Network + +variable {U ι V E : Type*} (R : Type*) (N : Network U ι V E) + +open Classical in +/-- The `0`–`1` tensor network of a constraint network on the input `x`: the same multigraph, with +the tensor at `v` equal to one where the constraint at `v` holds and to zero elsewhere. -/ +noncomputable def toTensorNetwork [Zero R] [One R] (x : ι → U) : TensorNetwork R U V E where + toMultigraph := N.toMultigraph + tensor v α := if N.Constraint v x α then 1 else 0 + tensor_congr v α β h := by + have hiff : N.Constraint v x α ↔ N.Constraint v x β := + ⟨N.constraint_congr v x x α β (fun _ _ => rfl) h, + N.constraint_congr v x x β α (fun _ _ => rfl) fun e he => (h e he).symm⟩ + simp only [hiff] + +/-- The tensor network of a constraint network has the same multigraph. -/ +@[simp] theorem toMultigraph_toTensorNetwork [Zero R] [One R] (x : ι → U) : + (N.toTensorNetwork R x).toMultigraph = N.toMultigraph := + rfl + +/-- **The contraction counts satisfying assignments.** The contraction of the `0`–`1` tensor +network of a constraint network on the input `x` is the number of assignments of values to the +edges that satisfy every constraint on `x`. -/ +theorem contraction_toTensorNetwork [CommSemiring R] [Fintype U] [Fintype V] [Fintype E] + [DecidableEq E] (x : ι → U) : + (N.toTensorNetwork R x).contraction = ({α | N.Satisfies x α} : Set (E → U)).ncard := by + classical + simp only [TensorNetwork.contraction, toTensorNetwork, Fintype.prod_boole, Finset.sum_boole, + Set.ncard_eq_toFinset_card', Set.toFinset_ofPred, Satisfies] + +/-- Over `ℕ`, the contraction is nonzero exactly at the accepted inputs. -/ +theorem mem_accepted_iff_contraction_ne_zero [Fintype U] [Fintype V] [Fintype E] [DecidableEq E] + (x : ι → U) : x ∈ N.accepted ↔ (N.toTensorNetwork ℕ x).contraction ≠ 0 := by + rw [contraction_toTensorNetwork, Nat.cast_id, Ne, Set.ncard_eq_zero (Set.toFinite _), + ← Ne, ← Set.nonempty_iff_ne_empty] + rfl + +end Cslib.Circuits.Frontier.Network diff --git a/Complexity/Computability/Circuit/Frontier/TensorNetwork/Explicit.lean b/Complexity/Computability/Circuit/Frontier/TensorNetwork/Explicit.lean new file mode 100644 index 0000000000..28f5dd3f54 --- /dev/null +++ b/Complexity/Computability/Circuit/Frontier/TensorNetwork/Explicit.lean @@ -0,0 +1,210 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Circuit.Frontier.TensorNetwork +import Mathlib.Algebra.BigOperators.Fin +import Mathlib.Data.List.GetD + +/-! +# Explicit Boolean tensor networks + +An *explicit* Boolean tensor network (`ExplicitTensorNetwork R`) is the data an algorithm reads: +the number of edges, numbered `0, 1, …`, and a list of vertices, each given by + +* its ordered list of *ports*, the numbers of the edges at the vertex, and +* its *table*: the value of its tensor when port `i` carries the bit `bs[i]` is the entry at + position `tableIndex bs`, the number whose binary digit `i` is `bs[i]`. + +So a vertex with `k` ports has a table of `2 ^ k` entries. The contraction of an explicit network +(`ExplicitTensorNetwork.contraction`) sums, over all assignments of bits to the edges, the product +of the table entries at the bits on the ports. It needs no well-formedness: a port naming no edge +reads `false`, and a position past the end of a table has entry zero. + +Its size measures are the number of edges, the number of vertices, the maximum number of ports of +a vertex (`ExplicitTensorNetwork.maxDegree`) and the total length of the tables +(`ExplicitTensorNetwork.tableLength`). + +**Writing a network out** (`TensorNetwork.toExplicit`). Given numberings of the vertices and the +edges of a Boolean tensor network on finite types, list the edges at each vertex in increasing +order and tabulate its tensor on them. The contraction is unchanged +(`TensorNetwork.contraction_toExplicit`). + +## Main definitions + +* `Cslib.Circuits.Frontier.tableIndex`: the position of a list of bits in a table. +* `Cslib.Circuits.Frontier.ExplicitTensorNetwork`: an explicit Boolean tensor network. +* `Cslib.Circuits.Frontier.ExplicitTensorNetwork.entry`, + `Cslib.Circuits.Frontier.ExplicitTensorNetwork.portBits`: table lookup and the bits on a list + of ports. +* `Cslib.Circuits.Frontier.ExplicitTensorNetwork.contraction`: the contraction. +* `Cslib.Circuits.Frontier.ExplicitTensorNetwork.maxDegree`, + `Cslib.Circuits.Frontier.ExplicitTensorNetwork.tableLength`: size measures. +* `Cslib.Circuits.Frontier.TensorNetwork.explicitPorts`, + `Cslib.Circuits.Frontier.TensorNetwork.explicitTable`, + `Cslib.Circuits.Frontier.TensorNetwork.toExplicit`: writing a Boolean tensor network out. + +## Main results + +* `Cslib.Circuits.Frontier.testBit_tableIndex`, `Cslib.Circuits.Frontier.tableIndex_lt`: the + digits and range of a table position. +* `Cslib.Circuits.Frontier.ExplicitTensorNetwork.maxDegree_le_iff`: the degree bound. +* `Cslib.Circuits.Frontier.TensorNetwork.entry_explicitTable`: a written-out table evaluates the + tensor. +* `Cslib.Circuits.Frontier.TensorNetwork.contraction_toExplicit`: writing a network out preserves + its contraction. + +## References + +* [OpenAI, *The Exponential Time Hypothesis is False*][OpenAI2026ETH], Appendix D.1 (p. 53). +-/ + +@[expose] public section + +namespace Cslib.Circuits.Frontier + +/-- The position of a list of bits in a table: the number whose binary digit `i` is `bs[i]`, so +that the bits are read little-endian. -/ +def tableIndex (bs : List Bool) : ℕ := + (BitVec.ofBoolListLE bs).toNat + +/-- Binary digit `i` of the position of `bs` is `bs[i]`, or `false` past the end of `bs`. -/ +@[simp] theorem testBit_tableIndex (bs : List Bool) (i : ℕ) : + (tableIndex bs).testBit i = bs.getD i false := by + rw [tableIndex, BitVec.testBit_toNat, BitVec.getLsbD_ofBoolListLE] + +/-- A list of `k` bits has a position below `2 ^ k`. -/ +theorem tableIndex_lt (bs : List Bool) : tableIndex bs < 2 ^ bs.length := + BitVec.isLt _ + +/-- An *explicit Boolean tensor network* over `R`: the number of edges, numbered from zero, and a +list of vertices. A vertex is given by its ordered list of *ports*, the numbers of its edges, and +its *table*, whose entry at position `tableIndex bs` is the value of its tensor when port `i` +carries the bit `bs[i]`. -/ +structure ExplicitTensorNetwork (R : Type*) where + /-- The number of edges; the edges are numbered `0, …, numEdges - 1`. -/ + numEdges : ℕ + /-- The vertices, each given by its ports and its table. -/ + vertices : List (List ℕ × List R) + +namespace ExplicitTensorNetwork + +variable {R : Type*} (d : ExplicitTensorNetwork R) + +/-- The entry of a table at a list of bits. A position past the end of the table has entry +zero. -/ +def entry [Zero R] (table : List R) (bs : List Bool) : R := + table.getD (tableIndex bs) 0 + +/-- The bits on a list of ports under an assignment of bits to the edges. A port naming no edge +reads `false`. -/ +def portBits (x : Fin d.numEdges → Bool) (ports : List ℕ) : List Bool := + ports.map fun i => if h : i < d.numEdges then x ⟨i, h⟩ else false + +/-- The *contraction* of an explicit network: the sum over all assignments of bits to the edges of +the product, over the vertices, of the table entries at the bits on their ports. -/ +def contraction [CommSemiring R] : R := + ∑ x : Fin d.numEdges → Bool, (d.vertices.map fun v => entry v.2 (d.portBits x v.1)).prod + +/-- The *maximum degree*: the largest number of ports of a vertex, or zero without vertices. -/ +def maxDegree : ℕ := + (d.vertices.map fun v => v.1.length).foldr max 0 + +/-- The total length of the tables. -/ +def tableLength : ℕ := + (d.vertices.map fun v => v.2.length).sum + +private theorem foldr_max_le_iff (l : List ℕ) (k : ℕ) : l.foldr max 0 ≤ k ↔ ∀ n ∈ l, n ≤ k := by + induction l with + | nil => simp + | cons a l ih => simp [ih] + +/-- The maximum degree is at most `k` exactly when every vertex has at most `k` ports. -/ +theorem maxDegree_le_iff {k : ℕ} : d.maxDegree ≤ k ↔ ∀ v ∈ d.vertices, v.1.length ≤ k := by + rw [maxDegree, foldr_max_le_iff] + constructor + · exact fun h v hv => h _ (List.mem_map_of_mem hv) + · rintro h _ hn + obtain ⟨v, hv, rfl⟩ := List.mem_map.mp hn + exact h v hv + +/-- Every vertex has at most `maxDegree` ports. -/ +theorem length_le_maxDegree {v : List ℕ × List R} (hv : v ∈ d.vertices) : + v.1.length ≤ d.maxDegree := + d.maxDegree_le_iff.mp le_rfl v hv + +end ExplicitTensorNetwork + +/-! ### Writing a tensor network out -/ + +namespace TensorNetwork + +variable {R V E : Type*} [DecidableEq V] {n m : ℕ} (N : TensorNetwork R Bool V E) (ev : V ≃ Fin n) + (ee : E ≃ Fin m) + +/-- The ports of a vertex when the edges are numbered by `ee`: the numbers of the edges at the +vertex, in increasing order. -/ +def explicitPorts (v : V) : List (Fin m) := + (List.finRange m).filter fun j => N.src (ee.symm j) = v ∨ N.tgt (ee.symm j) = v + +/-- An edge is a port of `v` exactly when it is incident to `v`. -/ +@[simp] theorem mem_explicitPorts {v : V} {j : Fin m} : + j ∈ N.explicitPorts ee v ↔ N.src (ee.symm j) = v ∨ N.tgt (ee.symm j) = v := by + simp [explicitPorts] + +/-- The table of a vertex: its tensor at each list of bits on its ports, by position. -/ +def explicitTable (v : V) : List R := + (List.range (2 ^ (N.explicitPorts ee v).length)).map fun j => + N.tensor v fun e => j.testBit ((N.explicitPorts ee v).idxOf (ee e)) + +/-- **A written-out table evaluates the tensor.** At the bits that an assignment puts on the ports +of `v`, the table of `v` has the value of the tensor at that assignment. -/ +theorem entry_explicitTable [Zero R] (v : V) (x : Fin m → Bool) : + ExplicitTensorNetwork.entry (N.explicitTable ee v) ((N.explicitPorts ee v).map x) = + N.tensor v (x ∘ ee) := by + set ps := N.explicitPorts ee v + have hlt : tableIndex (ps.map x) < (N.explicitTable ee v).length := by + simpa [explicitTable, ps] using tableIndex_lt (ps.map x) + rw [ExplicitTensorNetwork.entry, List.getD_eq_getElem _ _ hlt] + simp only [explicitTable, List.getElem_map, List.getElem_range] + refine N.tensor_congr v _ _ fun e he => ?_ + have hmem : ee e ∈ ps := (N.mem_explicitPorts ee).mpr (by simpa using he) + have hidx := List.idxOf_lt_length_of_mem hmem + rw [testBit_tableIndex, List.getD_eq_getElem _ _ (by simpa using hidx), List.getElem_map, + List.getElem_idxOf hidx, Function.comp_apply] + +/-- A Boolean tensor network on finite types written out as an explicit network, numbering the +vertices by `ev` and the edges by `ee`: vertex `i` is `ev.symm i`, with its ports in increasing +order and its table. -/ +def toExplicit : ExplicitTensorNetwork R where + numEdges := m + vertices := List.ofFn fun i => + ((N.explicitPorts ee (ev.symm i)).map Fin.val, N.explicitTable ee (ev.symm i)) + +/-- **Writing a network out preserves its contraction.** -/ +theorem contraction_toExplicit [CommSemiring R] [Fintype V] [Fintype E] [DecidableEq E] : + (N.toExplicit ev ee).contraction = N.contraction := by + rw [ExplicitTensorNetwork.contraction, contraction] + refine Fintype.sum_equiv (ee.symm.arrowCongr (Equiv.refl Bool)) _ _ fun x => ?_ + have hv : (N.toExplicit ev ee).vertices = List.ofFn fun i => + ((N.explicitPorts ee (ev.symm i)).map Fin.val, N.explicitTable ee (ev.symm i)) := rfl + rw [hv, List.map_ofFn, List.prod_ofFn, ← ev.symm.prod_comp] + refine Finset.prod_congr rfl fun i _ => ?_ + -- Every port names an edge, so the bits on the ports are those of the assignment. + have hbits : (N.toExplicit ev ee).portBits x ((N.explicitPorts ee (ev.symm i)).map Fin.val) = + (N.explicitPorts ee (ev.symm i)).map x := by + unfold ExplicitTensorNetwork.portBits + rw [List.map_map] + exact List.map_congr_left fun j _ => dite_eq_left j.isLt + simp only [Function.comp_apply] + rw [hbits, entry_explicitTable] + rfl + +end TensorNetwork + +end Cslib.Circuits.Frontier diff --git a/ComplexityTests/Computability/Circuit/Frontier/TensorNetwork.lean b/ComplexityTests/Computability/Circuit/Frontier/TensorNetwork.lean new file mode 100644 index 0000000000..5be31a11e9 --- /dev/null +++ b/ComplexityTests/Computability/Circuit/Frontier/TensorNetwork.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: local-only (test driver) + +public import Complexity.Computability.Circuit.Frontier.TensorNetwork.Constraint +public import Complexity.Computability.Circuit.Frontier.TensorNetwork.Explicit +public import Mathlib.Data.ZMod.Defs + +/-! +# Tests for tensor networks + +Hand-checked contractions of small explicit Boolean tensor networks (two parallel edges, and +four-cycles of equality and negation tensors over `ZMod 8`), a tensor network on finite types +written out and subdivided, and a constraint network counted by its indicator tensor network. +-/ + +@[expose] public section + +namespace ComplexityTests.Computability.Circuit.Frontier.TensorNetwork + +open Cslib.Circuits.Frontier + +/-! ### Explicit networks -/ + +/-- Two vertices joined by two parallel edges `0` and `1`, with the tables `A = (1, 2, 3, 4)` and +`B = (5, 6, 7, 8)`, read at positions `x₀ + 2 x₁`. -/ +def parallel : ExplicitTensorNetwork ℤ := + ⟨2, [([0, 1], [1, 2, 3, 4]), ([0, 1], [5, 6, 7, 8])]⟩ + +/-- By hand: `Z = ∑ᵢ Aᵢ Bᵢ = 1·5 + 2·6 + 3·7 + 4·8 = 70`. -/ +example : parallel.contraction = 70 := by decide + +example : parallel.maxDegree = 2 ∧ parallel.tableLength = 8 := by decide + +/-- The equality tensor on two ports. -/ +def eqTable : List (ZMod 8) := [1, 0, 0, 1] + +/-- The negation tensor on two ports: its two bits differ. -/ +def neTable : List (ZMod 8) := [0, 1, 1, 0] + +/-- A bipartite four-cycle `r₀ - c₀ - r₁ - c₁ - r₀` on the edges `0, 1, 2, 3`, with the table `t` +at `c₁` and equality tensors elsewhere. -/ +def cycle (t : List (ZMod 8)) : ExplicitTensorNetwork (ZMod 8) := + ⟨4, [([3, 0], eqTable), ([0, 1], eqTable), ([1, 2], eqTable), ([2, 3], t)]⟩ + +/-- With equality tensors all around, an assignment contributes exactly when all four bits are +equal: `Z = 2`. -/ +example : (cycle eqTable).contraction = 2 := by decide + +/-- One negation on a cycle forces an odd number of bit changes around it, which is impossible: +`Z = 0`. -/ +example : (cycle neTable).contraction = 0 := by decide + +/-! ### A network on finite types, written out and subdivided -/ + +/-- The table `A` or `B` of `parallel` as a tensor on assignments to `Fin 2`. -/ +def table (v : Fin 2) (x : Fin 2 → Bool) : ℤ := + [[1, 2, 3, 4], [5, 6, 7, 8]][v]!.getD (tableIndex [x 0, x 1]) 0 + +/-- The network `parallel` on `Fin 2` vertices and `Fin 2` edges, both edges from `0` to `1`. +Every edge is at both vertices, so the tensors are trivially local. -/ +def parallelNetwork : TensorNetwork ℤ Bool (Fin 2) (Fin 2) where + src _ := 0 + tgt _ := 1 + tensor := table + tensor_congr v x y h := by + have hxy : x = y := funext fun e => h e (by fin_cases v <;> simp) + rw [hxy] + +/-- Writing the network out gives `parallel` up to the order of its data, and the same +contraction. -/ +example : parallelNetwork.contraction = 70 := by + rw [← parallelNetwork.contraction_toExplicit (Equiv.refl _) (Equiv.refl _)] + decide + +/-- Subdividing both edges by equality tensors gives a bipartite network with the same +contraction and degree bound. -/ +example : parallelNetwork.subdivide.contraction = 70 ∧ parallelNetwork.subdivide.IsBipartite ∧ + parallelNetwork.subdivide.MaxDegreeLE 2 := by + refine ⟨?_, parallelNetwork.isBipartite_subdivide, + parallelNetwork.maxDegreeLE_subdivide (fun e => by simp [parallelNetwork]) (fun v => ?_) + le_rfl⟩ + · rw [TensorNetwork.contraction_subdivide, + ← parallelNetwork.contraction_toExplicit (Equiv.refl _) (Equiv.refl _)] + decide + · exact (Set.ncard_le_card _).trans (by simp) + +/-! ### Constraint networks -/ + +/-- Two vertices joined by two parallel edges, each requiring its two edges to agree. -/ +def agree : Network Bool Empty (Fin 2) (Fin 2) where + src _ := 0 + tgt _ := 1 + site := Empty.elim + Constraint _ _ α := α 0 = α 1 + constraint_congr v _ _ α β _ h hα := by + have h' : ∀ e, α e = β e := fun e => h e (by fin_cases v <;> simp) + rw [← h' 0, ← h' 1] + exact hα + +/-- The indicator tensor network of `agree` counts its two satisfying assignments. -/ +example : (agree.toTensorNetwork ℕ Empty.elim).contraction = 2 := by + rw [Network.contraction_toTensorNetwork, Nat.cast_id] + have hsat : {α | agree.Satisfies Empty.elim α} = {fun _ => false, fun _ => true} := by + ext α + simp only [Network.Satisfies, agree, Set.mem_ofPred_eq, forall_const, Set.mem_insert_iff, + Set.mem_singleton_iff, funext_iff, Fin.forall_fin_two] + cases α 0 <;> cases α 1 <;> simp + rw [hsat, Set.ncard_pair (fun h => Bool.false_ne_true (congrFun h 0))] + +end ComplexityTests.Computability.Circuit.Frontier.TensorNetwork From da93e6d6579ef4ba3ffca28fed5d8a91fff0018e Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 17:41:53 -0400 Subject: [PATCH 02/19] feat(time): accepting choice-string counts for NTIME and BPTIME (#1833 H1) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Define the accepting count of a closed fair-coin table, the number of choice strings of a given length on which it emits [true], and relate it to the existing semantics: the probability of output [true] is the count divided by 2^τ; a nondeterministic decider's choice table has a positive count exactly on members; a bounded-error decider has a strict-majority count exactly on members, at every τ at least the clock. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 2 + .../Complexity/Classes/Time/AcceptCount.lean | 137 +++++++++++++++ .../MultiTape/Probabilistic/AcceptCount.lean | 103 +++++++++++ ComplexityTests/HPVChoiceCount.lean | 161 ++++++++++++++++++ 4 files changed, 403 insertions(+) create mode 100644 Complexity/Computability/Complexity/Classes/Time/AcceptCount.lean create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/AcceptCount.lean create mode 100644 ComplexityTests/HPVChoiceCount.lean diff --git a/Complexity.lean b/Complexity.lean index 3942e2e28b..ce92f5d3ef 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -1177,6 +1177,7 @@ public import Complexity.Computability.Complexity.Classes.TFNP.Subclasses public import Complexity.Computability.Complexity.Classes.TFNP.Subclasses.Completeness public import Complexity.Computability.Complexity.Classes.TFNP.Subclasses.Principles public import Complexity.Computability.Complexity.Classes.Time +public import Complexity.Computability.Complexity.Classes.Time.AcceptCount public import Complexity.Computability.Complexity.Classes.Time.Polynomial public import Complexity.Computability.Complexity.Classes.Toda public import Complexity.Computability.Complexity.Classes.Toda.Counting @@ -1795,6 +1796,7 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.WhileC public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.WhileInput public import Complexity.Computability.Machines.Turing.MultiTape.PolyTime public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.AcceptCount public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Clock public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Closed public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.CoinTape diff --git a/Complexity/Computability/Complexity/Classes/Time/AcceptCount.lean b/Complexity/Computability/Complexity/Classes/Time/AcceptCount.lean new file mode 100644 index 0000000000..47496225e5 --- /dev/null +++ b/Complexity/Computability/Complexity/Classes/Time/AcceptCount.lean @@ -0,0 +1,137 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Complexity.Classes.Time +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.AcceptCount + +/-! +# Time classes through accepting choice strings + +Problems in `NTIME` and `BPTIME` are decided by comparing the accepting count of a fixed +binary-choice machine (`Turing.MultiTapePTM.acceptCount`) with a threshold, at every number `τ` +of choice bits at least a linear function of the time bound. This is the normal form used by +counting simulations of nondeterministic and probabilistic time, which compute the accepting +count exactly. + +* A nondeterministic decider is replayed by its choice table `Turing.MultiTapeNTM.choiceTable`, + which encodes each choice in binary and rejects at a stuck configuration: an instance is a + member exactly when the accepting count is positive + (`Turing.MultiTapeNTM.DecidesInTime.mem_iff_acceptCount_choiceTable_pos`). +* A bounded-error fair-coin decider accepts a member with probability at least `2 / 3` and a + nonmember with probability at most `1 / 3`, so an instance is a member exactly when more than + half of the choice strings accept + (`Turing.MultiTapePTM.DecidesWithBoundedErrorInTime.mem_iff_two_pow_lt_two_mul_acceptCount`). + +Both hold for every `τ` at least the clock: a halted table ignores further bits. + +## Main results + +* `Turing.MultiTapeNTM.DecidesInTime.mem_iff_acceptCount_choiceTable_pos`: nondeterministic + acceptance is a positive accepting count. +* `Turing.MultiTapePTM.DecidesWithBoundedErrorInTime.mem_iff_two_pow_lt_two_mul_acceptCount`: + bounded-error acceptance is a strict-majority accepting count. +* `Cslib.Complexity.exists_acceptCount_of_mem_NTIME`, + `Cslib.Complexity.exists_acceptCount_of_mem_BPTIME`: the class-level normal forms. +-/ + +public section + +namespace Turing.MultiTapeNTM + +variable {k : ℕ} {State : Type} [Finite State] {α : Type} {enc : α ↪ List Bool} + +/-- **Nondeterministic acceptance is a positive accepting count.** If `ntm` decides `A` within +`t`, then `a ∈ A` exactly when some choice string of length `τ` makes the choice table accept, +for every `τ` of at least `M * t a`, where `M` is the number of actions. -/ +theorem DecidesInTime.mem_iff_acceptCount_choiceTable_pos {ntm : MultiTapeNTM k Bool State} + {A : Set α} {t : α → ℕ} (h : ntm.DecidesInTime enc A t) {a : α} {τ : ℕ} + (hτ : Nat.card (Turing.Action k Bool State) * t a ≤ τ) : + a ∈ A ↔ 0 < ntm.choiceTable.acceptCount (enc a) τ := by + rw [h.mem_iff_exists_checkChoices hτ, MultiTapePTM.acceptCount_pos_iff] + simp only [checkChoices, decide_eq_true_eq] + +end Turing.MultiTapeNTM + +namespace Turing.MultiTapePTM + +open Cslib +open scoped ENNReal + +variable {k : ℕ} {State : Type} {α : Type} {enc : α ↪ List Bool} + +/-- A probability of at least `2 / 3` is more than one half. -/ +private theorem inv_two_lt_of_two_div_three_le {p : ℝ≥0∞} (h : 2 / 3 ≤ p) : 2⁻¹ < p := by + refine lt_of_lt_of_le ?_ h + rw [ENNReal.lt_div_iff_mul_lt (by simp) (by simp), ← ENNReal.div_eq_inv_mul, + ENNReal.div_lt_iff (by simp) (by simp)] + norm_num + +/-- Two distinct outcomes have total probability at most one. -/ +private theorem apply_add_apply_le_one {β : Type} (P : PMF β) {b b' : β} (hb : b ≠ b') : + P b + P b' ≤ 1 := by + classical + rw [← Finset.sum_pair hb, ← P.tsum_coe] + exact sum_le_tsum _ + +/-- **Bounded-error acceptance is a strict-majority accepting count.** If `machine` decides `A` +with bounded error within `t`, then `a ∈ A` exactly when more than half of the choice strings of +length `τ` accept, for every `τ` of at least `t a`. -/ +theorem DecidesWithBoundedErrorInTime.mem_iff_two_pow_lt_two_mul_acceptCount + {machine : MultiTapePTM k Bool State} {A : Set α} {t : α → ℕ} + (h : machine.DecidesWithBoundedErrorInTime enc A t) {a : α} {τ : ℕ} (hτ : t a ≤ τ) : + a ∈ A ↔ 2 ^ τ < 2 * machine.acceptCount (enc a) τ := by + obtain ⟨hhalt, hprob⟩ := h a + rw [← machine.eval_runClosed_eq_of_halted (enc a) hτ hhalt] at hprob + rw [← half_lt_eval_runClosed_apply_iff] + by_cases ha : a ∈ A + · simp only [MultiTapeTM.indicator, ha] at hprob + exact iff_of_true ha (inv_two_lt_of_two_div_three_le hprob) + · simp only [MultiTapeTM.indicator, ha] at hprob + refine iff_of_false ha fun htrue => ?_ + have hsum := apply_add_apply_le_one (ProbComp.eval (machine.runClosed τ (enc a))) + (b := [true]) (b' := [false]) (by simp) + exact absurd ((ENNReal.inv_two_add_inv_two.symm.trans_lt + (ENNReal.add_lt_add htrue (inv_two_lt_of_two_div_three_le hprob))).trans_le hsum) + (lt_irrefl 1) + +end Turing.MultiTapePTM + +namespace Cslib.Complexity + +open _root_.Turing + +variable {α : Type} {enc : α ↪ List Bool} {A : Set α} {t : ℕ → ℕ} + +/-- **Nondeterministic time as accepting counts.** A problem in `NTIME enc t` is decided by a +fixed binary-choice machine with a binary alphabet and finitely many states: for constants `c₁` +and `c₂`, an instance is a member exactly when its accepting count on `τ` choice bits is +positive, for every `τ ≥ c₁ * t n + c₂` on instances of encoded length `n`. -/ +theorem exists_acceptCount_of_mem_NTIME (h : A ∈ NTIME enc t) : + ∃ (k : ℕ) (State : Type) (_ : Finite State) (machine : MultiTapePTM k Bool State) (c₁ c₂ : ℕ), + ∀ a τ, c₁ * t (enc a).length + c₂ ≤ τ → (a ∈ A ↔ 0 < machine.acceptCount (enc a) τ) := by + obtain ⟨c₁, c₂, k, State, hfinite, ntm, hntm⟩ := h + set M := Nat.card (Turing.Action k Bool State) + refine ⟨k, _, inferInstance, ntm.choiceTable, M * c₁, M * c₂, fun a τ hτ => + hntm.mem_iff_acceptCount_choiceTable_pos ?_⟩ + rw [Nat.mul_add, ← Nat.mul_assoc] + exact hτ + +/-- **Bounded-error probabilistic time as accepting counts.** A problem in `BPTIME enc t` is +decided by a fixed fair-coin machine with a binary alphabet and finitely many states: for +constants `c₁` and `c₂`, an instance is a member exactly when more than half of its choice +strings of length `τ` accept, for every `τ ≥ c₁ * t n + c₂` on instances of encoded length `n`. -/ +theorem exists_acceptCount_of_mem_BPTIME (h : A ∈ BPTIME enc t) : + ∃ (k : ℕ) (State : Type) (_ : Finite State) (machine : MultiTapePTM k Bool State) (c₁ c₂ : ℕ), + ∀ a τ, c₁ * t (enc a).length + c₂ ≤ τ → + (a ∈ A ↔ 2 ^ τ < 2 * machine.acceptCount (enc a) τ) := by + obtain ⟨c₁, c₂, k, State, hfinite, machine, hmachine⟩ := h + exact ⟨k, State, hfinite, machine, c₁, c₂, fun a τ hτ => + hmachine.mem_iff_two_pow_lt_two_mul_acceptCount hτ⟩ + +end Cslib.Complexity diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/AcceptCount.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/AcceptCount.lean new file mode 100644 index 0000000000..1f0692c761 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/AcceptCount.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Machine.Nondeterministic +import Mathlib.Data.Fintype.Pi + +/-! +# Accepting choice strings of a fair-coin table + +A closed fair-coin table `Turing.MultiTapePTM k Bool State` is the binary-choice normal form of a +machine: a run is a deterministic replay of a list of choice bits, one bit per live step. When +both branches of an instruction agree, its bit is ignored, and a halted configuration ignores all +further bits (`Turing.MultiTapePTM.stepCoins`). So every run on `τ` bits is padded to exactly `τ` +steps. A nondeterministic machine with finitely many states and a binary alphabet is put in this +form by its choice table `Turing.MultiTapeNTM.choiceTable`, which encodes each choice in binary and +rejects at a stuck configuration. + +The *accepting count* `Turing.MultiTapePTM.acceptCount machine input τ` is the number of bit +strings `y ∈ {0,1}^τ` on which the table emits `[true]` on `input`: the count `A_M(x)` of the +counting simulations of nondeterministic and probabilistic time. Its fraction of all `2 ^ τ` +strings is exactly the probability that the closed fair-coin run outputs `[true]` +(`Turing.MultiTapePTM.eval_runClosed_apply_eq_acceptCount`). The membership characterizations +for nondeterministic and bounded-error deciders are in +`Complexity.Computability.Complexity.Classes.Time.AcceptCount`. + +## Main definitions + +* `Turing.MultiTapePTM.acceptCount`: the number of accepting choice strings of a given length. + +## Main results + +* `Turing.MultiTapePTM.eval_runClosed_apply_eq_acceptCount`: the probability of output `[true]` + is the accepting count divided by `2 ^ τ`. +* `Turing.MultiTapePTM.half_lt_eval_runClosed_apply_iff`: strict majority acceptance, as an + integer comparison `2 ^ τ < 2 * acceptCount`. +* `Turing.MultiTapePTM.acceptCount_pos_iff`: some choice string accepts. +* `Turing.MultiTapePTM.acceptCount_le_two_pow`: at most all `2 ^ τ` strings accept. +* `Turing.MultiTapePTM.runClosedCoins_eq_output_stepCoins`: the replay on upstream + configurations. +-/ + +public section + +namespace Turing.MultiTapePTM + +open Cslib Cslib.Probability +open scoped ENNReal + +variable {k : ℕ} {State : Type} (machine : MultiTapePTM k Bool State) (input : List Bool) + (τ : ℕ) + +/-- **The accepting count** `A_M(x)`: the number of choice strings `y ∈ {0,1}^τ` replaying +which the closed fair-coin table emits `[true]` on `input`. -/ +def acceptCount : ℕ := + (Finset.univ.filter fun y : Fin τ → Bool => + machine.runClosedCoins (List.ofFn y) input = [true]).card + +/-- At most all `2 ^ τ` choice strings accept. -/ +theorem acceptCount_le_two_pow : machine.acceptCount input τ ≤ 2 ^ τ := + (Finset.card_filter_le _ _).trans (by simp) + +/-- The accepting count is positive exactly when some choice string of length `τ` accepts. -/ +theorem acceptCount_pos_iff : + 0 < machine.acceptCount input τ ↔ + ∃ coins : List Bool, coins.length = τ ∧ machine.runClosedCoins coins input = [true] := by + rw [acceptCount, Finset.card_pos, Finset.filter_nonempty_iff] + constructor + · rintro ⟨y, -, hy⟩ + exact ⟨List.ofFn y, List.length_ofFn, hy⟩ + · rintro ⟨coins, rfl, hcoins⟩ + exact ⟨fun i => coins[i.val], Finset.mem_univ _, by rwa [List.ofFn_getElem]⟩ + +/-- **Acceptance probability is the accepting fraction.** The closed fair-coin run with clock +`τ` outputs `[true]` with probability `acceptCount / 2 ^ τ`. -/ +theorem eval_runClosed_apply_eq_acceptCount : + ProbComp.eval (machine.runClosed τ input) [true] = + (machine.acceptCount input τ : ℝ≥0∞) / 2 ^ τ := by + rw [eval_runClosed_eq_map_coins, BitString.uniformList_map_apply] + rfl + +/-- **Strict majority acceptance** is the integer comparison `2 ^ τ < 2 * acceptCount`. -/ +theorem half_lt_eval_runClosed_apply_iff : + 2⁻¹ < ProbComp.eval (machine.runClosed τ input) [true] ↔ + 2 ^ τ < 2 * machine.acceptCount input τ := by + rw [eval_runClosed_apply_eq_acceptCount, ENNReal.lt_div_iff_mul_lt (by simp) (by simp), + ← ENNReal.div_eq_inv_mul, ENNReal.div_lt_iff (by simp) (by simp), mul_comm] + exact_mod_cast Iff.rfl + +/-- The replay on the configurations of the shared interpreter is the replay on upstream +configurations, by deterministic steps under each coin. -/ +theorem runClosedCoins_eq_output_stepCoins (coins : List Bool) : + machine.runClosedCoins coins input = + (machine.stepCoins coins (Cfg.init machine.initial input)).output := by + rw [runClosedCoins, tapes_runClosedConfigFromCoins] + rfl + +end Turing.MultiTapePTM diff --git a/ComplexityTests/HPVChoiceCount.lean b/ComplexityTests/HPVChoiceCount.lean new file mode 100644 index 0000000000..d76ffc8f3b --- /dev/null +++ b/ComplexityTests/HPVChoiceCount.lean @@ -0,0 +1,161 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +import Complexity.Computability.Complexity.Classes.Time.AcceptCount + +/-! Accepting choice strings of concrete fair-coin and nondeterministic machines. -/ + +namespace ComplexityTests.HPVChoiceCount + +open Cslib Turing +open scoped ENNReal + +/-- Emit the first coin and halt. -/ +private def emitCoin : MultiTapePTM 0 Bool Unit where + initial := () + tr _ _ _ _ bit := .step + { inputTape := 0, workTapes := Fin.elim0, output := some bit, state := none } + Empty.elim Empty.elim + +-- No step is taken without a choice bit: nothing is accepted. +example : emitCoin.acceptCount [] 0 = 0 := by decide + +-- After the first step the machine has halted, and the remaining bits are ignored. +example : emitCoin.acceptCount [] 1 = 1 := by decide +example : emitCoin.acceptCount [true, false] 3 = 4 := by decide + +-- The accepted fraction is the probability of output `[true]`. +example : ProbComp.eval (emitCoin.runClosed 3 [true, false]) [true] = 4 / 8 := by + rw [MultiTapePTM.eval_runClosed_apply_eq_acceptCount, + show emitCoin.acceptCount [true, false] 3 = 4 by decide] + norm_num + +-- Exactly half accept: this is not a strict majority. +example : ¬ 2⁻¹ < ProbComp.eval (emitCoin.runClosed 3 []) [true] := by + rw [MultiTapePTM.half_lt_eval_runClosed_apply_iff, + show emitCoin.acceptCount [] 3 = 4 by decide] + decide + +/-- Run two steps, each ignoring its coin, then emit `true` exactly when the input is +nonempty. -/ +private def readInput : MultiTapePTM 0 Bool (Fin 2) where + initial := 0 + tr state symbol _ _ _ := .step + (if state = 0 then { inputTape := 0, workTapes := Fin.elim0, output := none, state := some 1 } + else { inputTape := 0, workTapes := Fin.elim0, output := some symbol.isSome, state := none }) + Empty.elim Empty.elim + +-- Ignored bits still count: every string accepts, or none does. +example : readInput.acceptCount [false] 3 = 8 := by decide +example : readInput.acceptCount [] 3 = 0 := by decide +-- Before the decision step, no string accepts. +example : readInput.acceptCount [false] 1 = 0 := by decide + +/-! ### A bounded-error decider and the strict-majority criterion -/ + +/-- Emit `true` exactly when the first input symbol is `true`, ignoring the coin. -/ +private def echo : MultiTapePTM 0 Bool Unit where + initial := () + tr _ symbol _ _ _ := .step + { inputTape := 0, workTapes := Fin.elim0, output := some (symbol == some true), state := none } + Empty.elim Empty.elim + +/-- `echo` decides `{true}` (encoded as one-symbol words) with no error within one step. -/ +private theorem echo_decides : + echo.DecidesWithBoundedErrorInTime MultiTapeTM.encBool {b | b = true} fun _ => 1 := by + intro a + refine ⟨fun final hfinal => ?_, ?_⟩ + · rw [MultiTapePTM.eval_runClosedConfigFrom_eq_map_coins, PMF.mem_support_map_iff] at hfinal + obtain ⟨coins, hcoins, rfl⟩ := hfinal + obtain ⟨c, rfl⟩ := List.length_eq_one_iff.mp + (BitString.mem_support_uniformList_iff.mp hcoins) + cases a <;> cases c <;> rfl + · rw [MultiTapePTM.eval_runClosed_eq_map_coins, BitString.uniformList_map_apply] + cases a + · rw [show MultiTapeTM.indicator {b : Bool | b = true} false = false by + simp [MultiTapeTM.indicator]] + rw [show (Finset.univ.filter fun r : Fin 1 → Bool => + echo.runClosedCoins (List.ofFn r) (MultiTapeTM.encBool false) = [false]).card = 2 by + decide] + norm_num [ENNReal.div_self] + exact ENNReal.div_le_of_le_mul (by norm_num) + · rw [show MultiTapeTM.indicator {b : Bool | b = true} true = true by + simp [MultiTapeTM.indicator]] + rw [show (Finset.univ.filter fun r : Fin 1 → Bool => + echo.runClosedCoins (List.ofFn r) (MultiTapeTM.encBool true) = [true]).card = 2 by + decide] + norm_num [ENNReal.div_self] + exact ENNReal.div_le_of_le_mul (by norm_num) + +-- With more bits than the clock, a member is accepted by all `2 ^ 4` strings. +example : true ∈ {b : Bool | b = true} ↔ 2 ^ 4 < 2 * echo.acceptCount [true] 4 := + echo_decides.mem_iff_two_pow_lt_two_mul_acceptCount (a := true) (by norm_num) +example : echo.acceptCount [true] 4 = 16 ∧ echo.acceptCount [false] 4 = 0 := by decide + +/-! ### Nondeterministic deciders through their choice tables -/ + +/-- Halt with output `[b]`. -/ +private def emit (b : Bool) : Action 0 Bool Bool := + { inputTape := 0, workTapes := Fin.elim0, output := some b, state := none } + +/-- From its only running state, either accept or reject. -/ +private def guess : MultiTapeNTM 0 Bool Bool where + q₀ := false + Tr q _ _ action := q = false ∧ (action = emit true ∨ action = emit false) + +private theorem guess_decides : + guess.DecidesInTime (Function.Embedding.refl (List Bool)) Set.univ fun _ => 1 := by + intro a + refine ⟨MultiTapeNTM.runsInTime_one_of_forall_step_initCfg fun c hc => ?_, ?_⟩ + · simp only [MultiTapeNTM.Step, MultiTapeNTM.initCfg, Cfg.init] at hc + obtain ⟨action, ⟨-, rfl | rfl⟩, rfl⟩ := hc <;> rfl + · have hstep : guess.Step (guess.initCfg a) ((emit true).apply (guess.initCfg a)) := + ⟨emit true, ⟨rfl, .inl rfl⟩, rfl⟩ + exact iff_of_true trivial + ⟨⟨(RelSeries.singleton _ _).cons (guess.initCfg a) hstep, rfl⟩, rfl, rfl⟩ + +-- The accepting branch is encoded by some padded choice string, of every sufficient length. +example (x : List Bool) (τ : ℕ) (hτ : Nat.card (Action 0 Bool Bool) ≤ τ) : + 0 < guess.choiceTable.acceptCount x τ := + (guess_decides.mem_iff_acceptCount_choiceTable_pos (a := x) (by simpa using hτ)).mp trivial + +/-- A machine permitting no action: its initial configuration is stuck. -/ +private def stuck : MultiTapeNTM 0 Bool Bool where + q₀ := false + Tr _ _ _ _ := False + +private theorem stuck_decides : + stuck.DecidesInTime (Function.Embedding.refl (List Bool)) ∅ fun _ => 1 := by + intro a + have hrun : stuck.RunsInTime a 1 := + MultiTapeNTM.runsInTime_one_of_forall_step_initCfg fun _ hc => by + simp [MultiTapeNTM.Step, MultiTapeNTM.initCfg, Cfg.init, stuck] at hc + refine ⟨hrun, iff_of_false id fun hacc => ?_⟩ + obtain ⟨p, hp, -⟩ := (MultiTapeNTM.accepts_iff_exists_time_eq hrun).mp hacc + have h0 := p.toRunPath.step ⟨0, by + unfold MultiTapeNTM.ComputationPath.time MultiTapeNTM.RunPath.time at hp; omega⟩ + change stuck.Step (p.toRunPath 0) _ at h0 + rw [show p.toRunPath 0 = stuck.initCfg a from p.head_eq] at h0 + simp [MultiTapeNTM.Step, MultiTapeNTM.initCfg, Cfg.init, stuck] at h0 + +-- The choice table rejects at the stuck configuration: no choice string accepts. +example (x : List Bool) (τ : ℕ) (hτ : Nat.card (Action 0 Bool Bool) ≤ τ) : + stuck.choiceTable.acceptCount x τ = 0 := + Nat.eq_zero_of_not_pos fun h => + (stuck_decides.mem_iff_acceptCount_choiceTable_pos (a := x) (by simpa using hτ)).mpr h + +/-! ### Class-level normal forms -/ + +example : {b : Bool | b = true} ∈ Complexity.BPTIME MultiTapeTM.encBool fun _ => 1 := + ⟨1, 0, 0, Unit, inferInstance, echo, by simpa using echo_decides⟩ + +example (h : {b : Bool | b = true} ∈ Complexity.BPTIME MultiTapeTM.encBool fun _ => 1) : + ∃ (k : ℕ) (State : Type) (_ : Finite State) (machine : MultiTapePTM k Bool State) + (c₁ c₂ : ℕ), ∀ a τ, c₁ * 1 + c₂ ≤ τ → + (a ∈ {b : Bool | b = true} ↔ 2 ^ τ < 2 * machine.acceptCount (MultiTapeTM.encBool a) τ) := + Complexity.exists_acceptCount_of_mem_BPTIME h + +end ComplexityTests.HPVChoiceCount From 686b2301fd9328db5085827bbe5967e8764001c3 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 18:05:44 -0400 Subject: [PATCH 03/19] feat(machines): HPV time intervals, tape blocks and schedules of coin runs (#1833 H2) Run-level facts of the HPV block decomposition for choice-string runs: every head (input head included) moves at most one cell per bit, so within b bits it stays in the three blocks around its starting block; movement schedules in {-1,0,1}, their count 3^((k+1)q), and recovery of block indices from a schedule; locality: configurations agreeing on the three-block windows evolve identically there and emit the same output; and cells outside the windows of a range of intervals are untouched. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 2 + .../Machines/Turing/MultiTape/Locality.lean | 184 ++++++++++ .../MultiTape/Probabilistic/Blocks.lean | 330 ++++++++++++++++++ ComplexityTests/HPVBlocks.lean | 113 ++++++ references.bib | 11 + 5 files changed, 640 insertions(+) create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Locality.lean create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/Blocks.lean create mode 100644 ComplexityTests/HPVBlocks.lean diff --git a/Complexity.lean b/Complexity.lean index bd5e471f87..823e67fda0 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -1749,6 +1749,7 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Internal.Resour public import Complexity.Computability.Machines.Turing.MultiTape.Internal.StepMachineCompiler public import Complexity.Computability.Machines.Turing.MultiTape.Internal.UnaryMachines public import Complexity.Computability.Machines.Turing.MultiTape.Internal.WordPredicates +public import Complexity.Computability.Machines.Turing.MultiTape.Locality public import Complexity.Computability.Machines.Turing.MultiTape.Machine public import Complexity.Computability.Machines.Turing.MultiTape.Machine.ChoiceTable public import Complexity.Computability.Machines.Turing.MultiTape.Machine.Clock @@ -1796,6 +1797,7 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.WhileC public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.WhileInput public import Complexity.Computability.Machines.Turing.MultiTape.PolyTime public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Blocks public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Clock public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Closed public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.CoinTape diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Locality.lean b/Complexity/Computability/Machines/Turing/MultiTape/Locality.lean new file mode 100644 index 0000000000..3cb609e61e --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Locality.lean @@ -0,0 +1,184 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Cslib.Computability.Machines.Turing.MultiTape.Deterministic +public import Cslib.Computability.Machines.Turing.MultiTape.TapeLemmas + +/-! +# Locality of a step + +A step of a multi-tape machine reads the cells under its heads, writes at most the cells under +its work heads, and moves every head by at most one cell. This file records these facts in the +form used to cut a computation into local pieces. + +The heads are indexed by `Option (Fin k)`: `none` is the read-only input head and `some i` the +head of work tape `i`. `Turing.Cfg.headPos` places them in coordinates where every head starts at +zero; the input head's stored position `inputPos` is shifted by one, so its coordinate ranges over +`[-1, n]` on an input of length `n`. The write-only output tape is never read and has no head +here. + +Two configurations *agree on* a family `W` of work-tape cells (`Turing.Cfg.AgreeOn`) when they have +the same control state and head positions and the same work-tape contents on `W`. If the work +heads lie in `W`, a step reads the same symbols in both, takes the same action, and preserves +agreement on `W`; both append the same symbol, if any, to their outputs +(`Turing.MultiTapeTM.agreeOn_step`). Contents outside `W` and earlier outputs may differ. + +## Main definitions + +* `Turing.Cfg.headPos`: head positions, starting at zero. +* `Turing.Cfg.AgreeOn`: same control and heads, and same work-tape contents on given cells. + +## Main results + +* `Turing.MultiTapeNTM.Step.abs_headPos_sub_le`: a step moves every head by at most one cell. +* `Turing.MultiTapeTM.agreeOn_step`: agreement on cells containing the work heads is preserved + by a step, which emits the same output in both configurations. +-/ + +public section + +namespace Turing + +variable {k : ℕ} {Symbol State : Type*} {input : List Symbol} + +/-- The position of a head, in coordinates where every head starts at zero: the input head +(`none`) at its stored position shifted by one, and the head of work tape `i` (`some i`). -/ +@[expose] def Cfg.headPos (cfg : Cfg k Symbol State input) : Option (Fin k) → ℤ + | none => (cfg.inputPos.val : ℤ) - 1 + | some i => cfg.workTapePos i + +@[simp] theorem Cfg.headPos_none (cfg : Cfg k Symbol State input) : + cfg.headPos none = (cfg.inputPos.val : ℤ) - 1 := rfl + +@[simp] theorem Cfg.headPos_some (cfg : Cfg k Symbol State input) (i : Fin k) : + cfg.headPos (some i) = cfg.workTapePos i := rfl + +/-- Every head starts at zero. -/ +theorem Cfg.headPos_init (q₀ : State) (head : Option (Fin k)) : + (Cfg.init q₀ input : Cfg k Symbol State input).headPos head = 0 := by + cases head with + | none => simp [Cfg.headPos] + | some i => rfl + +/-- The input head is at a coordinate in `[-1, n]` on an input of length `n`. -/ +theorem Cfg.headPos_none_mem_Icc (cfg : Cfg k Symbol State input) : + cfg.headPos none ∈ Set.Icc (-1) (input.length : ℤ) := by + have := cfg.inputPos.isLt + simp only [headPos_none, Set.mem_Icc] + omega + +/-- An action moves every head by at most one cell. -/ +theorem Action.abs_headPos_apply_sub_le (action : Action k Symbol State) + (cfg : Cfg k Symbol State input) (head : Option (Fin k)) : + |(action.apply cfg).headPos head - cfg.headPos head| ≤ 1 := by + cases head with + | none => + have hmove := val_moveInputPos_eq cfg.inputPos action.inputTape + have hlt := cfg.inputPos.isLt + have hcast : (action.inputTape.cast : ℤ) = -1 ∨ (action.inputTape.cast : ℤ) = 0 ∨ + (action.inputTape.cast : ℤ) = 1 := by + rcases action.inputTape with _ | _ | _ <;> simp [SignType.cast] + simp only [Cfg.headPos_none, Action.apply_inputPos, abs_le] + omega + | some i => exact workTapePos_apply_le action cfg i + +/-- **A step moves every head by at most one cell.** -/ +theorem MultiTapeNTM.Step.abs_headPos_sub_le {ntm : MultiTapeNTM k Symbol State} + {c c' : Cfg k Symbol State input} (h : ntm.Step c c') (head : Option (Fin k)) : + |c'.headPos head - c.headPos head| ≤ 1 := by + unfold MultiTapeNTM.Step at h + split at h + · simp [h] + · obtain ⟨action, -, rfl⟩ := h + exact action.abs_headPos_apply_sub_le c head + +/-- Two configurations agree on the work-tape cells `W`: they have the same control state, the +same input and work head positions, and the same work-tape contents on `W`. Their outputs and +their contents outside `W` are unconstrained. -/ +structure Cfg.AgreeOn (W : Fin k → Set ℤ) (c c' : Cfg k Symbol State input) : Prop where + /-- The same control state. -/ + state_eq : c.state = c'.state + /-- The same input head position. -/ + inputPos_eq : c.inputPos = c'.inputPos + /-- The same work head positions. -/ + workTapePos_eq : c.workTapePos = c'.workTapePos + /-- The same work-tape contents on `W`. -/ + workTapes_eq : ∀ i, ∀ z ∈ W i, c.workTapes i z = c'.workTapes i z + +/-- A configuration agrees with itself on every family of cells. -/ +theorem Cfg.AgreeOn.refl (W : Fin k → Set ℤ) (c : Cfg k Symbol State input) : c.AgreeOn W c := + ⟨rfl, rfl, rfl, fun _ _ _ => rfl⟩ + +theorem Cfg.AgreeOn.symm {W : Fin k → Set ℤ} {c c' : Cfg k Symbol State input} + (h : c.AgreeOn W c') : c'.AgreeOn W c := + ⟨h.state_eq.symm, h.inputPos_eq.symm, h.workTapePos_eq.symm, + fun i z hz => (h.workTapes_eq i z hz).symm⟩ + +theorem Cfg.AgreeOn.trans {W : Fin k → Set ℤ} {c c' c'' : Cfg k Symbol State input} + (h : c.AgreeOn W c') (h' : c'.AgreeOn W c'') : c.AgreeOn W c'' := + ⟨h.state_eq.trans h'.state_eq, h.inputPos_eq.trans h'.inputPos_eq, + h.workTapePos_eq.trans h'.workTapePos_eq, + fun i z hz => (h.workTapes_eq i z hz).trans (h'.workTapes_eq i z hz)⟩ + +/-- Agreement on more cells is agreement on fewer. -/ +theorem Cfg.AgreeOn.mono {W W' : Fin k → Set ℤ} {c c' : Cfg k Symbol State input} + (h : c.AgreeOn W c') (hW : ∀ i, W' i ⊆ W i) : c.AgreeOn W' c' := + ⟨h.state_eq, h.inputPos_eq, h.workTapePos_eq, fun i z hz => h.workTapes_eq i z (hW i hz)⟩ + +/-- Agreeing configurations are at the same head positions. -/ +theorem Cfg.AgreeOn.headPos_eq {W : Fin k → Set ℤ} {c c' : Cfg k Symbol State input} + (h : c.AgreeOn W c') : c.headPos = c'.headPos := by + funext head + cases head with + | none => simp [h.inputPos_eq] + | some i => simp [h.workTapePos_eq] + +/-- Agreement on cells containing the work heads gives the same read symbols. -/ +theorem Cfg.AgreeOn.workTapeSymbols_eq {W : Fin k → Set ℤ} {c c' : Cfg k Symbol State input} + (h : c.AgreeOn W c') (hpos : ∀ i, c.workTapePos i ∈ W i) : + c.workTapeSymbols = c'.workTapeSymbols := by + funext i + simp only [Cfg.workTapeSymbols, ← h.workTapePos_eq] + exact h.workTapes_eq i _ (hpos i) + +/-- One action applied to agreeing configurations keeps them agreeing on `W`: it writes the same +symbols under the same heads. -/ +theorem Cfg.AgreeOn.apply {W : Fin k → Set ℤ} {c c' : Cfg k Symbol State input} + (h : c.AgreeOn W c') (action : Action k Symbol State) : + (action.apply c).AgreeOn W (action.apply c') := by + refine ⟨rfl, by simp [h.inputPos_eq], by funext i; simp [h.workTapePos_eq], fun i z hz => ?_⟩ + simp only [Action.apply_workTapes, ← h.workTapePos_eq] + cases (action.workTapes i).1 with + | none => exact h.workTapes_eq i z hz + | some s => + by_cases hz' : z = c.workTapePos i + · simp [hz'] + · simp only [Function.update_of_ne hz'] + exact h.workTapes_eq i z hz + +/-- **Locality of a step.** If two configurations agree on cells `W` containing their work +heads, one step keeps them agreeing on `W`, and both append the same word to their outputs. -/ +theorem MultiTapeTM.agreeOn_step (tm : MultiTapeTM k Symbol State) {W : Fin k → Set ℤ} + {c c' : Cfg k Symbol State input} (h : c.AgreeOn W c') (hpos : ∀ i, c.workTapePos i ∈ W i) : + (tm.step c).AgreeOn W (tm.step c') ∧ + ∃ e, (tm.step c).output = c.output ++ e ∧ (tm.step c').output = c'.output ++ e := by + cases hs : c.state with + | none => + have hs' : c'.state = none := h.state_eq ▸ hs + rw [MultiTapeTM.step_of_halt hs, MultiTapeTM.step_of_halt hs'] + exact ⟨h, [], by simp, by simp⟩ + | some q => + have hs' : c'.state = some q := h.state_eq ▸ hs + have hread : c.inputSymbol = c'.inputSymbol := by + simp only [Cfg.inputSymbol, h.inputPos_eq] + rw [MultiTapeTM.step_of_state hs, MultiTapeTM.step_of_state hs', hread, + h.workTapeSymbols_eq hpos] + exact ⟨h.apply _, _, Action.apply_output _ _, Action.apply_output _ _⟩ + +end Turing diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/Blocks.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/Blocks.lean new file mode 100644 index 0000000000..5a41b6e994 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/Blocks.lean @@ -0,0 +1,330 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Locality +public import Complexity.Computability.Machines.Turing.MultiTape.Machine.Nondeterministic +public import Mathlib.Data.Fintype.Option +public import Mathlib.Data.Fintype.Pi +public import Mathlib.Basic.Sign.Defs +import Mathlib.Algebra.Order.BigOperators.Group.Finset +import Mathlib.Basic.Sign.Basic +import Mathlib.Tactic.Linarith + +/-! +# Time intervals and tape blocks of a choice-string run + +The blocking idea of Hopcroft, Paul and Valiant [HopcroftPaulValiant1977], in the form of +Lemma 2.1 of the note *Deterministic simulations of nondeterministic and randomized time* +(30 October 2026) formalized in issue #1833. It uses three neighbouring tape blocks instead of +making the machine block-respecting (compare [Williams2025], Lemma 2.1 and §3.2). The +statements here are the run-level facts of that lemma, for the replay +`Turing.MultiTapePTM.stepCoins` of a fair-coin table on a list of choice bits. + +Time is cut into intervals of `b` steps: interval `i` starts at +`Turing.MultiTapePTM.intervalStart b coins c i`, after the first `i * b` bits. Each tape is cut +into blocks `B_j = [b j, b (j + 1))`, so a head at coordinate `p` (`Turing.Cfg.headPos`) is in +block `p / b` at offset `p % b`. The blocked heads are the input head and the `k` work heads; +the write-only output tape is never read and is not blocked. + +* **Three blocks.** Within `b` steps a head moves at most `b` cells, so it stays in the blocks + `B_{j-1}, B_j, B_{j+1}` around its starting block `B_j` + (`Turing.MultiTapePTM.headPos_stepCoins_mem_Ico`), and its block index changes by at most one + (`Turing.MultiTapePTM.abs_blockIndex_stepCoins_sub_le`). +* **Schedules.** The *movement schedule* of a run (`Turing.MultiTapePTM.schedule`) records this + change in `{-1, 0, 1}` for every interval and head. There are `3 ^ ((k + 1) * q)` schedules of + `q` intervals (`Turing.MultiTapePTM.card_schedule`), every run has exactly one, and it + determines all block indices from the starting ones + (`Turing.MultiTapePTM.blockIndex_intervalStart`). +* **Locality.** An interval only reads and writes the window `Turing.Cfg.blockWindow` of three + blocks around each work head. Two configurations agreeing on their control, heads and window + contents still agree after `b` steps on the same bits, and emit the same output + (`Turing.MultiTapePTM.agreeOn_blockWindow_stepCoins`). So the interval is determined by its + bits, its entering state and head positions and the contents of its windows. Cells outside the + window are unchanged (`Turing.MultiTapePTM.workTapes_stepCoins_eq_of_notMem_blockWindow`), and + a cell lying outside the windows of a range of intervals is untouched throughout that range + (`Turing.MultiTapePTM.workTapes_intervalStart_eq_of_notMem_blockWindow`). + +All statements hold for every block length `b > 0` and number `q` of intervals; the choice +`q = ⌈t / b⌉` and the bound `2 ≤ b ≤ t` of the note only matter for counting. + +## Main definitions + +* `Turing.Cfg.blockWindow`: the three blocks around each work head. +* `Turing.MultiTapePTM.intervalStart`: the configuration at the start of a time interval. +* `Turing.MultiTapePTM.Schedule`, `Turing.MultiTapePTM.schedule`: movement schedules. + +## Main results + +* `Turing.MultiTapePTM.abs_headPos_stepCoins_sub_le`: a head moves at most one cell per bit. +* `Turing.MultiTapePTM.headPos_stepCoins_mem_Ico`: within `b` steps, three blocks. +* `Turing.MultiTapePTM.abs_blockIndex_stepCoins_sub_le`: block indices change by at most one. +* `Turing.MultiTapePTM.card_schedule`: there are `3 ^ ((k + 1) * q)` schedules. +* `Turing.MultiTapePTM.coe_schedule`: a schedule entry is the change of block index. +* `Turing.MultiTapePTM.blockIndex_intervalStart`: schedules determine block indices. +* `Turing.MultiTapePTM.agreeOn_stepCoins`: locality of a run on cells containing its heads. +* `Turing.MultiTapePTM.agreeOn_blockWindow_stepCoins`: an interval is determined by its window. +* `Turing.MultiTapePTM.workTapes_stepCoins_eq_of_notMem_blockWindow`: cells outside the window + are unchanged. +* `Turing.MultiTapePTM.workTapes_intervalStart_eq_of_notMem_blockWindow`: blocks outside the + windows of a range of intervals are untouched. + +## References + +* [J. Hopcroft, W. Paul, L. Valiant, *On Time Versus Space*][HopcroftPaulValiant1977] +* [R. Williams, *Simulating Time With Square-Root Space*][Williams2025] +-/ + +public section + +namespace Turing + +variable {k : ℕ} {Symbol State : Type} {input : List Symbol} + +/-! ### Block arithmetic -/ + +/-- Within distance `b` of a point of block `p / b`, the three blocks around it. -/ +private theorem mem_Ico_of_abs_sub_le {b p p' : ℤ} (hb : 0 < b) (h : |p' - p| ≤ b) : + b * (p / b - 1) ≤ p' ∧ p' < b * (p / b + 2) := by + have hdiv := Int.mul_ediv_add_emod p b + have hlo := Int.emod_nonneg p hb.ne' + have hhi := Int.emod_lt_of_pos p hb + have := abs_le.mp h + constructor <;> nlinarith + +/-- Within distance `b`, block indices differ by at most one. -/ +private theorem abs_ediv_sub_ediv_le_one {b p p' : ℤ} (hb : 0 < b) (h : |p' - p| ≤ b) : + |p' / b - p / b| ≤ 1 := by + obtain ⟨hlo, hhi⟩ := mem_Ico_of_abs_sub_le hb h + have hdiv := Int.mul_ediv_add_emod p' b + have hlo' := Int.emod_nonneg p' hb.ne' + have hhi' := Int.emod_lt_of_pos p' hb + have h₁ : p' / b < p / b + 2 := lt_of_mul_lt_mul_left (by linarith) hb.le + have h₂ : p / b - 1 < p' / b + 1 := lt_of_mul_lt_mul_left (by linarith) hb.le + rw [abs_le] + constructor <;> omega + +/-- The three blocks of length `b` around the block of each work head: the cells a work head can +visit within `b` steps. -/ +@[expose] def Cfg.blockWindow (b : ℕ) (c : Cfg k Symbol State input) (i : Fin k) : Set ℤ := + Set.Ico (b * (c.workTapePos i / b - 1)) (b * (c.workTapePos i / b + 2)) + +namespace MultiTapePTM + +variable (machine : MultiTapePTM k Symbol State) + +/-! ### Head movement -/ + +/-- A replayed bit is a step of the table with that coin fixed. -/ +private theorem step_withCoin (bit : Bool) (c : Cfg k Symbol State input) : + (machine.withCoin bit).toTM.Step c ((machine.withCoin bit).toTM.step c) := + MultiTapeTM.step_iff.mpr rfl + +/-- A head moves at most one cell per replayed bit. -/ +theorem abs_headPos_stepCoins_sub_le (coins : List Bool) (c : Cfg k Symbol State input) + (head : Option (Fin k)) : + |(machine.stepCoins coins c).headPos head - c.headPos head| ≤ coins.length := by + induction coins generalizing c with + | nil => simp + | cons bit coins ih => + rw [stepCoins_cons] + have h₁ := abs_le.mp (ih ((machine.withCoin bit).toTM.step c)) + have h₂ := abs_le.mp ((machine.step_withCoin bit c).abs_headPos_sub_le head) + rw [abs_le, List.length_cons] + push_cast + constructor <;> linarith + +/-- **Three blocks.** Within `b` replayed bits, a head stays in the three blocks of length `b` +around its starting block. -/ +theorem headPos_stepCoins_mem_Ico {b : ℕ} (hb : 0 < b) {coins : List Bool} + (hlen : coins.length ≤ b) (c : Cfg k Symbol State input) (head : Option (Fin k)) : + (machine.stepCoins coins c).headPos head ∈ + Set.Ico ((b : ℤ) * (c.headPos head / b - 1)) (b * (c.headPos head / b + 2)) := + mem_Ico_of_abs_sub_le (by exact_mod_cast hb) + ((machine.abs_headPos_stepCoins_sub_le coins c head).trans (by exact_mod_cast hlen)) + +/-- Within `b` replayed bits, the block index of a head changes by at most one. -/ +theorem abs_blockIndex_stepCoins_sub_le {b : ℕ} (hb : 0 < b) {coins : List Bool} + (hlen : coins.length ≤ b) (c : Cfg k Symbol State input) (head : Option (Fin k)) : + |(machine.stepCoins coins c).headPos head / b - c.headPos head / b| ≤ 1 := + abs_ediv_sub_ediv_le_one (by exact_mod_cast hb) + ((machine.abs_headPos_stepCoins_sub_le coins c head).trans (by exact_mod_cast hlen)) + +/-- A work-tape cell farther from the head than the number of replayed bits is unchanged. -/ +theorem workTapes_stepCoins_eq_of_lt_abs (coins : List Bool) (c : Cfg k Symbol State input) + {i : Fin k} {z : ℤ} (hz : (coins.length : ℤ) < |z - c.workTapePos i|) : + (machine.stepCoins coins c).workTapes i z = c.workTapes i z := by + induction coins generalizing c with + | nil => rfl + | cons bit coins ih => + have hstep := machine.step_withCoin bit c + have hmove := abs_le.mp (hstep.abs_headPos_sub_le (some i)) + simp only [Cfg.headPos_some] at hmove + simp only [List.length_cons, Nat.cast_add, Nat.cast_one] at hz + rw [stepCoins_cons, ih _ ?_] + · refine hstep.workTapes_eq_of_ne fun hzpos => ?_ + rw [hzpos, sub_self, abs_zero] at hz + omega + · rw [lt_abs] at hz ⊢ + omega + +/-- **Locality of a run.** If two configurations agree on cells `W`, and the work heads of the +first stay in `W` before each replayed bit, then after replaying the same bits they still agree +on `W` and have appended the same word to their outputs. -/ +theorem agreeOn_stepCoins {W : Fin k → Set ℤ} {c c' : Cfg k Symbol State input} + (h : c.AgreeOn W c') (coins : List Bool) + (hpos : ∀ j < coins.length, ∀ i, (machine.stepCoins (coins.take j) c).workTapePos i ∈ W i) : + (machine.stepCoins coins c).AgreeOn W (machine.stepCoins coins c') ∧ + ∃ e, (machine.stepCoins coins c).output = c.output ++ e ∧ + (machine.stepCoins coins c').output = c'.output ++ e := by + induction coins generalizing c c' with + | nil => exact ⟨h, [], by simp, by simp⟩ + | cons bit coins ih => + obtain ⟨hstep, e, he, he'⟩ := + MultiTapeTM.agreeOn_step (machine.withCoin bit).toTM h (hpos 0 (by simp)) + obtain ⟨hrest, e', hrest₁, hrest₂⟩ := ih hstep fun j hj => by + simpa only [List.take_succ_cons, stepCoins_cons] using + hpos (j + 1) (by simpa only [List.length_cons, Nat.add_lt_add_iff_right] using hj) + refine ⟨hrest, e ++ e', ?_, ?_⟩ + · rw [stepCoins_cons, hrest₁, he, List.append_assoc] + · rw [stepCoins_cons, hrest₂, he', List.append_assoc] + +/-- **An interval is determined by its window.** Two configurations agreeing on the three blocks +around each work head of the first still agree there after at most `b` replayed bits, and have +appended the same word to their outputs. -/ +theorem agreeOn_blockWindow_stepCoins {b : ℕ} (hb : 0 < b) {coins : List Bool} + (hlen : coins.length ≤ b) {c c' : Cfg k Symbol State input} + (h : c.AgreeOn (c.blockWindow b) c') : + (machine.stepCoins coins c).AgreeOn (c.blockWindow b) (machine.stepCoins coins c') ∧ + ∃ e, (machine.stepCoins coins c).output = c.output ++ e ∧ + (machine.stepCoins coins c').output = c'.output ++ e := + machine.agreeOn_stepCoins h coins fun j _ i => + machine.headPos_stepCoins_mem_Ico hb (coins := coins.take j) + ((List.length_take_le' j coins).trans hlen) c (some i) + +/-- Within `b` replayed bits, a work-tape cell outside the three blocks around its head is +unchanged. -/ +theorem workTapes_stepCoins_eq_of_notMem_blockWindow {b : ℕ} (hb : 0 < b) {coins : List Bool} + (hlen : coins.length ≤ b) (c : Cfg k Symbol State input) {i : Fin k} {z : ℤ} + (hz : z ∉ c.blockWindow b i) : + (machine.stepCoins coins c).workTapes i z = c.workTapes i z := by + refine machine.workTapes_stepCoins_eq_of_lt_abs coins c ?_ + have hb' : (0 : ℤ) < b := by exact_mod_cast hb + have hdiv := Int.mul_ediv_add_emod (c.workTapePos i) b + have hlo := Int.emod_nonneg (c.workTapePos i) hb'.ne' + have hhi := Int.emod_lt_of_pos (c.workTapePos i) hb' + have hlen' : (coins.length : ℤ) ≤ b := by exact_mod_cast hlen + simp only [Cfg.blockWindow, Set.mem_Ico, not_and_or, not_le, not_lt] at hz + rw [lt_abs] + rcases hz with hz | hz + · right + nlinarith + · left + nlinarith + +/-! ### Time intervals and schedules -/ + +/-- The configuration at the start of time interval `i`, of `b` steps each: replay the first +`i * b` bits. -/ +@[expose] noncomputable def intervalStart (b : ℕ) (coins : List Bool) (c : Cfg k Symbol State input) + (i : ℕ) : Cfg k Symbol State input := + machine.stepCoins (coins.take (i * b)) c + +@[simp] theorem intervalStart_zero (b : ℕ) (coins : List Bool) (c : Cfg k Symbol State input) : + machine.intervalStart b coins c 0 = c := by + simp [intervalStart] + +/-- Interval `i + 1` starts after replaying the `b` bits of interval `i`. -/ +theorem intervalStart_succ (b : ℕ) (coins : List Bool) (c : Cfg k Symbol State input) (i : ℕ) : + machine.intervalStart b coins c (i + 1) = + machine.stepCoins ((coins.drop (i * b)).take b) (machine.intervalStart b coins c i) := by + rw [intervalStart, intervalStart, ← stepCoins_append, Nat.succ_mul, List.take_add] + +/-- The bits of an interval number at most `b`. -/ +theorem length_intervalCoins_le (b : ℕ) (coins : List Bool) (i : ℕ) : + ((coins.drop (i * b)).take b).length ≤ b := + List.length_take_le _ _ + +/-- A movement schedule of `q` intervals: the change, in `{-1, 0, 1}`, of the block index of +the input head (`none`) and of each work head (`some i`) across each interval. -/ +abbrev Schedule (k q : ℕ) := Fin q → Option (Fin k) → SignType + +/-- There are `3 ^ ((k + 1) * q)` movement schedules of `q` intervals. -/ +theorem card_schedule (k q : ℕ) : Fintype.card (Schedule k q) = 3 ^ ((k + 1) * q) := by + simp only [Fintype.card_fun, Fintype.card_option, Fintype.card_fin] + rw [show Fintype.card SignType = 3 from rfl, ← pow_mul, mul_comm] + +/-- The movement schedule of the run replaying `coins` from `c`, in `q` intervals of `b` bits: +the change of the block index of every head across every interval. -/ +noncomputable def schedule (b q : ℕ) (coins : List Bool) (c : Cfg k Symbol State input) : + Schedule k q := fun i head => + SignType.sign ((machine.intervalStart b coins c (i + 1)).headPos head / b - + (machine.intervalStart b coins c i).headPos head / b) + +/-- An integer of absolute value at most one is its own sign. -/ +private theorem coe_sign_eq_self {d : ℤ} (hd : |d| ≤ 1) : + ((SignType.sign d : SignType) : ℤ) = d := by + have : d = -1 ∨ d = 0 ∨ d = 1 := by rw [abs_le] at hd; omega + rcases this with rfl | rfl | rfl <;> rfl + +/-- A schedule entry is the change of block index across the interval. -/ +theorem coe_schedule {b : ℕ} (hb : 0 < b) (q : ℕ) (coins : List Bool) + (c : Cfg k Symbol State input) (i : Fin q) (head : Option (Fin k)) : + (machine.schedule b q coins c i head : ℤ) = + (machine.intervalStart b coins c (i + 1)).headPos head / b - + (machine.intervalStart b coins c i).headPos head / b := by + refine coe_sign_eq_self ?_ + rw [intervalStart_succ] + exact machine.abs_blockIndex_stepCoins_sub_le hb (length_intervalCoins_le _ _ _) _ head + +/-- **Schedules determine block indices.** At the start of interval `i ≤ q`, the block index of a +head is its starting block index plus the schedule entries of the earlier intervals. -/ +theorem blockIndex_intervalStart {b : ℕ} (hb : 0 < b) {q : ℕ} (coins : List Bool) + (c : Cfg k Symbol State input) (head : Option (Fin k)) {i : ℕ} (hi : i ≤ q) : + (machine.intervalStart b coins c i).headPos head / b = + c.headPos head / b + + ∑ j : Fin i, (machine.schedule b q coins c (Fin.castLE hi j) head : ℤ) := by + induction i with + | zero => simp + | succ i ih => + have hsum : ∑ j : Fin i, (machine.schedule b q coins c (Fin.castLE hi j.castSucc) head : ℤ) = + ∑ j : Fin i, (machine.schedule b q coins c (Fin.castLE (by omega) j) head : ℤ) := rfl + rw [Fin.sum_univ_castSucc, hsum, ← add_assoc, ← ih (by omega)] + have := machine.coe_schedule hb q coins c ⟨i, by omega⟩ head + simp only at this + change _ = _ + (machine.schedule b q coins c ⟨i, by omega⟩ head : ℤ) + rw [this] + ring + +/-- Across interval `i`, a work-tape cell outside the window of interval `i` is unchanged. -/ +theorem workTapes_intervalStart_succ_eq {b : ℕ} (hb : 0 < b) (coins : List Bool) + (c : Cfg k Symbol State input) (i : ℕ) {h : Fin k} {z : ℤ} + (hz : z ∉ (machine.intervalStart b coins c i).blockWindow b h) : + (machine.intervalStart b coins c (i + 1)).workTapes h z = + (machine.intervalStart b coins c i).workTapes h z := by + rw [intervalStart_succ] + exact machine.workTapes_stepCoins_eq_of_notMem_blockWindow hb + (length_intervalCoins_le _ _ _) _ hz + +/-- **Untouched blocks.** A work-tape cell outside the windows of intervals `i₁, …, i₂ - 1` has +the same contents at the start of interval `i₂` as at the start of interval `i₁`. -/ +theorem workTapes_intervalStart_eq_of_notMem_blockWindow {b : ℕ} (hb : 0 < b) + (coins : List Bool) (c : Cfg k Symbol State input) {h : Fin k} {z : ℤ} {i₁ i₂ : ℕ} + (hle : i₁ ≤ i₂) + (hz : ∀ i, i₁ ≤ i → i < i₂ → z ∉ (machine.intervalStart b coins c i).blockWindow b h) : + (machine.intervalStart b coins c i₂).workTapes h z = + (machine.intervalStart b coins c i₁).workTapes h z := by + induction i₂, hle using Nat.le_induction with + | base => rfl + | succ i₂ hle ih => + rw [machine.workTapes_intervalStart_succ_eq hb coins c i₂ (hz i₂ hle (by omega)), + ih fun i hi hi₂ => hz i hi (by omega)] + +end MultiTapePTM + +end Turing diff --git a/ComplexityTests/HPVBlocks.lean b/ComplexityTests/HPVBlocks.lean new file mode 100644 index 0000000000..8b8e0aa4a7 --- /dev/null +++ b/ComplexityTests/HPVBlocks.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Blocks + +/-! Time intervals, tape blocks and schedules of a concrete choice-string run. -/ + +namespace ComplexityTests.HPVBlocks + +open Turing MultiTapeMachine + +/-- On one work tape, write the coin and move right on `true`, left on `false`. The input head +moves right on `true` too. -/ +private def zigzag : MultiTapePTM 1 Bool Unit where + initial := () + tr _ _ _ _ bit := .step + { inputTape := if bit then 1 else 0, + workTapes := fun _ => (some (some bit), if bit then 1 else -1), + output := none, state := some () } + Empty.elim Empty.elim + +/-- Replays on upstream configurations, evaluated through the computable interpreter. -/ +private theorem stepCoins_eq (coins : List Bool) (cfg : Cfg 1 Bool Unit [true, false]) : + zigzag.stepCoins coins cfg = + (zigzag.runClosedConfigFromCoins coins { tapes := cfg }).tapes := + (MultiTapePTM.tapes_runClosedConfigFromCoins zigzag coins { tapes := cfg }).symm + +private def start : Cfg 1 Bool Unit [true, false] := Cfg.init () [true, false] + +private def coins : List Bool := [true, true, true, false, true, true] + +-- The work head visits 0, 1, 2, 3, 2, 3, 4; the input head is clamped at the right boundary. +example : ((zigzag.stepCoins coins start).headPos (some 0), + (zigzag.stepCoins coins start).headPos none) = (4, 2) := by + rw [stepCoins_eq] + rfl + +-- With blocks of length 2, the work head starts intervals 0, 1, 2, 3 in blocks 0, 1, 1, 2. +example : (List.range 4).map + (fun i => (zigzag.intervalStart 2 coins start i).headPos (some 0) / 2) = [0, 1, 1, 2] := by + simp only [List.range_succ, List.range_zero, List.nil_append, MultiTapePTM.intervalStart, + stepCoins_eq] + rfl + +-- So the schedule of the work head is `(1, 0, 1)`; the input head moves right then stays. +example : (List.ofFn fun i : Fin 3 => (zigzag.schedule 2 3 coins start i (some 0) : ℤ)) = + [1, 0, 1] ∧ + (List.ofFn fun i : Fin 3 => (zigzag.schedule 2 3 coins start i none : ℤ)) = [1, 0, 0] := by + simp only [List.ofFn_succ, List.ofFn_zero, MultiTapePTM.coe_schedule zigzag two_pos, + MultiTapePTM.intervalStart, stepCoins_eq] + constructor <;> rfl + +-- The block index at the end is recovered from the schedule. +example : (zigzag.intervalStart 2 coins start 3).headPos (some 0) / (2 : ℕ) = 2 := by + rw [zigzag.blockIndex_intervalStart two_pos coins start (some 0) le_rfl, Fin.sum_univ_three] + simp only [MultiTapePTM.coe_schedule zigzag two_pos, MultiTapePTM.intervalStart, stepCoins_eq] + rfl + +-- There are `3 ^ 6` schedules of three intervals for the input head and one work head. +example : Fintype.card (MultiTapePTM.Schedule 1 3) = 729 := by + rw [MultiTapePTM.card_schedule] + norm_num + +/-! ### Three blocks -/ + +/-- After one bit the work head is at offset `1` of block `0`, with blocks of length `2`. -/ +private theorem headPos_one : (zigzag.stepCoins [true] start).headPos (some 0) = 1 := by + rw [stepCoins_eq] + rfl + +-- Within two more bits it stays in blocks `-1, 0, 1`: here it reaches block `1`. +example : (zigzag.stepCoins [true, true] (zigzag.stepCoins [true] start)).headPos (some 0) = 3 ∧ + (3 : ℤ) ∈ Set.Ico (2 * (1 / 2 - 1)) (2 * (1 / 2 + 2)) := by + refine ⟨?_, by decide⟩ + rw [← MultiTapePTM.stepCoins_append, stepCoins_eq] + rfl + +-- The bound needs at most `b` bits: three bits leave the three blocks. +example : (zigzag.stepCoins [true, true, true] (zigzag.stepCoins [true] start)).headPos (some 0) ∉ + Set.Ico (2 * ((zigzag.stepCoins [true] start).headPos (some 0) / 2 - 1)) + (2 * ((zigzag.stepCoins [true] start).headPos (some 0) / 2 + 2)) := by + rw [headPos_one, ← MultiTapePTM.stepCoins_append, stepCoins_eq] + decide + +/-! ### Locality -/ + +/-- The start configuration with a written cell outside its window `[-2, 4)`. -/ +private def marked : Cfg 1 Bool Unit [true, false] := + { start with workTapes := fun _ z => if z = 5 then some false else none } + +private theorem agreeOn_marked : start.AgreeOn (start.blockWindow 2) marked := + ⟨rfl, rfl, rfl, fun _ z hz => by + simp only [Cfg.blockWindow, start, Cfg.init, Set.mem_Ico] at hz + simp [marked, start, show z ≠ 5 by omega]⟩ + +-- A window cell written by the run from `start` is written the same way from `marked`. +example : (zigzag.stepCoins [true, false] marked).workTapes 0 1 = some false := by + have hstart : (zigzag.stepCoins [true, false] start).workTapes 0 1 = some false := by + rw [stepCoins_eq] + rfl + rw [← hstart] + exact ((zigzag.agreeOn_blockWindow_stepCoins two_pos (by simp) agreeOn_marked).1.workTapes_eq + 0 1 (by simp [Cfg.blockWindow, start])).symm + +-- The cell outside the window keeps its mark. +example : (zigzag.stepCoins [true, false] marked).workTapes 0 5 = some false := + zigzag.workTapes_stepCoins_eq_of_notMem_blockWindow two_pos (by simp) marked + (by simp [Cfg.blockWindow, marked, start]) + +end ComplexityTests.HPVBlocks diff --git a/references.bib b/references.bib index e41912a56b..8d4525226f 100644 --- a/references.bib +++ b/references.bib @@ -2288,6 +2288,17 @@ @book{ Hopcroft2006 address = {USA} } +@article{HopcroftPaulValiant1977, + author = {Hopcroft, John and Paul, Wolfgang and Valiant, Leslie}, + title = {On Time Versus Space}, + journal = {Journal of the ACM}, + volume = {24}, + number = {2}, + pages = {332--337}, + year = {1977}, + doi = {10.1145/322003.322015} +} + @techreport{Hoza2022, author = {Hoza, William M.}, title = {Recent Progress on Derandomizing Space-Bounded Computation}, From b7576bcda7f3f2574939699dbf8735d15944e60f Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 18:11:24 -0400 Subject: [PATCH 04/19] refactor(complexity): share the generic accepted-string count with machines Move `Cslib.Complexity.acceptCount` and its elementary lemmas unchanged from `Classes/SharpP.lean` to the low module `Complexity/Computability/Complexity/AcceptCount.lean`, which SharpP re-exports. Define `Turing.MultiTapePTM.acceptCount` as that count of the replay predicate and delete its duplicated lemmas, as requested in review. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 1 + .../Computability/Complexity/AcceptCount.lean | 119 ++++++++++++++++++ .../Complexity/Classes/SharpP.lean | 84 +------------ .../Complexity/Classes/Time/AcceptCount.lean | 4 +- .../MultiTape/Probabilistic/AcceptCount.lean | 32 ++--- 5 files changed, 134 insertions(+), 106 deletions(-) create mode 100644 Complexity/Computability/Complexity/AcceptCount.lean diff --git a/Complexity.lean b/Complexity.lean index ce92f5d3ef..f6e56784bc 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -984,6 +984,7 @@ public import Complexity.Computability.Communication.TopDown.Adversary public import Complexity.Computability.Communication.TopDown.Majority public import Complexity.Computability.Communication.TopDown.Parity public import Complexity.Computability.Communication.TopDown.Rectangle +public import Complexity.Computability.Complexity.AcceptCount public import Complexity.Computability.Complexity.AffineDisperser public import Complexity.Computability.Complexity.AffineDisperser.BinaryPolynomial public import Complexity.Computability.Complexity.AffineDisperser.Coordinates diff --git a/Complexity/Computability/Complexity/AcceptCount.lean b/Complexity/Computability/Complexity/AcceptCount.lean new file mode 100644 index 0000000000..c14ce50bbb --- /dev/null +++ b/Complexity/Computability/Complexity/AcceptCount.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Init +public import Mathlib.Algebra.BigOperators.Group.Finset.Basic +public import Mathlib.Data.Fintype.Pi +import Complexity.Foundations.Data.BitString.WordCount + +/-! +# Counting accepted strings + +`Cslib.Complexity.acceptCount V a n` is the number of strings `w` of length `n` with +`V (a, w) = true`, for any Boolean predicate `V : α × List Bool → Bool`. No efficiency of `V` is +assumed. It counts the certificates of a verifier in the counting classes +(`Cslib.Complexity.SharpP`), the random strings accepted by a bounded-error or majority verifier, +and the choice strings accepted by a fair-coin machine (`Turing.MultiTapePTM.acceptCount`). + +## Main definitions + +* `Cslib.Complexity.acceptCount`: the number of accepted strings of a given length. + +## Main results + +* `Cslib.Complexity.acceptCount_le_two_pow`, `Cslib.Complexity.acceptCount_pos_iff`: the range + and support of the count. +* `Cslib.Complexity.acceptCount_add`: counting accepted strings by their prefixes. +* `Cslib.Complexity.acceptCount_zero`, `Cslib.Complexity.acceptCount_add_acceptCount_not`, + `Cslib.Complexity.acceptCount_not`: counts of trivial and negated verifiers. +-/ + +@[expose] public section + +namespace Cslib.Complexity + +variable {α : Type} + +/-- The number of strings `w` of length `n` with `V (a, w) = true`. -/ +def acceptCount (V : α × List Bool → Bool) (a : α) (n : ℕ) : ℕ := + (Finset.univ.filter fun w : Fin n → Bool => V (a, List.ofFn w) = true).card + +section acceptCount + +variable {V : α × List Bool → Bool} {a : α} {n : ℕ} + +/-- At most all `2 ^ n` strings are accepted. -/ +theorem acceptCount_le_two_pow : acceptCount V a n ≤ 2 ^ n := + (Finset.card_filter_le _ _).trans (by simp) + +/-- Some string of length `n` is accepted exactly when the count is positive. -/ +theorem acceptCount_pos_iff : + 0 < acceptCount V a n ↔ ∃ w : List Bool, w.length = n ∧ V (a, w) = true := by + rw [acceptCount, Finset.card_pos, Finset.filter_nonempty_iff] + constructor + · rintro ⟨w, -, hw⟩ + exact ⟨List.ofFn w, List.length_ofFn, hw⟩ + · rintro ⟨w, rfl, hw⟩ + exact ⟨fun i => w[i.val], Finset.mem_univ _, by rwa [List.ofFn_getElem]⟩ + +/-- The strings that `V` accepts together with `a` and those it rejects are all the strings. -/ +theorem acceptCount_add_card_filter_eq_false : + acceptCount V a n + + (Finset.univ.filter fun w : Fin n → Bool => V (a, List.ofFn w) = false).card = 2 ^ n := by + have := Finset.card_filter_add_card_filter_not (s := Finset.univ) + fun w : Fin n → Bool => V (a, List.ofFn w) = true + simpa only [acceptCount, Bool.not_eq_true, Finset.card_univ, Fintype.card_fun, Fintype.card_bool, + Fintype.card_fin] using this + +/-- **Counting strings by their prefixes**: the strings of length `m + n` accepted by `V` are the +strings `u ++ w`, with `u` of length `m` and `w` of length `n` accepted with the prefix `u`. -/ +theorem acceptCount_add (V : α × List Bool → Bool) (a : α) (m n : ℕ) : + acceptCount V a (m + n) = + ∑ u : Fin m → Bool, acceptCount (fun x => V (x.1, List.ofFn u ++ x.2)) a n := by + have h := BitString.card_filter_ofFn_add m n fun u w => V (a, u ++ w) = true + simp only [List.take_append_drop] at h + exact h + +/-- Verifiers that agree on an instance accept the same strings with it. -/ +theorem acceptCount_congr {W : α × List Bool → Bool} (h : ∀ w, V (a, w) = W (a, w)) (n : ℕ) : + acceptCount V a n = acceptCount W a n := by + simp only [acceptCount, h] + +/-- With no bits there is one string, the empty one. -/ +theorem acceptCount_zero (V : α × List Bool → Bool) (a : α) : + acceptCount V a 0 = if V (a, []) = true then 1 else 0 := by + unfold acceptCount + rw [Finset.univ_unique, Finset.filter_singleton] + split_ifs with h₁ h₂ h₂ <;> simp_all + +/-- The verifier accepting everything accepts all `2 ^ n` strings of length `n`. -/ +@[simp] +theorem acceptCount_true (a : α) (n : ℕ) : acceptCount (fun _ => true) a n = 2 ^ n := by + simp [acceptCount] + +/-- The verifier rejecting everything accepts no string. -/ +@[simp] +theorem acceptCount_false (a : α) (n : ℕ) : acceptCount (fun _ => false) a n = 0 := by + simp [acceptCount] + +/-- A verifier and its negation together accept every string once. -/ +theorem acceptCount_add_acceptCount_not (V : α × List Bool → Bool) (a : α) (n : ℕ) : + acceptCount V a n + acceptCount (fun x => !V x) a n = 2 ^ n := by + simpa only [acceptCount, Bool.not_eq_true'] using + acceptCount_add_card_filter_eq_false (V := V) (a := a) (n := n) + +/-- The negation of a verifier accepts the strings that it rejects. -/ +theorem acceptCount_not (V : α × List Bool → Bool) (a : α) (n : ℕ) : + acceptCount (fun x => !V x) a n = 2 ^ n - acceptCount V a n := by + have := acceptCount_add_acceptCount_not V a n + omega + +end acceptCount + +end Cslib.Complexity diff --git a/Complexity/Computability/Complexity/Classes/SharpP.lean b/Complexity/Computability/Complexity/Classes/SharpP.lean index c61dce990f..a8141bc0e6 100644 --- a/Complexity/Computability/Complexity/Classes/SharpP.lean +++ b/Complexity/Computability/Complexity/Classes/SharpP.lean @@ -7,12 +7,12 @@ Authors: Samuel Schlesinger module -- upstream: candidate +public import Complexity.Computability.Complexity.AcceptCount public import Complexity.Computability.Complexity.Classes.NP public import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.Plain public import Mathlib.Algebra.BigOperators.Group.Finset.Basic public import Mathlib.Algebra.Order.Group.Int public import Mathlib.Data.Fintype.Pi -import Complexity.Foundations.Data.BitString.WordCount /-! # The counting classes #P and GapP @@ -21,7 +21,8 @@ import Complexity.Foundations.Data.BitString.WordCount [Valiant][Valiant1979], [Arora and Barak, Chapter 17][AroraBarak09]: `f ∈ SharpP enc` when there are a polynomial `p` and a function `V : α × List Bool → Bool`, computable in polynomial time on inputs `encPair enc encBits (a, w) = frame (enc a) ++ w`, such that `f a` is the number of strings -`w` of length `p (enc a).length` with `V (a, w) = true`. The problems in `NP` are exactly the sets +`w` of length `p (enc a).length` with `V (a, w) = true`, the count `Cslib.Complexity.acceptCount` +of `Complexity.Computability.Complexity.AcceptCount`. The problems in `NP` are exactly the sets where functions in `#P` are nonzero (`mem_NP_iff_exists_SharpP`). `GapP` consists of the differences of two functions in `#P`. Fenner, Fortnow and Kurtz define it @@ -36,16 +37,11 @@ signed routing and the corresponding bidirectional `GapP` characterization. ## Main definitions -* `Cslib.Complexity.acceptCount`: the number of strings of a given length that a verifier accepts - together with an instance. * `Cslib.Complexity.SharpP`, `Cslib.Complexity.GapP`. ## Main results * `Cslib.Complexity.mem_NP_iff_exists_SharpP`: `NP` consists of the supports of functions in `#P`. -* `Cslib.Complexity.acceptCount_add`: counting accepted strings by their prefixes. -* `Cslib.Complexity.acceptCount_zero`, `Cslib.Complexity.acceptCount_add_acceptCount_not`, - `Cslib.Complexity.acceptCount_not`: counts of trivial and negated verifiers. * `Cslib.Complexity.SharpP.exists_le_two_pow`: functions in `#P` are at most exponential. * `Cslib.Complexity.GapP.exists_abs_le_two_pow`: every `GapP` function is bounded in absolute value by `2 ^ p(|x|)` for a polynomial `p`. @@ -66,80 +62,6 @@ open Turing.MultiTapeTM variable {α : Type} -/-- The number of strings `w` of length `n` with `V (a, w) = true`. -/ -def acceptCount (V : α × List Bool → Bool) (a : α) (n : ℕ) : ℕ := - (Finset.univ.filter fun w : Fin n → Bool => V (a, List.ofFn w) = true).card - -section acceptCount - -variable {V : α × List Bool → Bool} {a : α} {n : ℕ} - -theorem acceptCount_le_two_pow : acceptCount V a n ≤ 2 ^ n := - (Finset.card_filter_le _ _).trans (by simp) - -theorem acceptCount_pos_iff : - 0 < acceptCount V a n ↔ ∃ w : List Bool, w.length = n ∧ V (a, w) = true := by - rw [acceptCount, Finset.card_pos, Finset.filter_nonempty_iff] - constructor - · rintro ⟨w, -, hw⟩ - exact ⟨List.ofFn w, List.length_ofFn, hw⟩ - · rintro ⟨w, rfl, hw⟩ - exact ⟨fun i => w[i.val], Finset.mem_univ _, by rwa [List.ofFn_getElem]⟩ - -/-- The strings that `V` accepts together with `a` and those it rejects are all the strings. -/ -theorem acceptCount_add_card_filter_eq_false : - acceptCount V a n + - (Finset.univ.filter fun w : Fin n → Bool => V (a, List.ofFn w) = false).card = 2 ^ n := by - have := Finset.card_filter_add_card_filter_not (s := Finset.univ) - fun w : Fin n → Bool => V (a, List.ofFn w) = true - simpa only [acceptCount, Bool.not_eq_true, Finset.card_univ, Fintype.card_fun, Fintype.card_bool, - Fintype.card_fin] using this - -/-- **Counting strings by their prefixes**: the strings of length `m + n` accepted by `V` are the -strings `u ++ w`, with `u` of length `m` and `w` of length `n` accepted with the prefix `u`. -/ -theorem acceptCount_add (V : α × List Bool → Bool) (a : α) (m n : ℕ) : - acceptCount V a (m + n) = - ∑ u : Fin m → Bool, acceptCount (fun x => V (x.1, List.ofFn u ++ x.2)) a n := by - have h := BitString.card_filter_ofFn_add m n fun u w => V (a, u ++ w) = true - simp only [List.take_append_drop] at h - exact h - -/-- Verifiers that agree on an instance accept the same strings with it. -/ -theorem acceptCount_congr {W : α × List Bool → Bool} (h : ∀ w, V (a, w) = W (a, w)) (n : ℕ) : - acceptCount V a n = acceptCount W a n := by - simp only [acceptCount, h] - -/-- With no bits there is one string, the empty one. -/ -theorem acceptCount_zero (V : α × List Bool → Bool) (a : α) : - acceptCount V a 0 = if V (a, []) = true then 1 else 0 := by - unfold acceptCount - rw [Finset.univ_unique, Finset.filter_singleton] - split_ifs with h₁ h₂ h₂ <;> simp_all - -/-- The verifier accepting everything accepts all `2 ^ n` strings of length `n`. -/ -@[simp] -theorem acceptCount_true (a : α) (n : ℕ) : acceptCount (fun _ => true) a n = 2 ^ n := by - simp [acceptCount] - -/-- The verifier rejecting everything accepts no string. -/ -@[simp] -theorem acceptCount_false (a : α) (n : ℕ) : acceptCount (fun _ => false) a n = 0 := by - simp [acceptCount] - -/-- A verifier and its negation together accept every string once. -/ -theorem acceptCount_add_acceptCount_not (V : α × List Bool → Bool) (a : α) (n : ℕ) : - acceptCount V a n + acceptCount (fun x => !V x) a n = 2 ^ n := by - simpa only [acceptCount, Bool.not_eq_true'] using - acceptCount_add_card_filter_eq_false (V := V) (a := a) (n := n) - -/-- The negation of a verifier accepts the strings that it rejects. -/ -theorem acceptCount_not (V : α × List Bool → Bool) (a : α) (n : ℕ) : - acceptCount (fun x => !V x) a n = 2 ^ n - acceptCount V a n := by - have := acceptCount_add_acceptCount_not V a n - omega - -end acceptCount - /-- The functions counting the certificates that a polynomial-time verifier accepts, with certificates of polynomial length, with respect to the encoding `enc` of instances. -/ def SharpP (enc : α ↪ List Bool) : Set (α → ℕ) := diff --git a/Complexity/Computability/Complexity/Classes/Time/AcceptCount.lean b/Complexity/Computability/Complexity/Classes/Time/AcceptCount.lean index 47496225e5..714b56d7b4 100644 --- a/Complexity/Computability/Complexity/Classes/Time/AcceptCount.lean +++ b/Complexity/Computability/Complexity/Classes/Time/AcceptCount.lean @@ -53,8 +53,8 @@ theorem DecidesInTime.mem_iff_acceptCount_choiceTable_pos {ntm : MultiTapeNTM k {A : Set α} {t : α → ℕ} (h : ntm.DecidesInTime enc A t) {a : α} {τ : ℕ} (hτ : Nat.card (Turing.Action k Bool State) * t a ≤ τ) : a ∈ A ↔ 0 < ntm.choiceTable.acceptCount (enc a) τ := by - rw [h.mem_iff_exists_checkChoices hτ, MultiTapePTM.acceptCount_pos_iff] - simp only [checkChoices, decide_eq_true_eq] + rw [h.mem_iff_exists_checkChoices hτ, Cslib.Complexity.acceptCount_pos_iff] + rfl end Turing.MultiTapeNTM diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/AcceptCount.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/AcceptCount.lean index 1f0692c761..a81d09a827 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/AcceptCount.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/AcceptCount.lean @@ -7,8 +7,8 @@ Authors: Samuel Schlesinger module -- upstream: candidate +public import Complexity.Computability.Complexity.AcceptCount public import Complexity.Computability.Machines.Turing.MultiTape.Machine.Nondeterministic -import Mathlib.Data.Fintype.Pi /-! # Accepting choice strings of a fair-coin table @@ -23,7 +23,10 @@ rejects at a stuck configuration. The *accepting count* `Turing.MultiTapePTM.acceptCount machine input τ` is the number of bit strings `y ∈ {0,1}^τ` on which the table emits `[true]` on `input`: the count `A_M(x)` of the -counting simulations of nondeterministic and probabilistic time. Its fraction of all `2 ^ τ` +counting simulations of nondeterministic and probabilistic time. It is the generic count +`Cslib.Complexity.acceptCount` of the replay predicate, so the elementary lemmas about that count +(`Cslib.Complexity.acceptCount_le_two_pow`, `Cslib.Complexity.acceptCount_pos_iff`, …) apply +to it directly. Its fraction of all `2 ^ τ` strings is exactly the probability that the closed fair-coin run outputs `[true]` (`Turing.MultiTapePTM.eval_runClosed_apply_eq_acceptCount`). The membership characterizations for nondeterministic and bounded-error deciders are in @@ -39,8 +42,6 @@ for nondeterministic and bounded-error deciders are in is the accepting count divided by `2 ^ τ`. * `Turing.MultiTapePTM.half_lt_eval_runClosed_apply_iff`: strict majority acceptance, as an integer comparison `2 ^ τ < 2 * acceptCount`. -* `Turing.MultiTapePTM.acceptCount_pos_iff`: some choice string accepts. -* `Turing.MultiTapePTM.acceptCount_le_two_pow`: at most all `2 ^ τ` strings accept. * `Turing.MultiTapePTM.runClosedCoins_eq_output_stepCoins`: the replay on upstream configurations. -/ @@ -57,24 +58,9 @@ variable {k : ℕ} {State : Type} (machine : MultiTapePTM k Bool State) (input : /-- **The accepting count** `A_M(x)`: the number of choice strings `y ∈ {0,1}^τ` replaying which the closed fair-coin table emits `[true]` on `input`. -/ -def acceptCount : ℕ := - (Finset.univ.filter fun y : Fin τ → Bool => - machine.runClosedCoins (List.ofFn y) input = [true]).card - -/-- At most all `2 ^ τ` choice strings accept. -/ -theorem acceptCount_le_two_pow : machine.acceptCount input τ ≤ 2 ^ τ := - (Finset.card_filter_le _ _).trans (by simp) - -/-- The accepting count is positive exactly when some choice string of length `τ` accepts. -/ -theorem acceptCount_pos_iff : - 0 < machine.acceptCount input τ ↔ - ∃ coins : List Bool, coins.length = τ ∧ machine.runClosedCoins coins input = [true] := by - rw [acceptCount, Finset.card_pos, Finset.filter_nonempty_iff] - constructor - · rintro ⟨y, -, hy⟩ - exact ⟨List.ofFn y, List.length_ofFn, hy⟩ - · rintro ⟨coins, rfl, hcoins⟩ - exact ⟨fun i => coins[i.val], Finset.mem_univ _, by rwa [List.ofFn_getElem]⟩ +abbrev acceptCount : ℕ := + Complexity.acceptCount + (fun p : List Bool × List Bool => decide (machine.runClosedCoins p.2 p.1 = [true])) input τ /-- **Acceptance probability is the accepting fraction.** The closed fair-coin run with clock `τ` outputs `[true]` with probability `acceptCount / 2 ^ τ`. -/ @@ -82,7 +68,7 @@ theorem eval_runClosed_apply_eq_acceptCount : ProbComp.eval (machine.runClosed τ input) [true] = (machine.acceptCount input τ : ℝ≥0∞) / 2 ^ τ := by rw [eval_runClosed_eq_map_coins, BitString.uniformList_map_apply] - rfl + simp only [Complexity.acceptCount, decide_eq_true_eq] /-- **Strict majority acceptance** is the integer comparison `2 ^ τ < 2 * acceptCount`. -/ theorem half_lt_eval_runClosed_apply_iff : From b06c2112f2badd9381e157200e2880137e5a13db Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 18:19:33 -0400 Subject: [PATCH 05/19] refactor(circuit/frontier): index explicit tables by BitString.lsbValue Address the #1844 review: replace the duplicate public `tableIndex` encoding and its lemmas by the existing `Cslib.BitString.lsbValue` and `lsbValue_lt`. Add the missing digit lemma `BitString.testBit_lsbValue` next to `lsbValue` in `BitString/Counter.lean`, and update the table lookup, its proof and the tests. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../Frontier/TensorNetwork/Explicit.lean | 37 ++++++------------- .../Foundations/Data/BitString/Counter.lean | 11 ++++++ .../Circuit/Frontier/TensorNetwork.lean | 2 +- 3 files changed, 23 insertions(+), 27 deletions(-) diff --git a/Complexity/Computability/Circuit/Frontier/TensorNetwork/Explicit.lean b/Complexity/Computability/Circuit/Frontier/TensorNetwork/Explicit.lean index 28f5dd3f54..051a95b90a 100644 --- a/Complexity/Computability/Circuit/Frontier/TensorNetwork/Explicit.lean +++ b/Complexity/Computability/Circuit/Frontier/TensorNetwork/Explicit.lean @@ -8,6 +8,7 @@ module -- upstream: candidate public import Complexity.Computability.Circuit.Frontier.TensorNetwork +public import Complexity.Foundations.Data.BitString.Counter import Mathlib.Algebra.BigOperators.Fin import Mathlib.Data.List.GetD @@ -19,7 +20,8 @@ the number of edges, numbered `0, 1, …`, and a list of vertices, each given by * its ordered list of *ports*, the numbers of the edges at the vertex, and * its *table*: the value of its tensor when port `i` carries the bit `bs[i]` is the entry at - position `tableIndex bs`, the number whose binary digit `i` is `bs[i]`. + position `BitString.lsbValue bs`, the number whose binary digit `i` is `bs[i]` + (`BitString.testBit_lsbValue`). So a vertex with `k` ports has a table of `2 ^ k` entries. The contraction of an explicit network (`ExplicitTensorNetwork.contraction`) sums, over all assignments of bits to the edges, the product @@ -37,7 +39,6 @@ order and tabulate its tensor on them. The contraction is unchanged ## Main definitions -* `Cslib.Circuits.Frontier.tableIndex`: the position of a list of bits in a table. * `Cslib.Circuits.Frontier.ExplicitTensorNetwork`: an explicit Boolean tensor network. * `Cslib.Circuits.Frontier.ExplicitTensorNetwork.entry`, `Cslib.Circuits.Frontier.ExplicitTensorNetwork.portBits`: table lookup and the bits on a list @@ -51,8 +52,6 @@ order and tabulate its tensor on them. The contraction is unchanged ## Main results -* `Cslib.Circuits.Frontier.testBit_tableIndex`, `Cslib.Circuits.Frontier.tableIndex_lt`: the - digits and range of a table position. * `Cslib.Circuits.Frontier.ExplicitTensorNetwork.maxDegree_le_iff`: the degree bound. * `Cslib.Circuits.Frontier.TensorNetwork.entry_explicitTable`: a written-out table evaluates the tensor. @@ -68,24 +67,10 @@ order and tabulate its tensor on them. The contraction is unchanged namespace Cslib.Circuits.Frontier -/-- The position of a list of bits in a table: the number whose binary digit `i` is `bs[i]`, so -that the bits are read little-endian. -/ -def tableIndex (bs : List Bool) : ℕ := - (BitVec.ofBoolListLE bs).toNat - -/-- Binary digit `i` of the position of `bs` is `bs[i]`, or `false` past the end of `bs`. -/ -@[simp] theorem testBit_tableIndex (bs : List Bool) (i : ℕ) : - (tableIndex bs).testBit i = bs.getD i false := by - rw [tableIndex, BitVec.testBit_toNat, BitVec.getLsbD_ofBoolListLE] - -/-- A list of `k` bits has a position below `2 ^ k`. -/ -theorem tableIndex_lt (bs : List Bool) : tableIndex bs < 2 ^ bs.length := - BitVec.isLt _ - /-- An *explicit Boolean tensor network* over `R`: the number of edges, numbered from zero, and a list of vertices. A vertex is given by its ordered list of *ports*, the numbers of its edges, and -its *table*, whose entry at position `tableIndex bs` is the value of its tensor when port `i` -carries the bit `bs[i]`. -/ +its *table*, whose entry at position `BitString.lsbValue bs` is the value of its tensor when +port `i` carries the bit `bs[i]`. -/ structure ExplicitTensorNetwork (R : Type*) where /-- The number of edges; the edges are numbered `0, …, numEdges - 1`. -/ numEdges : ℕ @@ -96,10 +81,10 @@ namespace ExplicitTensorNetwork variable {R : Type*} (d : ExplicitTensorNetwork R) -/-- The entry of a table at a list of bits. A position past the end of the table has entry -zero. -/ +/-- The entry of a table at a list of bits, read little-endian (`BitString.lsbValue`). A position +past the end of the table has entry zero. -/ def entry [Zero R] (table : List R) (bs : List Bool) : R := - table.getD (tableIndex bs) 0 + table.getD (BitString.lsbValue bs) 0 /-- The bits on a list of ports under an assignment of bits to the edges. A port naming no edge reads `false`. -/ @@ -168,14 +153,14 @@ theorem entry_explicitTable [Zero R] (v : V) (x : Fin m → Bool) : ExplicitTensorNetwork.entry (N.explicitTable ee v) ((N.explicitPorts ee v).map x) = N.tensor v (x ∘ ee) := by set ps := N.explicitPorts ee v - have hlt : tableIndex (ps.map x) < (N.explicitTable ee v).length := by - simpa [explicitTable, ps] using tableIndex_lt (ps.map x) + have hlt : BitString.lsbValue (ps.map x) < (N.explicitTable ee v).length := by + simpa [explicitTable, ps] using BitString.lsbValue_lt (ps.map x) rw [ExplicitTensorNetwork.entry, List.getD_eq_getElem _ _ hlt] simp only [explicitTable, List.getElem_map, List.getElem_range] refine N.tensor_congr v _ _ fun e he => ?_ have hmem : ee e ∈ ps := (N.mem_explicitPorts ee).mpr (by simpa using he) have hidx := List.idxOf_lt_length_of_mem hmem - rw [testBit_tableIndex, List.getD_eq_getElem _ _ (by simpa using hidx), List.getElem_map, + rw [BitString.testBit_lsbValue, List.getD_eq_getElem _ _ (by simpa using hidx), List.getElem_map, List.getElem_idxOf hidx, Function.comp_apply] /-- A Boolean tensor network on finite types written out as an explicit network, numbering the diff --git a/Complexity/Foundations/Data/BitString/Counter.lean b/Complexity/Foundations/Data/BitString/Counter.lean index d13e8137f0..40319f05b8 100644 --- a/Complexity/Foundations/Data/BitString/Counter.lean +++ b/Complexity/Foundations/Data/BitString/Counter.lean @@ -35,6 +35,7 @@ their candidates in this way, storing only the current one. * `Cslib.BitString.iterate_increment`, `Cslib.BitString.iterate_increment_lsbValue`: counting from zero enumerates the words of a length. * `Cslib.BitString.lsbValue_eq_foldr_bit`: `lsbValue` is a right fold of `Nat.bit`. +* `Cslib.BitString.testBit_lsbValue`: binary digit `i` of `lsbValue w` is the bit `w[i]`. -/ @[expose] public section @@ -154,4 +155,14 @@ theorem lsbValue_eq_foldr_bit (w : List Bool) : lsbValue w = w.foldr Nat.bit 0 : | nil => rfl | cons b w ih => rw [lsbValue, List.foldr_cons, ← ih, Nat.bit_val, Nat.add_comm] +/-- Binary digit `i` of the value of a word is its bit `i`, or `false` past its end. -/ +@[simp] theorem testBit_lsbValue : ∀ (w : List Bool) (i : ℕ), + (lsbValue w).testBit i = w.getD i false + | [], _ => by simp [lsbValue] + | b :: w, i => by + rw [lsbValue_eq_foldr_bit, List.foldr_cons, ← lsbValue_eq_foldr_bit] + cases i with + | zero => simp + | succ i => simp [Nat.testBit_bit_succ, testBit_lsbValue w i] + end Cslib.BitString diff --git a/ComplexityTests/Computability/Circuit/Frontier/TensorNetwork.lean b/ComplexityTests/Computability/Circuit/Frontier/TensorNetwork.lean index 5be31a11e9..27d867afd5 100644 --- a/ComplexityTests/Computability/Circuit/Frontier/TensorNetwork.lean +++ b/ComplexityTests/Computability/Circuit/Frontier/TensorNetwork.lean @@ -60,7 +60,7 @@ example : (cycle neTable).contraction = 0 := by decide /-- The table `A` or `B` of `parallel` as a tensor on assignments to `Fin 2`. -/ def table (v : Fin 2) (x : Fin 2 → Bool) : ℤ := - [[1, 2, 3, 4], [5, 6, 7, 8]][v]!.getD (tableIndex [x 0, x 1]) 0 + [[1, 2, 3, 4], [5, 6, 7, 8]][v]!.getD (Cslib.BitString.lsbValue [x 0, x 1]) 0 /-- The network `parallel` on `Fin 2` vertices and `Fin 2` edges, both edges from `0` to `1`. Every edge is at both vertices, so the tensors are trivially local. -/ From 13a6daeafef1e752435505e47f5329da96b392e6 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 18:24:25 -0400 Subject: [PATCH 06/19] feat(circuit/frontier): binarize a tensor network by an injective code MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit An injective code `U → (Fin m → Bool)` turns a tensor network over a finite alphabet into a Boolean one on `m` parallel copies of every edge. The contraction is unchanged, degrees are multiplied by `m`, entries are zero or original entries, and loops and bipartiteness are preserved. Used by the HPV block-counting networks of #1833 (H3). Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 1 + .../Frontier/TensorNetwork/Binarize.lean | 165 ++++++++++++++++++ .../Frontier/TensorNetworkBinarize.lean | 78 +++++++++ 3 files changed, 244 insertions(+) create mode 100644 Complexity/Computability/Circuit/Frontier/TensorNetwork/Binarize.lean create mode 100644 ComplexityTests/Computability/Circuit/Frontier/TensorNetworkBinarize.lean diff --git a/Complexity.lean b/Complexity.lean index 3e53d5172a..d6cce81ba8 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -858,6 +858,7 @@ public import Complexity.Computability.Circuit.Frontier.Rectangle public import Complexity.Computability.Circuit.Frontier.Reduction public import Complexity.Computability.Circuit.Frontier.Sweep public import Complexity.Computability.Circuit.Frontier.TensorNetwork +public import Complexity.Computability.Circuit.Frontier.TensorNetwork.Binarize public import Complexity.Computability.Circuit.Frontier.TensorNetwork.Constraint public import Complexity.Computability.Circuit.Frontier.TensorNetwork.Explicit public import Complexity.Computability.Circuit.Frontier.TwoSidedWitness diff --git a/Complexity/Computability/Circuit/Frontier/TensorNetwork/Binarize.lean b/Complexity/Computability/Circuit/Frontier/TensorNetwork/Binarize.lean new file mode 100644 index 0000000000..caaca2155c --- /dev/null +++ b/Complexity/Computability/Circuit/Frontier/TensorNetwork/Binarize.lean @@ -0,0 +1,165 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Circuit.Frontier.TensorNetwork +public import Mathlib.Logic.Function.Basic +import Mathlib.Data.Set.Card + +/-! +# Binarizing a tensor network + +A tensor network whose edges carry letters of a finite alphabet `U` becomes a Boolean tensor +network once every letter is written in `m` bits. Fix an injective *code* +`code : U → (Fin m → Bool)`. The *binarization* `TensorNetwork.binarize` replaces every edge `e` +by the `m` parallel Boolean edges `(e, 0), …, (e, m - 1)` between the same two vertices. A vertex +decodes the `m` bits on each of its edges and evaluates its old tensor on the decoded letters; if +the bits on one of its edges are not the code of any letter, its tensor is zero. + +The contraction is unchanged (`TensorNetwork.contraction_binarize`): assignments of bits in which +every edge carries a code word correspond exactly to assignments of letters, and every other +assignment of bits has an edge with an invalid code word, whose source tensor vanishes. Every edge +becomes `m` edges, so vertex degrees are multiplied by `m` +(`TensorNetwork.maxDegreeLE_binarize`). Every tensor entry of the binarization is zero or an entry +of the original network (`TensorNetwork.tensor_binarize_eq_zero_or`). Loops and bipartiteness are +preserved. + +This lets a construction use a structured alphabet, such as words over a machine's tape alphabet, +and then pass to the Boolean networks of [OpenAI2026ETH], Appendix D. + +## Main definitions + +* `Cslib.Circuits.Frontier.TensorNetwork.binarize`: the binarization by a code. +* `Cslib.Circuits.Frontier.TensorNetwork.bitsOn`: the bits on the copies of an edge. + +## Main results + +* `Cslib.Circuits.Frontier.TensorNetwork.contraction_binarize`: binarization by an injective code + preserves the contraction. +* `Cslib.Circuits.Frontier.TensorNetwork.maxDegreeLE_binarize`: degrees are multiplied by the + code length. +* `Cslib.Circuits.Frontier.TensorNetwork.loopless_binarize`, + `Cslib.Circuits.Frontier.TensorNetwork.isBipartite_binarize`: loops and bipartiteness are + preserved. +* `Cslib.Circuits.Frontier.TensorNetwork.tensor_binarize_eq_zero_or`: binarized entries are zero + or original entries. + +## References + +* [OpenAI, *The Exponential Time Hypothesis is False*][OpenAI2026ETH], Appendix D.1 (p. 53). +-/ + +public section + +namespace Cslib.Circuits.Frontier.TensorNetwork + +open Function + +variable {R U V E : Type*} {m : ℕ} + +/-- The bits on the `m` copies of the edge `e`. -/ +@[expose] def bitsOn (y : E × Fin m → Bool) (e : E) : Fin m → Bool := + fun j => y (e, j) + +@[simp] theorem bitsOn_apply (y : E × Fin m → Bool) (e : E) (j : Fin m) : + bitsOn y e j = y (e, j) := rfl + +variable [Zero R] [Nonempty U] (N : TensorNetwork R U V E) (code : U → Fin m → Bool) + +open Classical in +/-- The *binarization* of a tensor network by a code `code : U → (Fin m → Bool)`. Every edge `e` +becomes the `m` Boolean edges `(e, j)` between the same two vertices. A vertex whose edges all +carry code words evaluates its old tensor on the decoded letters (`Function.invFun code`); a +vertex with an edge carrying a word that is not a code word has tensor zero. -/ +@[expose] noncomputable def binarize : TensorNetwork R Bool V (E × Fin m) where + src p := N.src p.1 + tgt p := N.tgt p.1 + tensor v y := + if ∀ e, N.src e = v ∨ N.tgt e = v → bitsOn y e ∈ Set.range code then + N.tensor v fun e => invFun code (bitsOn y e) + else 0 + tensor_congr v y y' h := by + have hrow : ∀ e, N.src e = v ∨ N.tgt e = v → bitsOn y e = bitsOn y' e := + fun e he => funext fun j => h (e, j) he + have hcond : (∀ e, N.src e = v ∨ N.tgt e = v → bitsOn y e ∈ Set.range code) ↔ + ∀ e, N.src e = v ∨ N.tgt e = v → bitsOn y' e ∈ Set.range code := + forall_congr' fun e => imp_congr_right fun he => by rw [hrow e he] + simp only [hcond] + split_ifs + · exact N.tensor_congr v _ _ fun e he => by rw [hrow e he] + · rfl + +@[simp] theorem binarize_src (p : E × Fin m) : (N.binarize code).src p = N.src p.1 := rfl + +@[simp] theorem binarize_tgt (p : E × Fin m) : (N.binarize code).tgt p = N.tgt p.1 := rfl + +/-- Every tensor entry of the binarization is zero or an entry of the original network at some +assignment of letters. -/ +theorem tensor_binarize_eq_zero_or (v : V) (y : E × Fin m → Bool) : + (N.binarize code).tensor v y = 0 ∨ ∃ x, (N.binarize code).tensor v y = N.tensor v x := by + classical + simp only [binarize] + split_ifs + · exact Or.inr ⟨_, rfl⟩ + · exact Or.inl rfl + +/-- Binarization keeps a network without loops loopless. -/ +theorem loopless_binarize (h : N.Loopless) : (N.binarize code).Loopless := + fun p => h p.1 + +/-- Binarization keeps a network bipartite, with the same sides. -/ +theorem isBipartite_binarize (h : N.IsBipartite) : (N.binarize code).IsBipartite := by + obtain ⟨side, hside⟩ := h + exact ⟨side, fun p => hside p.1⟩ + +/-- The edges at a vertex of the binarization are the copies of its old edges. -/ +theorem incidenceSet_binarize (v : V) : + (N.binarize code).incidenceSet v = N.incidenceSet v ×ˢ Set.univ := by + ext p + simp [Multigraph.mem_incidenceSet] + +/-- **Binarization multiplies degrees by the code length.** -/ +theorem maxDegreeLE_binarize [Finite E] {d : ℕ} (hd : N.MaxDegreeLE d) : + (N.binarize code).MaxDegreeLE (d * m) := by + intro v + rw [incidenceSet_binarize, Set.ncard_prod, Set.ncard_univ, Nat.card_eq_fintype_card, + Fintype.card_fin] + exact Nat.mul_le_mul_right m (hd v) + +/-- **Binarization preserves the contraction.** Assignments of bits in which every edge carries a +code word are the codes of the assignments of letters, and every other assignment of bits has an +edge with an invalid word, at whose source the tensor vanishes. -/ +theorem contraction_binarize {R : Type*} [CommSemiring R] [Fintype U] [Fintype V] [Fintype E] + [DecidableEq E] (N : TensorNetwork R U V E) {code : U → Fin m → Bool} + (hcode : Injective code) : (N.binarize code).contraction = N.contraction := by + classical + symm + refine Fintype.sum_of_injective (fun x p => code (x p.1) p.2) ?_ _ _ ?_ fun x => ?_ + · -- Distinct assignments of letters differ at some edge, so their codes differ there. + intro x x' hxx' + funext e + exact hcode (funext fun j => congrFun hxx' (e, j)) + · -- A word on some edge is not a code word, so the tensor at its source vanishes. + intro y hy + have : ∃ e, bitsOn y e ∉ Set.range code := by + by_contra! hall + exact hy ⟨fun e => invFun code (bitsOn y e), funext fun p => + congrFun (invFun_eq (hall p.1)) p.2⟩ + obtain ⟨e, he⟩ := this + refine Finset.prod_eq_zero (Finset.mem_univ (N.src e)) ?_ + simp only [binarize] + rw [ite_eq_right fun hall => he (hall e (Or.inl rfl))] + · -- On a code word everywhere, every vertex decodes the original assignment. + refine Finset.prod_congr rfl fun v _ => ?_ + simp only [binarize] + rw [ite_eq_left fun e _ => ⟨x e, rfl⟩] + congr 1 + funext e + exact (leftInverse_invFun hcode (x e)).symm + +end Cslib.Circuits.Frontier.TensorNetwork diff --git a/ComplexityTests/Computability/Circuit/Frontier/TensorNetworkBinarize.lean b/ComplexityTests/Computability/Circuit/Frontier/TensorNetworkBinarize.lean new file mode 100644 index 0000000000..72f6e28aaf --- /dev/null +++ b/ComplexityTests/Computability/Circuit/Frontier/TensorNetworkBinarize.lean @@ -0,0 +1,78 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: local-only (test driver) + +public import Complexity.Computability.Circuit.Frontier.TensorNetwork.Binarize +public import Mathlib.Data.Fin.VecNotation + +/-! +# Tests for binarized tensor networks + +A network with one edge over the alphabet `Fin 3`, binarized with the two-bit code of each +letter: its contraction is unchanged, the unused word `(true, true)` gets weight zero, a valid +word reads the original tensor, and the degree doubles. +-/ + +@[expose] public section + +namespace ComplexityTests.Computability.Circuit.Frontier.TensorNetworkBinarize + +open Cslib.Circuits.Frontier + +/-- Two vertices joined by one edge carrying a letter of `Fin 3`, with the tensors +`A = (1, 2, 3)` at vertex `0` and `B = (4, 5, 6)` at vertex `1`. -/ +def ternary : TensorNetwork ℕ (Fin 3) (Fin 2) Unit where + src _ := 0 + tgt _ := 1 + tensor v x := ![![1, 2, 3], ![4, 5, 6]] v (x ()) + tensor_congr v x y h := by + rw [h () (by fin_cases v <;> simp)] + +/-- By hand: `Z = 1·4 + 2·5 + 3·6 = 32`. -/ +theorem contraction_ternary : ternary.contraction = 32 := by decide + +/-- The two binary digits of a letter, least significant first. -/ +def code (u : Fin 3) : Fin 2 → Bool := + ![u.val.testBit 0, u.val.testBit 1] + +theorem code_injective : Function.Injective code := by decide + +/-- Binarization keeps the contraction `32`. -/ +example : (ternary.binarize code).contraction = 32 := by + rw [TensorNetwork.contraction_binarize _ code_injective, contraction_ternary] + +/-- The word `(true, true)` codes no letter, so a vertex reading it has weight zero. -/ +example : (ternary.binarize code).tensor 0 (fun _ => true) = 0 := by + have : TensorNetwork.bitsOn (fun _ : Unit × Fin 2 => true) () ∉ Set.range code := by + rintro ⟨u, hu⟩ + have h0 := congrFun hu 0 + have h1 := congrFun hu 1 + revert h0 h1 + fin_cases u <;> decide + simp only [TensorNetwork.binarize] + exact ite_eq_right fun h => this (h () (Or.inl rfl)) + +/-- The word `(false, true)` codes the letter `2`, so vertex `1` reads its entry `6`. -/ +example : (ternary.binarize code).tensor 1 (fun p => p.2 = 1) = 6 := by + have hword : TensorNetwork.bitsOn (fun p : Unit × Fin 2 => decide (p.2 = 1)) () = code 2 := by + funext j + fin_cases j <;> rfl + have hdec : Function.invFun code (code 2) = 2 := + Function.leftInverse_invFun code_injective 2 + simp only [TensorNetwork.binarize] + rw [ite_eq_left fun e _ => ⟨2, by cases e; exact hword.symm⟩] + simp only [ternary, hword, hdec] + rfl + +/-- Each vertex has one edge; after binarization it has two, and the network stays bipartite. -/ +example : (ternary.binarize code).MaxDegreeLE 2 ∧ (ternary.binarize code).IsBipartite := by + refine ⟨ternary.maxDegreeLE_binarize code (d := 1) fun v => ?_, + ternary.isBipartite_binarize code ⟨fun v => v = 0, fun _ => by simp [ternary]⟩⟩ + exact (Set.ncard_le_card _).trans (by simp) + +end ComplexityTests.Computability.Circuit.Frontier.TensorNetworkBinarize From 822658ff3d92494f44dbe97d1bae3ef090f55b0c Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 18:39:42 -0400 Subject: [PATCH 07/19] feat(machines): interval tensors of HPV-blocked coin runs (#1833 H3) Views of a configuration with blocks of length `b` (block indices, control record, window contents), the configuration embedded from a view, interval steps and the interval tensor `F_i` of Lemma 2.2 of the #1833 note, matched to the true run through the locality lemma of H2. Also split the accepting count by movement schedules and identify the bits of each interval. `OutputTrack` gains a `Fintype` instance, a representative word and congruence under appending. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 3 +- .../Turing/MultiTape/Machine/ChoiceTable.lean | 24 +- .../Probabilistic/IntervalTensor.lean | 351 ++++++++++++++++++ ComplexityTests/HPVIntervalTensors.lean | 106 ++++++ 4 files changed, 479 insertions(+), 5 deletions(-) create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalTensor.lean create mode 100644 ComplexityTests/HPVIntervalTensors.lean diff --git a/Complexity.lean b/Complexity.lean index 0323fa5922..e16898c89c 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -1799,8 +1799,8 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.WhileC public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.WhileInput public import Complexity.Computability.Machines.Turing.MultiTape.PolyTime public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic -public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Blocks public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.AcceptCount +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Blocks public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Clock public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Closed public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.CoinTape @@ -1808,6 +1808,7 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.C public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Deterministic public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExtendTapes public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.InputFromTape +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalTensor public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IterateWhile public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Loop public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.OrElse diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Machine/ChoiceTable.lean b/Complexity/Computability/Machines/Turing/MultiTape/Machine/ChoiceTable.lean index 6394b54282..487783761f 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Machine/ChoiceTable.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Machine/ChoiceTable.lean @@ -87,10 +87,8 @@ inductive OutputTrack namespace OutputTrack -instance : Finite OutputTrack := - Finite.of_surjective (fun i : Fin 3 => [empty, accept, other][i]) fun t => by - cases t - exacts [⟨0, rfl⟩, ⟨1, rfl⟩, ⟨2, rfl⟩] +instance : Fintype OutputTrack := + ⟨{empty, accept, other}, fun t => by cases t <;> simp⟩ /-- The track of a word. -/ def ofWord (word : List Bool) : OutputTrack := @@ -120,6 +118,24 @@ theorem ofWord_eq_accept_iff (word : List Bool) : ofWord word = accept ↔ word unfold ofWord split_ifs with h₁ h₂ <;> simp_all +/-- Emitting the same word after words with the same track gives words with the same track. -/ +theorem ofWord_append_eq_of_eq {word word' : List Bool} (h : ofWord word = ofWord word') + (more : List Bool) : ofWord (word ++ more) = ofWord (word' ++ more) := by + induction more using List.reverseRecOn with + | nil => simpa using h + | append_singleton more symbol ih => + have hsym : [symbol] = (some symbol).toList := rfl + rw [← List.append_assoc, ← List.append_assoc, hsym, ofWord_append, ofWord_append, ih] + +/-- A word with a given track: `[]`, `[true]` or `[false]`. -/ +def toWord : OutputTrack → List Bool + | empty => [] + | accept => [true] + | other => [false] + +@[simp] theorem ofWord_toWord (track : OutputTrack) : ofWord track.toWord = track := by + cases track <;> rfl + end OutputTrack /-- The states of the choice table: the simulated state, the index of the candidate action, and diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalTensor.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalTensor.lean new file mode 100644 index 0000000000..18eaa4a012 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalTensor.lean @@ -0,0 +1,351 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.AcceptCount +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Blocks +public import Complexity.Computability.Machines.Turing.MultiTape.Machine.ChoiceTable +public import Mathlib.Data.ZMod.Defs +import Mathlib.Data.ZMod.Basic +import Mathlib.Logic.Equiv.Fin.Basic +import Mathlib.Tactic.Linarith + +/-! +# Interval tensors of a choice-string run + +The local pieces of the block-counting identity, Lemma 2.2 of the note *Deterministic +simulations of nondeterministic and randomized time* (30 October 2026) formalized in issue #1833, +which builds on the blocking of Hopcroft, Paul and Valiant [HopcroftPaulValiant1977] in the +three-block form of `Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Blocks` +(compare [Williams2025], Lemma 2.1 and §3.2). The proof idea is original to that note. + +Fix a block length `b > 0`. A configuration of a fair-coin table over `Bool` is seen through + +* its *block indices* `Turing.Cfg.blockIndex`: the block `p / b` of every head; +* its *control record* `Turing.Cfg.blockControl`: its state, the offset `p mod b` of every head + in its block, and the track (`Turing.MultiTapeNTM.ChoiceTable.OutputTrack`) of its output; +* its *window contents* `Turing.Cfg.windowContents`: the contents of the three blocks + `J - 1, J, J + 1` around given block indices `J` on every work tape. + +Conversely, `Turing.embedCfg` builds a configuration from block indices, a control record and +window contents, with blank cells outside the windows and an output of the right track. The +*interval step* `Turing.MultiTapePTM.IntervalStep` replays the bits of a time interval from such +an embedded configuration and compares the record, window contents and block indices it leaves +with prescribed ones. The *interval tensor* `Turing.MultiTapePTM.intervalCount` counts the bit +strings `u ∈ {0,1}^b` doing so: the entry `F_i` of the note's equation (3). + +**Matching the true run** (`Turing.MultiTapePTM.intervalStep_view_iff`). Embedding the view of a +configuration `c` gives a configuration that agrees with `c` on its state, its heads and its +windows, and whose output has the same track. By the locality of runs +(`Turing.MultiTapePTM.agreeOn_blockWindow_stepCoins`), an interval step from the view of `c` +holds exactly when the true replay from `c` leaves the prescribed record, contents and block +indices. The input tape is not blocked as a word: it is fixed by `input`, which the embedded +configuration shares. + +**Splitting the count by schedules** (`Turing.MultiTapePTM.acceptCount_eq_sum_card_schedule`). +The accepting count `A_M(x)` on `q * b` bits is the sum, over the movement schedules `σ` of `q` +intervals, of the number of accepting choice strings with schedule `σ`. The bits of interval `i` +of a choice string `y : Fin (q * b) → Bool` are `y (finProdFinEquiv (i, r))` for `r < b` +(`Turing.MultiTapePTM.intervalStart_succ_ofFn`). + +## Main definitions + +* `Turing.Cfg.blockIndex`, `Turing.Cfg.blockContents`, `Turing.Cfg.windowContents`: block + indices and block contents. +* `Turing.BlockControl`, `Turing.Cfg.blockControl`: control records. +* `Turing.embedCfg`: the configuration with given block indices, record and window contents. +* `Turing.MultiTapePTM.IntervalStep`, `Turing.MultiTapePTM.intervalCount`: interval steps and + interval tensors. + +## Main results + +* `Turing.MultiTapePTM.acceptCount_eq_sum_card_schedule`: the accepting count split by schedules. +* `Turing.MultiTapePTM.intervalStart_succ_ofFn`: the bits of each interval. +* `Turing.agreeOn_embedCfg_view`: an embedded view agrees with the configuration on its windows. +* `Turing.MultiTapePTM.intervalStep_view_iff`: interval steps from a view are the true replay. +* `Turing.MultiTapePTM.intervalCount_le`: interval tensor entries are at most `2 ^ b`. + +## References + +* [J. Hopcroft, W. Paul, L. Valiant, *On Time Versus Space*][HopcroftPaulValiant1977] +* [R. Williams, *Simulating Time With Square-Root Space*][Williams2025] +-/ + +public section + +namespace Turing + +open MultiTapeNTM.ChoiceTable + +variable {k : ℕ} {Symbol State : Type} + +/-! ### Views of a configuration -/ + +section View + +variable (b : ℕ) [NeZero b] {input : List Symbol} + +/-- The block index of every head, with blocks of length `b`: a head at coordinate `p` is in +block `p / b`. -/ +@[expose] def Cfg.blockIndex (c : Cfg k Symbol State input) (head : Option (Fin k)) : ℤ := + c.headPos head / b + +/-- The contents of block `j` of work tape `h`, with blocks of length `b`: the cells +`b * j + r` for `r < b`. -/ +@[expose] def Cfg.blockContents (c : Cfg k Symbol State input) (h : Fin k) (j : ℤ) : + ZMod b → Option Symbol := + fun r => c.workTapes h (b * j + r.val) + +/-- The contents of the three blocks `J h - 1, J h, J h + 1` around block indices `J` on every +work tape `h`; entry `d : Fin 3` is block `J h + d - 1`. -/ +@[expose] def Cfg.windowContents (J : Option (Fin k) → ℤ) (c : Cfg k Symbol State input) : + Fin k → Fin 3 → ZMod b → Option Symbol := + fun h d => c.blockContents b h (J (some h) + d - 1) + +end View + +section Embed + +variable (b : ℕ) [NeZero b] {input : List Bool} + +/-- A *control record* with blocks of length `b`: a state, the offset of every head in its block, +and the track of the output. -/ +abbrev BlockControl (k : ℕ) (State : Type) (b : ℕ) := + Option State × (Option (Fin k) → ZMod b) × OutputTrack + +/-- The control record of a configuration: its state, the offset `p mod b` of every head, and the +track of its output. -/ +@[expose] def Cfg.blockControl (c : Cfg k Bool State input) : + BlockControl k State b := + (c.state, fun head => (c.headPos head : ZMod b), OutputTrack.ofWord c.output) + +/-- The input head position with coordinate `p`, that is, stored position `p + 1`, or the +left end when `p + 1` is out of range. -/ +@[expose] def inputPosOfCoord (input : List Bool) (p : ℤ) : Fin (input.length + 2) := + if h : 0 ≤ p + 1 ∧ p + 1 < input.length + 2 then ⟨(p + 1).toNat, by omega⟩ else 0 + +/-- Cell `z` of work tape `h` of the configuration with window contents `w` at block indices `J`: +the entry of `w` if `z` lies in one of the three blocks around `J h`, and blank otherwise. -/ +@[expose] def windowCell (J : Option (Fin k) → ℤ) (w : Fin k → Fin 3 → ZMod b → Option Bool) + (h : Fin k) (z : ℤ) : Option Bool := + if hz : 0 ≤ z / b - J (some h) + 1 ∧ z / b - J (some h) + 1 < 3 then + w h ⟨(z / b - J (some h) + 1).toNat, by omega⟩ z + else none + +/-- The configuration with block indices `J`, control record `c` and window contents `w`: every +head at `b * J + offset`, the work tapes holding `w` on the windows and blank elsewhere, and an +output with the track of `c`. -/ +@[expose] def embedCfg (J : Option (Fin k) → ℤ) (c : BlockControl k State b) + (w : Fin k → Fin 3 → ZMod b → Option Bool) : Cfg k Bool State input where + state := c.1 + inputPos := inputPosOfCoord input (b * J none + (c.2.1 none).val) + workTapes := windowCell b J w + workTapePos h := b * J (some h) + (c.2.1 (some h)).val + output := c.2.2.toWord + +variable {b} + +/-- A coordinate is its block start plus its offset. -/ +private theorem mul_ediv_add_val_intCast (p : ℤ) : + (b : ℤ) * (p / b) + ((p : ZMod b).val : ℤ) = p := by + rw [ZMod.val_intCast] + exact Int.mul_ediv_add_emod p b + +omit [NeZero b] in +/-- The embedded configuration has the output track of its record. -/ +@[simp] theorem ofWord_output_embedCfg (J : Option (Fin k) → ℤ) (c : BlockControl k State b) + (w : Fin k → Fin 3 → ZMod b → Option Bool) : + OutputTrack.ofWord (embedCfg (input := input) b J c w).output = c.2.2 := + OutputTrack.ofWord_toWord _ + +/-- The cells of the window entries lie in the three blocks around the block index. -/ +private theorem mem_blockWindow_of_window {c : Cfg k Bool State input} (h : Fin k) (d : Fin 3) + (r : ZMod b) : + b * (c.blockIndex b (some h) + d - 1) + (r.val : ℤ) ∈ c.blockWindow b h := by + have hb : (0 : ℤ) < b := by exact_mod_cast Nat.pos_of_neZero b + have hr : (r.val : ℤ) < b := by exact_mod_cast ZMod.val_lt r + have hd : ((d : ℕ) : ℤ) < 3 := by exact_mod_cast d.isLt + simp only [Cfg.blockWindow, Cfg.blockIndex, Cfg.headPos_some, Set.mem_Ico] + constructor <;> nlinarith + +/-- **An embedded view agrees with the configuration.** Embedding the block indices, control +record and window contents of `c` gives a configuration with the state, heads and window contents +of `c`. -/ +theorem agreeOn_embedCfg_view (c : Cfg k Bool State input) : + (embedCfg b (c.blockIndex b) (c.blockControl b) + (c.windowContents b (c.blockIndex b))).AgreeOn (c.blockWindow b) c := by + have hb : (0 : ℤ) < b := by exact_mod_cast Nat.pos_of_neZero b + refine ⟨rfl, ?_, ?_, fun h z hz => ?_⟩ + · -- The input head is at its coordinate plus one, which is in range. + have hpos := mul_ediv_add_val_intCast (b := b) (c.headPos none) + have hlt := c.inputPos.isLt + change inputPosOfCoord input + (b * (c.headPos none / b) + ((c.headPos none : ZMod b)).val) = c.inputPos + rw [hpos, Cfg.headPos_none] + unfold inputPosOfCoord + split_ifs with hcond + · ext + simp only + omega + · exact absurd ⟨by omega, by omega⟩ hcond + · funext h + exact mul_ediv_add_val_intCast (c.headPos (some h)) + · -- A window cell `z` is entry `z / b - J + 1` of the window, at offset `z mod b`. + simp only [Cfg.blockWindow, Set.mem_Ico] at hz + have hlo := Int.emod_nonneg z hb.ne' + have hhi := Int.emod_lt_of_pos z hb + have hval := mul_ediv_add_val_intCast (b := b) z + have hdiv := Int.mul_ediv_add_emod z b + have hJ : c.blockIndex b (some h) = c.workTapePos h / b := rfl + have h₁ : c.workTapePos h / b - 1 ≤ z / b := by + by_contra hcon + have : b * (z / b) ≤ b * (c.workTapePos h / b - 2) := + mul_le_mul_of_nonneg_left (by omega) hb.le + nlinarith + have h₂ : z / b < c.workTapePos h / b + 2 := by + by_contra hcon + have : b * (c.workTapePos h / b + 2) ≤ b * (z / b) := + mul_le_mul_of_nonneg_left (by omega) hb.le + nlinarith + have hcond : 0 ≤ z / b - c.blockIndex b (some h) + 1 ∧ + z / b - c.blockIndex b (some h) + 1 < 3 := by + rw [hJ] + omega + change windowCell b (c.blockIndex b) (c.windowContents b (c.blockIndex b)) h z = _ + rw [windowCell, dite_eq_left hcond] + simp only [Cfg.windowContents, Cfg.blockContents] + rw [Int.toNat_of_nonneg hcond.1, + show c.blockIndex b (some h) + (z / b - c.blockIndex b (some h) + 1) - 1 = z / b by ring, + hval] + +end Embed + +namespace MultiTapePTM + +variable (machine : MultiTapePTM k Bool State) {input : List Bool} + +/-! ### Interval steps and interval tensors -/ + +section Interval + +variable (b : ℕ) [NeZero b] + +/-- **An interval step.** Replaying `coins` from the configuration embedded at block indices `J` +with entering control record `cIn` and window contents `wIn` leaves the control record `cOut`, +the contents `wOut` of the same windows, and moves the block of every head `h` by `δ h`. -/ +def IntervalStep (input : List Bool) (J : Option (Fin k) → ℤ) (δ : Option (Fin k) → SignType) + (cIn : BlockControl k State b) (wIn : Fin k → Fin 3 → ZMod b → Option Bool) + (coins : List Bool) (cOut : BlockControl k State b) + (wOut : Fin k → Fin 3 → ZMod b → Option Bool) : Prop := + (machine.stepCoins coins (embedCfg (input := input) b J cIn wIn)).blockControl b = cOut ∧ + (machine.stepCoins coins (embedCfg (input := input) b J cIn wIn)).windowContents b J = wOut ∧ + ∀ head, (machine.stepCoins coins (embedCfg (input := input) b J cIn wIn)).blockIndex b head = + J head + δ head + +open scoped Classical in +/-- **The interval tensor**: the number of bit strings `u ∈ {0,1}^b` whose replay is an interval +step from the entering record `cIn` and contents `wIn` at block indices `J` to the leaving record +`cOut` and contents `wOut`, moving the blocks by `δ`. This is the entry `F_i` of the note's +equation (3). -/ +noncomputable def intervalCount (input : List Bool) (J : Option (Fin k) → ℤ) + (δ : Option (Fin k) → SignType) (cIn : BlockControl k State b) + (wIn : Fin k → Fin 3 → ZMod b → Option Bool) + (cOut : BlockControl k State b) (wOut : Fin k → Fin 3 → ZMod b → Option Bool) : ℕ := + (Finset.univ.filter fun u : Fin b → Bool => + machine.IntervalStep b input J δ cIn wIn (List.ofFn u) cOut wOut).card + +omit [NeZero b] in +/-- An interval tensor entry is at most the number `2 ^ b` of bit strings. -/ +theorem intervalCount_le (input : List Bool) (J : Option (Fin k) → ℤ) + (δ : Option (Fin k) → SignType) (cIn : BlockControl k State b) + (wIn : Fin k → Fin 3 → ZMod b → Option Bool) + (cOut : BlockControl k State b) (wOut : Fin k → Fin 3 → ZMod b → Option Bool) : + machine.intervalCount b input J δ cIn wIn cOut wOut ≤ 2 ^ b := by + classical + unfold intervalCount + exact (Finset.card_filter_le _ _).trans (by simp) + +/-- **Interval steps from a view are the true replay.** For at most `b` bits, an interval step +from the view of `c` (its block indices, control record and window contents) holds exactly when +replaying the bits from `c` itself leaves the prescribed record and window contents and moves the +blocks by `δ`. -/ +theorem intervalStep_view_iff (c : Cfg k Bool State input) {coins : List Bool} + (hlen : coins.length ≤ b) (δ : Option (Fin k) → SignType) (cOut : BlockControl k State b) + (wOut : Fin k → Fin 3 → ZMod b → Option Bool) : + machine.IntervalStep b input (c.blockIndex b) δ (c.blockControl b) + (c.windowContents b (c.blockIndex b)) coins cOut wOut ↔ + (machine.stepCoins coins c).blockControl b = cOut ∧ + (machine.stepCoins coins c).windowContents b (c.blockIndex b) = wOut ∧ + ∀ head, (machine.stepCoins coins c).blockIndex b head = c.blockIndex b head + δ head := by + set e := embedCfg (input := input) b (c.blockIndex b) (c.blockControl b) + (c.windowContents b (c.blockIndex b)) + obtain ⟨hagree, word, hword, hword'⟩ := + machine.agreeOn_blockWindow_stepCoins (Nat.pos_of_neZero b) hlen + (agreeOn_embedCfg_view c).symm (coins := coins) + replace hagree := hagree.symm + -- The two replays have the same state, heads, output track and window contents. + have htrack : OutputTrack.ofWord (machine.stepCoins coins e).output = + OutputTrack.ofWord (machine.stepCoins coins c).output := by + rw [hword, hword'] + refine OutputTrack.ofWord_append_eq_of_eq ?_ word + rw [ofWord_output_embedCfg] + rfl + have hcontrol : (machine.stepCoins coins e).blockControl b = + (machine.stepCoins coins c).blockControl b := by + rw [Cfg.blockControl, Cfg.blockControl, hagree.state_eq, hagree.headPos_eq, htrack] + have hwindow : (machine.stepCoins coins e).windowContents b (c.blockIndex b) = + (machine.stepCoins coins c).windowContents b (c.blockIndex b) := by + funext h d r + exact hagree.workTapes_eq h _ (mem_blockWindow_of_window h d r) + have hindex : (machine.stepCoins coins e).blockIndex b = + (machine.stepCoins coins c).blockIndex b := by + funext head + rw [Cfg.blockIndex, Cfg.blockIndex, hagree.headPos_eq] + rw [IntervalStep, hcontrol, hwindow, hindex] + +end Interval + +/-! ### Splitting the accepting count -/ + +/-- **The accepting count split by schedules.** The accepting choice strings of `q` intervals of +`b` bits are counted schedule by schedule. -/ +theorem acceptCount_eq_sum_card_schedule (input : List Bool) (b q : ℕ) : + machine.acceptCount input (q * b) = ∑ σ : Schedule k q, + (Finset.univ.filter fun y : Fin (q * b) → Bool => + machine.runClosedCoins (List.ofFn y) input = [true] ∧ + machine.schedule b q (List.ofFn y) (Cfg.init machine.initial input) = σ).card := by + classical + rw [acceptCount, Cslib.Complexity.acceptCount, Finset.card_eq_sum_card_fiberwise + (f := fun y : Fin (q * b) → Bool => + machine.schedule b q (List.ofFn y) (Cfg.init machine.initial input)) + (t := Finset.univ) fun _ _ => Finset.mem_coe.mpr (Finset.mem_univ _)] + refine Finset.sum_congr rfl fun σ _ => ?_ + rw [Finset.filter_filter] + simp only [decide_eq_true_eq] + +/-- **The bits of an interval.** For a choice string `y` of `q` intervals of `b` bits, interval +`i` replays the bits `y (finProdFinEquiv (i, r))`, `r < b`. -/ +theorem intervalStart_succ_ofFn {q b : ℕ} (y : Fin (q * b) → Bool) (c : Cfg k Bool State input) + (i : Fin q) : + machine.intervalStart b (List.ofFn y) c (i + 1) = + machine.stepCoins (List.ofFn fun r : Fin b => y (finProdFinEquiv (i, r))) + (machine.intervalStart b (List.ofFn y) c i) := by + rw [intervalStart_succ] + congr 1 + have hi := i.isLt + have hle : i * b + b ≤ q * b := by nlinarith + refine List.ext_getElem (by simp; omega) fun r h₁ h₂ => ?_ + simp only [List.getElem_take, List.getElem_drop, List.getElem_ofFn] + congr 1 + ext + change i * b + r = r + b * i + ring + +end MultiTapePTM + +end Turing diff --git a/ComplexityTests/HPVIntervalTensors.lean b/ComplexityTests/HPVIntervalTensors.lean new file mode 100644 index 0000000000..aceca68168 --- /dev/null +++ b/ComplexityTests/HPVIntervalTensors.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalTensor + +/-! Views, embeddings and interval steps of a concrete choice-string run, with blocks of +length `2`. -/ + +namespace ComplexityTests.HPVIntervalTensors + +open Turing MultiTapeMachine + +/-- On one work tape, write the coin and move right on `true`, left on `false`. The input head +moves right on `true` too. -/ +private def zigzag : MultiTapePTM 1 Bool Unit where + initial := () + tr _ _ _ _ bit := .step + { inputTape := if bit then 1 else 0, + workTapes := fun _ => (some (some bit), if bit then 1 else -1), + output := none, state := some () } + Empty.elim Empty.elim + +/-- Replays on upstream configurations, evaluated through the computable interpreter. -/ +private theorem stepCoins_eq (coins : List Bool) (cfg : Cfg 1 Bool Unit [true, false]) : + zigzag.stepCoins coins cfg = + (zigzag.runClosedConfigFromCoins coins { tapes := cfg }).tapes := + (MultiTapePTM.tapes_runClosedConfigFromCoins zigzag coins { tapes := cfg }).symm + +private def start : Cfg 1 Bool Unit [true, false] := Cfg.init () [true, false] + +/-! ### Embedding a view keeps the window and forgets the rest -/ + +/-- The start configuration with marks in its window `[-2, 4)` (cell `3`) and outside it +(cell `5`). -/ +private def marked : Cfg 1 Bool Unit [true, false] := + { start with workTapes := fun _ z => if z = 3 ∨ z = 5 then some false else none } + +/-- The configuration embedded from the view of `marked`. -/ +private noncomputable def markedView : Cfg 1 Bool Unit [true, false] := + embedCfg 2 (marked.blockIndex 2) (marked.blockControl 2) + (marked.windowContents 2 (marked.blockIndex 2)) + +-- The mark in the window is kept. +example : markedView.workTapes 0 3 = some false := + (agreeOn_embedCfg_view marked).workTapes_eq 0 3 (by simp [Cfg.blockWindow, marked, start]) + +-- The mark outside the window is forgotten: block `2` is not part of the view. +example : markedView.workTapes 0 5 = none := by + simp only [markedView, embedCfg, windowCell] + rw [dite_eq_right (by decide)] + +/-! ### Interval steps -/ + +/-- After `true, true` both heads have moved two cells to the right. -/ +private noncomputable def after : Cfg 1 Bool Unit [true, false] := + zigzag.stepCoins [true, true] start + +private theorem headPos_after : after.headPos = fun _ => 2 := by + funext head + cases head <;> (rw [after, stepCoins_eq]; rfl) + +-- The interval wrote `true` into cells `0` and `1`: offsets `0` and `1` of the middle block. +example : after.windowContents 2 (start.blockIndex 2) 0 1 = fun _ => some true := by + funext r + fin_cases r <;> (rw [after, stepCoins_eq]; rfl) + +/-- Both heads move one block to the right. -/ +private theorem blockIndex_after (head : Option (Fin 1)) : + after.blockIndex 2 head = start.blockIndex 2 head + ((1 : SignType) : ℤ) := by + simp only [Cfg.blockIndex, headPos_after, Cfg.headPos_init, start] + rfl + +-- From the view of `start`, the interval step on `true, true` leaves the record and window of +-- the true replay and moves both blocks by `+1`. +example : zigzag.IntervalStep 2 [true, false] (start.blockIndex 2) (fun _ => 1) + (start.blockControl 2) (start.windowContents 2 (start.blockIndex 2)) [true, true] + (after.blockControl 2) (after.windowContents 2 (start.blockIndex 2)) := + (zigzag.intervalStep_view_iff 2 start (by decide) _ _ _).mpr ⟨rfl, rfl, blockIndex_after⟩ + +-- The schedule entry is checked: the step does not keep the work head in its block. +example : ¬ zigzag.IntervalStep 2 [true, false] (start.blockIndex 2) (fun _ => 0) + (start.blockControl 2) (start.windowContents 2 (start.blockIndex 2)) [true, true] + (after.blockControl 2) (after.windowContents 2 (start.blockIndex 2)) := by + rw [zigzag.intervalStep_view_iff 2 start (by decide)] + rintro ⟨-, -, h⟩ + have := (h (some 0)).symm.trans (blockIndex_after (some 0)) + simp at this + +/-- An entry of the interval tensor counts at most the `4` bit strings of the interval. -/ +example : zigzag.intervalCount 2 [true, false] (start.blockIndex 2) (fun _ => 1) + (start.blockControl 2) (start.windowContents 2 (start.blockIndex 2)) + (after.blockControl 2) (after.windowContents 2 (start.blockIndex 2)) ≤ 4 := + zigzag.intervalCount_le 2 _ _ _ _ _ _ _ + +/-! ### Bits of an interval -/ + +-- With two intervals of two bits, interval `1` replays bits `2` and `3`. +example (y : Fin (2 * 2) → Bool) : + zigzag.intervalStart 2 (List.ofFn y) start 2 = + zigzag.stepCoins [y 2, y 3] (zigzag.intervalStart 2 (List.ofFn y) start 1) := by + exact zigzag.intervalStart_succ_ofFn y start 1 + +end ComplexityTests.HPVIntervalTensors From e84e948852ef1c9e8d94e9b3d5f5f0f12df35f72 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 18:53:02 -0400 Subject: [PATCH 08/19] feat(machines): block-counting tensor networks (#1833 H3, Lemma 2.2) The tensor network of a movement schedule: one vertex per interval and a sink per edge, control-record and block-content edges from each interval to the next interval whose window holds that block, and the interval tensors of the previous commit. Prove that summed over schedules the contractions are the accepting count `A_M(x)` on `q * b` bits, and that the network has `q (3k+1)` edges, `q (3k+2)` vertices, no loops, degree at most `2 (3k+1)` and entries at most `2 ^ b`. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 1 + .../MultiTape/Probabilistic/BlockNetwork.lean | 844 ++++++++++++++++++ ComplexityTests/HPVBlockNetwork.lean | 55 ++ 3 files changed, 900 insertions(+) create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/BlockNetwork.lean create mode 100644 ComplexityTests/HPVBlockNetwork.lean diff --git a/Complexity.lean b/Complexity.lean index 6d065c46bf..edb6e44788 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -1804,6 +1804,7 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Plumbing.WhileI public import Complexity.Computability.Machines.Turing.MultiTape.PolyTime public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.AcceptCount +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.BlockNetwork public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Blocks public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Clock public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Closed diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/BlockNetwork.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/BlockNetwork.lean new file mode 100644 index 0000000000..32b9261096 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/BlockNetwork.lean @@ -0,0 +1,844 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalTensor +public import Complexity.Computability.Circuit.Frontier.TensorNetwork +import Mathlib.Algebra.BigOperators.GroupWithZero.Finset +import Mathlib.Algebra.BigOperators.Ring.Finset +import Mathlib.Data.Fintype.Sum + +/-! +# Block-counting tensor networks + +The block-counting identity, Lemma 2.2 of the note *Deterministic simulations of +nondeterministic and randomized time* (30 October 2026) formalized in issue #1833. Fix a closed +fair-coin table `machine` over `Bool`, an input, a block length `b > 0` and a movement schedule +`σ` of `q > 0` intervals (`Turing.MultiTapePTM.Schedule`). The tensor network +`Turing.MultiTapePTM.blockNetwork` counts the accepting choice strings of `q * b` bits whose run +has schedule `σ` (`Turing.MultiTapePTM.contraction_blockNetwork`), so summing over the schedules +gives the accepting count `A_M(x)` (`Turing.MultiTapePTM.sum_contraction_blockNetwork`). The proof +idea is original to that note, building on the blocking of Hopcroft, Paul and Valiant +[HopcroftPaulValiant1977] (compare [Williams2025], Lemma 2.1 and §3.2). + +**The network.** The schedule fixes the block index of every head at the start of every interval +(`Turing.MultiTapePTM.scheduleBlock`), and hence the window of three blocks around each work head. + +* There is one vertex for each interval `i`, and one *sink* vertex for each edge. +* Every edge leaves an interval (`Turing.MultiTapePTM.BlockEdge`): the edge `.inl i` carries the + control record leaving interval `i`, and the edge `.inr (i, h, d)` the contents of block + `scheduleBlock σ i h + d - 1` of work tape `h` leaving interval `i`. Its target is the next + interval whose window contains that block, or the next interval for a control record; when + there is none, it ends at its sink. +* The tensor of interval `i` is the interval tensor of + `Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalTensor`: the number of + bit strings `u ∈ {0,1}^b` taking the entering record and window to the leaving ones and moving + every block as `σ i` prescribes. The entering record comes from the control edge of interval + `i - 1`, or is the initial record for `i = 0`. The entering contents of a block come from the + previous interval whose window contains it, or are blank when there is none. +* The sink of the last control edge accepts exactly the records whose output track is `accept`; + every other sink is the constant `1`. + +Edges carry letters of `Turing.MultiTapePTM.BlockLetter`, a control record or the contents of a +block. A letter of the wrong kind on an edge gives weight zero, because the interval leaving +it requires the right kind. + +**The identity.** Expanding every interval tensor as a sum over its bit strings writes the +contraction as a sum over `q` strings of `b` bits, that is over choice strings of `q * b` bits. +For a fixed choice string, induction over the intervals shows that an assignment of letters with +nonzero weight is forced to be the true run's: the control records and the window contents of +the true run at the end of each interval, and the run is forced to follow `σ`. Between two +appearances of a block in windows, the block is untouched +(`Turing.MultiTapePTM.workTapes_intervalStart_eq_of_notMem_blockWindow`), and within an interval +the embedded window is matched to the true run (`Turing.MultiTapePTM.intervalStep_view_iff`). +Conversely the true run's letters have weight one exactly when the run has schedule `σ` and +accepts. + +**Size.** The network has `q * (3 k + 1)` edges and `q * (3 k + 2)` vertices, no loops, maximum +degree at most `2 * (3 k + 1)`, and entries at most `2 ^ b`. Its letters have `O(b)` bits, so +binarizing (`Cslib.Circuits.Frontier.TensorNetwork.binarize`) and subdividing it gives a +bipartite Boolean network with `O(q b)` edges and degree `O(b)`, as in the note. + +## Main definitions + +* `Turing.MultiTapePTM.scheduleBlock`: block indices prescribed by a schedule. +* `Turing.MultiTapePTM.InWindow`, `Turing.MultiTapePTM.portBlock`, `Turing.MultiTapePTM.portOf`: + windows and window entries under a schedule. +* `Turing.MultiTapePTM.BlockEdge`, `Turing.MultiTapePTM.BlockLetter`: edges and letters. +* `Turing.MultiTapePTM.inControl`, `Turing.MultiTapePTM.inWindow`, + `Turing.MultiTapePTM.IntervalHolds`, `Turing.MultiTapePTM.edgeTarget`: the entering record and + window of an interval, its condition, and the targets of edges. +* `Turing.MultiTapePTM.blockNetwork`: the block-counting network of a schedule. + +## Main results + +* `Turing.MultiTapePTM.blockIndex_intervalStart_eq_scheduleBlock`: a run following `σ` has the + block indices of `σ`. +* `Turing.MultiTapePTM.contraction_blockNetwork`: the network of `σ` counts the accepting choice + strings with schedule `σ`. +* `Turing.MultiTapePTM.sum_contraction_blockNetwork`: summed over the `3 ^ ((k + 1) * q)` + schedules, the contractions give the accepting count. +* `Turing.MultiTapePTM.card_blockEdge`, `Turing.MultiTapePTM.card_blockVertex`, + `Turing.MultiTapePTM.loopless_blockNetwork`, `Turing.MultiTapePTM.maxDegreeLE_blockNetwork`, + `Turing.MultiTapePTM.tensor_blockNetwork_le`: size, degree and entry bounds. + +## References + +* [J. Hopcroft, W. Paul, L. Valiant, *On Time Versus Space*][HopcroftPaulValiant1977] +* [R. Williams, *Simulating Time With Square-Root Space*][Williams2025] +* [OpenAI, *The Exponential Time Hypothesis is False*][OpenAI2026ETH], Appendix D.1 (p. 53) +-/ + +public section + +namespace Turing.MultiTapePTM + +open Cslib.Circuits.Frontier MultiTapeNTM.ChoiceTable + +variable {k q : ℕ} {State : Type} + +/-! ### Block indices prescribed by a schedule -/ + +/-- The block index of every head at the start of interval `i` under the schedule `σ`, when every +head starts in block `0`: the sum of the entries of `σ` for the intervals before `i`. -/ +@[expose] def scheduleBlock (σ : Schedule k q) : ℕ → Option (Fin k) → ℤ + | 0 => fun _ => 0 + | i + 1 => fun head => scheduleBlock σ i head + if hi : i < q then (σ ⟨i, hi⟩ head : ℤ) else 0 + +@[simp] theorem scheduleBlock_zero (σ : Schedule k q) : scheduleBlock σ 0 = fun _ => 0 := rfl + +theorem scheduleBlock_succ (σ : Schedule k q) {i : ℕ} (hi : i < q) (head : Option (Fin k)) : + scheduleBlock σ (i + 1) head = scheduleBlock σ i head + (σ ⟨i, hi⟩ head : ℤ) := by + simp only [scheduleBlock, dite_eq_left hi] + +/-- **A run following `σ` has the block indices of `σ`.** If the run replaying `coins` from the +start has schedule entries `σ j` for the intervals `j < i`, it starts interval `i` with the block +indices `scheduleBlock σ i`. -/ +theorem blockIndex_intervalStart_eq_scheduleBlock (machine : MultiTapePTM k Bool State) + {input : List Bool} (b : ℕ) [NeZero b] (coins : List Bool) (σ : Schedule k q) {i : ℕ} + (hi : i ≤ q) + (hσ : ∀ j : Fin q, j.val < i → + machine.schedule b q coins (Cfg.init machine.initial input) j = σ j) : + (machine.intervalStart b coins (Cfg.init machine.initial input) i).blockIndex b = + scheduleBlock σ i := by + induction i with + | zero => + funext head + rw [intervalStart_zero, Cfg.blockIndex, Cfg.headPos_init, Int.zero_ediv] + rfl + | succ i ih => + funext head + have hiq : i < q := by omega + have hstep := machine.coe_schedule (Nat.pos_of_neZero b) q coins + (Cfg.init machine.initial input) ⟨i, hiq⟩ head + rw [hσ ⟨i, hiq⟩ (by simp)] at hstep + have hprev := congrFun (ih (by omega) fun j hj => hσ j (by omega)) head + simp only [Cfg.blockIndex] at hprev ⊢ + rw [scheduleBlock_succ σ hiq] + simp only at hstep + omega + +/-! ### Appearances of a block in windows -/ + +/-- The first index after `i` satisfying `p`, if any. -/ +private def firstAfter (p : Fin q → Prop) [DecidablePred p] (i : Fin q) : Option (Fin q) := + if h : (Finset.univ.filter fun i' => i < i' ∧ p i').Nonempty then + some ((Finset.univ.filter fun i' => i < i' ∧ p i').min' h) + else none + +/-- The last index before `i` satisfying `p`, if any. -/ +private def lastBefore (p : Fin q → Prop) [DecidablePred p] (i : Fin q) : Option (Fin q) := + if h : (Finset.univ.filter fun i' => i' < i ∧ p i').Nonempty then + some ((Finset.univ.filter fun i' => i' < i ∧ p i').max' h) + else none + +private theorem firstAfter_eq_some_iff {p : Fin q → Prop} [DecidablePred p] {i i' : Fin q} : + firstAfter p i = some i' ↔ i < i' ∧ p i' ∧ ∀ j, i < j → j < i' → ¬ p j := by + unfold firstAfter + split_ifs with h + · rw [Option.some_inj] + constructor + · rintro rfl + have hmem := Finset.mem_filter.mp (Finset.min'_mem _ h) + refine ⟨hmem.2.1, hmem.2.2, fun j hj hjlt hpj => ?_⟩ + exact absurd (Finset.min'_le _ j (by simp [hj, hpj])) (not_le.mpr hjlt) + · rintro ⟨hlt, hp, hmin⟩ + refine le_antisymm (Finset.min'_le _ _ (by simp [hlt, hp])) ?_ + have hmem := Finset.mem_filter.mp (Finset.min'_mem _ h) + by_contra hcon + exact hmin _ hmem.2.1 (not_le.mp hcon) hmem.2.2 + · simp only [false_iff] + rintro ⟨hlt, hp, -⟩ + exact h ⟨i', by simp [hlt, hp]⟩ + +private theorem lastBefore_eq_some_iff {p : Fin q → Prop} [DecidablePred p] {i i' : Fin q} : + lastBefore p i = some i' ↔ i' < i ∧ p i' ∧ ∀ j, i' < j → j < i → ¬ p j := by + unfold lastBefore + split_ifs with h + · rw [Option.some_inj] + constructor + · rintro rfl + have hmem := Finset.mem_filter.mp (Finset.max'_mem _ h) + refine ⟨hmem.2.1, hmem.2.2, fun j hj hjlt hpj => ?_⟩ + exact absurd (Finset.le_max' _ j (by simp [hjlt, hpj])) (not_le.mpr hj) + · rintro ⟨hlt, hp, hmax⟩ + refine le_antisymm ?_ (Finset.le_max' _ _ (by simp [hlt, hp])) + have hmem := Finset.mem_filter.mp (Finset.max'_mem _ h) + by_contra hcon + exact hmax _ (not_le.mp hcon) hmem.2.1 hmem.2.2 + · simp only [false_iff] + rintro ⟨hlt, hp, -⟩ + exact h ⟨i', by simp [hlt, hp]⟩ + +private theorem lastBefore_eq_none_iff {p : Fin q → Prop} [DecidablePred p] {i : Fin q} : + lastBefore p i = none ↔ ∀ j, j < i → ¬ p j := by + unfold lastBefore + split_ifs with h + · simp only [false_iff, not_forall, not_not] + obtain ⟨j, hj⟩ := h + exact ⟨j, (Finset.mem_filter.mp hj).2.1, (Finset.mem_filter.mp hj).2.2⟩ + · simp only [true_iff] + intro j hj hp + exact h ⟨j, by simp [hj, hp]⟩ + +/-- Consecutive appearances: the last appearance before `i` has `i` as its next appearance. -/ +private theorem firstAfter_of_lastBefore {p : Fin q → Prop} [DecidablePred p] {i i' : Fin q} + (hi : p i) (h : lastBefore p i = some i') : firstAfter p i' = some i := by + obtain ⟨hlt, -, hbetween⟩ := lastBefore_eq_some_iff.mp h + exact firstAfter_eq_some_iff.mpr ⟨hlt, hi, hbetween⟩ + +private theorem lastBefore_of_firstAfter {p : Fin q → Prop} [DecidablePred p] {i i' : Fin q} + (hi' : p i') (h : firstAfter p i' = some i) : lastBefore p i = some i' := by + obtain ⟨hlt, -, hbetween⟩ := firstAfter_eq_some_iff.mp h + exact lastBefore_eq_some_iff.mpr ⟨hlt, hi', hbetween⟩ + +/-- Block `j` of work tape `h` lies in the window of interval `i` under `σ`. -/ +abbrev InWindow (σ : Schedule k q) (h : Fin k) (j : ℤ) (i : Fin q) : Prop := + |scheduleBlock σ i (some h) - j| ≤ 1 + +/-- The block of the window entry `d` of work tape `h` in interval `i`. -/ +@[expose] def portBlock (σ : Schedule k q) (i : Fin q) (h : Fin k) (d : Fin 3) : ℤ := + scheduleBlock σ i (some h) + d - 1 + +/-- The window entry of block `j` of work tape `h` in interval `i`. -/ +@[expose] def portOf (σ : Schedule k q) (i : Fin q) (h : Fin k) (j : ℤ) : Fin 3 := + ⟨(j - scheduleBlock σ i (some h) + 1).toNat % 3, Nat.mod_lt _ (by norm_num)⟩ + +theorem portBlock_portOf {σ : Schedule k q} {i : Fin q} {h : Fin k} {j : ℤ} + (hj : InWindow σ h j i) : portBlock σ i h (portOf σ i h j) = j := by + simp only [InWindow, abs_le] at hj + simp only [portBlock, portOf] + omega + +theorem inWindow_portBlock (σ : Schedule k q) (i : Fin q) (h : Fin k) (d : Fin 3) : + InWindow σ h (portBlock σ i h d) i := by + have := d.isLt + simp only [InWindow, portBlock, abs_le] + omega + +/-! ### The network -/ + +/-- The edges of a block-counting network of `q` intervals: `.inl i` carries the control record +leaving interval `i`, and `.inr (i, h, d)` the contents of window entry `d` of work tape `h` +leaving interval `i`. -/ +abbrev BlockEdge (k q : ℕ) := Fin q ⊕ (Fin q × Fin k × Fin 3) + +/-- The letters on the edges: a control record or the contents of a block. -/ +abbrev BlockLetter (k : ℕ) (State : Type) (b : ℕ) := + BlockControl k State b ⊕ (ZMod b → Option Bool) + +variable {b : ℕ} + +/-- The control record of a letter, or a default for block contents. -/ +@[expose] def BlockLetter.control : BlockLetter k State b → BlockControl k State b + | .inl c => c + | .inr _ => (none, 0, .empty) + +/-- The block contents of a letter, or blank for a control record. -/ +@[expose] def BlockLetter.contents : BlockLetter k State b → ZMod b → Option Bool + | .inl _ => fun _ => none + | .inr w => w + +/-- The weight of the last control record: one when its output track is `accept`. -/ +@[expose] def acceptWeight : BlockLetter k State b → ℕ + | .inl c => if c.2.2 = .accept then 1 else 0 + | .inr _ => 0 + +variable (machine : MultiTapePTM k Bool State) (input : List Bool) (b : ℕ) [NeZero b] + (σ : Schedule k q) + +/-- The control record entering interval `i`: the initial record for `i = 0`, and otherwise the +letter on the control edge leaving interval `i - 1`. -/ +@[expose] def inControl (i : Fin q) (x : BlockEdge k q → BlockLetter k State b) : + BlockControl k State b := + if hi : i.val = 0 then (some machine.initial, 0, .empty) + else (x (.inl ⟨i - 1, by omega⟩)).control + +variable {b} in +/-- The window contents entering interval `i`: each block is read from the edge leaving the +previous interval whose window contains it, and is blank if there is none. -/ +def inWindow (i : Fin q) (x : BlockEdge k q → BlockLetter k State b) : + Fin k → Fin 3 → ZMod b → Option Bool := fun h d => + (lastBefore (InWindow σ h (portBlock σ i h d)) i).elim (fun _ => none) fun i' => + (x (.inr (i', h, portOf σ i' h (portBlock σ i h d)))).contents + +/-- The edge condition at interval `i` for the bits `u`: an interval step from the entering +record and window to the letters on the edges leaving `i`, which must be of the right kinds, +moving the blocks as `σ i` prescribes. -/ +def IntervalHolds (i : Fin q) (x : BlockEdge k q → BlockLetter k State b) (u : Fin b → Bool) : + Prop := + ∃ cOut wOut, machine.IntervalStep b input (scheduleBlock σ i) (σ i) + (machine.inControl b i x) (inWindow σ i x) (List.ofFn u) cOut wOut ∧ + x (.inl i) = .inl cOut ∧ ∀ h d, x (.inr (i, h, d)) = .inr (wOut h d) + +/-- The target of an edge: the interval reading it next, or its sink. -/ +def edgeTarget : BlockEdge k q → Fin q ⊕ BlockEdge k q + | .inl i => if hi : i.val + 1 < q then .inl ⟨i + 1, hi⟩ else .inr (.inl i) + | .inr (i, h, d) => + (firstAfter (InWindow σ h (portBlock σ i h d)) i).elim (.inr (.inr (i, h, d))) .inl + +/-- The interval `i ≠ 0` reads the control edge of interval `i - 1`. -/ +private theorem edgeTarget_inl_pred {i : Fin q} (hi : i.val ≠ 0) : + edgeTarget σ (.inl ⟨i - 1, by omega⟩) = .inl i := by + simp only [edgeTarget] + rw [dite_eq_left (by omega)] + congr 1 + ext + simp only + omega + +/-- Interval `i` reads the block edges of the previous appearances of its window blocks. -/ +private theorem edgeTarget_inWindow {i i' : Fin q} {h : Fin k} {d : Fin 3} + (hi' : lastBefore (InWindow σ h (portBlock σ i h d)) i = some i') : + edgeTarget σ (.inr (i', h, portOf σ i' h (portBlock σ i h d))) = .inl i := by + have hin : InWindow σ h (portBlock σ i h d) i' := (lastBefore_eq_some_iff.mp hi').2.1 + simp only [edgeTarget, portBlock_portOf hin, + firstAfter_of_lastBefore (inWindow_portBlock σ i h d) hi', Option.elim_some] + +omit [NeZero b] in +/-- Interval `i` only reads the edges at it. -/ +private theorem intervalHolds_congr {i : Fin q} {x y : BlockEdge k q → BlockLetter k State b} + (hxy : ∀ e, Sum.inl i = edgeTarget σ e ∨ e.elim id Prod.fst = i → x e = y e) + (u : Fin b → Bool) : + machine.IntervalHolds input b σ i x u ↔ machine.IntervalHolds input b σ i y u := by + have hcontrol : machine.inControl b i x = machine.inControl b i y := by + unfold inControl + split_ifs with hi + · rfl + · rw [hxy _ (Or.inl (edgeTarget_inl_pred σ hi).symm)] + have hwindow : inWindow σ i x = inWindow σ i y := by + funext h d + unfold inWindow + cases hlast : lastBefore (InWindow σ h (portBlock σ i h d)) i with + | none => rfl + | some i' => + simp only [Option.elim_some] + rw [hxy _ (Or.inl (edgeTarget_inWindow σ hlast).symm)] + have hctrl : x (.inl i) = y (.inl i) := hxy _ (Or.inr rfl) + have hblock : ∀ h d, x (.inr (i, h, d)) = y (.inr (i, h, d)) := fun h d => hxy _ (Or.inr rfl) + simp only [IntervalHolds, hcontrol, hwindow, hctrl, hblock] + +open scoped Classical in +/-- **The block-counting network** of the schedule `σ`. It has a vertex for every interval +(`.inl i`) and a sink for every edge (`.inr e`). Every edge `e` leaves its interval and ends at +`edgeTarget σ e`. The tensor of interval `i` counts the bit strings `u ∈ {0,1}^b` for which +`IntervalHolds` holds; the sink of the last control edge requires the output track `accept`, and +every other sink is `1`. -/ +noncomputable def blockNetwork : + TensorNetwork ℕ (BlockLetter k State b) (Fin q ⊕ BlockEdge k q) (BlockEdge k q) where + src e := .inl (e.elim id Prod.fst) + tgt := edgeTarget σ + tensor + | .inl i, x => (Finset.univ.filter fun u => machine.IntervalHolds input b σ i x u).card + | .inr (.inl i), x => if i.val + 1 = q then acceptWeight (x (.inl i)) else 1 + | .inr (.inr _), _ => 1 + tensor_congr := by + rintro (i | (i | e)) x y h + · simp only + congr 1 + ext u + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + refine machine.intervalHolds_congr input b σ (fun e he => h e ?_) u + rcases he with he | he + · exact Or.inr he.symm + · exact Or.inl (congrArg Sum.inl he) + · simp only + split_ifs with hi + · rw [h (.inl i) (Or.inr ?_)] + simp only [edgeTarget] + rw [dite_eq_right (by omega)] + · rfl + · rfl + +/-! ### The counting identity -/ + +section Identity + +variable {machine input b σ} + +/-- The configuration of the run replaying `y` from the start at the start of interval `i`. -/ +private noncomputable abbrev trueRun (machine : MultiTapePTM k Bool State) (input : List Bool) + (b : ℕ) (y : Fin (q * b) → Bool) (i : ℕ) : Cfg k Bool State input := + machine.intervalStart b (List.ofFn y) (Cfg.init machine.initial input) i + +/-- The interval bits of a choice string: `y` split into `q` strings of `b` bits. -/ +private def intervalBits : (Fin (q * b) → Bool) ≃ (Fin q → Fin b → Bool) := + (finProdFinEquiv.arrowCongr (Equiv.refl Bool)).symm.trans (Equiv.curry _ _ _) + +omit [NeZero b] in +private theorem intervalBits_apply (y : Fin (q * b) → Bool) (i : Fin q) : + intervalBits y i = fun r => y (finProdFinEquiv (i, r)) := rfl + +/-- The letters of the true run: the control records and window contents at the end of every +interval. -/ +private noncomputable def trueLetters (machine : MultiTapePTM k Bool State) (input : List Bool) + (σ : Schedule k q) (y : Fin (q * b) → Bool) : BlockEdge k q → BlockLetter k State b + | .inl i => .inl ((trueRun machine input b y (i + 1)).blockControl b) + | .inr (i, h, d) => + .inr ((trueRun machine input b y (i + 1)).windowContents b + (scheduleBlock σ i) h d) + +/-- `x` agrees with the true run on the edges leaving the intervals before `i`, and the run +follows `σ` there. -/ +private def AgreesBefore (machine : MultiTapePTM k Bool State) (input : List Bool) + (σ : Schedule k q) (y : Fin (q * b) → Bool) (x : BlockEdge k q → BlockLetter k State b) + (i : ℕ) : Prop := + ∀ j : Fin q, j.val < i → + machine.schedule b q (List.ofFn y) (Cfg.init machine.initial input) j = σ j ∧ + x (.inl j) = trueLetters machine input σ y (.inl j) ∧ + ∀ h d, x (.inr (j, h, d)) = trueLetters machine input σ y (.inr (j, h, d)) + +omit [NeZero b] in +/-- The control record of the start configuration. -/ +private theorem blockControl_init (q₀ : State) : + (Cfg.init q₀ input : Cfg k Bool State input).blockControl b = (some q₀, 0, .empty) := by + have h : ∀ head, ((Cfg.init q₀ input : Cfg k Bool State input).headPos head : ZMod b) = 0 := + fun head => by rw [Cfg.headPos_init, Int.cast_zero] + rw [Cfg.blockControl, funext h] + rfl + +/-- A work-tape cell of a block outside the window of a configuration is outside its three +blocks. -/ +private theorem notMem_blockWindow {c : Cfg k Bool State input} {h : Fin k} {j : ℤ} + (hj : ¬ |c.blockIndex b (some h) - j| ≤ 1) (r : ZMod b) : + b * j + (r.val : ℤ) ∉ c.blockWindow b h := by + have hb : (0 : ℤ) < b := by exact_mod_cast Nat.pos_of_neZero b + have hr : (r.val : ℤ) < b := by exact_mod_cast ZMod.val_lt r + have hr0 : (0 : ℤ) ≤ r.val := by positivity + simp only [Cfg.blockIndex, Cfg.headPos_some, abs_le, not_and_or, not_le] at hj + simp only [Cfg.blockWindow, Set.mem_Ico, not_and_or, not_le, not_lt] + rcases hj with hj | hj + · right + nlinarith + · left + nlinarith + +/-- **The entering view is the true one.** If `x` agrees with the true run before interval `i`, +then interval `i` reads the true control record and window contents, at the true block +indices. -/ +private theorem inView_eq (y : Fin (q * b) → Bool) {x : BlockEdge k q → BlockLetter k State b} + {i : Fin q} (hx : AgreesBefore machine input σ y x i) : + scheduleBlock σ i = (trueRun machine input b y i).blockIndex b ∧ + machine.inControl b i x = (trueRun machine input b y i).blockControl b ∧ + inWindow σ i x = (trueRun machine input b y i).windowContents b + (scheduleBlock σ i) := by + have hindex : ∀ i' : ℕ, i' ≤ i → + (trueRun machine input b y i').blockIndex b = scheduleBlock σ i' := + fun i' hi' => machine.blockIndex_intervalStart_eq_scheduleBlock b _ σ (by omega) + fun j hj => (hx j (by omega)).1 + refine ⟨(hindex i le_rfl).symm, ?_, ?_⟩ + · -- The control record. + unfold inControl + split_ifs with hi + · have : (i : ℕ) = 0 := hi + rw [trueRun, this, intervalStart_zero, blockControl_init] + · rw [(hx ⟨i - 1, by omega⟩ (by simp; omega)).2.1] + simp only [trueLetters, BlockLetter.control] + congr 3 + omega + · -- The window contents: the last appearance before `i`, untouched since. + funext h d r + set j := portBlock σ i h d + have huntouched : ∀ i₁ : ℕ, i₁ ≤ i → (∀ i'' : Fin q, i₁ ≤ i'' → i'' < i → + ¬ InWindow σ h j i'') → + (trueRun machine input b y i).workTapes h (b * j + r.val) = + (trueRun machine input b y i₁).workTapes h (b * j + r.val) := by + intro i₁ hi₁ hnot + refine machine.workTapes_intervalStart_eq_of_notMem_blockWindow (Nat.pos_of_neZero b) + _ _ hi₁ fun i'' hi'' hi''i => notMem_blockWindow ?_ r + rw [hindex i'' hi''i.le] + exact hnot ⟨i'', by omega⟩ hi'' hi''i + change (inWindow σ i x h d) r = (trueRun machine input b y i).workTapes h (b * j + r.val) + unfold inWindow + cases hlast : lastBefore (InWindow σ h j) i with + | none => + simp only [Option.elim_none] + rw [huntouched 0 (Nat.zero_le _) fun i'' _ hi'' => + lastBefore_eq_none_iff.mp hlast i'' hi'', trueRun, intervalStart_zero] + rfl + | some i' => + obtain ⟨hlt, hin, hbetween⟩ := lastBefore_eq_some_iff.mp hlast + simp only [Option.elim_some] + rw [(hx i' hlt).2.2, huntouched (i' + 1) hlt fun i'' h₁ h₂ => hbetween i'' h₁ h₂] + change (trueRun machine input b y (i' + 1)).workTapes h + (b * portBlock σ i' h (portOf σ i' h j) + r.val) = _ + rw [portBlock_portOf hin] + +/-- `SignType` casts to `ℤ` injectively. -/ +private theorem signType_cast_inj {s t : SignType} (h : (s : ℤ) = t) : s = t := by + cases s <;> cases t <;> first | rfl | (simp at h) + +/-- **The condition at an interval, on the true view.** If interval `i` reads the true view, its +condition holds exactly when the letters it leaves are the true ones and the run follows +`σ i`. -/ +private theorem intervalHolds_iff (y : Fin (q * b) → Bool) + {x : BlockEdge k q → BlockLetter k State b} {i : Fin q} + (hindex : scheduleBlock σ i = (trueRun machine input b y i).blockIndex b) + (hcontrol : machine.inControl b i x = + (trueRun machine input b y i).blockControl b) + (hwindow : inWindow σ i x = (trueRun machine input b y i).windowContents b + (scheduleBlock σ i)) : + machine.IntervalHolds input b σ i x (fun r => y (finProdFinEquiv (i, r))) ↔ + machine.schedule b q (List.ofFn y) (Cfg.init machine.initial input) i = σ i ∧ + x (.inl i) = trueLetters machine input σ y (.inl i) ∧ + ∀ h d, x (.inr (i, h, d)) = trueLetters machine input σ y (.inr (i, h, d)) := by + have hnext := machine.intervalStart_succ_ofFn y (Cfg.init machine.initial input) i + rw [IntervalHolds, hcontrol, hwindow, hindex] + simp only [machine.intervalStep_view_iff b _ (List.length_ofFn (f := _)).le] + rw [← hnext] + have hsched : machine.schedule b q (List.ofFn y) (Cfg.init machine.initial input) i = σ i ↔ + ∀ head, (trueRun machine input b y (i + 1)).blockIndex b head = + (trueRun machine input b y i).blockIndex b head + σ i head := by + rw [funext_iff] + refine forall_congr' fun head => ?_ + have := machine.coe_schedule (Nat.pos_of_neZero b) q (List.ofFn y) + (Cfg.init machine.initial input) i head + simp only [Cfg.blockIndex, trueRun] + constructor + · intro h + rw [← h] + omega + · intro h + exact signType_cast_inj (by omega) + simp only [trueLetters, ← hindex, hsched] + constructor + · rintro ⟨cOut, wOut, ⟨rfl, rfl, hmove⟩, hc, hw⟩ + exact ⟨hmove, hc, hw⟩ + · rintro ⟨hmove, hc, hw⟩ + exact ⟨_, _, ⟨rfl, rfl, hmove⟩, hc, hw⟩ + +/-- Satisfying the conditions of all intervals forces agreement with the true run. -/ +private theorem agreesBefore_of_forall (y : Fin (q * b) → Bool) + {x : BlockEdge k q → BlockLetter k State b} + (hx : ∀ i : Fin q, machine.IntervalHolds input b σ i x (intervalBits y i)) : + ∀ i ≤ q, AgreesBefore machine input σ y x i := by + intro i hi + induction i with + | zero => exact fun j hj => absurd hj (Nat.not_lt_zero _) + | succ i ih => + have hprev := ih (by omega) + intro j hj + rcases Nat.lt_succ_iff_lt_or_eq.mp hj with hj | hj + · exact hprev j hj + · obtain ⟨hindex, hcontrol, hwindow⟩ := inView_eq y (i := j) (fun j' hj' => hprev j' (by omega)) + exact (intervalHolds_iff y hindex hcontrol hwindow).mp (hx j) + +/-- The true letters satisfy all interval conditions exactly when the run follows `σ`. -/ +private theorem forall_intervalHolds_trueLetters_iff (y : Fin (q * b) → Bool) : + (∀ i : Fin q, machine.IntervalHolds input b σ i (trueLetters machine input σ y) + (intervalBits y i)) ↔ + machine.schedule b q (List.ofFn y) (Cfg.init machine.initial input) = σ := by + constructor + · intro h + funext j + exact (agreesBefore_of_forall y h q le_rfl j j.isLt).1 + · intro hσ i + have hagree : AgreesBefore machine input σ y (trueLetters machine input σ y) i := + fun j _ => ⟨congrFun hσ j, rfl, fun _ _ => rfl⟩ + obtain ⟨hindex, hcontrol, hwindow⟩ := inView_eq y hagree + exact (intervalHolds_iff y hindex hcontrol hwindow).mpr ⟨congrFun hσ i, rfl, fun _ _ => rfl⟩ + +omit [NeZero b] in +/-- The run replaying `q * b` bits ends at the start of interval `q`. -/ +private theorem runClosedCoins_eq (y : Fin (q * b) → Bool) : + machine.runClosedCoins (List.ofFn y) input = + (trueRun machine input b y q).output := by + rw [runClosedCoins_eq_output_stepCoins, trueRun, intervalStart, + List.take_of_length_le (by simp)] + +omit [NeZero b] in +/-- Agreeing with the true run before every interval is being the true letters. -/ +private theorem eq_trueLetters_of_agreesBefore (y : Fin (q * b) → Bool) + {x : BlockEdge k q → BlockLetter k State b} (hx : AgreesBefore machine input σ y x q) : + x = trueLetters machine input σ y := by + funext e + rcases e with j | ⟨j, h, d⟩ + · exact (hx j j.isLt).2.1 + · exact (hx j j.isLt).2.2 h d + + +end Identity + +omit [NeZero b] in +/-- The sinks contribute the acceptance check of the last control edge. -/ +private theorem prod_sinks (hq : 0 < q) (x : BlockEdge k q → BlockLetter k State b) : + ∏ e : BlockEdge k q, (machine.blockNetwork input b σ).tensor (.inr e) x = + acceptWeight (x (.inl ⟨q - 1, by omega⟩)) := by + rw [Fintype.prod_sum_type] + have hblock : ∏ e : Fin q × Fin k × Fin 3, + (machine.blockNetwork input b σ).tensor (.inr (.inr e)) x = 1 := + Finset.prod_eq_one fun _ _ => rfl + rw [hblock, mul_one] + rw [Finset.prod_eq_single (⟨q - 1, by omega⟩ : Fin q)] + · change (if q - 1 + 1 = q then _ else 1) = _ + rw [ite_eq_left (by omega)] + · intro i _ hi + change (if i.val + 1 = q then _ else 1) = 1 + rw [ite_eq_right fun h => hi (Fin.ext (by simp only; omega))] + · exact fun h => absurd (Finset.mem_univ _) h + +omit [NeZero b] in +open scoped Classical in +/-- The interval tensors expanded as a sum over the bits of all intervals. -/ +private theorem prod_intervals (x : BlockEdge k q → BlockLetter k State b) : + ∏ i : Fin q, (machine.blockNetwork input b σ).tensor (.inl i) x = + ∑ u : Fin q → Fin b → Bool, + if ∀ i, machine.IntervalHolds input b σ i x (u i) then 1 else 0 := by + have hcard : ∀ i : Fin q, (machine.blockNetwork input b σ).tensor (.inl i) x = + ∑ u : Fin b → Bool, if machine.IntervalHolds input b σ i x u then 1 else 0 := by + intro i + change (Finset.univ.filter fun u => machine.IntervalHolds input b σ i x u).card = _ + rw [Finset.card_filter] + simp only [hcard] + rw [Finset.prod_univ_sum] + simp only [Fintype.piFinset_univ, Fintype.prod_boole] + exact Finset.sum_congr rfl fun u _ => by congr + +/-- **The block-counting identity for one schedule.** The contraction of the network of `σ` is the +number of choice strings of `q * b` bits on which the machine accepts and whose run has movement +schedule `σ`. -/ +theorem contraction_blockNetwork [Fintype State] (hq : 0 < q) : + (machine.blockNetwork input b σ).contraction = + (Finset.univ.filter fun y : Fin (q * b) → Bool => + machine.runClosedCoins (List.ofFn y) input = [true] ∧ + machine.schedule b q (List.ofFn y) (Cfg.init machine.initial input) = σ).card := by + classical + rw [TensorNetwork.contraction] + simp only [Fintype.prod_sum_type, machine.prod_sinks input b σ hq, prod_intervals, + Finset.sum_mul] + rw [Finset.sum_comm, ← (intervalBits (q := q) (b := b)).sum_comp, Finset.card_eq_sum_ones, + Finset.sum_filter] + refine Finset.sum_congr rfl fun y _ => ?_ + rw [Finset.sum_eq_single (trueLetters machine input σ y)] + · -- The true letters weigh one exactly when the run follows `σ` and accepts. + have hlast : trueLetters machine input σ y (.inl ⟨q - 1, by omega⟩) = + .inl ((trueRun machine input b y q).blockControl b) := by + simp only [trueLetters, Nat.sub_add_cancel hq] + by_cases hall : ∀ i : Fin q, + machine.IntervalHolds input b σ i (trueLetters machine input σ y) (intervalBits y i) + · have hσ' := (forall_intervalHolds_trueLetters_iff y).mp hall + rw [ite_eq_left hall, one_mul, hlast, acceptWeight] + refine if_congr ?_ rfl rfl + rw [Cfg.blockControl, OutputTrack.ofWord_eq_accept_iff, runClosedCoins_eq, hσ'] + exact (and_iff_left rfl).symm + · have hσ' := fun h => hall ((forall_intervalHolds_trueLetters_iff y).mpr h) + rw [ite_eq_right hall, zero_mul] + exact (ite_eq_right fun h => hσ' h.2).symm + · -- Any other assignment violates some interval condition. + intro x _ hx + rw [ite_eq_right fun hall => + hx (eq_trueLetters_of_agreesBefore y (agreesBefore_of_forall y hall q le_rfl)), zero_mul] + · exact fun h => absurd (Finset.mem_univ _) h + +/-- **The block-counting identity** (the note's Lemma 2.2, equation (2)). Summed over the +movement schedules of `q > 0` intervals of `b` bits, the contractions of the block-counting +networks are the accepting count on `q * b` bits. -/ +theorem sum_contraction_blockNetwork [Fintype State] (hq : 0 < q) : + ∑ σ : Schedule k q, (machine.blockNetwork input b σ).contraction = + machine.acceptCount input (q * b) := by + rw [machine.acceptCount_eq_sum_card_schedule input b q] + exact Finset.sum_congr rfl fun σ _ => machine.contraction_blockNetwork input b σ hq + +/-! ### Size, degree and entries -/ + +/-- A block-counting network has `q * (3 * k + 1)` edges: one control edge and three block edges +per work tape for each interval. -/ +theorem card_blockEdge : Fintype.card (BlockEdge k q) = q * (3 * k + 1) := by + simp only [Fintype.card_sum, Fintype.card_prod, Fintype.card_fin] + ring + +/-- A block-counting network has `q * (3 * k + 2)` vertices: the intervals and the sinks. -/ +theorem card_blockVertex : Fintype.card (Fin q ⊕ BlockEdge k q) = q * (3 * k + 2) := by + rw [Fintype.card_sum, card_blockEdge, Fintype.card_fin] + ring + +omit [NeZero b] in +/-- Every entry of a block-counting network is at most `2 ^ b`: an interval tensor counts bit +strings of length `b`, and a sink is `0` or `1`. -/ +theorem tensor_blockNetwork_le (v : Fin q ⊕ BlockEdge k q) + (x : BlockEdge k q → BlockLetter k State b) : + (machine.blockNetwork input b σ).tensor v x ≤ 2 ^ b := by + classical + have hone : (1 : ℕ) ≤ 2 ^ b := Nat.one_le_two_pow + rcases v with i | i | e + · change (Finset.univ.filter fun u => machine.IntervalHolds input b σ i x u).card ≤ 2 ^ b + exact (Finset.card_filter_le _ _).trans (by simp) + · change (if i.val + 1 = q then acceptWeight (x (.inl i)) else 1) ≤ 2 ^ b + split_ifs + · rcases x (.inl i) with c | w + · simp only [acceptWeight] + split_ifs <;> omega + · exact Nat.zero_le _ + · exact hone + · exact hone + +omit [NeZero b] in +/-- The source of an edge is its interval. -/ +private theorem blockNetwork_src (e : BlockEdge k q) : + (machine.blockNetwork input b σ).src e = .inl (e.elim id Prod.fst) := rfl + +omit [NeZero b] in +private theorem blockNetwork_tgt (e : BlockEdge k q) : + (machine.blockNetwork input b σ).tgt e = edgeTarget σ e := rfl + +omit [NeZero b] in +/-- Every edge goes forward in time, from its interval to a later interval or to a sink. -/ +private theorem edgeTarget_eq_inl {e : BlockEdge k q} {i : Fin q} + (h : edgeTarget σ e = .inl i) : e.elim id Prod.fst < i := by + rcases e with i' | ⟨i', hd, d⟩ + · simp only [edgeTarget] at h + split_ifs at h with hi + · cases h + simp only [Sum.elim_inl, id_eq, Fin.lt_def] + omega + · simp only [edgeTarget] at h + cases hf : firstAfter (InWindow σ hd (portBlock σ i' hd d)) i' with + | none => simp [hf] at h + | some i'' => + simp only [hf, Option.elim_some, Sum.inl.injEq] at h + subst h + exact (firstAfter_eq_some_iff.mp hf).1 + +omit [NeZero b] in +/-- A block-counting network has no loops. -/ +theorem loopless_blockNetwork : (machine.blockNetwork input b σ).Loopless := by + intro e he + rw [blockNetwork_src, blockNetwork_tgt] at he + exact (edgeTarget_eq_inl σ he.symm).ne rfl + +omit [NeZero b] in +/-- The edges into interval `i` are its entering control edge and one block edge for each window +entry it reads. -/ +private theorem injOn_inEdges (i : Fin q) : + Set.InjOn (fun e : BlockEdge k q => e.elim (fun _ => (none : Option (Fin k × Fin 3))) + fun p => some (p.2.1, portOf σ i p.2.1 (portBlock σ p.1 p.2.1 p.2.2))) + {e | edgeTarget σ e = .inl i} := by + rintro (i₁ | ⟨i₁, h₁, d₁⟩) he₁ (i₂ | ⟨i₂, h₂, d₂⟩) he₂ heq + · -- Two control edges into `i` both leave `i - 1`. + simp only [Set.mem_ofPred_eq, edgeTarget] at he₁ he₂ + split_ifs at he₁ he₂ + cases he₁ + simp only [Sum.inl.injEq, Fin.mk.injEq] at he₂ + congr 1 + exact Fin.ext (by omega) + · simp at heq + · simp at heq + · simp only [Option.some.injEq, Prod.mk.injEq, Sum.elim_inr] at heq + obtain ⟨rfl, hport⟩ := heq + simp only [Set.mem_ofPred_eq, edgeTarget] at he₁ he₂ + -- Both are previous appearances of the same block, read at the same window entry of `i`. + have hf : ∀ {i' : Fin q} {d' : Fin 3}, + (firstAfter (InWindow σ h₁ (portBlock σ i' h₁ d')) i').elim + (Sum.inr (Sum.inr (i', h₁, d'))) Sum.inl = (Sum.inl i : Fin q ⊕ BlockEdge k q) → + firstAfter (InWindow σ h₁ (portBlock σ i' h₁ d')) i' = some i := by + intro i' d' h + cases hc : firstAfter (InWindow σ h₁ (portBlock σ i' h₁ d')) i' with + | none => simp [hc] at h + | some i'' => simp only [hc, Option.elim_some, Sum.inl.injEq] at h; rw [h] + have hf₁ := hf he₁ + have hf₂ := hf he₂ + have hw₁ := (firstAfter_eq_some_iff.mp hf₁).2.1 + have hw₂ := (firstAfter_eq_some_iff.mp hf₂).2.1 + have hj : portBlock σ i₁ h₁ d₁ = portBlock σ i₂ h₁ d₂ := by + rw [← portBlock_portOf hw₁, ← portBlock_portOf hw₂, hport] + have hl₁ := lastBefore_of_firstAfter (inWindow_portBlock σ i₁ h₁ d₁) hf₁ + have hl₂ := lastBefore_of_firstAfter (inWindow_portBlock σ i₂ h₁ d₂) hf₂ + rw [hj] at hl₁ + have hi : i₁ = i₂ := Option.some.inj (hl₁.symm.trans hl₂) + subst hi + have hd : d₁ = d₂ := by + simp only [portBlock] at hj + exact Fin.ext (by omega) + rw [hd] + +omit [NeZero b] in +/-- **The degree bound.** An interval has its `3 k + 1` leaving edges and at most `3 k + 1` +entering edges, and a sink has at most one edge. -/ +theorem maxDegreeLE_blockNetwork : + (machine.blockNetwork input b σ).MaxDegreeLE (2 * (3 * k + 1)) := by + classical + rintro (i | e) + · have hsplit : (machine.blockNetwork input b σ).incidenceSet (.inl i) ⊆ + {e | e.elim id Prod.fst = i} ∪ {e | edgeTarget σ e = .inl i} := by + rintro e (he | he) + · left + rw [blockNetwork_src] at he + exact Sum.inl_injective he + · right + exact he + have hout : {e : BlockEdge k q | e.elim id Prod.fst = i}.ncard ≤ 3 * k + 1 := by + calc {e : BlockEdge k q | e.elim id Prod.fst = i}.ncard + ≤ (Set.range (Sum.elim (fun _ : Unit => (Sum.inl i : BlockEdge k q)) + fun p : Fin k × Fin 3 => Sum.inr (i, p))).ncard := by + refine Set.ncard_le_ncard ?_ (Set.toFinite _) + rintro (i' | ⟨i', h, d⟩) he + · simp only [Set.mem_ofPred_eq, Sum.elim_inl, id_eq] at he + exact ⟨.inl (), by simp [he]⟩ + · simp only [Set.mem_ofPred_eq, Sum.elim_inr] at he + exact ⟨.inr (h, d), by simp [he]⟩ + _ = Nat.card (Unit ⊕ Fin k × Fin 3) := Set.ncard_range_of_injective (by + rintro (_ | p) (_ | p') h <;> simp_all) + _ = 3 * k + 1 := by + simp only [Nat.card_eq_fintype_card, Fintype.card_sum, Fintype.card_unit, + Fintype.card_prod, Fintype.card_fin] + ring + have hin : {e : BlockEdge k q | edgeTarget σ e = .inl i}.ncard ≤ 3 * k + 1 := by + calc {e : BlockEdge k q | edgeTarget σ e = .inl i}.ncard + ≤ (Set.univ : Set (Option (Fin k × Fin 3))).ncard := + Set.ncard_le_ncard_of_injOn _ (fun _ _ => Set.mem_univ _) (injOn_inEdges σ i) + (Set.toFinite _) + _ = 3 * k + 1 := by + rw [Set.ncard_univ, Nat.card_eq_fintype_card, Fintype.card_option, + Fintype.card_prod, Fintype.card_fin, Fintype.card_fin] + ring + calc _ ≤ ({e : BlockEdge k q | e.elim id Prod.fst = i} ∪ + {e | edgeTarget σ e = .inl i}).ncard := Set.ncard_le_ncard hsplit (Set.toFinite _) + _ ≤ _ := Set.ncard_union_le _ _ + _ ≤ 2 * (3 * k + 1) := by omega + · have hsub : (machine.blockNetwork input b σ).incidenceSet (.inr e) ⊆ {e} := by + rintro e' (he' | he') + · rw [blockNetwork_src] at he' + cases he' + · rw [blockNetwork_tgt] at he' + rcases e' with i' | ⟨i', h, d⟩ + · simp only [edgeTarget] at he' + split_ifs at he' + cases he' + rfl + · simp only [edgeTarget] at he' + cases hc : firstAfter (InWindow σ h (portBlock σ i' h d)) i' with + | none => + simp only [hc, Option.elim_none, Sum.inr.injEq] at he' + rw [he'] + rfl + | some i'' => simp [hc] at he' + calc _ ≤ ({e} : Set (BlockEdge k q)).ncard := Set.ncard_le_ncard hsub (Set.toFinite _) + _ = 1 := Set.ncard_singleton e + _ ≤ 2 * (3 * k + 1) := by omega + +end Turing.MultiTapePTM diff --git a/ComplexityTests/HPVBlockNetwork.lean b/ComplexityTests/HPVBlockNetwork.lean new file mode 100644 index 0000000000..5a91e1b268 --- /dev/null +++ b/ComplexityTests/HPVBlockNetwork.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.BlockNetwork + +/-! Block-counting networks of concrete fair-coin machines: summed over schedules, their +contractions are accepting counts computed directly. -/ + +namespace ComplexityTests.HPVBlockNetwork + +open Turing MultiTapeMachine + +/-- Emit the first coin and halt. No work tapes; the input head stays. -/ +private def emitCoin : MultiTapePTM 0 Bool Unit where + initial := () + tr _ _ _ _ bit := .step + { inputTape := 0, workTapes := Fin.elim0, output := some bit, state := none } + Empty.elim Empty.elim + +-- One interval of two bits: the strings starting with `true` accept. +example : ∑ σ : MultiTapePTM.Schedule 0 1, (emitCoin.blockNetwork [] 2 σ).contraction = 2 := by + rw [MultiTapePTM.sum_contraction_blockNetwork _ _ _ one_pos, + show emitCoin.acceptCount [] (1 * 2) = 2 by decide] + +/-- On one work tape, write every coin and move right. The first step emits its coin; then the +machine keeps walking without output. -/ +private def walk : MultiTapePTM 1 Bool Bool where + initial := false + tr state _ _ _ bit := .step + { inputTape := 1, + workTapes := fun _ => (some (some bit), 1), + output := if state then none else some bit, state := some true } + Empty.elim Empty.elim + +-- Two intervals of two bits, with windows on the work tape: half of the `16` strings accept. +example : + ∑ σ : MultiTapePTM.Schedule 1 2, (walk.blockNetwork [true] 2 σ).contraction = 8 := by + rw [MultiTapePTM.sum_contraction_blockNetwork _ _ _ two_pos, + show walk.acceptCount [true] (2 * 2) = 8 by decide] + +-- Each network has `2 * (3 + 1) = 8` edges and `2 * (3 + 2) = 10` vertices, degree at most `8`, +-- no loops, and entries at most `2 ^ 2`. +example (σ : MultiTapePTM.Schedule 1 2) : + Fintype.card (MultiTapePTM.BlockEdge 1 2) = 8 ∧ + Fintype.card (Fin 2 ⊕ MultiTapePTM.BlockEdge 1 2) = 10 ∧ + (walk.blockNetwork [true] 2 σ).MaxDegreeLE 8 ∧ (walk.blockNetwork [true] 2 σ).Loopless ∧ + ∀ v x, (walk.blockNetwork [true] 2 σ).tensor v x ≤ 4 := + ⟨MultiTapePTM.card_blockEdge, MultiTapePTM.card_blockVertex, + walk.maxDegreeLE_blockNetwork _ _ σ, walk.loopless_blockNetwork _ _ σ, + walk.tensor_blockNetwork_le _ _ σ⟩ + +end ComplexityTests.HPVBlockNetwork From 2914159380f388f8a1814dd396f6ace61bf0914d Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 19:14:17 -0400 Subject: [PATCH 09/19] feat(machines): explicit Boolean block-counting networks (#1833 H3) Write the block-counting network of a schedule out as an explicit Boolean tensor network: binarize by a concrete injective letter code of (s + k + 4) * b bits, subdivide by equality tensors, and number the old vertices first. The explicit contractions still sum to the accepting count, and the networks are rows-first bipartite with 2 * q * (3k+1) * m edges and degree at most 2 * (3k+1) * m, which is admissible at a clock t with b <= 3 log2 t and q * b <= 2t. Generic additions: ExplicitTensorNetwork.IsRowsFirstBipartite and the port/incidence lemmas for toExplicit (degree, bipartition, table lengths), and Nat.clog_two_add_two_le_three_mul_log_two. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 1 + .../Frontier/TensorNetwork/Explicit.lean | 143 ++++++- .../Probabilistic/ExplicitBlockNetwork.lean | 364 ++++++++++++++++++ Complexity/Foundations/Data/Nat/Log.lean | 11 + .../Circuit/Frontier/TensorNetwork.lean | 29 ++ ComplexityTests/HPVExplicitBlockNetwork.lean | 99 +++++ 6 files changed, 645 insertions(+), 2 deletions(-) create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork.lean create mode 100644 ComplexityTests/HPVExplicitBlockNetwork.lean diff --git a/Complexity.lean b/Complexity.lean index edb6e44788..397740fe3b 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -1811,6 +1811,7 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.C public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.CoinTape public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Composition public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Deterministic +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExtendTapes public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.InputFromTape public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalTensor diff --git a/Complexity/Computability/Circuit/Frontier/TensorNetwork/Explicit.lean b/Complexity/Computability/Circuit/Frontier/TensorNetwork/Explicit.lean index 051a95b90a..42914f7f8f 100644 --- a/Complexity/Computability/Circuit/Frontier/TensorNetwork/Explicit.lean +++ b/Complexity/Computability/Circuit/Frontier/TensorNetwork/Explicit.lean @@ -11,6 +11,7 @@ public import Complexity.Computability.Circuit.Frontier.TensorNetwork public import Complexity.Foundations.Data.BitString.Counter import Mathlib.Algebra.BigOperators.Fin import Mathlib.Data.List.GetD +import Mathlib.Data.Set.Card /-! # Explicit Boolean tensor networks @@ -30,12 +31,17 @@ reads `false`, and a position past the end of a table has entry zero. Its size measures are the number of edges, the number of vertices, the maximum number of ports of a vertex (`ExplicitTensorNetwork.maxDegree`) and the total length of the tables -(`ExplicitTensorNetwork.tableLength`). +(`ExplicitTensorNetwork.tableLength`). A network is *rows-first bipartite* with `r` rows +(`ExplicitTensorNetwork.IsRowsFirstBipartite`) when every edge is a port of exactly one of its +first `r` vertices and of exactly one of the others. **Writing a network out** (`TensorNetwork.toExplicit`). Given numberings of the vertices and the edges of a Boolean tensor network on finite types, list the edges at each vertex in increasing order and tabulate its tensor on them. The contraction is unchanged -(`TensorNetwork.contraction_toExplicit`). +(`TensorNetwork.contraction_toExplicit`). The ports of a vertex are its incident edges, so the +degree bound carries over (`TensorNetwork.maxDegree_toExplicit_le`), and a numbering that puts +one end of every edge below `r` and the other at or above it gives a rows-first bipartite network +(`TensorNetwork.isRowsFirstBipartite_toExplicit`). ## Main definitions @@ -46,6 +52,8 @@ order and tabulate its tensor on them. The contraction is unchanged * `Cslib.Circuits.Frontier.ExplicitTensorNetwork.contraction`: the contraction. * `Cslib.Circuits.Frontier.ExplicitTensorNetwork.maxDegree`, `Cslib.Circuits.Frontier.ExplicitTensorNetwork.tableLength`: size measures. +* `Cslib.Circuits.Frontier.ExplicitTensorNetwork.IsRowsFirstBipartite`: the bipartition with the + first `r` vertices as rows. * `Cslib.Circuits.Frontier.TensorNetwork.explicitPorts`, `Cslib.Circuits.Frontier.TensorNetwork.explicitTable`, `Cslib.Circuits.Frontier.TensorNetwork.toExplicit`: writing a Boolean tensor network out. @@ -57,6 +65,12 @@ order and tabulate its tensor on them. The contraction is unchanged tensor. * `Cslib.Circuits.Frontier.TensorNetwork.contraction_toExplicit`: writing a network out preserves its contraction. +* `Cslib.Circuits.Frontier.TensorNetwork.length_explicitPorts`: a vertex has one port per incident + edge. +* `Cslib.Circuits.Frontier.TensorNetwork.maxDegree_toExplicit_le`, + `Cslib.Circuits.Frontier.TensorNetwork.isRowsFirstBipartite_toExplicit`, + `Cslib.Circuits.Frontier.TensorNetwork.length_table_toExplicit`: degree, bipartition and table + lengths of a written-out network. ## References @@ -123,6 +137,18 @@ theorem length_le_maxDegree {v : List ℕ × List R} (hv : v ∈ d.vertices) : v.1.length ≤ d.maxDegree := d.maxDegree_le_iff.mp le_rfl v hv +/-- **Rows-first bipartite**: the first `r` vertices are the *rows* and the others the *columns*, +every port names an edge, and every edge is a port of the rows exactly once and of the columns +exactly once. So every edge joins a row to a column. -/ +def IsRowsFirstBipartite (r : ℕ) : Prop := + (∀ v ∈ d.vertices, ∀ i ∈ v.1, i < d.numEdges) ∧ + ∀ i < d.numEdges, ((d.vertices.take r).map fun v => v.1.count i).sum = 1 ∧ + ((d.vertices.drop r).map fun v => v.1.count i).sum = 1 + +instance (r : ℕ) : Decidable (d.IsRowsFirstBipartite r) := by + unfold IsRowsFirstBipartite + infer_instance + end ExplicitTensorNetwork /-! ### Writing a tensor network out -/ @@ -163,6 +189,40 @@ theorem entry_explicitTable [Zero R] (v : V) (x : Fin m → Bool) : rw [BitString.testBit_lsbValue, List.getD_eq_getElem _ _ (by simpa using hidx), List.getElem_map, List.getElem_idxOf hidx, Function.comp_apply] +/-- An edge is a port of a vertex at most once. -/ +theorem nodup_explicitPorts (v : V) : (N.explicitPorts ee v).Nodup := + (List.nodup_finRange m).filter _ + +/-- **The ports of a vertex are its incident edges**: their number is its degree. -/ +theorem length_explicitPorts (v : V) : + (N.explicitPorts ee v).length = (N.incidenceSet v).ncard := by + classical + rw [← List.toFinset_card_of_nodup (N.nodup_explicitPorts ee v), + ← Set.ncard_image_of_injective _ ee.injective, ← Set.ncard_coe_finset] + congr 1 + ext j + simp [Multigraph.mem_incidenceSet] + +/-- The number of times the edge numbered `j` is a port of `v`: once if it is incident to `v`, and +never otherwise. -/ +theorem count_explicitPorts (v : V) (j : Fin m) : + ((N.explicitPorts ee v).map Fin.val).count j.val = + if N.src (ee.symm j) = v ∨ N.tgt (ee.symm j) = v then 1 else 0 := by + rw [List.Nodup.count ((N.nodup_explicitPorts ee v).map Fin.val_injective)] + simp only [List.mem_map, Fin.val_inj, exists_eq_right, mem_explicitPorts] + +/-- A table lists the values of the tensor at all `2 ^ (number of ports)` lists of bits on the +ports. -/ +theorem length_explicitTable (v : V) : + (N.explicitTable ee v).length = 2 ^ (N.explicitPorts ee v).length := by + simp [explicitTable] + +/-- Every entry of a written-out table is a value of the tensor. -/ +theorem exists_tensor_of_mem_explicitTable {v : V} {a : R} (ha : a ∈ N.explicitTable ee v) : + ∃ y, a = N.tensor v y := by + obtain ⟨j, -, rfl⟩ := List.mem_map.mp ha + exact ⟨_, rfl⟩ + /-- A Boolean tensor network on finite types written out as an explicit network, numbering the vertices by `ev` and the edges by `ee`: vertex `i` is `ev.symm i`, with its ports in increasing order and its table. -/ @@ -171,6 +231,85 @@ def toExplicit : ExplicitTensorNetwork R where vertices := List.ofFn fun i => ((N.explicitPorts ee (ev.symm i)).map Fin.val, N.explicitTable ee (ev.symm i)) +/-- The vertices of the written-out network are the ports and tables of the vertices. -/ +theorem mem_vertices_toExplicit {p : List ℕ × List R} : + p ∈ (N.toExplicit ev ee).vertices ↔ + ∃ v, p = ((N.explicitPorts ee v).map Fin.val, N.explicitTable ee v) := by + simp only [toExplicit, List.mem_ofFn] + constructor + · rintro ⟨i, rfl⟩ + exact ⟨_, rfl⟩ + · rintro ⟨v, rfl⟩ + exact ⟨ev v, by simp⟩ + +/-- **The degree bound carries over**: a vertex of the written-out network has as many ports as +the vertex has incident edges. -/ +theorem maxDegree_toExplicit_le [Finite E] {D : ℕ} (hD : N.MaxDegreeLE D) : + (N.toExplicit ev ee).maxDegree ≤ D := by + rw [ExplicitTensorNetwork.maxDegree_le_iff] + intro p hp + obtain ⟨v, rfl⟩ := (N.mem_vertices_toExplicit ev ee).mp hp + rw [List.length_map, length_explicitPorts] + exact hD v + +/-- Every table of the written-out network has an entry for every list of bits on its ports. -/ +theorem length_table_toExplicit {p : List ℕ × List R} (hp : p ∈ (N.toExplicit ev ee).vertices) : + p.2.length = 2 ^ p.1.length := by + obtain ⟨v, rfl⟩ := (N.mem_vertices_toExplicit ev ee).mp hp + simp [length_explicitTable] + +/-- Every table entry of the written-out network is a value of a tensor. -/ +theorem exists_tensor_of_mem_toExplicit {p : List ℕ × List R} + (hp : p ∈ (N.toExplicit ev ee).vertices) {a : R} (ha : a ∈ p.2) : + ∃ v y, a = N.tensor v y := by + obtain ⟨v, rfl⟩ := (N.mem_vertices_toExplicit ev ee).mp hp + exact ⟨v, N.exists_tensor_of_mem_explicitTable ee ha⟩ + +private theorem sum_drop_ofFn (f : Fin n → ℕ) (r : ℕ) : + ((List.ofFn f).drop r).sum = ∑ a with ¬ a.val < r, f a := by + have h := List.sum_take_add_sum_drop (List.ofFn f) r + rw [List.sum_take_ofFn, List.sum_ofFn, + ← Finset.sum_filter_add_sum_filter_not Finset.univ (fun a : Fin n => a.val < r)] at h + omega + +/-- **Rows first.** If every edge joins a vertex numbered below `r` to one numbered at least `r`, +the written-out network is bipartite with the first `r` vertices as rows. -/ +theorem isRowsFirstBipartite_toExplicit (r : ℕ) + (hside : ∀ e, (ev (N.src e) : ℕ) < r ↔ ¬ (ev (N.tgt e) : ℕ) < r) : + (N.toExplicit ev ee).IsRowsFirstBipartite r := by + refine ⟨fun p hp i hi => ?_, fun i hi => ?_⟩ + · obtain ⟨v, rfl⟩ := (N.mem_vertices_toExplicit ev ee).mp hp + obtain ⟨j, -, rfl⟩ := List.mem_map.mp hi + exact j.isLt + · -- The edge numbered `i` is a port of its source and its target, which are distinct. + set j : Fin m := ⟨i, hi⟩ + set e := ee.symm j + have hne : N.src e ≠ N.tgt e := fun h => by + have := hside e + rw [h] at this + tauto + have hcount : ∀ a : Fin n, ((N.explicitPorts ee (ev.symm a)).map Fin.val).count i = + (if ev (N.src e) = a then 1 else 0) + (if ev (N.tgt e) = a then 1 else 0) := by + intro a + rw [show i = j.val from rfl, count_explicitPorts] + simp only [Equiv.eq_symm_apply] + by_cases hs : ev (N.src e) = a <;> by_cases ht : ev (N.tgt e) = a + · exact absurd (ev.injective (hs.trans ht.symm)) hne + all_goals simp [e, hs, ht] + have hsum : ∀ s : Finset (Fin n), + ∑ a ∈ s, ((N.explicitPorts ee (ev.symm a)).map Fin.val).count i = + (if ev (N.src e) ∈ s then 1 else 0) + (if ev (N.tgt e) ∈ s then 1 else 0) := by + intro s + simp only [hcount, Finset.sum_add_distrib, Finset.sum_ite_eq] + have hv : (N.toExplicit ev ee).vertices = List.ofFn fun a => + ((N.explicitPorts ee (ev.symm a)).map Fin.val, N.explicitTable ee (ev.symm a)) := rfl + rw [hv, List.map_take, List.map_drop, List.map_ofFn, List.sum_take_ofFn, sum_drop_ofFn] + simp only [Function.comp_def] + rw [hsum, hsum] + have := hside e + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + by_cases h : (ev (N.src e) : ℕ) < r <;> simp_all + /-- **Writing a network out preserves its contraction.** -/ theorem contraction_toExplicit [CommSemiring R] [Fintype V] [Fintype E] [DecidableEq E] : (N.toExplicit ev ee).contraction = N.contraction := by diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork.lean new file mode 100644 index 0000000000..56ed22be45 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork.lean @@ -0,0 +1,364 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.BlockNetwork +public import Complexity.Computability.Circuit.Frontier.TensorNetwork.Binarize +public import Complexity.Computability.Circuit.Frontier.TensorNetwork.Explicit +public import Mathlib.Algebra.BigOperators.Fin +public import Mathlib.Data.ZMod.Basic +public import Mathlib.Data.Nat.Log +public import Mathlib.Logic.Equiv.Fin.Basic + +/-! +# Explicit block-counting networks + +The block-counting network of a schedule (`Turing.MultiTapePTM.blockNetwork`) carries structured +letters on its edges: control records and block contents (`Turing.MultiTapePTM.BlockLetter`). +This module writes it out as an explicit Boolean tensor network +(`Cslib.Circuits.Frontier.ExplicitTensorNetwork`), the form that a contraction algorithm reads, +completing the construction of Lemma 2.2 of the note *Deterministic simulations of +nondeterministic and randomized time* (30 October 2026) formalized in issue #1833: + +1. **Binarize** by a concrete injective code of the letters + (`Turing.MultiTapePTM.letterCode`), in `letterBits k s b = (s + k + 4) * b` bits, where `s` + numbers the states. A letter is numbered by `Turing.MultiTapePTM.letterEquiv`, composed of the + standard numberings of finite products, sums, options and functions (`finProdFinEquiv`, + `finSumFinEquiv`, `finSuccEquiv`, `finFunctionFinEquiv`); its code is the binary digits of its + number. +2. **Subdivide** every Boolean edge by an equality tensor, which makes the network bipartite. +3. **Write out** (`Cslib.Circuits.Frontier.TensorNetwork.toExplicit`), numbering the old vertices + (the intervals and sinks) first and the subdivision vertices after them, both by concrete + numberings (`Turing.MultiTapePTM.explicitVertexEquiv`, `Turing.MultiTapePTM.explicitEdgeEquiv`). + +Each step preserves the contraction, so the explicit networks of the schedules still sum to the +accepting count (`Turing.MultiTapePTM.sum_contraction_explicitBlockNetwork`). + +**Size.** With `q` intervals, `k` work tapes and `m = letterBits k s b`, the explicit network has +`2 * (q * (3 * k + 1) * m)` edges and maximum degree at most `2 * (3 * k + 1) * m`, both `O(b)` per +interval. Its first `q * (3 * k + 2)` vertices are the rows of a bipartition: every edge has +exactly one port at a row and one at a column +(`Cslib.Circuits.Frontier.ExplicitTensorNetwork.IsRowsFirstBipartite`). Every table has length +`2 ^ (number of ports)`, and its entries are at most `2 ^ b`. + +These are the inputs of the Boolean tensor contraction theorem [OpenAI2026ETH, Theorem D.1] +as the counting simulation of #1833 uses it: with `b = ⌈log₂ (t + 2)⌉` and `q * b ≤ 2 t`, the +networks have `O(t)` edges and maximum degree `O(log t)`. + +## Main definitions + +* `Turing.MultiTapePTM.letterEquiv`, `Turing.MultiTapePTM.letterCode`, + `Turing.MultiTapePTM.letterBits`: the numbering and binary code of the letters. +* `Turing.MultiTapePTM.blockEdgeEquiv`, `Turing.MultiTapePTM.explicitVertexEquiv`, + `Turing.MultiTapePTM.explicitEdgeEquiv`: the numberings of edges and vertices. +* `Turing.MultiTapePTM.explicitBlockNetwork`: the explicit block-counting network of a schedule. + +## Main results + +* `Turing.MultiTapePTM.letterCode_injective`: the code is injective. +* `Turing.MultiTapePTM.contraction_explicitBlockNetwork`: writing the network out preserves its + contraction. +* `Turing.MultiTapePTM.sum_contraction_explicitBlockNetwork`: summed over the schedules, the + contractions are the accepting count. +* `Turing.MultiTapePTM.admissible_explicitBlockNetwork`: at a clock `t` with `b = O(log t)` and + `q * b ≤ 2 t`, the network is rows-first bipartite with `O(t)` edges and degree `O(log t)`. +* `Turing.MultiTapePTM.numEdges_explicitBlockNetwork`, + `Turing.MultiTapePTM.length_vertices_explicitBlockNetwork`, + `Turing.MultiTapePTM.maxDegree_explicitBlockNetwork_le`, + `Turing.MultiTapePTM.isRowsFirstBipartite_explicitBlockNetwork`, + `Turing.MultiTapePTM.length_table_explicitBlockNetwork`, + `Turing.MultiTapePTM.entry_le_explicitBlockNetwork`: size, degree, bipartition and tables. + +## References + +* [J. Hopcroft, W. Paul, L. Valiant, *On Time Versus Space*][HopcroftPaulValiant1977] +* [OpenAI, *The Exponential Time Hypothesis is False*][OpenAI2026ETH], Appendix D.1 (p. 53) +-/ + +public section + +namespace Turing + +namespace MultiTapeNTM.ChoiceTable.OutputTrack + +/-- The output tracks numbered `empty ↦ 0`, `accept ↦ 1`, `other ↦ 2`. -/ +@[expose] def equivFin : OutputTrack ≃ Fin 3 where + toFun + | .empty => 0 + | .accept => 1 + | .other => 2 + invFun i := if i = 0 then .empty else if i = 1 then .accept else .other + left_inv t := by cases t <;> rfl + right_inv i := by fin_cases i <;> rfl + +end MultiTapeNTM.ChoiceTable.OutputTrack + +namespace MultiTapePTM + +open Cslib.Circuits.Frontier MultiTapeNTM.ChoiceTable Function + +variable {k q s : ℕ} {State : Type} {b : ℕ} + +/-! ### Numbering and coding the letters -/ + +section Letters + +variable [NeZero b] + +/-- The residues modulo `b > 0` numbered by their values. -/ +@[expose] def zmodEquiv (b : ℕ) [NeZero b] : ZMod b ≃ Fin b := + (ZMod.finEquiv b).toEquiv.symm + +@[simp] theorem val_zmodEquiv (r : ZMod b) : (zmodEquiv b r : ℕ) = r.val := by + obtain _ | b := b + · exact absurd rfl (NeZero.ne 0) + · rfl + +/-- The contents of a cell numbered `none ↦ 0`, `some false ↦ 1`, `some true ↦ 2`. -/ +@[expose] def cellEquiv : Option Bool ≃ Fin 3 := + (Equiv.optionCongr finTwoEquiv.symm).trans (finSuccEquiv 2).symm + +/-- The control records numbered: the state (with `none` first, then the states numbered by `e`), +then the head offsets as `k + 1` digits in base `b`, then the output track. -/ +@[expose] def controlEquiv (e : State ≃ Fin s) : + BlockControl k State b ≃ Fin ((s + 1) * (b ^ (k + 1) * 3)) := + (Equiv.prodCongr ((Equiv.optionCongr e).trans (finSuccEquiv s).symm) + ((Equiv.prodCongr + ((Equiv.arrowCongr (finSuccEquiv k).symm (zmodEquiv b)).trans finFunctionFinEquiv) + OutputTrack.equivFin).trans finProdFinEquiv)).trans finProdFinEquiv + +/-- The block contents numbered as `b` digits in base `3`. -/ +@[expose] def contentsEquiv (b : ℕ) [NeZero b] : (ZMod b → Option Bool) ≃ Fin (3 ^ b) := + (Equiv.arrowCongr (zmodEquiv b) cellEquiv).trans finFunctionFinEquiv + +/-- **The letters numbered**: the control records first (`Turing.MultiTapePTM.controlEquiv`), +then the block contents (`Turing.MultiTapePTM.contentsEquiv`). -/ +@[expose] def letterEquiv (e : State ≃ Fin s) : + BlockLetter k State b ≃ Fin ((s + 1) * (b ^ (k + 1) * 3) + 3 ^ b) := + (Equiv.sumCongr (controlEquiv e) (contentsEquiv b)).trans finSumFinEquiv + +/-- The number of bits of a letter: `(s + k + 4) * b`, for `s` states and `k` work tapes. -/ +@[expose] def letterBits (k s b : ℕ) : ℕ := (s + k + 4) * b + +/-- Every letter number fits in `letterBits k s b` bits. -/ +theorem card_letter_le_two_pow : + (s + 1) * (b ^ (k + 1) * 3) + 3 ^ b ≤ 2 ^ letterBits k s b := by + have hb : 1 ≤ b := Nat.one_le_iff_ne_zero.mpr (NeZero.ne b) + have hs : s + 1 ≤ 2 ^ (s * b) := + (Nat.lt_two_pow_self).trans_le (Nat.pow_le_pow_right two_pos (Nat.le_mul_of_pos_right s hb)) + have hbk : b ^ (k + 1) ≤ 2 ^ ((k + 1) * b) := by + rw [mul_comm, pow_mul] + exact Nat.pow_le_pow_left (Nat.lt_two_pow_self).le _ + have h3 : 3 ≤ 2 ^ (2 * b) := by + calc 3 ≤ 2 ^ 2 := by norm_num + _ ≤ 2 ^ (2 * b) := Nat.pow_le_pow_right two_pos (by omega) + have h3b : 3 ^ b ≤ 2 ^ (2 * b) := by + rw [pow_mul] + exact Nat.pow_le_pow_left (by norm_num) _ + have hctl : (s + 1) * (b ^ (k + 1) * 3) ≤ 2 ^ ((s + k + 3) * b) := by + calc (s + 1) * (b ^ (k + 1) * 3) ≤ 2 ^ (s * b) * (2 ^ ((k + 1) * b) * 2 ^ (2 * b)) := + Nat.mul_le_mul hs (Nat.mul_le_mul hbk h3) + _ = 2 ^ ((s + k + 3) * b) := by rw [← pow_add, ← pow_add]; ring_nf + have hcon : 3 ^ b ≤ 2 ^ ((s + k + 3) * b) := + h3b.trans (Nat.pow_le_pow_right two_pos (Nat.mul_le_mul_right b (by omega))) + calc _ ≤ 2 ^ ((s + k + 3) * b) + 2 ^ ((s + k + 3) * b) := Nat.add_le_add hctl hcon + _ = 2 ^ ((s + k + 3) * b + 1) := by rw [pow_succ]; ring + _ ≤ 2 ^ letterBits k s b := + Nat.pow_le_pow_right two_pos (by unfold letterBits; nlinarith) + +/-- **The letter code**: the `letterBits k s b` binary digits, least significant first, of the +number of a letter (`Turing.MultiTapePTM.letterEquiv`). -/ +@[expose] def letterCode (e : State ≃ Fin s) (l : BlockLetter k State b) : + Fin (letterBits k s b) → Bool := + fun j => (letterEquiv e l : ℕ).testBit j + +/-- **The letter code is injective**: letter numbers fit in `letterBits k s b` bits. -/ +theorem letterCode_injective (e : State ≃ Fin s) : + Injective (letterCode (k := k) (b := b) e) := by + intro l l' h + have hlt : ∀ l : BlockLetter k State b, (letterEquiv e l : ℕ) < 2 ^ letterBits k s b := + fun l => (letterEquiv e l).isLt.trans_le card_letter_le_two_pow + refine (letterEquiv e).injective (Fin.ext (Nat.eq_of_testBit_eq fun j => ?_)) + by_cases hj : j < letterBits k s b + · exact congrFun h ⟨j, hj⟩ + · rw [Nat.testBit_lt_two_pow ((hlt l).trans_le (Nat.pow_le_pow_right two_pos (not_lt.mp hj))), + Nat.testBit_lt_two_pow ((hlt l').trans_le (Nat.pow_le_pow_right two_pos (not_lt.mp hj)))] + +instance : Nonempty (BlockLetter k State b) := ⟨.inr fun _ => none⟩ + +end Letters + +/-! ### Numbering the edges and vertices -/ + +-- A named instance keeps the instances on the vertex types of the explicit network small. +instance (k q : ℕ) : DecidableEq (BlockEdge k q) := + inferInstanceAs (DecidableEq (Fin q ⊕ (Fin q × Fin k × Fin 3))) + +/-- The edges of a block-counting network numbered: the control edges first, then the block edges +`(i, h, d)` in lexicographic order. -/ +@[expose] def blockEdgeEquiv (k q : ℕ) : BlockEdge k q ≃ Fin (q * (3 * k + 1)) := + ((Equiv.sumCongr (Equiv.refl _) + ((Equiv.prodCongr (Equiv.refl _) finProdFinEquiv).trans finProdFinEquiv)).trans + finSumFinEquiv).trans (finCongr (by ring)) + +/-- The vertices of the explicit network numbered: the old vertices first (the intervals, then the +sinks in the order of their edges), then the subdivision vertices, one for each copy `(e, j)` of an +edge. -/ +@[expose] def explicitVertexEquiv (k q m : ℕ) : + (Fin q ⊕ BlockEdge k q) ⊕ (BlockEdge k q × Fin m) ≃ + Fin (q * (3 * k + 2) + q * (3 * k + 1) * m) := + (Equiv.sumCongr + (((Equiv.sumCongr (Equiv.refl _) (blockEdgeEquiv k q)).trans finSumFinEquiv).trans + (finCongr (by ring))) + ((Equiv.prodCongr (blockEdgeEquiv k q) (Equiv.refl _)).trans finProdFinEquiv)).trans + finSumFinEquiv + +/-- The edges of the explicit network numbered: the source halves of the copies `(e, j)` first, +then their target halves. -/ +@[expose] def explicitEdgeEquiv (k q m : ℕ) : + (BlockEdge k q × Fin m) ⊕ (BlockEdge k q × Fin m) ≃ Fin (2 * (q * (3 * k + 1) * m)) := + ((Equiv.sumCongr ((Equiv.prodCongr (blockEdgeEquiv k q) (Equiv.refl _)).trans finProdFinEquiv) + ((Equiv.prodCongr (blockEdgeEquiv k q) (Equiv.refl _)).trans finProdFinEquiv)).trans + finSumFinEquiv).trans (finCongr (by ring)) + +/-- The old vertices come first. -/ +theorem explicitVertexEquiv_inl (k q m : ℕ) (v : Fin q ⊕ BlockEdge k q) : + (explicitVertexEquiv k q m (.inl v) : ℕ) < q * (3 * k + 2) := by + simp only [explicitVertexEquiv, Equiv.trans_apply, Equiv.sumCongr_apply, Sum.map_inl, + finSumFinEquiv_apply_left, Fin.val_castAdd] + exact Fin.isLt _ + +/-- The subdivision vertices come after the old ones. -/ +theorem le_explicitVertexEquiv_inr (k q m : ℕ) (p : BlockEdge k q × Fin m) : + q * (3 * k + 2) ≤ (explicitVertexEquiv k q m (.inr p) : ℕ) := by + simp only [explicitVertexEquiv, Equiv.trans_apply, Equiv.sumCongr_apply, Sum.map_inr, + finSumFinEquiv_apply_right, Fin.val_natAdd] + omega + +/-! ### The explicit network -/ + +variable (machine : MultiTapePTM k Bool State) (input : List Bool) (b : ℕ) [NeZero b] + (σ : Schedule k q) (e : State ≃ Fin s) + +/-- **The explicit block-counting network** of the schedule `σ`: the block-counting network +binarized by the letter code (`Turing.MultiTapePTM.letterCode`), subdivided by equality tensors +and written out with the old vertices first. Its first `q * (3 * k + 2)` vertices are the rows of +its bipartition. -/ +@[expose] noncomputable def explicitBlockNetwork : ExplicitTensorNetwork ℕ := + ((machine.blockNetwork input b σ).binarize (letterCode e)).subdivide.toExplicit + (explicitVertexEquiv k q (letterBits k s b)) (explicitEdgeEquiv k q (letterBits k s b)) + +/-- **Writing the network out preserves its contraction.** -/ +theorem contraction_explicitBlockNetwork [Fintype State] : + (machine.explicitBlockNetwork input b σ e).contraction = + (machine.blockNetwork input b σ).contraction := by + rw [explicitBlockNetwork, TensorNetwork.contraction_toExplicit, + TensorNetwork.contraction_subdivide, + TensorNetwork.contraction_binarize _ (letterCode_injective e)] + +/-- **The block-counting identity for the explicit networks** (the note's Lemma 2.2, equation +(2)). Summed over the movement schedules of `q > 0` intervals of `b` bits, the contractions of the +explicit block-counting networks are the accepting count on `q * b` bits. -/ +theorem sum_contraction_explicitBlockNetwork [Finite State] (hq : 0 < q) : + ∑ σ : Schedule k q, (machine.explicitBlockNetwork input b σ e).contraction = + machine.acceptCount input (q * b) := by + have := Fintype.ofFinite State + simp only [contraction_explicitBlockNetwork] + exact machine.sum_contraction_blockNetwork input b hq + +/-- The explicit network has `2 * (q * (3 * k + 1) * letterBits k s b)` edges: two halves of each +of the `letterBits k s b` copies of each of the `q * (3 * k + 1)` edges. -/ +theorem numEdges_explicitBlockNetwork : + (machine.explicitBlockNetwork input b σ e).numEdges = + 2 * (q * (3 * k + 1) * letterBits k s b) := rfl + +/-- The explicit network has `q * (3 * k + 2)` old vertices and one subdivision vertex for each +copy of an edge. -/ +theorem length_vertices_explicitBlockNetwork : + (machine.explicitBlockNetwork input b σ e).vertices.length = + q * (3 * k + 2) + q * (3 * k + 1) * letterBits k s b := by + simp [explicitBlockNetwork, TensorNetwork.toExplicit] + +/-- **The degree bound**: at most `2 * (3 * k + 1) * letterBits k s b` ports at every vertex, +`O(b)` for a fixed machine. -/ +theorem maxDegree_explicitBlockNetwork_le : + (machine.explicitBlockNetwork input b σ e).maxDegree ≤ + 2 * (3 * k + 1) * letterBits k s b := by + have hm : 1 ≤ letterBits k s b := + Nat.mul_pos (by omega) (Nat.pos_of_neZero b) + refine TensorNetwork.maxDegree_toExplicit_le _ _ _ + (TensorNetwork.maxDegreeLE_subdivide _ ?_ ?_ ?_) + · exact TensorNetwork.loopless_binarize _ _ (machine.loopless_blockNetwork input b σ) + · exact TensorNetwork.maxDegreeLE_binarize _ _ (machine.maxDegreeLE_blockNetwork input b σ) + · nlinarith + +/-- **The bipartition**: the first `q * (3 * k + 2)` vertices, the old ones, are rows; every edge +joins an old vertex to a subdivision vertex. -/ +theorem isRowsFirstBipartite_explicitBlockNetwork : + (machine.explicitBlockNetwork input b σ e).IsRowsFirstBipartite (q * (3 * k + 2)) := by + refine TensorNetwork.isRowsFirstBipartite_toExplicit _ _ _ _ fun p => ?_ + rcases p with p | p <;> + simp only [TensorNetwork.subdivide_src_inl, TensorNetwork.subdivide_src_inr, + TensorNetwork.subdivide_tgt_inl, TensorNetwork.subdivide_tgt_inr] <;> + exact iff_of_true (explicitVertexEquiv_inl _ _ _ _) + (not_lt.mpr (le_explicitVertexEquiv_inr _ _ _ _)) + +/-- **Admissibility at a clock `t`.** With blocks of `b ≤ 3 ⌊log₂ t⌋` steps and padded time +`q * b ≤ 2 t`, the explicit network is rows-first bipartite with `O(t)` edges and maximum degree +`O(log t)`, with the constant `6 (3 k + 1) (s + k + 4)` of the machine. For the counting +simulation, `b = ⌈log₂ (t + 2)⌉` (`Nat.clog_two_add_two_le_three_mul_log_two`). -/ +theorem admissible_explicitBlockNetwork {t : ℕ} (hb : b ≤ 3 * Nat.log 2 t) (hqb : q * b ≤ 2 * t) : + (machine.explicitBlockNetwork input b σ e).IsRowsFirstBipartite (q * (3 * k + 2)) ∧ + (machine.explicitBlockNetwork input b σ e).numEdges ≤ 6 * (3 * k + 1) * (s + k + 4) * t ∧ + (machine.explicitBlockNetwork input b σ e).maxDegree ≤ + 6 * (3 * k + 1) * (s + k + 4) * Nat.log 2 t := by + refine ⟨machine.isRowsFirstBipartite_explicitBlockNetwork input b σ e, ?_, ?_⟩ + · rw [numEdges_explicitBlockNetwork, letterBits] + calc 2 * (q * (3 * k + 1) * ((s + k + 4) * b)) + = 2 * (3 * k + 1) * (s + k + 4) * (q * b) := by ring + _ ≤ 2 * (3 * k + 1) * (s + k + 4) * (2 * t) := Nat.mul_le_mul_left _ hqb + _ ≤ 6 * (3 * k + 1) * (s + k + 4) * t := by + have h4 : 2 * (3 * k + 1) * (s + k + 4) * (2 * t) = + 4 * ((3 * k + 1) * (s + k + 4) * t) := by ring + have h6 : 6 * (3 * k + 1) * (s + k + 4) * t = 6 * ((3 * k + 1) * (s + k + 4) * t) := by + ring + omega + · refine (machine.maxDegree_explicitBlockNetwork_le input b σ e).trans ?_ + rw [letterBits] + calc 2 * (3 * k + 1) * ((s + k + 4) * b) = 2 * (3 * k + 1) * (s + k + 4) * b := by ring + _ ≤ 2 * (3 * k + 1) * (s + k + 4) * (3 * Nat.log 2 t) := Nat.mul_le_mul_left _ hb + _ = 6 * (3 * k + 1) * (s + k + 4) * Nat.log 2 t := by ring + +/-- Every table of the explicit network lists the values at all bits on its ports. -/ +theorem length_table_explicitBlockNetwork {p : List ℕ × List ℕ} + (hp : p ∈ (machine.explicitBlockNetwork input b σ e).vertices) : + p.2.length = 2 ^ p.1.length := + TensorNetwork.length_table_toExplicit _ _ _ hp + +/-- **The entry bound**: every table entry of the explicit network is at most `2 ^ b`. -/ +theorem entry_le_explicitBlockNetwork {p : List ℕ × List ℕ} + (hp : p ∈ (machine.explicitBlockNetwork input b σ e).vertices) {a : ℕ} (ha : a ∈ p.2) : + a ≤ 2 ^ b := by + obtain ⟨v, y, rfl⟩ := TensorNetwork.exists_tensor_of_mem_toExplicit _ _ _ hp ha + have hone : (1 : ℕ) ≤ 2 ^ b := Nat.one_le_two_pow + rcases v with v | p + · rw [TensorNetwork.subdivide_tensor_inl] + rcases TensorNetwork.tensor_binarize_eq_zero_or (machine.blockNetwork input b σ) + (letterCode e) v _ with h | ⟨x, h⟩ + · rw [h] + exact Nat.zero_le _ + · rw [h] + exact machine.tensor_blockNetwork_le input b σ v x + · rw [TensorNetwork.subdivide_tensor_inr] + split_ifs + · exact hone + · exact Nat.zero_le _ + +end MultiTapePTM + +end Turing diff --git a/Complexity/Foundations/Data/Nat/Log.lean b/Complexity/Foundations/Data/Nat/Log.lean index e3387cc1ff..5f468fde9b 100644 --- a/Complexity/Foundations/Data/Nat/Log.lean +++ b/Complexity/Foundations/Data/Nat/Log.lean @@ -31,6 +31,7 @@ stays polynomial after logarithmically many rounds. Similarly `2 ^ (⌊log₂ n * `Nat.mul_log_le_add_sq`: `m * ⌊log_b n⌋ ≤ n + m * m` for `1 < b`. * `Nat.clog_two_le_two_mul_of_le_two_mul`: `⌈log₂ n⌉ ≤ 2 * ⌈log₂ n'⌉` when `n ≤ 2 * n'` and `2 ≤ n'`. +* `Nat.clog_two_add_two_le_three_mul_log_two`: `⌈log₂ (n + 2)⌉ ≤ 3 ⌊log₂ n⌋` for `n ≥ 2`. -/ @[expose] public section @@ -109,4 +110,14 @@ theorem clog_two_le_two_mul_of_le_two_mul {n n' : ℕ} (hn : n ≤ 2 * n') (hn' have h3 : clog 2 n ≤ clog 2 n' + 1 := (clog_le_iff_le_pow Nat.one_lt_two).mpr h2 omega +/-- From `n = 2` on, `⌈log₂ (n + 2)⌉ ≤ 3 ⌊log₂ n⌋`: the left side is at most `⌊log₂ n⌋ + 2`, and +`⌊log₂ n⌋ ≥ 1`. -/ +theorem clog_two_add_two_le_three_mul_log_two {n : ℕ} (hn : 2 ≤ n) : + clog 2 (n + 2) ≤ 3 * log 2 n := by + have hL : 1 ≤ log 2 n := le_log_of_pow_le Nat.one_lt_two (by simpa using hn) + have hlt : n < 2 ^ (log 2 n + 1) := lt_pow_succ_log_self Nat.one_lt_two n + refine (clog_le_iff_le_pow Nat.one_lt_two).mpr ?_ + calc n + 2 ≤ 2 ^ (log 2 n + 2) := by rw [Nat.pow_succ]; omega + _ ≤ 2 ^ (3 * log 2 n) := Nat.pow_le_pow_right Nat.two_pos (by omega) + end Nat diff --git a/ComplexityTests/Computability/Circuit/Frontier/TensorNetwork.lean b/ComplexityTests/Computability/Circuit/Frontier/TensorNetwork.lean index 27d867afd5..f030828558 100644 --- a/ComplexityTests/Computability/Circuit/Frontier/TensorNetwork.lean +++ b/ComplexityTests/Computability/Circuit/Frontier/TensorNetwork.lean @@ -10,6 +10,7 @@ module public import Complexity.Computability.Circuit.Frontier.TensorNetwork.Constraint public import Complexity.Computability.Circuit.Frontier.TensorNetwork.Explicit public import Mathlib.Data.ZMod.Defs +public import Mathlib.Logic.Equiv.Fin.Basic /-! # Tests for tensor networks @@ -90,6 +91,34 @@ example : parallelNetwork.subdivide.contraction = 70 ∧ parallelNetwork.subdivi decide · exact (Set.ncard_le_card _).trans (by simp) +/-! ### Rows-first bipartitions -/ + +/-- In `parallel`, the first vertex is a row and the second a column. -/ +example : parallel.IsRowsFirstBipartite 1 := by decide + +/-- With both vertices as rows, no edge has a column port. -/ +example : ¬ parallel.IsRowsFirstBipartite 2 := by decide + +/-- In the four-cycle the rows `r₀, r₁` are vertices `0` and `2`, not the first two. -/ +example : ¬ (cycle eqTable).IsRowsFirstBipartite 2 := by decide + +/-- A port naming no edge is excluded. -/ +example : ¬ (⟨1, [([0], [1, 1]), ([0, 5], [1, 1, 1, 1])]⟩ : + ExplicitTensorNetwork ℕ).IsRowsFirstBipartite 1 := by decide + +/-- Written out with the old vertices first, the subdivision of `parallelNetwork` is rows-first +bipartite with degree `2`, both by the general lemmas and by evaluation. -/ +example : (parallelNetwork.subdivide.toExplicit finSumFinEquiv finSumFinEquiv).IsRowsFirstBipartite + 2 ∧ (parallelNetwork.subdivide.toExplicit finSumFinEquiv finSumFinEquiv).maxDegree ≤ 2 := + ⟨parallelNetwork.subdivide.isRowsFirstBipartite_toExplicit _ _ 2 (by decide), + parallelNetwork.subdivide.maxDegree_toExplicit_le _ _ + (parallelNetwork.maxDegreeLE_subdivide (fun e => by simp [parallelNetwork]) + (fun v => (Set.ncard_le_card _).trans (by simp)) le_rfl)⟩ + +example : (parallelNetwork.subdivide.toExplicit finSumFinEquiv finSumFinEquiv).IsRowsFirstBipartite + 2 ∧ (parallelNetwork.subdivide.toExplicit finSumFinEquiv finSumFinEquiv).maxDegree = 2 := by + decide + /-! ### Constraint networks -/ /-- Two vertices joined by two parallel edges, each requiring its two edges to agree. -/ diff --git a/ComplexityTests/HPVExplicitBlockNetwork.lean b/ComplexityTests/HPVExplicitBlockNetwork.lean new file mode 100644 index 0000000000..eb3e8ac2be --- /dev/null +++ b/ComplexityTests/HPVExplicitBlockNetwork.lean @@ -0,0 +1,99 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork +import Complexity.Foundations.Data.Nat.Log + +/-! Explicit block-counting networks of concrete fair-coin machines: the letter numbering on +concrete letters, the counting identity, and the size, degree and bipartition of the networks. -/ + +namespace ComplexityTests.HPVExplicitBlockNetwork + +open Turing MultiTapeMachine MultiTapePTM Cslib.Circuits.Frontier + +/-- Emit the first coin and halt. No work tapes; the input head stays. -/ +private def emitCoin : MultiTapePTM 0 Bool Unit where + initial := () + tr _ _ _ _ bit := .step + { inputTape := 0, workTapes := Fin.elim0, output := some bit, state := none } + Empty.elim Empty.elim + +/-- On one work tape, write every coin and move right. The first step emits its coin; then the +machine keeps walking without output. -/ +private def walk : MultiTapePTM 1 Bool Bool where + initial := false + tr state _ _ _ bit := .step + { inputTape := 1, + workTapes := fun _ => (some (some bit), 1), + output := if state then none else some bit, state := some true } + Empty.elim Empty.elim + +/-! ### The letter numbering -/ + +/-- With two states, one work tape and blocks of two cells, there are +`3 * (2 ^ 2 * 3) = 36` control records, numbered first. The block holding `true` twice is +contents number `2 + 2 * 3 = 8`, so letter number `44`. -/ +example : (letterEquiv (k := 1) (b := 2) finTwoEquiv.symm (.inr fun _ => some true) : ℕ) = 44 := + by decide + +/-- The record of state `true` with both offsets `1` and output track `accept`: state digit `2`, +offset digits `1 + 1 * 2 = 3`, track digit `1`, so number `2 * 12 + (3 * 3 + 1) = 34`. -/ +example : (letterEquiv (k := 1) (b := 2) finTwoEquiv.symm + (.inl (some true, fun _ => 1, .accept)) : ℕ) = 34 := by decide + +/-- The code of letter `44 = 0b101100` in `(2 + 1 + 4) * 2 = 14` bits, least significant first. -/ +example : List.ofFn (letterCode (k := 1) (b := 2) finTwoEquiv.symm (.inr fun _ => some true)) = + [false, false, true, true, false, true, false, false, false, false, false, false, false, + false] := by decide + +/-! ### The counting identity -/ + +-- One interval of two bits: the strings starting with `true` accept. +example : ∑ σ : Schedule 0 1, + (emitCoin.explicitBlockNetwork [] 2 σ (Equiv.ofUnique Unit (Fin 1))).contraction = 2 := by + rw [sum_contraction_explicitBlockNetwork _ _ _ _ one_pos, + show emitCoin.acceptCount [] (1 * 2) = 2 by decide] + +-- Two intervals of two bits, with windows on the work tape: half of the `16` strings accept. +example : ∑ σ : Schedule 1 2, + (walk.explicitBlockNetwork [true] 2 σ finTwoEquiv.symm).contraction = 8 := by + rw [sum_contraction_explicitBlockNetwork _ _ _ _ two_pos, + show walk.acceptCount [true] (2 * 2) = 8 by decide] + +/-! ### Size, degree and bipartition -/ + +-- Letters of `14` bits; `2 * (2 * 4 * 14) = 224` edges; `10` old vertices and `112` subdivision +-- vertices; degree at most `2 * 4 * 14 = 112`; the `10` old vertices are the rows; every table has +-- an entry for each list of bits on its ports, and every entry is at most `2 ^ 2`. +example (σ : Schedule 1 2) : + letterBits 1 2 2 = 14 ∧ + (walk.explicitBlockNetwork [true] 2 σ finTwoEquiv.symm).numEdges = 224 ∧ + (walk.explicitBlockNetwork [true] 2 σ finTwoEquiv.symm).vertices.length = 122 ∧ + (walk.explicitBlockNetwork [true] 2 σ finTwoEquiv.symm).maxDegree ≤ 112 ∧ + (walk.explicitBlockNetwork [true] 2 σ finTwoEquiv.symm).IsRowsFirstBipartite 10 ∧ + ∀ p ∈ (walk.explicitBlockNetwork [true] 2 σ finTwoEquiv.symm).vertices, + p.2.length = 2 ^ p.1.length ∧ ∀ a ∈ p.2, a ≤ 4 := + ⟨rfl, numEdges_explicitBlockNetwork .., length_vertices_explicitBlockNetwork .., + maxDegree_explicitBlockNetwork_le .., isRowsFirstBipartite_explicitBlockNetwork .., + fun _ hp => ⟨length_table_explicitBlockNetwork _ _ _ _ _ hp, + fun _ ha => entry_le_explicitBlockNetwork _ _ _ _ _ hp ha⟩⟩ + +-- At the clock `t = 2`, blocks of `⌈log₂ 4⌉ = 2` steps and one interval: the network of +-- `emitCoin` is rows-first bipartite with at most `6 * 1 * 5 * 2 = 60` edges (it has +-- `2 * (1 * 1 * 10) = 20`) and degree at most `6 * 1 * 5 * ⌊log₂ 2⌋ = 30`. +example (σ : Schedule 0 1) : + (emitCoin.explicitBlockNetwork [] 2 σ (Equiv.ofUnique Unit (Fin 1))).IsRowsFirstBipartite 2 ∧ + (emitCoin.explicitBlockNetwork [] 2 σ (Equiv.ofUnique Unit (Fin 1))).numEdges ≤ 60 ∧ + (emitCoin.explicitBlockNetwork [] 2 σ (Equiv.ofUnique Unit (Fin 1))).maxDegree ≤ 30 := by + have hb : 2 ≤ 3 * Nat.log 2 2 := by + simpa [show Nat.clog 2 (2 + 2) = 2 by decide] using + Nat.clog_two_add_two_le_three_mul_log_two (le_refl 2) + have h := emitCoin.admissible_explicitBlockNetwork [] 2 σ (Equiv.ofUnique Unit (Fin 1)) hb + (by norm_num) + rw [show Nat.log 2 2 = 1 by decide] at h + simpa using h + +end ComplexityTests.HPVExplicitBlockNetwork From 804c542d719c607b84d236f973b19af22d3b5a0c Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 19:22:07 -0400 Subject: [PATCH 10/19] feat(machines): decide interval steps by finite simulation (#1833 H3) Interval steps replay coins on configurations whose work tapes are functions on Z. Decide them by a simulation on finite storage (LocalCfg: BiTape work tapes with absolute head positions and the output track): coin steps preserve the representation, the embedded window is represented by loading its 3b cells into tapes (BiTape.ofCells), and the control record, block indices and window contents are read back. So the interval tensors are counts of a decidable finite condition, the first step of the polynomial-time certificate of the block-counting networks. Expose IntervalStep and intervalCount, which the bridge unfolds. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 2 + .../Probabilistic/IntervalSimulation.lean | 363 ++++++++++++++++++ .../Probabilistic/IntervalTensor.lean | 7 +- .../Foundations/Data/BiTape/OfCells.lean | 97 +++++ ComplexityTests/HPVIntervalSimulation.lean | 58 +++ 5 files changed, 524 insertions(+), 3 deletions(-) create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalSimulation.lean create mode 100644 Complexity/Foundations/Data/BiTape/OfCells.lean create mode 100644 ComplexityTests/HPVIntervalSimulation.lean diff --git a/Complexity.lean b/Complexity.lean index 397740fe3b..a30ece7cfc 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -1814,6 +1814,7 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.D public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExtendTapes public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.InputFromTape +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalSimulation public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalTensor public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IterateWhile public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Loop @@ -2541,6 +2542,7 @@ public import Complexity.Foundations.Combinatorics.UniformSchedules public import Complexity.Foundations.Control.Monad.IsMonadHom.StateT public import Complexity.Foundations.Control.Monad.Memoize public import Complexity.Foundations.Data.BiTape +public import Complexity.Foundations.Data.BiTape.OfCells public import Complexity.Foundations.Data.BitString.Affine public import Complexity.Foundations.Data.BitString.AffineSubspace public import Complexity.Foundations.Data.BitString.Agree diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalSimulation.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalSimulation.lean new file mode 100644 index 0000000000..cba94354ce --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalSimulation.lean @@ -0,0 +1,363 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalTensor +public import Complexity.Computability.Machines.Turing.MultiTape.Run +public import Complexity.Foundations.Data.BiTape.OfCells + +/-! +# Interval steps by finite simulation + +An interval step (`Turing.MultiTapePTM.IntervalStep`) replays coins from a configuration whose +work tapes are functions on `ℤ`. This module decides it by a simulation on finite storage, the +first step towards computing the block-counting networks of #1833 in polynomial time. + +**Finite storage** (`Turing.MultiTapePTM.LocalCfg`) keeps the control, the input position as a +natural number, every work tape as a `Cslib.Turing.BiTape` around its head together with the +head's absolute position, and only the track of the output +(`Turing.MultiTapeNTM.ChoiceTable.OutputTrack`), which is all a control record keeps. One coin +step (`Turing.MultiTapePTM.localCoinStep`) applies the table's action; on halted storage it changes +nothing. Finite storage *represents* a configuration (`Turing.MultiTapePTM.LocalCfg.Represents`) +when it has its control, input position, head positions, output track and the contents of every +work tape around its head; steps preserve this +(`Turing.MultiTapePTM.LocalCfg.Represents.localRun`). + +**The window.** The configuration embedded at block indices `J` with control record `cIn` and +window contents `wIn` (`Turing.embedCfg`) is represented by `Turing.MultiTapePTM.localStart`, +which loads the `3 b` cells of each window into a tape (`Cslib.Turing.BiTape.ofCells`). Its control +record, block indices and window contents are read back from finite storage +(`Turing.MultiTapePTM.LocalCfg.blockControl`, `Turing.MultiTapePTM.LocalCfg.blockIndex`, +`Turing.MultiTapePTM.LocalCfg.windowContents`). + +## Main definitions + +* `Turing.MultiTapePTM.LocalCfg`: finite storage for replaying an interval. +* `Turing.MultiTapePTM.coinAction`, `Turing.MultiTapePTM.localCoinStep`, + `Turing.MultiTapePTM.localRun`: one coin step and a replay on finite storage. +* `Turing.MultiTapePTM.windowCells`, `Turing.MultiTapePTM.localStart`: the finite storage of an + embedded window. +* `Turing.MultiTapePTM.LocalIntervalStep`: the interval condition on finite storage. + +## Main results + +* `Turing.MultiTapePTM.LocalCfg.Represents.localRun`: replays preserve the representation. +* `Turing.MultiTapePTM.represents_localStart`: the finite storage of an embedded window. +* `Turing.MultiTapePTM.intervalStep_iff_localIntervalStep`: interval steps are decided by finite + simulation. +* `Turing.MultiTapePTM.intervalCount_eq_card_localIntervalStep`: so are the interval tensors. +-/ + +public section + +namespace Turing.MultiTapePTM + +open MultiTapeNTM.ChoiceTable Cslib.Turing + +variable {k : ℕ} {State : Type} + +/-! ### Finite storage and its steps -/ + +/-- **Finite storage** for replaying an interval: the control, the input position (`0` and +`|input| + 1` are the end cells), every work tape around its head with the head's absolute +position, and the track of the output. -/ +structure LocalCfg (k : ℕ) (State : Type) where + /-- The control, or `none` when halted. -/ + state : Option State + /-- The input position, as in `Turing.Cfg.inputPos`. -/ + inputPos : ℕ + /-- Every work tape, around its head. -/ + workTapes : Fin k → BiTape Bool + /-- The absolute position of every work head. -/ + workTapePos : Fin k → ℤ + /-- The track of the output. -/ + track : OutputTrack + +variable (machine : MultiTapePTM k Bool State) + +/-- The action from a control under a coin: the table's action when running, and the action that +changes nothing when halted. -/ +@[expose] def coinAction (state : Option State) (symbol : Option Bool) + (work : Fin k → Option Bool) (bit : Bool) : Action k Bool State := + match state with + | none => ⟨0, fun _ => (none, 0), none, none⟩ + | some q => MultiTapeMachine.Action.emptyOracleEquiv (machine.tr q symbol work Empty.elim bit) + +/-- One coin step on finite storage. -/ +@[expose] def localCoinStep (input : List Bool) (l : LocalCfg k State) (bit : Bool) : + LocalCfg k State := + let a := machine.coinAction l.state (inputAt input l.inputPos) (fun h => (l.workTapes h).head) bit + { state := a.state + inputPos := moveInputPosNat input.length l.inputPos a.inputTape + workTapes := fun h => (l.workTapes h).step (a.workTapes h) + workTapePos := fun h => l.workTapePos h + (a.workTapes h).2 + track := l.track.emit a.output } + +/-- Replaying coins on finite storage. -/ +@[expose] def localRun (input : List Bool) (coins : List Bool) (l : LocalCfg k State) : + LocalCfg k State := + coins.foldl (machine.localCoinStep input) l + +/-- Finite storage **represents** a configuration when it has its control, input position, head +positions and output track, and every work tape holds the configuration's tape around its +head. -/ +structure LocalCfg.Represents {input : List Bool} (l : LocalCfg k State) + (c : Cfg k Bool State input) : Prop where + /-- The controls agree. -/ + state : l.state = c.state + /-- The input positions agree. -/ + inputPos : l.inputPos = c.inputPos.val + /-- Every finite work tape holds the configuration's tape around its head. -/ + workTapes : ∀ h, (l.workTapes h).Represents (c.workTapes h) (c.workTapePos h) + /-- The work head positions agree. -/ + workTapePos : l.workTapePos = c.workTapePos + /-- The output track is the track of the configuration's output. -/ + track : l.track = OutputTrack.ofWord c.output + +/-- A coin step of a fair-coin table applies `coinAction`. -/ +theorem withCoin_step_eq (bit : Bool) {input : List Bool} (c : Cfg k Bool State input) : + (machine.withCoin bit).toTM.step c = + (machine.coinAction c.state c.inputSymbol c.workTapeSymbols bit).apply c := by + cases hs : c.state with + | none => + rw [MultiTapeTM.step_of_halt hs] + simp only [coinAction] + refine Cfg.ext ?_ ?_ ?_ ?_ ?_ + · simp [Action.apply, hs] + · simp [Action.apply] + · funext h + simp [Action.apply] + · funext h + simp [Action.apply] + · simp [Action.apply] + | some q => + rw [MultiTapeTM.step_of_state hs] + simp only [coinAction, MultiTapeMachine.toTM, MultiTapeTM.tr_ofTr] + rfl + +/-- **A coin step preserves the representation.** -/ +theorem LocalCfg.Represents.localCoinStep {input : List Bool} {l : LocalCfg k State} + {c : Cfg k Bool State input} (h : l.Represents c) (bit : Bool) : + (machine.localCoinStep input l bit).Represents ((machine.withCoin bit).toTM.step c) := by + have hsym : inputAt input l.inputPos = c.inputSymbol := by + rw [Cfg.inputSymbol_eq_inputAt, h.inputPos] + have hwork : (fun i => (l.workTapes i).head) = c.workTapeSymbols := + funext fun i => (h.workTapes i).head + rw [withCoin_step_eq] + unfold MultiTapePTM.localCoinStep + rw [hsym, hwork, h.state] + set a := machine.coinAction c.state c.inputSymbol c.workTapeSymbols bit + refine ⟨rfl, ?_, fun i => ?_, ?_, ?_⟩ + · rw [h.inputPos] + exact (val_moveInputPos_eq_moveInputPosNat _ _).symm + · have hstep := (h.workTapes i).step (a.workTapes i) + rcases hw : (a.workTapes i) with ⟨w, m⟩ + rw [hw] at hstep + cases w <;> simpa [Action.apply, hw] using hstep + · funext i + simp [Action.apply, h.workTapePos] + · simp [Action.apply, h.track, OutputTrack.ofWord_append] + +/-- **A replay preserves the representation.** -/ +theorem LocalCfg.Represents.localRun {input : List Bool} {l : LocalCfg k State} + {c : Cfg k Bool State input} (h : l.Represents c) (coins : List Bool) : + (machine.localRun input coins l).Represents (machine.stepCoins coins c) := by + induction coins generalizing l c with + | nil => exact h + | cons bit coins ih => exact ih (h.localCoinStep machine bit) + +/-! ### Reading a configuration's view off finite storage -/ + +section View + +variable (b : ℕ) [NeZero b] + +/-- The control record of finite storage: its control, the offset of every head in its block, +and its output track. -/ +@[expose] def LocalCfg.blockControl (l : LocalCfg k State) : BlockControl k State b := + (l.state, fun head => match head with + | none => (((l.inputPos : ℤ) - 1 : ℤ) : ZMod b) + | some h => ((l.workTapePos h : ℤ) : ZMod b), l.track) + +/-- The block index of every head of finite storage. -/ +@[expose] def LocalCfg.blockIndex (l : LocalCfg k State) : Option (Fin k) → ℤ + | none => ((l.inputPos : ℤ) - 1) / b + | some h => l.workTapePos h / b + +/-- The contents of the windows around block indices `J`, read off finite storage. -/ +@[expose] def LocalCfg.windowContents (J : Option (Fin k) → ℤ) (l : LocalCfg k State) : + Fin k → Fin 3 → ZMod b → Option Bool := fun h d r => + (l.workTapes h).read (b * (J (some h) + d - 1) + r.val - l.workTapePos h) + +variable {b} {input : List Bool} {l : LocalCfg k State} {c : Cfg k Bool State input} + +omit [NeZero b] in +theorem LocalCfg.Represents.blockControl (h : l.Represents c) : + l.blockControl b = c.blockControl b := by + simp only [LocalCfg.blockControl, Cfg.blockControl, h.state, h.track, h.inputPos, + h.workTapePos] + congr 2 + funext head + cases head <;> simp + +omit [NeZero b] in +theorem LocalCfg.Represents.blockIndex (h : l.Represents c) : + l.blockIndex b = c.blockIndex b := by + funext head + cases head <;> simp [LocalCfg.blockIndex, Cfg.blockIndex, h.inputPos, h.workTapePos] + +omit [NeZero b] in +theorem LocalCfg.Represents.windowContents (h : l.Represents c) (J : Option (Fin k) → ℤ) : + l.windowContents b J = c.windowContents b J := by + funext i d r + simp only [LocalCfg.windowContents, Cfg.windowContents, Cfg.blockContents, + h.workTapes i _, h.workTapePos] + congr 1 + ring + +end View + +/-! ### The finite storage of an embedded window -/ + +section Window + +variable (b : ℕ) [NeZero b] + +/-- The `3 b` cells of the three blocks of a window, left to right. -/ +@[expose] def windowCells (w : Fin 3 → ZMod b → Option Bool) : List (Option Bool) := + (List.range (3 * b)).map fun c => if hc : c / b < 3 then w ⟨c / b, hc⟩ (c : ZMod b) else none + +/-- The finite storage of the configuration embedded at block indices `J` with control record +`cIn` and window contents `wIn` (`Turing.embedCfg`): each work tape holds the cells of its window +with its head on cell `b + offset`, in the middle block. -/ +@[expose] def localStart (input : List Bool) (J : Option (Fin k) → ℤ) + (cIn : BlockControl k State b) (wIn : Fin k → Fin 3 → ZMod b → Option Bool) : + LocalCfg k State where + state := cIn.1 + inputPos := (inputPosOfCoord input (b * J none + (cIn.2.1 none).val)).val + workTapes h := BiTape.ofCells (windowCells b (wIn h)) (b + (cIn.2.1 (some h)).val) + workTapePos h := b * J (some h) + (cIn.2.1 (some h)).val + track := cIn.2.2 + +/-- The window cells hold the window: the cell at offset `c` from the start of the window is +entry `c / b` of the window at `c mod b`. -/ +private theorem windowCell_eq (J : Option (Fin k) → ℤ) (w : Fin k → Fin 3 → ZMod b → Option Bool) + (h : Fin k) (c : ℤ) : + windowCell b J w h (b * (J (some h) - 1) + c) = + if 0 ≤ c then (windowCells b (w h)).getD c.toNat none else none := by + have hb : (0 : ℤ) < b := by exact_mod_cast Nat.pos_of_neZero b + have hdiv : (b * (J (some h) - 1) + c) / b = J (some h) - 1 + c / b := by + rw [add_comm, Int.add_mul_ediv_left _ _ hb.ne', add_comm] + unfold windowCell + by_cases hc : 0 ≤ c + · rw [ite_eq_left hc] + have hcn : (c.toNat : ℤ) = c := Int.toNat_of_nonneg hc + obtain ⟨d, hd⟩ : ∃ d, d = c.toNat / b := ⟨_, rfl⟩ + have hcd : c / b = (d : ℤ) := by + rw [hd, Int.natCast_div, hcn] + by_cases hlt : c.toNat < 3 * b + · have hcb : d < 3 := by + rw [hd, Nat.div_lt_iff_lt_mul (Nat.pos_of_neZero b)] + linarith + have hcond : 0 ≤ (b * (J (some h) - 1) + c) / b - J (some h) + 1 ∧ + (b * (J (some h) - 1) + c) / b - J (some h) + 1 < 3 := by + rw [hdiv, hcd] + omega + have hidx : ((b * (J (some h) - 1) + c) / b - J (some h) + 1).toNat = d := by + rw [hdiv, hcd] + omega + have hcast : (((b * (J (some h) - 1) + c : ℤ)) : ZMod b) = ((c.toNat : ℕ) : ZMod b) := by + rw [Int.cast_add, Int.cast_mul, Int.cast_natCast, ZMod.natCast_self, zero_mul, zero_add, + ← Int.cast_natCast, hcn] + rw [dite_eq_left hcond, windowCells, List.getD_eq_getElem?_getD, List.getElem?_map, + List.getElem?_range hlt, Option.map_some, Option.getD_some, ← hd, dite_eq_left hcb, + hcast] + simp only [hidx] + · have hlen : (windowCells b (w h)).length ≤ c.toNat := by + simp only [windowCells, List.length_map, List.length_range] + omega + rw [List.getD_eq_getElem?_getD, List.getElem?_eq_none hlen] + have : 3 ≤ c / b := by + rw [hcd] + have : 3 ≤ d := hd ▸ (Nat.le_div_iff_mul_le (Nat.pos_of_neZero b)).mpr (by omega) + omega + rw [dite_eq_right (by rw [hdiv]; omega)] + rfl + · rw [ite_eq_right hc] + have : c / b < 0 := Int.ediv_neg_of_neg_of_pos (by omega) hb + exact dite_eq_right (by rw [hdiv]; omega) + +/-- **The finite storage of an embedded window represents it.** -/ +theorem represents_localStart (input : List Bool) (J : Option (Fin k) → ℤ) + (cIn : BlockControl k State b) (wIn : Fin k → Fin 3 → ZMod b → Option Bool) : + (localStart b input J cIn wIn).Represents (embedCfg (input := input) b J cIn wIn) := by + refine ⟨rfl, rfl, fun h z => ?_, rfl, (OutputTrack.ofWord_toWord _).symm⟩ + rw [localStart, BiTape.read_ofCells] + change _ = windowCell b J wIn h (b * J (some h) + (cIn.2.1 (some h)).val + z) + rw [show (b : ℤ) * J (some h) + (cIn.2.1 (some h)).val + z = + b * (J (some h) - 1) + (((b + (cIn.2.1 (some h)).val : ℕ) : ℤ) + z) by push_cast; ring, + windowCell_eq] + +end Window + +/-! ### Interval steps by finite simulation -/ + +section Interval + +variable (b : ℕ) [NeZero b] + +/-- **The interval condition on finite storage**: replaying `coins` on the finite storage of the +embedded window leaves the control record `cOut` and the window contents `wOut`, and moves the +block of every head `h` by `δ h`. -/ +@[expose] def LocalIntervalStep (input : List Bool) (J : Option (Fin k) → ℤ) + (δ : Option (Fin k) → SignType) (cIn : BlockControl k State b) + (wIn : Fin k → Fin 3 → ZMod b → Option Bool) (coins : List Bool) + (cOut : BlockControl k State b) (wOut : Fin k → Fin 3 → ZMod b → Option Bool) : Prop := + (machine.localRun input coins (localStart b input J cIn wIn)).blockControl b = cOut ∧ + (machine.localRun input coins (localStart b input J cIn wIn)).windowContents b J = wOut ∧ + ∀ head, (machine.localRun input coins (localStart b input J cIn wIn)).blockIndex b head = + J head + δ head + +instance [DecidableEq State] (input : List Bool) (J : Option (Fin k) → ℤ) + (δ : Option (Fin k) → SignType) (cIn : BlockControl k State b) + (wIn : Fin k → Fin 3 → ZMod b → Option Bool) (coins : List Bool) + (cOut : BlockControl k State b) (wOut : Fin k → Fin 3 → ZMod b → Option Bool) : + Decidable (machine.LocalIntervalStep b input J δ cIn wIn coins cOut wOut) := by + unfold LocalIntervalStep + infer_instance + +/-- **Interval steps are decided by finite simulation.** -/ +theorem intervalStep_iff_localIntervalStep (input : List Bool) (J : Option (Fin k) → ℤ) + (δ : Option (Fin k) → SignType) (cIn : BlockControl k State b) + (wIn : Fin k → Fin 3 → ZMod b → Option Bool) (coins : List Bool) + (cOut : BlockControl k State b) (wOut : Fin k → Fin 3 → ZMod b → Option Bool) : + machine.IntervalStep b input J δ cIn wIn coins cOut wOut ↔ + machine.LocalIntervalStep b input J δ cIn wIn coins cOut wOut := by + have h := (represents_localStart b input J cIn wIn).localRun machine coins + simp only [IntervalStep, LocalIntervalStep, h.blockControl, h.windowContents, + h.blockIndex] + +open scoped Classical in +/-- **Interval tensors by finite simulation**: the interval tensor counts the bit strings that +satisfy the interval condition on finite storage. -/ +theorem intervalCount_eq_card_localIntervalStep (input : List Bool) (J : Option (Fin k) → ℤ) + (δ : Option (Fin k) → SignType) (cIn : BlockControl k State b) + (wIn : Fin k → Fin 3 → ZMod b → Option Bool) + (cOut : BlockControl k State b) (wOut : Fin k → Fin 3 → ZMod b → Option Bool) : + machine.intervalCount b input J δ cIn wIn cOut wOut = + (Finset.univ.filter fun u : Fin b → Bool => + machine.LocalIntervalStep b input J δ cIn wIn (List.ofFn u) cOut wOut).card := by + unfold intervalCount + congr 1 + ext u + simp only [Finset.mem_filter, Finset.mem_univ, true_and, + intervalStep_iff_localIntervalStep] + +end Interval + +end Turing.MultiTapePTM diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalTensor.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalTensor.lean index 18eaa4a012..2d81fe6adb 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalTensor.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalTensor.lean @@ -238,8 +238,9 @@ variable (b : ℕ) [NeZero b] /-- **An interval step.** Replaying `coins` from the configuration embedded at block indices `J` with entering control record `cIn` and window contents `wIn` leaves the control record `cOut`, the contents `wOut` of the same windows, and moves the block of every head `h` by `δ h`. -/ -def IntervalStep (input : List Bool) (J : Option (Fin k) → ℤ) (δ : Option (Fin k) → SignType) - (cIn : BlockControl k State b) (wIn : Fin k → Fin 3 → ZMod b → Option Bool) +@[expose] def IntervalStep (input : List Bool) (J : Option (Fin k) → ℤ) + (δ : Option (Fin k) → SignType) (cIn : BlockControl k State b) + (wIn : Fin k → Fin 3 → ZMod b → Option Bool) (coins : List Bool) (cOut : BlockControl k State b) (wOut : Fin k → Fin 3 → ZMod b → Option Bool) : Prop := (machine.stepCoins coins (embedCfg (input := input) b J cIn wIn)).blockControl b = cOut ∧ @@ -252,7 +253,7 @@ open scoped Classical in step from the entering record `cIn` and contents `wIn` at block indices `J` to the leaving record `cOut` and contents `wOut`, moving the blocks by `δ`. This is the entry `F_i` of the note's equation (3). -/ -noncomputable def intervalCount (input : List Bool) (J : Option (Fin k) → ℤ) +@[expose] noncomputable def intervalCount (input : List Bool) (J : Option (Fin k) → ℤ) (δ : Option (Fin k) → SignType) (cIn : BlockControl k State b) (wIn : Fin k → Fin 3 → ZMod b → Option Bool) (cOut : BlockControl k State b) (wOut : Fin k → Fin 3 → ZMod b → Option Bool) : ℕ := diff --git a/Complexity/Foundations/Data/BiTape/OfCells.lean b/Complexity/Foundations/Data/BiTape/OfCells.lean new file mode 100644 index 0000000000..fa63005b2b --- /dev/null +++ b/Complexity/Foundations/Data/BiTape/OfCells.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Foundations.Data.BiTape + +/-! +# Tapes holding a finite list of cells + +`Cslib.Turing.BiTape.ofCells cells pos` is the tape that holds the list `cells` of optional +symbols, blanks allowed anywhere, with its head on cell `pos`: cell `i` of the list is at +displacement `i - pos` from the head and every other cell is blank +(`Cslib.Turing.BiTape.read_ofCells`). It loads a finite window of a tape, such as the blocks +around a head, into finite storage. + +## Main definitions + +* `Cslib.Turing.BiTape.ofCells`: the tape holding a list of cells. + +## Main results + +* `Cslib.Turing.StackTape.read_ofList`: a stack tape built from a list reads the list. +* `Cslib.Turing.BiTape.read_ofCells`: the cells of the tape. +-/ + +public section + +namespace Cslib.Turing + +namespace StackTape + +variable {Symbol : Type*} + +/-- A stack tape built from a list reads the list, and blank past its end. -/ +@[simp] lemma read_ofList (l : List (Option Symbol)) (position : ℕ) : + (ofList l).read position = l.getD position none := by + induction l generalizing position with + | nil => simp + | cons a l ih => + cases position with + | zero => simp [head_cons] + | succ position => simp [tail_cons, ih] + +end StackTape + +namespace BiTape + +variable {Symbol : Type*} + +/-- The tape holding `cells` with its head on cell `pos`: cell `i` of `cells` is at displacement +`i - pos` from the head, and every other cell is blank. -/ +@[expose] def ofCells (cells : List (Option Symbol)) (pos : ℕ) : BiTape Symbol := + ⟨cells.getD pos none, + StackTape.ofList ((List.range pos).map fun i => cells.getD (pos - 1 - i) none), + StackTape.ofList (cells.drop (pos + 1))⟩ + +/-- **The cells of `ofCells cells pos`**: the cell at displacement `z` is cell `pos + z` of +`cells`, blank when that is negative or past the end. -/ +lemma read_ofCells (cells : List (Option Symbol)) (pos : ℕ) (z : ℤ) : + (ofCells cells pos).read z = + if 0 ≤ (pos : ℤ) + z then cells.getD ((pos : ℤ) + z).toNat none else none := by + rcases z with (_ | n) | n + · simp [read, ofCells] + · have h : ((pos : ℤ) + Int.ofNat (n + 1)).toNat = pos + 1 + n := by + simp only [Int.ofNat_eq_natCast] + omega + have h0 : 0 ≤ (pos : ℤ) + Int.ofNat (n + 1) := by + simp only [Int.ofNat_eq_natCast] + omega + simp only [h0, ↓reduceIte, h] + simp [read, ofCells, List.getD_eq_getElem?_getD, List.getElem?_drop] + · simp only [read, ofCells, StackTape.read_ofList, List.getD_eq_getElem?_getD, + List.getElem?_map] + by_cases hn : n < pos + · have h : ((pos : ℤ) + Int.negSucc n).toNat = pos - 1 - n := by + simp only [Int.negSucc_eq] + omega + have h0 : 0 ≤ (pos : ℤ) + Int.negSucc n := by + simp only [Int.negSucc_eq] + omega + simp only [h0, ↓reduceIte, h, List.getElem?_range hn] + rfl + · have h0 : ¬ 0 ≤ (pos : ℤ) + Int.negSucc n := by + simp only [Int.negSucc_eq] + omega + simp only [h0, ↓reduceIte, + List.getElem?_eq_none (by simpa using hn : (List.range pos).length ≤ n)] + rfl + +end BiTape + +end Cslib.Turing diff --git a/ComplexityTests/HPVIntervalSimulation.lean b/ComplexityTests/HPVIntervalSimulation.lean new file mode 100644 index 0000000000..bd65757af3 --- /dev/null +++ b/ComplexityTests/HPVIntervalSimulation.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalSimulation + +/-! Interval steps of a concrete fair-coin machine, decided by finite simulation: the finite +storage of an embedded window is evaluated, and the semantic interval step follows. -/ + +namespace ComplexityTests.HPVIntervalSimulation + +open Turing MultiTapeMachine MultiTapePTM MultiTapeNTM.ChoiceTable Cslib.Turing + +/-- On one work tape, write every coin and move right; the input head moves right too. The first +step emits its coin; then the machine keeps walking without output. -/ +private def walk : MultiTapePTM 1 Bool Bool where + initial := false + tr state _ _ _ bit := .step + { inputTape := 1, + workTapes := fun _ => (some (some bit), 1), + output := if state then none else some bit, state := some true } + Empty.elim Empty.elim + +/-- The blocks of the start: every head in block `0` at offset `0`. -/ +private def J₀ : Option (Fin 1) → ℤ := fun _ => 0 + +/-- The start record: state `false`, offsets `0`, nothing emitted. -/ +private def c₀ : BlockControl 1 Bool 2 := (some false, fun _ => 0, .empty) + +/-- After the coins `true, false`: state `true`; the input head at coordinate `1` (clamped at the +right end cell of the one-symbol input), offset `1`; the work head at `2`, offset `0` in block +`1`; and the emitted word `[true]`. -/ +private def c₁ : BlockControl 1 Bool 2 := + (some true, fun head => match head with | none => 1 | some _ => 0, .accept) + +/-- The work tape after the coins `true, false`: the middle block holds them. -/ +private def w₁ : Fin 1 → Fin 3 → ZMod 2 → Option Bool := fun _ d r => + if d = 1 then some (r = 0) else none + +/-- The blocks move: the input head stays in block `0`, the work head moves to block `1`. -/ +private def δ₁ : Option (Fin 1) → SignType := fun head => match head with | none => 0 | some _ => 1 + +-- The finite simulation decides the interval condition by evaluation. +example : walk.LocalIntervalStep 2 [true] J₀ δ₁ c₀ (fun _ _ _ => none) [true, false] c₁ w₁ := by + decide + +-- A different leaving record (output track `other`) fails. +example : ¬ walk.LocalIntervalStep 2 [true] J₀ δ₁ c₀ (fun _ _ _ => none) [true, false] + (some true, fun head => match head with | none => 1 | some _ => 0, .other) w₁ := by + decide + +-- So the semantic interval step on the integer-indexed tapes holds. +example : walk.IntervalStep 2 [true] J₀ δ₁ c₀ (fun _ _ _ => none) [true, false] c₁ w₁ := + (walk.intervalStep_iff_localIntervalStep 2 _ _ _ _ _ _ _ _).mpr (by decide) + +end ComplexityTests.HPVIntervalSimulation From 93e3c1e841232cfa3300f797d2dd5d1af31fed36 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 21:56:51 -0400 Subject: [PATCH 11/19] refactor(machines): expose the block-network graph API (#1833 H3) Make firstAfter/lastBefore and their characterizations public, add firstAfter_eq_none_iff, expose inWindow, IntervalHolds and edgeTarget, and state the sources, targets and tensors of blockNetwork as public lemmas, so that a computable twin of the network can be proved equal to it. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../MultiTape/Probabilistic/BlockNetwork.lean | 68 +++++++++++++++---- 1 file changed, 53 insertions(+), 15 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/BlockNetwork.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/BlockNetwork.lean index 32b9261096..4e44f319be 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/BlockNetwork.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/BlockNetwork.lean @@ -67,6 +67,8 @@ bipartite Boolean network with `O(q b)` edges and degree `O(b)`, as in the note. ## Main definitions * `Turing.MultiTapePTM.scheduleBlock`: block indices prescribed by a schedule. +* `Turing.MultiTapePTM.firstAfter`, `Turing.MultiTapePTM.lastBefore`: the next and the previous + appearance of a block in windows. * `Turing.MultiTapePTM.InWindow`, `Turing.MultiTapePTM.portBlock`, `Turing.MultiTapePTM.portOf`: windows and window entries under a schedule. * `Turing.MultiTapePTM.BlockEdge`, `Turing.MultiTapePTM.BlockLetter`: edges and letters. @@ -146,18 +148,18 @@ theorem blockIndex_intervalStart_eq_scheduleBlock (machine : MultiTapePTM k Bool /-! ### Appearances of a block in windows -/ /-- The first index after `i` satisfying `p`, if any. -/ -private def firstAfter (p : Fin q → Prop) [DecidablePred p] (i : Fin q) : Option (Fin q) := +def firstAfter (p : Fin q → Prop) [DecidablePred p] (i : Fin q) : Option (Fin q) := if h : (Finset.univ.filter fun i' => i < i' ∧ p i').Nonempty then some ((Finset.univ.filter fun i' => i < i' ∧ p i').min' h) else none /-- The last index before `i` satisfying `p`, if any. -/ -private def lastBefore (p : Fin q → Prop) [DecidablePred p] (i : Fin q) : Option (Fin q) := +def lastBefore (p : Fin q → Prop) [DecidablePred p] (i : Fin q) : Option (Fin q) := if h : (Finset.univ.filter fun i' => i' < i ∧ p i').Nonempty then some ((Finset.univ.filter fun i' => i' < i ∧ p i').max' h) else none -private theorem firstAfter_eq_some_iff {p : Fin q → Prop} [DecidablePred p] {i i' : Fin q} : +theorem firstAfter_eq_some_iff {p : Fin q → Prop} [DecidablePred p] {i i' : Fin q} : firstAfter p i = some i' ↔ i < i' ∧ p i' ∧ ∀ j, i < j → j < i' → ¬ p j := by unfold firstAfter split_ifs with h @@ -176,7 +178,7 @@ private theorem firstAfter_eq_some_iff {p : Fin q → Prop} [DecidablePred p] {i rintro ⟨hlt, hp, -⟩ exact h ⟨i', by simp [hlt, hp]⟩ -private theorem lastBefore_eq_some_iff {p : Fin q → Prop} [DecidablePred p] {i i' : Fin q} : +theorem lastBefore_eq_some_iff {p : Fin q → Prop} [DecidablePred p] {i i' : Fin q} : lastBefore p i = some i' ↔ i' < i ∧ p i' ∧ ∀ j, i' < j → j < i → ¬ p j := by unfold lastBefore split_ifs with h @@ -195,7 +197,7 @@ private theorem lastBefore_eq_some_iff {p : Fin q → Prop} [DecidablePred p] {i rintro ⟨hlt, hp, -⟩ exact h ⟨i', by simp [hlt, hp]⟩ -private theorem lastBefore_eq_none_iff {p : Fin q → Prop} [DecidablePred p] {i : Fin q} : +theorem lastBefore_eq_none_iff {p : Fin q → Prop} [DecidablePred p] {i : Fin q} : lastBefore p i = none ↔ ∀ j, j < i → ¬ p j := by unfold lastBefore split_ifs with h @@ -206,13 +208,24 @@ private theorem lastBefore_eq_none_iff {p : Fin q → Prop} [DecidablePred p] {i intro j hj hp exact h ⟨j, by simp [hj, hp]⟩ +theorem firstAfter_eq_none_iff {p : Fin q → Prop} [DecidablePred p] {i : Fin q} : + firstAfter p i = none ↔ ∀ j, i < j → ¬ p j := by + unfold firstAfter + split_ifs with h + · simp only [false_iff, not_forall, not_not] + obtain ⟨j, hj⟩ := h + exact ⟨j, (Finset.mem_filter.mp hj).2.1, (Finset.mem_filter.mp hj).2.2⟩ + · simp only [true_iff] + intro j hj hp + exact h ⟨j, by simp [hj, hp]⟩ + /-- Consecutive appearances: the last appearance before `i` has `i` as its next appearance. -/ -private theorem firstAfter_of_lastBefore {p : Fin q → Prop} [DecidablePred p] {i i' : Fin q} +theorem firstAfter_of_lastBefore {p : Fin q → Prop} [DecidablePred p] {i i' : Fin q} (hi : p i) (h : lastBefore p i = some i') : firstAfter p i' = some i := by obtain ⟨hlt, -, hbetween⟩ := lastBefore_eq_some_iff.mp h exact firstAfter_eq_some_iff.mpr ⟨hlt, hi, hbetween⟩ -private theorem lastBefore_of_firstAfter {p : Fin q → Prop} [DecidablePred p] {i i' : Fin q} +theorem lastBefore_of_firstAfter {p : Fin q → Prop} [DecidablePred p] {i i' : Fin q} (hi' : p i') (h : firstAfter p i' = some i) : lastBefore p i = some i' := by obtain ⟨hlt, -, hbetween⟩ := firstAfter_eq_some_iff.mp h exact lastBefore_eq_some_iff.mpr ⟨hlt, hi', hbetween⟩ @@ -282,7 +295,7 @@ letter on the control edge leaving interval `i - 1`. -/ variable {b} in /-- The window contents entering interval `i`: each block is read from the edge leaving the previous interval whose window contains it, and is blank if there is none. -/ -def inWindow (i : Fin q) (x : BlockEdge k q → BlockLetter k State b) : +@[expose] def inWindow (i : Fin q) (x : BlockEdge k q → BlockLetter k State b) : Fin k → Fin 3 → ZMod b → Option Bool := fun h d => (lastBefore (InWindow σ h (portBlock σ i h d)) i).elim (fun _ => none) fun i' => (x (.inr (i', h, portOf σ i' h (portBlock σ i h d)))).contents @@ -290,14 +303,14 @@ def inWindow (i : Fin q) (x : BlockEdge k q → BlockLetter k State b) : /-- The edge condition at interval `i` for the bits `u`: an interval step from the entering record and window to the letters on the edges leaving `i`, which must be of the right kinds, moving the blocks as `σ i` prescribes. -/ -def IntervalHolds (i : Fin q) (x : BlockEdge k q → BlockLetter k State b) (u : Fin b → Bool) : - Prop := +@[expose] def IntervalHolds (i : Fin q) (x : BlockEdge k q → BlockLetter k State b) + (u : Fin b → Bool) : Prop := ∃ cOut wOut, machine.IntervalStep b input (scheduleBlock σ i) (σ i) (machine.inControl b i x) (inWindow σ i x) (List.ofFn u) cOut wOut ∧ x (.inl i) = .inl cOut ∧ ∀ h d, x (.inr (i, h, d)) = .inr (wOut h d) /-- The target of an edge: the interval reading it next, or its sink. -/ -def edgeTarget : BlockEdge k q → Fin q ⊕ BlockEdge k q +@[expose] def edgeTarget : BlockEdge k q → Fin q ⊕ BlockEdge k q | .inl i => if hi : i.val + 1 < q then .inl ⟨i + 1, hi⟩ else .inr (.inl i) | .inr (i, h, d) => (firstAfter (InWindow σ h (portBlock σ i h d)) i).elim (.inr (.inr (i, h, d))) .inl @@ -699,12 +712,37 @@ theorem tensor_blockNetwork_le (v : Fin q ⊕ BlockEdge k q) omit [NeZero b] in /-- The source of an edge is its interval. -/ -private theorem blockNetwork_src (e : BlockEdge k q) : - (machine.blockNetwork input b σ).src e = .inl (e.elim id Prod.fst) := rfl +theorem blockNetwork_src (e : BlockEdge k q) : + (machine.blockNetwork input b σ).src e = .inl (e.elim id Prod.fst) := by + unfold blockNetwork; rfl omit [NeZero b] in -private theorem blockNetwork_tgt (e : BlockEdge k q) : - (machine.blockNetwork input b σ).tgt e = edgeTarget σ e := rfl +/-- The target of an edge is the interval reading it next, or its sink. -/ +theorem blockNetwork_tgt (e : BlockEdge k q) : + (machine.blockNetwork input b σ).tgt e = edgeTarget σ e := by + unfold blockNetwork; rfl + +open scoped Classical in +omit [NeZero b] in +/-- The tensor of an interval counts the bit strings satisfying its condition. -/ +theorem blockNetwork_tensor_interval (i : Fin q) (x : BlockEdge k q → BlockLetter k State b) : + (machine.blockNetwork input b σ).tensor (.inl i) x = + (Finset.univ.filter fun u => machine.IntervalHolds input b σ i x u).card := by + unfold blockNetwork; rfl + +omit [NeZero b] in +/-- The sink of a control edge accepts the last control record, and is `1` otherwise. -/ +theorem blockNetwork_tensor_controlSink (i : Fin q) (x : BlockEdge k q → BlockLetter k State b) : + (machine.blockNetwork input b σ).tensor (.inr (.inl i)) x = + if i.val + 1 = q then acceptWeight (x (.inl i)) else 1 := by + unfold blockNetwork; rfl + +omit [NeZero b] in +/-- The sink of a block edge is the constant `1`. -/ +theorem blockNetwork_tensor_blockSink (e : Fin q × Fin k × Fin 3) + (x : BlockEdge k q → BlockLetter k State b) : + (machine.blockNetwork input b σ).tensor (.inr (.inr e)) x = 1 := by + unfold blockNetwork; rfl omit [NeZero b] in /-- Every edge goes forward in time, from its interval to a later interval or to a sink. -/ From a68faf1d1b0dbcf1e8bcb9f249ac22a4c8d45bc7 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 22:04:23 -0400 Subject: [PATCH 12/19] feat(machines): interval counts on plain data (#1833 H3) Restate the interval tensor on plain data: control records with offsets as natural numbers and windows as their 3b cells. Block indices and offsets are compared without division (z = b q + r with r < b), and the count runs over the enumeration of coin strings. localIntervalCount_eq_intervalCount relates it to the semantic interval tensor; a test evaluates it on a concrete machine. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 1 + .../Probabilistic/IntervalCount.lean | 271 ++++++++++++++++++ ComplexityTests/HPVIntervalCount.lean | 71 +++++ 3 files changed, 343 insertions(+) create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount.lean create mode 100644 ComplexityTests/HPVIntervalCount.lean diff --git a/Complexity.lean b/Complexity.lean index a30ece7cfc..7d07e52199 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -1814,6 +1814,7 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.D public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExtendTapes public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.InputFromTape +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalCount public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalSimulation public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalTensor public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IterateWhile diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount.lean new file mode 100644 index 0000000000..e87ab067cb --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount.lean @@ -0,0 +1,271 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalSimulation +public import Complexity.Foundations.Data.BitString.Enumeration + +/-! +# Interval counts on list data + +The interval tensor of the block-counting networks of #1833 +(`Turing.MultiTapePTM.intervalCount`) takes a control record with offsets in `ZMod b` and window +contents indexed by `ZMod b`. This module restates it on plain data, the form in which a +polynomial-time construction of the networks computes it: a control record with offsets as +natural numbers (`Turing.MultiTapePTM.ControlData`, `Turing.MultiTapePTM.controlData`) and the +window of each work tape as the list of its `3 b` cells (`Turing.MultiTapePTM.windowCells`). + +On such data, the finite storage of the embedded window is +`Turing.MultiTapePTM.localStartData`, and the interval condition +(`Turing.MultiTapePTM.LocalIntervalStepData`) compares the state and output track after the +replay, the coordinate of every head with its prescribed block start plus offset, and the cells +of every window with the given lists. Block indices and offsets need no division: a coordinate `z` +has block index `q` and offset `r` modulo `b` exactly when `r < b` and `z = b q + r`. The interval +count (`Turing.MultiTapePTM.localIntervalCount`) counts the coin strings of the enumeration +`Cslib.BitString.enumList b` satisfying the condition, and agrees with the interval tensor +(`Turing.MultiTapePTM.localIntervalCount_eq_intervalCount`). + +## Main definitions + +* `Turing.MultiTapePTM.ControlData`, `Turing.MultiTapePTM.controlData`: control records on + plain data. +* `Turing.MultiTapePTM.localStartData`: the finite storage of an embedded window. +* `Turing.MultiTapePTM.LocalCfg.headCoord`, `Turing.MultiTapePTM.LocalCfg.windowCellsAt`: the + coordinates of the heads and the cells of a window on finite storage. +* `Turing.MultiTapePTM.LocalIntervalStepData`, `Turing.MultiTapePTM.localIntervalCount`: the + interval condition and the interval count on plain data. + +## Main results + +* `Turing.MultiTapePTM.localIntervalStepData_iff`: the condition on plain data is the interval + condition on finite storage. +* `Turing.MultiTapePTM.localIntervalCount_eq_intervalCount`: the count on plain data is the + interval tensor. +-/ + +public section + +namespace Turing.MultiTapePTM + +open MultiTapeNTM.ChoiceTable Cslib.Turing + +variable {k : ℕ} {State : Type} + +/-! ### Plain data -/ + +/-- A control record on plain data: the state, the offset of every head as a natural number, and +the output track. -/ +abbrev ControlData (k : ℕ) (State : Type) := Option State × (Option (Fin k) → ℕ) × OutputTrack + +/-- A control record as plain data: its offsets by their values. -/ +@[expose] def controlData {b : ℕ} [NeZero b] (c : BlockControl k State b) : ControlData k State := + (c.1, fun head => (c.2.1 head).val, c.2.2) + +/-- The finite storage of the configuration embedded at block indices `J` with the control +record `cIn` and the window cells `wIn` (the `3 b` cells of each window, left to right): each +work tape holds the cells of its window with its head on cell `b + offset`. -/ +@[expose] def localStartData (b : ℕ) (input : List Bool) (J : Option (Fin k) → ℤ) + (cIn : ControlData k State) (wIn : Fin k → List (Option Bool)) : LocalCfg k State where + state := cIn.1 + inputPos := (inputPosOfCoord input (b * J none + cIn.2.1 none)).val + workTapes h := BiTape.ofCells (wIn h) (b + cIn.2.1 (some h)) + workTapePos h := b * J (some h) + cIn.2.1 (some h) + track := cIn.2.2 + +/-- On the data of a control record and window contents, `localStartData` is `localStart`. -/ +theorem localStartData_controlData (b : ℕ) [NeZero b] (input : List Bool) + (J : Option (Fin k) → ℤ) (cIn : BlockControl k State b) + (wIn : Fin k → Fin 3 → ZMod b → Option Bool) : + localStartData b input J (controlData cIn) (fun h => windowCells b (wIn h)) = + localStart b input J cIn wIn := rfl + +/-- The coordinate of every head of finite storage: the input position less one for the input +head, and the absolute position for a work head. -/ +@[expose] def LocalCfg.headCoord (l : LocalCfg k State) : Option (Fin k) → ℤ + | none => (l.inputPos : ℤ) - 1 + | some h => l.workTapePos h + +/-- The `3 b` cells of the window of work tape `h` around block index `j`, left to right. -/ +@[expose] def LocalCfg.windowCellsAt (b : ℕ) (j : ℤ) (l : LocalCfg k State) (h : Fin k) : + List (Option Bool) := + (List.range (3 * b)).map fun c : ℕ => + (l.workTapes h).read (b * (j - 1) + (c : ℤ) - l.workTapePos h) + +/-! ### Block indices and offsets without division -/ + +section Arithmetic + +variable {b : ℕ} [NeZero b] + +/-- A coordinate has block index `q` and offset `r` exactly when it is `b q + r`. -/ +theorem intCast_eq_and_ediv_eq_iff (z q : ℤ) (r : ZMod b) : + ((z : ZMod b) = r ∧ z / b = q) ↔ z = b * q + r.val := by + have hb : (0 : ℤ) < b := by exact_mod_cast Nat.pos_of_neZero b + have hr : (r.val : ℤ) < b := by exact_mod_cast ZMod.val_lt r + constructor + · rintro ⟨hz, hq⟩ + have hval : ((z : ZMod b).val : ℤ) = z % b := ZMod.val_intCast z + rw [hz] at hval + rw [hval, ← hq] + exact (Int.mul_ediv_add_emod z b).symm + · rintro rfl + constructor + · simp + · rw [add_comm, Int.add_mul_ediv_left _ _ hb.ne'] + rw [Int.ediv_eq_zero_of_lt (by positivity) hr, zero_add] + +/-- The offsets and block indices of finite storage, compared with a control record's offsets and +prescribed block indices, are its head coordinates. -/ +theorem blockControl_eq_and_blockIndex_iff (l : LocalCfg k State) (c : BlockControl k State b) + (J : Option (Fin k) → ℤ) : + (l.blockControl b = c ∧ ∀ head, l.blockIndex b head = J head) ↔ + l.state = c.1 ∧ l.track = c.2.2 ∧ + ∀ head, l.headCoord head = b * J head + (c.2.1 head).val := by + obtain ⟨s, off, tr⟩ := c + have hcoord : ∀ head, ((l.blockControl b).2.1 head = off head ∧ l.blockIndex b head = J head) ↔ + l.headCoord head = b * J head + (off head).val := by + intro head + rw [← intCast_eq_and_ediv_eq_iff] + cases head <;> rfl + simp only [LocalCfg.blockControl, Prod.mk.injEq] at hcoord ⊢ + constructor + · rintro ⟨⟨hs, hoff, htr⟩, hJ⟩ + exact ⟨hs, htr, fun head => (hcoord head).mp ⟨congrFun hoff head, hJ head⟩⟩ + · rintro ⟨hs, htr, hJ⟩ + exact ⟨⟨hs, funext fun head => ((hcoord head).mpr (hJ head)).1, htr⟩, + fun head => ((hcoord head).mpr (hJ head)).2⟩ + +/-- The window contents of finite storage are `w` exactly when the cells of every window are the +window cells of `w`. -/ +theorem windowContents_eq_iff (l : LocalCfg k State) (J : Option (Fin k) → ℤ) + (w : Fin k → Fin 3 → ZMod b → Option Bool) : + l.windowContents b J = w ↔ ∀ h, l.windowCellsAt b (J (some h)) h = windowCells b (w h) := by + have hb : 0 < b := Nat.pos_of_neZero b + constructor + · rintro rfl h + unfold LocalCfg.windowCellsAt windowCells + refine List.map_congr_left fun c hc => ?_ + have hc3 : c / b < 3 := by + rw [Nat.div_lt_iff_lt_mul hb] + simpa [Nat.mul_comm] using List.mem_range.mp hc + rw [dite_eq_left hc3] + simp only [LocalCfg.windowContents, ZMod.val_natCast] + congr 1 + have h := Nat.div_add_mod c b + zify at h + push_cast + linear_combination (-1 : ℤ) * h + · intro hw + funext h d r + have hwh := hw h + unfold LocalCfg.windowCellsAt windowCells at hwh + have hlt : b * (d : ℕ) + r.val < 3 * b := by + have := d.isLt + have := ZMod.val_lt r + nlinarith + have hcell := List.map_inj_left.mp hwh (b * d + r.val) (List.mem_range.mpr hlt) + have hdiv : (b * d + r.val) / b = d := by + rw [Nat.add_comm, Nat.add_mul_div_left _ _ hb, Nat.div_eq_of_lt (ZMod.val_lt r), zero_add] + simp only [hdiv, d.isLt, dite_true] at hcell + have hcast : ((b * d + r.val : ℕ) : ZMod b) = r := by + push_cast + simp + rw [hcast] at hcell + rw [← hcell] + simp only [LocalCfg.windowContents] + congr 1 + push_cast + ring + +end Arithmetic + +/-! ### The interval condition and count on plain data -/ + +section Interval + +variable (machine : MultiTapePTM k Bool State) (b : ℕ) + +/-- **The interval condition on plain data**: replaying `coins` on the finite storage of the +embedded window leaves the state and the output track of `cOut`, puts every head at its +prescribed block start `b (J + δ)` plus its offset in `cOut`, which is below `b`, and leaves the +window cells `wOut`. -/ +@[expose] def LocalIntervalStepData (input : List Bool) (J : Option (Fin k) → ℤ) + (δ : Option (Fin k) → SignType) (cIn : ControlData k State) + (wIn : Fin k → List (Option Bool)) (cOut : ControlData k State) + (wOut : Fin k → List (Option Bool)) (coins : List Bool) : Prop := + (machine.localRun input coins (localStartData b input J cIn wIn)).state = cOut.1 ∧ + (machine.localRun input coins (localStartData b input J cIn wIn)).track = cOut.2.2 ∧ + (∀ head, cOut.2.1 head < b ∧ + (machine.localRun input coins (localStartData b input J cIn wIn)).headCoord head = + b * (J head + δ head) + cOut.2.1 head) ∧ + ∀ h, (machine.localRun input coins (localStartData b input J cIn wIn)).windowCellsAt b + (J (some h)) h = wOut h + +instance [DecidableEq State] (input : List Bool) (J : Option (Fin k) → ℤ) + (δ : Option (Fin k) → SignType) (cIn : ControlData k State) + (wIn : Fin k → List (Option Bool)) (cOut : ControlData k State) + (wOut : Fin k → List (Option Bool)) (coins : List Bool) : + Decidable (machine.LocalIntervalStepData b input J δ cIn wIn cOut wOut coins) := by + unfold LocalIntervalStepData + infer_instance + +/-- **The interval condition on plain data is the interval condition on finite storage.** -/ +theorem localIntervalStepData_iff [NeZero b] (input : List Bool) (J : Option (Fin k) → ℤ) + (δ : Option (Fin k) → SignType) (cIn : BlockControl k State b) + (wIn : Fin k → Fin 3 → ZMod b → Option Bool) (cOut : BlockControl k State b) + (wOut : Fin k → Fin 3 → ZMod b → Option Bool) (coins : List Bool) : + machine.LocalIntervalStepData b input J δ (controlData cIn) (fun h => windowCells b (wIn h)) + (controlData cOut) (fun h => windowCells b (wOut h)) coins ↔ + machine.LocalIntervalStep b input J δ cIn wIn coins cOut wOut := by + set l := machine.localRun input coins (localStart b input J cIn wIn) + have hcontrol := blockControl_eq_and_blockIndex_iff l cOut (fun head => J head + δ head) + have hwindow := windowContents_eq_iff l J wOut + have hlt : ∀ head, (cOut.2.1 head).val < b := fun head => ZMod.val_lt _ + simp only [LocalIntervalStepData, LocalIntervalStep, controlData] + change (l.state = cOut.1 ∧ l.track = cOut.2.2 ∧ (∀ head, (cOut.2.1 head).val < b ∧ + l.headCoord head = b * (J head + δ head) + (cOut.2.1 head).val) ∧ + ∀ h, l.windowCellsAt b (J (some h)) h = windowCells b (wOut h)) ↔ + l.blockControl b = cOut ∧ l.windowContents b J = wOut ∧ + ∀ head, l.blockIndex b head = J head + δ head + rw [hwindow] + constructor + · rintro ⟨hs, htr, hcoord, hw⟩ + obtain ⟨hc, hJ⟩ := hcontrol.mpr ⟨hs, htr, fun head => (hcoord head).2⟩ + exact ⟨hc, hw, hJ⟩ + · rintro ⟨hc, hw, hJ⟩ + obtain ⟨hs, htr, hcoord⟩ := hcontrol.mp ⟨hc, hJ⟩ + exact ⟨hs, htr, fun head => ⟨hlt head, hcoord head⟩, hw⟩ + +/-- **The interval count on plain data**: the number of coin strings of `b` bits satisfying the +interval condition. -/ +@[expose] def localIntervalCount [DecidableEq State] (input : List Bool) (J : Option (Fin k) → ℤ) + (δ : Option (Fin k) → SignType) (cIn : ControlData k State) + (wIn : Fin k → List (Option Bool)) (cOut : ControlData k State) + (wOut : Fin k → List (Option Bool)) : ℕ := + (Cslib.BitString.enumList b).countP fun coins => + decide (machine.LocalIntervalStepData b input J δ cIn wIn cOut wOut coins) + +/-- **The interval count on plain data is the interval tensor.** -/ +theorem localIntervalCount_eq_intervalCount [DecidableEq State] [NeZero b] (input : List Bool) + (J : Option (Fin k) → ℤ) (δ : Option (Fin k) → SignType) (cIn : BlockControl k State b) + (wIn : Fin k → Fin 3 → ZMod b → Option Bool) (cOut : BlockControl k State b) + (wOut : Fin k → Fin 3 → ZMod b → Option Bool) : + machine.localIntervalCount b input J δ (controlData cIn) (fun h => windowCells b (wIn h)) + (controlData cOut) (fun h => windowCells b (wOut h)) = + machine.intervalCount b input J δ cIn wIn cOut wOut := by + classical + rw [localIntervalCount, Cslib.BitString.countP_enumList, + intervalCount_eq_card_localIntervalStep] + congr 1 + ext u + simp only [Finset.mem_filter, Finset.mem_univ, true_and, decide_eq_true_eq, + localIntervalStepData_iff] + +end Interval + +end Turing.MultiTapePTM diff --git a/ComplexityTests/HPVIntervalCount.lean b/ComplexityTests/HPVIntervalCount.lean new file mode 100644 index 0000000000..acc7c73183 --- /dev/null +++ b/ComplexityTests/HPVIntervalCount.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalCount + +/-! Interval counts of a concrete fair-coin machine on plain data: the count is evaluated, and +the interval tensor follows. -/ + +namespace ComplexityTests.HPVIntervalCount + +open Turing MultiTapeMachine MultiTapePTM MultiTapeNTM.ChoiceTable Cslib.Turing + +/-- On one work tape, write every coin and move right; the input head moves right too. The first +step emits its coin; then the machine keeps walking without output. -/ +private def walk : MultiTapePTM 1 Bool Bool where + initial := false + tr state _ _ _ bit := .step + { inputTape := 1, + workTapes := fun _ => (some (some bit), 1), + output := if state then none else some bit, state := some true } + Empty.elim Empty.elim + +/-- The blocks of the start: every head in block `0`. -/ +private def J₀ : Option (Fin 1) → ℤ := fun _ => 0 + +/-- The input head stays in block `0`, the work head moves to block `1`. -/ +private def δ₁ : Option (Fin 1) → SignType := fun head => match head with | none => 0 | some _ => 1 + +/-- The start record: state `false`, offsets `0`, nothing emitted. -/ +private def c₀ : BlockControl 1 Bool 2 := (some false, fun _ => 0, .empty) + +/-- After the coins `true, false`: state `true`, the input head at offset `1`, the work head at +offset `0` of block `1`, and output track `accept`. -/ +private def c₁ : BlockControl 1 Bool 2 := + (some true, fun head => match head with | none => 1 | some _ => 0, .accept) + +/-- The work tape after the coins `true, false`: the middle block holds them. -/ +private def w₁ : Fin 1 → Fin 3 → ZMod 2 → Option Bool := fun _ d r => + if d = 1 then some (r = 0) else none + +-- The plain data of the records and windows. +example : controlData c₁ = (some true, fun head => match head with | none => 1 | some _ => 0, + .accept) := by + refine Prod.ext rfl (Prod.ext (funext fun head => ?_) rfl) + cases head <;> rfl + +example : windowCells 2 (w₁ 0) = [none, none, some true, some false, none, none] := by decide + +-- Of the four coin strings of two bits, only `true, false` leaves the record `c₁` and the window +-- `w₁`, evaluated on plain data. +example : walk.localIntervalCount 2 [true] J₀ δ₁ (controlData c₀) + (fun _ => windowCells 2 fun _ _ => none) (controlData c₁) (fun h => windowCells 2 (w₁ h)) = + 1 := by + decide + +-- With output track `other` instead, no coin string qualifies. +example : walk.localIntervalCount 2 [true] J₀ δ₁ (controlData c₀) + (fun _ => windowCells 2 fun _ _ => none) + (some true, fun head => match head with | none => 1 | some _ => 0, .other) + (fun h => windowCells 2 (w₁ h)) = 0 := by + decide + +-- So the interval tensor is `1`. +example : walk.intervalCount 2 [true] J₀ δ₁ c₀ (fun _ _ _ => none) c₁ w₁ = 1 := by + rw [← localIntervalCount_eq_intervalCount] + decide + +end ComplexityTests.HPVIntervalCount From 01f1f96974f5b15b1df24998618e6cc509757bbb Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 22:12:13 -0400 Subject: [PATCH 13/19] feat(machines): replays of interval coins in polynomial time (#1833 H3) Encode finite storage (encLocalCfg) and certify one coin step by finite dispatch on the control, read symbols and coin, with a constant bound on the growth of the encoding; replays are then a fold with additive growth (computableInPolyTime_localRun). Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 1 + .../Probabilistic/IntervalCount/PolyTime.lean | 389 ++++++++++++++++++ 2 files changed, 390 insertions(+) create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount/PolyTime.lean diff --git a/Complexity.lean b/Complexity.lean index 7d07e52199..5cb7602590 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -1815,6 +1815,7 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.E public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExtendTapes public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.InputFromTape public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalCount +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalCount.PolyTime public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalSimulation public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalTensor public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IterateWhile diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount/PolyTime.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount/PolyTime.lean new file mode 100644 index 0000000000..2189bb567e --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount/PolyTime.lean @@ -0,0 +1,389 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalCount +public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.Finite +public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.IntBinary +public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.Pi +public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.Tape +public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.Words +public import Complexity.Computability.Machines.Turing.MultiTape.PolyTime +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.BitString +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.Finite +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.Int.Binary +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.List +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.Tape +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.Window +import Complexity.Computability.Machines.Turing.MultiTape.Encodings.Length +import Complexity.Computability.Machines.Turing.MultiTape.Internal.EqualityPrimitives +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeListBinaryLookup +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeListMap +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeListPrimitives +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeLoops +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeNatFrontends +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimePiPrimitives + +/-! +# Interval counts in polynomial time + +The interval count on plain data (`Turing.MultiTapePTM.localIntervalCount`) is computable in +polynomial time, as long as its `2 ^ b` coin strings are polynomially many in the input. This is +the machine-simulation part of the polynomial-time construction of the block-counting networks +of #1833. + +**Finite storage** (`Turing.MultiTapePTM.LocalCfg`) is encoded by `Turing.MultiTapePTM.encLocalCfg`: +the control and output track by their ranks, the input position in unary, the work tapes with all +their stored cells (`Turing.MultiTapeTM.encBiTape`), and the head positions in binary +(`Turing.MultiTapeTM.encIntBin`). + +* **One coin step** (`Turing.MultiTapePTM.localCoinStep`) branches on the finite key of the + control, the read symbols and the coin (`Turing.MultiTapeTM.ComputableInPolyTime.finite_cases`); + every branch applies a fixed action. A step adds at most a constant to the encoded length. +* **A replay** (`Turing.MultiTapePTM.localRun`) is a fold of coin steps with additive growth. +* **The interval condition** compares the state, the output track, the head coordinates and the + window cells after the replay, all from the encoded storage. +* **The interval count** counts the coin strings of `Cslib.BitString.enumList b` satisfying it. + +## Main definitions + +* `Turing.MultiTapePTM.encLocalCfg`: the encoding of finite storage. +* `Turing.MultiTapePTM.IntervalData`, `Turing.MultiTapePTM.encIntervalData`: the arguments of an + interval count and their encoding. + +## Main results + +* `Turing.MultiTapePTM.computableInPolyTime_localRun`: replays are polynomial-time. +* `Turing.MultiTapePTM.computableInPolyTime_localIntervalCount`: interval counts are + polynomial-time when `2 ^ b` is polynomial in the input. +-/ + +public section + +namespace Turing.MultiTapePTM + +open MultiTapeNTM.ChoiceTable Cslib.Turing MultiTapeTM ComputableInPolyTime + +variable {k : ℕ} {State : Type} + +/-! ### Encoding finite storage -/ + +/-- Finite storage as the tuple of its fields. -/ +@[expose] def LocalCfg.equivProd : + LocalCfg k State ≃ Option State × ℕ × (Fin k → BiTape Bool) × (Fin k → ℤ) × OutputTrack where + toFun l := (l.state, l.inputPos, l.workTapes, l.workTapePos, l.track) + invFun p := ⟨p.1, p.2.1, p.2.2.1, p.2.2.2.1, p.2.2.2.2⟩ + left_inv _ := rfl + right_inv _ := rfl + +variable [Finite State] + +/-- **The encoding of finite storage**: the control and the output track by their ranks, the input +position in unary, the work tapes with all their stored cells, and the head positions in +binary. -/ +noncomputable def encLocalCfg : LocalCfg k State ↪ List Bool := + encOfEquiv LocalCfg.equivProd (encPair (encFinite (Option State)) (encPair encUnary + (encPair (encPi (encBiTape encBool)) (encPair (encPi encIntBin) (encFinite OutputTrack))))) + +/-! ### Rules for finite storage -/ + +section Rules + +variable {α : Type} {input : α ↪ List Bool} + +/-- Assemble finite storage from its certified fields. -/ +private theorem localCfg_mk {state : α → Option State} {pos : α → ℕ} + {tapes : α → Fin k → BiTape Bool} {coords : α → Fin k → ℤ} {track : α → OutputTrack} + (hstate : ComputableInPolyTime state input (encFinite (Option State))) + (hpos : ComputableInPolyTime pos input encUnary) + (htapes : ComputableInPolyTime tapes input (encPi (encBiTape encBool))) + (hcoords : ComputableInPolyTime coords input (encPi encIntBin)) + (htrack : ComputableInPolyTime track input (encFinite OutputTrack)) : + ComputableInPolyTime (fun a => (⟨state a, pos a, tapes a, coords a, track a⟩ : + LocalCfg k State)) input encLocalCfg := + (hstate.prod (hpos.prod (htapes.prod (hcoords.prod htrack)))).of_enc_eq fun _ => rfl + +private theorem localCfg_parts : ComputableInPolyTime (LocalCfg.equivProd (k := k) (State := State)) + encLocalCfg (encPair (encFinite (Option State)) (encPair encUnary + (encPair (encPi (encBiTape encBool)) (encPair (encPi encIntBin) (encFinite OutputTrack))))) := + of_eq fun _ => rfl + +private theorem localCfg_state : + ComputableInPolyTime (LocalCfg.state (k := k) (State := State)) encLocalCfg + (encFinite (Option State)) := + localCfg_parts.fst' + +private theorem localCfg_inputPos : + ComputableInPolyTime (LocalCfg.inputPos (k := k) (State := State)) encLocalCfg encUnary := + localCfg_parts.snd'.fst' + +private theorem localCfg_workTapes : + ComputableInPolyTime (LocalCfg.workTapes (k := k) (State := State)) encLocalCfg + (encPi (encBiTape encBool)) := + localCfg_parts.snd'.snd'.fst' + +private theorem localCfg_workTapePos : + ComputableInPolyTime (LocalCfg.workTapePos (k := k) (State := State)) encLocalCfg + (encPi encIntBin) := + localCfg_parts.snd'.snd'.snd'.fst' + +private theorem localCfg_track : + ComputableInPolyTime (LocalCfg.track (k := k) (State := State)) encLocalCfg + (encFinite OutputTrack) := + localCfg_parts.snd'.snd'.snd'.snd' + +/-- Adding a binary integer, by two subtractions. -/ +private theorem intBin_add' {left right : α → ℤ} + (hleft : ComputableInPolyTime left input encIntBin) + (hright : ComputableInPolyTime right input encIntBin) : + ComputableInPolyTime (fun a => left a + right a) input encIntBin := by + have h := intBin_sub.comp (hleft.prod (intBin_sub.comp ((const 0).prod hright))) + simpa only [Function.comp_def, zero_sub, sub_neg_eq_add] using h + +/-- The input symbol at a stored input position. -/ +private theorem inputAt_eq_getD (x : List Bool) (j : ℕ) : + inputAt x j = (none :: x.map some).getD j none := by + cases j with + | zero => rfl + | succ j => + cases h : x[j]? <;> simp [inputAt, List.getD_eq_getElem?_getD, h] + +/-- Reading the input at a computed position. -/ +private theorem inputAt' {word : α → List Bool} {pos : α → ℕ} + (hword : ComputableInPolyTime word input encBits) + (hpos : ComputableInPolyTime pos input encUnary) : + ComputableInPolyTime (fun a => inputAt (word a) (pos a)) input (encFinEnum (Option Bool)) := by + have hsome : ComputableInPolyTime (some (α := Bool)) encBool (encFinEnum (Option Bool)) := + of_finite _ + have hlist : ComputableInPolyTime (fun a => none :: (word a).map some) input + (encList (encFinEnum (Option Bool))) := + (const none).cons' ((map hsome).comp (bitsToList.comp hword)) + simpa only [inputAt_eq_getD] using listGetDWithInput hlist hpos none + +end Rules + +/-! ### One coin step -/ + +variable (machine : MultiTapePTM k Bool State) + +/-- The finite key of a coin step: the control, the read symbols and the coin. -/ +private def stepKey (p : (List Bool × LocalCfg k State) × Bool) : + Option State × Option Bool × (Fin k → Option Bool) × Bool := + (p.1.2.state, inputAt p.1.1 p.1.2.inputPos, fun h => (p.1.2.workTapes h).head, p.2) + +/-- A fixed action applied to finite storage. -/ +private def applyAction (a : Action k Bool State) (p : (List Bool × LocalCfg k State) × Bool) : + LocalCfg k State where + state := a.state + inputPos := moveInputPosNat p.1.1.length p.1.2.inputPos a.inputTape + workTapes h := (p.1.2.workTapes h).step (a.workTapes h) + workTapePos h := p.1.2.workTapePos h + (a.workTapes h).2 + track := p.1.2.track.emit a.output + +/-- Applying a fixed action is polynomial-time. -/ +private theorem computableInPolyTime_applyAction (a : Action k Bool State) : + ComputableInPolyTime (applyAction (State := State) a) + (encPair (encPair encBits encLocalCfg) encBool) encLocalCfg := by + have hcfg := (fst (encPair encBits (encLocalCfg (k := k) (State := State))) encBool).snd' + have hword := (fst (encPair encBits (encLocalCfg (k := k) (State := State))) encBool).fst' + have h1 : ComputableInPolyTime (fun p : (List Bool × LocalCfg k State) × Bool => p.1.1.length) + (encPair (encPair encBits encLocalCfg) encBool) encUnary := length_bits.comp hword + have h2 : ComputableInPolyTime (fun p : (List Bool × LocalCfg k State) × Bool => p.1.2.inputPos) + (encPair (encPair encBits encLocalCfg) encBool) encUnary := localCfg_inputPos.comp hcfg + have h3 := (MultiTapeTM.ComputableInPolyTime.moveInputPosNat a.inputTape).comp (h1.prod h2) + have h4 : ComputableInPolyTime + (fun p : (List Bool × LocalCfg k State) × Bool => fun h => (p.1.2.workTapes h).step + (a.workTapes h)) (encPair (encPair encBits encLocalCfg) encBool) + (encPi (encBiTape encBool)) := + pi fun h => biTape_step (a.workTapes h) ((pi_apply _ h).comp (localCfg_workTapes.comp hcfg)) + have h5 : ComputableInPolyTime + (fun p : (List Bool × LocalCfg k State) × Bool => fun h => p.1.2.workTapePos h + + ((a.workTapes h).2 : ℤ)) (encPair (encPair encBits encLocalCfg) encBool) + (encPi encIntBin) := + pi fun h => intBin_add' ((pi_apply _ h).comp (localCfg_workTapePos.comp hcfg)) (const _) + have h6 : ComputableInPolyTime + (fun p : (List Bool × LocalCfg k State) × Bool => p.1.2.track.emit a.output) + (encPair (encPair encBits encLocalCfg) encBool) (encFinite OutputTrack) := + (of_finite fun t : OutputTrack => t.emit a.output).comp (localCfg_track.comp hcfg) + exact localCfg_mk (const a.state) h3 h4 h5 h6 + +/-- The key of a coin step is polynomial-time. -/ +private theorem computableInPolyTime_stepKey : + ComputableInPolyTime (stepKey (k := k) (State := State)) + (encPair (encPair encBits encLocalCfg) encBool) (encFinite _) := by + have hcfg := (fst (encPair encBits (encLocalCfg (k := k) (State := State))) encBool).snd' + have hword := (fst (encPair encBits (encLocalCfg (k := k) (State := State))) encBool).fst' + have hbit := snd (encPair encBits (encLocalCfg (k := k) (State := State))) encBool + have hheads : ComputableInPolyTime + (fun p : (List Bool × LocalCfg k State) × Bool => fun h => (p.1.2.workTapes h).head) + (encPair (encPair encBits encLocalCfg) encBool) (encPi (encOption encBool)) := + pi fun h => (biTape_head encBool).comp ((pi_apply _ h).comp (localCfg_workTapes.comp hcfg)) + have hheads' : ComputableInPolyTime + (fun p : (List Bool × LocalCfg k State) × Bool => fun h => (p.1.2.workTapes h).head) + (encPair (encPair encBits encLocalCfg) encBool) (encFinite (Fin k → Option Bool)) := + (of_finite id).comp hheads + have hsym := inputAt' hword (localCfg_inputPos.comp hcfg) + have hall := (localCfg_state.comp hcfg).prod (hsym.prod (hheads'.prod hbit)) + exact (of_finite id).comp hall + +/-- **One coin step is polynomial-time.** -/ +private theorem computableInPolyTime_localCoinStep : + ComputableInPolyTime (fun p : (List Bool × LocalCfg k State) × Bool => + machine.localCoinStep p.1.1 p.1.2 p.2) + (encPair (encPair encBits encLocalCfg) encBool) encLocalCfg := by + have h := finite_cases (tagEncoding := encFinite _) (computableInPolyTime_stepKey (k := k) + (State := State)) + (branch := fun key => applyAction (machine.coinAction key.1 key.2.1 key.2.2.1 key.2.2.2)) + fun key => computableInPolyTime_applyAction _ + exact h + +/-! ### Growth of a coin step -/ + +section Growth + +private theorem length_encOption_bool_le (o : Option Bool) : (encOption encBool o).length ≤ 2 := by + cases o <;> simp + +private theorem length_encStackTape_eq (t : StackTape Bool) : + (encStackTape encBool t).length = + (t.toList.map fun a => 2 * (encOption encBool a).length + 1).sum := by + rw [encStackTape_apply, length_encList] + +private theorem length_encStackTape_tail_le (t : StackTape Bool) : + (encStackTape encBool t.tail).length ≤ (encStackTape encBool t).length := by + rw [length_encStackTape_eq, length_encStackTape_eq, StackTape.tail_toList] + cases t.toList with + | nil => simp + | cons a l => simp + +private theorem length_encStackTape_cons_le (o : Option Bool) (t : StackTape Bool) : + (encStackTape encBool (StackTape.cons o t)).length ≤ (encStackTape encBool t).length + 5 := by + have ho := length_encOption_bool_le o + have hcons : (StackTape.cons o t).toList = o :: t.toList ∨ + (StackTape.cons o t).toList = t.toList := by + rcases o with _ | a + · rcases t with ⟨_ | ⟨hd, tl⟩, ht⟩ + · exact Or.inr rfl + · exact Or.inl rfl + · exact Or.inl (StackTape.cons_some_toList a t) + rw [length_encStackTape_eq, length_encStackTape_eq] + rcases hcons with h | h <;> rw [h] + · simp only [List.map_cons, List.sum_cons] + omega + · omega + +/-- A tape step adds at most `14` to the encoded tape. -/ +private theorem length_encBiTape_step_le (t : BiTape Bool) + (a : Option (Option Bool) × SignType) : + (encBiTape encBool (t.step a)).length ≤ (encBiTape encBool t).length + 14 := by + set w := a.1.elim t t.write with hw + have hwl : w.left = t.left := by rcases a with ⟨_ | _, _⟩ <;> rfl + have hwr : w.right = t.right := by rcases a with ⟨_ | _, _⟩ <;> rfl + have hstep : t.step a = match a.2 with + | .neg => w.moveLeft + | .zero => w + | .pos => w.moveRight := rfl + have h1 := length_encOption_bool_le w.head + have h2 := length_encOption_bool_le t.head + have h3 := length_encOption_bool_le w.left.head + have h4 := length_encOption_bool_le w.right.head + have h5 := length_encStackTape_tail_le w.left + have h6 := length_encStackTape_tail_le w.right + have h7 := length_encStackTape_cons_le w.head w.right + have h8 := length_encStackTape_cons_le w.head w.left + rw [hwl] at h3 h5 h8 + rw [hwr] at h4 h6 h7 + rw [hstep] + rcases a with ⟨_, _ | _ | _⟩ <;> + simp only [encBiTape_apply, length_encPair, BiTape.moveLeft, BiTape.moveRight, hwl, hwr] <;> + omega + +/-- A table of values that each grow by at most `c` grows by at most `2 c` per entry. -/ +private theorem length_encPi_le_add {Index Value : Type} [Fintype Index] + (enc : Value ↪ List Bool) (f g : Index → Value) (c : ℕ) + (h : ∀ i, (enc (g i)).length ≤ (enc (f i)).length + c) : + (encPi enc g).length ≤ (encPi enc f).length + Fintype.card Index * (2 * c) := by + simp only [encPi_apply, length_encList, List.map_ofFn, List.sum_ofFn, Function.comp_def] + calc _ ≤ ∑ i : Fin (Fintype.card Index), + ((2 * (enc (f ((Fintype.equivFin Index).symm i))).length + 1) + 2 * c) := + Finset.sum_le_sum fun i _ => by have := h ((Fintype.equivFin Index).symm i); omega + _ = _ := by + rw [Finset.sum_add_distrib, Finset.sum_const, Finset.card_univ, Fintype.card_fin, + smul_eq_mul] + +/-- A step of `±1` adds at most two bits to a binary integer. -/ +private theorem length_encIntBin_add_sign_le (z : ℤ) (d : SignType) : + (encIntBin (z + d)).length ≤ (encIntBin z).length + 2 := by + rw [length_encIntBin, length_encIntBin] + have hd : ((d : ℤ)).natAbs ≤ 1 := by cases d <;> decide + have habs : (z + d).natAbs ≤ z.natAbs + 1 := (Int.natAbs_add_le z d).trans (by omega) + have := (Nat.size_le_size habs).trans (Nat.size_add_le z.natAbs 1) + have h1 : (1 : ℕ).size = 1 := by decide + omega + +/-- The constant bounding the growth of a coin step. -/ +private noncomputable def stepGrowth (k : ℕ) (State : Type) : ℕ := + 2 * Nat.card (Option State) + 64 * k + 8 + +/-- **A coin step adds at most a constant to the encoded storage.** -/ +private theorem length_encLocalCfg_localCoinStep_le (input : List Bool) (l : LocalCfg k State) + (bit : Bool) : + (encLocalCfg (machine.localCoinStep input l bit)).length ≤ + (encLocalCfg l).length + stepGrowth k State := by + set a := machine.coinAction l.state (inputAt input l.inputPos) (fun h => (l.workTapes h).head) + bit + have hstate := length_encFinite_lt (machine.localCoinStep input l bit).state + have htrack := length_encFinite_lt (machine.localCoinStep input l bit).track + have hcard : Nat.card OutputTrack = 3 := by + rw [Nat.card_eq_fintype_card] + rfl + have hpos : (machine.localCoinStep input l bit).inputPos ≤ l.inputPos + 1 := by + change moveInputPosNat input.length l.inputPos a.inputTape ≤ l.inputPos + 1 + have hd : ((a.inputTape : ℤ)) ≤ 1 := by cases a.inputTape <;> decide + simp only [moveInputPosNat] + omega + have htapes := length_encPi_le_add (encBiTape encBool) l.workTapes + (machine.localCoinStep input l bit).workTapes 14 + fun h => length_encBiTape_step_le (l.workTapes h) (a.workTapes h) + have hcoords := length_encPi_le_add encIntBin l.workTapePos + (machine.localCoinStep input l bit).workTapePos 2 + fun h => length_encIntBin_add_sign_le (l.workTapePos h) (a.workTapes h).2 + simp only [Fintype.card_fin] at htapes hcoords + simp only [encLocalCfg, encOfEquiv_apply, LocalCfg.equivProd, Equiv.coe_fn_mk, length_encPair, + encUnary_apply, List.length_replicate, stepGrowth] at hstate htrack ⊢ + omega + +end Growth + +/-! ### Replays -/ + +/-- **Replays are polynomial-time**: replaying computed coins from computed finite storage, on a +computed input. -/ +theorem computableInPolyTime_localRun {α : Type} {enc : α ↪ List Bool} + {input coins : α → List Bool} {start : α → LocalCfg k State} + (hinput : ComputableInPolyTime input enc encBits) + (hcoins : ComputableInPolyTime coins enc encBits) + (hstart : ComputableInPolyTime start enc encLocalCfg) : + ComputableInPolyTime (fun a => machine.localRun (input a) (coins a) (start a)) enc + encLocalCfg := by + have hfst := fst (encPair enc (encLocalCfg (k := k) (State := State))) encBool + have hg : ComputableInPolyTime (fun p : (α × LocalCfg k State) × Bool => + ((input p.1.1, p.1.2), p.2)) (encPair (encPair enc encLocalCfg) encBool) + (encPair (encPair encBits encLocalCfg) encBool) := + ((hinput.comp hfst.fst').prod hfst.snd').prod (snd _ _) + have hstep : ComputableInPolyTime (fun p : (α × LocalCfg k State) × Bool => + machine.localCoinStep (input p.1.1) p.1.2 p.2) (encPair (encPair enc encLocalCfg) encBool) + encLocalCfg := by + simpa only [Function.comp_def] using (computableInPolyTime_localCoinStep machine).comp hg + have h := foldlWithInput_of_bounded_growth (encA := encBool) (encL := encBits) + (list := coins) (step := fun a => machine.localCoinStep (input a)) + hstart ⟨hcoins, hstep, inferInstance, inferInstance⟩ (growth := fun _ => stepGrowth k State) + ⟨.const _, fun a l bit _ => length_encLocalCfg_localCoinStep_le machine (input a) l bit⟩ + exact h + +end Turing.MultiTapePTM From dfaab6481fea6a37e11ca97fe94edba16ce0c4f4 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 22:14:54 -0400 Subject: [PATCH 14/19] feat(machines): window tapes, reads and head coordinates in polynomial time (#1833 H3) Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../Probabilistic/IntervalCount/PolyTime.lean | 164 ++++++++++++++++++ 1 file changed, 164 insertions(+) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount/PolyTime.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount/PolyTime.lean index 2189bb567e..04afed654f 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount/PolyTime.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount/PolyTime.lean @@ -386,4 +386,168 @@ theorem computableInPolyTime_localRun {α : Type} {enc : α ↪ List Bool} ⟨.const _, fun a l bit _ => length_encLocalCfg_localCoinStep_le machine (input a) l bit⟩ exact h +/-! ### Tapes of windows, reads and head coordinates -/ + +section Window + +variable {α : Type} {input : α ↪ List Bool} + +private theorem ofList_eq_foldl (l : List (Option Bool)) : + StackTape.ofList l = l.reverse.foldl (fun t a => StackTape.cons a t) StackTape.nil := by + rw [StackTape.ofList, List.foldl_reverse] + +/-- Loading a computed list of cells onto a stack tape. -/ +private theorem stackTape_ofList {cells : α → List (Option Bool)} + (hcells : ComputableInPolyTime cells input (encList (encOption encBool))) : + ComputableInPolyTime (fun a => StackTape.ofList (cells a)) input (encStackTape encBool) := by + have hstep : ComputableInPolyTime + (fun p : (α × StackTape Bool) × Option Bool => StackTape.cons p.2 p.1.2) + (encPair (encPair input (encStackTape encBool)) (encOption encBool)) + (encStackTape encBool) := + stackTape_cons (snd _ _) (fst _ _).snd' + have h := foldlWithInput_of_bounded_growth (encA := encOption encBool) + (encL := encList (encOption encBool)) (list := fun a => (cells a).reverse) + (init := fun _ => StackTape.nil) (step := fun _ t a => StackTape.cons a t) + (const _) ⟨listReverseWithInput hcells, hstep, inferInstance, inferInstance⟩ + (growth := fun _ => 5) ⟨.const _, fun _ t a _ => length_encStackTape_cons_le a t⟩ + simpa only [ofList_eq_foldl] using h + +private theorem drop_eq_map_range (cells : List (Option Bool)) (n : ℕ) : + cells.drop n = (List.range (cells.length - n)).map fun i => cells.getD (n + i) none := by + refine List.ext_getElem (by simp) fun i h₁ h₂ => ?_ + simp only [List.getElem_drop, List.getElem_map, List.getElem_range] + rw [List.getD_eq_getElem] + +/-- The tape holding computed cells with its head on a computed cell. -/ +private theorem biTape_ofCells {cells : α → List (Option Bool)} {pos : α → ℕ} + (hcells : ComputableInPolyTime cells input (encList (encOption encBool))) + (hpos : ComputableInPolyTime pos input encUnary) : + ComputableInPolyTime (fun a => BiTape.ofCells (cells a) (pos a)) input (encBiTape encBool) := by + have hcells' := hcells.comp (fst input encUnary) + have hleft : ComputableInPolyTime + (fun a => (List.range (pos a)).map fun i => (cells a).getD (pos a - 1 - i) none) input + (encList (encOption encBool)) := + mapWithInput (unary_range' hpos) (listGetDWithInput hcells' + (unary_sub' (unary_sub' (hpos.comp (fst input encUnary)) (const 1)) (snd _ _)) none) + have hright : ComputableInPolyTime + (fun a => (List.range ((cells a).length - (pos a + 1))).map fun i => + (cells a).getD (pos a + 1 + i) none) input (encList (encOption encBool)) := + mapWithInput (unary_range' (unary_sub' ((length_list _).comp hcells) + (unary_add' hpos (const 1)))) + (listGetDWithInput hcells' (unary_add' (unary_add' (hpos.comp (fst input encUnary)) + (const 1)) (snd _ _)) none) + have h := biTape_mk (listGetDWithInput hcells hpos none) (stackTape_ofList hleft) + (stackTape_ofList hright) + simpa only [BiTape.ofCells, drop_eq_map_range] using h + +/-- The sign of a binary integer is its first bit. -/ +private theorem intBin_isNeg' {z : α → ℤ} (hz : ComputableInPolyTime z input encIntBin) : + ComputableInPolyTime (fun a => decide (z a < 0)) input encBool := by + have hbits : ComputableInPolyTime (fun z : ℤ => encIntBin z) encIntBin encBits := + of_eq fun _ => rfl + exact ((headD false).comp hbits).comp hz + +private theorem getD_none_eq_join (l : List (Option Bool)) (n : ℕ) : + l.getD n none = l[n]?.join := by + rw [List.getD_eq_getElem?_getD] + cases l[n]? <;> rfl + +/-- A read at an integer displacement, by the sign of the displacement. -/ +private theorem read_eq (t : BiTape Bool) (z : ℤ) : + t.read z = if z = 0 then t.head else if z < 0 then t.left.toList.getD ((-z).toNat - 1) none + else t.right.toList.getD (z.toNat - 1) none := by + rcases z with (_ | n) | n + · rfl + · have h1 : ¬ (Int.ofNat (n + 1) = 0) := by rw [Int.ofNat_eq_natCast]; omega + have h2 : ¬ (Int.ofNat (n + 1) < 0) := by rw [Int.ofNat_eq_natCast]; omega + rw [ite_eq_right h1, ite_eq_right h2, getD_none_eq_join] + simp [BiTape.read, StackTape.read_eq_getElem?] + · have h1 : ¬ (Int.negSucc n = 0) := by omega + have h2 : Int.negSucc n < 0 := Int.negSucc_lt_zero n + rw [ite_eq_right h1, ite_eq_left h2, getD_none_eq_join] + simp [BiTape.read, StackTape.read_eq_getElem?] + +/-- **Reading a computed tape at a computed displacement.** -/ +private theorem biTape_read {tape : α → BiTape Bool} {z : α → ℤ} + (htape : ComputableInPolyTime tape input (encBiTape encBool)) + (hz : ComputableInPolyTime z input encIntBin) : + ComputableInPolyTime (fun a => (tape a).read (z a)) input (encOption encBool) := by + simp only [read_eq] + refine ite_decide (decide_eq' hz (const 0)) ((biTape_head _).comp htape) + (ite_decide (intBin_isNeg' hz) ?_ ?_) + · have hneg : ComputableInPolyTime (fun a => -z a) input encIntBin := by + simpa only [Function.comp_def, zero_sub] using intBin_sub.comp ((const 0).prod hz) + exact listGetD_binary none ((stackTape_toList _).comp ((biTape_left _).comp htape)) + (binary_sub' (intBin_toNat.comp hneg) (const 1)) + · exact listGetD_binary none ((stackTape_toList _).comp ((biTape_right _).comp htape)) + (binary_sub' (intBin_toNat.comp hz) (const 1)) + +/-- The coordinate of a head of computed storage. -/ +private theorem localCfg_headCoord {l : α → LocalCfg k State} + (hl : ComputableInPolyTime l input encLocalCfg) (head : Option (Fin k)) : + ComputableInPolyTime (fun a => (l a).headCoord head) input encIntBin := by + cases head with + | none => + exact intBin_sub.comp + ((intBin_natCast.comp (unary_to_binary.comp (localCfg_inputPos.comp hl))).prod (const 1)) + | some h => exact (pi_apply _ h).comp (localCfg_workTapePos.comp hl) + +/-- The window cells of computed storage. -/ +private theorem localCfg_windowCellsAt {b : α → ℕ} {j : α → ℤ} {l : α → LocalCfg k State} + (hb : ComputableInPolyTime b input encUnary) (hj : ComputableInPolyTime j input encIntBin) + (hl : ComputableInPolyTime l input encLocalCfg) (h : Fin k) : + ComputableInPolyTime (fun a => (l a).windowCellsAt (b a) (j a) h) input + (encList (encOption encBool)) := by + have hfst := fst input encUnary + have hbZ : ComputableInPolyTime (fun p : α × ℕ => (b p.1 : ℤ)) (encPair input encUnary) + encIntBin := intBin_natCast.comp (unary_to_binary.comp (hb.comp hfst)) + have hcZ : ComputableInPolyTime (fun p : α × ℕ => (p.2 : ℤ)) (encPair input encUnary) + encIntBin := intBin_natCast.comp (unary_to_binary.comp (snd _ _)) + have hoff : ComputableInPolyTime + (fun p : α × ℕ => (b p.1 : ℤ) * (j p.1 - 1) + (p.2 : ℤ) - (l p.1).workTapePos h) + (encPair input encUnary) encIntBin := + intBin_sub.comp ((intBin_add' (intBin_mul' hbZ (intBin_sub.comp ((hj.comp hfst).prod + (const 1)))) hcZ).prod ((pi_apply _ h).comp (localCfg_workTapePos.comp (hl.comp hfst)))) + exact mapWithInput (unary_range' (unary_mul' (const 3) hb)) + (biTape_read ((pi_apply _ h).comp (localCfg_workTapes.comp (hl.comp hfst))) hoff) + +/-- The stored input position of a coordinate. -/ +private theorem val_inputPosOfCoord (x : List Bool) (p : ℤ) : + (inputPosOfCoord x p).val = if !decide (p + 1 < 0) && decide (p + 1 - (x.length + 2) < 0) + then min (x.length + 1) (p + 1).toNat else 0 := by + unfold inputPosOfCoord + by_cases h : 0 ≤ p + 1 ∧ p + 1 < x.length + 2 + · rw [dite_eq_left h] + have : (!decide (p + 1 < 0) && decide (p + 1 - (x.length + 2) < 0)) = true := by + simp only [Bool.and_eq_true, Bool.not_eq_true', decide_eq_false_iff_not, not_lt, + decide_eq_true_eq] + omega + rw [ite_eq_left this] + simp only + omega + · rw [dite_eq_right h] + have : ¬ (!decide (p + 1 < 0) && decide (p + 1 - (x.length + 2) < 0)) = true := by + simp only [Bool.and_eq_true, Bool.not_eq_true', decide_eq_false_iff_not, not_lt, + decide_eq_true_eq] + omega + rw [ite_eq_right this] + rfl + +/-- The stored input position of a computed coordinate. -/ +private theorem inputPosOfCoord' {word : α → List Bool} {p : α → ℤ} + (hword : ComputableInPolyTime word input encBits) + (hp : ComputableInPolyTime p input encIntBin) : + ComputableInPolyTime (fun a => (inputPosOfCoord (word a) (p a)).val) input encUnary := by + simp only [val_inputPosOfCoord] + have hp1 := intBin_add' hp (const 1) + have hlen : ComputableInPolyTime (fun a => (word a).length) input encUnary := + length_bits.comp hword + have hlenZ : ComputableInPolyTime (fun a => ((word a).length : ℤ) + 2) input encIntBin := + intBin_add' (intBin_natCast.comp (unary_to_binary.comp hlen)) (const 2) + refine ite (bool_and' (bool_not.comp (intBin_isNeg' hp1)) + (intBin_isNeg' (intBin_sub.comp (hp1.prod hlenZ)))) ?_ (const 0) + exact binary_min_unary.comp ((unary_add' hlen (const 1)).prod (intBin_toNat.comp hp1)) + +end Window + end Turing.MultiTapePTM From 2324560011d1fc756eec8fad3258fe5538c10766 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 22:17:33 -0400 Subject: [PATCH 15/19] feat(machines): interval counts in polynomial time (#1833 H3) The arguments of an interval count (IntervalData) with their encoding; the finite storage of the embedded window and the interval test after the replay are polynomial-time, so computableInPolyTime_localIntervalCount counts the 2^b coin strings in polynomial time whenever they are polynomially many in the input. The test instantiates the certificate on a concrete machine. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../Probabilistic/IntervalCount/PolyTime.lean | 209 +++++++++++++++++- ComplexityTests/HPVIntervalCount.lean | 17 +- 2 files changed, 220 insertions(+), 6 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount/PolyTime.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount/PolyTime.lean index 04afed654f..61b1feb78a 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount/PolyTime.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount/PolyTime.lean @@ -53,14 +53,16 @@ their stored cells (`Turing.MultiTapeTM.encBiTape`), and the head positions in b ## Main definitions * `Turing.MultiTapePTM.encLocalCfg`: the encoding of finite storage. -* `Turing.MultiTapePTM.IntervalData`, `Turing.MultiTapePTM.encIntervalData`: the arguments of an - interval count and their encoding. +* `Turing.MultiTapePTM.IntervalData`, `Turing.MultiTapePTM.encIntervalData`, + `Turing.MultiTapePTM.encControlData`, `Turing.MultiTapePTM.IntervalData.count`: the arguments of + an interval count, their encoding, and their count. ## Main results * `Turing.MultiTapePTM.computableInPolyTime_localRun`: replays are polynomial-time. +* `Turing.MultiTapePTM.IntervalData.computableInPolyTime_mk`: assembling the arguments. * `Turing.MultiTapePTM.computableInPolyTime_localIntervalCount`: interval counts are - polynomial-time when `2 ^ b` is polynomial in the input. + polynomial-time when the `2 ^ b` coin strings are polynomially many in the input. -/ public section @@ -550,4 +552,205 @@ private theorem inputPosOfCoord' {word : α → List Bool} {p : α → ℤ} end Window +/-! ### The interval count -/ + +section Count + +/-- **The arguments of an interval count** on plain data. -/ +structure IntervalData (k : ℕ) (State : Type) where + /-- The input. -/ + input : List Bool + /-- The block length. -/ + b : ℕ + /-- The block indices at the start of the interval. -/ + J : Option (Fin k) → ℤ + /-- The movements of the blocks. -/ + δ : Option (Fin k) → SignType + /-- The entering control record. -/ + cIn : ControlData k State + /-- The entering window cells. -/ + wIn : Fin k → List (Option Bool) + /-- The leaving control record. -/ + cOut : ControlData k State + /-- The leaving window cells. -/ + wOut : Fin k → List (Option Bool) + +/-- The arguments of an interval count as a tuple. -/ +@[expose] def IntervalData.equivProd : IntervalData k State ≃ + List Bool × ℕ × (Option (Fin k) → ℤ) × (Option (Fin k) → SignType) × ControlData k State × + (Fin k → List (Option Bool)) × ControlData k State × (Fin k → List (Option Bool)) where + toFun d := (d.input, d.b, d.J, d.δ, d.cIn, d.wIn, d.cOut, d.wOut) + invFun p := ⟨p.1, p.2.1, p.2.2.1, p.2.2.2.1, p.2.2.2.2.1, p.2.2.2.2.2.1, p.2.2.2.2.2.2.1, + p.2.2.2.2.2.2.2⟩ + left_inv _ := rfl + right_inv _ := rfl + +/-- The encoding of a control record on plain data: the state and the track by their ranks, and +the offsets in unary. -/ +noncomputable def encControlData : ControlData k State ↪ List Bool := + encPair (encFinite (Option State)) (encPair (encPi encUnary) (encFinite OutputTrack)) + +/-- **The encoding of the arguments of an interval count**: the input, the block length in unary, +the block indices in binary, the movements by their ranks, and the records and window cells. -/ +noncomputable def encIntervalData : IntervalData k State ↪ List Bool := + encOfEquiv IntervalData.equivProd (encPair encBits (encPair encUnary (encPair (encPi encIntBin) + (encPair (encFinite (Option (Fin k) → SignType)) (encPair encControlData + (encPair (encPi (encList (encOption encBool))) (encPair encControlData + (encPi (encList (encOption encBool)))))))))) + +/-- The interval count of its arguments. -/ +@[expose] def IntervalData.count [DecidableEq State] (machine : MultiTapePTM k Bool State) + (d : IntervalData k State) : ℕ := + machine.localIntervalCount d.b d.input d.J d.δ d.cIn d.wIn d.cOut d.wOut + +variable {α : Type} {input : α ↪ List Bool} + +/-- Assemble the arguments of an interval count from their certified components. -/ +theorem IntervalData.computableInPolyTime_mk {word : α → List Bool} {b : α → ℕ} + {J : α → Option (Fin k) → ℤ} {δ : α → Option (Fin k) → SignType} + {cIn cOut : α → ControlData k State} {wIn wOut : α → Fin k → List (Option Bool)} + (hword : ComputableInPolyTime word input encBits) (hb : ComputableInPolyTime b input encUnary) + (hJ : ComputableInPolyTime J input (encPi encIntBin)) + (hδ : ComputableInPolyTime δ input (encFinite _)) + (hcIn : ComputableInPolyTime cIn input encControlData) + (hwIn : ComputableInPolyTime wIn input (encPi (encList (encOption encBool)))) + (hcOut : ComputableInPolyTime cOut input encControlData) + (hwOut : ComputableInPolyTime wOut input (encPi (encList (encOption encBool)))) : + ComputableInPolyTime (fun a => (⟨word a, b a, J a, δ a, cIn a, wIn a, cOut a, wOut a⟩ : + IntervalData k State)) input encIntervalData := + (hword.prod (hb.prod (hJ.prod (hδ.prod (hcIn.prod (hwIn.prod (hcOut.prod hwOut))))))).of_enc_eq + fun _ => rfl + +private theorem intervalData_parts : ComputableInPolyTime + (IntervalData.equivProd (k := k) (State := State)) encIntervalData + (encPair encBits (encPair encUnary (encPair (encPi encIntBin) + (encPair (encFinite (Option (Fin k) → SignType)) (encPair encControlData + (encPair (encPi (encList (encOption encBool))) (encPair encControlData + (encPi (encList (encOption encBool)))))))))) := + of_eq fun _ => rfl + +private theorem controlData_parts : ComputableInPolyTime (fun c : ControlData k State => c) + encControlData (encPair (encFinite (Option State)) (encPair (encPi encUnary) + (encFinite OutputTrack))) := + of_eq fun _ => rfl + +/-- The finite storage of the embedded window of computed arguments. -/ +private theorem localStartData' {d : α → IntervalData k State} + (hd : ComputableInPolyTime d input encIntervalData) : + ComputableInPolyTime (fun a => localStartData (d a).b (d a).input (d a).J (d a).cIn (d a).wIn) + input encLocalCfg := by + have hp := intervalData_parts.comp hd + have hword : ComputableInPolyTime (fun a => (d a).input) input encBits := hp.fst' + have hb : ComputableInPolyTime (fun a => (d a).b) input encUnary := hp.snd'.fst' + have hJ : ComputableInPolyTime (fun a => (d a).J) input (encPi encIntBin) := hp.snd'.snd'.fst' + have hc := controlData_parts.comp (hp.snd'.snd'.snd'.snd'.fst' : + ComputableInPolyTime (fun a => (d a).cIn) input encControlData) + have hw : ComputableInPolyTime (fun a => (d a).wIn) input + (encPi (encList (encOption encBool))) := hp.snd'.snd'.snd'.snd'.snd'.fst' + have hbZ : ComputableInPolyTime (fun a => ((d a).b : ℤ)) input encIntBin := + intBin_natCast.comp (unary_to_binary.comp hb) + have hoff (head : Option (Fin k)) : ComputableInPolyTime (fun a => (d a).cIn.2.1 head) input + encUnary := (pi_apply _ head).comp hc.snd'.fst' + have hcoord (head : Option (Fin k)) : ComputableInPolyTime + (fun a => ((d a).b : ℤ) * (d a).J head + ((d a).cIn.2.1 head : ℤ)) input encIntBin := + intBin_add' (intBin_mul' hbZ ((pi_apply _ head).comp hJ)) + (intBin_natCast.comp (unary_to_binary.comp (hoff head))) + exact localCfg_mk hc.fst' (inputPosOfCoord' hword (hcoord none)) + (pi fun h => biTape_ofCells ((pi_apply _ h).comp hw) (unary_add' hb (hoff (some h)))) + (pi fun h => hcoord (some h)) hc.snd'.snd' + +/-- The interval condition after the replay, as a Boolean test of the arguments and the +storage. -/ +private def stepTest (d : IntervalData k State) (l : LocalCfg k State) [DecidableEq State] : + Bool := + decide (l.state = d.cOut.1) && decide (l.track = d.cOut.2.2) && + (none :: (List.finRange k).map some).all (fun head => decide (d.cOut.2.1 head < d.b) && + decide (l.headCoord head = d.b * (d.J head + d.δ head) + d.cOut.2.1 head)) && + (List.finRange k).all fun h => decide (l.windowCellsAt d.b (d.J (some h)) h = d.wOut h) + +omit [Finite State] in +private theorem stepTest_eq [DecidableEq State] (machine : MultiTapePTM k Bool State) + (d : IntervalData k State) (coins : List Bool) : + decide (machine.LocalIntervalStepData d.b d.input d.J d.δ d.cIn d.wIn d.cOut d.wOut coins) = + stepTest d (machine.localRun d.input coins + (localStartData d.b d.input d.J d.cIn d.wIn)) := by + have hall : ∀ P : Option (Fin k) → Prop, (∀ head, P head) ↔ + ∀ head ∈ none :: (List.finRange k).map some, P head := by + intro P + constructor + · exact fun h head _ => h head + · intro h head + cases head with + | none => exact h none (by simp) + | some i => exact h (some i) (by simp) + rw [Bool.eq_iff_iff] + simp only [stepTest, LocalIntervalStepData, decide_eq_true_eq, Bool.and_eq_true, + List.all_eq_true, List.mem_finRange, true_implies, ← hall] + tauto + +/-- **The interval condition after the replay is polynomial-time.** -/ +private theorem computableInPolyTime_stepTest [DecidableEq State] : + ComputableInPolyTime (fun p : IntervalData k State × LocalCfg k State => stepTest p.1 p.2) + (encPair encIntervalData encLocalCfg) encBool := by + have hd := fst (encIntervalData (k := k) (State := State)) (encLocalCfg (k := k) (State := State)) + have hl := snd (encIntervalData (k := k) (State := State)) (encLocalCfg (k := k) (State := State)) + have hp := intervalData_parts.comp hd + have hb : ComputableInPolyTime (fun p : IntervalData k State × LocalCfg k State => p.1.b) + (encPair encIntervalData encLocalCfg) encUnary := hp.snd'.fst' + have hJ : ComputableInPolyTime (fun p : IntervalData k State × LocalCfg k State => p.1.J) + (encPair encIntervalData encLocalCfg) (encPi encIntBin) := hp.snd'.snd'.fst' + have hδ : ComputableInPolyTime (fun p : IntervalData k State × LocalCfg k State => p.1.δ) + (encPair encIntervalData encLocalCfg) (encFinite _) := hp.snd'.snd'.snd'.fst' + have hc := controlData_parts.comp (hp.snd'.snd'.snd'.snd'.snd'.snd'.fst' : + ComputableInPolyTime (fun p : IntervalData k State × LocalCfg k State => p.1.cOut) + (encPair encIntervalData encLocalCfg) encControlData) + have hw : ComputableInPolyTime (fun p : IntervalData k State × LocalCfg k State => p.1.wOut) + (encPair encIntervalData encLocalCfg) (encPi (encList (encOption encBool))) := + hp.snd'.snd'.snd'.snd'.snd'.snd'.snd' + have hbZ : ComputableInPolyTime + (fun p : IntervalData k State × LocalCfg k State => (p.1.b : ℤ)) + (encPair encIntervalData encLocalCfg) encIntBin := + intBin_natCast.comp (unary_to_binary.comp hb) + refine bool_and' (bool_and' (bool_and' (decide_eq' (localCfg_state.comp hl) hc.fst') + (decide_eq' (localCfg_track.comp hl) hc.snd'.snd')) ?_) ?_ + · refine allConst _ fun head _ => bool_and' (unary_lt' ((pi_apply _ head).comp hc.snd'.fst') hb) + (decide_eq' (localCfg_headCoord hl head) ?_) + have hδZ : ComputableInPolyTime + (fun p : IntervalData k State × LocalCfg k State => ((p.1.δ head : SignType) : ℤ)) + (encPair encIntervalData encLocalCfg) encIntBin := + (of_finite fun δ : Option (Fin k) → SignType => ((δ head : SignType) : ℤ)).comp hδ + exact intBin_add' (intBin_mul' hbZ (intBin_add' ((pi_apply _ head).comp hJ) hδZ)) + (intBin_natCast.comp (unary_to_binary.comp ((pi_apply _ head).comp hc.snd'.fst'))) + · exact allConst _ fun h _ => decide_eq' + (localCfg_windowCellsAt hb ((pi_apply _ (some h)).comp hJ) hl h) ((pi_apply _ h).comp hw) + +/-- **Interval counts are polynomial-time** in their computed arguments, provided that the `2 ^ b` +coin strings, with their encodings, are polynomially many in the input: the count enumerates them +and replays each on the finite storage of the embedded window. -/ +theorem computableInPolyTime_localIntervalCount [DecidableEq State] + (machine : MultiTapePTM k Bool State) {d : α → IntervalData k State} + (hd : ComputableInPolyTime d input encIntervalData) {size : ℕ → ℕ} + (hsize : Cslib.PolynomiallyBounded size) + (hbudget : ∀ a, 2 ^ (d a).b * (2 * (d a).b + 1) ≤ size (input a).length) : + ComputableInPolyTime (fun a => (d a).count machine) input encUnary := by + have hb : ComputableInPolyTime (fun a => (d a).b) input encUnary := + (intervalData_parts.comp hd).snd'.fst' + have hlist := bitsEnumList hb hsize hbudget + have hfst := fst input encBits + have hrun : ComputableInPolyTime (fun p : α × List Bool => machine.localRun (d p.1).input p.2 + (localStartData (d p.1).b (d p.1).input (d p.1).J (d p.1).cIn (d p.1).wIn)) + (encPair input encBits) encLocalCfg := + computableInPolyTime_localRun machine ((intervalData_parts.comp (hd.comp hfst)).fst') + (snd _ _) (localStartData' (hd.comp hfst)) + have htest : ComputableInPolyTime (fun p : α × List Bool => + decide (machine.LocalIntervalStepData (d p.1).b (d p.1).input (d p.1).J (d p.1).δ + (d p.1).cIn (d p.1).wIn (d p.1).cOut (d p.1).wOut p.2)) (encPair input encBits) + encBool := by + simp only [stepTest_eq] + simpa only [Function.comp_def] using computableInPolyTime_stepTest.comp + ((hd.comp hfst).prod hrun) + exact countPWithInput hlist htest + +end Count + end Turing.MultiTapePTM diff --git a/ComplexityTests/HPVIntervalCount.lean b/ComplexityTests/HPVIntervalCount.lean index acc7c73183..941665f2d2 100644 --- a/ComplexityTests/HPVIntervalCount.lean +++ b/ComplexityTests/HPVIntervalCount.lean @@ -4,10 +4,10 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Samuel Schlesinger -/ -import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalCount +import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalCount.PolyTime -/-! Interval counts of a concrete fair-coin machine on plain data: the count is evaluated, and -the interval tensor follows. -/ +/-! Interval counts of a concrete fair-coin machine on plain data: the count is evaluated, the +interval tensor follows, and the polynomial-time certificate applies with a satisfiable budget. -/ namespace ComplexityTests.HPVIntervalCount @@ -68,4 +68,15 @@ example : walk.intervalCount 2 [true] J₀ δ₁ c₀ (fun _ _ _ => none) c₁ w rw [← localIntervalCount_eq_intervalCount] decide +-- The certificate applies: with a fixed block length the budget `2 ^ b (2 b + 1) ≤ 20` holds, so +-- the count of the arguments with a computed input is polynomial-time. +example : MultiTapeTM.ComputableInPolyTime (fun x : List Bool => + (⟨x, 2, J₀, δ₁, controlData c₀, fun _ => windowCells 2 fun _ _ => none, controlData c₁, + fun h => windowCells 2 (w₁ h)⟩ : IntervalData 1 Bool).count walk) + MultiTapeTM.encBits MultiTapeTM.encUnary := + computableInPolyTime_localIntervalCount walk + (IntervalData.computableInPolyTime_mk MultiTapeTM.ComputableInPolyTime.id' + (.const _) (.const _) (.const _) (.const _) (.const _) (.const _) (.const _)) + (size := fun _ => 20) (Cslib.PolynomiallyBounded.const 20) fun _ => by norm_num + end ComplexityTests.HPVIntervalCount From df307b8c056212018634d55fa996c02f0df6bb81 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 22:20:23 -0400 Subject: [PATCH 16/19] fix(machines): drop unused NeZero arguments in interval data Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../Turing/MultiTape/Probabilistic/IntervalCount.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount.lean index e87ab067cb..0681585eea 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount.lean @@ -63,7 +63,7 @@ the output track. -/ abbrev ControlData (k : ℕ) (State : Type) := Option State × (Option (Fin k) → ℕ) × OutputTrack /-- A control record as plain data: its offsets by their values. -/ -@[expose] def controlData {b : ℕ} [NeZero b] (c : BlockControl k State b) : ControlData k State := +@[expose] def controlData {b : ℕ} (c : BlockControl k State b) : ControlData k State := (c.1, fun head => (c.2.1 head).val, c.2.2) /-- The finite storage of the configuration embedded at block indices `J` with the control @@ -78,7 +78,7 @@ work tape holds the cells of its window with its head on cell `b + offset`. -/ track := cIn.2.2 /-- On the data of a control record and window contents, `localStartData` is `localStart`. -/ -theorem localStartData_controlData (b : ℕ) [NeZero b] (input : List Bool) +theorem localStartData_controlData (b : ℕ) (input : List Bool) (J : Option (Fin k) → ℤ) (cIn : BlockControl k State b) (wIn : Fin k → Fin 3 → ZMod b → Option Bool) : localStartData b input J (controlData cIn) (fun h => windowCells b (wIn h)) = From 6fd5c5de43cbd81ecbd7dcd23e4ebde3c5ef5c41 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 22:36:55 -0400 Subject: [PATCH 17/19] feat(machines): the graph of explicit block-counting networks on numbers (#1833 H3) Number the schedules by base-3 digits (`scheduleEquiv`, `scheduleOfNat`), compute block indices as digit counts, windows and next appearances by comparison and search, and the endpoints and ports of the explicit edges by arithmetic. `map_fst_vertices_explicitBlockNetwork` equates the ports with those of `explicitBlockNetwork`, and `computableInPolyTime_explicitPortsNum` certifies them in plain polynomial time. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 2 + .../ExplicitBlockNetwork/Graph.lean | 386 ++++++++++++++++++ .../ExplicitBlockNetwork/GraphPolyTime.lean | 169 ++++++++ ComplexityTests/HPVExplicitGraph.lean | 98 +++++ 4 files changed, 655 insertions(+) create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/Graph.lean create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/GraphPolyTime.lean create mode 100644 ComplexityTests/HPVExplicitGraph.lean diff --git a/Complexity.lean b/Complexity.lean index 5cb7602590..fc1478063e 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -1812,6 +1812,8 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.C public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Composition public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.Deterministic public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork.Graph +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork.GraphPolyTime public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExtendTapes public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.InputFromTape public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalCount diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/Graph.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/Graph.lean new file mode 100644 index 0000000000..0b7cac6ff1 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/Graph.lean @@ -0,0 +1,386 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork +import Mathlib.Algebra.BigOperators.Fin + +/-! +# The graph of an explicit block-counting network, on numbers + +The explicit block-counting network of a schedule +(`Turing.MultiTapePTM.explicitBlockNetwork`) is defined through structured types: schedules, +edges `Turing.MultiTapePTM.BlockEdge`, and the next appearance of a block in windows +(`Turing.MultiTapePTM.firstAfter`). This module computes its graph, the ports of every vertex, +by arithmetic on natural numbers, the form in which a polynomial-time construction produces it. + +* **Schedules** are numbered by their `(k + 1) q` entries as digits in base `3` + (`Turing.MultiTapePTM.scheduleEquiv`), the entries of one interval consecutive with the input + head first, and the sign of digit `δ` being `δ - 1`. Any natural number `σ` names the schedule + of its digits `σ / 3 ^ j % 3` (`Turing.MultiTapePTM.scheduleOfNat`), which is the numbered one + for `σ < 3 ^ ((k + 1) q)` (`Turing.MultiTapePTM.scheduleOfNat_eq_symm`). So summing over the + numbers below `3 ^ ((k + 1) q)` is summing over the schedules + (`Turing.MultiTapePTM.sum_range_scheduleOfNat`). +* **Block indices** are counts of digits: a head is in block `#{2} - #{0}` at the start of + interval `i`, counting the digits `2` and `0` of that head in the intervals before `i` + (`Turing.MultiTapePTM.scheduleBlock_scheduleOfNat`). Whether a block lies in a window is then a + comparison of natural numbers (`Turing.MultiTapePTM.inWindowNum_iff`), and the next appearance + of a block is a search over the intervals (`Turing.MultiTapePTM.firstAfterNum_eq`). +* **Endpoints.** The numbered explicit edges have sources and targets given by + `Turing.MultiTapePTM.explicitSrcNum` and `Turing.MultiTapePTM.explicitTgtNum`, and the ports of + a vertex are the edge numbers with that vertex as an endpoint + (`Turing.MultiTapePTM.explicitPortsNum`). They are the ports of the explicit network + (`Turing.MultiTapePTM.map_fst_vertices_explicitBlockNetwork`). + +## Main definitions + +* `Turing.MultiTapePTM.signEquiv`, `Turing.MultiTapePTM.scheduleEquiv`, + `Turing.MultiTapePTM.scheduleOfNat`: numbering the schedules. +* `Turing.MultiTapePTM.digitCount`, `Turing.MultiTapePTM.inWindowNum`, + `Turing.MultiTapePTM.firstAfterNum`, `Turing.MultiTapePTM.edgeTargetNum`: block indices, + windows, next appearances and edge targets on numbers. +* `Turing.MultiTapePTM.explicitSrcNum`, `Turing.MultiTapePTM.explicitTgtNum`, + `Turing.MultiTapePTM.explicitPortsNum`: the endpoints of the explicit edges and the ports of the + vertices. + +## Main results + +* `Turing.MultiTapePTM.sum_range_scheduleOfNat`: summing over schedule numbers. +* `Turing.MultiTapePTM.edgeTargetNum_blockEdgeEquiv`: the edge targets on numbers. +* `Turing.MultiTapePTM.explicitSrcNum_explicitEdgeEquiv`, + `Turing.MultiTapePTM.explicitTgtNum_explicitEdgeEquiv`: the endpoints on numbers. +* `Turing.MultiTapePTM.map_fst_vertices_explicitBlockNetwork`: the ports of the explicit network + on numbers. +-/ + +public section + +namespace Turing.MultiTapePTM + +open Cslib.Circuits.Frontier + +variable {k q : ℕ} + +/-! ### Numbering the schedules -/ + +/-- The signs numbered `-1 ↦ 0`, `0 ↦ 1`, `1 ↦ 2`. -/ +@[expose] def signEquiv : SignType ≃ Fin 3 where + toFun + | .neg => 0 + | .zero => 1 + | .pos => 2 + invFun i := if i = 0 then .neg else if i = 1 then .zero else .pos + left_inv s := by cases s <;> rfl + right_inv i := by fin_cases i <;> rfl + +/-- The sign numbered `δ` is `δ - 1`: one for the digit `2`, minus one for the digit `0`. -/ +theorem coe_signEquiv_symm (δ : Fin 3) : + ((signEquiv.symm δ : SignType) : ℤ) = + (if (δ : ℕ) = 2 then 1 else 0) - (if (δ : ℕ) = 0 then 1 else 0) := by + fin_cases δ <;> rfl + +/-- The digit position of the entry of interval `i` and head `head` in a schedule number: +`head + (k + 1) i`, numbering the input head `0` and work head `h` as `h + 1`. -/ +@[expose] def scheduleIndexEquiv (k q : ℕ) : Fin q × Option (Fin k) ≃ Fin ((k + 1) * q) := + ((Equiv.prodCongr (Equiv.refl _) (finSuccEquiv k).symm).trans finProdFinEquiv).trans + (finCongr (Nat.mul_comm q (k + 1))) + +theorem val_scheduleIndexEquiv (i : Fin q) (head : Option (Fin k)) : + (scheduleIndexEquiv k q (i, head) : ℕ) = ((finSuccEquiv k).symm head : ℕ) + (k + 1) * i := by + simp [scheduleIndexEquiv, finProdFinEquiv_apply_val] + +/-- **The schedules numbered** by their `(k + 1) q` entries as digits in base `3`: the entry of +interval `i` and head `head` is the digit at position `head + (k + 1) i` +(`Turing.MultiTapePTM.scheduleIndexEquiv`), numbered by `Turing.MultiTapePTM.signEquiv`. -/ +@[expose] def scheduleEquiv (k q : ℕ) : Schedule k q ≃ Fin (3 ^ ((k + 1) * q)) := + (Equiv.curry _ _ _).symm.trans + ((Equiv.arrowCongr (scheduleIndexEquiv k q) signEquiv).trans finFunctionFinEquiv) + +/-- **The schedule of a number**: its entry for interval `i` and head `head` is named by the digit +of `σ` in base `3` at position `head + (k + 1) i`. Every natural number names a schedule; below +`3 ^ ((k + 1) q)` this is the numbering `Turing.MultiTapePTM.scheduleEquiv`. -/ +@[expose] def scheduleOfNat (k q σ : ℕ) : Schedule k q := fun i head => + signEquiv.symm ⟨σ / 3 ^ (((finSuccEquiv k).symm head : ℕ) + (k + 1) * i) % 3, + Nat.mod_lt _ (by norm_num)⟩ + +/-- Below `3 ^ ((k + 1) q)`, the schedule of a number is the numbered one. -/ +theorem scheduleOfNat_eq_symm {σ : ℕ} (hσ : σ < 3 ^ ((k + 1) * q)) : + scheduleOfNat k q σ = (scheduleEquiv k q).symm ⟨σ, hσ⟩ := by + funext i head + rw [scheduleOfNat] + change _ = signEquiv.symm (finFunctionFinEquiv.symm ⟨σ, hσ⟩ (scheduleIndexEquiv k q (i, head))) + congr 1 + +/-- **Summing over schedule numbers** is summing over the schedules. -/ +theorem sum_range_scheduleOfNat {M : Type*} [AddCommMonoid M] (f : Schedule k q → M) : + ∑ σ ∈ Finset.range (3 ^ ((k + 1) * q)), f (scheduleOfNat k q σ) = ∑ σ : Schedule k q, f σ := by + rw [Finset.sum_range] + simp only [scheduleOfNat_eq_symm (Fin.isLt _), Fin.eta] + exact Fintype.sum_equiv (scheduleEquiv k q).symm _ _ fun _ => rfl + +/-! ### Block indices, windows and next appearances on numbers -/ + +/-- The number of intervals `i' < i` in which the digit of `σ` at position `c + (k + 1) i'` is +`δ`. For `c` the number of a head, these are the intervals of `scheduleOfNat k q σ` moving that +head by `δ - 1` blocks. -/ +@[expose] def digitCount (k σ c δ i : ℕ) : ℕ := + (List.range i).countP fun i' => σ / 3 ^ (c + (k + 1) * i') % 3 = δ + +/-- **Block indices are digit counts**: at the start of interval `i ≤ q`, a head is in block +`#{2} - #{0}`, counting its digits `2` and `0` in the earlier intervals. -/ +theorem scheduleBlock_scheduleOfNat (σ : ℕ) {i : ℕ} (hi : i ≤ q) (head : Option (Fin k)) : + scheduleBlock (scheduleOfNat k q σ) i head = + (digitCount k σ ((finSuccEquiv k).symm head) 2 i : ℤ) - + digitCount k σ ((finSuccEquiv k).symm head) 0 i := by + induction i with + | zero => simp [digitCount] + | succ i ih => + rw [scheduleBlock_succ _ (by omega), ih (by omega), scheduleOfNat, coe_signEquiv_symm] + simp only [digitCount, List.range_succ, List.countP_append, List.countP_singleton] + split_ifs <;> simp_all <;> omega + +/-- Whether the block `j = b(i) + δ - 1` of interval `i`'s window lies in the window of interval +`i'`, from the digit counts `P` (digits `2`) and `N` (digits `0`) of the head at `i` and `i'`: +`|b(i') - j| ≤ 1` for `b = P - N`, compared in natural numbers. -/ +@[expose] def inWindowNum (k σ c i δ i' : ℕ) : Bool := + decide (digitCount k σ c 2 i' + digitCount k σ c 0 i + 1 ≤ + digitCount k σ c 0 i' + digitCount k σ c 2 i + δ + 1 ∧ + digitCount k σ c 0 i' + digitCount k σ c 2 i + δ ≤ + digitCount k σ c 2 i' + digitCount k σ c 0 i + 2) + +/-- **Windows on numbers.** -/ +theorem inWindowNum_iff (σ : ℕ) (i i' : Fin q) (h : Fin k) (δ : Fin 3) : + inWindowNum k σ (h + 1) i δ i' = true ↔ + InWindow (scheduleOfNat k q σ) h (portBlock (scheduleOfNat k q σ) i h δ) i' := by + have hc : (((finSuccEquiv k).symm (some h) : Fin (k + 1)) : ℕ) = h + 1 := by simp + have hb := scheduleBlock_scheduleOfNat (k := k) σ i.isLt.le (some h) + have hb' := scheduleBlock_scheduleOfNat (k := k) σ i'.isLt.le (some h) + rw [hc] at hb hb' + simp only [InWindow, portBlock, hb, hb', abs_le, inWindowNum, decide_eq_true_eq] + omega + +/-- The next interval after `i` whose window contains the block `δ` of interval `i`'s window, for +the head with digit offset `c`, found by searching the intervals in order. -/ +@[expose] def firstAfterNum (k q σ c i δ : ℕ) : Option ℕ := + (List.range q).find? fun i' => decide (i < i') && inWindowNum k σ c i δ i' + +/-- **Next appearances on numbers.** -/ +theorem firstAfterNum_eq (σ : ℕ) (i : Fin q) (h : Fin k) (δ : Fin 3) : + firstAfterNum k q σ (h + 1) i δ = + (firstAfter (InWindow (scheduleOfNat k q σ) h + (portBlock (scheduleOfNat k q σ) i h δ)) i).map Fin.val := by + cases hf : firstAfter (InWindow (scheduleOfNat k q σ) h + (portBlock (scheduleOfNat k q σ) i h δ)) i with + | none => + rw [firstAfter_eq_none_iff] at hf + simp only [Option.map_none, firstAfterNum, List.find?_eq_none, List.mem_range, + Bool.and_eq_true, decide_eq_true_eq, not_and] + intro j hj hij hw + exact hf ⟨j, hj⟩ hij ((inWindowNum_iff σ i ⟨j, hj⟩ h δ).mp hw) + | some i' => + obtain ⟨hlt, hw, hmin⟩ := firstAfter_eq_some_iff.mp hf + simp only [Option.map_some, firstAfterNum, List.find?_range_eq_some, List.mem_range, + Bool.and_eq_true, decide_eq_true_eq, Bool.not_eq_eq_eq_not, Bool.not_true, + Bool.and_eq_false_iff, decide_eq_false_iff_not] + refine ⟨⟨hlt, (inWindowNum_iff σ i i' h δ).mpr hw⟩, i'.isLt, fun j hj => ?_⟩ + by_cases hij : i.val < j + · refine Or.inr ?_ + rw [Bool.eq_false_iff, ne_eq, inWindowNum_iff σ i ⟨j, by omega⟩ h δ] + exact hmin ⟨j, by omega⟩ hij hj + · exact Or.inl hij + +/-! ### Edge targets and endpoints on numbers -/ + +/-- The number of the block edge `(i, h, δ)`: after the `q` control edges, in lexicographic +order. -/ +theorem val_blockEdgeEquiv_inr (i : Fin q) (h : Fin k) (δ : Fin 3) : + (blockEdgeEquiv k q (.inr (i, h, δ)) : ℕ) = q + (δ + 3 * h + k * 3 * i) := by + simp [blockEdgeEquiv, finProdFinEquiv_apply_val, Nat.add_assoc] + +/-- The number of the control edge leaving interval `i`. -/ +theorem val_blockEdgeEquiv_inl (i : Fin q) : (blockEdgeEquiv k q (.inl i) : ℕ) = i := by + simp [blockEdgeEquiv] + +/-- The number of an interval as a vertex of the explicit network. -/ +theorem val_explicitVertexEquiv_interval (m : ℕ) (i : Fin q) : + (explicitVertexEquiv k q m (.inl (.inl i)) : ℕ) = i := by + simp [explicitVertexEquiv] + +/-- The number of the sink of an edge as a vertex of the explicit network. -/ +theorem val_explicitVertexEquiv_sink (m : ℕ) (e : BlockEdge k q) : + (explicitVertexEquiv k q m (.inl (.inr e)) : ℕ) = q + blockEdgeEquiv k q e := by + simp [explicitVertexEquiv, Nat.add_comm] + +/-- The number of the subdivision vertex of copy `j` of an edge. -/ +theorem val_explicitVertexEquiv_inr (m : ℕ) (e : BlockEdge k q) (j : Fin m) : + (explicitVertexEquiv k q m (.inr (e, j)) : ℕ) = + q * (3 * k + 2) + (j + m * blockEdgeEquiv k q e) := by + simp [explicitVertexEquiv, finProdFinEquiv_apply_val] + +/-- The number of the source half of copy `j` of an edge. -/ +theorem val_explicitEdgeEquiv_inl (m : ℕ) (e : BlockEdge k q) (j : Fin m) : + (explicitEdgeEquiv k q m (.inl (e, j)) : ℕ) = j + m * blockEdgeEquiv k q e := by + simp [explicitEdgeEquiv, finProdFinEquiv_apply_val] + +/-- The number of the target half of copy `j` of an edge. -/ +theorem val_explicitEdgeEquiv_inr (m : ℕ) (e : BlockEdge k q) (j : Fin m) : + (explicitEdgeEquiv k q m (.inr (e, j)) : ℕ) = + q * (3 * k + 1) * m + (j + m * blockEdgeEquiv k q e) := by + simp [explicitEdgeEquiv, finProdFinEquiv_apply_val, Nat.add_comm] + +/-- The number of the vertex at which the block edge numbered `n` ends (`edgeTarget`): the next +interval for a control edge (`n < q`), and for a block edge the next interval whose window +contains its block; the sink `q + n` of the edge when there is none. -/ +@[expose] def edgeTargetNum (k q σ n : ℕ) : ℕ := + if n < q then (if n + 1 < q then n + 1 else q + n) + else (firstAfterNum k q σ ((n - q) % (k * 3) / 3 + 1) ((n - q) / (k * 3)) ((n - q) % 3)).getD + (q + n) + +/-- **Edge targets on numbers.** -/ +theorem edgeTargetNum_blockEdgeEquiv (σ m : ℕ) (e : BlockEdge k q) : + edgeTargetNum k q σ (blockEdgeEquiv k q e) = + explicitVertexEquiv k q m (.inl (edgeTarget (scheduleOfNat k q σ) e)) := by + rcases e with i | ⟨i, h, δ⟩ + · rw [val_blockEdgeEquiv_inl, edgeTargetNum, ite_eq_left i.isLt] + simp only [edgeTarget] + split_ifs with hi + · rw [val_explicitVertexEquiv_interval] + · rw [val_explicitVertexEquiv_sink, val_blockEdgeEquiv_inl] + · have hk : 0 < k := Fin.pos h + have hδ := δ.isLt + have hh := h.isLt + have hlt : (δ : ℕ) + 3 * (h : ℕ) < k * 3 := by omega + have hdiv : ((δ : ℕ) + 3 * (h : ℕ) + k * 3 * (i : ℕ)) / (k * 3) = i := by + rw [Nat.add_mul_div_left _ _ (by omega), Nat.div_eq_of_lt hlt, zero_add] + have hmod : ((δ : ℕ) + 3 * (h : ℕ) + k * 3 * (i : ℕ)) % (k * 3) = (δ : ℕ) + 3 * (h : ℕ) := by + rw [Nat.add_mul_mod_self_left, Nat.mod_eq_of_lt hlt] + have hmod3 : ((δ : ℕ) + 3 * (h : ℕ) + k * 3 * (i : ℕ)) % 3 = δ := by + rw [show (δ : ℕ) + 3 * (h : ℕ) + k * 3 * (i : ℕ) = δ + 3 * (h + k * i) by ring, + Nat.add_mul_mod_self_left, Nat.mod_eq_of_lt hδ] + have hdiv3 : ((δ : ℕ) + 3 * (h : ℕ)) / 3 = h := by omega + rw [val_blockEdgeEquiv_inr, edgeTargetNum, ite_eq_right (by omega), Nat.add_sub_cancel_left, + hdiv, hmod, hmod3, hdiv3, firstAfterNum_eq σ i h δ] + simp only [edgeTarget] + cases firstAfter (InWindow (scheduleOfNat k q σ) h + (portBlock (scheduleOfNat k q σ) i h δ)) i with + | none => + simp only [Option.map_none, Option.getD_none, Option.elim_none] + rw [val_explicitVertexEquiv_sink, val_blockEdgeEquiv_inr] + | some i' => + simp only [Option.map_some, Option.getD_some, Option.elim_some] + rw [val_explicitVertexEquiv_interval] + +/-- The number of the interval that the block edge numbered `n` leaves. -/ +@[expose] def blockSrcNum (k q n : ℕ) : ℕ := if n < q then n else (n - q) / (k * 3) + +/-- The interval an edge leaves, on numbers. -/ +theorem blockSrcNum_blockEdgeEquiv (m : ℕ) (e : BlockEdge k q) : + blockSrcNum k q (blockEdgeEquiv k q e) = + explicitVertexEquiv k q m (.inl (.inl (e.elim id Prod.fst))) := by + rw [val_explicitVertexEquiv_interval] + rcases e with i | ⟨i, h, δ⟩ + · rw [val_blockEdgeEquiv_inl, blockSrcNum, ite_eq_left i.isLt] + rfl + · have hδ := δ.isLt + have hh := h.isLt + have hlt : (δ : ℕ) + 3 * (h : ℕ) < k * 3 := by omega + rw [val_blockEdgeEquiv_inr, blockSrcNum, ite_eq_right (by omega), Nat.add_sub_cancel_left, + Nat.add_mul_div_left _ _ (by omega), Nat.div_eq_of_lt hlt, zero_add] + rfl + +/-- The number of the vertex at which the explicit edge numbered `j` starts: the interval of its +edge for a source half (`j < q (3 k + 1) m`), and the target of its edge for a target half. -/ +@[expose] def explicitSrcNum (k q m σ j : ℕ) : ℕ := + if j < q * (3 * k + 1) * m then blockSrcNum k q (j / m) + else edgeTargetNum k q σ ((j - q * (3 * k + 1) * m) / m) + +/-- The number of the vertex at which the explicit edge numbered `j` ends: the subdivision vertex +of its copy. -/ +@[expose] def explicitTgtNum (k q m j : ℕ) : ℕ := + q * (3 * k + 2) + if j < q * (3 * k + 1) * m then j else j - q * (3 * k + 1) * m + +section Endpoints + +variable {State : Type} (machine : MultiTapePTM k Bool State) (input : List Bool) (b : ℕ) + [NeZero b] {m : ℕ} (code : BlockLetter k State b → Fin m → Bool) + +private theorem lt_card_mul (e : BlockEdge k q) (j : Fin m) : + (j : ℕ) + m * blockEdgeEquiv k q e < q * (3 * k + 1) * m := by + have := (blockEdgeEquiv k q e).isLt + have := j.isLt + nlinarith + +private theorem add_mul_div (e : BlockEdge k q) (j : Fin m) : + ((j : ℕ) + m * blockEdgeEquiv k q e) / m = blockEdgeEquiv k q e := by + have := j.isLt + rw [Nat.add_mul_div_left _ _ (by omega), Nat.div_eq_of_lt j.isLt, zero_add] + +omit [NeZero b] in +/-- **The sources of the explicit edges on numbers.** -/ +theorem explicitSrcNum_explicitEdgeEquiv (σ : ℕ) (p : (BlockEdge k q × Fin m) ⊕ + (BlockEdge k q × Fin m)) : + explicitSrcNum k q m σ (explicitEdgeEquiv k q m p) = + explicitVertexEquiv k q m + (((machine.blockNetwork input b (scheduleOfNat k q σ)).binarize code).subdivide.src p) := by + rcases p with ⟨e, j⟩ | ⟨e, j⟩ + · rw [val_explicitEdgeEquiv_inl, explicitSrcNum, ite_eq_left (lt_card_mul e j), add_mul_div, + blockSrcNum_blockEdgeEquiv m e] + simp only [TensorNetwork.subdivide_src_inl, TensorNetwork.binarize_src, blockNetwork_src] + · rw [val_explicitEdgeEquiv_inr, explicitSrcNum, ite_eq_right (by omega), Nat.add_sub_cancel_left, + add_mul_div, edgeTargetNum_blockEdgeEquiv σ m e] + simp only [TensorNetwork.subdivide_src_inr, TensorNetwork.binarize_tgt, blockNetwork_tgt] + +omit [NeZero b] in +/-- **The targets of the explicit edges on numbers.** -/ +theorem explicitTgtNum_explicitEdgeEquiv (σ : ℕ) (p : (BlockEdge k q × Fin m) ⊕ + (BlockEdge k q × Fin m)) : + explicitTgtNum k q m (explicitEdgeEquiv k q m p) = + explicitVertexEquiv k q m + (((machine.blockNetwork input b (scheduleOfNat k q σ)).binarize code).subdivide.tgt p) := by + rcases p with ⟨e, j⟩ | ⟨e, j⟩ + · rw [val_explicitEdgeEquiv_inl, explicitTgtNum, ite_eq_left (lt_card_mul e j)] + exact (val_explicitVertexEquiv_inr m e j).symm + · rw [val_explicitEdgeEquiv_inr, explicitTgtNum, ite_eq_right (by omega), Nat.add_sub_cancel_left] + exact (val_explicitVertexEquiv_inr m e j).symm + +end Endpoints + +/-! ### Ports on numbers -/ + +/-- The ports of the vertex numbered `v`: the numbers of the explicit edges starting or ending at +it, in increasing order. -/ +@[expose] def explicitPortsNum (k q m σ v : ℕ) : List ℕ := + (List.range (2 * (q * (3 * k + 1) * m))).filter fun j => + decide (explicitSrcNum k q m σ j = v ∨ explicitTgtNum k q m j = v) + +variable {s : ℕ} {State : Type} (machine : MultiTapePTM k Bool State) (input : List Bool) + (b : ℕ) [NeZero b] (e : State ≃ Fin s) + +/-- **The ports of the explicit network on numbers**: vertex `v` of the explicit network of the +schedule of `σ` has the ports `explicitPortsNum k q (letterBits k s b) σ v`. -/ +theorem map_fst_vertices_explicitBlockNetwork (σ : ℕ) : + (machine.explicitBlockNetwork input b (scheduleOfNat k q σ) e).vertices.map Prod.fst = + (List.range (q * (3 * k + 2) + q * (3 * k + 1) * letterBits k s b)).map + (explicitPortsNum k q (letterBits k s b) σ) := by + set m := letterBits k s b + set N := ((machine.blockNetwork input b (scheduleOfNat k q σ)).binarize (letterCode e)).subdivide + rw [explicitBlockNetwork, TensorNetwork.toExplicit, List.map_ofFn, + ← List.map_coe_finRange_eq_range, List.map_map, List.ofFn_eq_map] + refine List.map_congr_left fun v _ => ?_ + simp only [Function.comp_apply] + rw [explicitPortsNum, ← List.map_coe_finRange_eq_range, List.filter_map, + TensorNetwork.explicitPorts] + congr 1 + refine List.filter_congr fun j _ => ?_ + have hj := (explicitEdgeEquiv k q m).apply_symm_apply j + simp only [Function.comp_apply, decide_eq_decide] + conv_rhs => rw [← hj, explicitSrcNum_explicitEdgeEquiv machine input b (letterCode e) σ, + explicitTgtNum_explicitEdgeEquiv machine input b (letterCode e) σ] + rw [Fin.val_inj, Fin.val_inj, Equiv.eq_symm_apply, Equiv.eq_symm_apply] + +end Turing.MultiTapePTM diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/GraphPolyTime.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/GraphPolyTime.lean new file mode 100644 index 0000000000..61519887b1 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/GraphPolyTime.lean @@ -0,0 +1,169 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork.Graph +public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.List +public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.Nat +public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.Option +public import Complexity.Computability.Machines.Turing.MultiTape.Encodings.Unary +public import Complexity.Computability.Machines.Turing.MultiTape.PolyTime +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.List +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.Nat +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.Nat.Binary +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.Nat.Div +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.Plain +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeBinaryDivision +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeBinaryPower +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeListPrimitives +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeNatFrontends +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeOptionPrimitives + +/-! +# The graph of an explicit block-counting network in polynomial time + +The ports of the vertices of the explicit block-counting networks, on numbers +(`Turing.MultiTapePTM.explicitPortsNum`), are computable in polynomial time from the number of +intervals and the number of bits of a letter in unary and the schedule number in binary. Every +step is arithmetic on numbers polynomial in the input, except the digits of the schedule number, +which are read in binary. + +## Main results + +* `Turing.MultiTapePTM.computableInPolyTime_digitCount`, + `Turing.MultiTapePTM.computableInPolyTime_firstAfterNum`, + `Turing.MultiTapePTM.computableInPolyTime_edgeTargetNum`: digit counts, next appearances and + edge targets. +* `Turing.MultiTapePTM.computableInPolyTime_explicitSrcNum`, + `Turing.MultiTapePTM.computableInPolyTime_explicitTgtNum`: the endpoints of the explicit + edges. +* `Turing.MultiTapePTM.computableInPolyTime_explicitPortsNum`: the ports of a vertex, as a list of + binary numbers. +-/ + +public section + +namespace Turing.MultiTapePTM + +open MultiTapeTM ComputableInPolyTime + +variable {k : ℕ} {α : Type} {input : α ↪ List Bool} + +/-- The digit of a binary number at a unary position in base `3`, compared with a unary digit. -/ +private theorem digit_eq {σ pos δ : α → ℕ} (hσ : ComputableInPolyTime σ input encNat) + (hpos : ComputableInPolyTime pos input encUnary) + (hδ : ComputableInPolyTime δ input encUnary) : + ComputableInPolyTime (fun a => decide (σ a / 3 ^ pos a % 3 = δ a)) input encBool := by + have hpow : ComputableInPolyTime (fun a => 3 ^ pos a) input encNat := + binary_pow' (const 3) hpos + have hdigit : ComputableInPolyTime (fun a => σ a / 3 ^ pos a % 3) input encNat := + binary_mod.comp ((binary_div.comp (hσ.prod hpow)).prod (const 3)) + exact decide_eq' hdigit (unary_to_binary.comp hδ) + +/-- **Digit counts are polynomial-time.** -/ +theorem computableInPolyTime_digitCount {σ c δ i : α → ℕ} + (hσ : ComputableInPolyTime σ input encNat) (hc : ComputableInPolyTime c input encUnary) + (hδ : ComputableInPolyTime δ input encUnary) (hi : ComputableInPolyTime i input encUnary) : + ComputableInPolyTime (fun a => digitCount k (σ a) (c a) (δ a) (i a)) input encUnary := by + unfold digitCount + refine countPWithInput (range.comp hi) ?_ + have hpos : ComputableInPolyTime (fun p : α × ℕ => c p.1 + (k + 1) * p.2) + (encPair input encUnary) encUnary := + unary_add' (hc.comp (fst _ _)) (unary_mul' (const _) (snd _ _)) + exact digit_eq (hσ.comp (fst _ _)) hpos (hδ.comp (fst _ _)) + +/-- Windows on numbers are polynomial-time. -/ +theorem computableInPolyTime_inWindowNum {σ c i δ i' : α → ℕ} + (hσ : ComputableInPolyTime σ input encNat) (hc : ComputableInPolyTime c input encUnary) + (hi : ComputableInPolyTime i input encUnary) (hδ : ComputableInPolyTime δ input encUnary) + (hi' : ComputableInPolyTime i' input encUnary) : + ComputableInPolyTime (fun a => inWindowNum k (σ a) (c a) (i a) (δ a) (i' a)) input + encBool := by + have h2 := fun {j : α → ℕ} (hj : ComputableInPolyTime j input encUnary) => + computableInPolyTime_digitCount (k := k) hσ hc (const 2) hj + have h0 := fun {j : α → ℕ} (hj : ComputableInPolyTime j input encUnary) => + computableInPolyTime_digitCount (k := k) hσ hc (const 0) hj + unfold inWindowNum + exact decide_and + (unary_le' (unary_add' (unary_add' (h2 hi') (h0 hi)) (const 1)) + (unary_add' (unary_add' (unary_add' (h0 hi') (h2 hi)) hδ) (const 1))) + (unary_le' (unary_add' (unary_add' (h0 hi') (h2 hi)) hδ) + (unary_add' (unary_add' (h2 hi') (h0 hi)) (const 2))) + +/-- **Next appearances are polynomial-time**: a search over the intervals. -/ +theorem computableInPolyTime_firstAfterNum {q σ c i δ : α → ℕ} + (hq : ComputableInPolyTime q input encUnary) (hσ : ComputableInPolyTime σ input encNat) + (hc : ComputableInPolyTime c input encUnary) (hi : ComputableInPolyTime i input encUnary) + (hδ : ComputableInPolyTime δ input encUnary) : + ComputableInPolyTime (fun a => firstAfterNum k (q a) (σ a) (c a) (i a) (δ a)) input + (encOption encUnary) := by + unfold firstAfterNum + refine findWithInput (range.comp hq) (bool_and' (unary_lt' (hi.comp (fst _ _)) (snd _ _)) ?_) + exact computableInPolyTime_inWindowNum (hσ.comp (fst _ _)) (hc.comp (fst _ _)) + (hi.comp (fst _ _)) (hδ.comp (fst _ _)) (snd _ _) + +/-- **Edge targets are polynomial-time.** -/ +theorem computableInPolyTime_edgeTargetNum {q σ n : α → ℕ} + (hq : ComputableInPolyTime q input encUnary) (hσ : ComputableInPolyTime σ input encNat) + (hn : ComputableInPolyTime n input encUnary) : + ComputableInPolyTime (fun a => edgeTargetNum k (q a) (σ a) (n a)) input encUnary := by + have hr : ComputableInPolyTime (fun a => n a - q a) input encUnary := unary_sub' hn hq + have hk3 : ComputableInPolyTime (fun _ : α => k * 3) input encUnary := const _ + have hsink : ComputableInPolyTime (fun a => q a + n a) input encUnary := unary_add' hq hn + unfold edgeTargetNum + refine ite_decide (unary_lt' hn hq) + (ite_decide (unary_lt' (unary_add' hn (const 1)) hq) (unary_add' hn (const 1)) hsink) ?_ + refine optionGetDWithInput (computableInPolyTime_firstAfterNum hq hσ ?_ ?_ ?_) hsink + · exact unary_add' (unary_div.comp ((unary_mod.comp (hr.prod hk3)).prod (const 3))) (const 1) + · exact unary_div.comp (hr.prod hk3) + · exact unary_mod.comp (hr.prod (const 3)) + +/-- **The sources of the explicit edges are polynomial-time.** -/ +theorem computableInPolyTime_explicitSrcNum {q m σ j : α → ℕ} + (hq : ComputableInPolyTime q input encUnary) (hm : ComputableInPolyTime m input encUnary) + (hσ : ComputableInPolyTime σ input encNat) (hj : ComputableInPolyTime j input encUnary) : + ComputableInPolyTime (fun a => explicitSrcNum k (q a) (m a) (σ a) (j a)) input encUnary := by + have hcard : ComputableInPolyTime (fun a => q a * (3 * k + 1) * m a) input encUnary := + unary_mul' (unary_mul' hq (const _)) hm + unfold explicitSrcNum blockSrcNum + refine ite_decide (unary_lt' hj hcard) ?_ ?_ + · have hn : ComputableInPolyTime (fun a => j a / m a) input encUnary := + unary_div.comp (hj.prod hm) + exact ite_decide (unary_lt' hn hq) hn (unary_div.comp ((unary_sub' hn hq).prod (const _))) + · exact computableInPolyTime_edgeTargetNum hq hσ (unary_div.comp ((unary_sub' hj hcard).prod hm)) + +/-- **The targets of the explicit edges are polynomial-time.** -/ +theorem computableInPolyTime_explicitTgtNum {q m j : α → ℕ} + (hq : ComputableInPolyTime q input encUnary) (hm : ComputableInPolyTime m input encUnary) + (hj : ComputableInPolyTime j input encUnary) : + ComputableInPolyTime (fun a => explicitTgtNum k (q a) (m a) (j a)) input encUnary := by + have hcard : ComputableInPolyTime (fun a => q a * (3 * k + 1) * m a) input encUnary := + unary_mul' (unary_mul' hq (const _)) hm + unfold explicitTgtNum + exact unary_add' (unary_mul' hq (const _)) + (ite_decide (unary_lt' hj hcard) hj (unary_sub' hj hcard)) + +/-- **The ports of a vertex are polynomial-time**, as a list of binary numbers. -/ +theorem computableInPolyTime_explicitPortsNum {q m σ v : α → ℕ} + (hq : ComputableInPolyTime q input encUnary) (hm : ComputableInPolyTime m input encUnary) + (hσ : ComputableInPolyTime σ input encNat) (hv : ComputableInPolyTime v input encUnary) : + ComputableInPolyTime (fun a => explicitPortsNum k (q a) (m a) (σ a) (v a)) input + (encList encNat) := by + have hM : ComputableInPolyTime (fun a => 2 * (q a * (3 * k + 1) * m a)) input encUnary := + unary_mul' (const 2) (unary_mul' (unary_mul' hq (const _)) hm) + have hfilter : ComputableInPolyTime (fun a => explicitPortsNum k (q a) (m a) (σ a) (v a)) input + (encList encUnary) := by + unfold explicitPortsNum + refine filterWithInput (range.comp hM) (decide_or ?_ ?_) + · exact decide_eq' (computableInPolyTime_explicitSrcNum (hq.comp (fst _ _)) (hm.comp (fst _ _)) + (hσ.comp (fst _ _)) (snd _ _)) (hv.comp (fst _ _)) + · exact decide_eq' (computableInPolyTime_explicitTgtNum (hq.comp (fst _ _)) (hm.comp (fst _ _)) + (snd _ _)) (hv.comp (fst _ _)) + simpa only [Function.comp_def, List.map_id'] using (map unary_to_binary).comp hfilter + +end Turing.MultiTapePTM diff --git a/ComplexityTests/HPVExplicitGraph.lean b/ComplexityTests/HPVExplicitGraph.lean new file mode 100644 index 0000000000..b212f58ded --- /dev/null +++ b/ComplexityTests/HPVExplicitGraph.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork.GraphPolyTime + +/-! The graph of the explicit block-counting networks on numbers: schedule numbers, edge targets +and ports for concrete machines, compared with the explicit networks, and the polynomial-time +certificate. -/ + +namespace ComplexityTests.HPVExplicitGraph + +open Turing MultiTapeMachine MultiTapePTM Cslib.Circuits.Frontier + +/-- Emit the first coin and halt. No work tapes; the input head stays. -/ +private def emitCoin : MultiTapePTM 0 Bool Unit where + initial := () + tr _ _ _ _ bit := .step + { inputTape := 0, workTapes := Fin.elim0, output := some bit, state := none } + Empty.elim Empty.elim + +/-- On one work tape, write every coin and move right. The first step emits its coin; then the +machine keeps walking without output. -/ +private def walk : MultiTapePTM 1 Bool Bool where + initial := false + tr state _ _ _ bit := .step + { inputTape := 1, + workTapes := fun _ => (some (some bit), 1), + output := if state then none else some bit, state := some true } + Empty.elim Empty.elim + +/-! ### Schedule numbers -/ + +-- With one work tape and two intervals, the digits of `σ = 2 + 1 * 3 + 0 * 9 + 2 * 27 = 59` are +-- `2, 1` for interval `0` (input head up, work head stays) and `0, 2` for interval `1`. +example : scheduleOfNat 1 2 59 0 none = 1 ∧ scheduleOfNat 1 2 59 0 (some 0) = 0 ∧ + scheduleOfNat 1 2 59 1 none = -1 ∧ scheduleOfNat 1 2 59 1 (some 0) = 1 := by decide + +-- So at the start of interval `2` the input head is back in block `0` and the work head in +-- block `1`, counted by its digits `2` and `0`. +example : scheduleBlock (scheduleOfNat 1 2 59) 2 none = 0 ∧ + scheduleBlock (scheduleOfNat 1 2 59) 2 (some 0) = 1 := by + rw [scheduleBlock_scheduleOfNat 59 le_rfl, scheduleBlock_scheduleOfNat 59 le_rfl] + decide + +-- Summing over the `3` schedule numbers of one interval without work tapes is summing over the +-- schedules: the strings of two bits starting with `true` accept. +example : ∑ σ ∈ Finset.range (3 ^ ((0 + 1) * 1)), + (emitCoin.explicitBlockNetwork [] 2 (scheduleOfNat 0 1 σ) + (Equiv.ofUnique Unit (Fin 1))).contraction = 2 := by + rw [sum_range_scheduleOfNat (fun σ => (emitCoin.explicitBlockNetwork [] 2 σ + (Equiv.ofUnique Unit (Fin 1))).contraction), + sum_contraction_explicitBlockNetwork _ _ _ _ one_pos, + show emitCoin.acceptCount [] (1 * 2) = 2 by decide] + +/-! ### Edge targets and ports -/ + +-- `emitCoin` with one interval of two steps: letters of `(1 + 0 + 4) * 2 = 10` bits. The control +-- edge `0` ends at its sink, vertex `1`. The interval has the `10` source halves as ports, the +-- sink the `10` target halves, and subdivision vertex `2 + r` the two halves of copy `r`. +example : (emitCoin.explicitBlockNetwork [] 2 (scheduleOfNat 0 1 0) + (Equiv.ofUnique Unit (Fin 1))).vertices.map Prod.fst = + List.range 10 :: (List.range 10).map (· + 10) :: + (List.range 10).map fun r => [r, r + 10] := by + rw [map_fst_vertices_explicitBlockNetwork] + decide + +-- `walk` with two intervals, every head staying except the work head, which moves right in +-- interval `0`: digits `1, 2, 1, 1`, so `σ = 1 + 2 * 3 + 9 + 27 = 43`. The block edge `(0, 0, 2)`, +-- number `2 + 2 = 4`, carries block `1`, which is in the window of interval `1`. The block edge +-- `(0, 0, 0)`, number `2`, carries block `-1`, which is not: it ends at its sink `2 + 2`. +example : edgeTargetNum 1 2 43 4 = 1 ∧ edgeTargetNum 1 2 43 2 = 4 := by decide + +-- With every head staying (all digits `1`, `σ = 40`), all three block edges of interval `0` end at +-- interval `1`, and the control edge of interval `1` ends at its sink `2 + 1`. +example : edgeTargetNum 1 2 40 2 = 1 ∧ edgeTargetNum 1 2 40 3 = 1 ∧ edgeTargetNum 1 2 40 4 = 1 ∧ + edgeTargetNum 1 2 40 1 = 3 := by decide + +-- So in the network of `σ = 43`, with letters of `(2 + 1 + 4) * 2 = 14` bits, interval `1` has +-- the `4 * 14` source halves of its edges and the target halves of the control edge `0` and of +-- the block edges `3` and `4`: `56 + 42 = 98` ports. +example : ((walk.explicitBlockNetwork [true] 2 (scheduleOfNat 1 2 43) + finTwoEquiv.symm).vertices.map Prod.fst)[1]!.length = 98 := by + rw [map_fst_vertices_explicitBlockNetwork] + decide + +/-! ### Polynomial time -/ + +-- The ports are polynomial-time in the schedule number (binary) and the vertex (unary). +example : MultiTapeTM.ComputableInPolyTime (fun p : ℕ × ℕ => explicitPortsNum 1 2 14 p.1 p.2) + (MultiTapeTM.encPair MultiTapeTM.encNat MultiTapeTM.encUnary) + (MultiTapeTM.encList MultiTapeTM.encNat) := + computableInPolyTime_explicitPortsNum (.const _) (.const _) + (MultiTapeTM.ComputableInPolyTime.fst _ _) (MultiTapeTM.ComputableInPolyTime.snd _ _) + +end ComplexityTests.HPVExplicitGraph From 3b7f4c03645c6704d4925f2fbbbfd3f64ea6ce59 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 22:47:12 -0400 Subject: [PATCH 18/19] refactor(machines): state the numeric ports per vertex (#1833 H3) `map_val_explicitPorts` gives the ports of any vertex of the binarized, subdivided network for any letter code; `map_fst_vertices_explicitBlockNetwork` now follows from it. The table twin uses the per-vertex form. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- .../ExplicitBlockNetwork/Graph.lean | 43 ++++++++++++------- 1 file changed, 28 insertions(+), 15 deletions(-) diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/Graph.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/Graph.lean index 0b7cac6ff1..78e46c9aba 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/Graph.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/Graph.lean @@ -35,7 +35,8 @@ by arithmetic on natural numbers, the form in which a polynomial-time constructi `Turing.MultiTapePTM.explicitSrcNum` and `Turing.MultiTapePTM.explicitTgtNum`, and the ports of a vertex are the edge numbers with that vertex as an endpoint (`Turing.MultiTapePTM.explicitPortsNum`). They are the ports of the explicit network - (`Turing.MultiTapePTM.map_fst_vertices_explicitBlockNetwork`). + (`Turing.MultiTapePTM.map_val_explicitPorts`, + `Turing.MultiTapePTM.map_fst_vertices_explicitBlockNetwork`). ## Main definitions @@ -54,7 +55,8 @@ by arithmetic on natural numbers, the form in which a polynomial-time constructi * `Turing.MultiTapePTM.edgeTargetNum_blockEdgeEquiv`: the edge targets on numbers. * `Turing.MultiTapePTM.explicitSrcNum_explicitEdgeEquiv`, `Turing.MultiTapePTM.explicitTgtNum_explicitEdgeEquiv`: the endpoints on numbers. -* `Turing.MultiTapePTM.map_fst_vertices_explicitBlockNetwork`: the ports of the explicit network +* `Turing.MultiTapePTM.map_val_explicitPorts`, + `Turing.MultiTapePTM.map_fst_vertices_explicitBlockNetwork`: the ports of the explicit network on numbers. -/ @@ -358,8 +360,29 @@ it, in increasing order. -/ (List.range (2 * (q * (3 * k + 1) * m))).filter fun j => decide (explicitSrcNum k q m σ j = v ∨ explicitTgtNum k q m j = v) -variable {s : ℕ} {State : Type} (machine : MultiTapePTM k Bool State) (input : List Bool) - (b : ℕ) [NeZero b] (e : State ≃ Fin s) +variable {State : Type} (machine : MultiTapePTM k Bool State) (input : List Bool) (b : ℕ) + [NeZero b] + +omit [NeZero b] in +/-- **The ports of a vertex on numbers**: for any letter code, the ports of the vertex `w` of the +binarized and subdivided network, numbered by `explicitEdgeEquiv`, are +`explicitPortsNum` at the number of `w`. -/ +theorem map_val_explicitPorts {m : ℕ} (code : BlockLetter k State b → Fin m → Bool) (σ : ℕ) + (w : (Fin q ⊕ BlockEdge k q) ⊕ BlockEdge k q × Fin m) : + ((((machine.blockNetwork input b (scheduleOfNat k q σ)).binarize code).subdivide.explicitPorts + (explicitEdgeEquiv k q m) w).map Fin.val) = + explicitPortsNum k q m σ (explicitVertexEquiv k q m w) := by + rw [explicitPortsNum, ← List.map_coe_finRange_eq_range, List.filter_map, + TensorNetwork.explicitPorts] + congr 1 + refine List.filter_congr fun j _ => ?_ + have hj := (explicitEdgeEquiv k q m).apply_symm_apply j + simp only [Function.comp_apply, decide_eq_decide] + conv_rhs => rw [← hj, explicitSrcNum_explicitEdgeEquiv machine input b code σ, + explicitTgtNum_explicitEdgeEquiv machine input b code σ] + simp only [Fin.val_inj, Equiv.apply_eq_iff_eq] + +variable {s : ℕ} (e : State ≃ Fin s) /-- **The ports of the explicit network on numbers**: vertex `v` of the explicit network of the schedule of `σ` has the ports `explicitPortsNum k q (letterBits k s b) σ v`. -/ @@ -367,20 +390,10 @@ theorem map_fst_vertices_explicitBlockNetwork (σ : ℕ) : (machine.explicitBlockNetwork input b (scheduleOfNat k q σ) e).vertices.map Prod.fst = (List.range (q * (3 * k + 2) + q * (3 * k + 1) * letterBits k s b)).map (explicitPortsNum k q (letterBits k s b) σ) := by - set m := letterBits k s b - set N := ((machine.blockNetwork input b (scheduleOfNat k q σ)).binarize (letterCode e)).subdivide rw [explicitBlockNetwork, TensorNetwork.toExplicit, List.map_ofFn, ← List.map_coe_finRange_eq_range, List.map_map, List.ofFn_eq_map] refine List.map_congr_left fun v _ => ?_ simp only [Function.comp_apply] - rw [explicitPortsNum, ← List.map_coe_finRange_eq_range, List.filter_map, - TensorNetwork.explicitPorts] - congr 1 - refine List.filter_congr fun j _ => ?_ - have hj := (explicitEdgeEquiv k q m).apply_symm_apply j - simp only [Function.comp_apply, decide_eq_decide] - conv_rhs => rw [← hj, explicitSrcNum_explicitEdgeEquiv machine input b (letterCode e) σ, - explicitTgtNum_explicitEdgeEquiv machine input b (letterCode e) σ] - rw [Fin.val_inj, Fin.val_inj, Equiv.eq_symm_apply, Equiv.eq_symm_apply] + rw [map_val_explicitPorts, Equiv.apply_symm_apply] end Turing.MultiTapePTM From f16d8e4f52ba802f46d3fa0a3bdb71ae5a64f782 Mon Sep 17 00:00:00 2001 From: Samuel Giuseppe Schlesinger Date: Fri, 30 Oct 2026 23:01:06 -0400 Subject: [PATCH 19/19] feat(machines): the tables of explicit block-counting networks on numbers (#1833 H3) Decode letter numbers into control records on plain data and block cells, compute the window entering an interval (`lastBeforeNum`, `portOfNum`), and evaluate the tensors of the block-counting network from letter numbers (`blockNetwork_tensor_decodeLetter`). Reading the letters from the table index and the ports gives every table entry on numbers, so `explicitBlockNetwork_eq_explicitNetworkNum` computes the whole explicit network. `computableInPolyTime_explicitNetworkNum` certifies it in plain polynomial time when `2 ^ b` has a computed unary bound. Adds the public `ControlData.computableInPolyTime_mk`. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_015DLg8kwPs8yi7ePPdtoNvG --- Complexity.lean | 2 + .../ExplicitBlockNetwork/Table.lean | 802 ++++++++++++++++++ .../ExplicitBlockNetwork/TablePolyTime.lean | 474 +++++++++++ .../Probabilistic/IntervalCount/PolyTime.lean | 13 +- ComplexityTests/HPVExplicitTables.lean | 77 ++ 5 files changed, 1367 insertions(+), 1 deletion(-) create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/Table.lean create mode 100644 Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/TablePolyTime.lean create mode 100644 ComplexityTests/HPVExplicitTables.lean diff --git a/Complexity.lean b/Complexity.lean index fc1478063e..3dedf164ef 100644 --- a/Complexity.lean +++ b/Complexity.lean @@ -1814,6 +1814,8 @@ public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.D public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork.Graph public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork.GraphPolyTime +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork.Table +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork.TablePolyTime public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExtendTapes public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.InputFromTape public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalCount diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/Table.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/Table.lean new file mode 100644 index 0000000000..78b02e38b8 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/Table.lean @@ -0,0 +1,802 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork.Graph +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalCount + +/-! +# The tables of an explicit block-counting network, on numbers + +The tables of the explicit block-counting network of a schedule +(`Turing.MultiTapePTM.explicitBlockNetwork`) are values of the tensors of the block-counting +network (`Turing.MultiTapePTM.blockNetwork`) at letters read from the bits of a table index. This +module computes them from numbers, the form in which a polynomial-time construction produces +them. + +* **Letters from numbers.** A letter is read as its number (`Turing.MultiTapePTM.letterEquiv`), + and every natural number is decoded to a letter (`Turing.MultiTapePTM.decodeLetter`), inverting + the numbering (`Turing.MultiTapePTM.decodeLetter_letterEquiv`). The control record of a number + is computed on plain data by division and remainder (`Turing.MultiTapePTM.decodeControlData`), + and so are the cells of block contents (`Turing.MultiTapePTM.contentsCellNum`) and the accepting + weight (`Turing.MultiTapePTM.acceptNum`). +* **The window entering an interval.** The previous appearance of a block in windows is a search + over the earlier intervals (`Turing.MultiTapePTM.lastBeforeNum_eq`), and its window entry is a + digit-count difference (`Turing.MultiTapePTM.portOfNum`). +* **The tensors on numbers.** Given the numbers of the letters on all edges, the tensor of an + interval is an interval count on plain data (`Turing.MultiTapePTM.localIntervalCount`) when the + letters leaving it have the right kinds, and zero otherwise; the sinks are the accepting weight + or `1` (`Turing.MultiTapePTM.blockNetwork_tensor_decodeLetter`). + +## Main definitions + +* `Turing.MultiTapePTM.decodeControlData`, `Turing.MultiTapePTM.decodeLetter`, + `Turing.MultiTapePTM.contentsCellNum`, `Turing.MultiTapePTM.acceptNum`: decoding letters. +* `Turing.MultiTapePTM.lastBeforeNum`, `Turing.MultiTapePTM.portOfNum`: previous appearances and + window entries on numbers. +* `Turing.MultiTapePTM.intervalEntryNum`, `Turing.MultiTapePTM.oldEntryNum`: the tensors of the + block-counting network on numbers. + +## Main results + +* `Turing.MultiTapePTM.decodeControlData_controlEquiv`, + `Turing.MultiTapePTM.decodeLetter_letterEquiv`: decoding inverts the numberings. +* `Turing.MultiTapePTM.card_intervalHolds`: the tensor of an interval is an interval count. +* `Turing.MultiTapePTM.blockNetwork_tensor_decodeLetter`: the tensors on numbers. +-/ + +public section + +namespace Turing.MultiTapePTM + +open Cslib.Circuits.Frontier MultiTapeNTM.ChoiceTable + +variable {k q s : ℕ} {State : Type} + +/-! ### Products of numberings -/ + +private theorem val_finProdFinEquiv_div {m n : ℕ} (x : Fin m × Fin n) : + (finProdFinEquiv x : ℕ) / n = x.1 := by + have := x.2.isLt + rw [finProdFinEquiv_apply_val, Nat.add_mul_div_left _ _ (by omega), Nat.div_eq_of_lt x.2.isLt, + zero_add] + +private theorem val_finProdFinEquiv_mod {m n : ℕ} (x : Fin m × Fin n) : + (finProdFinEquiv x : ℕ) % n = x.2 := by + rw [finProdFinEquiv_apply_val, Nat.add_mul_mod_self_left, Nat.mod_eq_of_lt x.2.isLt] + +/-- Digit `r < b` in base `3` of a number is that of its remainder modulo `3 ^ b`. -/ +private theorem mod_pow_div_pow_mod (x : ℕ) {r b : ℕ} (hr : r < b) : + x % 3 ^ b / 3 ^ r % 3 = x / 3 ^ r % 3 := by + obtain ⟨d, rfl⟩ : ∃ d, b = r + (d + 1) := ⟨b - r - 1, by omega⟩ + rw [pow_add, Nat.mod_mul_right_div_self, Nat.mod_mod_of_dvd _ (dvd_pow_self 3 (by omega))] + +private theorem equivFin_symm_eq_accept_iff {t : ℕ} (ht : t < 3) : + OutputTrack.equivFin.symm ⟨t, ht⟩ = .accept ↔ t = 1 := by + interval_cases t <;> simp [OutputTrack.equivFin] + +/-! ### Decoding letters -/ + +/-- The number of control records, which come first among the letters. -/ +@[expose] def controlCount (k s b : ℕ) : ℕ := (s + 1) * (b ^ (k + 1) * 3) + +/-- The number of letters. -/ +@[expose] def letterCount (k s b : ℕ) : ℕ := controlCount k s b + 3 ^ b + +section Decode + +variable (e : State ≃ Fin s) (b : ℕ) + +/-- The state numbered `i ≤ s`: none for `0`, and the state numbered `i - 1` by `e` otherwise. -/ +@[expose] def stateOfFin (i : Fin (s + 1)) : Option State := + ((Equiv.optionCongr e).trans (finSuccEquiv s).symm).symm i + +/-- **The control record of a number**, on plain data: the state from the quotient by +`b ^ (k + 1) * 3` (capped at `s`), the offsets as digits in base `b` and the output track from the +remainder. -/ +@[expose] def decodeControlData (n : ℕ) : ControlData k State := + (stateOfFin e ⟨min s (n / (b ^ (k + 1) * 3)) % (s + 1), Nat.mod_lt _ (by omega)⟩, + fun head => n % (b ^ (k + 1) * 3) / 3 / b ^ ((finSuccEquiv k).symm head : ℕ) % b, + OutputTrack.equivFin.symm ⟨n % (b ^ (k + 1) * 3) % 3, Nat.mod_lt _ (by omega)⟩) + +/-- **Decoding control records inverts their numbering.** -/ +theorem decodeControlData_controlEquiv [NeZero b] (c : BlockControl k State b) : + decodeControlData e b (controlEquiv e c) = controlData c := by + obtain ⟨st, off, tr⟩ := c + set x := controlEquiv e (st, off, tr) + have hx : (x : ℕ) = (finProdFinEquiv (((Equiv.optionCongr e).trans (finSuccEquiv s).symm) st, + finProdFinEquiv (finFunctionFinEquiv fun c => zmodEquiv b (off (finSuccEquiv k c)), + OutputTrack.equivFin tr)) : ℕ) := rfl + have hdiv : (x : ℕ) / (b ^ (k + 1) * 3) = + ((Equiv.optionCongr e).trans (finSuccEquiv s).symm) st := by + rw [hx, val_finProdFinEquiv_div] + have hmod : (x : ℕ) % (b ^ (k + 1) * 3) = (finProdFinEquiv (finFunctionFinEquiv fun c => + zmodEquiv b (off (finSuccEquiv k c)), OutputTrack.equivFin tr) : ℕ) := by + rw [hx, val_finProdFinEquiv_mod] + have hst : stateOfFin e ⟨min s ((x : ℕ) / (b ^ (k + 1) * 3)) % (s + 1), + Nat.mod_lt _ (by omega)⟩ = st := by + have hlt := (((Equiv.optionCongr e).trans (finSuccEquiv s).symm) st).isLt + have hfin : (⟨min s ((x : ℕ) / (b ^ (k + 1) * 3)) % (s + 1), Nat.mod_lt _ (by omega)⟩ : + Fin (s + 1)) = ((Equiv.optionCongr e).trans (finSuccEquiv s).symm) st := by + ext + simp only + rw [hdiv, Nat.min_eq_right (by omega), Nat.mod_eq_of_lt hlt] + rw [hfin, stateOfFin, Equiv.symm_apply_apply] + have htr : OutputTrack.equivFin.symm ⟨(x : ℕ) % (b ^ (k + 1) * 3) % 3, + Nat.mod_lt _ (by omega)⟩ = tr := by + have hfin : (⟨(x : ℕ) % (b ^ (k + 1) * 3) % 3, Nat.mod_lt _ (by omega)⟩ : Fin 3) = + OutputTrack.equivFin tr := by + ext + simp only + rw [hmod, val_finProdFinEquiv_mod] + rw [hfin, Equiv.symm_apply_apply] + have hoff : ∀ head, + (x : ℕ) % (b ^ (k + 1) * 3) / 3 / b ^ ((finSuccEquiv k).symm head : ℕ) % b = + (off head).val := by + intro head + rw [hmod, val_finProdFinEquiv_div, ← finFunctionFinEquiv_symm_apply_val, + Equiv.symm_apply_apply, val_zmodEquiv, Equiv.apply_symm_apply] + simp only [decodeControlData, controlData, hst, htr, hoff] + +/-- The control record entering an interval from a letter number: the decoded record of a control +letter, and the default record of block contents. -/ +@[expose] def controlDataOfNum (n : ℕ) : ControlData k State := + if n < controlCount k s b then decodeControlData e b n else (none, fun _ => 0, .empty) + +/-- The cell `r` of the block contents numbered `n`, blank for a control record. -/ +@[expose] def contentsCellNum (k s b n r : ℕ) : Option Bool := + if n < controlCount k s b then none + else cellEquiv.symm ⟨(n - controlCount k s b) / 3 ^ r % 3, Nat.mod_lt _ (by omega)⟩ + +/-- The accepting weight of the letter numbered `n`: one for a control record with output track +`accept`. -/ +@[expose] def acceptNum (k s b n : ℕ) : ℕ := + if n < controlCount k s b ∧ n % (b ^ (k + 1) * 3) % 3 = 1 then 1 else 0 + +variable [NeZero b] + +/-- **The letter of a number**: the control record of that number for a number below +`controlCount`, and otherwise the block contents of the remainder of `n - controlCount` modulo +`3 ^ b`. Below `letterCount` this inverts `Turing.MultiTapePTM.letterEquiv`. -/ +@[expose] def decodeLetter (n : ℕ) : BlockLetter k State b := + if h : n < controlCount k s b then .inl ((controlEquiv e).symm ⟨n, h⟩) + else .inr ((contentsEquiv b).symm + ⟨(n - controlCount k s b) % 3 ^ b, Nat.mod_lt _ (by positivity)⟩) + +/-- **Decoding letters inverts their numbering.** -/ +theorem decodeLetter_letterEquiv (l : BlockLetter k State b) : + decodeLetter e b (letterEquiv e l) = l := by + rcases l with c | w + · have hval : (letterEquiv e (.inl c) : ℕ) = controlEquiv e c := by + simp [letterEquiv] + have hlt : (letterEquiv e (.inl c) : ℕ) < controlCount k s b := by + rw [hval] + exact (controlEquiv e c).isLt + rw [decodeLetter, dite_eq_left hlt] + congr 1 + rw [Equiv.symm_apply_eq] + exact Fin.ext hval.symm + · have hval : (letterEquiv e (.inr w : BlockLetter k State b) : ℕ) = + controlCount k s b + contentsEquiv b w := by + simp [letterEquiv, controlCount] + rw [decodeLetter, dite_eq_right (by omega)] + congr 1 + rw [Equiv.symm_apply_eq] + ext + simp only [hval, Nat.add_sub_cancel_left] + exact Nat.mod_eq_of_lt (contentsEquiv b w).isLt + +/-- Below `letterCount`, the letter of a number is the numbered letter. -/ +theorem decodeLetter_of_lt {n : ℕ} (hn : n < letterCount k s b) : + decodeLetter e b n = (letterEquiv e).symm ⟨n, hn⟩ := by + conv_lhs => rw [show n = (letterEquiv e ((letterEquiv e).symm ⟨n, hn⟩) : ℕ) by simp] + exact decodeLetter_letterEquiv e b _ + +/-- The control record of a decoded letter. -/ +theorem controlData_control_decodeLetter (n : ℕ) : + controlData (decodeLetter (k := k) e b n).control = controlDataOfNum e b n := by + unfold decodeLetter controlDataOfNum + split_ifs with h + · simp only [BlockLetter.control] + rw [← decodeControlData_controlEquiv e b, Equiv.apply_symm_apply] + · simp only [BlockLetter.control, controlData, Pi.zero_apply, ZMod.val_zero] + +/-- The cells of a decoded letter. -/ +theorem contents_decodeLetter (n : ℕ) (r : ZMod b) : + (decodeLetter (k := k) e b n).contents r = contentsCellNum k s b n r.val := by + unfold decodeLetter contentsCellNum + split_ifs with h + · rfl + · simp only [BlockLetter.contents, contentsEquiv, Equiv.symm_trans_apply, Equiv.arrowCongr_symm, + Equiv.arrowCongr_apply, Function.comp_apply, Equiv.symm_symm] + congr 1 + ext + rw [finFunctionFinEquiv_symm_apply_val] + simp only [val_zmodEquiv] + exact mod_pow_div_pow_mod _ (ZMod.val_lt r) + +/-- The accepting weight of a decoded letter. -/ +theorem acceptWeight_decodeLetter (n : ℕ) : + acceptWeight (decodeLetter (k := k) e b n) = acceptNum k s b n := by + unfold decodeLetter acceptNum + by_cases h : n < controlCount k s b + · have hc := decodeControlData_controlEquiv e b ((controlEquiv e).symm ⟨n, h⟩) + rw [Equiv.apply_symm_apply] at hc + have htr := congrArg (fun c => c.2.2) hc + simp only [decodeControlData, controlData] at htr + simp only [h, ↓reduceDIte, acceptWeight, ← htr, equivFin_symm_eq_accept_iff, true_and] + · simp only [h, ↓reduceDIte, acceptWeight, false_and, ↓reduceIte] + +end Decode + +/-! ### The window entering an interval, on numbers -/ + +/-- The last interval before `i` whose window contains the block `δ` of interval `i`'s window, +for the head with digit offset `c`, found by searching the earlier intervals from the latest. -/ +@[expose] def lastBeforeNum (k σ c i δ : ℕ) : Option ℕ := + ((List.range i).find? fun j => inWindowNum k σ c i δ (i - 1 - j)).map fun j => i - 1 - j + +/-- **Previous appearances on numbers.** -/ +theorem lastBeforeNum_eq (σ : ℕ) (i : Fin q) (h : Fin k) (δ : Fin 3) : + lastBeforeNum k σ (h + 1) i δ = + (lastBefore (InWindow (scheduleOfNat k q σ) h + (portBlock (scheduleOfNat k q σ) i h δ)) i).map Fin.val := by + cases hl : lastBefore (InWindow (scheduleOfNat k q σ) h + (portBlock (scheduleOfNat k q σ) i h δ)) i with + | none => + rw [lastBefore_eq_none_iff] at hl + simp only [Option.map_none, lastBeforeNum, Option.map_eq_none_iff, List.find?_eq_none, + List.mem_range] + intro j hj hw + exact hl ⟨i - 1 - j, by omega⟩ (Fin.lt_def.mpr (by simp only; omega)) + ((inWindowNum_iff σ i ⟨i - 1 - j, by omega⟩ h δ).mp hw) + | some i' => + obtain ⟨hlt, hw, hmax⟩ := lastBefore_eq_some_iff.mp hl + have hlt' : (i' : ℕ) < i := hlt + have hfind : (List.range i).find? (fun j => inWindowNum k σ (h + 1) i δ (i - 1 - j)) = + some ((i : ℕ) - 1 - i') := by + rw [List.find?_range_eq_some] + refine ⟨?_, List.mem_range.mpr (by omega), fun j hj => ?_⟩ + · rw [show (i : ℕ) - 1 - (i - 1 - i') = i' by omega] + exact (inWindowNum_iff σ i i' h δ).mpr hw + · rw [Bool.not_eq_true', Bool.eq_false_iff, ne_eq, + inWindowNum_iff σ i ⟨i - 1 - j, by omega⟩ h δ] + exact hmax ⟨i - 1 - j, by omega⟩ (Fin.lt_def.mpr (by simp only; omega)) + (Fin.lt_def.mpr (by simp only; omega)) + simp only [lastBeforeNum, hfind, Option.map_some, Option.some.injEq] + omega + +/-- The window entry, in the window of interval `i'`, of the block `δ` of interval `i`'s window, +for the head with digit offset `c`: `b(i) + δ - b(i') mod 3` from the digit counts. -/ +@[expose] def portOfNum (k σ c i i' δ : ℕ) : ℕ := + (digitCount k σ c 2 i + digitCount k σ c 0 i' + δ - + (digitCount k σ c 0 i + digitCount k σ c 2 i')) % 3 + +/-- **Window entries on numbers.** -/ +theorem val_portOf (σ : ℕ) (i i' : Fin q) (h : Fin k) (δ : Fin 3) : + (portOf (scheduleOfNat k q σ) i' h (portBlock (scheduleOfNat k q σ) i h δ) : ℕ) = + portOfNum k σ (h + 1) i i' δ := by + have hc : (((finSuccEquiv k).symm (some h) : Fin (k + 1)) : ℕ) = h + 1 := by simp + have hb := scheduleBlock_scheduleOfNat (k := k) σ i.isLt.le (some h) + have hb' := scheduleBlock_scheduleOfNat (k := k) σ i'.isLt.le (some h) + rw [hc] at hb hb' + simp only [portOf, portBlock, hb, hb', portOfNum] + congr 1 + omega + +/-! ### The tensor of an interval -/ + +section Interval + +variable (machine : MultiTapePTM k Bool State) (input : List Bool) (b : ℕ) (σ : Schedule k q) + +open scoped Classical in +/-- **The tensor of an interval is an interval count** when the letters leaving it are a control +record and block contents. -/ +theorem card_intervalHolds (i : Fin q) {x : BlockEdge k q → BlockLetter k State b} + {cOut : BlockControl k State b} {wOut : Fin k → Fin 3 → ZMod b → Option Bool} + (hc : x (.inl i) = .inl cOut) (hw : ∀ h d, x (.inr (i, h, d)) = .inr (wOut h d)) : + (Finset.univ.filter fun u => machine.IntervalHolds input b σ i x u).card = + machine.intervalCount b input (scheduleBlock σ i) (σ i) (machine.inControl b i x) + (inWindow σ i x) cOut wOut := by + unfold intervalCount + congr 1 + ext u + simp only [Finset.mem_filter, Finset.mem_univ, true_and, IntervalHolds, hc, hw, Sum.inl.injEq, + Sum.inr.injEq] + constructor + · rintro ⟨c', w', hstep, rfl, hw'⟩ + obtain rfl : w' = wOut := funext fun h => funext fun d => (hw' h d).symm + exact hstep + · exact fun hstep => ⟨cOut, wOut, hstep, rfl, fun _ _ => rfl⟩ + +open scoped Classical in +/-- The tensor of an interval vanishes when a letter leaving it has the wrong kind. -/ +theorem card_intervalHolds_eq_zero (i : Fin q) {x : BlockEdge k q → BlockLetter k State b} + (hx : ¬ ((∃ cOut, x (.inl i) = .inl cOut) ∧ ∀ h d, ∃ w, x (.inr (i, h, d)) = .inr w)) : + (Finset.univ.filter fun u => machine.IntervalHolds input b σ i x u).card = 0 := by + rw [Finset.card_eq_zero, Finset.filter_eq_empty_iff] + rintro u - ⟨cOut, wOut, -, hc, hw⟩ + exact hx ⟨⟨cOut, hc⟩, fun h d => ⟨_, hw h d⟩⟩ + +end Interval + +/-! ### The tensors on numbers -/ + +section Tensors + +variable (e : State ≃ Fin s) (b : ℕ) + +/-- The block indices at the start of interval `i` of the schedule of `σ`, as digit counts. -/ +@[expose] def blockIndexNum (k σ i : ℕ) : Option (Fin k) → ℤ := fun head => + (digitCount k σ ((finSuccEquiv k).symm head) 2 i : ℤ) - + digitCount k σ ((finSuccEquiv k).symm head) 0 i + +/-- The movements of the blocks in interval `i` of the schedule of `σ`. -/ +@[expose] def blockMoveNum (k σ i : ℕ) : Option (Fin k) → SignType := fun head => + signEquiv.symm ⟨σ / 3 ^ (((finSuccEquiv k).symm head : ℕ) + (k + 1) * i) % 3, + Nat.mod_lt _ (by norm_num)⟩ + +/-- The control record entering interval `i`, from the letter numbers `L` of the edges. -/ +@[expose] def inControlNum (initial : State) (L : ℕ → ℕ) (i : ℕ) : ControlData k State := + if i = 0 then (some initial, fun _ => 0, .empty) else controlDataOfNum e b (L (i - 1)) + +/-- The cells of the window of work tape `h` entering interval `i`, from the letter numbers `L` +of the edges of a schedule number `σ` with `q` intervals. -/ +@[expose] def inCellsNum (k q s b σ : ℕ) (L : ℕ → ℕ) (i h : ℕ) : List (Option Bool) := + (List.range (3 * b)).map fun c => + (lastBeforeNum k σ (h + 1) i (c / b)).elim none fun i' => + contentsCellNum k s b (L (q + (portOfNum k σ (h + 1) i i' (c / b) + 3 * h + k * 3 * i'))) + (c % b) + +/-- The cells of the window of work tape `h` leaving interval `i`, from the letter numbers `L` +of the edges. -/ +@[expose] def outCellsNum (k q s b : ℕ) (L : ℕ → ℕ) (i h : ℕ) : List (Option Bool) := + (List.range (3 * b)).map fun c => + contentsCellNum k s b (L (q + (c / b + 3 * h + k * 3 * i))) (c % b) + +variable [DecidableEq State] (machine : MultiTapePTM k Bool State) (input : List Bool) + +/-- **The tensor of interval `i` on numbers**, from the letter numbers `L` of the edges: the +interval count on plain data when the control edge leaving `i` carries a control record and its +block edges carry block contents, and zero otherwise. -/ +@[expose] def intervalEntryNum (q σ : ℕ) (L : ℕ → ℕ) (i : ℕ) : ℕ := + if L i < controlCount k s b ∧ + ∀ h : Fin k, ∀ δ : Fin 3, ¬ L (q + (δ + 3 * h + k * 3 * i)) < controlCount k s b then + machine.localIntervalCount b input (blockIndexNum k σ i) (blockMoveNum k σ i) + (inControlNum e b machine.initial L i) (fun h => inCellsNum k q s b σ L i h) + (decodeControlData e b (L i)) (fun h => outCellsNum k q s b L i h) + else 0 + +/-- **The tensor of an old vertex on numbers**: an interval (`v < q`), or the sink of the edge +numbered `v - q`, which accepts the last control record and is `1` otherwise. -/ +@[expose] def oldEntryNum (q σ : ℕ) (L : ℕ → ℕ) (v : ℕ) : ℕ := + if v < q then intervalEntryNum e b machine input q σ L v + else if v - q + 1 = q then acceptNum k s b (L (v - q)) else 1 + +end Tensors + +/-! ### The tensors of the block-counting network on numbers -/ + +section TensorEq + +variable (e : State ≃ Fin s) (b : ℕ) [NeZero b] + +/-- A decoded letter is a control record exactly below `controlCount`. -/ +theorem exists_decodeLetter_eq_inl_iff (n : ℕ) : + (∃ c, decodeLetter (k := k) e b n = .inl c) ↔ n < controlCount k s b := by + unfold decodeLetter + split_ifs with h + · exact iff_of_true ⟨_, rfl⟩ h + · exact iff_of_false (by rintro ⟨c, hc⟩; cases hc) h + +/-- A decoded letter is block contents exactly from `controlCount` on. -/ +theorem exists_decodeLetter_eq_inr_iff (n : ℕ) : + (∃ w, decodeLetter (k := k) e b n = .inr w) ↔ ¬ n < controlCount k s b := by + unfold decodeLetter + split_ifs with h + · exact iff_of_false (by rintro ⟨c, hc⟩; cases hc) (not_not.mpr h) + · exact iff_of_true ⟨_, rfl⟩ h + +variable [DecidableEq State] (machine : MultiTapePTM k Bool State) (input : List Bool) + +/-- **The tensors of the block-counting network on numbers.** At the letters decoded from numbers +`L` of the edges (`Turing.MultiTapePTM.decodeLetter`), the tensor of an old vertex of the explicit +network is `Turing.MultiTapePTM.oldEntryNum` at its number. -/ +theorem blockNetwork_tensor_decodeLetter (σ : ℕ) (u : Fin q ⊕ BlockEdge k q) (L : ℕ → ℕ) : + (machine.blockNetwork input b (scheduleOfNat k q σ)).tensor u + (fun e' => decodeLetter e b (L (blockEdgeEquiv k q e'))) = + oldEntryNum e b machine input q σ L + (explicitVertexEquiv k q (letterBits k s b) (.inl u)) := by + set x : BlockEdge k q → BlockLetter k State b := + fun e' => decodeLetter e b (L (blockEdgeEquiv k q e')) + rcases u with i | i | ⟨i, h₀, d₀⟩ + · rw [val_explicitVertexEquiv_interval, oldEntryNum, ite_eq_left i.isLt, intervalEntryNum, + blockNetwork_tensor_interval] + have hxl : x (.inl i) = decodeLetter e b (L i) := by + simp only [x, val_blockEdgeEquiv_inl] + have hxr : ∀ (i' : Fin q) h d, x (.inr (i', h, d)) = + decodeLetter e b (L (q + (d + 3 * h + k * 3 * i'))) := by + intro i' h d + simp only [x, val_blockEdgeEquiv_inr] + split_ifs with hcond + · obtain ⟨hctl, hblk⟩ := hcond + have hc : x (.inl i) = .inl (x (.inl i)).control := by + obtain ⟨c, hc⟩ := (exists_decodeLetter_eq_inl_iff e b _).mpr hctl + rw [hxl, hc] + rfl + have hw : ∀ h d, x (.inr (i, h, d)) = .inr (x (.inr (i, h, d))).contents := by + intro h d + obtain ⟨w, hw⟩ := (exists_decodeLetter_eq_inr_iff e b _).mpr (hblk h d) + rw [hxr, hw] + rfl + rw [card_intervalHolds machine input b _ i hc hw, ← localIntervalCount_eq_intervalCount] + congr 1 + · funext head + exact scheduleBlock_scheduleOfNat σ i.isLt.le head + · unfold inControl inControlNum + split_ifs with h0 + · simp only [controlData, Pi.zero_apply, ZMod.val_zero] + · have : x (.inl ⟨i - 1, by omega⟩) = decodeLetter e b (L (i - 1)) := by + simp only [x, val_blockEdgeEquiv_inl] + rw [this, controlData_control_decodeLetter] + · funext h + unfold windowCells inCellsNum + refine List.map_congr_left fun c hc => ?_ + have hc3 : c / b < 3 := by + rw [Nat.div_lt_iff_lt_mul (Nat.pos_of_neZero b)] + simpa [Nat.mul_comm] using List.mem_range.mp hc + rw [dite_eq_left hc3, inWindow, lastBeforeNum_eq σ i h ⟨c / b, hc3⟩] + cases lastBefore (InWindow (scheduleOfNat k q σ) h + (portBlock (scheduleOfNat k q σ) i h ⟨c / b, hc3⟩)) i with + | none => rfl + | some i' => + simp only [Option.elim_some, Option.map_some] + rw [hxr, contents_decodeLetter, ZMod.val_natCast, val_portOf σ i i' h ⟨c / b, hc3⟩] + · rw [hxl, controlData_control_decodeLetter, controlDataOfNum, ite_eq_left hctl] + · funext h + unfold windowCells outCellsNum + refine List.map_congr_left fun c hc => ?_ + have hc3 : c / b < 3 := by + rw [Nat.div_lt_iff_lt_mul (Nat.pos_of_neZero b)] + simpa [Nat.mul_comm] using List.mem_range.mp hc + rw [dite_eq_left hc3] + simp only + rw [hxr, contents_decodeLetter, ZMod.val_natCast] + · refine card_intervalHolds_eq_zero machine input b _ i fun ⟨⟨c, hc⟩, hw⟩ => hcond ⟨?_, ?_⟩ + · rw [hxl] at hc + exact (exists_decodeLetter_eq_inl_iff e b _).mp ⟨c, hc⟩ + · intro h d + obtain ⟨w, hw⟩ := hw h d + rw [hxr] at hw + exact (exists_decodeLetter_eq_inr_iff e b _).mp ⟨w, hw⟩ + · rw [val_explicitVertexEquiv_sink, val_blockEdgeEquiv_inl, oldEntryNum, + ite_eq_right (by omega), blockNetwork_tensor_controlSink, Nat.add_sub_cancel_left] + have hxl : x (.inl i) = decodeLetter e b (L i) := by + simp only [x, val_blockEdgeEquiv_inl] + rw [hxl, acceptWeight_decodeLetter] + · rw [val_explicitVertexEquiv_sink, val_blockEdgeEquiv_inr, oldEntryNum, + ite_eq_right (by omega), ite_eq_right (by omega), blockNetwork_tensor_blockSink] + +end TensorEq + +/-! ### Reading letters from table indices -/ + +section Read + +variable (e : State ≃ Fin s) (b : ℕ) [NeZero b] + +/-- Bits are the code of a letter exactly when they write its number. -/ +theorem letterCode_eq_iff (l : BlockLetter k State b) (bits : Fin (letterBits k s b) → Bool) : + letterCode e l = bits ↔ (letterEquiv e l : ℕ) = Cslib.BitString.lsbValue (List.ofFn bits) := by + have hlt : (letterEquiv e l : ℕ) < 2 ^ letterBits k s b := + (letterEquiv e l).isLt.trans_le card_letter_le_two_pow + constructor + · rintro rfl + refine Nat.eq_of_testBit_eq fun i => ?_ + rw [Cslib.BitString.testBit_lsbValue] + by_cases hi : i < letterBits k s b + · rw [List.getD_eq_getElem _ _ (by simpa using hi), List.getElem_ofFn] + rfl + · rw [List.getD_eq_default _ _ (by simpa using hi), + Nat.testBit_lt_two_pow (hlt.trans_le (Nat.pow_le_pow_right two_pos (not_lt.mp hi)))] + · intro h + funext r + simp only [letterCode, h, Cslib.BitString.testBit_lsbValue] + rw [List.getD_eq_getElem _ _ (by rw [List.length_ofFn]; exact r.isLt), List.getElem_ofFn] + +/-- **Reading a letter code**: bits are the code of a letter exactly when the number they write is +below `letterCount`. -/ +theorem mem_range_letterCode_iff (bits : Fin (letterBits k s b) → Bool) : + bits ∈ Set.range (letterCode (k := k) e) ↔ + Cslib.BitString.lsbValue (List.ofFn bits) < letterCount k s b := by + constructor + · rintro ⟨l, hl⟩ + rw [← (letterCode_eq_iff e b l bits).mp hl] + exact (letterEquiv e l).isLt + · intro h + exact ⟨(letterEquiv e).symm ⟨_, h⟩, (letterCode_eq_iff e b _ bits).mpr (by simp)⟩ + +/-- The letter read from the code `bits` is the decoded letter of their number. -/ +theorem invFun_letterCode {bits : Fin (letterBits k s b) → Bool} + (h : Cslib.BitString.lsbValue (List.ofFn bits) < letterCount k s b) : + Function.invFun (letterCode (k := k) e) bits = + decodeLetter e b (Cslib.BitString.lsbValue (List.ofFn bits)) := by + have hmem := (mem_range_letterCode_iff e b bits).mpr h + have hinv := Function.invFun_eq hmem + rw [letterCode_eq_iff] at hinv + rw [← hinv, decodeLetter_letterEquiv] + +end Read + +/-! ### The tables on numbers -/ + +section Tables + +/-- The letter number read from the table index `j` at the `m` port numbers `base, …, +base + m - 1` of the port list `P`: its bit `r` is the bit of `j` at the position of port +`base + r` in `P`. -/ +@[expose] def readNum (m : ℕ) (P : List ℕ) (j base : ℕ) : ℕ := + Cslib.BitString.lsbValue ((List.range m).map fun r => j.testBit (P.idxOf (base + r))) + +/-- The first number of the explicit edges of the block edge numbered `n` at the old vertex +numbered `v`: its source halves when `v` is the interval it leaves, and its target halves +otherwise. -/ +@[expose] def halfBase (k q m v n : ℕ) : ℕ := + if blockSrcNum k q n = v then m * n else q * (3 * k + 1) * m + m * n + +/-- The letter numbers of the block edges read at the old vertex numbered `v` from the table +index `j` and the ports `P`. -/ +@[expose] def lettersAt (k q m : ℕ) (P : List ℕ) (j v : ℕ) (n : ℕ) : ℕ := + readNum m P j (halfBase k q m v n) + +/-- Whether every block edge at the old vertex numbered `v` carries a letter number, read from +the table index `j` and the ports `P`, below `letterCount`. -/ +@[expose] def validNum (k q s b σ : ℕ) (P : List ℕ) (j v : ℕ) : Bool := + (List.range (q * (3 * k + 1))).all fun n => + !decide (blockSrcNum k q n = v ∨ edgeTargetNum k q σ n = v) || + decide (lettersAt k q (letterBits k s b) P j v n < letterCount k s b) + +variable (e : State ≃ Fin s) (b : ℕ) [DecidableEq State] (machine : MultiTapePTM k Bool State) + (input : List Bool) + +/-- **The table entry on numbers** of the vertex numbered `v` with ports `P` at the table index +`j`: for an old vertex, its tensor at the letters read from `j` when they are all valid, and zero +otherwise; for the subdivision vertex of a copy, equality of the bits on its two halves. -/ +@[expose] def tableEntryNum (q σ v : ℕ) (P : List ℕ) (j : ℕ) : ℕ := + if v < q * (3 * k + 2) then + if validNum k q s b σ P j v then + oldEntryNum e b machine input q σ (lettersAt k q (letterBits k s b) P j v) v + else 0 + else if j.testBit (P.idxOf (v - q * (3 * k + 2))) = + j.testBit (P.idxOf (q * (3 * k + 1) * letterBits k s b + (v - q * (3 * k + 2)))) then 1 + else 0 + +/-- **The table on numbers** of the vertex numbered `v`: its entries at all indices below +`2 ^ (number of ports)`. -/ +@[expose] def explicitTableNum (q σ v : ℕ) : List ℕ := + (List.range (2 ^ (explicitPortsNum k q (letterBits k s b) σ v).length)).map + (tableEntryNum e b machine input q σ v (explicitPortsNum k q (letterBits k s b) σ v)) + +/-- **The vertices of the explicit network on numbers**: the ports and the table of every vertex +number. -/ +@[expose] def explicitVerticesNum (q σ : ℕ) : List (List ℕ × List ℕ) := + (List.range (q * (3 * k + 2) + q * (3 * k + 1) * letterBits k s b)).map fun v => + (explicitPortsNum k q (letterBits k s b) σ v, explicitTableNum e b machine input q σ v) + +private theorem idxOf_map_val {n : ℕ} (l : List (Fin n)) (a : Fin n) : + (l.map Fin.val).idxOf a.val = l.idxOf a := by + induction l with + | nil => rfl + | cons x l ih => + simp only [List.map_cons, List.idxOf_cons, ih, beq_iff_eq, Fin.val_inj] + +private theorem ofFn_eq_map_range {m : ℕ} (f : ℕ → Bool) : + List.ofFn (fun r : Fin m => f r) = (List.range m).map f := by + rw [List.ofFn_eq_map, ← List.map_coe_finRange_eq_range, List.map_map] + rfl + +variable [NeZero b] + +/-- **The tables of the explicit network on numbers**: the table of every vertex of the +binarized, subdivided network, with the edges numbered by `explicitEdgeEquiv`, is +`explicitTableNum` at the number of the vertex. -/ +theorem explicitTable_eq_explicitTableNum (σ : ℕ) + (w : (Fin q ⊕ BlockEdge k q) ⊕ BlockEdge k q × Fin (letterBits k s b)) : + ((machine.blockNetwork input b (scheduleOfNat k q σ)).binarize + (letterCode e)).subdivide.explicitTable (explicitEdgeEquiv k q (letterBits k s b)) w = + explicitTableNum e b machine input q σ (explicitVertexEquiv k q (letterBits k s b) w) := by + set BN := machine.blockNetwork input b (scheduleOfNat k q σ) + set ee := explicitEdgeEquiv k q (letterBits k s b) + set ev := explicitVertexEquiv k q (letterBits k s b) + set P := explicitPortsNum k q (letterBits k s b) σ (ev w) + have hP : ((BN.binarize (letterCode e)).subdivide.explicitPorts ee w).map Fin.val = P := + map_val_explicitPorts machine input b (letterCode e) σ w + have hidx : ∀ p, ((BN.binarize (letterCode e)).subdivide.explicitPorts ee w).idxOf (ee p) = + P.idxOf (ee p : ℕ) := fun p => by rw [← hP, idxOf_map_val] + unfold TensorNetwork.explicitTable explicitTableNum + rw [show ((BN.binarize (letterCode e)).subdivide.explicitPorts ee w).length = P.length by + rw [← hP, List.length_map]] + refine List.map_congr_left fun j _ => ?_ + simp only [hidx] + rcases w with u | ⟨e₀, r⟩ + · -- An old vertex. + have hv : (ev (.inl u) : ℕ) < q * (3 * k + 2) := explicitVertexEquiv_inl k q _ u + rw [tableEntryNum, ite_eq_left hv, TensorNetwork.subdivide_tensor_inl] + simp only [TensorNetwork.binarize] + -- The bits on the copies of an edge, and their number. + have hsrc : ∀ e' : BlockEdge k q, + BN.src e' = u ↔ blockSrcNum k q (blockEdgeEquiv k q e') = ev (.inl u) := by + intro e' + rw [blockSrcNum_blockEdgeEquiv (letterBits k s b) e', blockNetwork_src, Fin.val_inj, + Equiv.apply_eq_iff_eq] + simp only [Sum.inl.injEq] + have htgt : ∀ e' : BlockEdge k q, + BN.tgt e' = u ↔ edgeTargetNum k q σ (blockEdgeEquiv k q e') = ev (.inl u) := by + intro e' + rw [edgeTargetNum_blockEdgeEquiv σ (letterBits k s b) e', blockNetwork_tgt, Fin.val_inj, + Equiv.apply_eq_iff_eq] + simp only [Sum.inl.injEq] + have hbits : ∀ e' : BlockEdge k q, + Cslib.BitString.lsbValue (List.ofFn (TensorNetwork.bitsOn (fun p => + if BN.src p.1 = u then j.testBit (P.idxOf (ee (.inl p) : ℕ)) + else j.testBit (P.idxOf (ee (.inr p) : ℕ))) e')) = + lettersAt k q (letterBits k s b) P j (ev (.inl u)) (blockEdgeEquiv k q e') := by + intro e' + simp only [lettersAt, readNum, halfBase, ← hsrc e'] + rw [← ofFn_eq_map_range] + refine congrArg (fun l => Cslib.BitString.lsbValue (List.ofFn l)) (funext fun r => ?_) + rw [TensorNetwork.bitsOn_apply] + split_ifs + · rw [val_explicitEdgeEquiv_inl, Nat.add_comm] + · rw [val_explicitEdgeEquiv_inr, Nat.add_left_comm, Nat.add_comm (r : ℕ)] + have hinc : ∀ e' : BlockEdge k q, (BN.src e' = u ∨ BN.tgt e' = u) ↔ + (blockSrcNum k q (blockEdgeEquiv k q e') = ev (.inl u) ∨ + edgeTargetNum k q σ (blockEdgeEquiv k q e') = ev (.inl u)) := fun e' => by + rw [hsrc, htgt] + have hall : validNum k q s b σ P j (ev (.inl u)) = true ↔ ∀ e' : BlockEdge k q, + (BN.src e' = u ∨ BN.tgt e' = u) → + lettersAt k q (letterBits k s b) P j (ev (.inl u)) (blockEdgeEquiv k q e') < + letterCount k s b := by + rw [validNum, List.all_eq_true] + simp only [List.mem_range, Bool.or_eq_true, Bool.not_eq_true', decide_eq_false_iff_not, + decide_eq_true_eq] + constructor + · intro h e' he' + exact (h _ (blockEdgeEquiv k q e').isLt).resolve_left (not_not.mpr ((hinc e').mp he')) + · intro h n hn + obtain ⟨e', rfl⟩ : ∃ e', (blockEdgeEquiv k q e' : ℕ) = n := + ⟨(blockEdgeEquiv k q).symm ⟨n, hn⟩, by simp⟩ + by_cases he' : BN.src e' = u ∨ BN.tgt e' = u + · exact Or.inr (h e' he') + · exact Or.inl (fun h' => he' ((hinc e').mpr h')) + split_ifs with h1 h2 h2 + · rw [← blockNetwork_tensor_decodeLetter] + refine BN.tensor_congr _ _ _ fun e' he' => ?_ + have hlt := (mem_range_letterCode_iff e b _).mp (h1 e' he') + rw [invFun_letterCode e b hlt] + exact congrArg (decodeLetter e b) (hbits e') + · exact absurd (hall.mpr fun e' he' => + (hbits e').symm.trans_lt ((mem_range_letterCode_iff e b _).mp (h1 e' he'))) h2 + · exact absurd (fun e' he' => (mem_range_letterCode_iff e b _).mpr + ((hbits e').trans_lt (hall.mp h2 e' he'))) h1 + · rfl + · -- A subdivision vertex. + have hv : q * (3 * k + 2) ≤ (ev (.inr (e₀, r)) : ℕ) := le_explicitVertexEquiv_inr k q _ _ + have hc : (ev (.inr (e₀, r)) : ℕ) - q * (3 * k + 2) = + r + letterBits k s b * blockEdgeEquiv k q e₀ := by + rw [val_explicitVertexEquiv_inr] + omega + rw [tableEntryNum, ite_eq_right (by omega), TensorNetwork.subdivide_tensor_inr, hc, + val_explicitEdgeEquiv_inl, val_explicitEdgeEquiv_inr] + +/-- **The explicit block-counting network on numbers**: `2 q (3 k + 1) m` edges and the vertices +`explicitVerticesNum`. -/ +@[expose] def explicitNetworkNum (q σ : ℕ) : ExplicitTensorNetwork ℕ where + numEdges := 2 * (q * (3 * k + 1) * letterBits k s b) + vertices := explicitVerticesNum e b machine input q σ + +/-- **The explicit block-counting network is computed on numbers**: for the schedule of `σ`, +`explicitBlockNetwork` is `explicitNetworkNum`. -/ +theorem explicitBlockNetwork_eq_explicitNetworkNum (σ : ℕ) : + machine.explicitBlockNetwork input b (scheduleOfNat k q σ) e = + explicitNetworkNum e b machine input q σ := by + have hv : (machine.explicitBlockNetwork input b (scheduleOfNat k q σ) e).vertices = + explicitVerticesNum e b machine input q σ := by + rw [explicitBlockNetwork, TensorNetwork.toExplicit, explicitVerticesNum, + ← List.map_coe_finRange_eq_range, List.map_map, List.ofFn_eq_map] + refine List.map_congr_left fun v _ => ?_ + simp only [Function.comp_apply] + rw [map_val_explicitPorts, explicitTable_eq_explicitTableNum, Equiv.apply_symm_apply] + cases h : machine.explicitBlockNetwork input b (scheduleOfNat k q σ) e with + | mk n vs => + rw [h] at hv + have hn := numEdges_explicitBlockNetwork machine input b (scheduleOfNat k q σ) e + rw [h] at hn + simp only at hv hn + rw [explicitNetworkNum, hv, hn] + +end Tables + +/-! ### Port counts -/ + +section PortCounts + +/-- Every explicit edge starts at an old vertex. -/ +theorem explicitSrcNum_lt {m σ j : ℕ} (hj : j < 2 * (q * (3 * k + 1) * m)) : + explicitSrcNum k q m σ j < q * (3 * k + 2) := by + have hm : 0 < m := by + rcases Nat.eq_zero_or_pos m with rfl | hm + · simp at hj + · exact hm + unfold explicitSrcNum + split_ifs with hlt + · have hn : j / m < q * (3 * k + 1) := (Nat.div_lt_iff_lt_mul hm).mpr hlt + unfold blockSrcNum + split_ifs with hq + · nlinarith + · rcases Nat.eq_zero_or_pos k with rfl | hk + · omega + · have : (j / m - q) / (k * 3) < q := by + rw [Nat.div_lt_iff_lt_mul (by omega)] + have : q * (3 * k + 1) = q + q * (k * 3) := by ring + omega + nlinarith + · have hn : (j - q * (3 * k + 1) * m) / m < q * (3 * k + 1) := + (Nat.div_lt_iff_lt_mul hm).mpr (by omega) + set n := (j - q * (3 * k + 1) * m) / m + unfold edgeTargetNum + split_ifs with h1 h2 + · nlinarith + · nlinarith + · cases hf : firstAfterNum k q σ ((n - q) % (k * 3) / 3 + 1) ((n - q) / (k * 3)) ((n - q) % 3) + with + | none => simp only [Option.getD_none]; nlinarith + | some i' => + have hmem := List.mem_of_find?_eq_some hf + rw [List.mem_range] at hmem + simp only [Option.getD_some] + nlinarith + +/-- Every explicit edge ends at a vertex. -/ +theorem explicitTgtNum_lt {m j : ℕ} (hj : j < 2 * (q * (3 * k + 1) * m)) : + explicitTgtNum k q m j < q * (3 * k + 2) + q * (3 * k + 1) * m := by + unfold explicitTgtNum + split_ifs <;> omega + +/-- A number past the vertices has no ports. -/ +theorem explicitPortsNum_eq_nil {m σ v : ℕ} + (hv : q * (3 * k + 2) + q * (3 * k + 1) * m ≤ v) : explicitPortsNum k q m σ v = [] := by + rw [explicitPortsNum, List.filter_eq_nil_iff] + intro j hj + rw [List.mem_range] at hj + have h1 := explicitSrcNum_lt (σ := σ) hj + have h2 := explicitTgtNum_lt hj + simp only [decide_eq_true_eq, not_or] + omega + +/-- **The degree bound on numbers**: every vertex number has at most +`2 (3 k + 1) (letterBits k s b)` ports. -/ +theorem length_explicitPortsNum_le {State : Type} (machine : MultiTapePTM k Bool State) + (b : ℕ) [NeZero b] (e : State ≃ Fin s) (σ v : ℕ) : + (explicitPortsNum k q (letterBits k s b) σ v).length ≤ 2 * (3 * k + 1) * letterBits k s b := by + by_cases hv : v < q * (3 * k + 2) + q * (3 * k + 1) * letterBits k s b + · have hmem : explicitPortsNum k q (letterBits k s b) σ v ∈ + (machine.explicitBlockNetwork [] b (scheduleOfNat k q σ) e).vertices.map Prod.fst := by + rw [map_fst_vertices_explicitBlockNetwork] + exact List.mem_map_of_mem (List.mem_range.mpr hv) + obtain ⟨p, hp, hpv⟩ := List.mem_map.mp hmem + rw [← hpv] + exact ((machine.explicitBlockNetwork [] b (scheduleOfNat k q σ) e).length_le_maxDegree hp).trans + (maxDegree_explicitBlockNetwork_le ..) + · rw [explicitPortsNum_eq_nil (not_lt.mp hv)] + exact Nat.zero_le _ + +end PortCounts + +end Turing.MultiTapePTM diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/TablePolyTime.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/TablePolyTime.lean new file mode 100644 index 0000000000..cb04f090b9 --- /dev/null +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/ExplicitBlockNetwork/TablePolyTime.lean @@ -0,0 +1,474 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +-- upstream: candidate + +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork.Table +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork.GraphPolyTime +public import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.IntervalCount.PolyTime +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.BitString +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.Int.Binary +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.List +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.Nat +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.Nat.Binary +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.Nat.Div +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.Nat.Fin +import Complexity.Computability.Machines.Turing.MultiTape.Complexity.PolyTime.Plain +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeBinaryDivision +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeBinaryPrimitives +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeBinaryPower +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeListLookup +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeListMap +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeListPrimitives +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeLoops +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeNatFrontends +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimeOptionPrimitives +import Complexity.Computability.Machines.Turing.MultiTape.Internal.PolyTimePiPrimitives + +/-! +# The tables of an explicit block-counting network in polynomial time + +The explicit block-counting network on numbers (`Turing.MultiTapePTM.explicitNetworkNum`) is +computable in polynomial time from the input, the block length and the number of intervals in +unary, and the schedule number in binary, provided that `2 ^ b` is bounded by a computed unary +number. Its tables have `2 ^ (number of ports)` entries, at most `(2 ^ b) ^ (2 (3 k + 1) (s + k + +4))`, and each entry decodes letters by arithmetic and evaluates an interval count +(`Turing.MultiTapePTM.computableInPolyTime_localIntervalCount`). + +## Main results + +* `Turing.MultiTapePTM.computableInPolyTime_decodeControlData`, + `Turing.MultiTapePTM.computableInPolyTime_contentsCellNum`: decoding letters. +* `Turing.MultiTapePTM.computableInPolyTime_intervalEntryNum`: the tensor of an interval on + numbers. +* `Turing.MultiTapePTM.computableInPolyTime_explicitNetworkNum`: the explicit network on numbers, + as its number of edges in unary and its vertices, with ports and table entries in binary. +-/ + +public section + +namespace Turing.MultiTapePTM + +open MultiTapeTM ComputableInPolyTime MultiTapeNTM.ChoiceTable + +variable {k s : ℕ} {State : Type} {α : Type} {inp : α ↪ List Bool} + +/-! ### Small numbers and digits -/ + +/-- A binary number reduced modulo `3`, as an element of `Fin 3`. -/ +private theorem fin3 {v : α → ℕ} (hv : ComputableInPolyTime v inp encNat) : + ComputableInPolyTime (fun a => (⟨v a % 3, Nat.mod_lt _ (by norm_num)⟩ : Fin 3)) inp + (encFinite (Fin 3)) := by + have hu : ComputableInPolyTime (fun a => v a % 3) inp encUnary := + binary_to_unary_bounded (binary_mod.comp (hv.prod (const 3))) (const 2) fun a => by omega + have h := (unary_finMod (by norm_num : 0 < 3) (encFinite (Fin 3))).comp hu + simpa only [Function.comp_def, Nat.mod_mod] using h + +/-- The number of control records, in binary. -/ +private theorem controlCount' {b : α → ℕ} (hb : ComputableInPolyTime b inp encUnary) : + ComputableInPolyTime (fun a => controlCount k s (b a)) inp encNat := by + unfold controlCount + exact binary_mul' (const _) (binary_mul' (binary_pow' (unary_to_binary.comp hb) (const _)) + (const 3)) + +/-- The number of letters, in binary. -/ +private theorem letterCount' {b : α → ℕ} (hb : ComputableInPolyTime b inp encUnary) : + ComputableInPolyTime (fun a => letterCount k s (b a)) inp encNat := by + unfold letterCount + exact binary_add.comp ((controlCount' hb).prod (binary_pow' (const 3) hb)) + +/-! ### Decoding letters -/ + +/-- **Cells of block contents are polynomial-time.** -/ +theorem computableInPolyTime_contentsCellNum {b n r : α → ℕ} + (hb : ComputableInPolyTime b inp encUnary) (hn : ComputableInPolyTime n inp encNat) + (hr : ComputableInPolyTime r inp encUnary) : + ComputableInPolyTime (fun a => contentsCellNum k s (b a) (n a) (r a)) inp + (encOption encBool) := by + have hC := controlCount' (k := k) (s := s) hb + unfold contentsCellNum + refine ite_decide (binary_lt' hn hC) (const none) ?_ + exact (of_finite (encIn := encFinite (Fin 3)) (encOut := encOption encBool) + cellEquiv.symm).comp (fin3 (binary_div.comp ((binary_sub' hn hC).prod + (binary_pow' (const 3) hr)))) + +variable [Finite State] + +/-- **Control records of numbers are polynomial-time**, on plain data. -/ +theorem computableInPolyTime_decodeControlData (e : State ≃ Fin s) {b n : α → ℕ} + (hb : ComputableInPolyTime b inp encUnary) (hb0 : ∀ a, 0 < b a) + (hn : ComputableInPolyTime n inp encNat) : + ComputableInPolyTime (fun a => decodeControlData (k := k) e (b a) (n a)) inp + encControlData := by + have hbB : ComputableInPolyTime b inp encNat := unary_to_binary.comp hb + have hD : ComputableInPolyTime (fun a => b a ^ (k + 1) * 3) inp encNat := + binary_mul' (binary_pow' hbB (const _)) (const 3) + have hrem : ComputableInPolyTime (fun a => n a % (b a ^ (k + 1) * 3)) inp encNat := + binary_mod.comp (hn.prod hD) + have hstate : ComputableInPolyTime (fun a => stateOfFin e + ⟨min s (n a / (b a ^ (k + 1) * 3)) % (s + 1), Nat.mod_lt _ (by omega)⟩) inp + (encFinite (Option State)) := + (of_finite (encIn := encFinite (Fin (s + 1))) (encOut := encFinite (Option State)) + (stateOfFin e)).comp ((unary_finMod (Nat.succ_pos s) (encFinite (Fin (s + 1)))).comp + (binary_min_unary' (const s) (binary_div.comp (hn.prod hD)))) + have hoff : ComputableInPolyTime (fun a (head : Option (Fin k)) => + n a % (b a ^ (k + 1) * 3) / 3 / b a ^ ((finSuccEquiv k).symm head : ℕ) % b a) inp + (encPi encUnary) := by + refine pi fun head => binary_to_unary_bounded ?_ hb fun a => (Nat.mod_lt _ (hb0 a)).le + exact binary_mod.comp ((binary_div.comp ((binary_div.comp (hrem.prod (const 3))).prod + (binary_pow' hbB (const _)))).prod hbB) + have htrack : ComputableInPolyTime (fun a => OutputTrack.equivFin.symm + ⟨n a % (b a ^ (k + 1) * 3) % 3, Nat.mod_lt _ (by norm_num)⟩) inp + (encFinite OutputTrack) := + (of_finite (encIn := encFinite (Fin 3)) (encOut := encFinite OutputTrack) + OutputTrack.equivFin.symm).comp (fin3 hrem) + exact ControlData.computableInPolyTime_mk hstate hoff htrack + +/-- Entering control records from letter numbers are polynomial-time. -/ +theorem computableInPolyTime_controlDataOfNum (e : State ≃ Fin s) {b n : α → ℕ} + (hb : ComputableInPolyTime b inp encUnary) (hb0 : ∀ a, 0 < b a) + (hn : ComputableInPolyTime n inp encNat) : + ComputableInPolyTime (fun a => controlDataOfNum (k := k) e (b a) (n a)) inp + encControlData := by + unfold controlDataOfNum + exact ite_decide (binary_lt' hn (controlCount' hb)) + (computableInPolyTime_decodeControlData e hb hb0 hn) (const _) + +/-! ### Block indices, movements and the entering window -/ + +/-- Block indices as digit counts are polynomial-time. -/ +theorem computableInPolyTime_blockIndexNum {σ i : α → ℕ} + (hσ : ComputableInPolyTime σ inp encNat) (hi : ComputableInPolyTime i inp encUnary) : + ComputableInPolyTime (fun a => blockIndexNum k (σ a) (i a)) inp (encPi encIntBin) := by + refine pi fun head => ?_ + have hcount := fun δ => computableInPolyTime_digitCount (k := k) hσ + (const ((finSuccEquiv k).symm head : ℕ)) (const δ) hi + exact intBin_sub.comp ((intBin_natCast.comp (unary_to_binary.comp (hcount 2))).prod + (intBin_natCast.comp (unary_to_binary.comp (hcount 0)))) + +/-- Block movements of a schedule number are polynomial-time. -/ +theorem computableInPolyTime_blockMoveNum {σ i : α → ℕ} + (hσ : ComputableInPolyTime σ inp encNat) (hi : ComputableInPolyTime i inp encUnary) : + ComputableInPolyTime (fun a => blockMoveNum k (σ a) (i a)) inp + (encFinite (Option (Fin k) → SignType)) := by + have hpi : ComputableInPolyTime (fun a => blockMoveNum k (σ a) (i a)) inp + (encPi (encFinite SignType)) := by + refine pi fun head => ?_ + have hpos : ComputableInPolyTime (fun a => ((finSuccEquiv k).symm head : ℕ) + (k + 1) * i a) + inp encUnary := unary_add' (const _) (unary_mul' (const _) hi) + exact (of_finite (encIn := encFinite (Fin 3)) (encOut := encFinite SignType) + signEquiv.symm).comp (fin3 (binary_div.comp (hσ.prod (binary_pow' (const 3) hpos)))) + exact (of_finite (encIn := encPi (encFinite SignType)) + (encOut := encFinite (Option (Fin k) → SignType)) id).comp hpi + +/-- Previous appearances on numbers are polynomial-time. -/ +theorem computableInPolyTime_lastBeforeNum {σ c i δ : α → ℕ} + (hσ : ComputableInPolyTime σ inp encNat) (hc : ComputableInPolyTime c inp encUnary) + (hi : ComputableInPolyTime i inp encUnary) (hδ : ComputableInPolyTime δ inp encUnary) : + ComputableInPolyTime (fun a => lastBeforeNum k (σ a) (c a) (i a) (δ a)) inp + (encOption encUnary) := by + have heq : ∀ a, lastBeforeNum k (σ a) (c a) (i a) (δ a) = + ((List.range (i a)).find? fun j => inWindowNum k (σ a) (c a) (i a) (δ a) (i a - 1 - j)).elim + none fun j => some (i a - 1 - j) := fun a => by + unfold lastBeforeNum + cases (List.range (i a)).find? _ <;> rfl + simp only [heq] + have hi1 : ComputableInPolyTime (fun p : α × ℕ => i p.1 - 1 - p.2) (encPair inp encUnary) + encUnary := unary_sub' (unary_sub' (hi.comp (fst _ _)) (const 1)) (snd _ _) + refine optionElimWithInput (findWithInput (range.comp hi) ?_) (const none) + ((optionSome encUnary).comp hi1) + exact computableInPolyTime_inWindowNum (hσ.comp (fst _ _)) (hc.comp (fst _ _)) + (hi.comp (fst _ _)) (hδ.comp (fst _ _)) hi1 + +/-- Window entries on numbers are polynomial-time. -/ +theorem computableInPolyTime_portOfNum {σ c i i' δ : α → ℕ} + (hσ : ComputableInPolyTime σ inp encNat) (hc : ComputableInPolyTime c inp encUnary) + (hi : ComputableInPolyTime i inp encUnary) (hi' : ComputableInPolyTime i' inp encUnary) + (hδ : ComputableInPolyTime δ inp encUnary) : + ComputableInPolyTime (fun a => portOfNum k (σ a) (c a) (i a) (i' a) (δ a)) inp encUnary := by + have hcount := fun {j : α → ℕ} (hj : ComputableInPolyTime j inp encUnary) (d : ℕ) => + computableInPolyTime_digitCount (k := k) hσ hc (const d) hj + unfold portOfNum + exact unary_mod.comp ((unary_sub' (unary_add' (unary_add' (hcount hi 2) (hcount hi' 0)) hδ) + (unary_add' (hcount hi 0) (hcount hi' 2))).prod (const 3)) + +/-! ### The tensor of an interval -/ + +/-- A computed unary bound on `2 ^ b` gives the budget of the interval counts. -/ +private theorem budget_of_cap {b cap : α → ℕ} (hcap : ComputableInPolyTime cap inp encUnary) + (h2b : ∀ a, 2 ^ b a ≤ cap a) : + ∃ size : ℕ → ℕ, Cslib.PolynomiallyBounded size ∧ + ∀ a, 2 ^ b a * (2 * b a + 1) ≤ size (inp a).length := by + obtain ⟨bound, hbound, hle⟩ := polyBounded hcap + refine ⟨fun n => bound n * (2 * bound n + 1), by fun_prop, fun a => ?_⟩ + have h1 : 2 ^ b a ≤ bound (inp a).length := (h2b a).trans (hle a) + have h2 : b a < 2 ^ b a := Nat.lt_two_pow_self + exact Nat.mul_le_mul h1 (by omega) + +/-- A letter number at a computed edge number. -/ +private theorem letter_comp {β : Type} {encβ : β ↪ List Bool} {L : α → ℕ → ℕ} + (hL : ComputableInPolyTime (fun p : α × ℕ => L p.1 p.2) (encPair inp encUnary) encNat) + {g : β → α} {n : β → ℕ} (hg : ComputableInPolyTime g encβ inp) + (hn : ComputableInPolyTime n encβ encUnary) : + ComputableInPolyTime (fun c => L (g c) (n c)) encβ encNat := + hL.comp (hg.prod hn) + +section Interval + +variable [DecidableEq State] (e : State ≃ Fin s) (machine : MultiTapePTM k Bool State) + {x : α → List Bool} {b q σ cap : α → ℕ} {L : α → ℕ → ℕ} + +/-- The cells of a window entering an interval are polynomial-time. -/ +theorem computableInPolyTime_inCellsNum (h : ℕ) {i : α → ℕ} + (hb : ComputableInPolyTime b inp encUnary) (hq : ComputableInPolyTime q inp encUnary) + (hσ : ComputableInPolyTime σ inp encNat) + (hL : ComputableInPolyTime (fun p : α × ℕ => L p.1 p.2) (encPair inp encUnary) encNat) + (hi : ComputableInPolyTime i inp encUnary) : + ComputableInPolyTime (fun a => inCellsNum k (q a) s (b a) (σ a) (L a) (i a) h) inp + (encList (encOption encBool)) := by + unfold inCellsNum + have hcb : ComputableInPolyTime (fun p : α × ℕ => p.2 / b p.1) (encPair inp encUnary) + encUnary := unary_div.comp ((snd _ _).prod (hb.comp (fst _ _))) + refine mapWithInput (range.comp (unary_mul' (const 3) hb)) + (optionElimWithInput (computableInPolyTime_lastBeforeNum (hσ.comp (fst _ _)) (const _) + (hi.comp (fst _ _)) hcb) (const none) ?_) + have ha : ComputableInPolyTime (fun r : (α × ℕ) × ℕ => r.1.1) + (encPair (encPair inp encUnary) encUnary) inp := (fst _ _).comp (fst _ _) + have hc : ComputableInPolyTime (fun r : (α × ℕ) × ℕ => r.1.2) + (encPair (encPair inp encUnary) encUnary) encUnary := (snd _ _).comp (fst _ _) + have hi' : ComputableInPolyTime (fun r : (α × ℕ) × ℕ => r.2) + (encPair (encPair inp encUnary) encUnary) encUnary := snd _ _ + refine computableInPolyTime_contentsCellNum (hb.comp ha) (letter_comp hL ha ?_) + (unary_mod.comp (hc.prod (hb.comp ha))) + exact unary_add' (hq.comp ha) (unary_add' (unary_add' (computableInPolyTime_portOfNum + (hσ.comp ha) (const _) (hi.comp ha) hi' (unary_div.comp (hc.prod (hb.comp ha)))) (const _)) + (unary_mul' (const _) hi')) + +/-- The cells of a window leaving an interval are polynomial-time. -/ +theorem computableInPolyTime_outCellsNum (h : ℕ) {i : α → ℕ} + (hb : ComputableInPolyTime b inp encUnary) (hq : ComputableInPolyTime q inp encUnary) + (hL : ComputableInPolyTime (fun p : α × ℕ => L p.1 p.2) (encPair inp encUnary) encNat) + (hi : ComputableInPolyTime i inp encUnary) : + ComputableInPolyTime (fun a => outCellsNum k (q a) s (b a) (L a) (i a) h) inp + (encList (encOption encBool)) := by + unfold outCellsNum + have ha : ComputableInPolyTime (fun p : α × ℕ => p.1) (encPair inp encUnary) inp := fst _ _ + have hc : ComputableInPolyTime (fun p : α × ℕ => p.2) (encPair inp encUnary) encUnary := + snd _ _ + refine mapWithInput (range.comp (unary_mul' (const 3) hb)) + (computableInPolyTime_contentsCellNum (hb.comp ha) (letter_comp hL ha ?_) + (unary_mod.comp (hc.prod (hb.comp ha)))) + exact unary_add' (hq.comp ha) (unary_add' (unary_add' (unary_div.comp (hc.prod (hb.comp ha))) + (const _)) (unary_mul' (const _) (hi.comp ha))) + +/-- **The tensor of an interval on numbers is polynomial-time**, from the letter numbers of the +edges, when `2 ^ b` is bounded by a computed unary number. -/ +theorem computableInPolyTime_intervalEntryNum {i : α → ℕ} + (hx : ComputableInPolyTime x inp encBits) (hb : ComputableInPolyTime b inp encUnary) + (hb0 : ∀ a, 0 < b a) (hq : ComputableInPolyTime q inp encUnary) + (hσ : ComputableInPolyTime σ inp encNat) (hcap : ComputableInPolyTime cap inp encUnary) + (h2b : ∀ a, 2 ^ b a ≤ cap a) + (hL : ComputableInPolyTime (fun p : α × ℕ => L p.1 p.2) (encPair inp encUnary) encNat) + (hi : ComputableInPolyTime i inp encUnary) : + ComputableInPolyTime (fun a => intervalEntryNum e (b a) machine (x a) (q a) (σ a) (L a) (i a)) + inp encUnary := by + obtain ⟨size, hsize, hbudget⟩ := budget_of_cap hcap h2b + have hC := controlCount' (k := k) (s := s) hb + have hLat : ∀ {n : α → ℕ}, ComputableInPolyTime n inp encUnary → + ComputableInPolyTime (fun a => L a (n a)) inp encNat := fun hn => letter_comp hL id' hn + have hcond : ∀ a, decide (L a (i a) < controlCount k s (b a) ∧ ∀ h : Fin k, ∀ δ : Fin 3, + ¬ L a (q a + (δ + 3 * h + k * 3 * i a)) < controlCount k s (b a)) = + (decide (L a (i a) < controlCount k s (b a)) && (List.finRange k).all fun h => + (List.finRange 3).all fun δ => + !decide (L a (q a + (δ + 3 * h + k * 3 * i a)) < controlCount k s (b a))) := by + intro a + rw [Bool.eq_iff_iff] + simp [List.all_eq_true] + have hcIn : ComputableInPolyTime + (fun a => (inControlNum e (b a) machine.initial (L a) (i a) : ControlData k State)) inp + encControlData := by + unfold inControlNum + exact ite_decide (decide_eq' hi (const 0)) (const _) + (computableInPolyTime_controlDataOfNum e hb hb0 (hLat (unary_sub' hi (const 1)))) + unfold intervalEntryNum + refine ite_decide ?_ ?_ (const 0) + · simp only [hcond] + refine bool_and' (binary_lt' (hLat hi) hC) (allConst _ fun h _ => allConst _ fun δ _ => ?_) + exact bool_not.comp (binary_lt' (hLat (unary_add' hq (unary_add' (const _) + (unary_mul' (const _) hi)))) hC) + · have hd := IntervalData.computableInPolyTime_mk hx hb + (computableInPolyTime_blockIndexNum hσ hi) (computableInPolyTime_blockMoveNum hσ hi) hcIn + (pi fun h : Fin k => computableInPolyTime_inCellsNum (k := k) (s := s) h.val hb hq hσ hL hi) + (computableInPolyTime_decodeControlData e hb hb0 (hLat hi)) + (pi fun h : Fin k => computableInPolyTime_outCellsNum (k := k) (s := s) h.val hb hq hL hi) + have hcount := computableInPolyTime_localIntervalCount machine hd hsize hbudget + simpa only [IntervalData.count] using hcount + +end Interval + +/-! ### Reading letters and the tables -/ + +private theorem lsbValue_eq_ofBits : ∀ w : List Bool, Cslib.BitString.lsbValue w = ofBits w + | [] => rfl + | c :: w => by + rw [Cslib.BitString.lsbValue, lsbValue_eq_ofBits w] + simp only [ofBits, List.foldr_cons, Nat.bit_val] + ring + +/-- **Letter numbers read from table indices are polynomial-time.** -/ +theorem computableInPolyTime_readNum {m j base : α → ℕ} {P : α → List ℕ} + (hm : ComputableInPolyTime m inp encUnary) (hP : ComputableInPolyTime P inp (encList encNat)) + (hj : ComputableInPolyTime j inp encUnary) (hbase : ComputableInPolyTime base inp encUnary) : + ComputableInPolyTime (fun a => readNum (m a) (P a) (j a) (base a)) inp encNat := by + have hlist : ComputableInPolyTime + (fun a => (List.range (m a)).map fun r => (j a).testBit ((P a).idxOf (base a + r))) inp + (encList encBool) := + mapWithInput (range.comp hm) (unary_testBit' (hj.comp (fst _ _)) + (idxOfWithInput (hP.comp (fst _ _)) + (unary_to_binary.comp (unary_add' (hbase.comp (fst _ _)) (snd _ _))))) + have hbits := (bits_encList_polyTime encBool).2.comp hlist + have hnum := (ComputableInPolyTime.of_tidy ComputableTidilyInPolyTime.bitsToNat).comp hbits + simpa only [readNum, lsbValue_eq_ofBits, Function.comp_def] using hnum + +private theorem blockSrcNum' {q n : α → ℕ} (hq : ComputableInPolyTime q inp encUnary) + (hn : ComputableInPolyTime n inp encUnary) : + ComputableInPolyTime (fun a => blockSrcNum k (q a) (n a)) inp encUnary := by + unfold blockSrcNum + exact ite_decide (unary_lt' hn hq) hn (unary_div.comp ((unary_sub' hn hq).prod (const _))) + +/-- The letter numbers read at an old vertex are polynomial-time, at a computed edge number. -/ +theorem computableInPolyTime_lettersAt {q m v j : α → ℕ} {P : α → List ℕ} + (hq : ComputableInPolyTime q inp encUnary) (hm : ComputableInPolyTime m inp encUnary) + (hP : ComputableInPolyTime P inp (encList encNat)) (hj : ComputableInPolyTime j inp encUnary) + (hv : ComputableInPolyTime v inp encUnary) : + ComputableInPolyTime (fun p : α × ℕ => lettersAt k (q p.1) (m p.1) (P p.1) (j p.1) (v p.1) p.2) + (encPair inp encUnary) encNat := by + have ha : ComputableInPolyTime (fun p : α × ℕ => p.1) (encPair inp encUnary) inp := fst _ _ + have hn : ComputableInPolyTime (fun p : α × ℕ => p.2) (encPair inp encUnary) encUnary := + snd _ _ + unfold lettersAt halfBase + refine computableInPolyTime_readNum (hm.comp ha) (hP.comp ha) (hj.comp ha) + (ite_decide (decide_eq' (blockSrcNum' (hq.comp ha) hn) (hv.comp ha)) + (unary_mul' (hm.comp ha) hn) ?_) + exact unary_add' (unary_mul' (unary_mul' (hq.comp ha) (const _)) (hm.comp ha)) + (unary_mul' (hm.comp ha) hn) + +section Tables + +variable [DecidableEq State] (e : State ≃ Fin s) (machine : MultiTapePTM k Bool State) + {x : α → List Bool} {b q σ cap : α → ℕ} + +/-- **Table entries on numbers are polynomial-time.** -/ +theorem computableInPolyTime_tableEntryNum {v j : α → ℕ} {P : α → List ℕ} + (hx : ComputableInPolyTime x inp encBits) (hb : ComputableInPolyTime b inp encUnary) + (hb0 : ∀ a, 0 < b a) (hq : ComputableInPolyTime q inp encUnary) + (hσ : ComputableInPolyTime σ inp encNat) (hcap : ComputableInPolyTime cap inp encUnary) + (h2b : ∀ a, 2 ^ b a ≤ cap a) (hv : ComputableInPolyTime v inp encUnary) + (hP : ComputableInPolyTime P inp (encList encNat)) (hj : ComputableInPolyTime j inp encUnary) : + ComputableInPolyTime + (fun a => tableEntryNum e (b a) machine (x a) (q a) (σ a) (v a) (P a) (j a)) inp encNat := by + have hm : ComputableInPolyTime (fun a => letterBits k s (b a)) inp encUnary := by + unfold letterBits + exact unary_mul' (const _) hb + have hL := computableInPolyTime_lettersAt (k := k) hq hm hP hj hv + have hR : ComputableInPolyTime (fun a => q a * (3 * k + 2)) inp encUnary := + unary_mul' hq (const _) + have hE : ComputableInPolyTime (fun a => q a * (3 * k + 1)) inp encUnary := + unary_mul' hq (const _) + have hC := controlCount' (k := k) (s := s) hb + have hD : ComputableInPolyTime (fun a => b a ^ (k + 1) * 3) inp encNat := + binary_mul' (binary_pow' (unary_to_binary.comp hb) (const _)) (const 3) + -- Validity of the letters at an old vertex. + have hvalid : ComputableInPolyTime (fun a => validNum k (q a) s (b a) (σ a) (P a) (j a) (v a)) + inp encBool := by + unfold validNum + have ha : ComputableInPolyTime (fun p : α × ℕ => p.1) (encPair inp encUnary) inp := fst _ _ + have hn : ComputableInPolyTime (fun p : α × ℕ => p.2) (encPair inp encUnary) encUnary := + snd _ _ + refine allWithInput (range.comp hE) (bool_or.comp ((bool_not.comp ?_).prod ?_)) + · exact decide_or (decide_eq' (blockSrcNum' (hq.comp ha) hn) (hv.comp ha)) + (decide_eq' (computableInPolyTime_edgeTargetNum (hq.comp ha) (hσ.comp ha) hn) (hv.comp ha)) + · exact binary_lt' hL ((letterCount' hb).comp ha) + -- The tensor of an old vertex. + have hold : ComputableInPolyTime (fun a => oldEntryNum e (b a) machine (x a) (q a) (σ a) + (lettersAt k (q a) (letterBits k s (b a)) (P a) (j a) (v a)) (v a)) inp encNat := by + unfold oldEntryNum + refine ite_decide (unary_lt' hv hq) (unary_to_binary.comp + (computableInPolyTime_intervalEntryNum e machine hx hb hb0 hq hσ hcap h2b hL hv)) + (ite_decide (decide_eq' (unary_add' (unary_sub' hv hq) (const 1)) hq) ?_ (const 1)) + unfold acceptNum + have hn := letter_comp + (L := fun a => lettersAt k (q a) (letterBits k s (b a)) (P a) (j a) (v a)) hL id' + (unary_sub' hv hq) + exact ite_decide (decide_and (binary_lt' hn hC) (decide_eq' (binary_mod.comp + ((binary_mod.comp (hn.prod hD)).prod (const 3))) (const 1))) (const 1) (const 0) + unfold tableEntryNum + refine ite_decide (unary_lt' hv hR) (ite hvalid hold (const 0)) ?_ + have hc : ComputableInPolyTime (fun a => v a - q a * (3 * k + 2)) inp encUnary := + unary_sub' hv hR + refine ite_decide (decide_eq' (unary_testBit' hj (idxOfWithInput hP (unary_to_binary.comp hc))) + (unary_testBit' hj (idxOfWithInput hP (unary_to_binary.comp (unary_add' + (unary_mul' hE hm) hc))))) (const 1) (const 0) + +/-- **Tables on numbers are polynomial-time.** -/ +theorem computableInPolyTime_explicitTableNum {v : α → ℕ} + (hx : ComputableInPolyTime x inp encBits) (hb : ComputableInPolyTime b inp encUnary) + (hb0 : ∀ a, 0 < b a) (hq : ComputableInPolyTime q inp encUnary) + (hσ : ComputableInPolyTime σ inp encNat) (hcap : ComputableInPolyTime cap inp encUnary) + (h2b : ∀ a, 2 ^ b a ≤ cap a) (hv : ComputableInPolyTime v inp encUnary) : + ComputableInPolyTime (fun a => explicitTableNum e (b a) machine (x a) (q a) (σ a) (v a)) inp + (encList encNat) := by + have hm : ComputableInPolyTime (fun a => letterBits k s (b a)) inp encUnary := by + unfold letterBits + exact unary_mul' (const _) hb + have hP := computableInPolyTime_explicitPortsNum (k := k) hq hm hσ hv + have hlen : ComputableInPolyTime + (fun a => 2 ^ (explicitPortsNum k (q a) (letterBits k s (b a)) (σ a) (v a)).length) inp + encUnary := by + refine binary_to_unary_bounded (binary_two_pow.comp ((length_list encNat).comp hP)) + ((unary_pow (2 * (3 * k + 1) * (s + k + 4))).comp hcap) fun a => ?_ + have : NeZero (b a) := ⟨(hb0 a).ne'⟩ + have hdeg := length_explicitPortsNum_le (q := q a) machine (b a) e (σ a) (v a) + calc 2 ^ (explicitPortsNum k (q a) (letterBits k s (b a)) (σ a) (v a)).length + ≤ 2 ^ (b a * (2 * (3 * k + 1) * (s + k + 4))) := by + refine Nat.pow_le_pow_right two_pos (hdeg.trans (le_of_eq ?_)) + unfold letterBits + ring + _ = (2 ^ b a) ^ (2 * (3 * k + 1) * (s + k + 4)) := pow_mul _ _ _ + _ ≤ cap a ^ (2 * (3 * k + 1) * (s + k + 4)) := Nat.pow_le_pow_left (h2b a) _ + unfold explicitTableNum + have ha : ComputableInPolyTime (fun p : α × ℕ => p.1) (encPair inp encUnary) inp := fst _ _ + exact mapWithInput (range.comp hlen) (computableInPolyTime_tableEntryNum e machine + (hx.comp ha) (hb.comp ha) (fun p => hb0 p.1) (hq.comp ha) (hσ.comp ha) (hcap.comp ha) + (fun p => h2b p.1) (hv.comp ha) (hP.comp ha) (snd _ _)) + +/-- **The explicit block-counting network on numbers is polynomial-time**, as its number of edges +in unary and its list of vertices, each the pair of its ports and its table as lists of binary +numbers. -/ +theorem computableInPolyTime_explicitNetworkNum + (hx : ComputableInPolyTime x inp encBits) (hb : ComputableInPolyTime b inp encUnary) + (hb0 : ∀ a, 0 < b a) (hq : ComputableInPolyTime q inp encUnary) + (hσ : ComputableInPolyTime σ inp encNat) (hcap : ComputableInPolyTime cap inp encUnary) + (h2b : ∀ a, 2 ^ b a ≤ cap a) : + ComputableInPolyTime (fun a => ((explicitNetworkNum e (b a) machine (x a) (q a) (σ a)).numEdges, + (explicitNetworkNum e (b a) machine (x a) (q a) (σ a)).vertices)) inp + (encPair encUnary (encList (encPair (encList encNat) (encList encNat)))) := by + have hm : ComputableInPolyTime (fun a => letterBits k s (b a)) inp encUnary := by + unfold letterBits + exact unary_mul' (const _) hb + have ha : ComputableInPolyTime (fun p : α × ℕ => p.1) (encPair inp encUnary) inp := fst _ _ + refine (unary_mul' (const 2) (unary_mul' (unary_mul' hq (const _)) hm)).prod ?_ + unfold explicitNetworkNum explicitVerticesNum + refine mapWithInput (range.comp (unary_add' (unary_mul' hq (const _)) + (unary_mul' (unary_mul' hq (const _)) hm))) ((computableInPolyTime_explicitPortsNum + (hq.comp ha) (hm.comp ha) (hσ.comp ha) (snd _ _)).prod ?_) + exact computableInPolyTime_explicitTableNum e machine (hx.comp ha) (hb.comp ha) (fun p => hb0 p.1) + (hq.comp ha) (hσ.comp ha) (hcap.comp ha) (fun p => h2b p.1) (snd _ _) + +end Tables + +end Turing.MultiTapePTM diff --git a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount/PolyTime.lean b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount/PolyTime.lean index 61b1feb78a..b2581b0aa0 100644 --- a/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount/PolyTime.lean +++ b/Complexity/Computability/Machines/Turing/MultiTape/Probabilistic/IntervalCount/PolyTime.lean @@ -60,7 +60,8 @@ their stored cells (`Turing.MultiTapeTM.encBiTape`), and the head positions in b ## Main results * `Turing.MultiTapePTM.computableInPolyTime_localRun`: replays are polynomial-time. -* `Turing.MultiTapePTM.IntervalData.computableInPolyTime_mk`: assembling the arguments. +* `Turing.MultiTapePTM.IntervalData.computableInPolyTime_mk`, + `Turing.MultiTapePTM.ControlData.computableInPolyTime_mk`: assembling the arguments. * `Turing.MultiTapePTM.computableInPolyTime_localIntervalCount`: interval counts are polynomial-time when the `2 ^ b` coin strings are polynomially many in the input. -/ @@ -605,6 +606,16 @@ noncomputable def encIntervalData : IntervalData k State ↪ List Bool := variable {α : Type} {input : α ↪ List Bool} +/-- Assemble a control record on plain data from its certified components. -/ +theorem ControlData.computableInPolyTime_mk {state : α → Option State} + {off : α → Option (Fin k) → ℕ} {track : α → OutputTrack} + (hstate : ComputableInPolyTime state input (encFinite (Option State))) + (hoff : ComputableInPolyTime off input (encPi encUnary)) + (htrack : ComputableInPolyTime track input (encFinite OutputTrack)) : + ComputableInPolyTime (fun a => ((state a, off a, track a) : ControlData k State)) input + encControlData := + (hstate.prod (hoff.prod htrack)).of_enc_eq fun _ => rfl + /-- Assemble the arguments of an interval count from their certified components. -/ theorem IntervalData.computableInPolyTime_mk {word : α → List Bool} {b : α → ℕ} {J : α → Option (Fin k) → ℤ} {δ : α → Option (Fin k) → SignType} diff --git a/ComplexityTests/HPVExplicitTables.lean b/ComplexityTests/HPVExplicitTables.lean new file mode 100644 index 0000000000..a29d7be5cd --- /dev/null +++ b/ComplexityTests/HPVExplicitTables.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +import Complexity.Computability.Machines.Turing.MultiTape.Probabilistic.ExplicitBlockNetwork.TablePolyTime + +/-! The tables of the explicit block-counting networks on numbers: decoded letters, table entries +of a concrete machine read off the explicit network, and the polynomial-time certificate. -/ + +namespace ComplexityTests.HPVExplicitTables + +open Turing MultiTapeMachine MultiTapePTM MultiTapeNTM.ChoiceTable Cslib.Circuits.Frontier + +/-- Emit the first coin and halt. No work tapes; the input head stays. -/ +private def emitCoin : MultiTapePTM 0 Bool Unit where + initial := () + tr _ _ _ _ bit := .step + { inputTape := 0, workTapes := Fin.elim0, output := some bit, state := none } + Empty.elim Empty.elim + +/-! ### Decoding letters -/ + +-- With two states, one work tape and blocks of two cells there are `3 * (2 ^ 2 * 3) = 36` +-- control records. Letter `34` is the record of state `true`, both offsets `1` and output track +-- `accept` (compare `HPVExplicitBlockNetwork`), and letter `44` is the block holding `true` twice. +example : decodeControlData (k := 1) finTwoEquiv.symm 2 34 = + controlData (some true, (fun _ => 1 : Option (Fin 1) → ZMod 2), OutputTrack.accept) := by + rw [show (34 : ℕ) = letterEquiv (k := 1) (b := 2) finTwoEquiv.symm + (.inl (some true, fun _ => 1, .accept)) by decide] + simp only [letterEquiv, Equiv.trans_apply, Equiv.sumCongr_apply, Sum.map_inl, + finSumFinEquiv_apply_left, Fin.val_castAdd, decodeControlData_controlEquiv] + +example : contentsCellNum 1 2 2 44 0 = some true ∧ contentsCellNum 1 2 2 44 1 = some true ∧ + acceptNum 1 2 2 34 = 1 ∧ acceptNum 1 2 2 44 = 0 := by decide + +/-! ### Table entries of `emitCoin` -/ + +-- One interval of two steps; letters of `10` bits. The interval (vertex `0`) has the source +-- halves of its control edge as ports. At index `1` its leaving letter is number `1`: halted, +-- offsets `0`, output track `accept`, reached by the two coin strings starting with `true`. +example : ((emitCoin.explicitBlockNetwork [] 2 (scheduleOfNat 0 1 1) + (Equiv.ofUnique Unit (Fin 1))).vertices[0]!.2)[1]! = 2 := by + rw [explicitBlockNetwork_eq_explicitNetworkNum] + decide +kernel + +-- The sink of the control edge (vertex `1`) accepts letter `1` and rejects letter `0`, whose +-- output track is empty. +example : ((emitCoin.explicitBlockNetwork [] 2 (scheduleOfNat 0 1 1) + (Equiv.ofUnique Unit (Fin 1))).vertices[1]!.2)[1]! = 1 ∧ + ((emitCoin.explicitBlockNetwork [] 2 (scheduleOfNat 0 1 1) + (Equiv.ofUnique Unit (Fin 1))).vertices[1]!.2)[0]! = 0 := by + rw [explicitBlockNetwork_eq_explicitNetworkNum] + decide +kernel + +-- A subdivision vertex (vertex `2`) is the equality of the bits on its two ports. +example : (emitCoin.explicitBlockNetwork [] 2 (scheduleOfNat 0 1 1) + (Equiv.ofUnique Unit (Fin 1))).vertices[2]!.2 = [1, 0, 0, 1] := by + rw [explicitBlockNetwork_eq_explicitNetworkNum] + decide +kernel + +/-! ### Polynomial time -/ + +-- The network of `emitCoin` with blocks of two steps and one interval is polynomial-time in the +-- schedule number, with `2 ^ 2 ≤ 4`. +example : MultiTapeTM.ComputableInPolyTime (fun σ : ℕ => + ((explicitNetworkNum (Equiv.ofUnique Unit (Fin 1)) 2 emitCoin [] 1 σ).numEdges, + (explicitNetworkNum (Equiv.ofUnique Unit (Fin 1)) 2 emitCoin [] 1 σ).vertices)) + MultiTapeTM.encNat (MultiTapeTM.encPair MultiTapeTM.encUnary + (MultiTapeTM.encList (MultiTapeTM.encPair (MultiTapeTM.encList MultiTapeTM.encNat) + (MultiTapeTM.encList MultiTapeTM.encNat)))) := + computableInPolyTime_explicitNetworkNum (Equiv.ofUnique Unit (Fin 1)) emitCoin (.const _) + (.const _) (fun _ => two_pos) (.const _) MultiTapeTM.ComputableInPolyTime.id' (.const 4) + (fun _ => le_refl 4) + +end ComplexityTests.HPVExplicitTables