# HG changeset patch # User Shinji KONO # Date 1623584717 -32400 # Node ID 3fa72793620b7cec4ae3fcecbd44a134f228cd61 # Parent 567754463810cca755b8931fbceffe79a824e66c fix diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/automaton-ex.agda --- a/automaton-in-agda/src/agda/automaton-ex.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,76 +0,0 @@ -module automaton-ex where - -open import Data.Nat -open import Data.List -open import Data.Maybe -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import Relation.Nullary using (¬_; Dec; yes; no) -open import logic - -open import automaton -open Automaton - -data StatesQ : Set where - q1 : StatesQ - q2 : StatesQ - q3 : StatesQ - -data In2 : Set where - i0 : In2 - i1 : In2 -transitionQ : StatesQ → In2 → StatesQ -transitionQ q1 i0 = q1 -transitionQ q1 i1 = q2 -transitionQ q2 i0 = q3 -transitionQ q2 i1 = q2 -transitionQ q3 i0 = q2 -transitionQ q3 i1 = q2 - -aendQ : StatesQ → Bool -aendQ q2 = true -aendQ _ = false - -a1 : Automaton StatesQ In2 -a1 = record { - δ = transitionQ - ; aend = aendQ - } - -test1 : accept a1 q1 ( i0 ∷ i1 ∷ i0 ∷ [] ) ≡ false -test1 = refl -test2 = accept a1 q1 ( i0 ∷ i1 ∷ i0 ∷ i1 ∷ [] ) - -data States1 : Set where - sr : States1 - ss : States1 - st : States1 - -transition1 : States1 → In2 → States1 -transition1 sr i0 = sr -transition1 sr i1 = ss -transition1 ss i0 = sr -transition1 ss i1 = st -transition1 st i0 = sr -transition1 st i1 = st - -fin1 : States1 → Bool -fin1 st = true -fin1 ss = false -fin1 sr = false - -am1 : Automaton States1 In2 -am1 = record { δ = transition1 ; aend = fin1 } - - -example1-1 = accept am1 sr ( i0 ∷ i1 ∷ i0 ∷ [] ) -example1-2 = accept am1 sr ( i1 ∷ i1 ∷ i1 ∷ [] ) -trace-2 = trace am1 sr ( i1 ∷ i1 ∷ i1 ∷ [] ) - -example1-3 = reachable am1 sr st ( i1 ∷ i1 ∷ i1 ∷ [] ) - -ieq : (i i' : In2 ) → Dec ( i ≡ i' ) -ieq i0 i0 = yes refl -ieq i1 i1 = yes refl -ieq i0 i1 = no ( λ () ) -ieq i1 i0 = no ( λ () ) - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/automaton.agda --- a/automaton-in-agda/src/agda/automaton.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,40 +0,0 @@ -module automaton where - -open import Data.Nat -open import Data.List -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import logic - -record Automaton ( Q : Set ) ( Σ : Set ) - : Set where - field - δ : Q → Σ → Q - aend : Q → Bool - -open Automaton - -accept : { Q : Set } { Σ : Set } - → Automaton Q Σ - → (astart : Q) - → List Σ → Bool -accept {Q} { Σ} M q [] = aend M q -accept {Q} { Σ} M q ( H ∷ T ) = accept M ( (δ M) q H ) T - -moves : { Q : Set } { Σ : Set } - → Automaton Q Σ - → Q → List Σ → Q -moves {Q} { Σ} M q [] = q -moves {Q} { Σ} M q ( H ∷ T ) = moves M ( δ M q H) T - -trace : { Q : Set } { Σ : Set } - → Automaton Q Σ - → Q → List Σ → List Q -trace {Q} { Σ} M q [] = q ∷ [] -trace {Q} { Σ} M q ( H ∷ T ) = q ∷ trace M ( (δ M) q H ) T - -reachable : { Q : Set } { Σ : Set } - → (M : Automaton Q Σ ) - → (astart q : Q ) - → (L : List Σ ) → Set -reachable M astart q L = moves M astart L ≡ q - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/bijection.agda --- a/automaton-in-agda/src/agda/bijection.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,180 +0,0 @@ -module bijection where - -open import Level renaming ( zero to Zero ; suc to Suc ) -open import Data.Nat -open import Data.Maybe -open import Data.List hiding ([_]) -open import Data.Nat.Properties -open import Relation.Nullary -open import Data.Empty -open import Data.Unit -open import Relation.Binary.Core hiding (_⇔_) -open import Relation.Binary.Definitions -open import Relation.Binary.PropositionalEquality - -open import logic - -record Bijection {n m : Level} (R : Set n) (S : Set m) : Set (n Level.⊔ m) where - field - fun← : S → R - fun→ : R → S - fiso← : (x : R) → fun← ( fun→ x ) ≡ x - fiso→ : (x : S ) → fun→ ( fun← x ) ≡ x - -injection : {n m : Level} (R : Set n) (S : Set m) (f : R → S ) → Set (n Level.⊔ m) -injection R S f = (x y : R) → f x ≡ f y → x ≡ y - -open Bijection - -b→injection0 : {n m : Level} (R : Set n) (S : Set m) → (b : Bijection R S) → injection R S (fun→ b) -b→injection0 R S b x y eq = begin - x - ≡⟨ sym ( fiso← b x ) ⟩ - fun← b ( fun→ b x ) - ≡⟨ cong (λ k → fun← b k ) eq ⟩ - fun← b ( fun→ b y ) - ≡⟨ fiso← b y ⟩ - y - ∎ where open ≡-Reasoning - -b→injection1 : {n m : Level} (R : Set n) (S : Set m) → (b : Bijection R S) → injection S R (fun← b) -b→injection1 R S b x y eq = trans ( sym ( fiso→ b x ) ) (trans ( cong (λ k → fun→ b k ) eq ) ( fiso→ b y )) - --- ¬ A = A → ⊥ - -diag : {S : Set } (b : Bijection ( S → Bool ) S) → S → Bool -diag b n = not (fun← b n n) - -diagonal : { S : Set } → ¬ Bijection ( S → Bool ) S -diagonal {S} b = diagn1 (fun→ b (diag b) ) refl where - diagn1 : (n : S ) → ¬ (fun→ b (diag b) ≡ n ) - diagn1 n dn = ¬t=f (diag b n ) ( begin - not (diag b n) - ≡⟨⟩ - not (not fun← b n n) - ≡⟨ cong (λ k → not (k n) ) (sym (fiso← b _)) ⟩ - not (fun← b (fun→ b (diag b)) n) - ≡⟨ cong (λ k → not (fun← b k n) ) dn ⟩ - not (fun← b n n) - ≡⟨⟩ - diag b n - ∎ ) where open ≡-Reasoning - -b1 : (b : Bijection ( ℕ → Bool ) ℕ) → ℕ -b1 b = fun→ b (diag b) - -b-iso : (b : Bijection ( ℕ → Bool ) ℕ) → fun← b (b1 b) ≡ (diag b) -b-iso b = fiso← b _ - -to1 : {n : Level} {R : Set n} → Bijection ℕ R → Bijection ℕ (⊤ ∨ R ) -to1 {n} {R} b = record { - fun← = to11 - ; fun→ = to12 - ; fiso← = to13 - ; fiso→ = to14 - } where - to11 : ⊤ ∨ R → ℕ - to11 (case1 tt) = 0 - to11 (case2 x) = suc ( fun← b x ) - to12 : ℕ → ⊤ ∨ R - to12 zero = case1 tt - to12 (suc n) = case2 ( fun→ b n) - to13 : (x : ℕ) → to11 (to12 x) ≡ x - to13 zero = refl - to13 (suc x) = cong suc (fiso← b x) - to14 : (x : ⊤ ∨ R) → to12 (to11 x) ≡ x - to14 (case1 x) = refl - to14 (case2 x) = cong case2 (fiso→ b x) - -open _∧_ - -open import nat - -open ≡-Reasoning - --- [] 0 --- 0 → 1 --- 1 → 2 --- 01 → 3 --- 11 → 4 --- ... --- -{-# TERMINATING #-} -LBℕ : Bijection ℕ ( List Bool ) -LBℕ = record { - fun← = λ x → lton x - ; fun→ = λ n → ntol n - ; fiso← = lbiso0 - ; fiso→ = lbisor - } where - lton1 : List Bool → ℕ - lton1 [] = 0 - lton1 (true ∷ t) = suc (lton1 t + lton1 t) - lton1 (false ∷ t) = lton1 t + lton1 t - lton : List Bool → ℕ - lton [] = 0 - lton x = suc (lton1 x) - ntol1 : ℕ → List Bool - ntol1 0 = [] - ntol1 (suc x) with div2 (suc x) - ... | ⟪ x1 , true ⟫ = true ∷ ntol1 x1 -- non terminating - ... | ⟪ x1 , false ⟫ = false ∷ ntol1 x1 - ntol : ℕ → List Bool - ntol 0 = [] - ntol 1 = false ∷ [] - ntol (suc n) = ntol1 n - xx : (x : ℕ ) → List Bool ∧ ℕ - xx x = ⟪ (ntol x) , lton ((ntol x)) ⟫ - add11 : (x1 : ℕ ) → suc x1 + suc x1 ≡ suc (suc (x1 + x1)) - add11 zero = refl - add11 (suc x) = cong (λ k → suc (suc k)) (trans (+-comm x _) (cong suc (+-comm _ x))) - add12 : (x1 x : ℕ ) → suc x1 + x ≡ x1 + suc x - add12 zero x = refl - add12 (suc x1) x = cong suc (add12 x1 x) - ---- div2-eq : (x : ℕ ) → div2-rev ( div2 x ) ≡ x - div20 : (x x1 : ℕ ) → div2 (suc x) ≡ ⟪ x1 , false ⟫ → x1 + x1 ≡ suc x - div20 x x1 eq = begin - x1 + x1 ≡⟨ cong (λ k → div2-rev k ) (sym eq) ⟩ - div2-rev (div2 (suc x)) ≡⟨ div2-eq _ ⟩ - suc x ∎ - 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 ∎ - lbiso1 : (x : ℕ) → suc (lton1 (ntol1 x)) ≡ suc x - lbiso1 zero = refl - lbiso1 (suc x) with div2 (suc x) | inspect div2 (suc x) - ... | ⟪ x1 , true ⟫ | record { eq = eq1 } = begin - suc (suc (lton1 (ntol1 x1) + lton1 (ntol1 x1))) ≡⟨ sym (add11 _) ⟩ - 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) ∎ - ... | ⟪ 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) ∎ - lbiso0 : (x : ℕ) → lton (ntol x) ≡ x - lbiso0 zero = refl - lbiso0 (suc zero) = refl - lbiso0 (suc (suc x)) = subst (λ k → k ≡ suc (suc x)) (hh x) ( lbiso1 (suc x)) where - hh : (x : ℕ ) → suc (lton1 (ntol1 (suc x))) ≡ lton (ntol (suc (suc x))) - hh x with div2 (suc x) - ... | ⟪ _ , true ⟫ = refl - ... | ⟪ _ , false ⟫ = refl - lbisor0 : (x : List Bool) → ntol1 (lton1 (true ∷ x)) ≡ true ∷ x - lbisor0 = {!!} - lbisor1 : (x : List Bool) → ntol1 (lton1 (false ∷ x)) ≡ false ∷ x - lbisor1 = {!!} - lbisor : (x : List Bool) → ntol (lton x) ≡ x - lbisor [] = refl - lbisor (false ∷ []) = refl - lbisor (true ∷ []) = refl - lbisor (false ∷ t) = trans {!!} ( lbisor1 t ) - lbisor (true ∷ t) = trans {!!} ( lbisor0 t ) - - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/cfg.agda --- a/automaton-in-agda/src/agda/cfg.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,134 +0,0 @@ -module cfg where - -open import Level renaming ( suc to succ ; zero to Zero ) -open import Data.Nat hiding ( _≟_ ) -open import Data.Fin -open import Data.Product -open import Data.List -open import Data.Maybe -open import Data.Bool using ( Bool ; true ; false ; _∧_ ; _∨_ ) -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import Relation.Nullary using (¬_; Dec; yes; no) --- open import Data.String - -open import nfa - -data IsTerm (Token : Set) : Set where - isTerm : Token → IsTerm Token - noTerm : IsTerm Token - -record CFGGrammer (Token Node : Set) : Set (succ Zero) where - field - cfg : Node → List ( List ( Node ) ) - cfgtop : Node - term? : Node → IsTerm Token - tokensz : ℕ - tokenid : Token → Fin tokensz - -open CFGGrammer - ------------------ --- --- CGF language --- ------------------ - -split : {Σ : Set} → (List Σ → Bool) - → ( List Σ → Bool) → List Σ → Bool -split x y [] = x [] ∧ y [] -split x y (h ∷ t) = (x [] ∧ y (h ∷ t)) ∨ - split (λ t1 → x ( h ∷ t1 )) (λ t2 → y t2 ) t - - -cfg-language0 : {Node Token : Set} → CFGGrammer Token Node → List (List Node ) → List Token → Bool - -{-# TERMINATING #-} -cfg-language2 : {Node Token : Set} → CFGGrammer Token Node → Node → List Token → Bool -cfg-language2 cg _ [] = false -cfg-language2 cg x (h1 ∷ [] ) with term? cg x -cfg-language2 cg x (h1 ∷ []) | isTerm t with tokenid cg h1 ≟ tokenid cg t -cfg-language2 cg x (h1 ∷ []) | isTerm t | yes p = true -cfg-language2 cg x (h1 ∷ []) | isTerm t | no ¬p = false -cfg-language2 cg x (h1 ∷ []) | noTerm = cfg-language0 cg (cfg cg x) ( h1 ∷ [] ) -cfg-language2 cg x In with term? cg x -cfg-language2 cg x In | isTerm t = false -cfg-language2 cg x In | noTerm = cfg-language0 cg (cfg cg x ) In - -cfg-language1 : {Node Token : Set} → CFGGrammer Token Node → List Node → List Token → Bool -cfg-language1 cg [] [] = true -cfg-language1 cg [] _ = false -cfg-language1 cg (node ∷ T) = split ( cfg-language2 cg node ) ( cfg-language1 cg T ) - -cfg-language0 cg [] [] = true -cfg-language0 cg [] _ = false -cfg-language0 cg (node ∷ T) In = cfg-language1 cg node In ∨ cfg-language0 cg T In - -cfg-language : {Node Token : Set} → CFGGrammer Token Node → List Token → Bool -cfg-language cg = cfg-language0 cg (cfg cg (cfgtop cg)) - ------------------ - -data IFToken : Set where - t:EA : IFToken - t:EB : IFToken - t:EC : IFToken - t:IF : IFToken - t:THEN : IFToken - t:ELSE : IFToken - t:SA : IFToken - t:SB : IFToken - t:SC : IFToken - -IFtokenid : IFToken → Fin 9 -IFtokenid t:EA = # 0 -IFtokenid t:EB = # 1 -IFtokenid t:EC = # 2 -IFtokenid t:IF = # 3 -IFtokenid t:THEN = # 4 -IFtokenid t:ELSE = # 5 -IFtokenid t:SA = # 6 -IFtokenid t:SB = # 7 -IFtokenid t:SC = # 8 - -data IFNode (T : Set) : Set where - Token : T → IFNode T - expr : IFNode T - statement : IFNode T - -IFGrammer : CFGGrammer IFToken (IFNode IFToken) -IFGrammer = record { - cfg = cfg' - ; cfgtop = statement - ; term? = term?' - ; tokensz = 9 - ; tokenid = IFtokenid - } where - term?' : IFNode IFToken → IsTerm IFToken - term?' (Token x) = isTerm x - term?' _ = noTerm - cfg' : IFNode IFToken → List ( List (IFNode IFToken) ) - cfg' (Token t) = ( (Token t) ∷ [] ) ∷ [] - cfg' expr = ( Token t:EA ∷ [] ) ∷ - ( Token t:EB ∷ [] ) ∷ - ( Token t:EC ∷ [] ) ∷ [] - cfg' statement = ( Token t:SA ∷ [] ) ∷ - ( Token t:SB ∷ [] ) ∷ - ( Token t:SC ∷ [] ) ∷ - ( Token t:IF ∷ expr ∷ statement ∷ [] ) ∷ - ( Token t:IF ∷ expr ∷ statement ∷ Token t:ELSE ∷ statement ∷ [] ) ∷ [] - - -cfgtest1 = cfg-language IFGrammer ( t:SA ∷ [] ) - -cfgtest2 = cfg-language2 IFGrammer (Token t:SA) ( t:SA ∷ [] ) - -cfgtest3 = cfg-language1 IFGrammer (Token t:SA ∷ [] ) ( t:SA ∷ [] ) - -cfgtest4 = cfg-language IFGrammer (t:IF ∷ t:EA ∷ t:SA ∷ [] ) - -cfgtest5 = cfg-language1 IFGrammer (Token t:IF ∷ expr ∷ statement ∷ []) (t:IF ∷ t:EA ∷ t:EA ∷ [] ) -cfgtest6 = cfg-language2 IFGrammer statement (t:IF ∷ t:EA ∷ t:SA ∷ [] ) -cfgtest7 = cfg-language1 IFGrammer (Token t:IF ∷ expr ∷ statement ∷ Token t:ELSE ∷ statement ∷ []) (t:IF ∷ t:EA ∷ t:SA ∷ t:ELSE ∷ t:SB ∷ [] ) - -cfgtest8 = cfg-language IFGrammer (t:IF ∷ t:EA ∷ t:IF ∷ t:EB ∷ t:SA ∷ t:ELSE ∷ t:SB ∷ [] ) - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/cfg1.agda --- a/automaton-in-agda/src/agda/cfg1.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,184 +0,0 @@ -module cfg1 where - -open import Level renaming ( suc to succ ; zero to Zero ) -open import Data.Nat hiding ( _≟_ ) -open import Data.Fin -open import Data.Product -open import Data.List -open import Data.Maybe -open import Data.Bool using ( Bool ; true ; false ; _∧_ ; _∨_ ) -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import Relation.Nullary using (¬_; Dec; yes; no) - --- --- Java → Java Byte Code --- --- CFG Stack Machine (PDA) --- - - -data Node (Symbol : Set) : Set where - T : Symbol → Node Symbol - N : Symbol → Node Symbol - -data Seq (Symbol : Set) : Set where - _，_ : Symbol → Seq Symbol → Seq Symbol - _． : Symbol → Seq Symbol - Error : Seq Symbol - -data Body (Symbol : Set) : Set where - _｜_ : Seq Symbol → Body Symbol → Body Symbol - _； : Seq Symbol → Body Symbol - -record CFGGrammer (Symbol : Set) : Set where - field - cfg : Symbol → Body Symbol - top : Symbol - eq? : Symbol → Symbol → Bool - typeof : Symbol → Node Symbol - -infixr 80 _｜_ -infixr 90 _； -infixr 100 _，_ -infixr 110 _． - -open CFGGrammer - ------------------ --- --- CGF language --- ------------------ - -split : {Σ : Set} → (List Σ → Bool) - → ( List Σ → Bool) → List Σ → Bool -split x y [] = x [] ∧ y [] -split x y (h ∷ t) = (x [] ∧ y (h ∷ t)) ∨ - split (λ t1 → x ( h ∷ t1 )) (λ t2 → y t2 ) t - - -cfg-language0 : {Symbol : Set} → CFGGrammer Symbol → Body Symbol → List Symbol → Bool - -{-# TERMINATING #-} -cfg-language1 : {Symbol : Set} → CFGGrammer Symbol → Seq Symbol → List Symbol → Bool -cfg-language1 cg Error x = false -cfg-language1 cg (S ， seq) x with typeof cg S -cfg-language1 cg (_ ， seq) (x' ∷ t) | T x = eq? cg x x' ∧ cfg-language1 cg seq t -cfg-language1 cg (_ ， seq) [] | T x = false -cfg-language1 cg (_ ， seq) x | N nonTerminal = split (cfg-language0 cg (cfg cg nonTerminal) )(cfg-language1 cg seq ) x -cfg-language1 cg (S ．) x with typeof cg S -cfg-language1 cg (_ ．) (x' ∷ []) | T x = eq? cg x x' -cfg-language1 cg (_ ．) _ | T x = false -cfg-language1 cg (_ ．) x | N nonTerminal = cfg-language0 cg (cfg cg nonTerminal) x - -cfg-language0 cg _ [] = false -cfg-language0 cg (rule ｜ b) x = - cfg-language1 cg rule x ∨ cfg-language0 cg b x -cfg-language0 cg (rule ；) x = cfg-language1 cg rule x - -cfg-language : {Symbol : Set} → CFGGrammer Symbol → List Symbol → Bool -cfg-language cg = cfg-language0 cg (cfg cg (top cg )) - - -data IFToken : Set where - EA : IFToken - EB : IFToken - EC : IFToken - IF : IFToken - THEN : IFToken - ELSE : IFToken - SA : IFToken - SB : IFToken - SC : IFToken - expr : IFToken - statement : IFToken - -token-eq? : IFToken → IFToken → Bool -token-eq? EA EA = true -token-eq? EB EB = true -token-eq? EC EC = true -token-eq? IF IF = true -token-eq? THEN THEN = true -token-eq? ELSE ELSE = true -token-eq? SA SA = true -token-eq? SB SB = true -token-eq? SC SC = true -token-eq? expr expr = true -token-eq? statement statement = true -token-eq? _ _ = false - -typeof-IFG : IFToken → Node IFToken -typeof-IFG expr = N expr -typeof-IFG statement = N statement -typeof-IFG x = T x - -IFGrammer : CFGGrammer IFToken -IFGrammer = record { - cfg = cfg' - ; top = statement - ; eq? = token-eq? - ; typeof = typeof-IFG - } where - cfg' : IFToken → Body IFToken - cfg' expr = EA ． ｜ EB ． ｜ EC ． ； - cfg' statement = - SA ． ｜ SB ． ｜ SC ． - ｜ IF ， expr ， THEN ， statement ． - ｜ IF ， expr ， THEN ， statement ， ELSE ， statement ． - ； - cfg' x = Error ； - -cfgtest1 = cfg-language IFGrammer ( SA ∷ [] ) - -cfgtest2 = cfg-language1 IFGrammer ( SA ．) ( SA ∷ [] ) - -cfgtest3 = cfg-language1 IFGrammer ( SA ． ) ( SA ∷ [] ) - -cfgtest4 = cfg-language IFGrammer (IF ∷ EA ∷ THEN ∷ SA ∷ [] ) - -cfgtest5 = cfg-language1 IFGrammer ( IF ， expr ， THEN ， statement ． ) (IF ∷ EA ∷ THEN ∷ SA ∷ [] ) -cfgtest6 = cfg-language1 IFGrammer ( statement ．)(IF ∷ EA ∷ SA ∷ [] ) -cfgtest7 = cfg-language1 IFGrammer ( IF ， expr ， THEN ， statement ， ELSE ， statement ． ) - (IF ∷ EA ∷ THEN ∷ SA ∷ ELSE ∷ SB ∷ [] ) -cfgtest8 = cfg-language IFGrammer (IF ∷ EA ∷ THEN ∷ IF ∷ EB ∷ THEN ∷ SA ∷ ELSE ∷ SB ∷ [] ) -cfgtest9 = cfg-language IFGrammer (IF ∷ EB ∷ THEN ∷ SA ∷ ELSE ∷ SB ∷ [] ) - -data E1Token : Set where - e1 : E1Token - e[ : E1Token - e] : E1Token - expr : E1Token - term : E1Token - -E1-token-eq? : E1Token → E1Token → Bool -E1-token-eq? e1 e1 = true -E1-token-eq? e[ e] = true -E1-token-eq? e] e] = true -E1-token-eq? expr expr = true -E1-token-eq? term term = true -E1-token-eq? _ _ = false - -typeof-E1 : E1Token → Node E1Token -typeof-E1 expr = N expr -typeof-E1 term = N term -typeof-E1 x = T x - -E1Grammer : CFGGrammer E1Token -E1Grammer = record { - cfg = cfgE - ; top = expr - ; eq? = E1-token-eq? - ; typeof = typeof-E1 - } where - cfgE : E1Token → Body E1Token - cfgE expr = term ． - ； - cfgE term = e1 ． - ｜ e[ ， expr ， e] ． - ； - cfgE x = Error ； - -ecfgtest1 = cfg-language E1Grammer ( e1 ∷ [] ) -ecfgtest2 = cfg-language E1Grammer ( e[ ∷ e1 ∷ e] ∷ [] ) -ecfgtest3 = cfg-language E1Grammer ( e[ ∷ e[ ∷ e1 ∷ e] ∷ e] ∷ [] ) - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/chap0.agda --- a/automaton-in-agda/src/agda/chap0.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,210 +0,0 @@ -module chap0 where - -open import Data.List -open import Data.Nat hiding (_⊔_) --- open import Data.Integer hiding (_⊔_ ; _≟_ ; _+_ ) -open import Data.Product - -A : List ℕ -A = 1 ∷ 2 ∷ [] - -data Literal : Set where - x : Literal - y : Literal - z : Literal - -B : List Literal -B = x ∷ y ∷ z ∷ [] - - -ListProduct : {A B : Set } → List A → List B → List ( A × B ) -ListProduct = {!!} - -ex05 : List ( ℕ × Literal ) -ex05 = ListProduct A B -- (1 , x) ∷ (1 , y) ∷ (1 , z) ∷ (2 , x) ∷ (2 , y) ∷ (2 , z) ∷ [] - -ex06 : List ( ℕ × Literal × ℕ ) -ex06 = ListProduct A (ListProduct B A) - -ex07 : Set -ex07 = ℕ × ℕ - -data ex08-f : ℕ → ℕ → Set where - ex08f0 : ex08-f 0 1 - ex08f1 : ex08-f 1 2 - ex08f2 : ex08-f 2 3 - ex08f3 : ex08-f 3 4 - ex08f4 : ex08-f 4 0 - -data ex09-g : ℕ → ℕ → ℕ → ℕ → Set where - ex09g0 : ex09-g 0 1 2 3 - ex09g1 : ex09-g 1 2 3 0 - ex09g2 : ex09-g 2 3 0 1 - ex09g3 : ex09-g 3 0 1 2 - -open import Data.Nat.DivMod -open import Relation.Binary.PropositionalEquality -open import Relation.Binary.Core -open import Data.Nat.Properties - --- _%_ : ℕ → ℕ → ℕ --- _%_ a b with <-cmp a b --- _%_ a b | tri< a₁ ¬b ¬c = a --- _%_ a b | tri≈ ¬a b₁ ¬c = 0 --- _%_ a b | tri> ¬a ¬b c = _%_ (a - b) b - -_≡7_ : ℕ → ℕ → Set -n ≡7 m = (n % 7) ≡ (m % 7 ) - -refl7 : { n : ℕ} → n ≡7 n -refl7 = {!!} - -sym7 : { n m : ℕ} → n ≡7 m → m ≡7 n -sym7 = {!!} - -trans7 : { n m o : ℕ} → n ≡7 m → m ≡7 o → n ≡7 o -trans7 = {!!} - -open import Level renaming ( zero to Zero ; suc to Suc ) - -record Graph { v v' : Level } : Set (Suc v ⊔ Suc v' ) where - field - vertex : Set v - edge : vertex → vertex → Set v' - -open Graph - --- open import Data.Fin hiding ( _≟_ ) -open import Data.Empty -open import Relation.Nullary -open import Data.Unit hiding ( _≟_ ) - - --- data Dec (P : Set) : Set where --- yes : P → Dec P --- no : ¬ P → Dec P --- --- _≟_ : (s t : ℕ ) → Dec ( s ≡ t ) - --- ¬ A = A → ⊥ - -_n≟_ : (s t : ℕ ) → Dec ( s ≡ t ) -zero n≟ zero = yes refl -zero n≟ suc t = no (λ ()) -suc s n≟ zero = no (λ ()) -suc s n≟ suc t with s n≟ t -... | yes refl = yes refl -... | no n = no (λ k → n (tt1 k) ) where - tt1 : suc s ≡ suc t → s ≡ t - tt1 refl = refl - -open import Data.Bool hiding ( _≟_ ) - -conn : List ( ℕ × ℕ ) → ℕ → ℕ → Bool -conn [] _ _ = false -conn ((n1 , m1 ) ∷ t ) n m with n ≟ n1 | m ≟ m1 -conn ((n1 , m1) ∷ t) n m | yes refl | yes refl = true -conn ((n1 , m1) ∷ t) n m | _ | _ = conn t n m - -list012a : List ( ℕ × ℕ ) -list012a = (1 , 2) ∷ (2 , 3) ∷ (3 , 4) ∷ (4 , 5) ∷ (5 , 1) ∷ [] - -graph012a : Graph {Zero} {Zero} -graph012a = record { vertex = ℕ ; edge = λ s t → (conn list012a s t) ≡ true } - -data edge012b : ℕ → ℕ → Set where - e012b-1 : edge012b 1 2 - e012b-2 : edge012b 1 3 - e012b-3 : edge012b 1 4 - e012b-4 : edge012b 2 3 - e012b-5 : edge012b 2 4 - e012b-6 : edge012b 3 4 - -edge? : (E : ℕ → ℕ → Set) → ( a b : ℕ ) → Set -edge? E a b = Dec ( E a b ) - -lemma3 : ( a b : ℕ ) → edge? edge012b a b -lemma3 1 2 = yes e012b-1 -lemma3 1 3 = yes e012b-2 -lemma3 1 4 = yes e012b-3 -lemma3 2 3 = yes e012b-4 -lemma3 2 4 = yes e012b-5 -lemma3 3 4 = yes e012b-6 -lemma3 1 1 = no ( λ () ) -lemma3 2 1 = no ( λ () ) -lemma3 2 2 = no ( λ () ) -lemma3 3 1 = no ( λ () ) -lemma3 3 2 = no ( λ () ) -lemma3 3 3 = no ( λ () ) -lemma3 0 _ = no ( λ () ) -lemma3 _ 0 = no ( λ () ) -lemma3 _ (suc (suc (suc (suc (suc _))))) = no ( λ () ) -lemma3 (suc (suc (suc (suc _)))) _ = no ( λ () ) - -graph012b : Graph {Zero} {Zero} -graph012b = record { vertex = ℕ ; edge = edge012b } - -data connected { V : Set } ( E : V -> V -> Set ) ( x y : V ) : Set where - direct : E x y → connected E x y - indirect : ( z : V ) -> E x z → connected {V} E z y → connected E x y - -lemma1 : connected ( edge graph012a ) 1 2 -lemma1 = direct refl where - -lemma1-2 : connected ( edge graph012a ) 1 3 -lemma1-2 = indirect 2 refl (direct refl ) - -lemma2 : connected ( edge graph012b ) 1 2 -lemma2 = direct e012b-1 - -reachable : { V : Set } ( E : V -> V -> Set ) ( x y : V ) -> Set -reachable {V} E X Y = Dec ( connected {V} E X Y ) - -dag : { V : Set } ( E : V -> V -> Set ) -> Set -dag {V} E = ∀ (n : V) → ¬ ( connected E n n ) - -open import Function - -lemma4 : ¬ ( dag ( edge graph012a) ) -lemma4 neg = neg 1 $ indirect 2 refl $ indirect 3 refl $ indirect 4 refl $ indirect 5 refl $ direct refl - -dgree : List ( ℕ × ℕ ) → ℕ → ℕ -dgree [] _ = 0 -dgree ((e , e1) ∷ t) e0 with e0 ≟ e | e0 ≟ e1 -dgree ((e , e1) ∷ t) e0 | yes _ | _ = 1 + (dgree t e0) -dgree ((e , e1) ∷ t) e0 | _ | yes p = 1 + (dgree t e0) -dgree ((e , e1) ∷ t) e0 | no _ | no _ = dgree t e0 - -dgree-c : {t : Set} → List ( ℕ × ℕ ) → ℕ → (ℕ → t) → t -dgree-c {t} [] e0 next = next 0 -dgree-c {t} ((e , e1) ∷ tail ) e0 next with e0 ≟ e | e0 ≟ e1 -... | yes _ | _ = dgree-c tail e0 ( λ n → next (n + 1 )) -... | _ | yes _ = dgree-c tail e0 ( λ n → next (n + 1 )) -... | no _ | no _ = dgree-c tail e0 next - -lemma6 = dgree list012a 2 -lemma7 = dgree-c list012a 2 ( λ n → n ) - -even2 : (n : ℕ ) → n % 2 ≡ 0 → (n + 2) % 2 ≡ 0 -even2 0 refl = refl -even2 1 () -even2 (suc (suc n)) eq = trans ([a+n]%n≡a%n n _) eq -- [a+n]%n≡a%n : ∀ a n → (a + suc n) % suc n ≡ a % suc n - -sum-of-dgree : ( g : List ( ℕ × ℕ )) → ℕ -sum-of-dgree [] = 0 -sum-of-dgree ((e , e1) ∷ t) = 2 + sum-of-dgree t - -dgree-even : ( g : List ( ℕ × ℕ )) → sum-of-dgree g % 2 ≡ 0 -dgree-even [] = refl -dgree-even ((e , e1) ∷ t) = begin - sum-of-dgree ((e , e1) ∷ t) % 2 - ≡⟨⟩ - (2 + sum-of-dgree t ) % 2 - ≡⟨ cong ( λ k → k % 2 ) ( +-comm 2 (sum-of-dgree t) ) ⟩ - (sum-of-dgree t + 2) % 2 - ≡⟨ [a+n]%n≡a%n (sum-of-dgree t) _ ⟩ - sum-of-dgree t % 2 - ≡⟨ dgree-even t ⟩ - 0 - ∎ where open ≡-Reasoning - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/derive.agda --- a/automaton-in-agda/src/agda/derive.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,126 +0,0 @@ -{-# OPTIONS --allow-unsolved-metas #-} - -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import Relation.Nullary using (¬_; Dec; yes; no) -open import Data.List hiding ( [_] ) - -module derive ( Σ : Set) ( eq? : (x y : Σ) → Dec (x ≡ y)) where - --- open import nfa -open import Data.Nat --- open import Data.Nat hiding ( _<_ ; _>_ ) --- open import Data.Fin hiding ( _<_ ) - -open import finiteSet -open import FSetUtil -open import automaton -open import logic -open import regex - -empty? : Regex Σ → Bool -empty? ε = true -empty? φ = false -empty? (x *) = true -empty? (x & y) = empty? x /\ empty? y -empty? (x || y) = empty? x \/ empty? y -empty? < x > = false - -derivative0 : Regex Σ → Σ → Regex Σ -derivative0 ε s = φ -derivative0 φ s = φ -derivative0 (x *) s = derivative0 x s & (x *) -derivative0 (x & y) s with empty? x -... | true = (derivative0 x s & y) || derivative0 y s -... | false = derivative0 x s & y -derivative0 (x || y) s = derivative0 x s || derivative0 y s -derivative0 < x > s with eq? x s -... | yes _ = ε -... | no _ = φ - -derivative : Regex Σ → Σ → Regex Σ -derivative ε s = φ -derivative φ s = φ -derivative (x *) s with derivative x s -... | ε = x * -... | φ = φ -... | t = t & (x *) -derivative (x & y) s with empty? x -... | true with derivative x s | derivative y s -... | ε | φ = φ -... | ε | t = y || t -... | φ | t = t -... | x1 | φ = x1 & y -... | x1 | y1 = (x1 & y) || y1 -derivative (x & y) s | false with derivative x s -... | ε = y -... | φ = φ -... | t = t & y -derivative (x || y) s with derivative x s | derivative y s -... | φ | y1 = y1 -... | x1 | φ = x1 -... | x1 | y1 = x1 || y1 -derivative < x > s with eq? x s -... | yes _ = ε -... | no _ = φ - -data regex-states (x : Regex Σ ) : Regex Σ → Set where - unit : regex-states x x - derive : { y : Regex Σ } → regex-states x y → (s : Σ) → regex-states x ( derivative y s ) - -record Derivative (x : Regex Σ ) : Set where - field - state : Regex Σ - is-derived : regex-states x state - -open Derivative - -open import Data.Fin - --- derivative generates (x & y) || ... form. y and x part is a substerm of original regex --- since subterm is finite, only finite number of state is negerated, if we normalize ||-list. - -data subterm (r : Regex Σ) : Regex Σ → Set where - sε : subterm r ε - sφ : subterm r φ - orig : subterm r r - x& : {x y : Regex Σ } → subterm r (x & y) → subterm r x - &y : {x y : Regex Σ } → subterm r (x & y) → subterm r y - x| : {x y : Regex Σ } → subterm r (x || y) → subterm r x - |y : {x y : Regex Σ } → subterm r (x || y) → subterm r y - s* : {x : Regex Σ } → subterm r (x *) → subterm r x - s<_> : (s : Σ) → subterm r < s > → subterm r < s > - -record Subterm (r : Regex Σ) : Set where - field - subt : Regex Σ - is-subt : subterm r subt - -finsub : (r : Regex Σ ) → FiniteSet (Subterm r) -finsub ε = {!!} -finsub φ = {!!} -finsub (r *) = {!!} -finsub (r & r₁) = {!!} -finsub (r || r₁) = {!!} -finsub < x > = {!!} - -finsubList : (r : Regex Σ ) → FiniteSet (Subterm r ∧ Subterm r → Bool ) -finsubList r = fin→ ( fin-∧ (finsub r) (finsub r) ) - --- derivative is subset of Subterm r → Subterm r → Bool - -der2ssb : {r : Regex Σ } → Derivative r → Subterm r ∧ Subterm r → Bool -der2ssb = {!!} - --- we cannot say this, because Derivative is redundant --- der2inject : {r : Regex Σ } → (x y : Derivative r ) → ( ( s t : Subterm r ∧ Subterm r ) → der2ssb x s ≡ der2ssb y t ) → x ≡ y - --- this does not work, becuase it depends on input sequences --- finite-derivative : (r : Regex Σ) → FiniteSet Σ → FiniteSet (Derivative r) - --- in case of automaton, number of derivative is limited by iteration of input length, so it is finite. - -regex→automaton : (r : Regex Σ) → Automaton (Derivative r) Σ -regex→automaton r = record { δ = λ d s → record { state = derivative (state d) s ; is-derived = derive-step d s} ; aend = λ d → empty? (state d) } where - derive-step : (d0 : Derivative r) → (s : Σ) → regex-states r (derivative (state d0) s) - derive-step d0 s = derive (is-derived d0) s - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/even.agda --- a/automaton-in-agda/src/agda/even.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,71 +0,0 @@ -module even where - -open import Data.Nat -open import Data.Nat.Properties -open import Data.Empty -open import Data.Unit using (⊤ ; tt) -open import Relation.Nullary -open import Relation.Binary.PropositionalEquality -open import Relation.Binary.Definitions -open import nat -open import logic - -even : (n : ℕ ) → Set -even zero = ⊤ -even (suc zero) = ⊥ -even (suc (suc n)) = even n - -even? : (n : ℕ ) → Dec ( even n ) -even? zero = yes tt -even? (suc zero) = no (λ ()) -even? (suc (suc n)) = even? n - -n+even : {n m : ℕ } → even n → even m → even ( n + m ) -n+even {zero} {zero} tt tt = tt -n+even {zero} {suc m} tt em = em -n+even {suc (suc n)} {m} en em = n+even {n} {m} en em - -n*even : {m n : ℕ } → even n → even ( m * n ) -n*even {zero} {n} en = tt -n*even {suc m} {n} en = n+even {n} {m * n} en (n*even {m} {n} en) - -even*n : {n m : ℕ } → even n → even ( n * m ) -even*n {n} {m} en = subst even (*-comm m n) (n*even {m} {n} en) - - -record Even (i : ℕ) : Set where - field - j : ℕ - is-twice : i ≡ 2 * j - -e2 : (i : ℕ) → even i → Even i -e2 zero en = record { j = 0 ; is-twice = refl } -e2 (suc (suc i)) en = record { j = suc (Even.j (e2 i en )) ; is-twice = e21 } where - e21 : suc (suc i) ≡ 2 * suc (Even.j (e2 i en)) - e21 = begin - suc (suc i) ≡⟨ cong (λ k → suc (suc k)) (Even.is-twice (e2 i en)) ⟩ - suc (suc (2 * Even.j (e2 i en))) ≡⟨ sym (*-distribˡ-+ 2 1 _) ⟩ - 2 * suc (Even.j (e2 i en)) ∎ where open ≡-Reasoning - -record Odd (i : ℕ) : Set where - field - j : ℕ - is-twice : i ≡ suc (2 * j ) - -odd2 : (i : ℕ) → ¬ even i → even (suc i) -odd2 zero ne = ⊥-elim ( ne tt ) -odd2 (suc zero) ne = tt -odd2 (suc (suc i)) ne = odd2 i ne - -odd3 : (i : ℕ) → ¬ even i → Odd i -odd3 zero ne = ⊥-elim ( ne tt ) -odd3 (suc zero) ne = record { j = 0 ; is-twice = refl } -odd3 (suc (suc i)) ne = record { j = Even.j (e2 (suc i) (odd2 i ne)) ; is-twice = odd31 } where - odd31 : suc (suc i) ≡ suc (2 * Even.j (e2 (suc i) (odd2 i ne))) - odd31 = begin - suc (suc i) ≡⟨ cong suc (Even.is-twice (e2 (suc i) (odd2 i ne))) ⟩ - suc (2 * (Even.j (e2 (suc i) (odd2 i ne)))) ∎ where open ≡-Reasoning - -odd4 : (i : ℕ) → even i → ¬ even ( suc i ) -odd4 (suc (suc i)) en en1 = odd4 i en en1 - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/fin.agda --- a/automaton-in-agda/src/agda/fin.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,117 +0,0 @@ -{-# OPTIONS --allow-unsolved-metas #-} - -module fin where - -open import Data.Fin hiding (_<_ ; _≤_ ) -open import Data.Fin.Properties hiding ( <-trans ) -open import Data.Nat -open import logic -open import nat -open import Relation.Binary.PropositionalEquality - - --- toℕ 0 → Data.Nat.pred (toℕ f) < n -predn = ⊥-elim (nat-≤> i>n (fin ¬a ¬b c = ⊥-elim ( nat-≤> m ¬a ¬b c = j0 -gcd1 zero i0 (suc zero) j0 = 1 -gcd1 zero zero (suc (suc j)) j0 = j0 -gcd1 zero (suc i0) (suc (suc j)) j0 = gcd1 i0 (suc i0) (suc j) (suc (suc j)) -gcd1 (suc zero) i0 zero j0 = 1 -gcd1 (suc (suc i)) i0 zero zero = i0 -gcd1 (suc (suc i)) i0 zero (suc j0) = gcd1 (suc i) (suc (suc i)) j0 (suc j0) -gcd1 (suc i) i0 (suc j) j0 = gcd1 i i0 j j0 - -gcd : ( i j : ℕ ) → ℕ -gcd i j = gcd1 i i j j - -gcd-gt : ( i i0 j j0 k : ℕ ) → (if : Factor k i) (i0f : Factor k i0 ) (jf : Factor k i ) (j0f : Factor k j0) - → remain i0f ≡ 0 → remain j0f ≡ 0 - → (remain if + i ) ≡ i0 → (remain jf + j ) ≡ j0 - → Dividable k ( gcd1 i i0 j j0 ) -gcd-gt zero i0 zero j0 k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 with <-cmp i0 j0 -... | tri< a ¬b ¬c = record { factor = factor i0f ; is-factor = ifk0 i0 k i0f i0=0 } -... | tri≈ ¬a refl ¬c = record { factor = factor i0f ; is-factor = ifk0 i0 k i0f i0=0 } -... | tri> ¬a ¬b c = record { factor = factor j0f ; is-factor = ifk0 j0 k j0f j0=0 } -gcd-gt zero i0 (suc zero) j0 k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 = {!!} -- can't happen -gcd-gt zero zero (suc (suc j)) j0 k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 = record { factor = factor j0f ; is-factor = ifk0 j0 k j0f j0=0 } -gcd-gt zero (suc i0) (suc (suc j)) j0 k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 = - gcd-gt i0 (suc i0) (suc j) (suc (suc j)) k (decf i0f) i0f (decf i0f) - record { factor = factor jf ; remain = remain jf ; is-factor = {!!} } i0=0 {!!} {!!} {!!} -gcd-gt (suc zero) i0 zero j0 k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 = {!!} -- can't happen -gcd-gt (suc (suc i)) i0 zero zero k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 = {!!} -gcd-gt (suc (suc i)) i0 zero (suc j0) k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 = - gcd-gt (suc i) (suc (suc i)) j0 (suc j0) k (decf if) {!!} (decf jf) j0f j0=0 {!!} {!!} {!!} -gcd-gt (suc zero) i0 (suc j) j0 k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 = - gcd-gt zero i0 j j0 k (decf if) i0f (decf jf) j0f i0=0 j0=0 {!!} {!!} -gcd-gt (suc (suc i)) i0 (suc j) j0 k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 = - gcd-gt (suc i) i0 j j0 k (decf if) i0f (decf jf) j0f i0=0 j0=0 {!!} {!!} - --- gcd26 : { n m : ℕ} → n > 1 → m > 1 → n - m > 0 → gcd n m ≡ gcd (n - m) m --- gcd27 : { n m : ℕ} → n > 1 → m > 1 → n - m > 0 → gcd n k ≡ k → k ≤ n - -gcd22 : ( i i0 o o0 : ℕ ) → gcd1 (suc i) i0 (suc o) o0 ≡ gcd1 i i0 o o0 -gcd22 zero i0 zero o0 = refl -gcd22 zero i0 (suc o) o0 = refl -gcd22 (suc i) i0 zero o0 = refl -gcd22 (suc i) i0 (suc o) o0 = refl - -gcd20 : (i : ℕ) → gcd i 0 ≡ i -gcd20 zero = refl -gcd20 (suc i) = gcd201 (suc i) where - gcd201 : (i : ℕ ) → gcd1 i i zero zero ≡ i - gcd201 zero = refl - gcd201 (suc zero) = refl - gcd201 (suc (suc i)) = refl - -gcdmm : (n m : ℕ) → gcd1 n m n m ≡ m -gcdmm zero m with <-cmp m m -... | tri< a ¬b ¬c = refl -... | tri≈ ¬a refl ¬c = refl -... | tri> ¬a ¬b c = refl -gcdmm (suc n) m = subst (λ k → k ≡ m) (sym (gcd22 n m n m )) (gcdmm n m ) - -gcdsym2 : (i j : ℕ) → gcd1 zero i zero j ≡ gcd1 zero j zero i -gcdsym2 i j with <-cmp i j | <-cmp j i -... | tri< a ¬b ¬c | tri< a₁ ¬b₁ ¬c₁ = ⊥-elim (nat-<> a a₁) -... | tri< a ¬b ¬c | tri≈ ¬a b ¬c₁ = ⊥-elim (nat-≡< (sym b) a) -... | tri< a ¬b ¬c | tri> ¬a ¬b₁ c = refl -... | tri≈ ¬a b ¬c | tri< a ¬b ¬c₁ = ⊥-elim (nat-≡< (sym b) a) -... | tri≈ ¬a refl ¬c | tri≈ ¬a₁ refl ¬c₁ = refl -... | tri≈ ¬a b ¬c | tri> ¬a₁ ¬b c = ⊥-elim (nat-≡< b c) -... | tri> ¬a ¬b c | tri< a ¬b₁ ¬c = refl -... | tri> ¬a ¬b c | tri≈ ¬a₁ b ¬c = ⊥-elim (nat-≡< b c) -... | tri> ¬a ¬b c | tri> ¬a₁ ¬b₁ c₁ = ⊥-elim (nat-<> c c₁) -gcdsym1 : ( i i0 j j0 : ℕ ) → gcd1 i i0 j j0 ≡ gcd1 j j0 i i0 -gcdsym1 zero zero zero zero = refl -gcdsym1 zero zero zero (suc j0) = refl -gcdsym1 zero (suc i0) zero zero = refl -gcdsym1 zero (suc i0) zero (suc j0) = gcdsym2 (suc i0) (suc j0) -gcdsym1 zero zero (suc zero) j0 = refl -gcdsym1 zero zero (suc (suc j)) j0 = refl -gcdsym1 zero (suc i0) (suc zero) j0 = refl -gcdsym1 zero (suc i0) (suc (suc j)) j0 = gcdsym1 i0 (suc i0) (suc j) (suc (suc j)) -gcdsym1 (suc zero) i0 zero j0 = refl -gcdsym1 (suc (suc i)) i0 zero zero = refl -gcdsym1 (suc (suc i)) i0 zero (suc j0) = gcdsym1 (suc i) (suc (suc i))j0 (suc j0) -gcdsym1 (suc i) i0 (suc j) j0 = subst₂ (λ j k → j ≡ k ) (sym (gcd22 i _ _ _)) (sym (gcd22 j _ _ _)) (gcdsym1 i i0 j j0 ) - -gcdsym : { n m : ℕ} → gcd n m ≡ gcd m n -gcdsym {n} {m} = gcdsym1 n n m m - -gcd11 : ( i : ℕ ) → gcd i i ≡ i -gcd11 i = gcdmm i i - -gcd203 : (i : ℕ) → gcd1 (suc i) (suc i) i i ≡ 1 -gcd203 zero = refl -gcd203 (suc i) = gcd205 (suc i) where - gcd205 : (j : ℕ) → gcd1 (suc j) (suc (suc i)) j (suc i) ≡ 1 - gcd205 zero = refl - gcd205 (suc j) = subst (λ k → k ≡ 1) (gcd22 (suc j) (suc (suc i)) j (suc i)) (gcd205 j) -gcd204 : (i : ℕ) → gcd1 1 1 i i ≡ 1 -gcd204 zero = refl -gcd204 (suc zero) = refl -gcd204 (suc (suc zero)) = refl -gcd204 (suc (suc (suc i))) = gcd204 (suc (suc i)) - -gcd2 : ( i j : ℕ ) → gcd (i + j) j ≡ gcd i j -gcd2 i j = gcd200 i i j j refl refl where - gcd202 : (i j1 : ℕ) → (i + suc j1) ≡ suc (i + j1) - gcd202 zero j1 = refl - gcd202 (suc i) j1 = cong suc (gcd202 i j1) - gcd201 : (i i0 j j0 j1 : ℕ) → gcd1 (i + j1) (i0 + suc j) j1 j0 ≡ gcd1 i (i0 + suc j) zero j0 - gcd201 i i0 j j0 zero = subst (λ k → gcd1 k (i0 + suc j) zero j0 ≡ gcd1 i (i0 + suc j) zero j0 ) (+-comm zero i) refl - gcd201 i i0 j j0 (suc j1) = begin - gcd1 (i + suc j1) (i0 + suc j) (suc j1) j0 ≡⟨ cong (λ k → gcd1 k (i0 + suc j) (suc j1) j0 ) (gcd202 i j1) ⟩ - gcd1 (suc (i + j1)) (i0 + suc j) (suc j1) j0 ≡⟨ gcd22 (i + j1) (i0 + suc j) j1 j0 ⟩ - gcd1 (i + j1) (i0 + suc j) j1 j0 ≡⟨ gcd201 i i0 j j0 j1 ⟩ - gcd1 i (i0 + suc j) zero j0 ∎ where open ≡-Reasoning - gcd200 : (i i0 j j0 : ℕ) → i ≡ i0 → j ≡ j0 → gcd1 (i + j) (i0 + j) j j0 ≡ gcd1 i i j0 j0 - gcd200 i .i zero .0 refl refl = subst (λ k → gcd1 k k zero zero ≡ gcd1 i i zero zero ) (+-comm zero i) refl - gcd200 (suc (suc i)) i0 (suc j) (suc j0) i=i0 j=j0 = gcd201 (suc (suc i)) i0 j (suc j0) (suc j) - gcd200 zero zero (suc zero) .1 i=i0 refl = refl - gcd200 zero zero (suc (suc j)) .(suc (suc j)) i=i0 refl = begin - gcd1 (zero + suc (suc j)) (zero + suc (suc j)) (suc (suc j)) (suc (suc j)) ≡⟨ gcdmm (suc (suc j)) (suc (suc j)) ⟩ - suc (suc j) ≡⟨ sym (gcd20 (suc (suc j))) ⟩ - gcd1 zero zero (suc (suc j)) (suc (suc j)) ∎ where open ≡-Reasoning - gcd200 zero (suc i0) (suc j) .(suc j) () refl - gcd200 (suc zero) .1 (suc j) .(suc j) refl refl = begin - gcd1 (1 + suc j) (1 + suc j) (suc j) (suc j) ≡⟨ gcd203 (suc j) ⟩ - 1 ≡⟨ sym ( gcd204 (suc j)) ⟩ - gcd1 1 1 (suc j) (suc j) ∎ where open ≡-Reasoning - gcd200 (suc (suc i)) i0 (suc j) zero i=i0 () - -gcd52 : {i : ℕ } → 1 < suc (suc i) -gcd52 {zero} = a ¬a ¬b c = ≤-trans refl-≤s c -gcd50 zero (suc i0) (suc zero) j0 0 FSetUtil.agda
- automaton-ex.agda
- automaton.agda
- cfg.agda
- cfg1.agda
- chap0.agda
- derive.agda
- even.agda
- finiteSet.agda
- flcagl.agda
- gcd.agda
- halt.agda
- induction-ex.agda
- lang-text.agda
- logic.agda
- nat.agda
- nfa.agda
- nfa136.agda
- non-regular.agda
- omega-automaton.agda
- pushdown.agda
- puzzle.agda
- regex.agda
- regex1.agda
- regular-concat.agda
- regular-language.agda
- root2.agda
- sbconst2.agda
- turing.agda
- utm.agda
diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/induction-ex.agda --- a/automaton-in-agda/src/agda/induction-ex.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,118 +0,0 @@ -{-# OPTIONS --guardedness #-} -module induction-ex where - -open import Relation.Binary.PropositionalEquality -open import Size -open import Data.Bool - -data List (A : Set ) : Set where - [] : List A - _∷_ : A → List A → List A - -data Nat : Set where - zero : Nat - suc : Nat → Nat - -add : Nat → Nat → Nat -add zero x = x -add (suc x) y = suc ( add x y ) - -_++_ : {A : Set} → List A → List A → List A -[] ++ y = y -(x ∷ t) ++ y = x ∷ ( t ++ y ) - -test1 = (zero ∷ []) ++ (zero ∷ []) - -length : {A : Set } → List A → Nat -length [] = zero -length (_ ∷ t) = suc ( length t ) - -lemma1 : {A : Set} → (x y : List A ) → length ( x ++ y ) ≡ add (length x) (length y) -lemma1 [] y = refl -lemma1 (x ∷ t) y = cong ( λ k → suc k ) lemma2 where - lemma2 : length (t ++ y) ≡ add (length t) (length y) - lemma2 = lemma1 t y - --- record List1 ( A : Set ) : Set where --- inductive --- field --- nil : List1 A --- cons : A → List1 A → List1 A --- --- record List2 ( A : Set ) : Set where --- coinductive --- field --- nil : List2 A --- cons : A → List2 A → List2 A - -data SList (i : Size) (A : Set) : Set where - []' : SList i A - _∷'_ : {j : Size< i} (x : A) (xs : SList j A) → SList i A - - -map : ∀{i A B} → (A → B) → SList i A → SList i B -map f []' = []' -map f ( x ∷' xs)= f x ∷' map f xs - -foldr : ∀{i} {A B : Set} → (A → B → B) → B → SList i A → B -foldr c n []' = n -foldr c n (x ∷' xs) = c x (foldr c n xs) - -any : ∀{i A} → (A → Bool) → SList i A → Bool -any p xs = foldr _∨_ false (map p xs) - --- Sappend : {A : Set } {i j : Size } → SList i A → SList j A → SList {!!} A --- Sappend []' y = y --- Sappend (x ∷' x₁) y = _∷'_ {?} x (Sappend x₁ y) - -language : { Σ : Set } → Set -language {Σ} = List Σ → Bool - -record Lang (i : Size) (A : Set) : Set where - coinductive - field - ν : Bool - δ : ∀{j : Size< i} → A → Lang j A - -open Lang - -∅ : ∀ {i A} → Lang i A -ν ∅ = false -δ ∅ _ = ∅ - -∅' : {i : Size } { A : Set } → Lang i A -∅' {i} {A} = record { ν = false ; δ = lemma3 } where - lemma3 : {j : Size< i} → A → Lang j A - lemma3 {j} _ = {!!} - -∅l : {A : Set } → language {A} -∅l _ = false - -ε : ∀ {i A} → Lang i A -ν ε = true -δ ε _ = ∅ - -εl : {A : Set } → language {A} -εl [] = true -εl (_ ∷ _) = false - -_+_ : ∀ {i A} → Lang i A → Lang i A → Lang i A -ν (a + b) = ν a ∨ ν b -δ (a + b) x = δ a x + δ b x - -Union : {Σ : Set} → ( A B : language {Σ} ) → language {Σ} -Union {Σ} A B x = (A x ) ∨ (B x) - -_·_ : ∀ {i A} → Lang i A → Lang i A → Lang i A -ν (a · b) = ν a ∧ ν b -δ (a · b) x = if (ν a) then ((δ a x · b ) + (δ b x )) else ( δ a x · b ) - -split : {Σ : Set} → (List Σ → Bool) - → ( List Σ → Bool) → List Σ → Bool -split x y [] = x [] ∨ y [] -split x y (h ∷ t) = (x [] ∧ y (h ∷ t)) ∨ - split (λ t1 → x ( h ∷ t1 )) (λ t2 → y t2 ) t - -Concat : {Σ : Set} → ( A B : language {Σ} ) → language {Σ} -Concat {Σ} A B = split A B - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/lang-text.agda --- a/automaton-in-agda/src/agda/lang-text.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,54 +0,0 @@ -module lang-text where - -open import Data.List -open import Data.String -open import Data.Char -open import Data.Char.Unsafe -open import Relation.Binary.PropositionalEquality -open import Relation.Nullary -open import logic - -split : {Σ : Set} → (List Σ → Bool) - → ( List Σ → Bool) → List Σ → Bool -split x y [] = x [] /\ y [] -split x y (h ∷ t) = (x [] /\ y (h ∷ t)) \/ - split (λ t1 → x ( h ∷ t1 )) (λ t2 → y t2 ) t - -contains : String → String → Bool -contains x y = contains1 (toList x ) ( toList y ) where - contains1 : List Char → List Char → Bool - contains1 [] [] = false - contains1 [] ( cx ∷ ly ) = false - contains1 (cx ∷ lx) [] = true - contains1 (cx ∷ lx ) ( cy ∷ ly ) with cx ≟ cy - ... | yes refl = contains1 lx ly - ... | no n = false - --- w does not contain the substring ab -ex15a : Set -ex15a = (w : String ) → ¬ (contains w "ab" ≡ true ) - --- w does not contains substring baba -ex15b : Set -ex15b = (w : String ) → ¬ (contains w "baba" ≡ true ) - --- w contains neither the substing ab nor ba -ex15c : Set - --- w is any string not in a*b* -ex15c = (w : String ) → ( ¬ (contains w "ab" ≡ true ) /\ ( ¬ (contains w "ba" ≡ true ) - -ex15d : {!!} -ex15d = {!!} - -ex15e : {!!} -ex15e = {!!} - -ex15f : {!!} -ex15f = {!!} - -ex15g : {!!} -ex15g = {!!} - -ex15h : {!!} -ex15h = {!!} diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/logic.agda --- a/automaton-in-agda/src/agda/logic.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,154 +0,0 @@ -module logic where - -open import Level -open import Relation.Nullary -open import Relation.Binary hiding (_⇔_ ) -open import Data.Empty - - -data Bool : Set where - true : Bool - false : Bool - -record _∧_ {n m : Level} (A : Set n) ( B : Set m ) : Set (n ⊔ m) where - constructor ⟪_,_⟫ - field - proj1 : A - proj2 : B - -data _∨_ {n m : Level} (A : Set n) ( B : Set m ) : Set (n ⊔ m) where - case1 : A → A ∨ B - case2 : B → A ∨ B - -_⇔_ : {n m : Level } → ( A : Set n ) ( B : Set m ) → Set (n ⊔ m) -_⇔_ A B = ( A → B ) ∧ ( B → A ) - -contra-position : {n m : Level } {A : Set n} {B : Set m} → (A → B) → ¬ B → ¬ A -contra-position {n} {m} {A} {B} f ¬b a = ¬b ( f a ) - -double-neg : {n : Level } {A : Set n} → A → ¬ ¬ A -double-neg A notnot = notnot A - -double-neg2 : {n : Level } {A : Set n} → ¬ ¬ ¬ A → ¬ A -double-neg2 notnot A = notnot ( double-neg A ) - -de-morgan : {n : Level } {A B : Set n} → A ∧ B → ¬ ( (¬ A ) ∨ (¬ B ) ) -de-morgan {n} {A} {B} and (case1 ¬A) = ⊥-elim ( ¬A ( _∧_.proj1 and )) -de-morgan {n} {A} {B} and (case2 ¬B) = ⊥-elim ( ¬B ( _∧_.proj2 and )) - -dont-or :　{n m : Level} {A : Set n} { B : Set m } → A ∨ B → ¬ A → B -dont-or {A} {B} (case1 a) ¬A = ⊥-elim ( ¬A a ) -dont-or {A} {B} (case2 b) ¬A = b - -dont-orb :　{n m : Level} {A : Set n} { B : Set m } → A ∨ B → ¬ B → A -dont-orb {A} {B} (case2 b) ¬B = ⊥-elim ( ¬B b ) -dont-orb {A} {B} (case1 a) ¬B = a - -infixr 130 _∧_ -infixr 140 _∨_ -infixr 150 _⇔_ - -_/\_ : Bool → Bool → Bool -true /\ true = true -_ /\ _ = false - -_\/_ : Bool → Bool → Bool -false \/ false = false -_ \/ _ = true - -not_ : Bool → Bool -not true = false -not false = true - -_<=>_ : Bool → Bool → Bool -true <=> true = true -false <=> false = true -_ <=> _ = false - -open import Relation.Binary.PropositionalEquality - -¬t=f : (t : Bool ) → ¬ ( not t ≡ t) -¬t=f true () -¬t=f false () - -infixr 130 _\/_ -infixr 140 _/\_ - -≡-Bool-func : {A B : Bool } → ( A ≡ true → B ≡ true ) → ( B ≡ true → A ≡ true ) → A ≡ B -≡-Bool-func {true} {true} a→b b→a = refl -≡-Bool-func {false} {true} a→b b→a with b→a refl -... | () -≡-Bool-func {true} {false} a→b b→a with a→b refl -... | () -≡-Bool-func {false} {false} a→b b→a = refl - -bool-≡-? : (a b : Bool) → Dec ( a ≡ b ) -bool-≡-? true true = yes refl -bool-≡-? true false = no (λ ()) -bool-≡-? false true = no (λ ()) -bool-≡-? false false = yes refl - -¬-bool-t : {a : Bool} → ¬ ( a ≡ true ) → a ≡ false -¬-bool-t {true} ne = ⊥-elim ( ne refl ) -¬-bool-t {false} ne = refl - -¬-bool-f : {a : Bool} → ¬ ( a ≡ false ) → a ≡ true -¬-bool-f {true} ne = refl -¬-bool-f {false} ne = ⊥-elim ( ne refl ) - -¬-bool : {a : Bool} → a ≡ false → a ≡ true → ⊥ -¬-bool refl () - -lemma-∧-0 : {a b : Bool} → a /\ b ≡ true → a ≡ false → ⊥ -lemma-∧-0 {true} {true} refl () -lemma-∧-0 {true} {false} () -lemma-∧-0 {false} {true} () -lemma-∧-0 {false} {false} () - -lemma-∧-1 : {a b : Bool} → a /\ b ≡ true → b ≡ false → ⊥ -lemma-∧-1 {true} {true} refl () -lemma-∧-1 {true} {false} () -lemma-∧-1 {false} {true} () -lemma-∧-1 {false} {false} () - -bool-and-tt : {a b : Bool} → a ≡ true → b ≡ true → ( a /\ b ) ≡ true -bool-and-tt refl refl = refl - -bool-∧→tt-0 : {a b : Bool} → ( a /\ b ) ≡ true → a ≡ true -bool-∧→tt-0 {true} {true} refl = refl -bool-∧→tt-0 {false} {_} () - -bool-∧→tt-1 : {a b : Bool} → ( a /\ b ) ≡ true → b ≡ true -bool-∧→tt-1 {true} {true} refl = refl -bool-∧→tt-1 {true} {false} () -bool-∧→tt-1 {false} {false} () - -bool-or-1 : {a b : Bool} → a ≡ false → ( a \/ b ) ≡ b -bool-or-1 {false} {true} refl = refl -bool-or-1 {false} {false} refl = refl -bool-or-2 : {a b : Bool} → b ≡ false → (a \/ b ) ≡ a -bool-or-2 {true} {false} refl = refl -bool-or-2 {false} {false} refl = refl - -bool-or-3 : {a : Bool} → ( a \/ true ) ≡ true -bool-or-3 {true} = refl -bool-or-3 {false} = refl - -bool-or-31 : {a b : Bool} → b ≡ true → ( a \/ b ) ≡ true -bool-or-31 {true} {true} refl = refl -bool-or-31 {false} {true} refl = refl - -bool-or-4 : {a : Bool} → ( true \/ a ) ≡ true -bool-or-4 {true} = refl -bool-or-4 {false} = refl - -bool-or-41 : {a b : Bool} → a ≡ true → ( a \/ b ) ≡ true -bool-or-41 {true} {b} refl = refl - -bool-and-1 : {a b : Bool} → a ≡ false → (a /\ b ) ≡ false -bool-and-1 {false} {b} refl = refl -bool-and-2 : {a b : Bool} → b ≡ false → (a /\ b ) ≡ false -bool-and-2 {true} {false} refl = refl -bool-and-2 {false} {false} refl = refl - - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/nfa.agda --- a/automaton-in-agda/src/agda/nfa.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,152 +0,0 @@ -{-# OPTIONS --allow-unsolved-metas #-} -module nfa where - --- open import Level renaming ( suc to succ ; zero to Zero ) -open import Data.Nat -open import Data.List -open import Data.Fin hiding ( _<_ ) -open import Data.Maybe -open import Relation.Nullary -open import Data.Empty --- open import Data.Bool using ( Bool ; true ; false ; _∧_ ; _∨_ ) -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import Relation.Nullary using (¬_; Dec; yes; no) -open import logic - -data States1 : Set where - sr : States1 - ss : States1 - st : States1 - -data In2 : Set where - i0 : In2 - i1 : In2 - - -record NAutomaton ( Q : Set ) ( Σ : Set ) - : Set where - field - Nδ : Q → Σ → Q → Bool - Nend : Q → Bool - -open NAutomaton - -LStates1 : List States1 -LStates1 = sr ∷ ss ∷ st ∷ [] - --- one of qs q is true -existsS1 : ( States1 → Bool ) → Bool -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 qs = ss1 LStates1 where - ss1 : List States1 → List States1 - ss1 [] = [] - ss1 (x ∷ t) with qs x - ... | true = x ∷ ss1 t - ... | false = ss1 t - -Nmoves : { Q : Set } { Σ : Set } - → NAutomaton Q Σ - → (exists : ( Q → Bool ) → Bool) - → ( Qs : Q → Bool ) → (s : Σ ) → Q → Bool -Nmoves {Q} { Σ} M exists Qs s q = - exists ( λ qn → (Qs qn /\ ( Nδ M qn s q ) )) - -Naccept : { Q : Set } { Σ : Set } - → NAutomaton Q Σ - → (exists : ( Q → Bool ) → Bool) - → (Nstart : Q → Bool) → List Σ → Bool -Naccept M exists sb [] = exists ( λ q → sb q /\ Nend M q ) -Naccept M exists sb (i ∷ t ) = Naccept M exists (λ q → exists ( λ qn → (sb qn /\ ( Nδ M qn i q ) ))) t - -Ntrace : { Q : Set } { Σ : Set } - → NAutomaton Q Σ - → (exists : ( Q → Bool ) → Bool) - → (to-list : ( Q → Bool ) → List Q ) - → (Nstart : Q → Bool) → List Σ → List (List Q) -Ntrace M exists to-list sb [] = to-list ( λ q → sb q /\ Nend M q ) ∷ [] -Ntrace M exists to-list sb (i ∷ t ) = - to-list (λ q → sb q ) ∷ - Ntrace M exists to-list (λ q → exists ( λ qn → (sb qn /\ ( Nδ M qn i q ) ))) t - - -transition3 : States1 → In2 → States1 → Bool -transition3 sr i0 sr = true -transition3 sr i1 ss = true -transition3 sr i1 sr = true -transition3 ss i0 sr = true -transition3 ss i1 st = true -transition3 st i0 sr = true -transition3 st i1 st = true -transition3 _ _ _ = false - -fin1 : States1 → Bool -fin1 st = true -fin1 ss = false -fin1 sr = false - -test5 = existsS1 (λ q → fin1 q ) -test6 = to-listS1 (λ q → fin1 q ) - -start1 : States1 → Bool -start1 sr = true -start1 _ = false - -am2 : NAutomaton States1 In2 -am2 = record { Nδ = transition3 ; Nend = fin1} - -example2-1 = Naccept am2 existsS1 start1 ( i0 ∷ i1 ∷ i0 ∷ [] ) -example2-2 = Naccept am2 existsS1 start1 ( i1 ∷ i1 ∷ i1 ∷ [] ) - -t-1 : List ( List States1 ) -t-1 = Ntrace am2 existsS1 to-listS1 start1 ( i1 ∷ i1 ∷ i1 ∷ [] ) -t-2 = Ntrace am2 existsS1 to-listS1 start1 ( i0 ∷ i1 ∷ i0 ∷ [] ) - -transition4 : States1 → In2 → States1 → Bool -transition4 sr i0 sr = true -transition4 sr i1 ss = true -transition4 sr i1 sr = true -transition4 ss i0 ss = true -transition4 ss i1 st = true -transition4 st i0 st = true -transition4 st i1 st = true -transition4 _ _ _ = false - -fin4 : States1 → Bool -fin4 st = true -fin4 _ = false - -start4 : States1 → Bool -start4 ss = true -start4 _ = false - -am4 : NAutomaton States1 In2 -am4 = record { Nδ = transition4 ; Nend = fin4} - -example4-1 = Naccept am4 existsS1 start4 ( i0 ∷ i1 ∷ i1 ∷ i0 ∷ [] ) -example4-2 = Naccept am4 existsS1 start4 ( i0 ∷ i1 ∷ i1 ∷ i1 ∷ [] ) - -fin0 : States1 → Bool -fin0 st = false -fin0 ss = false -fin0 sr = false - -test0 : Bool -test0 = existsS1 fin0 - -test1 : Bool -test1 = existsS1 fin1 - -test2 = Nmoves am2 existsS1 start1 - -open import automaton - -am2def : Automaton (States1 → Bool ) In2 -am2def = record { δ = λ qs s q → existsS1 (λ qn → qs q /\ Nδ am2 q s qn ) - ; aend = λ qs → existsS1 (λ q → qs q /\ Nend am2 q) } - -dexample4-1 = accept am2def start1 ( i0 ∷ i1 ∷ i1 ∷ i0 ∷ [] ) -texample4-1 = trace am2def start1 ( i0 ∷ i1 ∷ i1 ∷ i0 ∷ [] ) - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/nfa136.agda --- a/automaton-in-agda/src/agda/nfa136.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,113 +0,0 @@ -module nfa136 where - -open import logic -open import nfa -open import automaton -open import Data.List -open import finiteSet -open import Data.Fin -open import Relation.Binary.PropositionalEquality hiding ( [_] ) - -data StatesQ : Set where - q1 : StatesQ - q2 : StatesQ - q3 : StatesQ - -data A2 : Set where - a0 : A2 - b0 : A2 - -finStateQ : FiniteSet StatesQ -finStateQ = record { - Q←F = Q←F - ; F←Q = F←Q - ; finiso→ = finiso→ - ; finiso← = finiso← - } where - Q←F : Fin 3 → StatesQ - Q←F zero = q1 - Q←F (suc zero) = q2 - Q←F (suc (suc zero)) = q3 - F←Q : StatesQ → Fin 3 - F←Q q1 = zero - F←Q q2 = suc zero - F←Q q3 = suc (suc zero) - finiso→ : (q : StatesQ) → Q←F (F←Q q) ≡ q - finiso→ q1 = refl - finiso→ q2 = refl - finiso→ q3 = refl - finiso← : (f : Fin 3) → F←Q (Q←F f) ≡ f - finiso← zero = refl - finiso← (suc zero) = refl - finiso← (suc (suc zero)) = refl - finiso← (suc (suc (suc ()))) - -transition136 : StatesQ → A2 → StatesQ → Bool -transition136 q1 b0 q2 = true -transition136 q1 a0 q1 = true -- q1 → ep → q3 -transition136 q2 a0 q2 = true -transition136 q2 a0 q3 = true -transition136 q2 b0 q3 = true -transition136 q3 a0 q1 = true -transition136 _ _ _ = false - -end136 : StatesQ → Bool -end136 q1 = true -end136 _ = false - -start136 : StatesQ → Bool -start136 q1 = true -start136 _ = false - -exists136 : (StatesQ → Bool) → Bool -exists136 f = f q1 \/ f q2 \/ f q3 - -to-list-136 : (StatesQ → Bool) → List StatesQ -to-list-136 f = tl1 where - tl3 : List StatesQ - tl3 with f q3 - ... | true = q3 ∷ [] - ... | false = [] - tl2 : List StatesQ - tl2 with f q2 - ... | true = q2 ∷ tl3 - ... | false = tl3 - tl1 : List StatesQ - tl1 with f q1 - ... | true = q1 ∷ tl2 - ... | false = tl2 - -nfa136 : NAutomaton StatesQ A2 -nfa136 = record { Nδ = transition136; Nend = end136 } - -example136-1 = Naccept nfa136 exists136 start136( a0 ∷ b0 ∷ a0 ∷ a0 ∷ [] ) - -t146-1 = Ntrace nfa136 exists136 to-list-136 start136( a0 ∷ b0 ∷ a0 ∷ a0 ∷ [] ) - -example136-0 = Naccept nfa136 exists136 start136( a0 ∷ [] ) - -example136-2 = Naccept nfa136 exists136 start136( b0 ∷ a0 ∷ b0 ∷ a0 ∷ b0 ∷ [] ) -t146-2 = Ntrace nfa136 exists136 to-list-136 start136( b0 ∷ a0 ∷ b0 ∷ a0 ∷ b0 ∷ [] ) - -open FiniteSet - -nx : (StatesQ → Bool) → (List A2 ) → StatesQ → Bool -nx now [] = now -nx now ( i ∷ ni ) = (Nmoves nfa136 exists136 (nx now ni) i ) - -example136-3 = to-list-136 start136 -example136-4 = to-list-136 (nx start136 ( a0 ∷ b0 ∷ a0 ∷ [] )) - -open import sbconst2 - -fm136 : Automaton ( StatesQ → Bool ) A2 -fm136 = subset-construction exists136 nfa136 - -open NAutomaton - -lemma136 : ( x : List A2 ) → Naccept nfa136 exists136 start136 x ≡ accept fm136 start136 x -lemma136 x = lemma136-1 x start136 where - lemma136-1 : ( x : List A2 ) → ( states : StatesQ → Bool ) - → Naccept nfa136 exists136 states x ≡ accept fm136 states x - lemma136-1 [] _ = refl - lemma136-1 (h ∷ t) states = lemma136-1 t (δconv exists136 (Nδ nfa136) states h) diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/non-regular.agda --- a/automaton-in-agda/src/agda/non-regular.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -module non-regular where - -open import Data.Nat -open import Data.List -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import logic -open import automaton -open import finiteSet -open import Relation.Nullary - -inputnn : ( n : ℕ ) → { Σ : Set } → ( x y : Σ ) → List Σ → List Σ -inputnn zero {_} _ _ s = s -inputnn (suc n) x y s = x ∷ ( inputnn n x y ( y ∷ s ) ) - -lemmaNN : { Q : Set } { Σ : Set } → ( x y : Σ ) → ¬ (x ≡ y) - → FiniteSet Q - → (M : Automaton Q Σ) (q : Q) - → ¬ ( (n : ℕ) → accept M q ( inputnn n x y [] ) ≡ true ) -lemmaNN = {!!} - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/omega-automaton.agda --- a/automaton-in-agda/src/agda/omega-automaton.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,155 +0,0 @@ -module omega-automaton where - -open import Level renaming ( suc to succ ; zero to Zero ) -open import Data.Nat -open import Data.List -open import Data.Maybe --- open import Data.Bool using ( Bool ; true ; false ; _∧_ ) renaming ( not to negate ) -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import Relation.Nullary -- using (not_; Dec; yes; no) -open import Data.Empty - -open import logic -open import automaton - -open Automaton - -ω-run : { Q Σ : Set } → (Ω : Automaton Q Σ ) → (astart : Q ) → ℕ → ( ℕ → Σ ) → Q -ω-run Ω x zero s = x -ω-run Ω x (suc n) s = δ Ω (ω-run Ω x n s) ( s n ) - --- --- accept as Buchi automaton --- -record Buchi { Q Σ : Set } (Ω : Automaton Q Σ ) ( S : ℕ → Σ ) : Set where - field - from : ℕ - stay : (x : Q) → (n : ℕ ) → n > from → aend Ω ( ω-run Ω x n S ) ≡ true - -open Buchi - --- after sometimes, always p --- --- not p --- ------------> --- <> [] p * <> [] p --- <----------- --- p - - --- --- accept as Muller automaton --- -record Muller { Q Σ : Set } (Ω : Automaton Q Σ ) ( S : ℕ → Σ ) : Set where - field - next : (n : ℕ ) → ℕ - infinite : (x : Q) → (n : ℕ ) → aend Ω ( ω-run Ω x (n + (next n)) S ) ≡ true - --- always sometimes p --- --- not p --- ------------> --- [] <> p * [] <> p --- <----------- --- p - -data States3 : Set where - ts* : States3 - ts : States3 - -transition3 : States3 → Bool → States3 -transition3 ts* true = ts* -transition3 ts* false = ts -transition3 ts true = ts* -transition3 ts false = ts - -mark1 : States3 → Bool -mark1 ts* = true -mark1 ts = false - -ωa1 : Automaton States3 Bool -ωa1 = record { - δ = transition3 - ; aend = mark1 - } - -true-seq : ℕ → Bool -true-seq _ = true - -false-seq : ℕ → Bool -false-seq _ = false - -flip-seq : ℕ → Bool -flip-seq zero = false -flip-seq (suc n) = not ( flip-seq n ) - -lemma0 : Muller ωa1 flip-seq -lemma0 = record { - next = λ n → suc (suc n) - ; infinite = lemma01 - } where - lemma01 : (x : States3) (n : ℕ) → - aend ωa1 (ω-run ωa1 x (n + suc (suc n)) flip-seq) ≡ true - lemma01 = {!!} - -lemma1 : Buchi ωa1 true-seq -lemma1 = record { - from = zero - ; stay = {!!} - } where - lem1 : ( n : ℕ ) → n > zero → aend ωa1 (ω-run ωa1 {!!} n true-seq ) ≡ true - lem1 zero () - lem1 (suc n) (s≤s z≤n) with ω-run ωa1 {!!} n true-seq - lem1 (suc n) (s≤s z≤n) | ts* = {!!} - lem1 (suc n) (s≤s z≤n) | ts = {!!} - -ωa2 : Automaton States3 Bool -ωa2 = record { - δ = transition3 - ; aend = λ x → not ( mark1 x ) - } - -flip-dec : (n : ℕ ) → Dec ( flip-seq n ≡ true ) -flip-dec n with flip-seq n -flip-dec n | false = no λ () -flip-dec n | true = yes refl - -flip-dec1 : (n : ℕ ) → flip-seq (suc n) ≡ ( not ( flip-seq n ) ) -flip-dec1 n = let open ≡-Reasoning in - flip-seq (suc n ) - ≡⟨⟩ - ( not ( flip-seq n ) ) - ∎ - -flip-dec2 : (n : ℕ ) → not flip-seq (suc n) ≡ flip-seq n -flip-dec2 n = {!!} - - -record flipProperty : Set where - field - flipP : (n : ℕ) → ω-run ωa2 {!!} {!!} ≡ ω-run ωa2 {!!} {!!} - -lemma2 : Muller ωa2 flip-seq -lemma2 = record { - next = next - ; infinite = {!!} - } where - next : ℕ → ℕ - next = {!!} - infinite' : (n m : ℕ) → n ≥″ m → aend ωa2 {!!} ≡ true → aend ωa2 {!!} ≡ true - infinite' = {!!} - infinite : (n : ℕ) → aend ωa2 {!!} ≡ true - infinite = {!!} - -lemma3 : Buchi ωa1 false-seq → ⊥ -lemma3 = {!!} - -lemma4 : Muller ωa1 flip-seq → ⊥ -lemma4 = {!!} - - - - - - - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/prime.agda --- a/automaton-in-agda/src/agda/prime.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,51 +0,0 @@ -module prime where - -open import Data.Nat -open import Data.Nat.Properties -open import Data.Empty -open import Data.Unit using (⊤ ; tt) -open import Relation.Nullary -open import Relation.Binary.PropositionalEquality -open import Relation.Binary.Definitions - -open import gcd -open import nat - -record Prime (i : ℕ ) : Set where - field - isPrime : ( j : ℕ ) → j < i → gcd i j ≡ 1 - -open ≡-Reasoning - -record NonPrime ( n : ℕ ) : Set where - field - factor : ℕ - prime : Prime factor - dividable : Dividable factor n - -isPrime : ( n : ℕ ) → Dec ( Prime n ) -isPrime = {!!} - -nonPrime : ( n : ℕ ) → ¬ Prime n → NonPrime n -nonPrime n np = np1 n (λ j n≤j j n≤j j ¬a ¬b c = record { factor = gcd n (suc m) ; prime = {!!} ; dividable = record { factor = {!!} ; is-factor = {!!} } } - -prime-is-infinite : (max-prime : ℕ ) → ¬ ( (j : ℕ) → max-prime < j → ¬ Prime j ) -prime-is-infinite zero pmax = pmax 1 {!!} record { isPrime = λ n lt → {!!} } -prime-is-infinite (suc m) pmax = pmax (suc (factorial (suc m))) f>m record { isPrime = λ n lt → fact n lt } where - factorial : (n : ℕ) → ℕ - factorial zero = 1 - factorial (suc n) = (suc n) * (factorial n) - f>m : suc m < suc (factorial (suc m)) - f>m = {!!} - factm : (n m : ℕ ) → n < (suc m) → Dividable n (factorial m ) - factm = {!!} - fact : (n : ℕ ) → n < (suc (factorial (suc m))) → gcd (suc (factorial (suc m))) n ≡ 1 - fact n lt = fact12 (nonPrime (factorial (suc m )) ( pmax (factorial (suc m )) {!!} )) where - fact12 : NonPrime (factorial (suc m)) → gcd (suc (factorial (suc m))) n ≡ 1 - fact12 np = {!!} diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/pushdown.agda --- a/automaton-in-agda/src/agda/pushdown.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,118 +0,0 @@ -module pushdown where - -open import Level renaming ( suc to succ ; zero to Zero ) -open import Data.Nat -open import Data.List -open import Data.Maybe -open import Data.Bool using ( Bool ; true ; false ) -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import Relation.Nullary using (¬_; Dec; yes; no) -open import Level renaming ( suc to succ ; zero to Zero ) -open import Data.Product - - -data PushDown ( Γ : Set ) : Set where - pop : PushDown Γ - push : Γ → PushDown Γ - - -record PushDownAutomaton ( Q : Set ) ( Σ : Set ) ( Γ : Set ) - : Set where - field - pδ : Q → Σ → Γ → Q × ( PushDown Γ ) - pok : Q → Bool - pempty : Γ - pmoves : Q → List Γ → Σ → ( Q × List Γ ) - pmoves q [] i with pδ q i pempty - pmoves q [] i | qn , pop = ( qn , [] ) - pmoves q [] i | qn , push x = ( qn , ( x ∷ [] ) ) - pmoves q ( H ∷ T ) i with pδ q i H - pmoves q (H ∷ T) i | qn , pop = ( qn , T ) - pmoves q (H ∷ T) i | qn , push x = ( qn , ( x ∷ H ∷ T) ) - - paccept : (q : Q ) ( In : List Σ ) ( sp : List Γ ) → Bool - paccept q [] [] = pok q - paccept q ( H ∷ T) [] with pδ q H pempty - paccept q (H ∷ T) [] | qn , pop = paccept qn T [] - paccept q (H ∷ T) [] | qn , push x = paccept qn T (x ∷ [] ) - paccept q [] (_ ∷ _ ) = false - paccept q ( H ∷ T ) ( SH ∷ ST ) with pδ q H SH - ... | (nq , pop ) = paccept nq T ST - ... | (nq , push ns ) = paccept nq T ( ns ∷ SH ∷ ST ) - - --- 0011 --- 00000111111 -inputnn : ( n : ℕ ) → { Σ : Set } → ( x y : Σ ) → List Σ → List Σ -inputnn zero {_} _ _ s = s -inputnn (suc n) x y s = x ∷ ( inputnn n x y ( y ∷ s ) ) - - -data States0 : Set where - sr : States0 - -data In2 : Set where - i0 : In2 - i1 : In2 - -test0 = inputnn 5 i0 i1 [] - -pnn : PushDownAutomaton States0 In2 States0 -pnn = record { - pδ = pδ - ; pempty = sr - ; pok = λ q → true - } where - pδ : States0 → In2 → States0 → States0 × PushDown States0 - pδ sr i0 _ = (sr , push sr) - pδ sr i1 _ = (sr , pop ) - -data States1 : Set where - ss : States1 - st : States1 - -pn1 : PushDownAutomaton States1 In2 States1 -pn1 = record { - pδ = pδ - ; pempty = ss - ; pok = pok1 - } where - pok1 : States1 → Bool - pok1 ss = false - pok1 st = true - pδ : States1 → In2 → States1 → States1 × PushDown States1 - pδ ss i0 _ = (ss , push ss) - pδ ss i1 _ = (st , pop) - pδ st i0 _ = (st , push ss) - pδ st i1 _ = (st , pop ) - -test1 = PushDownAutomaton.paccept pnn sr ( i0 ∷ i0 ∷ i1 ∷ i1 ∷ [] ) [] -test2 = PushDownAutomaton.paccept pnn sr ( i0 ∷ i0 ∷ i1 ∷ i0 ∷ [] ) [] -test3 = PushDownAutomaton.pmoves pnn sr [] i0 -test4 = PushDownAutomaton.paccept pnn sr ( i0 ∷ i0 ∷ i1 ∷ i1 ∷ i0 ∷ i1 ∷ [] ) [] - -test5 = PushDownAutomaton.paccept pn1 ss ( i0 ∷ i0 ∷ i1 ∷ i1 ∷ [] ) [] -test6 = PushDownAutomaton.paccept pn1 ss ( i0 ∷ i0 ∷ i1 ∷ i1 ∷ i0 ∷ i1 ∷ [] ) [] - -open import Data.Empty - -test70 : (n : ℕ ) → (x : List In2) → PushDownAutomaton.paccept pnn sr x [] ≡ true → inputnn n i0 i1 [] ≡ x -test70 zero [] refl = refl -test70 zero (x ∷ y) pa = ⊥-elim (test701 pa) where - test701 : PushDownAutomaton.paccept pnn sr (x ∷ y) [] ≡ true → ⊥ - test701 pa with PushDownAutomaton.pδ pnn sr x sr - ... | sr , pop = {!!} - ... | sr , push x = {!!} -test70 (suc n) x pa = {!!} - -test71 : (n : ℕ ) → (x : List In2) → inputnn n i0 i1 [] ≡ x → PushDownAutomaton.paccept pnn sr x [] ≡ true -test71 = {!!} - -test7 : (n : ℕ ) → PushDownAutomaton.paccept pnn sr (inputnn n i0 i1 []) [] ≡ true -test7 zero = refl -test7 (suc n) with test7 n -... | t = test7lem [] t where - test7lem : (x : List States0) → PushDownAutomaton.paccept pnn sr (inputnn n i0 i1 []) x ≡ true - → PushDownAutomaton.paccept pnn sr (inputnn n i0 i1 (i1 ∷ [])) (sr ∷ x) ≡ true - test7lem x with PushDownAutomaton.paccept pnn sr (inputnn (suc n) i0 i1 []) (sr ∷ x) - ... | t2 = {!!} diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/puzzle.agda --- a/automaton-in-agda/src/agda/puzzle.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,194 +0,0 @@ -module puzzle where - ----- 仮定 --- 猫か犬を飼っている人は山羊を飼ってない --- 猫を飼ってない人は、犬かウサギを飼っている --- 猫も山羊も飼っていない人は、ウサギを飼っている --- ----- 問題 --- 山羊を飼っている人は、犬を飼っていない --- 山羊を飼っている人は、ウサギを飼っている --- ウサギを飼っていない人は、猫を飼っている - -module pet-research where - open import logic - open import Relation.Nullary - open import Data.Empty - - postulate - lem : (a : Set) → a ∨ ( ¬ a ) - - record PetResearch ( Cat Dog Goat Rabbit : Set ) : Set where - field - fact1 : ( Cat ∨ Dog ) → ¬ Goat - fact2 : ¬ Cat → ( Dog ∨ Rabbit ) - fact3 : ¬ ( Cat ∨ Goat ) → Rabbit - - module tmp ( Cat Dog Goat Rabbit : Set ) (p : PetResearch Cat Dog Goat Rabbit ) where - - open PetResearch - - problem0 : Cat ∨ Dog ∨ Goat ∨ Rabbit - problem0 with lem Cat | lem Goat - ... | case1 c | g = case1 c - ... | c | case1 g = case2 ( case2 ( case1 g ) ) - ... | case2 ¬c | case2 ¬g = case2 ( case2 ( case2 ( fact3 p lemma1 ))) where - lemma1 : ¬ ( Cat ∨ Goat ) - lemma1 (case1 c) = ¬c c - lemma1 (case2 g) = ¬g g - - problem1 : Goat → ¬ Dog - problem1 g d = fact1 p (case2 d) g - - problem2 : Goat → Rabbit - problem2 g with lem Cat | lem Dog - problem2 g | case1 c | d = ⊥-elim ( fact1 p (case1 c ) g ) - problem2 g | case2 ¬c | case1 d = ⊥-elim ( fact1 p (case2 d ) g ) - problem2 g | case2 ¬c | case2 ¬d with lem Rabbit - ... | case1 r = r - ... | case2 ¬r = fact3 p lemma2 where - lemma2 : ¬ ( Cat ∨ Goat ) - lemma2 (case1 c) = ¬c c - lemma2 (case2 g) with fact2 p ¬c - lemma2 (case2 g) | case1 d = ¬d d - lemma2 (case2 g) | case2 r = ¬r r - - problem3 : (¬ Rabbit ) → Cat - problem3 ¬r with lem Cat | lem Goat - problem3 ¬r | case1 c | g = c - problem3 ¬r | case2 ¬c | g = ⊥-elim ( ¬r ( fact3 p lemma3 )) where - lemma3 : ¬ ( Cat ∨ Goat ) - lemma3 (case1 c) = ¬c c - lemma3 (case2 g) with fact2 p ¬c - lemma3 (case2 g) | case1 d = fact1 p (case2 d ) g - lemma3 (case2 g) | case2 r = ¬r r - -module pet-research1 ( Cat Dog Goat Rabbit : Set ) where - - open import Data.Bool - open import Relation.Binary - open import Relation.Binary.PropositionalEquality - - _=>_ : Bool → Bool → Bool - _ => true = true - false => _ = true - true => false = false - - ¬_ : Bool → Bool - ¬ p = not p - - problem0 : ( Cat Dog Goat Rabbit : Bool ) → - ((( Cat ∨ Dog ) => (¬ Goat) ) ∧ ( (¬ Cat ) => ( Dog ∨ Rabbit ) ) ∧ ( ( ¬ ( Cat ∨ Goat ) ) => Rabbit ) ) - => (Cat ∨ Dog ∨ Goat ∨ Rabbit) ≡ true - problem0 true d g r = refl - problem0 false true g r = refl - problem0 false false true r = refl - problem0 false false false true = refl - problem0 false false false false = refl - - problem1 : ( Cat Dog Goat Rabbit : Bool ) → - ((( Cat ∨ Dog ) => (¬ Goat) ) ∧ ( (¬ Cat ) => ( Dog ∨ Rabbit ) ) ∧ ( ( ¬ ( Cat ∨ Goat ) ) => Rabbit ) ) - => ( Goat => ( ¬ Dog )) ≡ true - problem1 c false false r = refl - problem1 c true false r = refl - problem1 c false true r = refl - problem1 false true true r = refl - problem1 true true true r = refl - - problem2 : ( Cat Dog Goat Rabbit : Bool ) → - ((( Cat ∨ Dog ) => (¬ Goat) ) ∧ ( (¬ Cat ) => ( Dog ∨ Rabbit ) ) ∧ ( ( ¬ ( Cat ∨ Goat ) ) => Rabbit ) ) - => ( Goat => Rabbit ) ≡ true - problem2 c d false false = refl - problem2 c d false true = refl - problem2 c d true true = refl - problem2 true d true false = refl - problem2 false false true false = refl - problem2 false true true false = refl - - problem3 : ( Cat Dog Goat Rabbit : Bool ) → - ((( Cat ∨ Dog ) => (¬ Goat) ) ∧ ( (¬ Cat ) => ( Dog ∨ Rabbit ) ) ∧ ( ( ¬ ( Cat ∨ Goat ) ) => Rabbit ) ) - => ( (¬ Rabbit ) => Cat ) ≡ true - problem3 false d g true = refl - problem3 true d g true = refl - problem3 true d g false = refl - problem3 false false false false = refl - problem3 false false true false = refl - problem3 false true false false = refl - problem3 false true true false = refl - --- module pet-research2 ( Cat Dog Goat Rabbit : Set ) where --- --- open import Data.Bool hiding ( _∨_ ) --- open import Relation.Binary --- open import Relation.Binary.PropositionalEquality --- --- ¬_ : Bool → Bool --- ¬ p = p xor true --- --- infixr 5 _∨_ --- _∨_ : Bool → Bool → Bool --- a ∨ b = ¬ ( (¬ a) ∧ (¬ b ) ) --- --- _=>_ : Bool → Bool → Bool --- a => b = (¬ a ) ∨ b --- --- open import Data.Bool.Solver using (module xor-∧-Solver) --- open xor-∧-Solver --- --- problem0' : ( Cat : Bool ) → (Cat xor Cat ) ≡ false --- problem0' = solve 1 (λ c → (c :+ c ) := con false ) refl --- --- problem1' : ( Cat : Bool ) → (Cat ∧ (Cat xor true )) ≡ false --- problem1' = solve 1 (λ c → ((c :* (c :+ con true )) ) := con false ) {!!} --- --- open import Data.Nat --- :¬_ : {n : ℕ} → Polynomial n → Polynomial n --- :¬ p = p :+ con true --- --- _:∨_ : {n : ℕ} → Polynomial n → Polynomial n → Polynomial n --- a :∨ b = :¬ ( ( :¬ a ) :* ( :¬ b )) --- --- _:=>_ : {n : ℕ} → Polynomial n → Polynomial n → Polynomial n --- a :=> b = ( :¬ a ) :∨ b --- --- _:∧_ = _:*_ --- --- infixr 6 _:∧_ --- infixr 5 _:∨_ --- --- problem0 : ( Cat Dog Goat Rabbit : Bool ) → --- ((( Cat ∨ Dog ) => (¬ Goat) ) ∧ ( (¬ Cat ) => ( Dog ∨ Rabbit ) ) ∧ ( ( ¬ ( Cat ∨ Goat ) ) => Rabbit ) ) --- => (Cat ∨ Dog ∨ Goat ∨ Rabbit) ≡ true --- problem0 = solve 4 ( λ Cat Dog Goat Rabbit → ( --- ( ((Cat :∨ Dog ) :=> (:¬ Goat)) :∧ ( ((:¬ Cat ) :=> ( Dog :∨ Rabbit )) :∧ (( :¬ ( Cat :∨ Goat ) ) :=> Rabbit) )) --- :=> ( Cat :∨ (Dog :∨ ( Goat :∨ Rabbit))) ) := con true ) {!!} --- --- problem1 : ( Cat Dog Goat Rabbit : Bool ) → --- ((( Cat ∨ Dog ) => (¬ Goat) ) ∧ ( (¬ Cat ) => ( Dog ∨ Rabbit ) ) ∧ ( ( ¬ ( Cat ∨ Goat ) ) => Rabbit ) ) --- => ( Goat => ( ¬ Dog )) ≡ true --- problem1 c false false r = {!!} --- problem1 c true false r = {!!} --- problem1 c false true r = {!!} --- problem1 false true true r = refl --- problem1 true true true r = refl --- --- problem2 : ( Cat Dog Goat Rabbit : Bool ) → --- ((( Cat ∨ Dog ) => (¬ Goat) ) ∧ ( (¬ Cat ) => ( Dog ∨ Rabbit ) ) ∧ ( ( ¬ ( Cat ∨ Goat ) ) => Rabbit ) ) --- => ( Goat => Rabbit ) ≡ true --- problem2 c d false false = {!!} --- problem2 c d false true = {!!} --- problem2 c d true true = {!!} --- problem2 true d true false = refl --- problem2 false false true false = refl --- problem2 false true true false = refl --- --- problem3 : ( Cat Dog Goat Rabbit : Bool ) → --- ((( Cat ∨ Dog ) => (¬ Goat) ) ∧ ( (¬ Cat ) => ( Dog ∨ Rabbit ) ) ∧ ( ( ¬ ( Cat ∨ Goat ) ) => Rabbit ) ) --- => ( (¬ Rabbit ) => Cat ) ≡ true --- problem3 false d g true = {!!} --- problem3 true d g true = {!!} --- problem3 true d g false = {!!} --- problem3 false false false false = refl --- problem3 false false true false = refl --- problem3 false true false false = refl --- problem3 false true true false = refl diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/regex.agda --- a/automaton-in-agda/src/agda/regex.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,14 +0,0 @@ -module regex where - -data Regex ( Σ : Set) : Set where - ε : Regex Σ -- empty - φ : Regex Σ -- fail - _* : Regex Σ → Regex Σ - _&_ : Regex Σ → Regex Σ → Regex Σ - _||_ : Regex Σ → Regex Σ → Regex Σ - <_> : Σ → Regex Σ - -infixr 40 _&_ _||_ - - - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/regex1.agda --- a/automaton-in-agda/src/agda/regex1.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,128 +0,0 @@ -{-# OPTIONS --allow-unsolved-metas #-} -module regex1 where - -open import Level renaming ( suc to succ ; zero to Zero ) -open import Data.Fin -open import Data.Nat hiding ( _≟_ ) -open import Data.List hiding ( any ; [_] ) -import Data.Bool using ( Bool ; true ; false ; _∧_ ) -open import Data.Bool using ( Bool ; true ; false ; _∧_ ; _∨_ ) -open import Relation.Binary.PropositionalEquality as RBF hiding ( [_] ) -open import Relation.Nullary using (¬_; Dec; yes; no) -open import regex - --- postulate a b c d : Set - -data In : Set where - a : In - b : In - c : In - d : In - -cmpi : (x y : In ) → Dec (x ≡ y) -cmpi a a = yes refl -cmpi b b = yes refl -cmpi c c = yes refl -cmpi d d = yes refl -cmpi a b = no (λ ()) -cmpi a c = no (λ ()) -cmpi a d = no (λ ()) -cmpi b a = no (λ ()) -cmpi b c = no (λ ()) -cmpi b d = no (λ ()) -cmpi c a = no (λ ()) -cmpi c b = no (λ ()) -cmpi c d = no (λ ()) -cmpi d a = no (λ ()) -cmpi d b = no (λ ()) -cmpi d c = no (λ ()) - --- infixr 40 _&_ _||_ - -r1' = (< a > & < b >) & < c > --- abc -r1 = < a > & < b > & < c > --- abc -any = < a > || < b > || < c > --- a|b|c -r2 = ( any * ) & ( < a > & < b > & < c > ) -- .*abc -r3 = ( any * ) & ( < a > & < b > & < c > & < a > & < b > & < c > ) -r4 = ( < a > & < b > & < c > ) || ( < b > & < c > & < d > ) -r5 = ( any * ) & ( < a > & < b > & < c > || < b > & < c > & < d > ) - -open import nfa - --- former ++ later ≡ x -split : {Σ : Set} → ((former : List Σ) → Bool) → ((later : List Σ) → Bool) → (x : List Σ ) → Bool -split x y [] = x [] ∧ y [] -split x y (h ∷ t) = (x [] ∧ y (h ∷ t)) ∨ - split (λ t1 → x ( h ∷ t1 )) (λ t2 → y t2 ) t - --- tt1 : {Σ : Set} → ( P Q : List In → Bool ) → split P Q ( a ∷ b ∷ c ∷ [] ) --- tt1 P Q = ? - -{-# TERMINATING #-} -repeat : {Σ : Set} → (List Σ → Bool) → List Σ → Bool -repeat x [] = true -repeat {Σ} x ( h ∷ t ) = split x (repeat {Σ} x) ( h ∷ t ) - -regular-language : {Σ : Set} → Regex Σ → ((x y : Σ ) → Dec (x ≡ y)) → List Σ → Bool -regular-language φ cmp _ = false -regular-language ε cmp [] = true -regular-language ε cmp (_ ∷ _) = false -regular-language (x *) cmp = repeat ( regular-language x cmp ) -regular-language (x & y) cmp = split ( λ z → (regular-language x cmp) z ) (λ z → regular-language y cmp z ) -regular-language (x || y) cmp = λ s → ( regular-language x cmp s ) ∨ ( regular-language y cmp s) -regular-language < h > cmp [] = false -regular-language < h > cmp (h1 ∷ [] ) with cmp h h1 -... | yes _ = true -... | no _ = false -regular-language < h > _ (_ ∷ _ ∷ _) = false - -test-regex : regular-language r1' cmpi ( a ∷ [] ) ≡ false -test-regex = refl - -test-regex1 : regular-language r2 cmpi ( a ∷ a ∷ b ∷ c ∷ [] ) ≡ true -test-regex1 = refl - - -test-AB→split : {Σ : Set} → {A B : List In → Bool} → split A B ( a ∷ b ∷ a ∷ [] ) ≡ ( - ( A [] ∧ B ( a ∷ b ∷ a ∷ [] ) ) ∨ - ( A ( a ∷ [] ) ∧ B ( b ∷ a ∷ [] ) ) ∨ - ( A ( a ∷ b ∷ [] ) ∧ B ( a ∷ [] ) ) ∨ - ( A ( a ∷ b ∷ a ∷ [] ) ∧ B [] ) - ) -test-AB→split {_} {A} {B} = refl - --- from example 1.53 1 - -ex53-1 : Set -ex53-1 = (s : List In ) → regular-language ( (< a > *) & < b > & (< a > *) ) cmpi s ≡ true → {!!} -- contains exact one b - -ex53-2 : Set -ex53-2 = (s : List In ) → regular-language ( (any * ) & < b > & (any *) ) cmpi s ≡ true → {!!} -- contains at lease one b - -evenp : {Σ : Set} → List Σ → Bool -oddp : {Σ : Set} → List Σ → Bool -oddp [] = false -oddp (_ ∷ t) = evenp t - -evenp [] = true -evenp (_ ∷ t) = oddp t - --- from example 1.53 5 -egex-even : Set -egex-even = (s : List In ) → regular-language ( ( any & any ) * ) cmpi s ≡ true → evenp s ≡ true - -test11 = regular-language ( ( any & any ) * ) cmpi (a ∷ []) -test12 = regular-language ( ( any & any ) * ) cmpi (a ∷ b ∷ []) - --- proof-egex-even : egex-even --- proof-egex-even [] _ = refl --- proof-egex-even (a ∷ []) () --- proof-egex-even (b ∷ []) () --- proof-egex-even (c ∷ []) () --- proof-egex-even (x ∷ x₁ ∷ s) y = proof-egex-even s {!!} - -open import derive In cmpi -open import automaton - -ra-ex = trace (regex→automaton r2) (record { state = r2 ; is-derived = unit }) ( a ∷ b ∷ c ∷ []) - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/regular-concat.agda --- a/automaton-in-agda/src/agda/regular-concat.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,240 +0,0 @@ -module regular-concat where - -open import Level renaming ( suc to Suc ; zero to Zero ) -open import Data.List -open import Data.Nat hiding ( _≟_ ) -open import Data.Fin hiding ( _+_ ) -open import Data.Empty -open import Data.Unit -open import Data.Product --- open import Data.Maybe -open import Relation.Nullary -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import logic -open import nat -open import automaton -open import regular-language - -open import nfa -open import sbconst2 - -open RegularLanguage -open Automaton - -Concat-NFA : {Σ : Set} → (A B : RegularLanguage Σ ) → ((x y : states A )→ Dec (x ≡ y)) → ((x y : states B )→ Dec (x ≡ y)) - → NAutomaton (states A ∨ states B) Σ -Concat-NFA {Σ} A B equal?A equal?B = record { Nδ = δnfa ; Nend = nend } - module Concat-NFA where - δnfa : states A ∨ states B → Σ → states A ∨ states B → Bool - δnfa (case1 q) i (case1 q₁) with equal?A (δ (automaton A) q i) q₁ - ... | yes _ = true - ... | no _ = false - δnfa (case1 qa) i (case2 qb) with equal?B qb (δ (automaton B) (astart B) i) - ... | yes _ = aend (automaton A) qa - ... | no _ = false - δnfa (case2 q) i (case2 q₁) with equal?B (δ (automaton B) q i) q₁ - ... | yes _ = true - ... | no _ = false - δnfa _ i _ = false - nend : states A ∨ states B → Bool - nend (case2 q) = aend (automaton B) q - nend (case1 q) = aend (automaton A) q /\ aend (automaton B) (astart B) -- empty B case - -Concat-NFA-start : {Σ : Set} → (A B : RegularLanguage Σ ) → states A ∨ states B → ((x y : states A )→ Dec (x ≡ y)) → Bool -Concat-NFA-start A B (case1 a) equal?A with equal?A a (astart A) -... | yes _ = true -... | no _ = false -Concat-NFA-start A B (case2 b) equal?A = false - -M-Concat : {Σ : Set} → (A B : RegularLanguage Σ ) → ((states A → Bool) → Bool) → ((states B → Bool) → Bool) → RegularLanguage Σ -M-Concat {Σ} A B existsA existsB = record { - states = states A ∨ states B → Bool - ; astart = λ ab → Concat-NFA-start A B ab {!!} - ; automaton = subset-construction sbexists (Concat-NFA A B {!!} {!!} ) - } where - sbexists : (states A ∨ states B → Bool) → Bool - sbexists P = existsA ( λ a → existsB ( λ b → P (case1 a) \/ P (case2 b))) - -record Split {Σ : Set} (A : List Σ → Bool ) ( B : List Σ → Bool ) (x : List Σ ) : Set where - field - sp0 : List Σ - sp1 : List Σ - sp-concat : sp0 ++ sp1 ≡ x - prop0 : A sp0 ≡ true - prop1 : B sp1 ≡ true - -open Split - -list-empty++ : {Σ : Set} → (x y : List Σ) → x ++ y ≡ [] → (x ≡ [] ) ∧ (y ≡ [] ) -list-empty++ [] [] refl = record { proj1 = refl ; proj2 = refl } -list-empty++ [] (x ∷ y) () -list-empty++ (x ∷ x₁) y () - -open _∧_ - -open import Relation.Binary.PropositionalEquality hiding ( [_] ) - -c-split-lemma : {Σ : Set} → (A B : List Σ → Bool ) → (h : Σ) → ( t : List Σ ) → split A B (h ∷ t ) ≡ true - → ( ¬ (A [] ≡ true )) ∨ ( ¬ (B ( h ∷ t ) ≡ true) ) - → split (λ t1 → A (h ∷ t1)) B t ≡ true -c-split-lemma {Σ} A B h t eq p = sym ( begin - true - ≡⟨ sym eq ⟩ - split A B (h ∷ t ) - ≡⟨⟩ - A [] /\ B (h ∷ t) \/ split (λ t1 → A (h ∷ t1)) B t - ≡⟨ cong ( λ k → k \/ split (λ t1 → A (h ∷ t1)) B t ) (lemma-p p ) ⟩ - false \/ split (λ t1 → A (h ∷ t1)) B t - ≡⟨ bool-or-1 refl ⟩ - split (λ t1 → A (h ∷ t1)) B t - ∎ ) where - open ≡-Reasoning - lemma-p : ( ¬ (A [] ≡ true )) ∨ ( ¬ (B ( h ∷ t ) ≡ true) ) → A [] /\ B (h ∷ t) ≡ false - lemma-p (case1 ¬A ) = bool-and-1 ( ¬-bool-t ¬A ) - lemma-p (case2 ¬B ) = bool-and-2 ( ¬-bool-t ¬B ) - -split→AB : {Σ : Set} → (A B : List Σ → Bool ) → ( x : List Σ ) → split A B x ≡ true → Split A B x -split→AB {Σ} A B [] eq with bool-≡-? (A []) true | bool-≡-? (B []) true -split→AB {Σ} A B [] eq | yes eqa | yes eqb = - record { sp0 = [] ; sp1 = [] ; sp-concat = refl ; prop0 = eqa ; prop1 = eqb } -split→AB {Σ} A B [] eq | yes p | no ¬p = ⊥-elim (lemma-∧-1 eq (¬-bool-t ¬p )) -split→AB {Σ} A B [] eq | no ¬p | t = ⊥-elim (lemma-∧-0 eq (¬-bool-t ¬p )) -split→AB {Σ} A B (h ∷ t ) eq with bool-≡-? (A []) true | bool-≡-? (B (h ∷ t )) true -... | yes px | yes py = record { sp0 = [] ; sp1 = h ∷ t ; sp-concat = refl ; prop0 = px ; prop1 = py } -... | no px | _ with split→AB (λ t1 → A ( h ∷ t1 )) B t (c-split-lemma A B h t eq (case1 px) ) -... | S = record { sp0 = h ∷ sp0 S ; sp1 = sp1 S ; sp-concat = cong ( λ k → h ∷ k) (sp-concat S) ; prop0 = prop0 S ; prop1 = prop1 S } -split→AB {Σ} A B (h ∷ t ) eq | _ | no px with split→AB (λ t1 → A ( h ∷ t1 )) B t (c-split-lemma A B h t eq (case2 px) ) -... | S = record { sp0 = h ∷ sp0 S ; sp1 = sp1 S ; sp-concat = cong ( λ k → h ∷ k) (sp-concat S) ; prop0 = prop0 S ; prop1 = prop1 S } - -AB→split : {Σ : Set} → (A B : List Σ → Bool ) → ( x y : List Σ ) → A x ≡ true → B y ≡ true → split A B (x ++ y ) ≡ true -AB→split {Σ} A B [] [] eqa eqb = begin - split A B [] - ≡⟨⟩ - A [] /\ B [] - ≡⟨ cong₂ (λ j k → j /\ k ) eqa eqb ⟩ - true - ∎ where open ≡-Reasoning -AB→split {Σ} A B [] (h ∷ y ) eqa eqb = begin - split A B (h ∷ y ) - ≡⟨⟩ - A [] /\ B (h ∷ y) \/ split (λ t1 → A (h ∷ t1)) B y - ≡⟨ cong₂ (λ j k → j /\ k \/ split (λ t1 → A (h ∷ t1)) B y ) eqa eqb ⟩ - true /\ true \/ split (λ t1 → A (h ∷ t1)) B y - ≡⟨⟩ - true \/ split (λ t1 → A (h ∷ t1)) B y - ≡⟨⟩ - true - ∎ where open ≡-Reasoning -AB→split {Σ} A B (h ∷ t) y eqa eqb = begin - split A B ((h ∷ t) ++ y) - ≡⟨⟩ - A [] /\ B (h ∷ t ++ y) \/ split (λ t1 → A (h ∷ t1)) B (t ++ y) - ≡⟨ cong ( λ k → A [] /\ B (h ∷ t ++ y) \/ k ) (AB→split {Σ} (λ t1 → A (h ∷ t1)) B t y eqa eqb ) ⟩ - A [] /\ B (h ∷ t ++ y) \/ true - ≡⟨ bool-or-3 ⟩ - true - ∎ where open ≡-Reasoning - -open NAutomaton -open import Data.List.Properties - -open import finiteSet -open import finiteSetUtil - -open FiniteSet - -closed-in-concat : {Σ : Set} → (A B : RegularLanguage Σ ) → ( x : List Σ ) → isRegular (Concat (contain A) (contain B)) x ( M-Concat A B ) -closed-in-concat {Σ} A B x = ≡-Bool-func closed-in-concat→ closed-in-concat← where - afin : (A : RegularLanguage Σ ) → FiniteSet A - afin = ? - finab = (fin-∨ (afin A) (afin B)) - NFA = (Concat-NFA A B) - abmove : (q : states A ∨ states B) → (h : Σ ) → states A ∨ states B - abmove (case1 q) h = case1 (δ (automaton A) q h) - abmove (case2 q) h = case2 (δ (automaton B) q h) - lemma-nmove-ab : (q : states A ∨ states B) → (h : Σ ) → Nδ NFA q h (abmove q h) ≡ true - lemma-nmove-ab (case1 q) _ = ? -- equal?-refl (afin A) - lemma-nmove-ab (case2 q) _ = ? -- equal?-refl (afin B) - nmove : (q : states A ∨ states B) (nq : states A ∨ states B → Bool ) → (nq q ≡ true) → ( h : Σ ) → - exists finab (λ qn → nq qn /\ Nδ NFA qn h (abmove q h)) ≡ true - nmove (case1 q) nq nqt h = found finab (case1 q) ( bool-and-tt nqt (lemma-nmove-ab (case1 q) h) ) - nmove (case2 q) nq nqt h = found finab (case2 q) ( bool-and-tt nqt (lemma-nmove-ab (case2 q) h) ) - acceptB : (z : List Σ) → (q : states B) → (nq : states A ∨ states B → Bool ) → (nq (case2 q) ≡ true) → ( accept (automaton B) q z ≡ true ) - → Naccept NFA finab nq z ≡ true - acceptB [] q nq nqt fb = lemma8 where - lemma8 : exists finab ( λ q → nq q /\ Nend NFA q ) ≡ true - lemma8 = found finab (case2 q) ( bool-and-tt nqt fb ) - acceptB (h ∷ t ) q nq nq=q fb = acceptB t (δ (automaton B) q h) (Nmoves NFA finab nq h) (nmove (case2 q) nq nq=q h) fb - - acceptA : (y z : List Σ) → (q : states A) → (nq : states A ∨ states B → Bool ) → (nq (case1 q) ≡ true) - → ( accept (automaton A) q y ≡ true ) → ( accept (automaton B) (astart B) z ≡ true ) - → Naccept NFA finab nq (y ++ z) ≡ true - acceptA [] [] q nq nqt fa fb = found finab (case1 q) (bool-and-tt nqt (bool-and-tt fa fb )) - acceptA [] (h ∷ z) q nq nq=q fa fb = acceptB z nextb (Nmoves NFA finab nq h) lemma70 fb where - nextb : states B - nextb = δ (automaton B) (astart B) h - lemma70 : exists finab (λ qn → nq qn /\ Nδ NFA qn h (case2 nextb)) ≡ true - lemma70 = found finab (case1 q) ( bool-and-tt nq=q (bool-and-tt fa (lemma-nmove-ab (case2 (astart B)) h) )) - acceptA (h ∷ t) z q nq nq=q fa fb = acceptA t z (δ (automaton A) q h) (Nmoves NFA finab nq h) (nmove (case1 q) nq nq=q h) fa fb where - - acceptAB : Split (contain A) (contain B) x - → Naccept NFA finab (equal? finab (case1 (astart A))) x ≡ true - acceptAB S = subst ( λ k → Naccept NFA finab (equal? finab (case1 (astart A))) k ≡ true ) ( sp-concat S ) - (acceptA (sp0 S) (sp1 S) (astart A) (equal? finab (case1 (astart A))) ? (prop0 S) (prop1 S) ) - - closed-in-concat→ : Concat (contain A) (contain B) x ≡ true → contain (M-Concat A B) x ≡ true - closed-in-concat→ concat with split→AB (contain A) (contain B) x concat - ... | S = begin - accept (subset-construction finab NFA (case1 (astart A))) (Concat-NFA-start A B ) x - ≡⟨ ≡-Bool-func (subset-construction-lemma← finab NFA (case1 (astart A)) x ) - (subset-construction-lemma→ finab NFA (case1 (astart A)) x ) ⟩ - Naccept NFA finab (equal? finab (case1 (astart A))) x - ≡⟨ acceptAB S ⟩ - true - ∎ where open ≡-Reasoning - - open Found - - ab-case : (q : states A ∨ states B ) → (qa : states A ) → (x : List Σ ) → Set - ab-case (case1 qa') qa x = qa' ≡ qa - ab-case (case2 qb) qa x = ¬ ( accept (automaton B) qb x ≡ true ) - - contain-A : (x : List Σ) → (nq : states A ∨ states B → Bool ) → (fn : Naccept NFA finab nq x ≡ true ) - → (qa : states A ) → ( (q : states A ∨ states B) → nq q ≡ true → ab-case q qa x ) - → split (accept (automaton A) qa ) (contain B) x ≡ true - contain-A [] nq fn qa cond with found← finab fn - ... | S with found-q S | inspect found-q S | cond (found-q S) (bool-∧→tt-0 (found-p S)) - ... | case1 qa' | record { eq = refl } | refl = bool-∧→tt-1 (found-p S) - ... | case2 qb | record { eq = refl } | ab = ⊥-elim ( ab (bool-∧→tt-1 (found-p S))) - contain-A (h ∷ t) nq fn qa cond with bool-≡-? ((aend (automaton A) qa) /\ accept (automaton B) (δ (automaton B) (astart B) h) t ) true - ... | yes eq = bool-or-41 eq - ... | no ne = bool-or-31 (contain-A t (Nmoves NFA finab nq h) fn (δ (automaton A) qa h) lemma11 ) where - lemma11 : (q : states A ∨ states B) → exists finab (λ qn → nq qn /\ Nδ NFA qn h q) ≡ true → ab-case q (δ (automaton A) qa h) t - lemma11 (case1 qa') ex with found← finab ex - ... | S with found-q S | inspect found-q S | cond (found-q S) (bool-∧→tt-0 (found-p S)) - ... | case1 qa | record { eq = refl } | refl = sym ( equal→refl (afin A) ( bool-∧→tt-1 (found-p S) )) -- continued A case - ... | case2 qb | record { eq = refl } | nb with bool-∧→tt-1 (found-p S) -- δnfa (case2 q) i (case1 q₁) is false - ... | () - lemma11 (case2 qb) ex with found← finab ex - ... | S with found-q S | inspect found-q S | cond (found-q S) (bool-∧→tt-0 (found-p S)) - lemma11 (case2 qb) ex | S | case2 qb' | record { eq = refl } | nb = contra-position lemma13 nb where -- continued B case should fail - lemma13 : accept (automaton B) qb t ≡ true → accept (automaton B) qb' (h ∷ t) ≡ true - lemma13 fb = subst (λ k → accept (automaton B) k t ≡ true ) (sym (equal→refl (afin B) (bool-∧→tt-1 (found-p S)))) fb - lemma11 (case2 qb) ex | S | case1 qa | record { eq = refl } | refl with bool-∧→tt-1 (found-p S) - ... | eee = contra-position lemma12 ne where -- starting B case should fail - lemma12 : accept (automaton B) qb t ≡ true → aend (automaton A) qa /\ accept (automaton B) (δ (automaton B) (astart B) h) t ≡ true - lemma12 fb = bool-and-tt (bool-∧→tt-0 eee) (subst ( λ k → accept (automaton B) k t ≡ true ) (equal→refl (afin B) (bool-∧→tt-1 eee) ) fb ) - - lemma10 : Naccept NFA finab (equal? finab (case1 (astart A))) x ≡ true → split (contain A) (contain B) x ≡ true - lemma10 CC = contain-A x (Concat-NFA-start A B ) CC (astart A) lemma15 where - lemma15 : (q : states A ∨ states B) → Concat-NFA-start A B q ≡ true → ab-case q (astart A) x - lemma15 q nq=t with equal→refl finab nq=t - ... | refl = refl - - closed-in-concat← : contain (M-Concat A B) x ≡ true → Concat (contain A) (contain B) x ≡ true - closed-in-concat← C with subset-construction-lemma← finab NFA (case1 (astart A)) x C - ... | CC = lemma10 CC - - - - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/regular-language.agda --- a/automaton-in-agda/src/agda/regular-language.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,87 +0,0 @@ -module regular-language where - -open import Level renaming ( suc to Suc ; zero to Zero ) -open import Data.List -open import Data.Nat hiding ( _≟_ ) -open import Data.Fin hiding ( _+_ ) -open import Data.Empty -open import Data.Unit -open import Data.Product --- open import Data.Maybe -open import Relation.Nullary -open import Relation.Binary.PropositionalEquality hiding ( [_] ) -open import logic -open import nat -open import automaton - -language : { Σ : Set } → Set -language {Σ} = List Σ → Bool - -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) - -split : {Σ : Set} → (List Σ → Bool) - → ( List Σ → Bool) → List Σ → Bool -split x y [] = x [] /\ y [] -split x y (h ∷ t) = (x [] /\ y (h ∷ t)) \/ - split (λ t1 → x ( h ∷ t1 )) (λ t2 → y t2 ) t - -Concat : {Σ : Set} → ( A B : language {Σ} ) → language {Σ} -Concat {Σ} A B = split A B - -{-# TERMINATING #-} -Star : {Σ : Set} → ( A : language {Σ} ) → language {Σ} -Star {Σ} A = split A ( Star {Σ} A ) - -open import automaton-ex - -test-AB→split : {Σ : Set} → {A B : List In2 → Bool} → split A B ( i0 ∷ i1 ∷ i0 ∷ [] ) ≡ ( - ( A [] /\ B ( i0 ∷ i1 ∷ i0 ∷ [] ) ) \/ - ( A ( i0 ∷ [] ) /\ B ( i1 ∷ i0 ∷ [] ) ) \/ - ( A ( i0 ∷ i1 ∷ [] ) /\ B ( i0 ∷ [] ) ) \/ - ( A ( i0 ∷ i1 ∷ i0 ∷ [] ) /\ B [] ) - ) -test-AB→split {_} {A} {B} = refl - -open RegularLanguage -isRegular : {Σ : Set} → (A : language {Σ} ) → ( x : List Σ ) → (r : RegularLanguage Σ ) → Set -isRegular A x r = A x ≡ contain r x - --- postulate --- fin-× : {A B : Set} → { a b : ℕ } → FiniteSet A {a} → FiniteSet B {b} → FiniteSet (A × B) {a * b} - -M-Union : {Σ : Set} → (A B : RegularLanguage Σ ) → RegularLanguage Σ -M-Union {Σ} A B = record { - states = states A × states B - ; astart = ( astart A , astart B ) - ; automaton = record { - δ = λ q x → ( δ (automaton A) (proj₁ q) x , δ (automaton B) (proj₂ q) x ) - ; aend = λ q → ( aend (automaton A) (proj₁ q) \/ aend (automaton B) (proj₂ q) ) - } - } - -closed-in-union : {Σ : Set} → (A B : RegularLanguage Σ ) → ( x : List Σ ) → isRegular (Union (contain A) (contain B)) x ( M-Union A B ) -closed-in-union A B [] = lemma where - lemma : aend (automaton A) (astart A) \/ aend (automaton B) (astart B) ≡ - aend (automaton A) (astart A) \/ aend (automaton B) (astart B) - lemma = refl -closed-in-union {Σ} A B ( h ∷ t ) = lemma1 t ((δ (automaton A) (astart A) h)) ((δ (automaton B) (astart B) h)) where - lemma1 : (t : List Σ) → (qa : states A ) → (qb : states B ) → - accept (automaton A) qa t \/ accept (automaton B) qb t - ≡ accept (automaton (M-Union A B)) (qa , qb) t - lemma1 [] qa qb = refl - lemma1 (h ∷ t ) qa qb = lemma1 t ((δ (automaton A) qa h)) ((δ (automaton B) qb h)) - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/root2.agda --- a/automaton-in-agda/src/agda/root2.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,100 +0,0 @@ -module root2 where - -open import Data.Nat -open import Data.Nat.Properties -open import Data.Empty -open import Data.Unit using (⊤ ; tt) -open import Relation.Nullary -open import Relation.Binary.PropositionalEquality -open import Relation.Binary.Definitions - -open import gcd -open import even -open import nat - -record Rational : Set where - field - i j : ℕ - coprime : gcd i j ≡ 1 - -even→gcd=2 : {n : ℕ} → even n → n > 0 → gcd n 2 ≡ 2 -even→gcd=2 {suc (suc zero)} en (s≤s z≤n) = refl -even→gcd=2 {suc (suc (suc (suc n)))} en (s≤s z≤n) = begin - gcd (suc (suc (suc (suc n)))) 2 ≡⟨⟩ - gcd (suc (suc n)) 2 ≡⟨ even→gcd=2 {suc (suc n)} en (s≤s z≤n) ⟩ - 2 ∎ where open ≡-Reasoning - -even^2 : {n : ℕ} → even ( n * n ) → even n -even^2 {n} en with even? n -... | yes y = y -... | no ne = ⊥-elim ( odd4 ((2 * m) + 2 * m * suc (2 * m)) (n+even {2 * m} {2 * m * suc (2 * m)} ee3 ee4) (subst (λ k → even k) ee2 en )) where - m : ℕ - m = Odd.j ( odd3 n ne ) - ee3 : even (2 * m) - ee3 = subst (λ k → even k ) (*-comm m 2) (n*even {m} {2} tt ) - ee4 : even ((2 * m) * suc (2 * m)) - ee4 = even*n {(2 * m)} {suc (2 * m)} (even*n {2} {m} tt ) - ee2 : n * n ≡ suc (2 * m) + ((2 * m) * (suc (2 * m) )) - ee2 = begin n * n ≡⟨ cong ( λ k → k * k) (Odd.is-twice (odd3 n ne)) ⟩ - suc (2 * m) * suc (2 * m) ≡⟨ *-distribʳ-+ (suc (2 * m)) 1 ((2 * m) ) ⟩ - (1 * suc (2 * m)) + 2 * m * suc (2 * m) ≡⟨ cong (λ k → k + 2 * m * suc (2 * m)) (begin - suc m + 1 * m + 0 * (suc m + 1 * m ) ≡⟨ +-comm (suc m + 1 * m) 0 ⟩ - suc m + 1 * m ≡⟨⟩ - suc (2 * m) - ∎) ⟩ suc (2 * m) + 2 * m * suc (2 * m) ∎ where open ≡-Reasoning - -e3 : {i j : ℕ } → 2 * i ≡ 2 * j → i ≡ j -e3 {zero} {zero} refl = refl -e3 {suc x} {suc y} eq with <-cmp x y -... | tri< a ¬b ¬c = ⊥-elim ( nat-≡< eq (s≤s (<-trans (<-plus a) (<-plus-0 (s≤s (<-plus a )))))) -... | tri≈ ¬a b ¬c = cong suc b -... | tri> ¬a ¬b c = ⊥-elim ( nat-≡< (sym eq) (s≤s (<-trans (<-plus c) (<-plus-0 (s≤s (<-plus c )))))) - -open Factor - -root2-irrational : ( n m : ℕ ) → n > 1 → m > 1 → 2 * n * n ≡ m * m → ¬ (gcd n m ≡ 1) -root2-irrational n m n>1 m>1 2nm = rot13 ( gcd-gt n n m m 2 f2 f2 f2 fm {!!} {!!} {!!} {!!}) where - rot13 : {m : ℕ } → Dividable 2 m → m ≡ 1 → ⊥ - rot13 d refl with Dividable.is-factor d - ... | t = {!!} - rot11 : {m : ℕ } → even m → Factor 2 m - rot11 {zero} em = record { factor = 0 ; remain = 0 ; is-factor = refl } - rot11 {suc zero} () - rot11 {suc (suc m) } em = record { factor = suc (factor fc ) ; remain = remain fc ; is-factor = isfc } where - fc : Factor 2 m - fc = rot11 {m} em - isfc : suc (factor fc) * 2 + remain fc ≡ suc (suc m) - isfc = begin - suc (factor fc) * 2 + remain fc ≡⟨ cong (λ k → k + remain fc) (*-distribʳ-+ 2 1 (factor fc)) ⟩ - ((1 * 2) + (factor fc)* 2 ) + remain fc ≡⟨⟩ - ((1 + 1) + (factor fc)* 2 ) + remain fc ≡⟨ cong (λ k → k + remain fc) (+-assoc 1 1 _ ) ⟩ - (1 + (1 + (factor fc)* 2 )) + remain fc ≡⟨⟩ - suc (suc ((factor fc * 2) + remain fc )) ≡⟨ cong (λ x → suc (suc x)) (is-factor fc) ⟩ - suc (suc m) ∎ where open ≡-Reasoning - rot5 : {n : ℕ} → n > 1 → n > 0 - rot5 {n} lt = <-trans a test2 n) ( 0 ∷ 1 ∷ 2 ∷ 3 ∷ 4 ∷ 5 ∷ 6 ∷ [] ) - -testn : ℕ → List ( CopyStates × ( List ℕ ) × ( List ℕ ) ) -testn 0 = test2 0 ∷ [] -testn (suc n) = test2 n ∷ testn n - diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/agda/utm.agda --- a/automaton-in-agda/src/agda/utm.agda Sun Jun 13 18:48:57 2021 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,250 +0,0 @@ -module utm where - -open import turing -open import Data.Product -open import Data.Bool -open import Data.List -open import Data.Nat - -data utmStates : Set where - reads : utmStates - read0 : utmStates - read1 : utmStates - read2 : utmStates - read3 : utmStates - read4 : utmStates - read5 : utmStates - read6 : utmStates - - loc0 : utmStates - loc1 : utmStates - loc2 : utmStates - loc3 : utmStates - loc4 : utmStates - loc5 : utmStates - loc6 : utmStates - - fetch0 : utmStates - fetch1 : utmStates - fetch2 : utmStates - fetch3 : utmStates - fetch4 : utmStates - fetch5 : utmStates - fetch6 : utmStates - fetch7 : utmStates - - print0 : utmStates - print1 : utmStates - print2 : utmStates - print3 : utmStates - print4 : utmStates - print5 : utmStates - print6 : utmStates - print7 : utmStates - - mov0 : utmStates - mov1 : utmStates - mov2 : utmStates - mov3 : utmStates - mov4 : utmStates - mov5 : utmStates - mov6 : utmStates - - tidy0 : utmStates - tidy1 : utmStates - halt : utmStates - -data utmΣ : Set where - ０ : utmΣ - １ : utmΣ - B : utmΣ - * : utmΣ - $ : utmΣ - ^ : utmΣ - X : utmΣ - Y : utmΣ - Z : utmΣ - ＠ : utmΣ - b : utmΣ - -utmδ : utmStates → utmΣ → utmStates × (Write utmΣ) × Move -utmδ reads x = read0 , wnone , mnone -utmδ read0 * = read1 , write * , left -utmδ read0 x = read0 , write x , right -utmδ read1 x = read2 , write ＠ , right -utmδ read2 ^ = read3 , write ^ , right -utmδ read2 x = read2 , write x , right -utmδ read3 ０ = read4 , write ０ , left -utmδ read3 １ = read5 , write １ , left -utmδ read3 b = read6 , write b , left -utmδ read4 ＠ = loc0 , write ０ , right -utmδ read4 x = read4 , write x , left -utmδ read5 ＠ = loc0 , write １ , right -utmδ read5 x = read5 , write x , left -utmδ read6 ＠ = loc0 , write B , right -utmδ read6 x = read6 , write x , left -utmδ loc0 ０ = loc0 , write X , left -utmδ loc0 １ = loc0 , write Y , left -utmδ loc0 B = loc0 , write Z , left -utmδ loc0 $ = loc1 , write $ , right -utmδ loc0 x = loc0 , write x , left -utmδ loc1 X = loc2 , write ０ , right -utmδ loc1 Y = loc3 , write １ , right -utmδ loc1 Z = loc4 , write B , right -utmδ loc1 * = fetch0 , write * , right -utmδ loc1 x = loc1 , write x , right -utmδ loc2 ０ = loc5 , write X , right -utmδ loc2 １ = loc6 , write Y , right -utmδ loc2 B = loc6 , write Z , right -utmδ loc2 x = loc2 , write x , right -utmδ loc3 １ = loc5 , write Y , right -utmδ loc3 ０ = loc6 , write X , right -utmδ loc3 B = loc6 , write Z , right -utmδ loc3 x = loc3 , write x , right -utmδ loc4 B = loc5 , write Z , right -utmδ loc4 ０ = loc6 , write X , right -utmδ loc4 １ = loc6 , write Y , right -utmδ loc4 x = loc4 , write x , right -utmδ loc5 $ = loc1 , write $ , right -utmδ loc5 x = loc5 , write x , left -utmδ loc6 $ = halt , write $ , right -utmδ loc6 * = loc0 , write * , left -utmδ loc6 x = loc6 , write x , right -utmδ fetch0 ０ = fetch1 , write X , left -utmδ fetch0 １ = fetch2 , write Y , left -utmδ fetch0 B = fetch3 , write Z , left -utmδ fetch0 x = fetch0 , write x , right -utmδ fetch1 $ = fetch4 , write $ , right -utmδ fetch1 x = fetch1 , write x , left -utmδ fetch2 $ = fetch5 , write $ , right -utmδ fetch2 x = fetch2 , write x , left -utmδ fetch3 $ = fetch6 , write $ , right -utmδ fetch3 x = fetch3 , write x , left -utmδ fetch4 ０ = fetch7 , write X , right -utmδ fetch4 １ = fetch7 , write X , right -utmδ fetch4 B = fetch7 , write X , right -utmδ fetch4 * = print0 , write * , left -utmδ fetch4 x = fetch4 , write x , right -utmδ fetch5 ０ = fetch7 , write Y , right -utmδ fetch5 １ = fetch7 , write Y , right -utmδ fetch5 B = fetch7 , write Y , right -utmδ fetch5 * = print0 , write * , left -utmδ fetch5 x = fetch5 , write x , right -utmδ fetch6 ０ = fetch7 , write Z , right -utmδ fetch6 １ = fetch7 , write Z , right -utmδ fetch6 B = fetch7 , write Z , right -utmδ fetch6 * = print0 , write * , left -utmδ fetch6 x = fetch6 , write x , right -utmδ fetch7 * = fetch0 , write * , right -utmδ fetch7 x = fetch7 , write x , right -utmδ print0 X = print1 , write X , right -utmδ print0 Y = print2 , write Y , right -utmδ print0 Z = print3 , write Z , right -utmδ print1 ^ = print4 , write ^ , right -utmδ print1 x = print1 , write x , right -utmδ print2 ^ = print5 , write ^ , right -utmδ print2 x = print2 , write x , right -utmδ print3 ^ = print6 , write ^ , right -utmδ print3 x = print3 , write x , right -utmδ print4 x = print7 , write ０ , left -utmδ print5 x = print7 , write １ , left -utmδ print6 x = print7 , write B , left -utmδ print7 X = mov0 , write X , right -utmδ print7 Y = mov1 , write Y , right -utmδ print7 x = print7 , write x , left -utmδ mov0 ^ = mov2 , write ^ , left -utmδ mov0 x = mov0 , write x , right -utmδ mov1 ^ = mov3 , write ^ , right -utmδ mov1 x = mov1 , write x , right -utmδ mov2 ０ = mov4 , write ^ , right -utmδ mov2 １ = mov5 , write ^ , right -utmδ mov2 B = mov6 , write ^ , right -utmδ mov3 ０ = mov4 , write ^ , left -utmδ mov3 １ = mov5 , write ^ , left -utmδ mov3 B = mov6 , write ^ , left -utmδ mov4 ^ = tidy0 , write ０ , left -utmδ mov5 ^ = tidy0 , write １ , left -utmδ mov6 ^ = tidy0 , write B , left -utmδ tidy0 $ = tidy1 , write $ , left -utmδ tidy0 x = tidy0 , write x , left -utmδ tidy1 X = tidy1 , write ０ , left -utmδ tidy1 Y = tidy1 , write １ , left -utmδ tidy1 Z = tidy1 , write B , left -utmδ tidy1 $ = reads , write $ , right -utmδ tidy1 x = tidy1 , write x , left -utmδ _ x = halt , write x , mnone - -U-TM : Turing utmStates utmΣ -U-TM = record { - tδ = utmδ - ; tstart = read0 - ; tend = tend - ; tnone = b - } where - tend : utmStates → Bool - tend halt = true - tend _ = false - --- Copyδ : CopyStates → ℕ → CopyStates × ( Write ℕ ) × Move --- Copyδ s1 0 = H , wnone , mnone --- Copyδ s1 1 = s2 , write 0 , right --- Copyδ s2 0 = s3 , write 0 , right --- Copyδ s2 1 = s2 , write 1 , right --- Copyδ s3 0 = s4 , write 1 , left --- Copyδ s3 1 = s3 , write 1 , right --- Copyδ s4 0 = s5 , write 0 , left --- Copyδ s4 1 = s4 , write 1 , left --- Copyδ s5 0 = s1 , write 1 , right --- Copyδ s5 1 = s5 , write 1 , left --- Copyδ H _ = H , wnone , mnone --- Copyδ _ (suc (suc _)) = H , wnone , mnone - -Copyδ-encode : List utmΣ -Copyδ-encode = - ０ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ ０ ∷ -- s1 0 = H , wnone , mnone - * ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ １ ∷ -- s1 1 = s2 , write 0 , right - * ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ ０ ∷ １ ∷ -- s2 0 = s3 , write 0 , right - * ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ -- s2 1 = s2 , write 1 , right - * ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ -- s3 0 = s4 , write 1 , left - * ∷ ０ ∷ １ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ -- s3 1 = s3 , write 1 , right - * ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ -- s4 0 = s5 , write 0 , left - * ∷ １ ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ -- s4 1 = s4 , write 1 , left - * ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ -- s5 0 = s1 , write 1 , right - * ∷ １ ∷ ０ ∷ １ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ ０ ∷ -- s5 1 = s5 , write 1 , left - [] - - -input-encode : List utmΣ -input-encode = １ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ [] - -input+Copyδ : List utmΣ -input+Copyδ = ( $ ∷ ０ ∷ ０ ∷ ０ ∷ ０ ∷ * ∷ [] ) -- start state - ++ Copyδ-encode - ++ ( $ ∷ ^ ∷ input-encode ) - -short-input : List utmΣ -short-input = $ ∷ ０ ∷ ０ ∷ ０ ∷ * ∷ - ０ ∷ ０ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ １ ∷ * ∷ - ０ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ １ ∷ １ ∷ * ∷ - ０ ∷ １ ∷ B ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ * ∷ - １ ∷ ０ ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ １ ∷ $ ∷ - ^ ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ [] - -utm-test1 : List utmΣ → utmStates × ( List utmΣ ) × ( List utmΣ ) -utm-test1 inp = Turing.taccept U-TM inp - -{-# TERMINATING #-} -utm-test2 : ℕ → List utmΣ → utmStates × ( List utmΣ ) × ( List utmΣ ) -utm-test2 n inp = loop n (Turing.tstart U-TM) inp [] - where - loop : ℕ → utmStates → ( List utmΣ ) → ( List utmΣ ) → utmStates × ( List utmΣ ) × ( List utmΣ ) - loop zero q L R = ( q , L , R ) - loop (suc n) q L R with move {utmStates} {utmΣ} {０} {utmδ} q L R | q - ... | nq , nL , nR | reads = loop n nq nL nR - ... | nq , nL , nR | _ = loop (suc n) nq nL nR - -t1 = utm-test2 20 short-input - -t : (n : ℕ) → utmStates × ( List utmΣ ) × ( List utmΣ ) --- t n = utm-test2 n input+Copyδ -t n = utm-test2 n short-input diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/automaton-ex.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/automaton-ex.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,76 @@ +module automaton-ex where + +open import Data.Nat +open import Data.List +open import Data.Maybe +open import Relation.Binary.PropositionalEquality hiding ( [_] ) +open import Relation.Nullary using (¬_; Dec; yes; no) +open import logic + +open import automaton +open Automaton + +data StatesQ : Set where + q1 : StatesQ + q2 : StatesQ + q3 : StatesQ + +data In2 : Set where + i0 : In2 + i1 : In2 +transitionQ : StatesQ → In2 → StatesQ +transitionQ q1 i0 = q1 +transitionQ q1 i1 = q2 +transitionQ q2 i0 = q3 +transitionQ q2 i1 = q2 +transitionQ q3 i0 = q2 +transitionQ q3 i1 = q2 + +aendQ : StatesQ → Bool +aendQ q2 = true +aendQ _ = false + +a1 : Automaton StatesQ In2 +a1 = record { + δ = transitionQ + ; aend = aendQ + } + +test1 : accept a1 q1 ( i0 ∷ i1 ∷ i0 ∷ [] ) ≡ false +test1 = refl +test2 = accept a1 q1 ( i0 ∷ i1 ∷ i0 ∷ i1 ∷ [] ) + +data States1 : Set where + sr : States1 + ss : States1 + st : States1 + +transition1 : States1 → In2 → States1 +transition1 sr i0 = sr +transition1 sr i1 = ss +transition1 ss i0 = sr +transition1 ss i1 = st +transition1 st i0 = sr +transition1 st i1 = st + +fin1 : States1 → Bool +fin1 st = true +fin1 ss = false +fin1 sr = false + +am1 : Automaton States1 In2 +am1 = record { δ = transition1 ; aend = fin1 } + + +example1-1 = accept am1 sr ( i0 ∷ i1 ∷ i0 ∷ [] ) +example1-2 = accept am1 sr ( i1 ∷ i1 ∷ i1 ∷ [] ) +trace-2 = trace am1 sr ( i1 ∷ i1 ∷ i1 ∷ [] ) + +example1-3 = reachable am1 sr st ( i1 ∷ i1 ∷ i1 ∷ [] ) + +ieq : (i i' : In2 ) → Dec ( i ≡ i' ) +ieq i0 i0 = yes refl +ieq i1 i1 = yes refl +ieq i0 i1 = no ( λ () ) +ieq i1 i0 = no ( λ () ) + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/automaton.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/automaton.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,40 @@ +module automaton where + +open import Data.Nat +open import Data.List +open import Relation.Binary.PropositionalEquality hiding ( [_] ) +open import logic + +record Automaton ( Q : Set ) ( Σ : Set ) + : Set where + field + δ : Q → Σ → Q + aend : Q → Bool + +open Automaton + +accept : { Q : Set } { Σ : Set } + → Automaton Q Σ + → (astart : Q) + → List Σ → Bool +accept {Q} { Σ} M q [] = aend M q +accept {Q} { Σ} M q ( H ∷ T ) = accept M ( (δ M) q H ) T + +moves : { Q : Set } { Σ : Set } + → Automaton Q Σ + → Q → List Σ → Q +moves {Q} { Σ} M q [] = q +moves {Q} { Σ} M q ( H ∷ T ) = moves M ( δ M q H) T + +trace : { Q : Set } { Σ : Set } + → Automaton Q Σ + → Q → List Σ → List Q +trace {Q} { Σ} M q [] = q ∷ [] +trace {Q} { Σ} M q ( H ∷ T ) = q ∷ trace M ( (δ M) q H ) T + +reachable : { Q : Set } { Σ : Set } + → (M : Automaton Q Σ ) + → (astart q : Q ) + → (L : List Σ ) → Set +reachable M astart q L = moves M astart L ≡ q + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/bijection.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/bijection.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,180 @@ +module bijection where + +open import Level renaming ( zero to Zero ; suc to Suc ) +open import Data.Nat +open import Data.Maybe +open import Data.List hiding ([_]) +open import Data.Nat.Properties +open import Relation.Nullary +open import Data.Empty +open import Data.Unit +open import Relation.Binary.Core hiding (_⇔_) +open import Relation.Binary.Definitions +open import Relation.Binary.PropositionalEquality + +open import logic + +record Bijection {n m : Level} (R : Set n) (S : Set m) : Set (n Level.⊔ m) where + field + fun← : S → R + fun→ : R → S + fiso← : (x : R) → fun← ( fun→ x ) ≡ x + fiso→ : (x : S ) → fun→ ( fun← x ) ≡ x + +injection : {n m : Level} (R : Set n) (S : Set m) (f : R → S ) → Set (n Level.⊔ m) +injection R S f = (x y : R) → f x ≡ f y → x ≡ y + +open Bijection + +b→injection0 : {n m : Level} (R : Set n) (S : Set m) → (b : Bijection R S) → injection R S (fun→ b) +b→injection0 R S b x y eq = begin + x + ≡⟨ sym ( fiso← b x ) ⟩ + fun← b ( fun→ b x ) + ≡⟨ cong (λ k → fun← b k ) eq ⟩ + fun← b ( fun→ b y ) + ≡⟨ fiso← b y ⟩ + y + ∎ where open ≡-Reasoning + +b→injection1 : {n m : Level} (R : Set n) (S : Set m) → (b : Bijection R S) → injection S R (fun← b) +b→injection1 R S b x y eq = trans ( sym ( fiso→ b x ) ) (trans ( cong (λ k → fun→ b k ) eq ) ( fiso→ b y )) + +-- ¬ A = A → ⊥ + +diag : {S : Set } (b : Bijection ( S → Bool ) S) → S → Bool +diag b n = not (fun← b n n) + +diagonal : { S : Set } → ¬ Bijection ( S → Bool ) S +diagonal {S} b = diagn1 (fun→ b (diag b) ) refl where + diagn1 : (n : S ) → ¬ (fun→ b (diag b) ≡ n ) + diagn1 n dn = ¬t=f (diag b n ) ( begin + not (diag b n) + ≡⟨⟩ + not (not fun← b n n) + ≡⟨ cong (λ k → not (k n) ) (sym (fiso← b _)) ⟩ + not (fun← b (fun→ b (diag b)) n) + ≡⟨ cong (λ k → not (fun← b k n) ) dn ⟩ + not (fun← b n n) + ≡⟨⟩ + diag b n + ∎ ) where open ≡-Reasoning + +b1 : (b : Bijection ( ℕ → Bool ) ℕ) → ℕ +b1 b = fun→ b (diag b) + +b-iso : (b : Bijection ( ℕ → Bool ) ℕ) → fun← b (b1 b) ≡ (diag b) +b-iso b = fiso← b _ + +to1 : {n : Level} {R : Set n} → Bijection ℕ R → Bijection ℕ (⊤ ∨ R ) +to1 {n} {R} b = record { + fun← = to11 + ; fun→ = to12 + ; fiso← = to13 + ; fiso→ = to14 + } where + to11 : ⊤ ∨ R → ℕ + to11 (case1 tt) = 0 + to11 (case2 x) = suc ( fun← b x ) + to12 : ℕ → ⊤ ∨ R + to12 zero = case1 tt + to12 (suc n) = case2 ( fun→ b n) + to13 : (x : ℕ) → to11 (to12 x) ≡ x + to13 zero = refl + to13 (suc x) = cong suc (fiso← b x) + to14 : (x : ⊤ ∨ R) → to12 (to11 x) ≡ x + to14 (case1 x) = refl + to14 (case2 x) = cong case2 (fiso→ b x) + +open _∧_ + +open import nat + +open ≡-Reasoning + +-- [] 0 +-- 0 → 1 +-- 1 → 2 +-- 01 → 3 +-- 11 → 4 +-- ... +-- +{-# TERMINATING #-} +LBℕ : Bijection ℕ ( List Bool ) +LBℕ = record { + fun← = λ x → lton x + ; fun→ = λ n → ntol n + ; fiso← = lbiso0 + ; fiso→ = lbisor + } where + lton1 : List Bool → ℕ + lton1 [] = 0 + lton1 (true ∷ t) = suc (lton1 t + lton1 t) + lton1 (false ∷ t) = lton1 t + lton1 t + lton : List Bool → ℕ + lton [] = 0 + lton x = suc (lton1 x) + ntol1 : ℕ → List Bool + ntol1 0 = [] + ntol1 (suc x) with div2 (suc x) + ... | ⟪ x1 , true ⟫ = true ∷ ntol1 x1 -- non terminating + ... | ⟪ x1 , false ⟫ = false ∷ ntol1 x1 + ntol : ℕ → List Bool + ntol 0 = [] + ntol 1 = false ∷ [] + ntol (suc n) = ntol1 n + xx : (x : ℕ ) → List Bool ∧ ℕ + xx x = ⟪ (ntol x) , lton ((ntol x)) ⟫ + add11 : (x1 : ℕ ) → suc x1 + suc x1 ≡ suc (suc (x1 + x1)) + add11 zero = refl + add11 (suc x) = cong (λ k → suc (suc k)) (trans (+-comm x _) (cong suc (+-comm _ x))) + add12 : (x1 x : ℕ ) → suc x1 + x ≡ x1 + suc x + add12 zero x = refl + add12 (suc x1) x = cong suc (add12 x1 x) + ---- div2-eq : (x : ℕ ) → div2-rev ( div2 x ) ≡ x + div20 : (x x1 : ℕ ) → div2 (suc x) ≡ ⟪ x1 , false ⟫ → x1 + x1 ≡ suc x + div20 x x1 eq = begin + x1 + x1 ≡⟨ cong (λ k → div2-rev k ) (sym eq) ⟩ + div2-rev (div2 (suc x)) ≡⟨ div2-eq _ ⟩ + suc x ∎ + 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 ∎ + lbiso1 : (x : ℕ) → suc (lton1 (ntol1 x)) ≡ suc x + lbiso1 zero = refl + lbiso1 (suc x) with div2 (suc x) | inspect div2 (suc x) + ... | ⟪ x1 , true ⟫ | record { eq = eq1 } = begin + suc (suc (lton1 (ntol1 x1) + lton1 (ntol1 x1))) ≡⟨ sym (add11 _) ⟩ + 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) ∎ + ... | ⟪ 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) ∎ + lbiso0 : (x : ℕ) → lton (ntol x) ≡ x + lbiso0 zero = refl + lbiso0 (suc zero) = refl + lbiso0 (suc (suc x)) = subst (λ k → k ≡ suc (suc x)) (hh x) ( lbiso1 (suc x)) where + hh : (x : ℕ ) → suc (lton1 (ntol1 (suc x))) ≡ lton (ntol (suc (suc x))) + hh x with div2 (suc x) + ... | ⟪ _ , true ⟫ = refl + ... | ⟪ _ , false ⟫ = refl + lbisor0 : (x : List Bool) → ntol1 (lton1 (true ∷ x)) ≡ true ∷ x + lbisor0 = {!!} + lbisor1 : (x : List Bool) → ntol1 (lton1 (false ∷ x)) ≡ false ∷ x + lbisor1 = {!!} + lbisor : (x : List Bool) → ntol (lton x) ≡ x + lbisor [] = refl + lbisor (false ∷ []) = refl + lbisor (true ∷ []) = refl + lbisor (false ∷ t) = trans {!!} ( lbisor1 t ) + lbisor (true ∷ t) = trans {!!} ( lbisor0 t ) + + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/cfg.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/cfg.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,134 @@ +module cfg where + +open import Level renaming ( suc to succ ; zero to Zero ) +open import Data.Nat hiding ( _≟_ ) +open import Data.Fin +open import Data.Product +open import Data.List +open import Data.Maybe +open import Data.Bool using ( Bool ; true ; false ; _∧_ ; _∨_ ) +open import Relation.Binary.PropositionalEquality hiding ( [_] ) +open import Relation.Nullary using (¬_; Dec; yes; no) +-- open import Data.String + +open import nfa + +data IsTerm (Token : Set) : Set where + isTerm : Token → IsTerm Token + noTerm : IsTerm Token + +record CFGGrammer (Token Node : Set) : Set (succ Zero) where + field + cfg : Node → List ( List ( Node ) ) + cfgtop : Node + term? : Node → IsTerm Token + tokensz : ℕ + tokenid : Token → Fin tokensz + +open CFGGrammer + +----------------- +-- +-- CGF language +-- +----------------- + +split : {Σ : Set} → (List Σ → Bool) + → ( List Σ → Bool) → List Σ → Bool +split x y [] = x [] ∧ y [] +split x y (h ∷ t) = (x [] ∧ y (h ∷ t)) ∨ + split (λ t1 → x ( h ∷ t1 )) (λ t2 → y t2 ) t + + +cfg-language0 : {Node Token : Set} → CFGGrammer Token Node → List (List Node ) → List Token → Bool + +{-# TERMINATING #-} +cfg-language2 : {Node Token : Set} → CFGGrammer Token Node → Node → List Token → Bool +cfg-language2 cg _ [] = false +cfg-language2 cg x (h1 ∷ [] ) with term? cg x +cfg-language2 cg x (h1 ∷ []) | isTerm t with tokenid cg h1 ≟ tokenid cg t +cfg-language2 cg x (h1 ∷ []) | isTerm t | yes p = true +cfg-language2 cg x (h1 ∷ []) | isTerm t | no ¬p = false +cfg-language2 cg x (h1 ∷ []) | noTerm = cfg-language0 cg (cfg cg x) ( h1 ∷ [] ) +cfg-language2 cg x In with term? cg x +cfg-language2 cg x In | isTerm t = false +cfg-language2 cg x In | noTerm = cfg-language0 cg (cfg cg x ) In + +cfg-language1 : {Node Token : Set} → CFGGrammer Token Node → List Node → List Token → Bool +cfg-language1 cg [] [] = true +cfg-language1 cg [] _ = false +cfg-language1 cg (node ∷ T) = split ( cfg-language2 cg node ) ( cfg-language1 cg T ) + +cfg-language0 cg [] [] = true +cfg-language0 cg [] _ = false +cfg-language0 cg (node ∷ T) In = cfg-language1 cg node In ∨ cfg-language0 cg T In + +cfg-language : {Node Token : Set} → CFGGrammer Token Node → List Token → Bool +cfg-language cg = cfg-language0 cg (cfg cg (cfgtop cg)) + +----------------- + +data IFToken : Set where + t:EA : IFToken + t:EB : IFToken + t:EC : IFToken + t:IF : IFToken + t:THEN : IFToken + t:ELSE : IFToken + t:SA : IFToken + t:SB : IFToken + t:SC : IFToken + +IFtokenid : IFToken → Fin 9 +IFtokenid t:EA = # 0 +IFtokenid t:EB = # 1 +IFtokenid t:EC = # 2 +IFtokenid t:IF = # 3 +IFtokenid t:THEN = # 4 +IFtokenid t:ELSE = # 5 +IFtokenid t:SA = # 6 +IFtokenid t:SB = # 7 +IFtokenid t:SC = # 8 + +data IFNode (T : Set) : Set where + Token : T → IFNode T + expr : IFNode T + statement : IFNode T + +IFGrammer : CFGGrammer IFToken (IFNode IFToken) +IFGrammer = record { + cfg = cfg' + ; cfgtop = statement + ; term? = term?' + ; tokensz = 9 + ; tokenid = IFtokenid + } where + term?' : IFNode IFToken → IsTerm IFToken + term?' (Token x) = isTerm x + term?' _ = noTerm + cfg' : IFNode IFToken → List ( List (IFNode IFToken) ) + cfg' (Token t) = ( (Token t) ∷ [] ) ∷ [] + cfg' expr = ( Token t:EA ∷ [] ) ∷ + ( Token t:EB ∷ [] ) ∷ + ( Token t:EC ∷ [] ) ∷ [] + cfg' statement = ( Token t:SA ∷ [] ) ∷ + ( Token t:SB ∷ [] ) ∷ + ( Token t:SC ∷ [] ) ∷ + ( Token t:IF ∷ expr ∷ statement ∷ [] ) ∷ + ( Token t:IF ∷ expr ∷ statement ∷ Token t:ELSE ∷ statement ∷ [] ) ∷ [] + + +cfgtest1 = cfg-language IFGrammer ( t:SA ∷ [] ) + +cfgtest2 = cfg-language2 IFGrammer (Token t:SA) ( t:SA ∷ [] ) + +cfgtest3 = cfg-language1 IFGrammer (Token t:SA ∷ [] ) ( t:SA ∷ [] ) + +cfgtest4 = cfg-language IFGrammer (t:IF ∷ t:EA ∷ t:SA ∷ [] ) + +cfgtest5 = cfg-language1 IFGrammer (Token t:IF ∷ expr ∷ statement ∷ []) (t:IF ∷ t:EA ∷ t:EA ∷ [] ) +cfgtest6 = cfg-language2 IFGrammer statement (t:IF ∷ t:EA ∷ t:SA ∷ [] ) +cfgtest7 = cfg-language1 IFGrammer (Token t:IF ∷ expr ∷ statement ∷ Token t:ELSE ∷ statement ∷ []) (t:IF ∷ t:EA ∷ t:SA ∷ t:ELSE ∷ t:SB ∷ [] ) + +cfgtest8 = cfg-language IFGrammer (t:IF ∷ t:EA ∷ t:IF ∷ t:EB ∷ t:SA ∷ t:ELSE ∷ t:SB ∷ [] ) + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/cfg1.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/cfg1.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,184 @@ +module cfg1 where + +open import Level renaming ( suc to succ ; zero to Zero ) +open import Data.Nat hiding ( _≟_ ) +open import Data.Fin +open import Data.Product +open import Data.List +open import Data.Maybe +open import Data.Bool using ( Bool ; true ; false ; _∧_ ; _∨_ ) +open import Relation.Binary.PropositionalEquality hiding ( [_] ) +open import Relation.Nullary using (¬_; Dec; yes; no) + +-- +-- Java → Java Byte Code +-- +-- CFG Stack Machine (PDA) +-- + + +data Node (Symbol : Set) : Set where + T : Symbol → Node Symbol + N : Symbol → Node Symbol + +data Seq (Symbol : Set) : Set where + _，_ : Symbol → Seq Symbol → Seq Symbol + _． : Symbol → Seq Symbol + Error : Seq Symbol + +data Body (Symbol : Set) : Set where + _｜_ : Seq Symbol → Body Symbol → Body Symbol + _； : Seq Symbol → Body Symbol + +record CFGGrammer (Symbol : Set) : Set where + field + cfg : Symbol → Body Symbol + top : Symbol + eq? : Symbol → Symbol → Bool + typeof : Symbol → Node Symbol + +infixr 80 _｜_ +infixr 90 _； +infixr 100 _，_ +infixr 110 _． + +open CFGGrammer + +----------------- +-- +-- CGF language +-- +----------------- + +split : {Σ : Set} → (List Σ → Bool) + → ( List Σ → Bool) → List Σ → Bool +split x y [] = x [] ∧ y [] +split x y (h ∷ t) = (x [] ∧ y (h ∷ t)) ∨ + split (λ t1 → x ( h ∷ t1 )) (λ t2 → y t2 ) t + + +cfg-language0 : {Symbol : Set} → CFGGrammer Symbol → Body Symbol → List Symbol → Bool + +{-# TERMINATING #-} +cfg-language1 : {Symbol : Set} → CFGGrammer Symbol → Seq Symbol → List Symbol → Bool +cfg-language1 cg Error x = false +cfg-language1 cg (S ， seq) x with typeof cg S +cfg-language1 cg (_ ， seq) (x' ∷ t) | T x = eq? cg x x' ∧ cfg-language1 cg seq t +cfg-language1 cg (_ ， seq) [] | T x = false +cfg-language1 cg (_ ， seq) x | N nonTerminal = split (cfg-language0 cg (cfg cg nonTerminal) )(cfg-language1 cg seq ) x +cfg-language1 cg (S ．) x with typeof cg S +cfg-language1 cg (_ ．) (x' ∷ []) | T x = eq? cg x x' +cfg-language1 cg (_ ．) _ | T x = false +cfg-language1 cg (_ ．) x | N nonTerminal = cfg-language0 cg (cfg cg nonTerminal) x + +cfg-language0 cg _ [] = false +cfg-language0 cg (rule ｜ b) x = + cfg-language1 cg rule x ∨ cfg-language0 cg b x +cfg-language0 cg (rule ；) x = cfg-language1 cg rule x + +cfg-language : {Symbol : Set} → CFGGrammer Symbol → List Symbol → Bool +cfg-language cg = cfg-language0 cg (cfg cg (top cg )) + + +data IFToken : Set where + EA : IFToken + EB : IFToken + EC : IFToken + IF : IFToken + THEN : IFToken + ELSE : IFToken + SA : IFToken + SB : IFToken + SC : IFToken + expr : IFToken + statement : IFToken + +token-eq? : IFToken → IFToken → Bool +token-eq? EA EA = true +token-eq? EB EB = true +token-eq? EC EC = true +token-eq? IF IF = true +token-eq? THEN THEN = true +token-eq? ELSE ELSE = true +token-eq? SA SA = true +token-eq? SB SB = true +token-eq? SC SC = true +token-eq? expr expr = true +token-eq? statement statement = true +token-eq? _ _ = false + +typeof-IFG : IFToken → Node IFToken +typeof-IFG expr = N expr +typeof-IFG statement = N statement +typeof-IFG x = T x + +IFGrammer : CFGGrammer IFToken +IFGrammer = record { + cfg = cfg' + ; top = statement + ; eq? = token-eq? + ; typeof = typeof-IFG + } where + cfg' : IFToken → Body IFToken + cfg' expr = EA ． ｜ EB ． ｜ EC ． ； + cfg' statement = + SA ． ｜ SB ． ｜ SC ． + ｜ IF ， expr ， THEN ， statement ． + ｜ IF ， expr ， THEN ， statement ， ELSE ， statement ． + ； + cfg' x = Error ； + +cfgtest1 = cfg-language IFGrammer ( SA ∷ [] ) + +cfgtest2 = cfg-language1 IFGrammer ( SA ．) ( SA ∷ [] ) + +cfgtest3 = cfg-language1 IFGrammer ( SA ． ) ( SA ∷ [] ) + +cfgtest4 = cfg-language IFGrammer (IF ∷ EA ∷ THEN ∷ SA ∷ [] ) + +cfgtest5 = cfg-language1 IFGrammer ( IF ， expr ， THEN ， statement ． ) (IF ∷ EA ∷ THEN ∷ SA ∷ [] ) +cfgtest6 = cfg-language1 IFGrammer ( statement ．)(IF ∷ EA ∷ SA ∷ [] ) +cfgtest7 = cfg-language1 IFGrammer ( IF ， expr ， THEN ， statement ， ELSE ， statement ． ) + (IF ∷ EA ∷ THEN ∷ SA ∷ ELSE ∷ SB ∷ [] ) +cfgtest8 = cfg-language IFGrammer (IF ∷ EA ∷ THEN ∷ IF ∷ EB ∷ THEN ∷ SA ∷ ELSE ∷ SB ∷ [] ) +cfgtest9 = cfg-language IFGrammer (IF ∷ EB ∷ THEN ∷ SA ∷ ELSE ∷ SB ∷ [] ) + +data E1Token : Set where + e1 : E1Token + e[ : E1Token + e] : E1Token + expr : E1Token + term : E1Token + +E1-token-eq? : E1Token → E1Token → Bool +E1-token-eq? e1 e1 = true +E1-token-eq? e[ e] = true +E1-token-eq? e] e] = true +E1-token-eq? expr expr = true +E1-token-eq? term term = true +E1-token-eq? _ _ = false + +typeof-E1 : E1Token → Node E1Token +typeof-E1 expr = N expr +typeof-E1 term = N term +typeof-E1 x = T x + +E1Grammer : CFGGrammer E1Token +E1Grammer = record { + cfg = cfgE + ; top = expr + ; eq? = E1-token-eq? + ; typeof = typeof-E1 + } where + cfgE : E1Token → Body E1Token + cfgE expr = term ． + ； + cfgE term = e1 ． + ｜ e[ ， expr ， e] ． + ； + cfgE x = Error ； + +ecfgtest1 = cfg-language E1Grammer ( e1 ∷ [] ) +ecfgtest2 = cfg-language E1Grammer ( e[ ∷ e1 ∷ e] ∷ [] ) +ecfgtest3 = cfg-language E1Grammer ( e[ ∷ e[ ∷ e1 ∷ e] ∷ e] ∷ [] ) + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/chap0.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/chap0.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,210 @@ +module chap0 where + +open import Data.List +open import Data.Nat hiding (_⊔_) +-- open import Data.Integer hiding (_⊔_ ; _≟_ ; _+_ ) +open import Data.Product + +A : List ℕ +A = 1 ∷ 2 ∷ [] + +data Literal : Set where + x : Literal + y : Literal + z : Literal + +B : List Literal +B = x ∷ y ∷ z ∷ [] + + +ListProduct : {A B : Set } → List A → List B → List ( A × B ) +ListProduct = {!!} + +ex05 : List ( ℕ × Literal ) +ex05 = ListProduct A B -- (1 , x) ∷ (1 , y) ∷ (1 , z) ∷ (2 , x) ∷ (2 , y) ∷ (2 , z) ∷ [] + +ex06 : List ( ℕ × Literal × ℕ ) +ex06 = ListProduct A (ListProduct B A) + +ex07 : Set +ex07 = ℕ × ℕ + +data ex08-f : ℕ → ℕ → Set where + ex08f0 : ex08-f 0 1 + ex08f1 : ex08-f 1 2 + ex08f2 : ex08-f 2 3 + ex08f3 : ex08-f 3 4 + ex08f4 : ex08-f 4 0 + +data ex09-g : ℕ → ℕ → ℕ → ℕ → Set where + ex09g0 : ex09-g 0 1 2 3 + ex09g1 : ex09-g 1 2 3 0 + ex09g2 : ex09-g 2 3 0 1 + ex09g3 : ex09-g 3 0 1 2 + +open import Data.Nat.DivMod +open import Relation.Binary.PropositionalEquality +open import Relation.Binary.Core +open import Data.Nat.Properties + +-- _%_ : ℕ → ℕ → ℕ +-- _%_ a b with <-cmp a b +-- _%_ a b | tri< a₁ ¬b ¬c = a +-- _%_ a b | tri≈ ¬a b₁ ¬c = 0 +-- _%_ a b | tri> ¬a ¬b c = _%_ (a - b) b + +_≡7_ : ℕ → ℕ → Set +n ≡7 m = (n % 7) ≡ (m % 7 ) + +refl7 : { n : ℕ} → n ≡7 n +refl7 = {!!} + +sym7 : { n m : ℕ} → n ≡7 m → m ≡7 n +sym7 = {!!} + +trans7 : { n m o : ℕ} → n ≡7 m → m ≡7 o → n ≡7 o +trans7 = {!!} + +open import Level renaming ( zero to Zero ; suc to Suc ) + +record Graph { v v' : Level } : Set (Suc v ⊔ Suc v' ) where + field + vertex : Set v + edge : vertex → vertex → Set v' + +open Graph + +-- open import Data.Fin hiding ( _≟_ ) +open import Data.Empty +open import Relation.Nullary +open import Data.Unit hiding ( _≟_ ) + + +-- data Dec (P : Set) : Set where +-- yes : P → Dec P +-- no : ¬ P → Dec P +-- +-- _≟_ : (s t : ℕ ) → Dec ( s ≡ t ) + +-- ¬ A = A → ⊥ + +_n≟_ : (s t : ℕ ) → Dec ( s ≡ t ) +zero n≟ zero = yes refl +zero n≟ suc t = no (λ ()) +suc s n≟ zero = no (λ ()) +suc s n≟ suc t with s n≟ t +... | yes refl = yes refl +... | no n = no (λ k → n (tt1 k) ) where + tt1 : suc s ≡ suc t → s ≡ t + tt1 refl = refl + +open import Data.Bool hiding ( _≟_ ) + +conn : List ( ℕ × ℕ ) → ℕ → ℕ → Bool +conn [] _ _ = false +conn ((n1 , m1 ) ∷ t ) n m with n ≟ n1 | m ≟ m1 +conn ((n1 , m1) ∷ t) n m | yes refl | yes refl = true +conn ((n1 , m1) ∷ t) n m | _ | _ = conn t n m + +list012a : List ( ℕ × ℕ ) +list012a = (1 , 2) ∷ (2 , 3) ∷ (3 , 4) ∷ (4 , 5) ∷ (5 , 1) ∷ [] + +graph012a : Graph {Zero} {Zero} +graph012a = record { vertex = ℕ ; edge = λ s t → (conn list012a s t) ≡ true } + +data edge012b : ℕ → ℕ → Set where + e012b-1 : edge012b 1 2 + e012b-2 : edge012b 1 3 + e012b-3 : edge012b 1 4 + e012b-4 : edge012b 2 3 + e012b-5 : edge012b 2 4 + e012b-6 : edge012b 3 4 + +edge? : (E : ℕ → ℕ → Set) → ( a b : ℕ ) → Set +edge? E a b = Dec ( E a b ) + +lemma3 : ( a b : ℕ ) → edge? edge012b a b +lemma3 1 2 = yes e012b-1 +lemma3 1 3 = yes e012b-2 +lemma3 1 4 = yes e012b-3 +lemma3 2 3 = yes e012b-4 +lemma3 2 4 = yes e012b-5 +lemma3 3 4 = yes e012b-6 +lemma3 1 1 = no ( λ () ) +lemma3 2 1 = no ( λ () ) +lemma3 2 2 = no ( λ () ) +lemma3 3 1 = no ( λ () ) +lemma3 3 2 = no ( λ () ) +lemma3 3 3 = no ( λ () ) +lemma3 0 _ = no ( λ () ) +lemma3 _ 0 = no ( λ () ) +lemma3 _ (suc (suc (suc (suc (suc _))))) = no ( λ () ) +lemma3 (suc (suc (suc (suc _)))) _ = no ( λ () ) + +graph012b : Graph {Zero} {Zero} +graph012b = record { vertex = ℕ ; edge = edge012b } + +data connected { V : Set } ( E : V -> V -> Set ) ( x y : V ) : Set where + direct : E x y → connected E x y + indirect : ( z : V ) -> E x z → connected {V} E z y → connected E x y + +lemma1 : connected ( edge graph012a ) 1 2 +lemma1 = direct refl where + +lemma1-2 : connected ( edge graph012a ) 1 3 +lemma1-2 = indirect 2 refl (direct refl ) + +lemma2 : connected ( edge graph012b ) 1 2 +lemma2 = direct e012b-1 + +reachable : { V : Set } ( E : V -> V -> Set ) ( x y : V ) -> Set +reachable {V} E X Y = Dec ( connected {V} E X Y ) + +dag : { V : Set } ( E : V -> V -> Set ) -> Set +dag {V} E = ∀ (n : V) → ¬ ( connected E n n ) + +open import Function + +lemma4 : ¬ ( dag ( edge graph012a) ) +lemma4 neg = neg 1 $ indirect 2 refl $ indirect 3 refl $ indirect 4 refl $ indirect 5 refl $ direct refl + +dgree : List ( ℕ × ℕ ) → ℕ → ℕ +dgree [] _ = 0 +dgree ((e , e1) ∷ t) e0 with e0 ≟ e | e0 ≟ e1 +dgree ((e , e1) ∷ t) e0 | yes _ | _ = 1 + (dgree t e0) +dgree ((e , e1) ∷ t) e0 | _ | yes p = 1 + (dgree t e0) +dgree ((e , e1) ∷ t) e0 | no _ | no _ = dgree t e0 + +dgree-c : {t : Set} → List ( ℕ × ℕ ) → ℕ → (ℕ → t) → t +dgree-c {t} [] e0 next = next 0 +dgree-c {t} ((e , e1) ∷ tail ) e0 next with e0 ≟ e | e0 ≟ e1 +... | yes _ | _ = dgree-c tail e0 ( λ n → next (n + 1 )) +... | _ | yes _ = dgree-c tail e0 ( λ n → next (n + 1 )) +... | no _ | no _ = dgree-c tail e0 next + +lemma6 = dgree list012a 2 +lemma7 = dgree-c list012a 2 ( λ n → n ) + +even2 : (n : ℕ ) → n % 2 ≡ 0 → (n + 2) % 2 ≡ 0 +even2 0 refl = refl +even2 1 () +even2 (suc (suc n)) eq = trans ([a+n]%n≡a%n n _) eq -- [a+n]%n≡a%n : ∀ a n → (a + suc n) % suc n ≡ a % suc n + +sum-of-dgree : ( g : List ( ℕ × ℕ )) → ℕ +sum-of-dgree [] = 0 +sum-of-dgree ((e , e1) ∷ t) = 2 + sum-of-dgree t + +dgree-even : ( g : List ( ℕ × ℕ )) → sum-of-dgree g % 2 ≡ 0 +dgree-even [] = refl +dgree-even ((e , e1) ∷ t) = begin + sum-of-dgree ((e , e1) ∷ t) % 2 + ≡⟨⟩ + (2 + sum-of-dgree t ) % 2 + ≡⟨ cong ( λ k → k % 2 ) ( +-comm 2 (sum-of-dgree t) ) ⟩ + (sum-of-dgree t + 2) % 2 + ≡⟨ [a+n]%n≡a%n (sum-of-dgree t) _ ⟩ + sum-of-dgree t % 2 + ≡⟨ dgree-even t ⟩ + 0 + ∎ where open ≡-Reasoning + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/derive.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/derive.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,126 @@ +{-# OPTIONS --allow-unsolved-metas #-} + +open import Relation.Binary.PropositionalEquality hiding ( [_] ) +open import Relation.Nullary using (¬_; Dec; yes; no) +open import Data.List hiding ( [_] ) + +module derive ( Σ : Set) ( eq? : (x y : Σ) → Dec (x ≡ y)) where + +-- open import nfa +open import Data.Nat +-- open import Data.Nat hiding ( _<_ ; _>_ ) +-- open import Data.Fin hiding ( _<_ ) + +open import finiteSet +open import FSetUtil +open import automaton +open import logic +open import regex + +empty? : Regex Σ → Bool +empty? ε = true +empty? φ = false +empty? (x *) = true +empty? (x & y) = empty? x /\ empty? y +empty? (x || y) = empty? x \/ empty? y +empty? < x > = false + +derivative0 : Regex Σ → Σ → Regex Σ +derivative0 ε s = φ +derivative0 φ s = φ +derivative0 (x *) s = derivative0 x s & (x *) +derivative0 (x & y) s with empty? x +... | true = (derivative0 x s & y) || derivative0 y s +... | false = derivative0 x s & y +derivative0 (x || y) s = derivative0 x s || derivative0 y s +derivative0 < x > s with eq? x s +... | yes _ = ε +... | no _ = φ + +derivative : Regex Σ → Σ → Regex Σ +derivative ε s = φ +derivative φ s = φ +derivative (x *) s with derivative x s +... | ε = x * +... | φ = φ +... | t = t & (x *) +derivative (x & y) s with empty? x +... | true with derivative x s | derivative y s +... | ε | φ = φ +... | ε | t = y || t +... | φ | t = t +... | x1 | φ = x1 & y +... | x1 | y1 = (x1 & y) || y1 +derivative (x & y) s | false with derivative x s +... | ε = y +... | φ = φ +... | t = t & y +derivative (x || y) s with derivative x s | derivative y s +... | φ | y1 = y1 +... | x1 | φ = x1 +... | x1 | y1 = x1 || y1 +derivative < x > s with eq? x s +... | yes _ = ε +... | no _ = φ + +data regex-states (x : Regex Σ ) : Regex Σ → Set where + unit : regex-states x x + derive : { y : Regex Σ } → regex-states x y → (s : Σ) → regex-states x ( derivative y s ) + +record Derivative (x : Regex Σ ) : Set where + field + state : Regex Σ + is-derived : regex-states x state + +open Derivative + +open import Data.Fin + +-- derivative generates (x & y) || ... form. y and x part is a substerm of original regex +-- since subterm is finite, only finite number of state is negerated, if we normalize ||-list. + +data subterm (r : Regex Σ) : Regex Σ → Set where + sε : subterm r ε + sφ : subterm r φ + orig : subterm r r + x& : {x y : Regex Σ } → subterm r (x & y) → subterm r x + &y : {x y : Regex Σ } → subterm r (x & y) → subterm r y + x| : {x y : Regex Σ } → subterm r (x || y) → subterm r x + |y : {x y : Regex Σ } → subterm r (x || y) → subterm r y + s* : {x : Regex Σ } → subterm r (x *) → subterm r x + s<_> : (s : Σ) → subterm r < s > → subterm r < s > + +record Subterm (r : Regex Σ) : Set where + field + subt : Regex Σ + is-subt : subterm r subt + +finsub : (r : Regex Σ ) → FiniteSet (Subterm r) +finsub ε = {!!} +finsub φ = {!!} +finsub (r *) = {!!} +finsub (r & r₁) = {!!} +finsub (r || r₁) = {!!} +finsub < x > = {!!} + +finsubList : (r : Regex Σ ) → FiniteSet (Subterm r ∧ Subterm r → Bool ) +finsubList r = fin→ ( fin-∧ (finsub r) (finsub r) ) + +-- derivative is subset of Subterm r → Subterm r → Bool + +der2ssb : {r : Regex Σ } → Derivative r → Subterm r ∧ Subterm r → Bool +der2ssb = {!!} + +-- we cannot say this, because Derivative is redundant +-- der2inject : {r : Regex Σ } → (x y : Derivative r ) → ( ( s t : Subterm r ∧ Subterm r ) → der2ssb x s ≡ der2ssb y t ) → x ≡ y + +-- this does not work, becuase it depends on input sequences +-- finite-derivative : (r : Regex Σ) → FiniteSet Σ → FiniteSet (Derivative r) + +-- in case of automaton, number of derivative is limited by iteration of input length, so it is finite. + +regex→automaton : (r : Regex Σ) → Automaton (Derivative r) Σ +regex→automaton r = record { δ = λ d s → record { state = derivative (state d) s ; is-derived = derive-step d s} ; aend = λ d → empty? (state d) } where + derive-step : (d0 : Derivative r) → (s : Σ) → regex-states r (derivative (state d0) s) + derive-step d0 s = derive (is-derived d0) s + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/even.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/even.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,71 @@ +module even where + +open import Data.Nat +open import Data.Nat.Properties +open import Data.Empty +open import Data.Unit using (⊤ ; tt) +open import Relation.Nullary +open import Relation.Binary.PropositionalEquality +open import Relation.Binary.Definitions +open import nat +open import logic + +even : (n : ℕ ) → Set +even zero = ⊤ +even (suc zero) = ⊥ +even (suc (suc n)) = even n + +even? : (n : ℕ ) → Dec ( even n ) +even? zero = yes tt +even? (suc zero) = no (λ ()) +even? (suc (suc n)) = even? n + +n+even : {n m : ℕ } → even n → even m → even ( n + m ) +n+even {zero} {zero} tt tt = tt +n+even {zero} {suc m} tt em = em +n+even {suc (suc n)} {m} en em = n+even {n} {m} en em + +n*even : {m n : ℕ } → even n → even ( m * n ) +n*even {zero} {n} en = tt +n*even {suc m} {n} en = n+even {n} {m * n} en (n*even {m} {n} en) + +even*n : {n m : ℕ } → even n → even ( n * m ) +even*n {n} {m} en = subst even (*-comm m n) (n*even {m} {n} en) + + +record Even (i : ℕ) : Set where + field + j : ℕ + is-twice : i ≡ 2 * j + +e2 : (i : ℕ) → even i → Even i +e2 zero en = record { j = 0 ; is-twice = refl } +e2 (suc (suc i)) en = record { j = suc (Even.j (e2 i en )) ; is-twice = e21 } where + e21 : suc (suc i) ≡ 2 * suc (Even.j (e2 i en)) + e21 = begin + suc (suc i) ≡⟨ cong (λ k → suc (suc k)) (Even.is-twice (e2 i en)) ⟩ + suc (suc (2 * Even.j (e2 i en))) ≡⟨ sym (*-distribˡ-+ 2 1 _) ⟩ + 2 * suc (Even.j (e2 i en)) ∎ where open ≡-Reasoning + +record Odd (i : ℕ) : Set where + field + j : ℕ + is-twice : i ≡ suc (2 * j ) + +odd2 : (i : ℕ) → ¬ even i → even (suc i) +odd2 zero ne = ⊥-elim ( ne tt ) +odd2 (suc zero) ne = tt +odd2 (suc (suc i)) ne = odd2 i ne + +odd3 : (i : ℕ) → ¬ even i → Odd i +odd3 zero ne = ⊥-elim ( ne tt ) +odd3 (suc zero) ne = record { j = 0 ; is-twice = refl } +odd3 (suc (suc i)) ne = record { j = Even.j (e2 (suc i) (odd2 i ne)) ; is-twice = odd31 } where + odd31 : suc (suc i) ≡ suc (2 * Even.j (e2 (suc i) (odd2 i ne))) + odd31 = begin + suc (suc i) ≡⟨ cong suc (Even.is-twice (e2 (suc i) (odd2 i ne))) ⟩ + suc (2 * (Even.j (e2 (suc i) (odd2 i ne)))) ∎ where open ≡-Reasoning + +odd4 : (i : ℕ) → even i → ¬ even ( suc i ) +odd4 (suc (suc i)) en en1 = odd4 i en en1 + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/fin.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/fin.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,117 @@ +{-# OPTIONS --allow-unsolved-metas #-} + +module fin where + +open import Data.Fin hiding (_<_ ; _≤_ ) +open import Data.Fin.Properties hiding ( <-trans ) +open import Data.Nat +open import logic +open import nat +open import Relation.Binary.PropositionalEquality + + +-- toℕ 0 → Data.Nat.pred (toℕ f) < n +predn = ⊥-elim (nat-≤> i>n (fin ¬a ¬b c = ⊥-elim ( nat-≤> m ¬a ¬b c = j0 +gcd1 zero i0 (suc zero) j0 = 1 +gcd1 zero zero (suc (suc j)) j0 = j0 +gcd1 zero (suc i0) (suc (suc j)) j0 = gcd1 i0 (suc i0) (suc j) (suc (suc j)) +gcd1 (suc zero) i0 zero j0 = 1 +gcd1 (suc (suc i)) i0 zero zero = i0 +gcd1 (suc (suc i)) i0 zero (suc j0) = gcd1 (suc i) (suc (suc i)) j0 (suc j0) +gcd1 (suc i) i0 (suc j) j0 = gcd1 i i0 j j0 + +gcd : ( i j : ℕ ) → ℕ +gcd i j = gcd1 i i j j + +gcd-gt : ( i i0 j j0 k : ℕ ) → (if : Factor k i) (i0f : Factor k i0 ) (jf : Factor k i ) (j0f : Factor k j0) + → remain i0f ≡ 0 → remain j0f ≡ 0 + → (remain if + i ) ≡ i0 → (remain jf + j ) ≡ j0 + → Dividable k ( gcd1 i i0 j j0 ) +gcd-gt zero i0 zero j0 k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 with <-cmp i0 j0 +... | tri< a ¬b ¬c = record { factor = factor i0f ; is-factor = ifk0 i0 k i0f i0=0 } +... | tri≈ ¬a refl ¬c = record { factor = factor i0f ; is-factor = ifk0 i0 k i0f i0=0 } +... | tri> ¬a ¬b c = record { factor = factor j0f ; is-factor = ifk0 j0 k j0f j0=0 } +gcd-gt zero i0 (suc zero) j0 k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 = {!!} -- can't happen +gcd-gt zero zero (suc (suc j)) j0 k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 = record { factor = factor j0f ; is-factor = ifk0 j0 k j0f j0=0 } +gcd-gt zero (suc i0) (suc (suc j)) j0 k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 = + gcd-gt i0 (suc i0) (suc j) (suc (suc j)) k (decf i0f) i0f (decf i0f) + record { factor = factor jf ; remain = remain jf ; is-factor = {!!} } i0=0 {!!} {!!} {!!} +gcd-gt (suc zero) i0 zero j0 k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 = {!!} -- can't happen +gcd-gt (suc (suc i)) i0 zero zero k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 = {!!} +gcd-gt (suc (suc i)) i0 zero (suc j0) k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 = + gcd-gt (suc i) (suc (suc i)) j0 (suc j0) k (decf if) {!!} (decf jf) j0f j0=0 {!!} {!!} {!!} +gcd-gt (suc zero) i0 (suc j) j0 k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 = + gcd-gt zero i0 j j0 k (decf if) i0f (decf jf) j0f i0=0 j0=0 {!!} {!!} +gcd-gt (suc (suc i)) i0 (suc j) j0 k if i0f jf j0f i0=0 j0=0 ir=i0 jr=j0 = + gcd-gt (suc i) i0 j j0 k (decf if) i0f (decf jf) j0f i0=0 j0=0 {!!} {!!} + +-- gcd26 : { n m : ℕ} → n > 1 → m > 1 → n - m > 0 → gcd n m ≡ gcd (n - m) m +-- gcd27 : { n m : ℕ} → n > 1 → m > 1 → n - m > 0 → gcd n k ≡ k → k ≤ n + +gcd22 : ( i i0 o o0 : ℕ ) → gcd1 (suc i) i0 (suc o) o0 ≡ gcd1 i i0 o o0 +gcd22 zero i0 zero o0 = refl +gcd22 zero i0 (suc o) o0 = refl +gcd22 (suc i) i0 zero o0 = refl +gcd22 (suc i) i0 (suc o) o0 = refl + +gcd20 : (i : ℕ) → gcd i 0 ≡ i +gcd20 zero = refl +gcd20 (suc i) = gcd201 (suc i) where + gcd201 : (i : ℕ ) → gcd1 i i zero zero ≡ i + gcd201 zero = refl + gcd201 (suc zero) = refl + gcd201 (suc (suc i)) = refl + +gcdmm : (n m : ℕ) → gcd1 n m n m ≡ m +gcdmm zero m with <-cmp m m +... | tri< a ¬b ¬c = refl +... | tri≈ ¬a refl ¬c = refl +... | tri> ¬a ¬b c = refl +gcdmm (suc n) m = subst (λ k → k ≡ m) (sym (gcd22 n m n m )) (gcdmm n m ) + +gcdsym2 : (i j : ℕ) → gcd1 zero i zero j ≡ gcd1 zero j zero i +gcdsym2 i j with <-cmp i j | <-cmp j i +... | tri< a ¬b ¬c | tri< a₁ ¬b₁ ¬c₁ = ⊥-elim (nat-<> a a₁) +... | tri< a ¬b ¬c | tri≈ ¬a b ¬c₁ = ⊥-elim (nat-≡< (sym b) a) +... | tri< a ¬b ¬c | tri> ¬a ¬b₁ c = refl +... | tri≈ ¬a b ¬c | tri< a ¬b ¬c₁ = ⊥-elim (nat-≡< (sym b) a) +... | tri≈ ¬a refl ¬c | tri≈ ¬a₁ refl ¬c₁ = refl +... | tri≈ ¬a b ¬c | tri> ¬a₁ ¬b c = ⊥-elim (nat-≡< b c) +... | tri> ¬a ¬b c | tri< a ¬b₁ ¬c = refl +... | tri> ¬a ¬b c | tri≈ ¬a₁ b ¬c = ⊥-elim (nat-≡< b c) +... | tri> ¬a ¬b c | tri> ¬a₁ ¬b₁ c₁ = ⊥-elim (nat-<> c c₁) +gcdsym1 : ( i i0 j j0 : ℕ ) → gcd1 i i0 j j0 ≡ gcd1 j j0 i i0 +gcdsym1 zero zero zero zero = refl +gcdsym1 zero zero zero (suc j0) = refl +gcdsym1 zero (suc i0) zero zero = refl +gcdsym1 zero (suc i0) zero (suc j0) = gcdsym2 (suc i0) (suc j0) +gcdsym1 zero zero (suc zero) j0 = refl +gcdsym1 zero zero (suc (suc j)) j0 = refl +gcdsym1 zero (suc i0) (suc zero) j0 = refl +gcdsym1 zero (suc i0) (suc (suc j)) j0 = gcdsym1 i0 (suc i0) (suc j) (suc (suc j)) +gcdsym1 (suc zero) i0 zero j0 = refl +gcdsym1 (suc (suc i)) i0 zero zero = refl +gcdsym1 (suc (suc i)) i0 zero (suc j0) = gcdsym1 (suc i) (suc (suc i))j0 (suc j0) +gcdsym1 (suc i) i0 (suc j) j0 = subst₂ (λ j k → j ≡ k ) (sym (gcd22 i _ _ _)) (sym (gcd22 j _ _ _)) (gcdsym1 i i0 j j0 ) + +gcdsym : { n m : ℕ} → gcd n m ≡ gcd m n +gcdsym {n} {m} = gcdsym1 n n m m + +gcd11 : ( i : ℕ ) → gcd i i ≡ i +gcd11 i = gcdmm i i + +gcd203 : (i : ℕ) → gcd1 (suc i) (suc i) i i ≡ 1 +gcd203 zero = refl +gcd203 (suc i) = gcd205 (suc i) where + gcd205 : (j : ℕ) → gcd1 (suc j) (suc (suc i)) j (suc i) ≡ 1 + gcd205 zero = refl + gcd205 (suc j) = subst (λ k → k ≡ 1) (gcd22 (suc j) (suc (suc i)) j (suc i)) (gcd205 j) +gcd204 : (i : ℕ) → gcd1 1 1 i i ≡ 1 +gcd204 zero = refl +gcd204 (suc zero) = refl +gcd204 (suc (suc zero)) = refl +gcd204 (suc (suc (suc i))) = gcd204 (suc (suc i)) + +gcd2 : ( i j : ℕ ) → gcd (i + j) j ≡ gcd i j +gcd2 i j = gcd200 i i j j refl refl where + gcd202 : (i j1 : ℕ) → (i + suc j1) ≡ suc (i + j1) + gcd202 zero j1 = refl + gcd202 (suc i) j1 = cong suc (gcd202 i j1) + gcd201 : (i i0 j j0 j1 : ℕ) → gcd1 (i + j1) (i0 + suc j) j1 j0 ≡ gcd1 i (i0 + suc j) zero j0 + gcd201 i i0 j j0 zero = subst (λ k → gcd1 k (i0 + suc j) zero j0 ≡ gcd1 i (i0 + suc j) zero j0 ) (+-comm zero i) refl + gcd201 i i0 j j0 (suc j1) = begin + gcd1 (i + suc j1) (i0 + suc j) (suc j1) j0 ≡⟨ cong (λ k → gcd1 k (i0 + suc j) (suc j1) j0 ) (gcd202 i j1) ⟩ + gcd1 (suc (i + j1)) (i0 + suc j) (suc j1) j0 ≡⟨ gcd22 (i + j1) (i0 + suc j) j1 j0 ⟩ + gcd1 (i + j1) (i0 + suc j) j1 j0 ≡⟨ gcd201 i i0 j j0 j1 ⟩ + gcd1 i (i0 + suc j) zero j0 ∎ where open ≡-Reasoning + gcd200 : (i i0 j j0 : ℕ) → i ≡ i0 → j ≡ j0 → gcd1 (i + j) (i0 + j) j j0 ≡ gcd1 i i j0 j0 + gcd200 i .i zero .0 refl refl = subst (λ k → gcd1 k k zero zero ≡ gcd1 i i zero zero ) (+-comm zero i) refl + gcd200 (suc (suc i)) i0 (suc j) (suc j0) i=i0 j=j0 = gcd201 (suc (suc i)) i0 j (suc j0) (suc j) + gcd200 zero zero (suc zero) .1 i=i0 refl = refl + gcd200 zero zero (suc (suc j)) .(suc (suc j)) i=i0 refl = begin + gcd1 (zero + suc (suc j)) (zero + suc (suc j)) (suc (suc j)) (suc (suc j)) ≡⟨ gcdmm (suc (suc j)) (suc (suc j)) ⟩ + suc (suc j) ≡⟨ sym (gcd20 (suc (suc j))) ⟩ + gcd1 zero zero (suc (suc j)) (suc (suc j)) ∎ where open ≡-Reasoning + gcd200 zero (suc i0) (suc j) .(suc j) () refl + gcd200 (suc zero) .1 (suc j) .(suc j) refl refl = begin + gcd1 (1 + suc j) (1 + suc j) (suc j) (suc j) ≡⟨ gcd203 (suc j) ⟩ + 1 ≡⟨ sym ( gcd204 (suc j)) ⟩ + gcd1 1 1 (suc j) (suc j) ∎ where open ≡-Reasoning + gcd200 (suc (suc i)) i0 (suc j) zero i=i0 () + +gcd52 : {i : ℕ } → 1 < suc (suc i) +gcd52 {zero} = a ¬a ¬b c = ≤-trans refl-≤s c +gcd50 zero (suc i0) (suc zero) j0 0 FSetUtil.agda
+ automaton-ex.agda
+ automaton.agda
+ cfg.agda
+ cfg1.agda
+ chap0.agda
+ derive.agda
+ even.agda
+ finiteSet.agda
+ flcagl.agda
+ gcd.agda
+ halt.agda
+ induction-ex.agda
+ lang-text.agda
+ logic.agda
+ nat.agda
+ nfa.agda
+ nfa136.agda
+ non-regular.agda
+ omega-automaton.agda
+ pushdown.agda
+ puzzle.agda
+ regex.agda
+ regex1.agda
+ regular-concat.agda
+ regular-language.agda
+ root2.agda
+ sbconst2.agda
+ turing.agda
+ utm.agda
diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/induction-ex.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/induction-ex.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,118 @@ +{-# OPTIONS --guardedness #-} +module induction-ex where + +open import Relation.Binary.PropositionalEquality +open import Size +open import Data.Bool + +data List (A : Set ) : Set where + [] : List A + _∷_ : A → List A → List A + +data Nat : Set where + zero : Nat + suc : Nat → Nat + +add : Nat → Nat → Nat +add zero x = x +add (suc x) y = suc ( add x y ) + +_++_ : {A : Set} → List A → List A → List A +[] ++ y = y +(x ∷ t) ++ y = x ∷ ( t ++ y ) + +test1 = (zero ∷ []) ++ (zero ∷ []) + +length : {A : Set } → List A → Nat +length [] = zero +length (_ ∷ t) = suc ( length t ) + +lemma1 : {A : Set} → (x y : List A ) → length ( x ++ y ) ≡ add (length x) (length y) +lemma1 [] y = refl +lemma1 (x ∷ t) y = cong ( λ k → suc k ) lemma2 where + lemma2 : length (t ++ y) ≡ add (length t) (length y) + lemma2 = lemma1 t y + +-- record List1 ( A : Set ) : Set where +-- inductive +-- field +-- nil : List1 A +-- cons : A → List1 A → List1 A +-- +-- record List2 ( A : Set ) : Set where +-- coinductive +-- field +-- nil : List2 A +-- cons : A → List2 A → List2 A + +data SList (i : Size) (A : Set) : Set where + []' : SList i A + _∷'_ : {j : Size< i} (x : A) (xs : SList j A) → SList i A + + +map : ∀{i A B} → (A → B) → SList i A → SList i B +map f []' = []' +map f ( x ∷' xs)= f x ∷' map f xs + +foldr : ∀{i} {A B : Set} → (A → B → B) → B → SList i A → B +foldr c n []' = n +foldr c n (x ∷' xs) = c x (foldr c n xs) + +any : ∀{i A} → (A → Bool) → SList i A → Bool +any p xs = foldr _∨_ false (map p xs) + +-- Sappend : {A : Set } {i j : Size } → SList i A → SList j A → SList {!!} A +-- Sappend []' y = y +-- Sappend (x ∷' x₁) y = _∷'_ {?} x (Sappend x₁ y) + +language : { Σ : Set } → Set +language {Σ} = List Σ → Bool + +record Lang (i : Size) (A : Set) : Set where + coinductive + field + ν : Bool + δ : ∀{j : Size< i} → A → Lang j A + +open Lang + +∅ : ∀ {i A} → Lang i A +ν ∅ = false +δ ∅ _ = ∅ + +∅' : {i : Size } { A : Set } → Lang i A +∅' {i} {A} = record { ν = false ; δ = lemma3 } where + lemma3 : {j : Size< i} → A → Lang j A + lemma3 {j} _ = {!!} + +∅l : {A : Set } → language {A} +∅l _ = false + +ε : ∀ {i A} → Lang i A +ν ε = true +δ ε _ = ∅ + +εl : {A : Set } → language {A} +εl [] = true +εl (_ ∷ _) = false + +_+_ : ∀ {i A} → Lang i A → Lang i A → Lang i A +ν (a + b) = ν a ∨ ν b +δ (a + b) x = δ a x + δ b x + +Union : {Σ : Set} → ( A B : language {Σ} ) → language {Σ} +Union {Σ} A B x = (A x ) ∨ (B x) + +_·_ : ∀ {i A} → Lang i A → Lang i A → Lang i A +ν (a · b) = ν a ∧ ν b +δ (a · b) x = if (ν a) then ((δ a x · b ) + (δ b x )) else ( δ a x · b ) + +split : {Σ : Set} → (List Σ → Bool) + → ( List Σ → Bool) → List Σ → Bool +split x y [] = x [] ∨ y [] +split x y (h ∷ t) = (x [] ∧ y (h ∷ t)) ∨ + split (λ t1 → x ( h ∷ t1 )) (λ t2 → y t2 ) t + +Concat : {Σ : Set} → ( A B : language {Σ} ) → language {Σ} +Concat {Σ} A B = split A B + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/lang-text.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/lang-text.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,54 @@ +module lang-text where + +open import Data.List +open import Data.String +open import Data.Char +open import Data.Char.Unsafe +open import Relation.Binary.PropositionalEquality +open import Relation.Nullary +open import logic + +split : {Σ : Set} → (List Σ → Bool) + → ( List Σ → Bool) → List Σ → Bool +split x y [] = x [] /\ y [] +split x y (h ∷ t) = (x [] /\ y (h ∷ t)) \/ + split (λ t1 → x ( h ∷ t1 )) (λ t2 → y t2 ) t + +contains : String → String → Bool +contains x y = contains1 (toList x ) ( toList y ) where + contains1 : List Char → List Char → Bool + contains1 [] [] = false + contains1 [] ( cx ∷ ly ) = false + contains1 (cx ∷ lx) [] = true + contains1 (cx ∷ lx ) ( cy ∷ ly ) with cx ≟ cy + ... | yes refl = contains1 lx ly + ... | no n = false + +-- w does not contain the substring ab +ex15a : Set +ex15a = (w : String ) → ¬ (contains w "ab" ≡ true ) + +-- w does not contains substring baba +ex15b : Set +ex15b = (w : String ) → ¬ (contains w "baba" ≡ true ) + +-- w contains neither the substing ab nor ba +ex15c : Set + +-- w is any string not in a*b* +ex15c = (w : String ) → ( ¬ (contains w "ab" ≡ true ) /\ ( ¬ (contains w "ba" ≡ true ) + +ex15d : {!!} +ex15d = {!!} + +ex15e : {!!} +ex15e = {!!} + +ex15f : {!!} +ex15f = {!!} + +ex15g : {!!} +ex15g = {!!} + +ex15h : {!!} +ex15h = {!!} diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/logic.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/logic.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,154 @@ +module logic where + +open import Level +open import Relation.Nullary +open import Relation.Binary hiding (_⇔_ ) +open import Data.Empty + + +data Bool : Set where + true : Bool + false : Bool + +record _∧_ {n m : Level} (A : Set n) ( B : Set m ) : Set (n ⊔ m) where + constructor ⟪_,_⟫ + field + proj1 : A + proj2 : B + +data _∨_ {n m : Level} (A : Set n) ( B : Set m ) : Set (n ⊔ m) where + case1 : A → A ∨ B + case2 : B → A ∨ B + +_⇔_ : {n m : Level } → ( A : Set n ) ( B : Set m ) → Set (n ⊔ m) +_⇔_ A B = ( A → B ) ∧ ( B → A ) + +contra-position : {n m : Level } {A : Set n} {B : Set m} → (A → B) → ¬ B → ¬ A +contra-position {n} {m} {A} {B} f ¬b a = ¬b ( f a ) + +double-neg : {n : Level } {A : Set n} → A → ¬ ¬ A +double-neg A notnot = notnot A + +double-neg2 : {n : Level } {A : Set n} → ¬ ¬ ¬ A → ¬ A +double-neg2 notnot A = notnot ( double-neg A ) + +de-morgan : {n : Level } {A B : Set n} → A ∧ B → ¬ ( (¬ A ) ∨ (¬ B ) ) +de-morgan {n} {A} {B} and (case1 ¬A) = ⊥-elim ( ¬A ( _∧_.proj1 and )) +de-morgan {n} {A} {B} and (case2 ¬B) = ⊥-elim ( ¬B ( _∧_.proj2 and )) + +dont-or :　{n m : Level} {A : Set n} { B : Set m } → A ∨ B → ¬ A → B +dont-or {A} {B} (case1 a) ¬A = ⊥-elim ( ¬A a ) +dont-or {A} {B} (case2 b) ¬A = b + +dont-orb :　{n m : Level} {A : Set n} { B : Set m } → A ∨ B → ¬ B → A +dont-orb {A} {B} (case2 b) ¬B = ⊥-elim ( ¬B b ) +dont-orb {A} {B} (case1 a) ¬B = a + +infixr 130 _∧_ +infixr 140 _∨_ +infixr 150 _⇔_ + +_/\_ : Bool → Bool → Bool +true /\ true = true +_ /\ _ = false + +_\/_ : Bool → Bool → Bool +false \/ false = false +_ \/ _ = true + +not_ : Bool → Bool +not true = false +not false = true + +_<=>_ : Bool → Bool → Bool +true <=> true = true +false <=> false = true +_ <=> _ = false + +open import Relation.Binary.PropositionalEquality + +¬t=f : (t : Bool ) → ¬ ( not t ≡ t) +¬t=f true () +¬t=f false () + +infixr 130 _\/_ +infixr 140 _/\_ + +≡-Bool-func : {A B : Bool } → ( A ≡ true → B ≡ true ) → ( B ≡ true → A ≡ true ) → A ≡ B +≡-Bool-func {true} {true} a→b b→a = refl +≡-Bool-func {false} {true} a→b b→a with b→a refl +... | () +≡-Bool-func {true} {false} a→b b→a with a→b refl +... | () +≡-Bool-func {false} {false} a→b b→a = refl + +bool-≡-? : (a b : Bool) → Dec ( a ≡ b ) +bool-≡-? true true = yes refl +bool-≡-? true false = no (λ ()) +bool-≡-? false true = no (λ ()) +bool-≡-? false false = yes refl + +¬-bool-t : {a : Bool} → ¬ ( a ≡ true ) → a ≡ false +¬-bool-t {true} ne = ⊥-elim ( ne refl ) +¬-bool-t {false} ne = refl + +¬-bool-f : {a : Bool} → ¬ ( a ≡ false ) → a ≡ true +¬-bool-f {true} ne = refl +¬-bool-f {false} ne = ⊥-elim ( ne refl ) + +¬-bool : {a : Bool} → a ≡ false → a ≡ true → ⊥ +¬-bool refl () + +lemma-∧-0 : {a b : Bool} → a /\ b ≡ true → a ≡ false → ⊥ +lemma-∧-0 {true} {true} refl () +lemma-∧-0 {true} {false} () +lemma-∧-0 {false} {true} () +lemma-∧-0 {false} {false} () + +lemma-∧-1 : {a b : Bool} → a /\ b ≡ true → b ≡ false → ⊥ +lemma-∧-1 {true} {true} refl () +lemma-∧-1 {true} {false} () +lemma-∧-1 {false} {true} () +lemma-∧-1 {false} {false} () + +bool-and-tt : {a b : Bool} → a ≡ true → b ≡ true → ( a /\ b ) ≡ true +bool-and-tt refl refl = refl + +bool-∧→tt-0 : {a b : Bool} → ( a /\ b ) ≡ true → a ≡ true +bool-∧→tt-0 {true} {true} refl = refl +bool-∧→tt-0 {false} {_} () + +bool-∧→tt-1 : {a b : Bool} → ( a /\ b ) ≡ true → b ≡ true +bool-∧→tt-1 {true} {true} refl = refl +bool-∧→tt-1 {true} {false} () +bool-∧→tt-1 {false} {false} () + +bool-or-1 : {a b : Bool} → a ≡ false → ( a \/ b ) ≡ b +bool-or-1 {false} {true} refl = refl +bool-or-1 {false} {false} refl = refl +bool-or-2 : {a b : Bool} → b ≡ false → (a \/ b ) ≡ a +bool-or-2 {true} {false} refl = refl +bool-or-2 {false} {false} refl = refl + +bool-or-3 : {a : Bool} → ( a \/ true ) ≡ true +bool-or-3 {true} = refl +bool-or-3 {false} = refl + +bool-or-31 : {a b : Bool} → b ≡ true → ( a \/ b ) ≡ true +bool-or-31 {true} {true} refl = refl +bool-or-31 {false} {true} refl = refl + +bool-or-4 : {a : Bool} → ( true \/ a ) ≡ true +bool-or-4 {true} = refl +bool-or-4 {false} = refl + +bool-or-41 : {a b : Bool} → a ≡ true → ( a \/ b ) ≡ true +bool-or-41 {true} {b} refl = refl + +bool-and-1 : {a b : Bool} → a ≡ false → (a /\ b ) ≡ false +bool-and-1 {false} {b} refl = refl +bool-and-2 : {a b : Bool} → b ≡ false → (a /\ b ) ≡ false +bool-and-2 {true} {false} refl = refl +bool-and-2 {false} {false} refl = refl + + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/nfa.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/nfa.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,152 @@ +{-# OPTIONS --allow-unsolved-metas #-} +module nfa where + +-- open import Level renaming ( suc to succ ; zero to Zero ) +open import Data.Nat +open import Data.List +open import Data.Fin hiding ( _<_ ) +open import Data.Maybe +open import Relation.Nullary +open import Data.Empty +-- open import Data.Bool using ( Bool ; true ; false ; _∧_ ; _∨_ ) +open import Relation.Binary.PropositionalEquality hiding ( [_] ) +open import Relation.Nullary using (¬_; Dec; yes; no) +open import logic + +data States1 : Set where + sr : States1 + ss : States1 + st : States1 + +data In2 : Set where + i0 : In2 + i1 : In2 + + +record NAutomaton ( Q : Set ) ( Σ : Set ) + : Set where + field + Nδ : Q → Σ → Q → Bool + Nend : Q → Bool + +open NAutomaton + +LStates1 : List States1 +LStates1 = sr ∷ ss ∷ st ∷ [] + +-- one of qs q is true +existsS1 : ( States1 → Bool ) → Bool +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 qs = ss1 LStates1 where + ss1 : List States1 → List States1 + ss1 [] = [] + ss1 (x ∷ t) with qs x + ... | true = x ∷ ss1 t + ... | false = ss1 t + +Nmoves : { Q : Set } { Σ : Set } + → NAutomaton Q Σ + → (exists : ( Q → Bool ) → Bool) + → ( Qs : Q → Bool ) → (s : Σ ) → Q → Bool +Nmoves {Q} { Σ} M exists Qs s q = + exists ( λ qn → (Qs qn /\ ( Nδ M qn s q ) )) + +Naccept : { Q : Set } { Σ : Set } + → NAutomaton Q Σ + → (exists : ( Q → Bool ) → Bool) + → (Nstart : Q → Bool) → List Σ → Bool +Naccept M exists sb [] = exists ( λ q → sb q /\ Nend M q ) +Naccept M exists sb (i ∷ t ) = Naccept M exists (λ q → exists ( λ qn → (sb qn /\ ( Nδ M qn i q ) ))) t + +Ntrace : { Q : Set } { Σ : Set } + → NAutomaton Q Σ + → (exists : ( Q → Bool ) → Bool) + → (to-list : ( Q → Bool ) → List Q ) + → (Nstart : Q → Bool) → List Σ → List (List Q) +Ntrace M exists to-list sb [] = to-list ( λ q → sb q /\ Nend M q ) ∷ [] +Ntrace M exists to-list sb (i ∷ t ) = + to-list (λ q → sb q ) ∷ + Ntrace M exists to-list (λ q → exists ( λ qn → (sb qn /\ ( Nδ M qn i q ) ))) t + + +transition3 : States1 → In2 → States1 → Bool +transition3 sr i0 sr = true +transition3 sr i1 ss = true +transition3 sr i1 sr = true +transition3 ss i0 sr = true +transition3 ss i1 st = true +transition3 st i0 sr = true +transition3 st i1 st = true +transition3 _ _ _ = false + +fin1 : States1 → Bool +fin1 st = true +fin1 ss = false +fin1 sr = false + +test5 = existsS1 (λ q → fin1 q ) +test6 = to-listS1 (λ q → fin1 q ) + +start1 : States1 → Bool +start1 sr = true +start1 _ = false + +am2 : NAutomaton States1 In2 +am2 = record { Nδ = transition3 ; Nend = fin1} + +example2-1 = Naccept am2 existsS1 start1 ( i0 ∷ i1 ∷ i0 ∷ [] ) +example2-2 = Naccept am2 existsS1 start1 ( i1 ∷ i1 ∷ i1 ∷ [] ) + +t-1 : List ( List States1 ) +t-1 = Ntrace am2 existsS1 to-listS1 start1 ( i1 ∷ i1 ∷ i1 ∷ [] ) +t-2 = Ntrace am2 existsS1 to-listS1 start1 ( i0 ∷ i1 ∷ i0 ∷ [] ) + +transition4 : States1 → In2 → States1 → Bool +transition4 sr i0 sr = true +transition4 sr i1 ss = true +transition4 sr i1 sr = true +transition4 ss i0 ss = true +transition4 ss i1 st = true +transition4 st i0 st = true +transition4 st i1 st = true +transition4 _ _ _ = false + +fin4 : States1 → Bool +fin4 st = true +fin4 _ = false + +start4 : States1 → Bool +start4 ss = true +start4 _ = false + +am4 : NAutomaton States1 In2 +am4 = record { Nδ = transition4 ; Nend = fin4} + +example4-1 = Naccept am4 existsS1 start4 ( i0 ∷ i1 ∷ i1 ∷ i0 ∷ [] ) +example4-2 = Naccept am4 existsS1 start4 ( i0 ∷ i1 ∷ i1 ∷ i1 ∷ [] ) + +fin0 : States1 → Bool +fin0 st = false +fin0 ss = false +fin0 sr = false + +test0 : Bool +test0 = existsS1 fin0 + +test1 : Bool +test1 = existsS1 fin1 + +test2 = Nmoves am2 existsS1 start1 + +open import automaton + +am2def : Automaton (States1 → Bool ) In2 +am2def = record { δ = λ qs s q → existsS1 (λ qn → qs q /\ Nδ am2 q s qn ) + ; aend = λ qs → existsS1 (λ q → qs q /\ Nend am2 q) } + +dexample4-1 = accept am2def start1 ( i0 ∷ i1 ∷ i1 ∷ i0 ∷ [] ) +texample4-1 = trace am2def start1 ( i0 ∷ i1 ∷ i1 ∷ i0 ∷ [] ) + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/nfa136.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/nfa136.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,113 @@ +module nfa136 where + +open import logic +open import nfa +open import automaton +open import Data.List +open import finiteSet +open import Data.Fin +open import Relation.Binary.PropositionalEquality hiding ( [_] ) + +data StatesQ : Set where + q1 : StatesQ + q2 : StatesQ + q3 : StatesQ + +data A2 : Set where + a0 : A2 + b0 : A2 + +finStateQ : FiniteSet StatesQ +finStateQ = record { + Q←F = Q←F + ; F←Q = F←Q + ; finiso→ = finiso→ + ; finiso← = finiso← + } where + Q←F : Fin 3 → StatesQ + Q←F zero = q1 + Q←F (suc zero) = q2 + Q←F (suc (suc zero)) = q3 + F←Q : StatesQ → Fin 3 + F←Q q1 = zero + F←Q q2 = suc zero + F←Q q3 = suc (suc zero) + finiso→ : (q : StatesQ) → Q←F (F←Q q) ≡ q + finiso→ q1 = refl + finiso→ q2 = refl + finiso→ q3 = refl + finiso← : (f : Fin 3) → F←Q (Q←F f) ≡ f + finiso← zero = refl + finiso← (suc zero) = refl + finiso← (suc (suc zero)) = refl + finiso← (suc (suc (suc ()))) + +transition136 : StatesQ → A2 → StatesQ → Bool +transition136 q1 b0 q2 = true +transition136 q1 a0 q1 = true -- q1 → ep → q3 +transition136 q2 a0 q2 = true +transition136 q2 a0 q3 = true +transition136 q2 b0 q3 = true +transition136 q3 a0 q1 = true +transition136 _ _ _ = false + +end136 : StatesQ → Bool +end136 q1 = true +end136 _ = false + +start136 : StatesQ → Bool +start136 q1 = true +start136 _ = false + +exists136 : (StatesQ → Bool) → Bool +exists136 f = f q1 \/ f q2 \/ f q3 + +to-list-136 : (StatesQ → Bool) → List StatesQ +to-list-136 f = tl1 where + tl3 : List StatesQ + tl3 with f q3 + ... | true = q3 ∷ [] + ... | false = [] + tl2 : List StatesQ + tl2 with f q2 + ... | true = q2 ∷ tl3 + ... | false = tl3 + tl1 : List StatesQ + tl1 with f q1 + ... | true = q1 ∷ tl2 + ... | false = tl2 + +nfa136 : NAutomaton StatesQ A2 +nfa136 = record { Nδ = transition136; Nend = end136 } + +example136-1 = Naccept nfa136 exists136 start136( a0 ∷ b0 ∷ a0 ∷ a0 ∷ [] ) + +t146-1 = Ntrace nfa136 exists136 to-list-136 start136( a0 ∷ b0 ∷ a0 ∷ a0 ∷ [] ) + +example136-0 = Naccept nfa136 exists136 start136( a0 ∷ [] ) + +example136-2 = Naccept nfa136 exists136 start136( b0 ∷ a0 ∷ b0 ∷ a0 ∷ b0 ∷ [] ) +t146-2 = Ntrace nfa136 exists136 to-list-136 start136( b0 ∷ a0 ∷ b0 ∷ a0 ∷ b0 ∷ [] ) + +open FiniteSet + +nx : (StatesQ → Bool) → (List A2 ) → StatesQ → Bool +nx now [] = now +nx now ( i ∷ ni ) = (Nmoves nfa136 exists136 (nx now ni) i ) + +example136-3 = to-list-136 start136 +example136-4 = to-list-136 (nx start136 ( a0 ∷ b0 ∷ a0 ∷ [] )) + +open import sbconst2 + +fm136 : Automaton ( StatesQ → Bool ) A2 +fm136 = subset-construction exists136 nfa136 + +open NAutomaton + +lemma136 : ( x : List A2 ) → Naccept nfa136 exists136 start136 x ≡ accept fm136 start136 x +lemma136 x = lemma136-1 x start136 where + lemma136-1 : ( x : List A2 ) → ( states : StatesQ → Bool ) + → Naccept nfa136 exists136 states x ≡ accept fm136 states x + lemma136-1 [] _ = refl + lemma136-1 (h ∷ t) states = lemma136-1 t (δconv exists136 (Nδ nfa136) states h) diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/non-regular.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/non-regular.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,20 @@ +module non-regular where + +open import Data.Nat +open import Data.List +open import Relation.Binary.PropositionalEquality hiding ( [_] ) +open import logic +open import automaton +open import finiteSet +open import Relation.Nullary + +inputnn : ( n : ℕ ) → { Σ : Set } → ( x y : Σ ) → List Σ → List Σ +inputnn zero {_} _ _ s = s +inputnn (suc n) x y s = x ∷ ( inputnn n x y ( y ∷ s ) ) + +lemmaNN : { Q : Set } { Σ : Set } → ( x y : Σ ) → ¬ (x ≡ y) + → FiniteSet Q + → (M : Automaton Q Σ) (q : Q) + → ¬ ( (n : ℕ) → accept M q ( inputnn n x y [] ) ≡ true ) +lemmaNN = {!!} + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/omega-automaton.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/omega-automaton.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,155 @@ +module omega-automaton where + +open import Level renaming ( suc to succ ; zero to Zero ) +open import Data.Nat +open import Data.List +open import Data.Maybe +-- open import Data.Bool using ( Bool ; true ; false ; _∧_ ) renaming ( not to negate ) +open import Relation.Binary.PropositionalEquality hiding ( [_] ) +open import Relation.Nullary -- using (not_; Dec; yes; no) +open import Data.Empty + +open import logic +open import automaton + +open Automaton + +ω-run : { Q Σ : Set } → (Ω : Automaton Q Σ ) → (astart : Q ) → ℕ → ( ℕ → Σ ) → Q +ω-run Ω x zero s = x +ω-run Ω x (suc n) s = δ Ω (ω-run Ω x n s) ( s n ) + +-- +-- accept as Buchi automaton +-- +record Buchi { Q Σ : Set } (Ω : Automaton Q Σ ) ( S : ℕ → Σ ) : Set where + field + from : ℕ + stay : (x : Q) → (n : ℕ ) → n > from → aend Ω ( ω-run Ω x n S ) ≡ true + +open Buchi + +-- after sometimes, always p +-- +-- not p +-- ------------> +-- <> [] p * <> [] p +-- <----------- +-- p + + +-- +-- accept as Muller automaton +-- +record Muller { Q Σ : Set } (Ω : Automaton Q Σ ) ( S : ℕ → Σ ) : Set where + field + next : (n : ℕ ) → ℕ + infinite : (x : Q) → (n : ℕ ) → aend Ω ( ω-run Ω x (n + (next n)) S ) ≡ true + +-- always sometimes p +-- +-- not p +-- ------------> +-- [] <> p * [] <> p +-- <----------- +-- p + +data States3 : Set where + ts* : States3 + ts : States3 + +transition3 : States3 → Bool → States3 +transition3 ts* true = ts* +transition3 ts* false = ts +transition3 ts true = ts* +transition3 ts false = ts + +mark1 : States3 → Bool +mark1 ts* = true +mark1 ts = false + +ωa1 : Automaton States3 Bool +ωa1 = record { + δ = transition3 + ; aend = mark1 + } + +true-seq : ℕ → Bool +true-seq _ = true + +false-seq : ℕ → Bool +false-seq _ = false + +flip-seq : ℕ → Bool +flip-seq zero = false +flip-seq (suc n) = not ( flip-seq n ) + +lemma0 : Muller ωa1 flip-seq +lemma0 = record { + next = λ n → suc (suc n) + ; infinite = lemma01 + } where + lemma01 : (x : States3) (n : ℕ) → + aend ωa1 (ω-run ωa1 x (n + suc (suc n)) flip-seq) ≡ true + lemma01 = {!!} + +lemma1 : Buchi ωa1 true-seq +lemma1 = record { + from = zero + ; stay = {!!} + } where + lem1 : ( n : ℕ ) → n > zero → aend ωa1 (ω-run ωa1 {!!} n true-seq ) ≡ true + lem1 zero () + lem1 (suc n) (s≤s z≤n) with ω-run ωa1 {!!} n true-seq + lem1 (suc n) (s≤s z≤n) | ts* = {!!} + lem1 (suc n) (s≤s z≤n) | ts = {!!} + +ωa2 : Automaton States3 Bool +ωa2 = record { + δ = transition3 + ; aend = λ x → not ( mark1 x ) + } + +flip-dec : (n : ℕ ) → Dec ( flip-seq n ≡ true ) +flip-dec n with flip-seq n +flip-dec n | false = no λ () +flip-dec n | true = yes refl + +flip-dec1 : (n : ℕ ) → flip-seq (suc n) ≡ ( not ( flip-seq n ) ) +flip-dec1 n = let open ≡-Reasoning in + flip-seq (suc n ) + ≡⟨⟩ + ( not ( flip-seq n ) ) + ∎ + +flip-dec2 : (n : ℕ ) → not flip-seq (suc n) ≡ flip-seq n +flip-dec2 n = {!!} + + +record flipProperty : Set where + field + flipP : (n : ℕ) → ω-run ωa2 {!!} {!!} ≡ ω-run ωa2 {!!} {!!} + +lemma2 : Muller ωa2 flip-seq +lemma2 = record { + next = next + ; infinite = {!!} + } where + next : ℕ → ℕ + next = {!!} + infinite' : (n m : ℕ) → n ≥″ m → aend ωa2 {!!} ≡ true → aend ωa2 {!!} ≡ true + infinite' = {!!} + infinite : (n : ℕ) → aend ωa2 {!!} ≡ true + infinite = {!!} + +lemma3 : Buchi ωa1 false-seq → ⊥ +lemma3 = {!!} + +lemma4 : Muller ωa1 flip-seq → ⊥ +lemma4 = {!!} + + + + + + + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/prime.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/prime.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,51 @@ +module prime where + +open import Data.Nat +open import Data.Nat.Properties +open import Data.Empty +open import Data.Unit using (⊤ ; tt) +open import Relation.Nullary +open import Relation.Binary.PropositionalEquality +open import Relation.Binary.Definitions + +open import gcd +open import nat + +record Prime (i : ℕ ) : Set where + field + isPrime : ( j : ℕ ) → j < i → gcd i j ≡ 1 + +open ≡-Reasoning + +record NonPrime ( n : ℕ ) : Set where + field + factor : ℕ + prime : Prime factor + dividable : Dividable factor n + +isPrime : ( n : ℕ ) → Dec ( Prime n ) +isPrime = {!!} + +nonPrime : ( n : ℕ ) → ¬ Prime n → NonPrime n +nonPrime n np = np1 n (λ j n≤j j n≤j j ¬a ¬b c = record { factor = gcd n (suc m) ; prime = {!!} ; dividable = record { factor = {!!} ; is-factor = {!!} } } + +prime-is-infinite : (max-prime : ℕ ) → ¬ ( (j : ℕ) → max-prime < j → ¬ Prime j ) +prime-is-infinite zero pmax = pmax 1 {!!} record { isPrime = λ n lt → {!!} } +prime-is-infinite (suc m) pmax = pmax (suc (factorial (suc m))) f>m record { isPrime = λ n lt → fact n lt } where + factorial : (n : ℕ) → ℕ + factorial zero = 1 + factorial (suc n) = (suc n) * (factorial n) + f>m : suc m < suc (factorial (suc m)) + f>m = {!!} + factm : (n m : ℕ ) → n < (suc m) → Dividable n (factorial m ) + factm = {!!} + fact : (n : ℕ ) → n < (suc (factorial (suc m))) → gcd (suc (factorial (suc m))) n ≡ 1 + fact n lt = fact12 (nonPrime (factorial (suc m )) ( pmax (factorial (suc m )) {!!} )) where + fact12 : NonPrime (factorial (suc m)) → gcd (suc (factorial (suc m))) n ≡ 1 + fact12 np = {!!} diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/pushdown.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/pushdown.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,118 @@ +module pushdown where + +open import Level renaming ( suc to succ ; zero to Zero ) +open import Data.Nat +open import Data.List +open import Data.Maybe +open import Data.Bool using ( Bool ; true ; false ) +open import Relation.Binary.PropositionalEquality hiding ( [_] ) +open import Relation.Nullary using (¬_; Dec; yes; no) +open import Level renaming ( suc to succ ; zero to Zero ) +open import Data.Product + + +data PushDown ( Γ : Set ) : Set where + pop : PushDown Γ + push : Γ → PushDown Γ + + +record PushDownAutomaton ( Q : Set ) ( Σ : Set ) ( Γ : Set ) + : Set where + field + pδ : Q → Σ → Γ → Q × ( PushDown Γ ) + pok : Q → Bool + pempty : Γ + pmoves : Q → List Γ → Σ → ( Q × List Γ ) + pmoves q [] i with pδ q i pempty + pmoves q [] i | qn , pop = ( qn , [] ) + pmoves q [] i | qn , push x = ( qn , ( x ∷ [] ) ) + pmoves q ( H ∷ T ) i with pδ q i H + pmoves q (H ∷ T) i | qn , pop = ( qn , T ) + pmoves q (H ∷ T) i | qn , push x = ( qn , ( x ∷ H ∷ T) ) + + paccept : (q : Q ) ( In : List Σ ) ( sp : List Γ ) → Bool + paccept q [] [] = pok q + paccept q ( H ∷ T) [] with pδ q H pempty + paccept q (H ∷ T) [] | qn , pop = paccept qn T [] + paccept q (H ∷ T) [] | qn , push x = paccept qn T (x ∷ [] ) + paccept q [] (_ ∷ _ ) = false + paccept q ( H ∷ T ) ( SH ∷ ST ) with pδ q H SH + ... | (nq , pop ) = paccept nq T ST + ... | (nq , push ns ) = paccept nq T ( ns ∷ SH ∷ ST ) + + +-- 0011 +-- 00000111111 +inputnn : ( n : ℕ ) → { Σ : Set } → ( x y : Σ ) → List Σ → List Σ +inputnn zero {_} _ _ s = s +inputnn (suc n) x y s = x ∷ ( inputnn n x y ( y ∷ s ) ) + + +data States0 : Set where + sr : States0 + +data In2 : Set where + i0 : In2 + i1 : In2 + +test0 = inputnn 5 i0 i1 [] + +pnn : PushDownAutomaton States0 In2 States0 +pnn = record { + pδ = pδ + ; pempty = sr + ; pok = λ q → true + } where + pδ : States0 → In2 → States0 → States0 × PushDown States0 + pδ sr i0 _ = (sr , push sr) + pδ sr i1 _ = (sr , pop ) + +data States1 : Set where + ss : States1 + st : States1 + +pn1 : PushDownAutomaton States1 In2 States1 +pn1 = record { + pδ = pδ + ; pempty = ss + ; pok = pok1 + } where + pok1 : States1 → Bool + pok1 ss = false + pok1 st = true + pδ : States1 → In2 → States1 → States1 × PushDown States1 + pδ ss i0 _ = (ss , push ss) + pδ ss i1 _ = (st , pop) + pδ st i0 _ = (st , push ss) + pδ st i1 _ = (st , pop ) + +test1 = PushDownAutomaton.paccept pnn sr ( i0 ∷ i0 ∷ i1 ∷ i1 ∷ [] ) [] +test2 = PushDownAutomaton.paccept pnn sr ( i0 ∷ i0 ∷ i1 ∷ i0 ∷ [] ) [] +test3 = PushDownAutomaton.pmoves pnn sr [] i0 +test4 = PushDownAutomaton.paccept pnn sr ( i0 ∷ i0 ∷ i1 ∷ i1 ∷ i0 ∷ i1 ∷ [] ) [] + +test5 = PushDownAutomaton.paccept pn1 ss ( i0 ∷ i0 ∷ i1 ∷ i1 ∷ [] ) [] +test6 = PushDownAutomaton.paccept pn1 ss ( i0 ∷ i0 ∷ i1 ∷ i1 ∷ i0 ∷ i1 ∷ [] ) [] + +open import Data.Empty + +test70 : (n : ℕ ) → (x : List In2) → PushDownAutomaton.paccept pnn sr x [] ≡ true → inputnn n i0 i1 [] ≡ x +test70 zero [] refl = refl +test70 zero (x ∷ y) pa = ⊥-elim (test701 pa) where + test701 : PushDownAutomaton.paccept pnn sr (x ∷ y) [] ≡ true → ⊥ + test701 pa with PushDownAutomaton.pδ pnn sr x sr + ... | sr , pop = {!!} + ... | sr , push x = {!!} +test70 (suc n) x pa = {!!} + +test71 : (n : ℕ ) → (x : List In2) → inputnn n i0 i1 [] ≡ x → PushDownAutomaton.paccept pnn sr x [] ≡ true +test71 = {!!} + +test7 : (n : ℕ ) → PushDownAutomaton.paccept pnn sr (inputnn n i0 i1 []) [] ≡ true +test7 zero = refl +test7 (suc n) with test7 n +... | t = test7lem [] t where + test7lem : (x : List States0) → PushDownAutomaton.paccept pnn sr (inputnn n i0 i1 []) x ≡ true + → PushDownAutomaton.paccept pnn sr (inputnn n i0 i1 (i1 ∷ [])) (sr ∷ x) ≡ true + test7lem x with PushDownAutomaton.paccept pnn sr (inputnn (suc n) i0 i1 []) (sr ∷ x) + ... | t2 = {!!} diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/puzzle.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/puzzle.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,194 @@ +module puzzle where + +---- 仮定 +-- 猫か犬を飼っている人は山羊を飼ってない +-- 猫を飼ってない人は、犬かウサギを飼っている +-- 猫も山羊も飼っていない人は、ウサギを飼っている +-- +---- 問題 +-- 山羊を飼っている人は、犬を飼っていない +-- 山羊を飼っている人は、ウサギを飼っている +-- ウサギを飼っていない人は、猫を飼っている + +module pet-research where + open import logic + open import Relation.Nullary + open import Data.Empty + + postulate + lem : (a : Set) → a ∨ ( ¬ a ) + + record PetResearch ( Cat Dog Goat Rabbit : Set ) : Set where + field + fact1 : ( Cat ∨ Dog ) → ¬ Goat + fact2 : ¬ Cat → ( Dog ∨ Rabbit ) + fact3 : ¬ ( Cat ∨ Goat ) → Rabbit + + module tmp ( Cat Dog Goat Rabbit : Set ) (p : PetResearch Cat Dog Goat Rabbit ) where + + open PetResearch + + problem0 : Cat ∨ Dog ∨ Goat ∨ Rabbit + problem0 with lem Cat | lem Goat + ... | case1 c | g = case1 c + ... | c | case1 g = case2 ( case2 ( case1 g ) ) + ... | case2 ¬c | case2 ¬g = case2 ( case2 ( case2 ( fact3 p lemma1 ))) where + lemma1 : ¬ ( Cat ∨ Goat ) + lemma1 (case1 c) = ¬c c + lemma1 (case2 g) = ¬g g + + problem1 : Goat → ¬ Dog + problem1 g d = fact1 p (case2 d) g + + problem2 : Goat → Rabbit + problem2 g with lem Cat | lem Dog + problem2 g | case1 c | d = ⊥-elim ( fact1 p (case1 c ) g ) + problem2 g | case2 ¬c | case1 d = ⊥-elim ( fact1 p (case2 d ) g ) + problem2 g | case2 ¬c | case2 ¬d with lem Rabbit + ... | case1 r = r + ... | case2 ¬r = fact3 p lemma2 where + lemma2 : ¬ ( Cat ∨ Goat ) + lemma2 (case1 c) = ¬c c + lemma2 (case2 g) with fact2 p ¬c + lemma2 (case2 g) | case1 d = ¬d d + lemma2 (case2 g) | case2 r = ¬r r + + problem3 : (¬ Rabbit ) → Cat + problem3 ¬r with lem Cat | lem Goat + problem3 ¬r | case1 c | g = c + problem3 ¬r | case2 ¬c | g = ⊥-elim ( ¬r ( fact3 p lemma3 )) where + lemma3 : ¬ ( Cat ∨ Goat ) + lemma3 (case1 c) = ¬c c + lemma3 (case2 g) with fact2 p ¬c + lemma3 (case2 g) | case1 d = fact1 p (case2 d ) g + lemma3 (case2 g) | case2 r = ¬r r + +module pet-research1 ( Cat Dog Goat Rabbit : Set ) where + + open import Data.Bool + open import Relation.Binary + open import Relation.Binary.PropositionalEquality + + _=>_ : Bool → Bool → Bool + _ => true = true + false => _ = true + true => false = false + + ¬_ : Bool → Bool + ¬ p = not p + + problem0 : ( Cat Dog Goat Rabbit : Bool ) → + ((( Cat ∨ Dog ) => (¬ Goat) ) ∧ ( (¬ Cat ) => ( Dog ∨ Rabbit ) ) ∧ ( ( ¬ ( Cat ∨ Goat ) ) => Rabbit ) ) + => (Cat ∨ Dog ∨ Goat ∨ Rabbit) ≡ true + problem0 true d g r = refl + problem0 false true g r = refl + problem0 false false true r = refl + problem0 false false false true = refl + problem0 false false false false = refl + + problem1 : ( Cat Dog Goat Rabbit : Bool ) → + ((( Cat ∨ Dog ) => (¬ Goat) ) ∧ ( (¬ Cat ) => ( Dog ∨ Rabbit ) ) ∧ ( ( ¬ ( Cat ∨ Goat ) ) => Rabbit ) ) + => ( Goat => ( ¬ Dog )) ≡ true + problem1 c false false r = refl + problem1 c true false r = refl + problem1 c false true r = refl + problem1 false true true r = refl + problem1 true true true r = refl + + problem2 : ( Cat Dog Goat Rabbit : Bool ) → + ((( Cat ∨ Dog ) => (¬ Goat) ) ∧ ( (¬ Cat ) => ( Dog ∨ Rabbit ) ) ∧ ( ( ¬ ( Cat ∨ Goat ) ) => Rabbit ) ) + => ( Goat => Rabbit ) ≡ true + problem2 c d false false = refl + problem2 c d false true = refl + problem2 c d true true = refl + problem2 true d true false = refl + problem2 false false true false = refl + problem2 false true true false = refl + + problem3 : ( Cat Dog Goat Rabbit : Bool ) → + ((( Cat ∨ Dog ) => (¬ Goat) ) ∧ ( (¬ Cat ) => ( Dog ∨ Rabbit ) ) ∧ ( ( ¬ ( Cat ∨ Goat ) ) => Rabbit ) ) + => ( (¬ Rabbit ) => Cat ) ≡ true + problem3 false d g true = refl + problem3 true d g true = refl + problem3 true d g false = refl + problem3 false false false false = refl + problem3 false false true false = refl + problem3 false true false false = refl + problem3 false true true false = refl + +-- module pet-research2 ( Cat Dog Goat Rabbit : Set ) where +-- +-- open import Data.Bool hiding ( _∨_ ) +-- open import Relation.Binary +-- open import Relation.Binary.PropositionalEquality +-- +-- ¬_ : Bool → Bool +-- ¬ p = p xor true +-- +-- infixr 5 _∨_ +-- _∨_ : Bool → Bool → Bool +-- a ∨ b = ¬ ( (¬ a) ∧ (¬ b ) ) +-- +-- _=>_ : Bool → Bool → Bool +-- a => b = (¬ a ) ∨ b +-- +-- open import Data.Bool.Solver using (module xor-∧-Solver) +-- open xor-∧-Solver +-- +-- problem0' : ( Cat : Bool ) → (Cat xor Cat ) ≡ false +-- problem0' = solve 1 (λ c → (c :+ c ) := con false ) refl +-- +-- problem1' : ( Cat : Bool ) → (Cat ∧ (Cat xor true )) ≡ false +-- problem1' = solve 1 (λ c → ((c :* (c :+ con true )) ) := con false ) {!!} +-- +-- open import Data.Nat +-- :¬_ : {n : ℕ} → Polynomial n → Polynomial n +-- :¬ p = p :+ con true +-- +-- _:∨_ : {n : ℕ} → Polynomial n → Polynomial n → Polynomial n +-- a :∨ b = :¬ ( ( :¬ a ) :* ( :¬ b )) +-- +-- _:=>_ : {n : ℕ} → Polynomial n → Polynomial n → Polynomial n +-- a :=> b = ( :¬ a ) :∨ b +-- +-- _:∧_ = _:*_ +-- +-- infixr 6 _:∧_ +-- infixr 5 _:∨_ +-- +-- problem0 : ( Cat Dog Goat Rabbit : Bool ) → +-- ((( Cat ∨ Dog ) => (¬ Goat) ) ∧ ( (¬ Cat ) => ( Dog ∨ Rabbit ) ) ∧ ( ( ¬ ( Cat ∨ Goat ) ) => Rabbit ) ) +-- => (Cat ∨ Dog ∨ Goat ∨ Rabbit) ≡ true +-- problem0 = solve 4 ( λ Cat Dog Goat Rabbit → ( +-- ( ((Cat :∨ Dog ) :=> (:¬ Goat)) :∧ ( ((:¬ Cat ) :=> ( Dog :∨ Rabbit )) :∧ (( :¬ ( Cat :∨ Goat ) ) :=> Rabbit) )) +-- :=> ( Cat :∨ (Dog :∨ ( Goat :∨ Rabbit))) ) := con true ) {!!} +-- +-- problem1 : ( Cat Dog Goat Rabbit : Bool ) → +-- ((( Cat ∨ Dog ) => (¬ Goat) ) ∧ ( (¬ Cat ) => ( Dog ∨ Rabbit ) ) ∧ ( ( ¬ ( Cat ∨ Goat ) ) => Rabbit ) ) +-- => ( Goat => ( ¬ Dog )) ≡ true +-- problem1 c false false r = {!!} +-- problem1 c true false r = {!!} +-- problem1 c false true r = {!!} +-- problem1 false true true r = refl +-- problem1 true true true r = refl +-- +-- problem2 : ( Cat Dog Goat Rabbit : Bool ) → +-- ((( Cat ∨ Dog ) => (¬ Goat) ) ∧ ( (¬ Cat ) => ( Dog ∨ Rabbit ) ) ∧ ( ( ¬ ( Cat ∨ Goat ) ) => Rabbit ) ) +-- => ( Goat => Rabbit ) ≡ true +-- problem2 c d false false = {!!} +-- problem2 c d false true = {!!} +-- problem2 c d true true = {!!} +-- problem2 true d true false = refl +-- problem2 false false true false = refl +-- problem2 false true true false = refl +-- +-- problem3 : ( Cat Dog Goat Rabbit : Bool ) → +-- ((( Cat ∨ Dog ) => (¬ Goat) ) ∧ ( (¬ Cat ) => ( Dog ∨ Rabbit ) ) ∧ ( ( ¬ ( Cat ∨ Goat ) ) => Rabbit ) ) +-- => ( (¬ Rabbit ) => Cat ) ≡ true +-- problem3 false d g true = {!!} +-- problem3 true d g true = {!!} +-- problem3 true d g false = {!!} +-- problem3 false false false false = refl +-- problem3 false false true false = refl +-- problem3 false true false false = refl +-- problem3 false true true false = refl diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/regex.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/regex.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,14 @@ +module regex where + +data Regex ( Σ : Set) : Set where + ε : Regex Σ -- empty + φ : Regex Σ -- fail + _* : Regex Σ → Regex Σ + _&_ : Regex Σ → Regex Σ → Regex Σ + _||_ : Regex Σ → Regex Σ → Regex Σ + <_> : Σ → Regex Σ + +infixr 40 _&_ _||_ + + + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/regex1.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/regex1.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,128 @@ +{-# OPTIONS --allow-unsolved-metas #-} +module regex1 where + +open import Level renaming ( suc to succ ; zero to Zero ) +open import Data.Fin +open import Data.Nat hiding ( _≟_ ) +open import Data.List hiding ( any ; [_] ) +import Data.Bool using ( Bool ; true ; false ; _∧_ ) +open import Data.Bool using ( Bool ; true ; false ; _∧_ ; _∨_ ) +open import Relation.Binary.PropositionalEquality as RBF hiding ( [_] ) +open import Relation.Nullary using (¬_; Dec; yes; no) +open import regex + +-- postulate a b c d : Set + +data In : Set where + a : In + b : In + c : In + d : In + +cmpi : (x y : In ) → Dec (x ≡ y) +cmpi a a = yes refl +cmpi b b = yes refl +cmpi c c = yes refl +cmpi d d = yes refl +cmpi a b = no (λ ()) +cmpi a c = no (λ ()) +cmpi a d = no (λ ()) +cmpi b a = no (λ ()) +cmpi b c = no (λ ()) +cmpi b d = no (λ ()) +cmpi c a = no (λ ()) +cmpi c b = no (λ ()) +cmpi c d = no (λ ()) +cmpi d a = no (λ ()) +cmpi d b = no (λ ()) +cmpi d c = no (λ ()) + +-- infixr 40 _&_ _||_ + +r1' = (< a > & < b >) & < c > --- abc +r1 = < a > & < b > & < c > --- abc +any = < a > || < b > || < c > --- a|b|c +r2 = ( any * ) & ( < a > & < b > & < c > ) -- .*abc +r3 = ( any * ) & ( < a > & < b > & < c > & < a > & < b > & < c > ) +r4 = ( < a > & < b > & < c > ) || ( < b > & < c > & < d > ) +r5 = ( any * ) & ( < a > & < b > & < c > || < b > & < c > & < d > ) + +open import nfa + +-- former ++ later ≡ x +split : {Σ : Set} → ((former : List Σ) → Bool) → ((later : List Σ) → Bool) → (x : List Σ ) → Bool +split x y [] = x [] ∧ y [] +split x y (h ∷ t) = (x [] ∧ y (h ∷ t)) ∨ + split (λ t1 → x ( h ∷ t1 )) (λ t2 → y t2 ) t + +-- tt1 : {Σ : Set} → ( P Q : List In → Bool ) → split P Q ( a ∷ b ∷ c ∷ [] ) +-- tt1 P Q = ? + +{-# TERMINATING #-} +repeat : {Σ : Set} → (List Σ → Bool) → List Σ → Bool +repeat x [] = true +repeat {Σ} x ( h ∷ t ) = split x (repeat {Σ} x) ( h ∷ t ) + +regular-language : {Σ : Set} → Regex Σ → ((x y : Σ ) → Dec (x ≡ y)) → List Σ → Bool +regular-language φ cmp _ = false +regular-language ε cmp [] = true +regular-language ε cmp (_ ∷ _) = false +regular-language (x *) cmp = repeat ( regular-language x cmp ) +regular-language (x & y) cmp = split ( λ z → (regular-language x cmp) z ) (λ z → regular-language y cmp z ) +regular-language (x || y) cmp = λ s → ( regular-language x cmp s ) ∨ ( regular-language y cmp s) +regular-language < h > cmp [] = false +regular-language < h > cmp (h1 ∷ [] ) with cmp h h1 +... | yes _ = true +... | no _ = false +regular-language < h > _ (_ ∷ _ ∷ _) = false + +test-regex : regular-language r1' cmpi ( a ∷ [] ) ≡ false +test-regex = refl + +test-regex1 : regular-language r2 cmpi ( a ∷ a ∷ b ∷ c ∷ [] ) ≡ true +test-regex1 = refl + + +test-AB→split : {Σ : Set} → {A B : List In → Bool} → split A B ( a ∷ b ∷ a ∷ [] ) ≡ ( + ( A [] ∧ B ( a ∷ b ∷ a ∷ [] ) ) ∨ + ( A ( a ∷ [] ) ∧ B ( b ∷ a ∷ [] ) ) ∨ + ( A ( a ∷ b ∷ [] ) ∧ B ( a ∷ [] ) ) ∨ + ( A ( a ∷ b ∷ a ∷ [] ) ∧ B [] ) + ) +test-AB→split {_} {A} {B} = refl + +-- from example 1.53 1 + +ex53-1 : Set +ex53-1 = (s : List In ) → regular-language ( (< a > *) & < b > & (< a > *) ) cmpi s ≡ true → {!!} -- contains exact one b + +ex53-2 : Set +ex53-2 = (s : List In ) → regular-language ( (any * ) & < b > & (any *) ) cmpi s ≡ true → {!!} -- contains at lease one b + +evenp : {Σ : Set} → List Σ → Bool +oddp : {Σ : Set} → List Σ → Bool +oddp [] = false +oddp (_ ∷ t) = evenp t + +evenp [] = true +evenp (_ ∷ t) = oddp t + +-- from example 1.53 5 +egex-even : Set +egex-even = (s : List In ) → regular-language ( ( any & any ) * ) cmpi s ≡ true → evenp s ≡ true + +test11 = regular-language ( ( any & any ) * ) cmpi (a ∷ []) +test12 = regular-language ( ( any & any ) * ) cmpi (a ∷ b ∷ []) + +-- proof-egex-even : egex-even +-- proof-egex-even [] _ = refl +-- proof-egex-even (a ∷ []) () +-- proof-egex-even (b ∷ []) () +-- proof-egex-even (c ∷ []) () +-- proof-egex-even (x ∷ x₁ ∷ s) y = proof-egex-even s {!!} + +open import derive In cmpi +open import automaton + +ra-ex = trace (regex→automaton r2) (record { state = r2 ; is-derived = unit }) ( a ∷ b ∷ c ∷ []) + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/regular-concat.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/regular-concat.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,240 @@ +module regular-concat where + +open import Level renaming ( suc to Suc ; zero to Zero ) +open import Data.List +open import Data.Nat hiding ( _≟_ ) +open import Data.Fin hiding ( _+_ ) +open import Data.Empty +open import Data.Unit +open import Data.Product +-- open import Data.Maybe +open import Relation.Nullary +open import Relation.Binary.PropositionalEquality hiding ( [_] ) +open import logic +open import nat +open import automaton +open import regular-language + +open import nfa +open import sbconst2 + +open RegularLanguage +open Automaton + +Concat-NFA : {Σ : Set} → (A B : RegularLanguage Σ ) → ((x y : states A )→ Dec (x ≡ y)) → ((x y : states B )→ Dec (x ≡ y)) + → NAutomaton (states A ∨ states B) Σ +Concat-NFA {Σ} A B equal?A equal?B = record { Nδ = δnfa ; Nend = nend } + module Concat-NFA where + δnfa : states A ∨ states B → Σ → states A ∨ states B → Bool + δnfa (case1 q) i (case1 q₁) with equal?A (δ (automaton A) q i) q₁ + ... | yes _ = true + ... | no _ = false + δnfa (case1 qa) i (case2 qb) with equal?B qb (δ (automaton B) (astart B) i) + ... | yes _ = aend (automaton A) qa + ... | no _ = false + δnfa (case2 q) i (case2 q₁) with equal?B (δ (automaton B) q i) q₁ + ... | yes _ = true + ... | no _ = false + δnfa _ i _ = false + nend : states A ∨ states B → Bool + nend (case2 q) = aend (automaton B) q + nend (case1 q) = aend (automaton A) q /\ aend (automaton B) (astart B) -- empty B case + +Concat-NFA-start : {Σ : Set} → (A B : RegularLanguage Σ ) → states A ∨ states B → ((x y : states A )→ Dec (x ≡ y)) → Bool +Concat-NFA-start A B (case1 a) equal?A with equal?A a (astart A) +... | yes _ = true +... | no _ = false +Concat-NFA-start A B (case2 b) equal?A = false + +M-Concat : {Σ : Set} → (A B : RegularLanguage Σ ) → ((states A → Bool) → Bool) → ((states B → Bool) → Bool) → RegularLanguage Σ +M-Concat {Σ} A B existsA existsB = record { + states = states A ∨ states B → Bool + ; astart = λ ab → Concat-NFA-start A B ab {!!} + ; automaton = subset-construction sbexists (Concat-NFA A B {!!} {!!} ) + } where + sbexists : (states A ∨ states B → Bool) → Bool + sbexists P = existsA ( λ a → existsB ( λ b → P (case1 a) \/ P (case2 b))) + +record Split {Σ : Set} (A : List Σ → Bool ) ( B : List Σ → Bool ) (x : List Σ ) : Set where + field + sp0 : List Σ + sp1 : List Σ + sp-concat : sp0 ++ sp1 ≡ x + prop0 : A sp0 ≡ true + prop1 : B sp1 ≡ true + +open Split + +list-empty++ : {Σ : Set} → (x y : List Σ) → x ++ y ≡ [] → (x ≡ [] ) ∧ (y ≡ [] ) +list-empty++ [] [] refl = record { proj1 = refl ; proj2 = refl } +list-empty++ [] (x ∷ y) () +list-empty++ (x ∷ x₁) y () + +open _∧_ + +open import Relation.Binary.PropositionalEquality hiding ( [_] ) + +c-split-lemma : {Σ : Set} → (A B : List Σ → Bool ) → (h : Σ) → ( t : List Σ ) → split A B (h ∷ t ) ≡ true + → ( ¬ (A [] ≡ true )) ∨ ( ¬ (B ( h ∷ t ) ≡ true) ) + → split (λ t1 → A (h ∷ t1)) B t ≡ true +c-split-lemma {Σ} A B h t eq p = sym ( begin + true + ≡⟨ sym eq ⟩ + split A B (h ∷ t ) + ≡⟨⟩ + A [] /\ B (h ∷ t) \/ split (λ t1 → A (h ∷ t1)) B t + ≡⟨ cong ( λ k → k \/ split (λ t1 → A (h ∷ t1)) B t ) (lemma-p p ) ⟩ + false \/ split (λ t1 → A (h ∷ t1)) B t + ≡⟨ bool-or-1 refl ⟩ + split (λ t1 → A (h ∷ t1)) B t + ∎ ) where + open ≡-Reasoning + lemma-p : ( ¬ (A [] ≡ true )) ∨ ( ¬ (B ( h ∷ t ) ≡ true) ) → A [] /\ B (h ∷ t) ≡ false + lemma-p (case1 ¬A ) = bool-and-1 ( ¬-bool-t ¬A ) + lemma-p (case2 ¬B ) = bool-and-2 ( ¬-bool-t ¬B ) + +split→AB : {Σ : Set} → (A B : List Σ → Bool ) → ( x : List Σ ) → split A B x ≡ true → Split A B x +split→AB {Σ} A B [] eq with bool-≡-? (A []) true | bool-≡-? (B []) true +split→AB {Σ} A B [] eq | yes eqa | yes eqb = + record { sp0 = [] ; sp1 = [] ; sp-concat = refl ; prop0 = eqa ; prop1 = eqb } +split→AB {Σ} A B [] eq | yes p | no ¬p = ⊥-elim (lemma-∧-1 eq (¬-bool-t ¬p )) +split→AB {Σ} A B [] eq | no ¬p | t = ⊥-elim (lemma-∧-0 eq (¬-bool-t ¬p )) +split→AB {Σ} A B (h ∷ t ) eq with bool-≡-? (A []) true | bool-≡-? (B (h ∷ t )) true +... | yes px | yes py = record { sp0 = [] ; sp1 = h ∷ t ; sp-concat = refl ; prop0 = px ; prop1 = py } +... | no px | _ with split→AB (λ t1 → A ( h ∷ t1 )) B t (c-split-lemma A B h t eq (case1 px) ) +... | S = record { sp0 = h ∷ sp0 S ; sp1 = sp1 S ; sp-concat = cong ( λ k → h ∷ k) (sp-concat S) ; prop0 = prop0 S ; prop1 = prop1 S } +split→AB {Σ} A B (h ∷ t ) eq | _ | no px with split→AB (λ t1 → A ( h ∷ t1 )) B t (c-split-lemma A B h t eq (case2 px) ) +... | S = record { sp0 = h ∷ sp0 S ; sp1 = sp1 S ; sp-concat = cong ( λ k → h ∷ k) (sp-concat S) ; prop0 = prop0 S ; prop1 = prop1 S } + +AB→split : {Σ : Set} → (A B : List Σ → Bool ) → ( x y : List Σ ) → A x ≡ true → B y ≡ true → split A B (x ++ y ) ≡ true +AB→split {Σ} A B [] [] eqa eqb = begin + split A B [] + ≡⟨⟩ + A [] /\ B [] + ≡⟨ cong₂ (λ j k → j /\ k ) eqa eqb ⟩ + true + ∎ where open ≡-Reasoning +AB→split {Σ} A B [] (h ∷ y ) eqa eqb = begin + split A B (h ∷ y ) + ≡⟨⟩ + A [] /\ B (h ∷ y) \/ split (λ t1 → A (h ∷ t1)) B y + ≡⟨ cong₂ (λ j k → j /\ k \/ split (λ t1 → A (h ∷ t1)) B y ) eqa eqb ⟩ + true /\ true \/ split (λ t1 → A (h ∷ t1)) B y + ≡⟨⟩ + true \/ split (λ t1 → A (h ∷ t1)) B y + ≡⟨⟩ + true + ∎ where open ≡-Reasoning +AB→split {Σ} A B (h ∷ t) y eqa eqb = begin + split A B ((h ∷ t) ++ y) + ≡⟨⟩ + A [] /\ B (h ∷ t ++ y) \/ split (λ t1 → A (h ∷ t1)) B (t ++ y) + ≡⟨ cong ( λ k → A [] /\ B (h ∷ t ++ y) \/ k ) (AB→split {Σ} (λ t1 → A (h ∷ t1)) B t y eqa eqb ) ⟩ + A [] /\ B (h ∷ t ++ y) \/ true + ≡⟨ bool-or-3 ⟩ + true + ∎ where open ≡-Reasoning + +open NAutomaton +open import Data.List.Properties + +open import finiteSet +open import finiteSetUtil + +open FiniteSet + +closed-in-concat : {Σ : Set} → (A B : RegularLanguage Σ ) → ( x : List Σ ) → isRegular (Concat (contain A) (contain B)) x ( M-Concat A B ) +closed-in-concat {Σ} A B x = ≡-Bool-func closed-in-concat→ closed-in-concat← where + afin : (A : RegularLanguage Σ ) → FiniteSet A + afin = ? + finab = (fin-∨ (afin A) (afin B)) + NFA = (Concat-NFA A B) + abmove : (q : states A ∨ states B) → (h : Σ ) → states A ∨ states B + abmove (case1 q) h = case1 (δ (automaton A) q h) + abmove (case2 q) h = case2 (δ (automaton B) q h) + lemma-nmove-ab : (q : states A ∨ states B) → (h : Σ ) → Nδ NFA q h (abmove q h) ≡ true + lemma-nmove-ab (case1 q) _ = ? -- equal?-refl (afin A) + lemma-nmove-ab (case2 q) _ = ? -- equal?-refl (afin B) + nmove : (q : states A ∨ states B) (nq : states A ∨ states B → Bool ) → (nq q ≡ true) → ( h : Σ ) → + exists finab (λ qn → nq qn /\ Nδ NFA qn h (abmove q h)) ≡ true + nmove (case1 q) nq nqt h = found finab (case1 q) ( bool-and-tt nqt (lemma-nmove-ab (case1 q) h) ) + nmove (case2 q) nq nqt h = found finab (case2 q) ( bool-and-tt nqt (lemma-nmove-ab (case2 q) h) ) + acceptB : (z : List Σ) → (q : states B) → (nq : states A ∨ states B → Bool ) → (nq (case2 q) ≡ true) → ( accept (automaton B) q z ≡ true ) + → Naccept NFA finab nq z ≡ true + acceptB [] q nq nqt fb = lemma8 where + lemma8 : exists finab ( λ q → nq q /\ Nend NFA q ) ≡ true + lemma8 = found finab (case2 q) ( bool-and-tt nqt fb ) + acceptB (h ∷ t ) q nq nq=q fb = acceptB t (δ (automaton B) q h) (Nmoves NFA finab nq h) (nmove (case2 q) nq nq=q h) fb + + acceptA : (y z : List Σ) → (q : states A) → (nq : states A ∨ states B → Bool ) → (nq (case1 q) ≡ true) + → ( accept (automaton A) q y ≡ true ) → ( accept (automaton B) (astart B) z ≡ true ) + → Naccept NFA finab nq (y ++ z) ≡ true + acceptA [] [] q nq nqt fa fb = found finab (case1 q) (bool-and-tt nqt (bool-and-tt fa fb )) + acceptA [] (h ∷ z) q nq nq=q fa fb = acceptB z nextb (Nmoves NFA finab nq h) lemma70 fb where + nextb : states B + nextb = δ (automaton B) (astart B) h + lemma70 : exists finab (λ qn → nq qn /\ Nδ NFA qn h (case2 nextb)) ≡ true + lemma70 = found finab (case1 q) ( bool-and-tt nq=q (bool-and-tt fa (lemma-nmove-ab (case2 (astart B)) h) )) + acceptA (h ∷ t) z q nq nq=q fa fb = acceptA t z (δ (automaton A) q h) (Nmoves NFA finab nq h) (nmove (case1 q) nq nq=q h) fa fb where + + acceptAB : Split (contain A) (contain B) x + → Naccept NFA finab (equal? finab (case1 (astart A))) x ≡ true + acceptAB S = subst ( λ k → Naccept NFA finab (equal? finab (case1 (astart A))) k ≡ true ) ( sp-concat S ) + (acceptA (sp0 S) (sp1 S) (astart A) (equal? finab (case1 (astart A))) ? (prop0 S) (prop1 S) ) + + closed-in-concat→ : Concat (contain A) (contain B) x ≡ true → contain (M-Concat A B) x ≡ true + closed-in-concat→ concat with split→AB (contain A) (contain B) x concat + ... | S = begin + accept (subset-construction finab NFA (case1 (astart A))) (Concat-NFA-start A B ) x + ≡⟨ ≡-Bool-func (subset-construction-lemma← finab NFA (case1 (astart A)) x ) + (subset-construction-lemma→ finab NFA (case1 (astart A)) x ) ⟩ + Naccept NFA finab (equal? finab (case1 (astart A))) x + ≡⟨ acceptAB S ⟩ + true + ∎ where open ≡-Reasoning + + open Found + + ab-case : (q : states A ∨ states B ) → (qa : states A ) → (x : List Σ ) → Set + ab-case (case1 qa') qa x = qa' ≡ qa + ab-case (case2 qb) qa x = ¬ ( accept (automaton B) qb x ≡ true ) + + contain-A : (x : List Σ) → (nq : states A ∨ states B → Bool ) → (fn : Naccept NFA finab nq x ≡ true ) + → (qa : states A ) → ( (q : states A ∨ states B) → nq q ≡ true → ab-case q qa x ) + → split (accept (automaton A) qa ) (contain B) x ≡ true + contain-A [] nq fn qa cond with found← finab fn + ... | S with found-q S | inspect found-q S | cond (found-q S) (bool-∧→tt-0 (found-p S)) + ... | case1 qa' | record { eq = refl } | refl = bool-∧→tt-1 (found-p S) + ... | case2 qb | record { eq = refl } | ab = ⊥-elim ( ab (bool-∧→tt-1 (found-p S))) + contain-A (h ∷ t) nq fn qa cond with bool-≡-? ((aend (automaton A) qa) /\ accept (automaton B) (δ (automaton B) (astart B) h) t ) true + ... | yes eq = bool-or-41 eq + ... | no ne = bool-or-31 (contain-A t (Nmoves NFA finab nq h) fn (δ (automaton A) qa h) lemma11 ) where + lemma11 : (q : states A ∨ states B) → exists finab (λ qn → nq qn /\ Nδ NFA qn h q) ≡ true → ab-case q (δ (automaton A) qa h) t + lemma11 (case1 qa') ex with found← finab ex + ... | S with found-q S | inspect found-q S | cond (found-q S) (bool-∧→tt-0 (found-p S)) + ... | case1 qa | record { eq = refl } | refl = sym ( equal→refl (afin A) ( bool-∧→tt-1 (found-p S) )) -- continued A case + ... | case2 qb | record { eq = refl } | nb with bool-∧→tt-1 (found-p S) -- δnfa (case2 q) i (case1 q₁) is false + ... | () + lemma11 (case2 qb) ex with found← finab ex + ... | S with found-q S | inspect found-q S | cond (found-q S) (bool-∧→tt-0 (found-p S)) + lemma11 (case2 qb) ex | S | case2 qb' | record { eq = refl } | nb = contra-position lemma13 nb where -- continued B case should fail + lemma13 : accept (automaton B) qb t ≡ true → accept (automaton B) qb' (h ∷ t) ≡ true + lemma13 fb = subst (λ k → accept (automaton B) k t ≡ true ) (sym (equal→refl (afin B) (bool-∧→tt-1 (found-p S)))) fb + lemma11 (case2 qb) ex | S | case1 qa | record { eq = refl } | refl with bool-∧→tt-1 (found-p S) + ... | eee = contra-position lemma12 ne where -- starting B case should fail + lemma12 : accept (automaton B) qb t ≡ true → aend (automaton A) qa /\ accept (automaton B) (δ (automaton B) (astart B) h) t ≡ true + lemma12 fb = bool-and-tt (bool-∧→tt-0 eee) (subst ( λ k → accept (automaton B) k t ≡ true ) (equal→refl (afin B) (bool-∧→tt-1 eee) ) fb ) + + lemma10 : Naccept NFA finab (equal? finab (case1 (astart A))) x ≡ true → split (contain A) (contain B) x ≡ true + lemma10 CC = contain-A x (Concat-NFA-start A B ) CC (astart A) lemma15 where + lemma15 : (q : states A ∨ states B) → Concat-NFA-start A B q ≡ true → ab-case q (astart A) x + lemma15 q nq=t with equal→refl finab nq=t + ... | refl = refl + + closed-in-concat← : contain (M-Concat A B) x ≡ true → Concat (contain A) (contain B) x ≡ true + closed-in-concat← C with subset-construction-lemma← finab NFA (case1 (astart A)) x C + ... | CC = lemma10 CC + + + + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/regular-language.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/regular-language.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,87 @@ +module regular-language where + +open import Level renaming ( suc to Suc ; zero to Zero ) +open import Data.List +open import Data.Nat hiding ( _≟_ ) +open import Data.Fin hiding ( _+_ ) +open import Data.Empty +open import Data.Unit +open import Data.Product +-- open import Data.Maybe +open import Relation.Nullary +open import Relation.Binary.PropositionalEquality hiding ( [_] ) +open import logic +open import nat +open import automaton + +language : { Σ : Set } → Set +language {Σ} = List Σ → Bool + +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) + +split : {Σ : Set} → (List Σ → Bool) + → ( List Σ → Bool) → List Σ → Bool +split x y [] = x [] /\ y [] +split x y (h ∷ t) = (x [] /\ y (h ∷ t)) \/ + split (λ t1 → x ( h ∷ t1 )) (λ t2 → y t2 ) t + +Concat : {Σ : Set} → ( A B : language {Σ} ) → language {Σ} +Concat {Σ} A B = split A B + +{-# TERMINATING #-} +Star : {Σ : Set} → ( A : language {Σ} ) → language {Σ} +Star {Σ} A = split A ( Star {Σ} A ) + +open import automaton-ex + +test-AB→split : {Σ : Set} → {A B : List In2 → Bool} → split A B ( i0 ∷ i1 ∷ i0 ∷ [] ) ≡ ( + ( A [] /\ B ( i0 ∷ i1 ∷ i0 ∷ [] ) ) \/ + ( A ( i0 ∷ [] ) /\ B ( i1 ∷ i0 ∷ [] ) ) \/ + ( A ( i0 ∷ i1 ∷ [] ) /\ B ( i0 ∷ [] ) ) \/ + ( A ( i0 ∷ i1 ∷ i0 ∷ [] ) /\ B [] ) + ) +test-AB→split {_} {A} {B} = refl + +open RegularLanguage +isRegular : {Σ : Set} → (A : language {Σ} ) → ( x : List Σ ) → (r : RegularLanguage Σ ) → Set +isRegular A x r = A x ≡ contain r x + +-- postulate +-- fin-× : {A B : Set} → { a b : ℕ } → FiniteSet A {a} → FiniteSet B {b} → FiniteSet (A × B) {a * b} + +M-Union : {Σ : Set} → (A B : RegularLanguage Σ ) → RegularLanguage Σ +M-Union {Σ} A B = record { + states = states A × states B + ; astart = ( astart A , astart B ) + ; automaton = record { + δ = λ q x → ( δ (automaton A) (proj₁ q) x , δ (automaton B) (proj₂ q) x ) + ; aend = λ q → ( aend (automaton A) (proj₁ q) \/ aend (automaton B) (proj₂ q) ) + } + } + +closed-in-union : {Σ : Set} → (A B : RegularLanguage Σ ) → ( x : List Σ ) → isRegular (Union (contain A) (contain B)) x ( M-Union A B ) +closed-in-union A B [] = lemma where + lemma : aend (automaton A) (astart A) \/ aend (automaton B) (astart B) ≡ + aend (automaton A) (astart A) \/ aend (automaton B) (astart B) + lemma = refl +closed-in-union {Σ} A B ( h ∷ t ) = lemma1 t ((δ (automaton A) (astart A) h)) ((δ (automaton B) (astart B) h)) where + lemma1 : (t : List Σ) → (qa : states A ) → (qb : states B ) → + accept (automaton A) qa t \/ accept (automaton B) qb t + ≡ accept (automaton (M-Union A B)) (qa , qb) t + lemma1 [] qa qb = refl + lemma1 (h ∷ t ) qa qb = lemma1 t ((δ (automaton A) qa h)) ((δ (automaton B) qb h)) + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/root2.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/root2.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,100 @@ +module root2 where + +open import Data.Nat +open import Data.Nat.Properties +open import Data.Empty +open import Data.Unit using (⊤ ; tt) +open import Relation.Nullary +open import Relation.Binary.PropositionalEquality +open import Relation.Binary.Definitions + +open import gcd +open import even +open import nat + +record Rational : Set where + field + i j : ℕ + coprime : gcd i j ≡ 1 + +even→gcd=2 : {n : ℕ} → even n → n > 0 → gcd n 2 ≡ 2 +even→gcd=2 {suc (suc zero)} en (s≤s z≤n) = refl +even→gcd=2 {suc (suc (suc (suc n)))} en (s≤s z≤n) = begin + gcd (suc (suc (suc (suc n)))) 2 ≡⟨⟩ + gcd (suc (suc n)) 2 ≡⟨ even→gcd=2 {suc (suc n)} en (s≤s z≤n) ⟩ + 2 ∎ where open ≡-Reasoning + +even^2 : {n : ℕ} → even ( n * n ) → even n +even^2 {n} en with even? n +... | yes y = y +... | no ne = ⊥-elim ( odd4 ((2 * m) + 2 * m * suc (2 * m)) (n+even {2 * m} {2 * m * suc (2 * m)} ee3 ee4) (subst (λ k → even k) ee2 en )) where + m : ℕ + m = Odd.j ( odd3 n ne ) + ee3 : even (2 * m) + ee3 = subst (λ k → even k ) (*-comm m 2) (n*even {m} {2} tt ) + ee4 : even ((2 * m) * suc (2 * m)) + ee4 = even*n {(2 * m)} {suc (2 * m)} (even*n {2} {m} tt ) + ee2 : n * n ≡ suc (2 * m) + ((2 * m) * (suc (2 * m) )) + ee2 = begin n * n ≡⟨ cong ( λ k → k * k) (Odd.is-twice (odd3 n ne)) ⟩ + suc (2 * m) * suc (2 * m) ≡⟨ *-distribʳ-+ (suc (2 * m)) 1 ((2 * m) ) ⟩ + (1 * suc (2 * m)) + 2 * m * suc (2 * m) ≡⟨ cong (λ k → k + 2 * m * suc (2 * m)) (begin + suc m + 1 * m + 0 * (suc m + 1 * m ) ≡⟨ +-comm (suc m + 1 * m) 0 ⟩ + suc m + 1 * m ≡⟨⟩ + suc (2 * m) + ∎) ⟩ suc (2 * m) + 2 * m * suc (2 * m) ∎ where open ≡-Reasoning + +e3 : {i j : ℕ } → 2 * i ≡ 2 * j → i ≡ j +e3 {zero} {zero} refl = refl +e3 {suc x} {suc y} eq with <-cmp x y +... | tri< a ¬b ¬c = ⊥-elim ( nat-≡< eq (s≤s (<-trans (<-plus a) (<-plus-0 (s≤s (<-plus a )))))) +... | tri≈ ¬a b ¬c = cong suc b +... | tri> ¬a ¬b c = ⊥-elim ( nat-≡< (sym eq) (s≤s (<-trans (<-plus c) (<-plus-0 (s≤s (<-plus c )))))) + +open Factor + +root2-irrational : ( n m : ℕ ) → n > 1 → m > 1 → 2 * n * n ≡ m * m → ¬ (gcd n m ≡ 1) +root2-irrational n m n>1 m>1 2nm = rot13 ( gcd-gt n n m m 2 f2 f2 f2 fm {!!} {!!} {!!} {!!}) where + rot13 : {m : ℕ } → Dividable 2 m → m ≡ 1 → ⊥ + rot13 d refl with Dividable.is-factor d + ... | t = {!!} + rot11 : {m : ℕ } → even m → Factor 2 m + rot11 {zero} em = record { factor = 0 ; remain = 0 ; is-factor = refl } + rot11 {suc zero} () + rot11 {suc (suc m) } em = record { factor = suc (factor fc ) ; remain = remain fc ; is-factor = isfc } where + fc : Factor 2 m + fc = rot11 {m} em + isfc : suc (factor fc) * 2 + remain fc ≡ suc (suc m) + isfc = begin + suc (factor fc) * 2 + remain fc ≡⟨ cong (λ k → k + remain fc) (*-distribʳ-+ 2 1 (factor fc)) ⟩ + ((1 * 2) + (factor fc)* 2 ) + remain fc ≡⟨⟩ + ((1 + 1) + (factor fc)* 2 ) + remain fc ≡⟨ cong (λ k → k + remain fc) (+-assoc 1 1 _ ) ⟩ + (1 + (1 + (factor fc)* 2 )) + remain fc ≡⟨⟩ + suc (suc ((factor fc * 2) + remain fc )) ≡⟨ cong (λ x → suc (suc x)) (is-factor fc) ⟩ + suc (suc m) ∎ where open ≡-Reasoning + rot5 : {n : ℕ} → n > 1 → n > 0 + rot5 {n} lt = <-trans a test2 n) ( 0 ∷ 1 ∷ 2 ∷ 3 ∷ 4 ∷ 5 ∷ 6 ∷ [] ) + +testn : ℕ → List ( CopyStates × ( List ℕ ) × ( List ℕ ) ) +testn 0 = test2 0 ∷ [] +testn (suc n) = test2 n ∷ testn n + diff -r 567754463810 -r 3fa72793620b automaton-in-agda/src/utm.agda --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/automaton-in-agda/src/utm.agda Sun Jun 13 20:45:17 2021 +0900 @@ -0,0 +1,250 @@ +module utm where + +open import turing +open import Data.Product +open import Data.Bool +open import Data.List +open import Data.Nat + +data utmStates : Set where + reads : utmStates + read0 : utmStates + read1 : utmStates + read2 : utmStates + read3 : utmStates + read4 : utmStates + read5 : utmStates + read6 : utmStates + + loc0 : utmStates + loc1 : utmStates + loc2 : utmStates + loc3 : utmStates + loc4 : utmStates + loc5 : utmStates + loc6 : utmStates + + fetch0 : utmStates + fetch1 : utmStates + fetch2 : utmStates + fetch3 : utmStates + fetch4 : utmStates + fetch5 : utmStates + fetch6 : utmStates + fetch7 : utmStates + + print0 : utmStates + print1 : utmStates + print2 : utmStates + print3 : utmStates + print4 : utmStates + print5 : utmStates + print6 : utmStates + print7 : utmStates + + mov0 : utmStates + mov1 : utmStates + mov2 : utmStates + mov3 : utmStates + mov4 : utmStates + mov5 : utmStates + mov6 : utmStates + + tidy0 : utmStates + tidy1 : utmStates + halt : utmStates + +data utmΣ : Set where + ０ : utmΣ + １ : utmΣ + B : utmΣ + * : utmΣ + $ : utmΣ + ^ : utmΣ + X : utmΣ + Y : utmΣ + Z : utmΣ + ＠ : utmΣ + b : utmΣ + +utmδ : utmStates → utmΣ → utmStates × (Write utmΣ) × Move +utmδ reads x = read0 , wnone , mnone +utmδ read0 * = read1 , write * , left +utmδ read0 x = read0 , write x , right +utmδ read1 x = read2 , write ＠ , right +utmδ read2 ^ = read3 , write ^ , right +utmδ read2 x = read2 , write x , right +utmδ read3 ０ = read4 , write ０ , left +utmδ read3 １ = read5 , write １ , left +utmδ read3 b = read6 , write b , left +utmδ read4 ＠ = loc0 , write ０ , right +utmδ read4 x = read4 , write x , left +utmδ read5 ＠ = loc0 , write １ , right +utmδ read5 x = read5 , write x , left +utmδ read6 ＠ = loc0 , write B , right +utmδ read6 x = read6 , write x , left +utmδ loc0 ０ = loc0 , write X , left +utmδ loc0 １ = loc0 , write Y , left +utmδ loc0 B = loc0 , write Z , left +utmδ loc0 $ = loc1 , write $ , right +utmδ loc0 x = loc0 , write x , left +utmδ loc1 X = loc2 , write ０ , right +utmδ loc1 Y = loc3 , write １ , right +utmδ loc1 Z = loc4 , write B , right +utmδ loc1 * = fetch0 , write * , right +utmδ loc1 x = loc1 , write x , right +utmδ loc2 ０ = loc5 , write X , right +utmδ loc2 １ = loc6 , write Y , right +utmδ loc2 B = loc6 , write Z , right +utmδ loc2 x = loc2 , write x , right +utmδ loc3 １ = loc5 , write Y , right +utmδ loc3 ０ = loc6 , write X , right +utmδ loc3 B = loc6 , write Z , right +utmδ loc3 x = loc3 , write x , right +utmδ loc4 B = loc5 , write Z , right +utmδ loc4 ０ = loc6 , write X , right +utmδ loc4 １ = loc6 , write Y , right +utmδ loc4 x = loc4 , write x , right +utmδ loc5 $ = loc1 , write $ , right +utmδ loc5 x = loc5 , write x , left +utmδ loc6 $ = halt , write $ , right +utmδ loc6 * = loc0 , write * , left +utmδ loc6 x = loc6 , write x , right +utmδ fetch0 ０ = fetch1 , write X , left +utmδ fetch0 １ = fetch2 , write Y , left +utmδ fetch0 B = fetch3 , write Z , left +utmδ fetch0 x = fetch0 , write x , right +utmδ fetch1 $ = fetch4 , write $ , right +utmδ fetch1 x = fetch1 , write x , left +utmδ fetch2 $ = fetch5 , write $ , right +utmδ fetch2 x = fetch2 , write x , left +utmδ fetch3 $ = fetch6 , write $ , right +utmδ fetch3 x = fetch3 , write x , left +utmδ fetch4 ０ = fetch7 , write X , right +utmδ fetch4 １ = fetch7 , write X , right +utmδ fetch4 B = fetch7 , write X , right +utmδ fetch4 * = print0 , write * , left +utmδ fetch4 x = fetch4 , write x , right +utmδ fetch5 ０ = fetch7 , write Y , right +utmδ fetch5 １ = fetch7 , write Y , right +utmδ fetch5 B = fetch7 , write Y , right +utmδ fetch5 * = print0 , write * , left +utmδ fetch5 x = fetch5 , write x , right +utmδ fetch6 ０ = fetch7 , write Z , right +utmδ fetch6 １ = fetch7 , write Z , right +utmδ fetch6 B = fetch7 , write Z , right +utmδ fetch6 * = print0 , write * , left +utmδ fetch6 x = fetch6 , write x , right +utmδ fetch7 * = fetch0 , write * , right +utmδ fetch7 x = fetch7 , write x , right +utmδ print0 X = print1 , write X , right +utmδ print0 Y = print2 , write Y , right +utmδ print0 Z = print3 , write Z , right +utmδ print1 ^ = print4 , write ^ , right +utmδ print1 x = print1 , write x , right +utmδ print2 ^ = print5 , write ^ , right +utmδ print2 x = print2 , write x , right +utmδ print3 ^ = print6 , write ^ , right +utmδ print3 x = print3 , write x , right +utmδ print4 x = print7 , write ０ , left +utmδ print5 x = print7 , write １ , left +utmδ print6 x = print7 , write B , left +utmδ print7 X = mov0 , write X , right +utmδ print7 Y = mov1 , write Y , right +utmδ print7 x = print7 , write x , left +utmδ mov0 ^ = mov2 , write ^ , left +utmδ mov0 x = mov0 , write x , right +utmδ mov1 ^ = mov3 , write ^ , right +utmδ mov1 x = mov1 , write x , right +utmδ mov2 ０ = mov4 , write ^ , right +utmδ mov2 １ = mov5 , write ^ , right +utmδ mov2 B = mov6 , write ^ , right +utmδ mov3 ０ = mov4 , write ^ , left +utmδ mov3 １ = mov5 , write ^ , left +utmδ mov3 B = mov6 , write ^ , left +utmδ mov4 ^ = tidy0 , write ０ , left +utmδ mov5 ^ = tidy0 , write １ , left +utmδ mov6 ^ = tidy0 , write B , left +utmδ tidy0 $ = tidy1 , write $ , left +utmδ tidy0 x = tidy0 , write x , left +utmδ tidy1 X = tidy1 , write ０ , left +utmδ tidy1 Y = tidy1 , write １ , left +utmδ tidy1 Z = tidy1 , write B , left +utmδ tidy1 $ = reads , write $ , right +utmδ tidy1 x = tidy1 , write x , left +utmδ _ x = halt , write x , mnone + +U-TM : Turing utmStates utmΣ +U-TM = record { + tδ = utmδ + ; tstart = read0 + ; tend = tend + ; tnone = b + } where + tend : utmStates → Bool + tend halt = true + tend _ = false + +-- Copyδ : CopyStates → ℕ → CopyStates × ( Write ℕ ) × Move +-- Copyδ s1 0 = H , wnone , mnone +-- Copyδ s1 1 = s2 , write 0 , right +-- Copyδ s2 0 = s3 , write 0 , right +-- Copyδ s2 1 = s2 , write 1 , right +-- Copyδ s3 0 = s4 , write 1 , left +-- Copyδ s3 1 = s3 , write 1 , right +-- Copyδ s4 0 = s5 , write 0 , left +-- Copyδ s4 1 = s4 , write 1 , left +-- Copyδ s5 0 = s1 , write 1 , right +-- Copyδ s5 1 = s5 , write 1 , left +-- Copyδ H _ = H , wnone , mnone +-- Copyδ _ (suc (suc _)) = H , wnone , mnone + +Copyδ-encode : List utmΣ +Copyδ-encode = + ０ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ ０ ∷ -- s1 0 = H , wnone , mnone + * ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ １ ∷ -- s1 1 = s2 , write 0 , right + * ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ ０ ∷ １ ∷ -- s2 0 = s3 , write 0 , right + * ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ -- s2 1 = s2 , write 1 , right + * ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ -- s3 0 = s4 , write 1 , left + * ∷ ０ ∷ １ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ -- s3 1 = s3 , write 1 , right + * ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ -- s4 0 = s5 , write 0 , left + * ∷ １ ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ -- s4 1 = s4 , write 1 , left + * ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ -- s5 0 = s1 , write 1 , right + * ∷ １ ∷ ０ ∷ １ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ ０ ∷ -- s5 1 = s5 , write 1 , left + [] + + +input-encode : List utmΣ +input-encode = １ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ [] + +input+Copyδ : List utmΣ +input+Copyδ = ( $ ∷ ０ ∷ ０ ∷ ０ ∷ ０ ∷ * ∷ [] ) -- start state + ++ Copyδ-encode + ++ ( $ ∷ ^ ∷ input-encode ) + +short-input : List utmΣ +short-input = $ ∷ ０ ∷ ０ ∷ ０ ∷ * ∷ + ０ ∷ ０ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ １ ∷ * ∷ + ０ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ １ ∷ １ ∷ * ∷ + ０ ∷ １ ∷ B ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ * ∷ + １ ∷ ０ ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ １ ∷ $ ∷ + ^ ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ [] + +utm-test1 : List utmΣ → utmStates × ( List utmΣ ) × ( List utmΣ ) +utm-test1 inp = Turing.taccept U-TM inp + +{-# TERMINATING #-} +utm-test2 : ℕ → List utmΣ → utmStates × ( List utmΣ ) × ( List utmΣ ) +utm-test2 n inp = loop n (Turing.tstart U-TM) inp [] + where + loop : ℕ → utmStates → ( List utmΣ ) → ( List utmΣ ) → utmStates × ( List utmΣ ) × ( List utmΣ ) + loop zero q L R = ( q , L , R ) + loop (suc n) q L R with move {utmStates} {utmΣ} {０} {utmδ} q L R | q + ... | nq , nL , nR | reads = loop n nq nL nR + ... | nq , nL , nR | _ = loop (suc n) nq nL nR + +t1 = utm-test2 20 short-input + +t : (n : ℕ) → utmStates × ( List utmΣ ) × ( List utmΣ ) +-- t n = utm-test2 n input+Copyδ +t n = utm-test2 n short-input