changeset 267:ae70f96cb60c

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Thu, 25 Nov 2021 08:48:41 +0900
parents e5cf49902db3
children 8006cbd87b20
files automaton-in-agda/src/automaton-ex.agda automaton-in-agda/src/nfa.agda automaton-in-agda/src/regular-language.agda
diffstat 3 files changed, 83 insertions(+), 12 deletions(-) [+]
line wrap: on
line diff
--- a/automaton-in-agda/src/automaton-ex.agda	Wed Nov 17 16:12:30 2021 +0900
+++ b/automaton-in-agda/src/automaton-ex.agda	Thu Nov 25 08:48:41 2021 +0900
@@ -1,3 +1,4 @@
+{-# OPTIONS --allow-unsolved-metas #-}
 module automaton-ex where
 
 open import Data.Nat
--- a/automaton-in-agda/src/nfa.agda	Wed Nov 17 16:12:30 2021 +0900
+++ b/automaton-in-agda/src/nfa.agda	Thu Nov 25 08:48:41 2021 +0900
@@ -5,7 +5,7 @@
 open import Data.Nat
 open import Data.List
 open import Data.Fin hiding ( _<_ )
-open import Data.Maybe
+open import Data.Maybe hiding ( zip )
 open import Relation.Nullary
 open import Data.Empty
 -- open import Data.Bool using ( Bool ; true ; false ; _∧_ ; _∨_ )
@@ -39,7 +39,7 @@
 existsS1 qs = qs sr \/ qs ss \/ qs st
 
 -- extract list of q which qs q is true
-to-listS1 : ( States1 → Bool ) → List States1            
+to-listS1 : ( States1 → Bool ) → List States1
 to-listS1 qs = ss1 LStates1 where
    ss1 : List States1 → List States1
    ss1 [] = []
@@ -150,3 +150,65 @@
 dexample4-1 = accept am2def start1 ( i0  ∷ i1  ∷ i1  ∷ i0 ∷ [] ) 
 texample4-1 = trace am2def start1 ( i0  ∷ i1  ∷ i1  ∷ i0 ∷ [] ) 
 
+-- LStates1 contains all states in States1
+
+-- a list of Q contains (q : Q)
+
+eqState1? : (x y : States1)  →  Dec ( x ≡ y )
+eqState1? sr sr = yes refl
+eqState1? ss ss = yes refl
+eqState1? st st = yes refl
+eqState1? sr ss = no (λ ())
+eqState1? sr st = no (λ ())
+eqState1? ss sr = no (λ ())
+eqState1? ss st = no (λ ())
+eqState1? st sr = no (λ ())
+eqState1? st ss = no (λ ())
+
+
+list-contains  : {Q : Set} → ( (x y : Q ) → Dec ( x ≡ y ) ) → (qs : List Q) → (q : Q ) → Bool
+list-contains {Q} eq? [] q = false
+list-contains {Q} eq? (x ∷ qs) q with eq? x q
+... | yes _  = true
+... | no _  = list-contains eq? qs q
+
+containsP : {Q : Set} → ( eq? : (x y : Q ) →  Dec ( x ≡ y ))  → (qs : List Q) → (q : Q ) → Set 
+containsP eq? qs q = list-contains eq? qs q ≡ true
+
+module All (Q : Set)  (eq? : (x y : Q ) →  Dec ( x ≡ y )) (all : List Q ) (is-all : (q : Q ) → containsP eq? all q)  where
+
+    -- foldr : (A → B → B) → B → List A → B
+    -- foldr c n []       = n
+    -- foldr c n (x ∷ xs) = c x (foldr c n xs)
+
+    ssQ : ( qs : Q → Bool ) → List Q → List Q
+    ssQ qs [] = []
+    ssQ qs (x ∷ t) with qs x
+    ... | true   = x ∷ ssQ qs t
+    ... | false  = ssQ qs t 
+
+    to-listQ : ( qs : Q → Bool ) → List Q
+    to-listQ qs = ssQ qs all 
+
+    bool-t1 : {b : Bool } → b ≡ true → (true /\ b)  ≡ true
+    bool-t1 refl = refl
+
+    bool-1t : {b : Bool } → b ≡ true → (b /\ true)  ≡ true
+    bool-1t refl = refl
+
+    to-listS2 : ( qs : Q → Bool ) → foldr (λ q x → qs q /\ x ) true (to-listQ qs) ≡ true
+    to-listS2 qs = to-list1 all where
+        to-list1 : (all : List Q) →  foldr (λ q x → qs q /\ x ) true (ssQ  qs all ) ≡ true
+        to-list1 []  = refl
+        to-list1 (x ∷ all)  with qs x  | inspect qs x
+        ... | false | record { eq = eq } = to-list1 all 
+        ... | true  | record { eq = eq } = subst (λ k → k /\ foldr (λ q → _/\_ (qs q)) true (ssQ qs all) ≡ true ) (sym eq) ( bool-t1 (to-list1 all) )
+
+    existsS1-valid : ¬ ( (qs : States1 → Bool ) →  ( existsS1 qs ≡ true ) )
+    existsS1-valid n = ¬-bool refl ( n ( λ x → false ))
+
+contains-all : (q : States1 ) → containsP eqState1? LStates1 q 
+contains-all sr = refl
+contains-all ss = refl
+contains-all st = refl
+
--- a/automaton-in-agda/src/regular-language.agda	Wed Nov 17 16:12:30 2021 +0900
+++ b/automaton-in-agda/src/regular-language.agda	Thu Nov 25 08:48:41 2021 +0900
@@ -20,16 +20,6 @@
 language-L : { Σ : Set } → Set
 language-L {Σ} = List (List Σ)
 
-open Automaton
-
-record RegularLanguage ( Σ : Set ) : Set (Suc Zero) where
-   field
-      states : Set 
-      astart : states 
-      automaton : Automaton states Σ
-   contain : List Σ → Bool
-   contain x = accept automaton astart x
-
 Union : {Σ : Set} → ( A B : language {Σ} ) → language {Σ}
 Union {Σ} A B x = (A x ) \/ (B x)
 
@@ -60,9 +50,27 @@
 star-nil : {Σ : Set} → ( A : language {Σ} ) → Star A [] ≡ true
 star-nil A = refl
 
+open Automaton
+
+record RegularLanguage ( Σ : Set ) : Set (Suc Zero) where
+   field
+      states : Set 
+      astart : states 
+      automaton : Automaton states Σ
+   contain : List Σ → Bool
+   contain x = accept automaton astart x
+
+RegularLanguage-is-language : { Σ : Set } → RegularLanguage Σ  → language {Σ} 
+RegularLanguage-is-language {Σ} R = RegularLanguage.contain R 
+
+RegularLanguage-is-language' : { Σ : Set } → RegularLanguage Σ  → List Σ  → Bool
+RegularLanguage-is-language' {Σ} R x = accept (automaton R) (astart R) x where
+   open RegularLanguage
+
 open RegularLanguage 
 isRegular : {Σ : Set} → (A : language {Σ} ) → ( x : List Σ ) → (r : RegularLanguage Σ ) → Set
 isRegular A x r = A x ≡ contain r x 
+--  a language is implemented by an automaton
 
 -- postulate 
 --   fin-× : {A B : Set} → { a b : ℕ } → FiniteSet A {a} → FiniteSet B {b} → FiniteSet (A × B) {a * b}