From 981f543509386a34e75f76ceb2ebd2d60231707e Mon Sep 17 00:00:00 2001 From: rhiannon morris Date: Wed, 6 Apr 2022 20:21:02 +0200 Subject: [PATCH] agda fiddling --- quox-nat.agda | 42 ++++++++++++++++++++++++++++++++++++++---- 1 file changed, 38 insertions(+), 4 deletions(-) diff --git a/quox-nat.agda b/quox-nat.agda index a8a9cd7..4ae275e 100644 --- a/quox-nat.agda +++ b/quox-nat.agda @@ -3,11 +3,15 @@ open import Axiom.Extensionality.Propositional module _ (ext : ∀ {a b} → Extensionality a b) where open import Prelude hiding (zero; suc) -open import Data.W +open import Data.W renaming (induction to induction′) open import Data.Container open import Data.Container.Relation.Unary.All ; open □ -variable ℓ : Level +variable + 𝓀 ℓ : Level + A B : Set 𝓀 + P Q : A → Set ℓ + C : Container 𝓀 ℓ data Tag : Set where `zero `suc : Tag @@ -30,15 +34,45 @@ zero = sup (`zero , λ ()) suc : Nat → Nat suc n = sup (`suc , const n) +induction : + (P : W C → Set ℓ) → + (IH : (t : ⟦ C ⟧ (W C)) → □ C P t → P (sup t)) → + (w : W C) → P w +induction P IH = induction′ P (λ {t} → IH t) + + elim : (P : Nat → Set ℓ) → (Z : P zero) → (S : ∀ n → P n → P (suc n)) → (n : Nat) → P n -elim P Z S = induction P λ {(tag , body)} → +elim P Z S = induction _ λ (tag , body) → + body |> (case tag return (λ t → (n′ : Body t → Nat) → □ Repr P (t , n′) → P (sup (t , n′))) of λ where `zero → λ n′ _ → ≡.subst (λ n′ → P (sup (`zero , n′))) (ext λ ()) Z - `suc → λ n′ IH → S (n′ tt) (IH .proof tt)) body + `suc → λ n′ IH → S (n′ tt) (IH .proof tt)) + +pred : Nat → Nat +pred = induction _ λ n@(tag , body) _ → + body |> + (case tag + return (λ t → (Body t → Nat) → Nat) + of λ where + `zero _ → zero + `suc n → n tt) + +Subterms : (A : Set 𝓀) (P : A → Set ℓ) → Set _ +Subterms A P = Σ[ x ∈ A ] (P x → W (A ▷ P)) + +subterms : W (A ▷ P) → Subterms A P +subterms = induction _ λ t IH → t + +natSub : Nat → List Nat +natSub n = + case subterms n of λ where + (`zero , body) → [] + (`suc , body) → [ body tt ] + where open List