changeset 284:c9f20dec63ad

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 27 Dec 2021 21:45:00 +0900
parents e5a0499e7b40
children 6e85b8b0d8db
files automaton-in-agda/src/fin.agda
diffstat 1 files changed, 29 insertions(+), 9 deletions(-) [+]
line wrap: on
line diff
--- a/automaton-in-agda/src/fin.agda	Mon Dec 27 19:48:00 2021 +0900
+++ b/automaton-in-agda/src/fin.agda	Mon Dec 27 21:45:00 2021 +0900
@@ -3,8 +3,9 @@
 module fin where
 
 open import Data.Fin hiding (_<_ ; _≤_ ; _>_ ; _+_ )
-open import Data.Fin.Properties hiding ( <-trans ;  ≤-refl  ) renaming ( <-cmp to <-fcmp )
+open import Data.Fin.Properties hiding (≤-trans ;  <-trans ;  ≤-refl  ) renaming ( <-cmp to <-fcmp )
 open import Data.Nat
+open import Data.Nat.Properties
 open import logic
 open import nat
 open import Relation.Binary.PropositionalEquality
@@ -113,6 +114,14 @@
            ∎  where
                open ≡-Reasoning
 
+x<y→fin-1 : {n : ℕ } → { x y : Fin (suc n)} →  toℕ x < toℕ y  → Fin n
+x<y→fin-1 {n} {x} {y} lt = fromℕ< (≤-trans lt (fin≤n _ ))
+
+x<y→fin-1-eq : {n : ℕ } → { x y : Fin (suc n)} → (lt : toℕ x < toℕ y ) → toℕ x ≡ toℕ (x<y→fin-1 lt )
+x<y→fin-1-eq {n} {x} {y} lt = sym ( begin
+           toℕ (fromℕ< (≤-trans lt (fin≤n y)) ) ≡⟨ toℕ-fromℕ< _ ⟩
+           toℕ x  ∎  ) where open ≡-Reasoning
+
 open import Data.List
 open import Relation.Binary.Definitions
 
@@ -150,15 +159,26 @@
      lseq : list-less qs ≡ ls
      ls>n : m + length ls > n
 
+
 fin-dup-in-list>n : {n : ℕ } → (qs : List (Fin n))  → (len> : length qs > n ) → FDup-in-list n qs
 fin-dup-in-list>n {zero} [] ()
 fin-dup-in-list>n {zero} (() ∷ qs) lt
 fin-dup-in-list>n {suc n} qs lt = fdup-phase0 where
+     open import Level using ( Level )
+     mapleneq : {n : Level} {a b : Set n} { x : List a } {f : a → b} → length (map f x) ≡ length x
+     mapleneq {_} {_} {_} {[]} {f} = refl
+     mapleneq {_} {_} {_} {x ∷ x₁} {f} = cong suc (mapleneq  {_} {_} {_} {x₁})
+     lt-conv : {l : Level} {a : Set l} {m n : ℕ } ( qs : List a ) → m + suc ( length qs ) > n → suc m + length qs > n
+     lt-conv {_} {_} {m} {n} qs lt = begin
+         suc n ≤⟨ lt ⟩
+         m + suc (length qs) ≡⟨ sym (+-assoc m 1 _)  ⟩
+         (m + 1) + length qs ≡⟨ cong (λ k → k + length qs) (+-comm m _ ) ⟩
+         suc m + length qs ∎  where open ≤-Reasoning
      fdup+1 : (qs : List (Fin (suc n))) (i : Fin n) → fin-dup-in-list i (list-less qs) ≡ true → fin-dup-in-list (fin+1 i) qs ≡ true 
      fdup+1 qs i p = f1-phase1 qs p where
           f1-phase2 : (qs : List (Fin (suc n)) ) → fin-phase2 i (list-less qs) ≡ true → fin-phase2 (fin+1 i) qs ≡ true 
           f1-phase2 (x ∷ qs) p with <-fcmp (fin+1 i) x
-          ... | tri< a ¬b ¬c = f1-phase2 qs {!!} -- fin-phase2 i (list-less (x ∷ qs)) ≡ true
+          ... | tri< a ¬b ¬c = f1-phase2 qs {!!} -- fin-phase2 i (list-less (x ∷ qs)) ≡ true → fin-phase2 i (list-less qs) ≡ true
           ... | tri≈ ¬a b ¬c = refl
           ... | tri> ¬a ¬b c = f1-phase2 qs {!!}
           f1-phase1 : (qs : List (Fin (suc n)) ) → fin-phase1 i (list-less qs) ≡ true → fin-phase1 (fin+1 i) qs ≡ true 
@@ -171,21 +191,21 @@
          → ( fin-phase2 (fromℕ< a<sa ) qs ≡ true )  ∨ NList n m qs
      fdup-phase2 [] {m} lt = case2  record { ls = [] ; lseq = refl ; ls>n = lt }
      fdup-phase2 (x ∷ qs) {m} lt with <-fcmp (fromℕ< a<sa) x
-     ... | tri< a ¬b ¬c = {!!}
+     ... | tri< a ¬b ¬c = ⊥-elim ( nat-≤> a (subst (λ k → toℕ x < suc k) (sym fin<asa) fin<n ))
      fdup-phase2 (x ∷ qs) {m} lt | tri≈ ¬a b ¬c = case1 refl
-     fdup-phase2 (x ∷ qs) {m} lt | tri> ¬a ¬b c with fdup-phase2 qs {suc m} {!!}
+     fdup-phase2 (x ∷ qs) {m} lt | tri> ¬a ¬b c with fdup-phase2 qs {suc m} (lt-conv qs lt)
      ... | case1 p = case1 p
-     ... | case2 nlist = case2 record { ls = {!!} ∷ NList.ls nlist ; lseq = {!!} ; ls>n = {!!} }
+     ... | case2 nlist = case2 record { ls = x<y→fin-1 c ∷ NList.ls nlist ; lseq = {!!} ; ls>n = {!!} }
      fdup-phase1 : (qs : List (Fin (suc n)) ) → {m : ℕ} → m + length qs > n → (fin-phase1  (fromℕ< a<sa) qs ≡ true)  ∨ NList n m qs
      fdup-phase1 [] {m} lt = case2  record { ls = [] ; lseq = refl ; ls>n = lt }
      fdup-phase1 (x ∷ qs) {m} lt with  <-fcmp (fromℕ< a<sa) x
-     fdup-phase1 (x ∷ qs) {m} lt | tri< a ¬b ¬c = ⊥-elim ( nat-≤> a {!!} )
-     fdup-phase1 (x ∷ qs) {m} lt | tri≈ ¬a b ¬c with fdup-phase2 qs {m} {!!}
+     fdup-phase1 (x ∷ qs) {m} lt | tri< a ¬b ¬c = ⊥-elim ( nat-≤> a (subst (λ k → toℕ x < suc k) (sym fin<asa) fin<n ))
+     fdup-phase1 (x ∷ qs) {m} lt | tri≈ ¬a b ¬c with fdup-phase2 qs {m} ?
      ... | case1 p = case1 p
-     ... | case2 nlist = case2 record { ls = {!!} ∷ NList.ls nlist ; lseq = {!!} ; ls>n = {!!} }
+     ... | case2 nlist = case2 record { ls = NList.ls nlist ; lseq = {!!} ; ls>n = NList.ls>n nlist }
      fdup-phase1 (x ∷ qs) {m} lt | tri> ¬a ¬b c with fdup-phase1 qs {m} {!!}
      ... | case1 p = case1 p
-     ... | case2 nlist = case2 record { ls = {!!} ∷ NList.ls nlist ; lseq = {!!} ; ls>n = {!!} }
+     ... | case2 nlist = case2 record { ls = x<y→fin-1 c ∷ NList.ls nlist ; lseq = {!!} ; ls>n = {!!} }
      fdup-phase0 : FDup-in-list (suc n) qs 
      fdup-phase0 with fdup-phase1 qs {0} ( <-trans a<sa lt ) 
      ... | case1 dup   = record { dup =  fromℕ< a<sa ; is-dup = dup }