From f84a8d1bf9525aa9a005c1a31045b7685c6ac059 Mon Sep 17 00:00:00 2001 From: Jacques Comeaux Date: Thu, 1 Jan 2026 14:31:42 -0600 Subject: Update push, pull, and sys functors --- Data/System/Values.agda | 445 ++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 408 insertions(+), 37 deletions(-) (limited to 'Data/System') diff --git a/Data/System/Values.agda b/Data/System/Values.agda index 545a835..d1cd6c9 100644 --- a/Data/System/Values.agda +++ b/Data/System/Values.agda @@ -5,53 +5,98 @@ open import Level using (0ℓ) module Data.System.Values (A : CommutativeMonoid 0ℓ 0ℓ) where -import Algebra.Properties.CommutativeMonoid.Sum as Sum -import Data.Vec.Functional.Relation.Binary.Equality.Setoid as Pointwise -import Relation.Binary.PropositionalEquality as ≡ +open import Category.Instance.Setoids.SymmetricMonoidal {0ℓ} {0ℓ} using (Setoids-×) -open import Data.Fin using (_↑ˡ_; _↑ʳ_; zero; suc; splitAt) -open import Data.Nat using (ℕ; _+_; suc) -open import Data.Product using (_,_) +import Algebra.Properties.CommutativeMonoid.Sum A as Sum +import Data.Vec.Functional.Relation.Binary.Equality.Setoid as Pointwise +import Object.Monoid.Commutative Setoids-×.symmetric as Obj +import Relation.Binary.Reasoning.Setoid as ≈-Reasoning + +open import Data.Bool using (Bool; if_then_else_) +open import Data.Bool.Properties using (if-cong) +open import Data.Monoid using (module FromMonoid) +open import Data.CMonoid using (fromCMonoid) +open import Data.Fin using (Fin; splitAt; _↑ˡ_; _↑ʳ_; punchIn; punchOut) +open import Data.Fin using (_≟_) +open import Data.Fin.Permutation using (Permutation; Permutation′; _⟨$⟩ʳ_; _⟨$⟩ˡ_; id; flip; inverseˡ; inverseʳ; punchIn-permute; insert; remove) +open import Data.Fin.Preimage using (preimage; preimage-cong₁; preimage-cong₂) +open import Data.Fin.Properties using (punchIn-punchOut) +open import Data.Nat using (ℕ; _+_) +open import Data.Product using (_,_; Σ-syntax) open import Data.Product.Relation.Binary.Pointwise.NonDependent using (_×ₛ_) open import Data.Setoid using (∣_∣) +open import Data.Subset.Functional using (Subset; ⁅_⁆; ⁅⁆∘ρ) open import Data.Sum using (inj₁; inj₂) open import Data.Vec.Functional as Vec using (Vector; zipWith; replicate) open import Function using (Func; _⟶ₛ_; _⟨$⟩_; _∘_) open import Level using (0ℓ) open import Relation.Binary using (Rel; Setoid; IsEquivalence) +open import Relation.Binary.PropositionalEquality as ≡ using (_≡_; _≗_; module ≡-Reasoning) +open import Relation.Nullary.Decidable using (yes; no) -open CommutativeMonoid A renaming (Carrier to Value) +open Bool +open CommutativeMonoid A renaming (Carrier to Value; setoid to Valueₛ) +open Fin open Func -open Sum A using (sum) - -open Pointwise setoid using (≋-setoid; ≋-isEquivalence) +open Pointwise Valueₛ using (≋-setoid; ≋-isEquivalence) +open ℕ opaque - Values : ℕ → Setoid 0ℓ 0ℓ Values = ≋-setoid +_when_ : Value → Bool → Value +x when b = if b then x else ε + +-- when preserves setoid equivalence +when-cong + : {x y : Value} + → x ≈ y + → (b : Bool) + → x when b ≈ y when b +when-cong _ false = refl +when-cong x≈y true = x≈y + module _ {n : ℕ} where opaque unfolding Values - merge : ∣ Values n ∣ → Value - merge = sum - _⊕_ : ∣ Values n ∣ → ∣ Values n ∣ → ∣ Values n ∣ xs ⊕ ys = zipWith _∙_ xs ys <ε> : ∣ Values n ∣ <ε> = replicate n ε + mask : Subset n → ∣ Values n ∣ → ∣ Values n ∣ + mask S v i = v i when S i + + sum : ∣ Values n ∣ → Value + sum = Sum.sum + + merge : ∣ Values n ∣ → Subset n → Value + merge v S = sum (mask S v) + + -- mask preserves setoid equivalence + maskₛ : Subset n → Values n ⟶ₛ Values n + maskₛ S .to = mask S + maskₛ S .cong v≋w i = when-cong (v≋w i) (S i) + + -- sum preserves setoid equivalence + sumₛ : Values n ⟶ₛ Valueₛ + sumₛ .to = Sum.sum + sumₛ .cong = Sum.sum-cong-≋ + head : ∣ Values (suc n) ∣ → Value head xs = xs zero tail : ∣ Values (suc n) ∣ → ∣ Values n ∣ tail xs = xs ∘ suc + lookup : ∣ Values n ∣ → Fin n → Value + lookup v i = v i + module ≋ = Setoid (Values n) _≋_ : Rel ∣ Values n ∣ 0ℓ @@ -59,16 +104,45 @@ module _ {n : ℕ} where infix 4 _≋_ -opaque + opaque + + unfolding merge + + -- merge preserves setoid equivalence + merge-cong + : (S : Subset n) + → {xs ys : ∣ Values n ∣} + → xs ≋ ys + → merge xs S ≈ merge ys S + merge-cong S {xs} {ys} xs≋ys = cong sumₛ (cong (maskₛ S) xs≋ys) + + mask-cong₁ + : {S₁ S₂ : Subset n} + → S₁ ≗ S₂ + → (xs : ∣ Values n ∣) + → mask S₁ xs ≋ mask S₂ xs + mask-cong₁ S₁≋S₂ _ i = reflexive (if-cong (S₁≋S₂ i)) + + merge-cong₂ + : (xs : ∣ Values n ∣) + → {S₁ S₂ : Subset n} + → S₁ ≗ S₂ + → merge xs S₁ ≈ merge xs S₂ + merge-cong₂ xs S₁≋S₂ = cong sumₛ (mask-cong₁ S₁≋S₂ xs) + +module _ where - unfolding Values open Setoid - ≋-isEquiv : ∀ n → IsEquivalence (_≈_ (Values n)) - ≋-isEquiv = ≋-isEquivalence + + opaque + unfolding Values + ≋-isEquiv : ∀ n → IsEquivalence (_≈_ (Values n)) + ≋-isEquiv = ≋-isEquivalence module _ {n : ℕ} where opaque + unfolding _⊕_ ⊕-cong : {x y u v : ≋.Carrier {n}} → x ≋ y → u ≋ v → x ⊕ u ≋ y ⊕ v @@ -86,25 +160,35 @@ module _ {n : ℕ} where ⊕-comm : (x y : ≋.Carrier {n}) → x ⊕ y ≋ y ⊕ x ⊕-comm x y i = comm (x i) (y i) -open CommutativeMonoid -Valuesₘ : ℕ → CommutativeMonoid 0ℓ 0ℓ -Valuesₘ n .Carrier = ∣ Values n ∣ -Valuesₘ n ._≈_ = _≋_ -Valuesₘ n ._∙_ = _⊕_ -Valuesₘ n .ε = <ε> -Valuesₘ n .isCommutativeMonoid = record - { isMonoid = record - { isSemigroup = record - { isMagma = record - { isEquivalence = ≋-isEquiv n - ; ∙-cong = ⊕-cong - } - ; assoc = ⊕-assoc - } - ; identity = ⊕-identityˡ , ⊕-identityʳ - } - ; comm = ⊕-comm - } +module Algebra where + + open CommutativeMonoid + + Valuesₘ : ℕ → CommutativeMonoid 0ℓ 0ℓ + Valuesₘ n .Carrier = ∣ Values n ∣ + Valuesₘ n ._≈_ = _≋_ + Valuesₘ n ._∙_ = _⊕_ + Valuesₘ n .ε = <ε> + Valuesₘ n .isCommutativeMonoid = record + { isMonoid = record + { isSemigroup = record + { isMagma = record + { isEquivalence = ≋-isEquiv n + ; ∙-cong = ⊕-cong + } + ; assoc = ⊕-assoc + } + ; identity = ⊕-identityˡ , ⊕-identityʳ + } + ; comm = ⊕-comm + } + +module Object where + + opaque + unfolding FromMonoid.μ + Valuesₘ : ℕ → Obj.CommutativeMonoid + Valuesₘ n = fromCMonoid (Algebra.Valuesₘ n) opaque @@ -144,3 +228,290 @@ module _ {n m : ℕ} where ++ₛ : Values n ×ₛ Values m ⟶ₛ Values (n + m) to ++ₛ (xs , ys) = xs ++ ys cong ++ₛ (≗xs , ≗ys) = ++-cong _ _ ≗xs ≗ys + +opaque + + unfolding merge + + mask-⊕ + : {n : ℕ} + (xs ys : ∣ Values n ∣) + (S : Subset n) + → mask S (xs ⊕ ys) ≋ mask S xs ⊕ mask S ys + mask-⊕ xs ys S i with S i + ... | false = sym (identityˡ ε) + ... | true = refl + + sum-⊕ + : {n : ℕ} + → (xs ys : ∣ Values n ∣) + → sum (xs ⊕ ys) ≈ sum xs ∙ sum ys + sum-⊕ {zero} xs ys = sym (identityˡ ε) + sum-⊕ {suc n} xs ys = begin + (head xs ∙ head ys) ∙ sum (tail xs ⊕ tail ys) ≈⟨ ∙-congˡ (sum-⊕ (tail xs) (tail ys)) ⟩ + (head xs ∙ head ys) ∙ (sum (tail xs) ∙ sum (tail ys)) ≈⟨ assoc (head xs) (head ys) _ ⟩ + head xs ∙ (head ys ∙ (sum (tail xs) ∙ sum (tail ys))) ≈⟨ ∙-congˡ (assoc (head ys) (sum (tail xs)) _) ⟨ + head xs ∙ ((head ys ∙ sum (tail xs)) ∙ sum (tail ys)) ≈⟨ ∙-congˡ (∙-congʳ (comm (head ys) (sum (tail xs)))) ⟩ + head xs ∙ ((sum (tail xs) ∙ head ys) ∙ sum (tail ys)) ≈⟨ ∙-congˡ (assoc (sum (tail xs)) (head ys) _) ⟩ + head xs ∙ (sum (tail xs) ∙ (head ys ∙ sum (tail ys))) ≈⟨ assoc (head xs) (sum (tail xs)) _ ⟨ + (head xs ∙ sum (tail xs)) ∙ (head ys ∙ sum (tail ys)) ∎ + where + open ≈-Reasoning Valueₛ + + merge-⊕ + : {n : ℕ} + (xs ys : ∣ Values n ∣) + (S : Subset n) + → merge (xs ⊕ ys) S ≈ merge xs S ∙ merge ys S + merge-⊕ {n} xs ys S = begin + sum (mask S (xs ⊕ ys)) ≈⟨ cong sumₛ (mask-⊕ xs ys S) ⟩ + sum (mask S xs ⊕ mask S ys) ≈⟨ sum-⊕ (mask S xs) (mask S ys) ⟩ + sum (mask S xs) ∙ sum (mask S ys) ∎ + where + open ≈-Reasoning Valueₛ + + mask-<ε> : {n : ℕ} (S : Subset n) → mask {n} S <ε> ≋ <ε> + mask-<ε> S i with S i + ... | false = refl + ... | true = refl + + sum-<ε> : (n : ℕ) → sum {n} <ε> ≈ ε + sum-<ε> zero = refl + sum-<ε> (suc n) = trans (identityˡ (sum {n} <ε>)) (sum-<ε> n) + + merge-<ε> : {n : ℕ} (S : Subset n) → merge {n} <ε> S ≈ ε + merge-<ε> {n} S = begin + sum (mask S <ε>) ≈⟨ cong sumₛ (mask-<ε> S) ⟩ + sum {n} <ε> ≈⟨ sum-<ε> n ⟩ + ε ∎ + where + open ≈-Reasoning Valueₛ + + merge-⁅⁆ + : {n : ℕ} + (xs : ∣ Values n ∣) + (i : Fin n) + → merge xs ⁅ i ⁆ ≈ lookup xs i + merge-⁅⁆ {suc n} xs zero = trans (∙-congˡ (sum-<ε> n)) (identityʳ (head xs)) + merge-⁅⁆ {suc n} xs (suc i) = begin + ε ∙ merge (tail xs) ⁅ i ⁆ ≈⟨ identityˡ (sum (mask ⁅ i ⁆ (tail xs))) ⟩ + merge (tail xs) ⁅ i ⁆ ≈⟨ merge-⁅⁆ (tail xs) i ⟩ + tail xs i ∎ + where + open ≈-Reasoning Valueₛ + +opaque + + unfolding Values + + push : {A B : ℕ} → ∣ Values A ∣ → (Fin A → Fin B) → ∣ Values B ∣ + push v f = merge v ∘ preimage f ∘ ⁅_⁆ + + pull : {A B : ℕ} → ∣ Values B ∣ → (Fin A → Fin B) → ∣ Values A ∣ + pull v f = v ∘ f + +insert-f0-0 + : {A B : ℕ} + (f : Fin (suc A) → Fin (suc B)) + → Σ[ ρ ∈ Permutation′ (suc B) ] (ρ ⟨$⟩ʳ (f zero) ≡ zero) +insert-f0-0 {A} {B} f = ρ , ρf0≡0 + where + ρ : Permutation′ (suc B) + ρ = insert (f zero) zero id + ρf0≡0 : ρ ⟨$⟩ʳ f zero ≡ zero + ρf0≡0 with f zero ≟ f zero + ... | yes _ = ≡.refl + ... | no f0≢f0 with () ← f0≢f0 ≡.refl + +opaque + unfolding push + push-cong + : {A B : ℕ} + → (v : ∣ Values A ∣) + {f g : Fin A → Fin B} + → f ≗ g + → push v f ≋ push v g + push-cong v f≋g i = merge-cong₂ v (≡.cong ⁅ i ⁆ ∘ f≋g) + +opaque + unfolding Values + removeAt : {n : ℕ} → ∣ Values (suc n) ∣ → Fin (suc n) → ∣ Values n ∣ + removeAt v i = Vec.removeAt v i + +opaque + unfolding merge removeAt + merge-removeAt + : {A : ℕ} + (k : Fin (suc A)) + (v : ∣ Values (suc A) ∣) + (S : Subset (suc A)) + → merge v S ≈ lookup v k when S k ∙ merge (removeAt v k) (Vec.removeAt S k) + merge-removeAt {A} zero v S = refl + merge-removeAt {suc A} (suc k) v S = begin + v0? ∙ merge (tail v) (Vec.tail S) ≈⟨ ∙-congˡ (merge-removeAt k (tail v) (Vec.tail S)) ⟩ + v0? ∙ (vk? ∙ merge (tail v-) (Vec.tail S-)) ≈⟨ assoc v0? vk? _ ⟨ + (v0? ∙ vk?) ∙ merge (tail v-) (Vec.tail S-) ≈⟨ ∙-congʳ (comm v0? vk?) ⟩ + (vk? ∙ v0?) ∙ merge (tail v-) (Vec.tail S-) ≈⟨ assoc vk? v0? _ ⟩ + vk? ∙ (v0? ∙ merge (tail v-) (Vec.tail S-)) ≡⟨⟩ + vk? ∙ merge v- S- ∎ + where + open ≈-Reasoning Valueₛ + v0? vk? : Value + v0? = head v when Vec.head S + vk? = tail v k when Vec.tail S k + v- : Vector Value (suc A) + v- = removeAt v (suc k) + S- : Subset (suc A) + S- = Vec.removeAt S (suc k) + +opaque + unfolding merge pull removeAt + merge-preimage-ρ + : {A B : ℕ} + → (ρ : Permutation A B) + → (v : ∣ Values A ∣) + (S : Subset B) + → merge v (preimage (ρ ⟨$⟩ʳ_) S) ≈ merge (pull v (ρ ⟨$⟩ˡ_)) S + merge-preimage-ρ {zero} {zero} ρ v S = refl + merge-preimage-ρ {zero} {suc B} ρ v S with () ← ρ ⟨$⟩ˡ zero + merge-preimage-ρ {suc A} {zero} ρ v S with () ← ρ ⟨$⟩ʳ zero + merge-preimage-ρ {suc A} {suc B} ρ v S = begin + merge v (preimage ρʳ S) ≈⟨ merge-removeAt (ρˡ zero) v (preimage ρʳ S) ⟩ + mask (preimage ρʳ S) v (ρˡ zero) ∙ merge v- [preimage-ρʳ-S]- ≈⟨ ∙-congʳ ≈vρˡ0? ⟩ + mask S (pull v ρˡ) zero ∙ merge v- [preimage-ρʳ-S]- ≈⟨ ∙-congˡ (merge-cong₂ v- preimage-) ⟩ + mask S (pull v ρˡ) zero ∙ merge v- (preimage ρʳ- S-) ≈⟨ ∙-congˡ (merge-preimage-ρ ρ- v- S-) ⟩ + mask S (pull v ρˡ) zero ∙ merge (pull v- ρˡ-) S- ≈⟨ ∙-congˡ (merge-cong S- (reflexive ∘ pull-v-ρˡ-)) ⟩ + mask S (pull v ρˡ) zero ∙ merge (tail (pull v ρˡ)) S- ≡⟨⟩ + merge (pull v ρˡ) S ∎ + where + ρˡ : Fin (suc B) → Fin (suc A) + ρˡ = ρ ⟨$⟩ˡ_ + ρʳ : Fin (suc A) → Fin (suc B) + ρʳ = ρ ⟨$⟩ʳ_ + ρ- : Permutation A B + ρ- = remove (ρˡ zero) ρ + ρˡ- : Fin B → Fin A + ρˡ- = ρ- ⟨$⟩ˡ_ + ρʳ- : Fin A → Fin B + ρʳ- = ρ- ⟨$⟩ʳ_ + v- : ∣ Values A ∣ + v- = removeAt v (ρˡ zero) + S- : Subset B + S- = S ∘ suc + [preimage-ρʳ-S]- : Subset A + [preimage-ρʳ-S]- = Vec.removeAt (preimage ρʳ S) (ρˡ zero) + vρˡ0? : Value + vρˡ0? = head (pull v ρˡ) when S zero + ≈vρˡ0?  : mask (S ∘ ρʳ ∘ ρˡ) (pull v ρˡ) zero ≈ mask S (pull v ρˡ) zero + ≈vρˡ0? = mask-cong₁ (λ i → ≡.cong S (inverseʳ ρ {i})) (pull v ρˡ) zero + module _ where + open ≡-Reasoning + preimage- : [preimage-ρʳ-S]- ≗ preimage ρʳ- S- + preimage- x = begin + [preimage-ρʳ-S]- x ≡⟨⟩ + Vec.removeAt (preimage ρʳ S) (ρˡ zero) x ≡⟨⟩ + S (ρʳ (punchIn (ρˡ zero) x)) ≡⟨ ≡.cong S (punchIn-permute ρ (ρˡ zero) x) ⟩  + S (punchIn (ρʳ (ρˡ zero)) (ρʳ- x)) ≡⟨ ≡.cong (λ h → S (punchIn h (ρʳ- x))) (inverseʳ ρ) ⟩  + S (punchIn zero (ρʳ- x)) ≡⟨⟩  + S (suc (ρʳ- x)) ≡⟨⟩ + preimage ρʳ- S- x ∎ + pull-v-ρˡ- : pull v- ρˡ- ≗ tail (pull v ρˡ) + pull-v-ρˡ- i = begin + v- (ρˡ- i) ≡⟨⟩ + v (punchIn (ρˡ zero) (punchOut {A} {ρˡ zero} _)) ≡⟨ ≡.cong v (punchIn-punchOut _) ⟩ + v (ρˡ (punchIn (ρʳ (ρˡ zero)) i)) ≡⟨ ≡.cong (λ h → v (ρˡ (punchIn h i))) (inverseʳ ρ) ⟩ + v (ρˡ (punchIn zero i)) ≡⟨⟩ + v (ρˡ (suc i)) ≡⟨⟩ + tail (v ∘ ρˡ) i ∎ + open ≈-Reasoning Valueₛ + +opaque + + unfolding push merge mask + + mutual + + merge-preimage + : {A B : ℕ} + (f : Fin A → Fin B) + → (v : ∣ Values A ∣) + (S : Subset B) + → merge v (preimage f S) ≈ merge (push v f) S + merge-preimage {zero} {zero} f v S = refl + merge-preimage {zero} {suc B} f v S = sym (trans (cong sumₛ (mask-<ε> S)) (sum-<ε> (suc B))) + merge-preimage {suc A} {zero} f v S with () ← f zero + merge-preimage {suc A} {suc B} f v S with insert-f0-0 f + ... | ρ , ρf0≡0 = begin + merge v (preimage f S) ≈⟨ merge-cong₂ v (preimage-cong₁ (λ x → inverseˡ ρ {f x}) S) ⟨ + merge v (preimage (ρˡ ∘ ρʳ ∘ f) S) ≡⟨⟩ + merge v (preimage (ρʳ ∘ f) (preimage ρˡ S)) ≈⟨ merge-preimage-f0≡0 (ρʳ ∘ f) ρf0≡0 v (preimage ρˡ S) ⟩ + merge (push v (ρʳ ∘ f)) (preimage ρˡ S) ≈⟨ merge-preimage-ρ (flip ρ) (push v (ρʳ ∘ f)) S ⟩ + merge (pull (push v (ρʳ ∘ f)) ρʳ) S ≈⟨ merge-cong S (merge-cong₂ v ∘ preimage-cong₂ (ρʳ ∘ f) ∘ ⁅⁆∘ρ ρ) ⟩ + merge (push v (ρˡ ∘ ρʳ ∘ f)) S ≈⟨ merge-cong S (push-cong v (λ x → inverseˡ ρ {f x})) ⟩ + merge (push v f) S ∎ + where + open ≈-Reasoning Valueₛ + ρʳ ρˡ : Fin (ℕ.suc B) → Fin (ℕ.suc B) + ρʳ = ρ ⟨$⟩ʳ_ + ρˡ = ρ ⟨$⟩ˡ_ + + merge-preimage-f0≡0 + : {A B : ℕ} + (f : Fin (suc A) → Fin (suc B)) + → f zero ≡ zero + → (v : ∣ Values (suc A) ∣) + (S : Subset (suc B)) + → merge v (preimage f S) ≈ merge (push v f) S + merge-preimage-f0≡0 {A} {B} f f0≡0 v S + using S0 , S- ← S zero , S ∘ suc + using v0 , v- ← head v , tail v + using f0 , f- ← f zero , f ∘ suc = begin + merge v f⁻¹[S] ≡⟨⟩ + v0? ∙ merge v- f⁻¹[S]- ≈⟨ ∙-congˡ (merge-preimage f- v- S) ⟩ + v0? ∙ merge f[v-] S ≡⟨⟩ + v0? ∙ (f[v-]0? ∙ merge f[v-]- S-) ≈⟨ assoc v0? f[v-]0? (merge f[v-]- S-) ⟨ + v0? ∙ f[v-]0? ∙ merge f[v-]- S- ≈⟨ ∙-congʳ v0?∙f[v-]0?≈f[v]0? ⟩ + f[v]0? ∙ merge f[v-]- S- ≈⟨ ∙-congˡ (merge-cong S- ≋f[v]-) ⟩ + f[v]0? ∙ merge f[v]- S- ≡⟨⟩ + merge f[v] S ∎ + where + open ≈-Reasoning Valueₛ + f⁻¹[S] : Subset (suc A) + f⁻¹[S] = preimage f S + f⁻¹[S]- : Subset A + f⁻¹[S]- = f⁻¹[S] ∘ suc + f⁻¹[S]0 : Bool + f⁻¹[S]0 = f⁻¹[S] zero + f[v] : ∣ Values (suc B) ∣ + f[v] = push v f + f[v]- : Vector Value B + f[v]- = tail f[v] + f[v]0 : Value + f[v]0 = head f[v] + f[v-] : ∣ Values (suc B) ∣ + f[v-] = push v- f- + f[v-]- : Vector Value B + f[v-]- = tail f[v-] + f[v-]0 : Value + f[v-]0 = head f[v-] + v0? f[v-]0? v0?+[f[v-]0?] f[v]0? : Value + v0? = v0 when f⁻¹[S]0 + f[v-]0? = f[v-]0 when S0 + v0?+[f[v-]0?] = if S0 then v0? ∙ f[v-]0 else v0? + f[v]0? = f[v]0 when S0 + v0?∙f[v-]0?≈f[v]0? : v0? ∙ f[v-]0? ≈ f[v]0? + v0?∙f[v-]0?≈f[v]0? rewrite f0≡0 with S0 + ... | true = refl + ... | false = identityˡ ε + ≋f[v]- : f[v-]- ≋ f[v]- + ≋f[v]- x rewrite f0≡0 = sym (identityˡ (push v- f- (suc x))) + +opaque + unfolding push + merge-push + : {A B C : ℕ} + (f : Fin A → Fin B) + (g : Fin B → Fin C) + → (v : ∣ Values A ∣) + → push v (g ∘ f) ≋ push (push v f) g + merge-push f g v i = merge-preimage f v (preimage g ⁅ i ⁆) -- cgit v1.2.3