Mercurial > hg > Members > kono > Proof > automaton
changeset 257:246da8456ad1
...
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 05 Jul 2021 15:35:48 +0900 |
parents | 5aff0067b194 |
children | 8e103a50511a |
files | automaton-in-agda/src/bijection.agda |
diffstat | 1 files changed, 45 insertions(+), 5 deletions(-) [+] |
line wrap: on
line diff
--- a/automaton-in-agda/src/bijection.agda Mon Jul 05 11:10:15 2021 +0900 +++ b/automaton-in-agda/src/bijection.agda Mon Jul 05 15:35:48 2021 +0900 @@ -314,7 +314,6 @@ open import nat -open ≡-Reasoning -- [] 0 -- 0 → 1 @@ -322,6 +321,12 @@ -- 01 → 3 -- 11 → 4 -- ... + +record LB (n : ℕ) (lton : List Bool → ℕ ) : Set where + field + nlist : List Bool + isBin : lton nlist ≡ n + -- {-# TERMINATING #-} LBℕ : Bijection ℕ ( List Bool ) @@ -338,6 +343,41 @@ lton : List Bool → ℕ lton [] = 0 lton x = suc (lton1 x) + + lb : (n : ℕ) → LB n lton + lb zero = record { nlist = [] ; isBin = refl } + lb (suc n) with LB.nlist (lb n) | inspect LB.nlist (lb n) + ... | [] | record { eq = eq } = record { nlist = false ∷ [] ; isBin = begin + lton (false ∷ []) ≡⟨ refl ⟩ + suc 0 ≡⟨ refl ⟩ + suc (lton []) ≡⟨ cong (λ k → suc (lton k)) (sym eq) ⟩ + suc (lton (LB.nlist (lb n))) ≡⟨ cong suc (LB.isBin (lb n) ) ⟩ + suc n ∎ } where open ≡-Reasoning + ... | false ∷ t | record { eq = eq } = record { nlist = true ∷ t ; isBin = lb01 } where + lb01 : lton (true ∷ t) ≡ suc n + lb01 = begin + lton (true ∷ t) ≡⟨ refl ⟩ + suc (lton (false ∷ t)) ≡⟨ cong (λ k → suc (lton k)) (sym eq) ⟩ + suc (lton (LB.nlist (lb n))) ≡⟨ cong suc (LB.isBin (lb n)) ⟩ + suc n ∎ where open ≡-Reasoning + ... | true ∷ t | record { eq = eq } = n-induction {_} {_} {ℕ} {λ x → LB x lton } (λ x → x) LBN ( suc n ) where + div3 : ℕ → ℕ + div3 x with div2 x + ... | ⟪ n , true ⟫ = n + ... | ⟪ n , false ⟫ = 0 + lb02 : {n : ℕ} → div3 n ≡ zero → LB n lton + lb02 {n} eq with div2 n | inspect div2 n + ... | ⟪ x , true ⟫ | record { eq = eq1 } = {!!} + ... | ⟪ x , false ⟫ | record { eq = eq1 } = {!!} + LBN : Ninduction ℕ (λ x → LB x lton ) ( λ x → x ) + LBN = record { + pnext = div3 + ; fzero = {!!} + ; decline = {!!} + ; ind = {!!} + } + + ntol1 : ℕ → List Bool ntol1 0 = [] ntol1 (suc x) with div2 (suc x) @@ -360,12 +400,12 @@ div20 x x1 eq = begin x1 + x1 ≡⟨ cong (λ k → div2-rev k ) (sym eq) ⟩ div2-rev (div2 (suc x)) ≡⟨ div2-eq _ ⟩ - suc x ∎ + suc x ∎ where open ≡-Reasoning div21 : (x x1 : ℕ ) → div2 (suc x) ≡ ⟪ x1 , true ⟫ → suc (x1 + x1) ≡ suc x div21 x x1 eq = begin suc (x1 + x1) ≡⟨ cong (λ k → div2-rev k ) (sym eq) ⟩ div2-rev (div2 (suc x)) ≡⟨ div2-eq _ ⟩ - suc x ∎ + suc x ∎ where open ≡-Reasoning lbiso1 : (x : ℕ) → suc (lton1 (ntol1 x)) ≡ suc x lbiso1 zero = refl lbiso1 (suc x) with div2 (suc x) | inspect div2 (suc x) @@ -374,14 +414,14 @@ suc (lton1 (ntol1 x1)) + suc (lton1 (ntol1 x1)) ≡⟨ cong ( λ k → k + k ) (lbiso1 x1) ⟩ suc x1 + suc x1 ≡⟨ add11 x1 ⟩ suc (suc (x1 + x1)) ≡⟨ cong suc (div21 x x1 eq1) ⟩ - suc (suc x) ∎ + suc (suc x) ∎ where open ≡-Reasoning ... | ⟪ x1 , false ⟫ | record { eq = eq1 } = begin suc (lton1 (ntol1 x1) + lton1 (ntol1 x1)) ≡⟨ cong ( λ k → k + lton1 (ntol1 x1) ) (lbiso1 x1) ⟩ suc x1 + lton1 (ntol1 x1) ≡⟨ add12 _ _ ⟩ x1 + suc (lton1 (ntol1 x1)) ≡⟨ cong ( λ k → x1 + k ) (lbiso1 x1) ⟩ x1 + suc x1 ≡⟨ +-comm x1 _ ⟩ suc (x1 + x1) ≡⟨ cong suc (div20 x x1 eq1) ⟩ - suc (suc x) ∎ + suc (suc x) ∎ where open ≡-Reasoning lbiso0 : (x : ℕ) → lton (ntol x) ≡ x lbiso0 zero = refl lbiso0 (suc zero) = refl