agda fiddling

This commit is contained in:
rhiannon morris 2022-04-06 20:21:02 +02:00
parent 3ea12fef67
commit 981f543509
1 changed files with 38 additions and 4 deletions

View File

@ -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