|
57 | 57 | -- |
58 | 58 | -- Where next: |
59 | 59 | -- |
60 | | --- * Sequential composition `EchoS enum f b n₁ → EchoS enum' g y n₂ |
61 | | --- → EchoS (paired-enum) (g ∘ f) y (n₁ * n₂)` under a pairing |
62 | | --- enumerator on `ℕ × ℕ`. Honest but needs a bijection |
63 | | --- `ℕ × ℕ ↔ ℕ`; defer to the slice that wants it. |
| 60 | +-- * (LANDED) Product / sequential composition. The original sketch |
| 61 | +-- `EchoS enum f b n₁ → EchoS enum' g y n₂ → EchoS … (g ∘ f) y (n₁ * n₂)` |
| 62 | +-- is ill-typed (the second search's witness is not tied to the first's |
| 63 | +-- output `b`); the well-typed form is the PRODUCT of two independent |
| 64 | +-- searches, `echo-search-product` below, over `A₁ × A₂` with budget |
| 65 | +-- `n₁ * n₂`. The `n₁ * n₂` budget provably needs a budget-dependent |
| 66 | +-- row-major pairing (a global `ℕ × ℕ ↔ ℕ` cannot keep |
| 67 | +-- `pair (n₁-1) (n₂-1) < n₁ * n₂`), so it divides by `n₂` and requires |
| 68 | +-- `NonZero n₂`. See `productEnum` / `echo-search-product` at the bottom. |
64 | 69 | -- |
65 | 70 | -- * A real abstract-machine refinement: configurations + a step |
66 | 71 | -- relation, with `EchoS` recovered as `∃ trace . trace.length < n |
|
77 | 82 | module EchoSearch where |
78 | 83 |
|
79 | 84 | open import Function.Base using (_∘_; id) |
80 | | -open import Data.Nat.Base using (ℕ; zero; suc; _≤_; _<_; z≤n; s≤s) |
| 85 | +open import Data.Nat.Base using (ℕ; zero; suc; _≤_; _<_; _+_; _*_; z≤n; s≤s; NonZero) |
81 | 86 | open import Data.Nat.Properties |
82 | | - using (≤-<-trans; <-≤-trans; <-cmp; <-trans; ≤-trans; ≤-refl; <-irrefl) |
| 87 | + using (≤-<-trans; <-≤-trans; <-cmp; <-trans; ≤-trans; ≤-refl; <-irrefl; +-monoˡ-<; *-monoˡ-≤) |
| 88 | +open import Data.Nat.DivMod |
| 89 | + using (_/_; _%_; [m+kn]%n≡m%n; m<n⇒m%n≡m; m<n⇒m/n≡0; m*n/n≡m; +-distrib-/-∣ʳ) |
| 90 | +open import Data.Nat.Divisibility using (divides-refl) |
83 | 91 | open import Data.Empty using (⊥; ⊥-elim) |
84 | 92 | open import Data.Product.Base using (Σ; _,_; _×_; proj₁; proj₂) |
85 | 93 | open import Relation.Nullary using (¬_; Dec; yes; no) |
86 | 94 | open import Relation.Binary.Definitions using (Tri; tri<; tri≈; tri>) |
87 | 95 | open import Relation.Binary.PropositionalEquality |
88 | | - using (_≡_; refl; sym; trans; cong) |
| 96 | + using (_≡_; refl; sym; trans; cong; cong₂) |
89 | 97 |
|
90 | 98 | open import Echo using (Echo) |
91 | 99 |
|
@@ -194,3 +202,59 @@ bounded-search-is-decidable _≟_ enum f y (suc n) with f (enum n) ≟ y |
194 | 202 | ... | tri< k<n _ _ = ¬below (k , k<n , eqk) |
195 | 203 | ... | tri≈ _ k≡n _ = ¬eq (trans (sym (cong (λ j → f (enum j)) k≡n)) eqk) |
196 | 204 | ... | tri> _ _ n<k = <-irrefl refl (≤-trans n<k k≤n) |
| 205 | + |
| 206 | +---------------------------------------------------------------------- |
| 207 | +-- Product (sequential) composition |
| 208 | +---------------------------------------------------------------------- |
| 209 | + |
| 210 | +-- The product of two searches. `productMap` runs `f₁` and `f₂` on the two |
| 211 | +-- components; `productEnum n₂` is the row-major product strategy on |
| 212 | +-- `A₁ × A₂`: at index `k` it queries `enum₁ (k / n₂)` and `enum₂ (k % n₂)`, |
| 213 | +-- where `n₂` is the second budget. |
| 214 | +productMap : |
| 215 | + ∀ {a₁ a₂ b₁ b₂} {A₁ : Set a₁} {A₂ : Set a₂} {B₁ : Set b₁} {B₂ : Set b₂} → |
| 216 | + (A₁ → B₁) → (A₂ → B₂) → (A₁ × A₂ → B₁ × B₂) |
| 217 | +productMap f₁ f₂ (a₁ , a₂) = f₁ a₁ , f₂ a₂ |
| 218 | + |
| 219 | +productEnum : |
| 220 | + ∀ {a₁ a₂} {A₁ : Set a₁} {A₂ : Set a₂} |
| 221 | + (n₂ : ℕ) .{{_ : NonZero n₂}} → |
| 222 | + SearchStrategy A₁ → SearchStrategy A₂ → SearchStrategy (A₁ × A₂) |
| 223 | +productEnum n₂ enum₁ enum₂ k = enum₁ (k / n₂) , enum₂ (k % n₂) |
| 224 | + |
| 225 | +-- Two bounded searches compose into a single bounded search over the |
| 226 | +-- product, with the *product* budget `n₁ * n₂`. The witness pairs the two |
| 227 | +-- step indices row-major as `k₂ + k₁ * n₂`; this stays `< n₁ * n₂` exactly |
| 228 | +-- when `k₁ < n₁` and `k₂ < n₂`, and `/ n₂` / `% n₂` recover `k₁` / `k₂`. |
| 229 | +-- |
| 230 | +-- The `n₁ * n₂` budget provably needs this budget-dependent pairing — a |
| 231 | +-- global `ℕ × ℕ ↔ ℕ` cannot keep `pair (n₁-1) (n₂-1) < n₁ * n₂` — which is |
| 232 | +-- why the scheme divides by `n₂` and requires `NonZero n₂` (a zero-width |
| 233 | +-- second dimension admits no witness anyway). |
| 234 | +echo-search-product : |
| 235 | + ∀ {a₁ a₂ b₁ b₂} {A₁ : Set a₁} {A₂ : Set a₂} {B₁ : Set b₁} {B₂ : Set b₂} |
| 236 | + {enum₁ : SearchStrategy A₁} {enum₂ : SearchStrategy A₂} |
| 237 | + {f₁ : A₁ → B₁} {f₂ : A₂ → B₂} {y₁ : B₁} {y₂ : B₂} |
| 238 | + {n₁ n₂ : ℕ} .{{_ : NonZero n₂}} → |
| 239 | + EchoS enum₁ f₁ y₁ n₁ → |
| 240 | + EchoS enum₂ f₂ y₂ n₂ → |
| 241 | + EchoS (productEnum n₂ enum₁ enum₂) (productMap f₁ f₂) (y₁ , y₂) (n₁ * n₂) |
| 242 | +echo-search-product {enum₁ = enum₁} {enum₂} {f₁} {f₂} {y₁} {y₂} {n₁} {n₂} |
| 243 | + (k₁ , k₁<n₁ , eq₁) (k₂ , k₂<n₂ , eq₂) = |
| 244 | + idx , idx<n₁n₂ , prodEq |
| 245 | + where |
| 246 | + idx : ℕ |
| 247 | + idx = k₂ + k₁ * n₂ |
| 248 | + -- k₂ + k₁*n₂ < n₂ + k₁*n₂ = suc k₁ * n₂ ≤ n₁ * n₂ |
| 249 | + idx<n₁n₂ : idx < n₁ * n₂ |
| 250 | + idx<n₁n₂ = <-≤-trans (+-monoˡ-< (k₁ * n₂) k₂<n₂) (*-monoˡ-≤ n₂ k₁<n₁) |
| 251 | + idx/n₂≡k₁ : idx / n₂ ≡ k₁ |
| 252 | + idx/n₂≡k₁ = trans (+-distrib-/-∣ʳ k₂ (divides-refl k₁)) |
| 253 | + (cong₂ _+_ (m<n⇒m/n≡0 k₂<n₂) (m*n/n≡m k₁ n₂)) |
| 254 | + idx%n₂≡k₂ : idx % n₂ ≡ k₂ |
| 255 | + idx%n₂≡k₂ = trans ([m+kn]%n≡m%n k₂ k₁ n₂) (m<n⇒m%n≡m k₂<n₂) |
| 256 | + prodEq : |
| 257 | + productMap f₁ f₂ (productEnum n₂ enum₁ enum₂ idx) ≡ (y₁ , y₂) |
| 258 | + prodEq = cong₂ _,_ |
| 259 | + (trans (cong (f₁ ∘ enum₁) idx/n₂≡k₁) eq₁) |
| 260 | + (trans (cong (f₂ ∘ enum₂) idx%n₂≡k₂) eq₂) |
0 commit comments