changeset 183:3fa72793620b

fix
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sun, 13 Jun 2021 20:45:17 +0900
parents 567754463810
children a810ae49187c
files automaton-in-agda/src/agda/automaton-ex.agda automaton-in-agda/src/agda/automaton.agda automaton-in-agda/src/agda/bijection.agda automaton-in-agda/src/agda/cfg.agda automaton-in-agda/src/agda/cfg1.agda automaton-in-agda/src/agda/chap0.agda automaton-in-agda/src/agda/derive.agda automaton-in-agda/src/agda/even.agda automaton-in-agda/src/agda/fin.agda automaton-in-agda/src/agda/finiteSet.agda automaton-in-agda/src/agda/finiteSetUtil.agda automaton-in-agda/src/agda/flcagl.agda automaton-in-agda/src/agda/gcd.agda automaton-in-agda/src/agda/halt.agda automaton-in-agda/src/agda/index.ind automaton-in-agda/src/agda/induction-ex.agda automaton-in-agda/src/agda/lang-text.agda automaton-in-agda/src/agda/logic.agda automaton-in-agda/src/agda/nfa.agda automaton-in-agda/src/agda/nfa136.agda automaton-in-agda/src/agda/non-regular.agda automaton-in-agda/src/agda/omega-automaton.agda automaton-in-agda/src/agda/prime.agda automaton-in-agda/src/agda/pushdown.agda automaton-in-agda/src/agda/puzzle.agda automaton-in-agda/src/agda/regex.agda automaton-in-agda/src/agda/regex1.agda automaton-in-agda/src/agda/regular-concat.agda automaton-in-agda/src/agda/regular-language.agda automaton-in-agda/src/agda/root2.agda automaton-in-agda/src/agda/sbconst2.agda automaton-in-agda/src/agda/turing.agda automaton-in-agda/src/agda/utm.agda automaton-in-agda/src/automaton-ex.agda automaton-in-agda/src/automaton.agda automaton-in-agda/src/bijection.agda automaton-in-agda/src/cfg.agda automaton-in-agda/src/cfg1.agda automaton-in-agda/src/chap0.agda automaton-in-agda/src/derive.agda automaton-in-agda/src/even.agda automaton-in-agda/src/fin.agda automaton-in-agda/src/finiteSet.agda automaton-in-agda/src/finiteSetUtil.agda automaton-in-agda/src/flcagl.agda automaton-in-agda/src/gcd.agda automaton-in-agda/src/halt.agda automaton-in-agda/src/index.ind automaton-in-agda/src/induction-ex.agda automaton-in-agda/src/lang-text.agda automaton-in-agda/src/logic.agda automaton-in-agda/src/nfa.agda automaton-in-agda/src/nfa136.agda automaton-in-agda/src/non-regular.agda automaton-in-agda/src/omega-automaton.agda automaton-in-agda/src/prime.agda automaton-in-agda/src/pushdown.agda automaton-in-agda/src/puzzle.agda automaton-in-agda/src/regex.agda automaton-in-agda/src/regex1.agda automaton-in-agda/src/regular-concat.agda automaton-in-agda/src/regular-language.agda automaton-in-agda/src/root2.agda automaton-in-agda/src/sbconst2.agda automaton-in-agda/src/turing.agda automaton-in-agda/src/utm.agda
diffstat 66 files changed, 4616 insertions(+), 4616 deletions(-) [+]
line wrap: on
line diff
--- 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 ( λ () )
-
--- 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
-
--- 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 ) 
-
-
--- 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  ∷ [] ) 
-
--- 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] ∷ [] )
-
--- 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
-
--- 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
-
--- 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 
-
--- 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ℕ<n
-fin<n : {n : ℕ} {f : Fin n} → toℕ f < n
-fin<n {_} {zero} = s≤s z≤n
-fin<n {suc n} {suc f} = s≤s (fin<n {n} {f})
-
--- toℕ≤n
-fin≤n : {n : ℕ} (f : Fin (suc n)) → toℕ f ≤ n
-fin≤n {_} zero = z≤n
-fin≤n {suc n} (suc f) = s≤s (fin≤n {n} f)
-
-pred<n : {n : ℕ} {f : Fin (suc n)} → n > 0  → Data.Nat.pred (toℕ f) < n
-pred<n {suc n} {zero} (s≤s z≤n) = s≤s z≤n
-pred<n {suc n} {suc f} (s≤s z≤n) = fin<n
-
-fin<asa : {n : ℕ} → toℕ (fromℕ< {n} a<sa) ≡ n
-fin<asa = toℕ-fromℕ< nat.a<sa
-
--- fromℕ<-toℕ
-toℕ→from : {n : ℕ} {x : Fin (suc n)} → toℕ x ≡ n → fromℕ n ≡ x
-toℕ→from {0} {zero} refl = refl
-toℕ→from {suc n} {suc x} eq = cong (λ k → suc k ) ( toℕ→from {n} {x} (cong (λ k → Data.Nat.pred k ) eq ))
-
-0≤fmax : {n : ℕ } → (# 0) Data.Fin.≤ fromℕ< {n} a<sa
-0≤fmax  = subst (λ k → 0 ≤ k ) (sym (toℕ-fromℕ< a<sa)) z≤n
-
-0<fmax : {n : ℕ } → (# 0) Data.Fin.< fromℕ< {suc n} a<sa
-0<fmax = subst (λ k → 0 < k ) (sym (toℕ-fromℕ< a<sa)) (s≤s z≤n)
-
--- toℕ-injective
-i=j : {n : ℕ} (i j : Fin n) → toℕ i ≡ toℕ j → i ≡ j
-i=j {suc n} zero zero refl = refl
-i=j {suc n} (suc i) (suc j) eq = cong ( λ k → suc k ) ( i=j i j (cong ( λ k → Data.Nat.pred k ) eq) )
-
--- raise 1
-fin+1 :  { n : ℕ } → Fin n → Fin (suc n)
-fin+1  zero = zero 
-fin+1  (suc x) = suc (fin+1 x)
-
-open import Data.Nat.Properties as NatP  hiding ( _≟_ )
-
-fin+1≤ : { i n : ℕ } → (a : i < n)  → fin+1 (fromℕ< a) ≡ fromℕ< (<-trans a a<sa)
-fin+1≤ {0} {suc i} (s≤s z≤n) = refl
-fin+1≤ {suc n} {suc (suc i)} (s≤s (s≤s a)) = cong (λ k → suc k ) ( fin+1≤ {n} {suc i} (s≤s a) )
-
-fin+1-toℕ : { n : ℕ } → { x : Fin n} → toℕ (fin+1 x) ≡ toℕ x
-fin+1-toℕ {suc n} {zero} = refl
-fin+1-toℕ {suc n} {suc x} = cong (λ k → suc k ) (fin+1-toℕ {n} {x})
-
-open import Relation.Nullary 
-open import Data.Empty
-
-fin-1 :  { n : ℕ } → (x : Fin (suc n)) → ¬ (x ≡ zero )  → Fin n
-fin-1 zero ne = ⊥-elim (ne refl )
-fin-1 {n} (suc x) ne = x 
-
-fin-1-sx : { n : ℕ } → (x : Fin n) →  fin-1 (suc x) (λ ()) ≡ x 
-fin-1-sx zero = refl
-fin-1-sx (suc x) = refl
-
-fin-1-xs : { n : ℕ } → (x : Fin (suc n)) → (ne : ¬ (x ≡ zero ))  → suc (fin-1 x ne ) ≡ x
-fin-1-xs zero ne = ⊥-elim ( ne refl )
-fin-1-xs (suc x) ne = refl
-
--- suc-injective
--- suc-eq : {n : ℕ } {x y : Fin n} → Fin.suc x ≡ Fin.suc y  → x ≡ y
--- suc-eq {n} {x} {y} eq = subst₂ (λ j k → j ≡ k ) {!!} {!!} (cong (λ k → Data.Fin.pred k ) eq )
-
--- this is refl
-lemma3 : {a b : ℕ } → (lt : a < b ) → fromℕ< (s≤s lt) ≡ suc (fromℕ< lt)
-lemma3 (s≤s lt) = refl
-
--- fromℕ<-toℕ 
-lemma12 : {n m : ℕ } → (n<m : n < m ) → (f : Fin m )  → toℕ f ≡ n → f ≡ fromℕ< n<m 
-lemma12 {zero} {suc m} (s≤s z≤n) zero refl = refl
-lemma12 {suc n} {suc m} (s≤s n<m) (suc f) refl =  cong suc ( lemma12 {n} {m} n<m f refl  ) 
-
-open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) 
-open import Data.Fin.Properties
-
--- <-irrelevant
-<-nat=irr : {i j n : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → i<n ≅ j<n  
-<-nat=irr {zero} {zero} {suc n} refl {s≤s z≤n} {s≤s z≤n} = HE.refl
-<-nat=irr {suc i} {suc i} {suc n} refl {s≤s i<n} {s≤s j<n} = HE.cong (λ k → s≤s k ) ( <-nat=irr {i} {i} {n} refl  )
-
-lemma8 : {i j n : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → i<n ≅ j<n  
-lemma8 {zero} {zero} {suc n} refl {s≤s z≤n} {s≤s z≤n} = HE.refl
-lemma8 {suc i} {suc i} {suc n} refl {s≤s i<n} {s≤s j<n} = HE.cong (λ k → s≤s k ) ( lemma8 {i} {i} {n} refl  )
-
--- fromℕ<-irrelevant 
-lemma10 : {n i j  : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n }  → fromℕ< i<n ≡ fromℕ< j<n
-lemma10 {n} refl  = HE.≅-to-≡ (HE.cong (λ k → fromℕ< k ) (lemma8 refl  ))
-
-lemma31 : {a b c : ℕ } → { a<b : a < b } { b<c : b < c } { a<c : a < c } → NatP.<-trans a<b b<c ≡ a<c
-lemma31 {a} {b} {c} {a<b} {b<c} {a<c} = HE.≅-to-≡ (lemma8 refl) 
-
--- toℕ-fromℕ<
-lemma11 : {n m : ℕ } {x : Fin n } → (n<m : n < m ) → toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m)) ≡ toℕ x
-lemma11 {n} {m} {x} n<m  = begin
-              toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m))
-           ≡⟨ toℕ-fromℕ< _ ⟩
-              toℕ x
-           ∎  where
-               open ≡-Reasoning
-
-
--- a/automaton-in-agda/src/agda/finiteSet.agda	Sun Jun 13 18:48:57 2021 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,42 +0,0 @@
-{-# OPTIONS --allow-unsolved-metas #-}
-module finiteSet  where
-
-open import Data.Nat hiding ( _≟_ )
-open import Data.Fin renaming ( _<_ to _<<_ ) hiding (_≤_)
--- open import Data.Fin.Properties
-open import Data.Empty
-open import Relation.Nullary
-open import Relation.Binary.Definitions
-open import Relation.Binary.PropositionalEquality
-open import logic
-open import nat
-open import Data.Nat.Properties hiding ( _≟_ )
-
-open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) 
-
-record FiniteSet ( Q : Set ) : Set  where
-     field
-        finite : ℕ
-        Q←F : Fin finite → Q
-        F←Q : Q → Fin finite
-        finiso→ : (q : Q) → Q←F ( F←Q q ) ≡ q
-        finiso← : (f : Fin finite ) → F←Q ( Q←F f ) ≡ f
-     exists1 : (m : ℕ ) → m Data.Nat.≤ finite → (Q → Bool) → Bool
-     exists1  zero  _ _ = false
-     exists1 ( suc m ) m<n p = p (Q←F (fromℕ< {m} {finite} m<n)) \/ exists1 m (≤to< m<n) p
-     exists : ( Q → Bool ) → Bool
-     exists p = exists1 finite ≤-refl p 
-
-     open import Data.List
-     list1 : (m : ℕ ) → m Data.Nat.≤ finite → (Q → Bool) → List Q 
-     list1  zero  _ _ = []
-     list1 ( suc m ) m<n p with bool-≡-? (p (Q←F (fromℕ< {m} {finite} m<n))) true
-     ... | yes _ = Q←F (fromℕ< {m} {finite} m<n) ∷ list1 m (≤to< m<n) p
-     ... | no  _ = list1 m (≤to< m<n) p
-     to-list : ( Q → Bool ) → List Q 
-     to-list p = list1 finite ≤-refl p 
-
-     equal? : Q → Q → Bool
-     equal? q0 q1 with F←Q q0 ≟ F←Q q1
-     ... | yes p = true
-     ... | no ¬p = false
--- a/automaton-in-agda/src/agda/finiteSetUtil.agda	Sun Jun 13 18:48:57 2021 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,461 +0,0 @@
-{-# OPTIONS --allow-unsolved-metas #-} 
-
-module finiteSetUtil  where
-
-open import Data.Nat hiding ( _≟_ )
-open import Data.Fin renaming ( _<_ to _<<_ ) hiding (_≤_)
-open import Data.Fin.Properties
-open import Data.Empty
-open import Relation.Nullary
-open import Relation.Binary.Definitions
-open import Relation.Binary.PropositionalEquality
-open import logic
-open import nat
-open import finiteSet
-open import fin
-open import Data.Nat.Properties as NatP  hiding ( _≟_ )
-open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) 
-
-record Found ( Q : Set ) (p : Q → Bool ) : Set where
-     field
-       found-q : Q
-       found-p : p found-q ≡ true
-
-module _ {Q : Set } (F : FiniteSet Q) where
-     open FiniteSet F
-     equal→refl  : { x y : Q } → equal? x y ≡ true → x ≡ y
-     equal→refl {q0} {q1} eq with F←Q q0 ≟ F←Q q1
-     equal→refl {q0} {q1} refl | yes eq = begin
-            q0
-        ≡⟨ sym ( finiso→ q0) ⟩
-            Q←F (F←Q q0)
-        ≡⟨ cong (λ k → Q←F k ) eq ⟩
-            Q←F (F←Q q1)
-        ≡⟨ finiso→ q1 ⟩
-            q1
-        ∎  where open ≡-Reasoning
-     End : (m : ℕ ) → (p : Q → Bool ) → Set
-     End m p = (i : Fin finite) → m ≤ toℕ i → p (Q←F i )  ≡ false 
-     first-end :  ( p : Q → Bool ) → End finite p
-     first-end p i i>n = ⊥-elim (nat-≤> i>n (fin<n {finite} {i}) )
-     next-end : {m : ℕ } → ( p : Q → Bool ) → End (suc m) p
-              → (m<n : m < finite ) → p (Q←F (fromℕ< m<n )) ≡ false
-              → End m p
-     next-end {m} p prev m<n np i m<i with NatP.<-cmp m (toℕ i) 
-     next-end p prev m<n np i m<i | tri< a ¬b ¬c = prev i a
-     next-end p prev m<n np i m<i | tri> ¬a ¬b c = ⊥-elim ( nat-≤> m<i c )
-     next-end {m} p prev m<n np i m<i | tri≈ ¬a b ¬c = subst ( λ k → p (Q←F k) ≡ false) (m<n=i i b m<n ) np where
-              m<n=i : {n : ℕ } (i : Fin n) {m : ℕ } → m ≡ (toℕ i) → (m<n : m < n )  → fromℕ< m<n ≡ i
-              m<n=i i eq m<n = {!!} -- toℕ-inject (fromℕ≤ ?) i (subst (λ k → k ≡ toℕ i) (sym (toℕ-fromℕ≤ m<n)) eq )
-     found : { p : Q → Bool } → (q : Q ) → p q ≡ true → exists p ≡ true
-     found {p} q pt = found1 finite  (NatP.≤-refl ) ( first-end p ) where
-         found1 : (m : ℕ ) (m<n : m Data.Nat.≤ finite ) → ((i : Fin finite) → m ≤ toℕ i → p (Q←F i )  ≡ false ) →  exists1 m m<n p ≡ true
-         found1 0 m<n end = ⊥-elim ( ¬-bool (subst (λ k → k ≡ false ) (cong (λ k → p k) (finiso→ q) ) (end (F←Q q) z≤n )) pt )
-         found1 (suc m)  m<n end with bool-≡-? (p (Q←F (fromℕ< m<n))) true
-         found1 (suc m)  m<n end | yes eq = subst (λ k → k \/ exists1 m (≤to<  m<n) p ≡ true ) (sym eq) (bool-or-4 {exists1 m (≤to<  m<n) p} ) 
-         found1 (suc m)  m<n end | no np = begin
-                 p (Q←F (fromℕ< m<n)) \/ exists1 m (≤to<  m<n) p
-              ≡⟨ bool-or-1 (¬-bool-t np ) ⟩
-                 exists1 m (≤to<  m<n) p
-              ≡⟨ found1 m (≤to<  m<n) (next-end p end m<n (¬-bool-t np )) ⟩
-                 true
-              ∎  where open ≡-Reasoning
-
-
-
-record ISO (A B : Set) : Set where
-   field
-     A←B : B → A
-     B←A : A → B
-     iso← : (q : A) → A←B ( B←A q ) ≡ q
-     iso→ : (f : B) → B←A ( A←B f ) ≡ f
-
-iso-fin : {A B : Set} → FiniteSet A  → ISO A B → FiniteSet B 
-iso-fin {A} {B}  fin iso = record {
-   Q←F = λ f → ISO.B←A iso ( FiniteSet.Q←F fin f )
- ; F←Q = λ b → FiniteSet.F←Q fin ( ISO.A←B iso b )
- ; finiso→ = finiso→ 
- ; finiso← = finiso← 
-   } where
-   finiso→ : (q : B) → ISO.B←A iso (FiniteSet.Q←F fin (FiniteSet.F←Q fin (ISO.A←B iso q))) ≡ q
-   finiso→ q = begin
-              ISO.B←A iso (FiniteSet.Q←F fin (FiniteSet.F←Q fin (ISO.A←B iso q))) 
-           ≡⟨ cong (λ k → ISO.B←A iso k ) (FiniteSet.finiso→ fin _ ) ⟩
-              ISO.B←A iso (ISO.A←B iso q)
-           ≡⟨ ISO.iso→ iso _ ⟩
-              q
-           ∎  where
-           open ≡-Reasoning
-   finiso← : (f : Fin (FiniteSet.finite fin ))→ FiniteSet.F←Q fin (ISO.A←B iso (ISO.B←A iso (FiniteSet.Q←F fin f))) ≡ f
-   finiso← f = begin
-              FiniteSet.F←Q fin (ISO.A←B iso (ISO.B←A iso (FiniteSet.Q←F fin f))) 
-           ≡⟨ cong (λ k → FiniteSet.F←Q fin k ) (ISO.iso← iso _) ⟩
-              FiniteSet.F←Q fin (FiniteSet.Q←F fin f) 
-           ≡⟨ FiniteSet.finiso← fin _  ⟩
-              f
-           ∎  where
-           open ≡-Reasoning
-
-data One : Set where
-   one : One
-
-fin-∨1 : {B : Set} → (fb : FiniteSet B ) → FiniteSet (One ∨ B) 
-fin-∨1 {B} fb =  record {
-   Q←F = Q←F
- ; F←Q =  F←Q
- ; finiso→ = finiso→
- ; finiso← = finiso←
-   }  where
-   b = FiniteSet.finite fb
-   Q←F : Fin (suc b) → One ∨ B
-   Q←F zero = case1 one
-   Q←F (suc f) = case2 (FiniteSet.Q←F fb f)
-   F←Q : One ∨ B → Fin (suc b)
-   F←Q (case1 one) = zero
-   F←Q (case2 f ) = suc (FiniteSet.F←Q fb f) 
-   finiso→ : (q : One ∨ B) → Q←F (F←Q q) ≡ q
-   finiso→ (case1 one) = refl
-   finiso→ (case2 b) = cong (λ k → case2 k ) (FiniteSet.finiso→ fb b)
-   finiso← : (q : Fin (suc b)) → F←Q (Q←F q) ≡ q
-   finiso← zero = refl
-   finiso← (suc f) = cong ( λ k → suc k ) (FiniteSet.finiso← fb f)
-
-
-fin-∨2 : {B : Set} → ( a : ℕ ) → FiniteSet B  → FiniteSet (Fin a ∨ B) 
-fin-∨2 {B} zero  fb = iso-fin fb iso where
-   iso : ISO B (Fin zero ∨ B)
-   iso =  record {
-        A←B = A←B
-      ; B←A = λ b → case2 b
-      ; iso→ = iso→
-      ; iso← = λ _ → refl
-    } where
-     A←B : Fin zero ∨ B → B
-     A←B (case2 x) = x 
-     iso→ : (f : Fin zero ∨ B ) → case2 (A←B f) ≡ f
-     iso→ (case2 x)  = refl
-fin-∨2 {B} (suc a) fb =  iso-fin (fin-∨1 (fin-∨2 a fb) ) iso
-    where
-  iso : ISO (One ∨ (Fin a ∨ B) ) (Fin (suc a) ∨ B)
-  ISO.A←B iso (case1 zero) = case1 one
-  ISO.A←B iso (case1 (suc f)) = case2 (case1 f)
-  ISO.A←B iso (case2 b) = case2 (case2 b)
-  ISO.B←A iso (case1 one) = case1 zero
-  ISO.B←A iso (case2 (case1 f)) = case1 (suc f)
-  ISO.B←A iso (case2 (case2 b)) = case2 b
-  ISO.iso← iso (case1 one) = refl
-  ISO.iso← iso (case2 (case1 x)) = refl
-  ISO.iso← iso (case2 (case2 x)) = refl
-  ISO.iso→ iso (case1 zero) = refl
-  ISO.iso→ iso (case1 (suc x)) = refl
-  ISO.iso→ iso (case2 x) = refl
-
-
-FiniteSet→Fin : {A : Set} → (fin : FiniteSet A  ) → ISO (Fin (FiniteSet.finite fin)) A
-ISO.A←B (FiniteSet→Fin fin) f = FiniteSet.F←Q fin f
-ISO.B←A (FiniteSet→Fin fin) f = FiniteSet.Q←F fin f
-ISO.iso← (FiniteSet→Fin fin) = FiniteSet.finiso← fin
-ISO.iso→ (FiniteSet→Fin fin) =  FiniteSet.finiso→ fin
-   
-
-fin-∨ : {A B : Set} → FiniteSet A → FiniteSet B → FiniteSet (A ∨ B) 
-fin-∨ {A} {B}  fa fb = iso-fin (fin-∨2 a  fb ) iso2 where
-    a = FiniteSet.finite fa
-    ia = FiniteSet→Fin fa
-    iso2 : ISO (Fin a ∨ B ) (A ∨ B)
-    ISO.A←B iso2 (case1 x) = case1 ( ISO.A←B ia x )
-    ISO.A←B iso2 (case2 x) = case2 x
-    ISO.B←A iso2 (case1 x) = case1 ( ISO.B←A ia x )
-    ISO.B←A iso2 (case2 x) = case2 x
-    ISO.iso← iso2 (case1 x) = cong ( λ k → case1 k ) (ISO.iso← ia x)
-    ISO.iso← iso2 (case2 x) = refl
-    ISO.iso→ iso2 (case1 x) = cong ( λ k → case1 k ) (ISO.iso→ ia x)
-    ISO.iso→ iso2 (case2 x) = refl
-
-open import Data.Product
-
-fin-× : {A B : Set} → FiniteSet A → FiniteSet B → FiniteSet (A × B) 
-fin-× {A} {B}  fa fb with FiniteSet→Fin fa
-... | a=f = iso-fin (fin-×-f a ) iso-1 where
-   a = FiniteSet.finite fa
-   b = FiniteSet.finite fb
-   iso-1 : ISO (Fin a × B) ( A × B )
-   ISO.A←B iso-1 x = ( FiniteSet.F←Q fa (proj₁ x)  , proj₂ x) 
-   ISO.B←A iso-1 x = ( FiniteSet.Q←F fa (proj₁ x)  , proj₂ x) 
-   ISO.iso← iso-1 x  =  lemma  where
-     lemma : (FiniteSet.F←Q fa (FiniteSet.Q←F fa (proj₁ x)) , proj₂ x) ≡ ( proj₁ x , proj₂ x )
-     lemma = cong ( λ k → ( k ,  proj₂ x ) )  (FiniteSet.finiso← fa _ )
-   ISO.iso→ iso-1 x = cong ( λ k → ( k ,  proj₂ x ) )  (FiniteSet.finiso→ fa _ )
-
-   iso-2 : {a : ℕ } → ISO (B ∨ (Fin a × B)) (Fin (suc a) × B)
-   ISO.A←B iso-2 (zero , b ) = case1 b
-   ISO.A←B iso-2 (suc fst , b ) = case2 ( fst , b )
-   ISO.B←A iso-2 (case1 b) = ( zero , b )
-   ISO.B←A iso-2 (case2 (a , b )) = ( suc a , b )
-   ISO.iso← iso-2 (case1 x) = refl
-   ISO.iso← iso-2 (case2 x) = refl
-   ISO.iso→ iso-2 (zero , b ) = refl
-   ISO.iso→ iso-2 (suc a , b ) = refl
-
-   fin-×-f : ( a  : ℕ ) → FiniteSet ((Fin a) × B) 
-   fin-×-f zero = record { Q←F = λ () ; F←Q = λ () ; finiso→ = λ () ; finiso← = λ () ; finite = 0 }
-   fin-×-f (suc a) = iso-fin ( fin-∨ fb ( fin-×-f a ) ) iso-2
-
-open _∧_
-
-fin-∧ : {A B : Set} → FiniteSet A → FiniteSet B → FiniteSet (A ∧ B) 
-fin-∧ {A} {B} fa fb with FiniteSet→Fin fa    -- same thing for our tool
-... | a=f = iso-fin (fin-×-f a ) iso-1 where
-   a = FiniteSet.finite fa
-   b = FiniteSet.finite fb
-   iso-1 : ISO (Fin a ∧ B) ( A ∧ B )
-   ISO.A←B iso-1 x = record { proj1 = FiniteSet.F←Q fa (proj1 x)  ; proj2 =  proj2 x} 
-   ISO.B←A iso-1 x = record { proj1 = FiniteSet.Q←F fa (proj1 x)  ; proj2 =  proj2 x}
-   ISO.iso← iso-1 x  =  lemma  where
-     lemma : record { proj1 = FiniteSet.F←Q fa (FiniteSet.Q←F fa (proj1 x)) ; proj2 =  proj2 x} ≡ record {proj1 =  proj1 x ; proj2 =  proj2 x }
-     lemma = cong ( λ k → record {proj1 = k ;  proj2 = proj2 x } )  (FiniteSet.finiso← fa _ )
-   ISO.iso→ iso-1 x = cong ( λ k → record {proj1 =  k ; proj2 =  proj2 x } )  (FiniteSet.finiso→ fa _ )
-
-   iso-2 : {a : ℕ } → ISO (B ∨ (Fin a ∧ B)) (Fin (suc a) ∧ B)
-   ISO.A←B iso-2 (record { proj1 = zero ; proj2 =  b }) = case1 b
-   ISO.A←B iso-2 (record { proj1 = suc fst ; proj2 =  b }) = case2 ( record { proj1 = fst ; proj2 =  b } )
-   ISO.B←A iso-2 (case1 b) = record {proj1 =  zero ; proj2 =  b }
-   ISO.B←A iso-2 (case2 (record { proj1 = a ; proj2 =  b })) = record { proj1 =  suc a ; proj2 =  b }
-   ISO.iso← iso-2 (case1 x) = refl
-   ISO.iso← iso-2 (case2 x) = refl
-   ISO.iso→ iso-2 (record { proj1 = zero ; proj2 =  b }) = refl
-   ISO.iso→ iso-2 (record { proj1 = suc a ; proj2 =  b }) = refl
-
-   fin-×-f : ( a  : ℕ ) → FiniteSet ((Fin a) ∧ B) 
-   fin-×-f zero = record { Q←F = λ () ; F←Q = λ () ; finiso→ = λ () ; finiso← = λ () ; finite = 0 }
-   fin-×-f (suc a) = iso-fin ( fin-∨ fb ( fin-×-f a ) ) iso-2
-
--- import Data.Nat.DivMod
-
-open import Data.Vec
-import Data.Product
-
-exp2 : (n : ℕ ) → exp 2 (suc n) ≡ exp 2 n Data.Nat.+ exp 2 n
-exp2 n = begin
-      exp 2 (suc n)
-   ≡⟨⟩
-      2 * ( exp 2 n )
-   ≡⟨ *-comm 2 (exp 2 n)  ⟩
-      ( exp 2 n ) * 2
-   ≡⟨ *-suc ( exp 2 n ) 1 ⟩
-      (exp 2 n ) Data.Nat.+ ( exp 2 n ) * 1
-   ≡⟨ cong ( λ k →  (exp 2 n ) Data.Nat.+  k ) (proj₂ *-identity (exp 2 n) ) ⟩
-      exp 2 n Data.Nat.+ exp 2 n
-   ∎  where
-       open ≡-Reasoning
-       open Data.Product
-
-cast-iso : {n m : ℕ } → (eq : n ≡ m ) → (f : Fin m ) → cast eq ( cast (sym eq ) f)  ≡ f
-cast-iso refl zero =  refl
-cast-iso refl (suc f) = cong ( λ k → suc k ) ( cast-iso refl f )
-
-
-fin2List : {n : ℕ } → FiniteSet (Vec Bool n) 
-fin2List {zero} = record {
-   Q←F = λ _ → Vec.[]
- ; F←Q =  λ _ → # 0
- ; finiso→ = finiso→ 
- ; finiso← = finiso← 
-   } where
-   Q = Vec Bool zero
-   finiso→ : (q : Q) → [] ≡ q
-   finiso→ [] = refl
-   finiso← : (f : Fin (exp 2 zero)) → # 0 ≡ f
-   finiso← zero = refl
-fin2List {suc n} = subst (λ k → FiniteSet (Vec Bool (suc n)) ) (sym (exp2 n)) ( iso-fin (fin-∨ (fin2List ) (fin2List )) iso )
-    where
-   QtoR : Vec Bool (suc  n) →  Vec Bool n ∨ Vec Bool n
-   QtoR ( true ∷ x ) = case1 x
-   QtoR ( false ∷ x ) = case2 x
-   RtoQ : Vec Bool n ∨ Vec Bool n → Vec Bool (suc  n) 
-   RtoQ ( case1 x ) = true ∷ x
-   RtoQ ( case2 x ) = false ∷ x
-   isoRQ : (x : Vec Bool (suc  n) ) → RtoQ ( QtoR x ) ≡ x
-   isoRQ (true ∷ _ ) = refl
-   isoRQ (false ∷ _ ) = refl
-   isoQR : (x : Vec Bool n ∨ Vec Bool n ) → QtoR ( RtoQ x ) ≡ x
-   isoQR (case1 x) = refl
-   isoQR (case2 x) = refl
-   iso : ISO (Vec Bool n ∨ Vec Bool n) (Vec Bool (suc n))
-   iso = record { A←B = QtoR ; B←A = RtoQ ; iso← = isoQR ; iso→ = isoRQ  }
-
-F2L : {Q : Set } {n : ℕ } → (fin : FiniteSet Q ) → n < suc (FiniteSet.finite fin) → ( (q : Q) → toℕ (FiniteSet.F←Q fin q ) < n  → Bool ) → Vec Bool n
-F2L  {Q} {zero} fin _ Q→B = []
-F2L  {Q} {suc n} fin (s≤s n<m) Q→B = Q→B (FiniteSet.Q←F fin (fromℕ< n<m)) lemma6 ∷ F2L {Q} fin (NatP.<-trans n<m a<sa ) qb1 where
-   lemma6 : toℕ (FiniteSet.F←Q fin (FiniteSet.Q←F fin (fromℕ< n<m))) < suc n
-   lemma6 = subst (λ k → toℕ k < suc n ) (sym (FiniteSet.finiso← fin _ )) (subst (λ k → k < suc n) (sym (toℕ-fromℕ< n<m ))  a<sa )
-   qb1 : (q : Q) → toℕ (FiniteSet.F←Q fin q) < n → Bool
-   qb1 q q<n = Q→B q (NatP.<-trans q<n a<sa)
-
-List2Func : { Q : Set } → {n : ℕ } → (fin : FiniteSet Q ) → n < suc (FiniteSet.finite fin)  → Vec Bool n →  Q → Bool 
-List2Func {Q} {zero} fin (s≤s z≤n) [] q = false
-List2Func {Q} {suc n} fin (s≤s n<m) (h ∷ t) q with  FiniteSet.F←Q fin q ≟ fromℕ< n<m
-... | yes _ = h
-... | no _ = List2Func {Q} fin (NatP.<-trans n<m a<sa ) t q
-
-open import Level renaming ( suc to Suc ; zero to Zero) 
-open import Axiom.Extensionality.Propositional
-postulate f-extensionality : { n : Level}  →  Axiom.Extensionality.Propositional.Extensionality n n 
-
-F2L-iso : { Q : Set } → (fin : FiniteSet Q ) → (x : Vec Bool (FiniteSet.finite fin) ) → F2L fin a<sa (λ q _ → List2Func fin a<sa x q ) ≡ x
-F2L-iso {Q} fin x = f2l m a<sa x where
-  m = FiniteSet.finite fin
-  f2l : (n : ℕ ) → (n<m : n < suc m )→ (x : Vec Bool n ) → F2L fin n<m (λ q q<n → List2Func fin n<m x q )  ≡ x 
-  f2l zero (s≤s z≤n) [] = refl
-  f2l (suc n) (s≤s n<m) (h ∷ t ) = lemma1 lemma2 lemma3f where
-    lemma1 : {n : ℕ } → {h h1 : Bool } → {t t1 : Vec Bool n } → h ≡ h1 → t ≡ t1 →  h ∷ t ≡ h1 ∷ t1
-    lemma1 refl refl = refl
-    lemma2 : List2Func fin (s≤s n<m) (h ∷ t) (FiniteSet.Q←F fin (fromℕ< n<m)) ≡ h
-    lemma2 with FiniteSet.F←Q fin (FiniteSet.Q←F fin (fromℕ< n<m))  ≟ fromℕ< n<m
-    lemma2 | yes p = refl
-    lemma2 | no ¬p = ⊥-elim ( ¬p (FiniteSet.finiso← fin _) )
-    lemma4 : (q : Q ) → toℕ (FiniteSet.F←Q fin q ) < n → List2Func fin (s≤s n<m) (h ∷ t) q ≡ List2Func fin (NatP.<-trans n<m a<sa) t q
-    lemma4 q _ with FiniteSet.F←Q fin q ≟ fromℕ< n<m 
-    lemma4 q lt | yes p = ⊥-elim ( nat-≡< (toℕ-fromℕ< n<m) (lemma5 n lt (cong (λ k → toℕ k) p))) where 
-        lemma5 : {j k : ℕ } → ( n : ℕ) → suc j ≤ n → j ≡ k → k < n
-        lemma5 {zero} (suc n) (s≤s z≤n) refl = s≤s  z≤n
-        lemma5 {suc j} (suc n) (s≤s lt) refl = s≤s (lemma5 {j} n lt refl)
-    lemma4 q _ | no ¬p = refl
-    lemma3f :  F2L fin (NatP.<-trans n<m a<sa) (λ q q<n → List2Func fin (s≤s n<m) (h ∷ t) q  ) ≡ t
-    lemma3f = begin 
-         F2L fin (NatP.<-trans n<m a<sa) (λ q q<n → List2Func fin (s≤s n<m) (h ∷ t) q )
-       ≡⟨ cong (λ k → F2L fin (NatP.<-trans n<m a<sa) ( λ q q<n → k q q<n ))
-              (f-extensionality ( λ q →  
-              (f-extensionality ( λ q<n →  lemma4 q q<n )))) ⟩
-         F2L fin (NatP.<-trans n<m a<sa) (λ q q<n → List2Func fin (NatP.<-trans n<m a<sa) t q )
-       ≡⟨ f2l n (NatP.<-trans n<m a<sa ) t ⟩
-         t
-       ∎  where
-         open ≡-Reasoning
-
-
-L2F : {Q : Set } {n : ℕ } → (fin : FiniteSet Q )  → n < suc (FiniteSet.finite fin) → Vec Bool n → (q :  Q ) → toℕ (FiniteSet.F←Q fin q ) < n  → Bool
-L2F fin n<m x q q<n = List2Func fin n<m x q 
-
-L2F-iso : { Q : Set } → (fin : FiniteSet Q ) → (f : Q → Bool ) → (q : Q ) → (L2F fin a<sa (F2L fin a<sa (λ q _ → f q) )) q (toℕ<n _) ≡ f q
-L2F-iso {Q} fin f q = l2f m a<sa (toℕ<n _) where
-  m = FiniteSet.finite fin
-  lemma11f : {n : ℕ } → (n<m : n < m )  → ¬ ( FiniteSet.F←Q fin q ≡ fromℕ< n<m ) → toℕ (FiniteSet.F←Q fin q) ≤ n → toℕ (FiniteSet.F←Q fin q) < n
-  lemma11f  n<m ¬q=n q≤n = lemma13 n<m (contra-position (lemma12 n<m _) ¬q=n ) q≤n where
-     lemma13 : {n nq : ℕ } → (n<m : n < m )  → ¬ ( nq ≡ n ) → nq  ≤ n → nq < n
-     lemma13 {0} {0} (s≤s z≤n) nt z≤n = ⊥-elim ( nt refl )
-     lemma13 {suc _} {0} (s≤s (s≤s n<m)) nt z≤n = s≤s z≤n
-     lemma13 {suc n} {suc nq} n<m nt (s≤s nq≤n) = s≤s (lemma13 {n} {nq} (NatP.<-trans a<sa n<m ) (λ eq → nt ( cong ( λ k → suc k ) eq )) nq≤n)
-     lemma3f : {a b : ℕ } → (lt : a < b ) → fromℕ< (s≤s lt) ≡ suc (fromℕ< lt)
-     lemma3f (s≤s lt) = refl
-     lemma12f : {n m : ℕ } → (n<m : n < m ) → (f : Fin m )  → toℕ f ≡ n → f ≡ fromℕ< n<m 
-     lemma12f {zero} {suc m} (s≤s z≤n) zero refl = refl
-     lemma12f {suc n} {suc m} (s≤s n<m) (suc f) refl = subst ( λ k → suc f ≡ k ) (sym (lemma3f n<m) ) ( cong ( λ k → suc k ) ( lemma12f {n} {m} n<m f refl  ) )
-  l2f :  (n : ℕ ) → (n<m : n < suc m ) → (q<n : toℕ (FiniteSet.F←Q fin q ) < n )  →  (L2F fin n<m (F2L fin n<m  (λ q _ → f q))) q q<n ≡ f q
-  l2f zero (s≤s z≤n) ()
-  l2f (suc n) (s≤s n<m) (s≤s n<q) with FiniteSet.F←Q fin q ≟ fromℕ< n<m 
-  l2f (suc n) (s≤s n<m) (s≤s n<q) | yes p = begin 
-        f (FiniteSet.Q←F fin (fromℕ< n<m)) 
-     ≡⟨ cong ( λ k → f (FiniteSet.Q←F fin k )) (sym p)  ⟩
-        f (FiniteSet.Q←F fin ( FiniteSet.F←Q fin q ))
-     ≡⟨ cong ( λ k → f k ) (FiniteSet.finiso→ fin _ ) ⟩
-        f q 
-     ∎  where
-       open ≡-Reasoning
-  l2f (suc n) (s≤s n<m) (s≤s n<q) | no ¬p = l2f n (NatP.<-trans n<m a<sa) (lemma11f n<m ¬p n<q)
-
-fin→ : {A : Set} → FiniteSet A → FiniteSet (A → Bool ) 
-fin→ {A}  fin = iso-fin fin2List iso where
-    a = FiniteSet.finite fin
-    iso : ISO (Vec Bool a ) (A → Bool)
-    ISO.A←B iso x = F2L fin a<sa ( λ q _ → x q )
-    ISO.B←A iso x = List2Func fin a<sa x 
-    ISO.iso← iso x  =  F2L-iso fin x 
-    ISO.iso→ iso x = lemma where
-      lemma : List2Func fin a<sa (F2L fin a<sa (λ q _ → x q)) ≡ x
-      lemma = f-extensionality ( λ q → L2F-iso fin x q )
-    
-
-Fin2Finite : ( n : ℕ ) → FiniteSet (Fin n) 
-Fin2Finite n = record { F←Q = λ x → x ; Q←F = λ x → x ; finiso← = λ q → refl ; finiso→ = λ q → refl }
-
-data fin-less { n : ℕ } { A : Set }  (fa : FiniteSet A ) (n<m : n < FiniteSet.finite fa ) : Set where
-  elm1 : (elm : A ) → toℕ (FiniteSet.F←Q fa elm ) < n → fin-less fa n<m 
-
-get-elm : { n : ℕ }  { A : Set } {fa : FiniteSet A } {n<m : n < FiniteSet.finite fa } → fin-less fa n<m → A
-get-elm (elm1 a _ ) = a
-
-get-< : { n : ℕ }  { A : Set } {fa : FiniteSet A } {n<m : n < FiniteSet.finite fa }→ (f : fin-less fa n<m ) → toℕ (FiniteSet.F←Q fa (get-elm f )) < n
-get-< (elm1 _ b ) = b
-
-fin-less-cong : { n : ℕ }  { A : Set } (fa : FiniteSet A ) (n<m : n < FiniteSet.finite fa )
-   → (x y : fin-less fa n<m ) → get-elm {n} {A} {fa} x ≡ get-elm {n} {A} {fa} y → get-< x ≅  get-< y → x ≡ y
-fin-less-cong fa n<m (elm1 elm x) (elm1 elm x) refl HE.refl = refl
-
-fin-< : {A : Set} → { n : ℕ } → (fa : FiniteSet A ) → (n<m : n < FiniteSet.finite fa ) → FiniteSet (fin-less fa n<m ) 
-fin-< {A}  {n} fa n<m = iso-fin (Fin2Finite n) iso where
-    m = FiniteSet.finite fa
-    iso : ISO (Fin n) (fin-less fa n<m )
-    lemma8f : {i j n : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → i<n ≅ j<n  
-    lemma8f {zero} {zero} {suc n} refl {s≤s z≤n} {s≤s z≤n} = HE.refl
-    lemma8f {suc i} {suc i} {suc n} refl {s≤s i<n} {s≤s j<n} = HE.cong (λ k → s≤s k ) ( lemma8f {i} {i}  refl  )
-    lemma10f : {n i j  : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n }  → fromℕ< i<n ≡ fromℕ< j<n
-    lemma10f  refl  = HE.≅-to-≡ (HE.cong (λ k → fromℕ< k ) (lemma8f refl  ))
-    lemma3f : {a b c : ℕ } → { a<b : a < b } { b<c : b < c } { a<c : a < c } → NatP.<-trans a<b b<c ≡ a<c
-    lemma3f {a} {b} {c} {a<b} {b<c} {a<c} = HE.≅-to-≡ (lemma8f refl) 
-    lemma11f : {n : ℕ } {x : Fin n } → (n<m : n < m ) → toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m)) ≡ toℕ x
-    lemma11f {n} {x} n<m  = begin
-         toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m))
-      ≡⟨ toℕ-fromℕ< _ ⟩
-         toℕ x
-      ∎  where
-          open ≡-Reasoning
-    ISO.A←B iso (elm1 elm x) = fromℕ< x
-    ISO.B←A iso x = elm1 (FiniteSet.Q←F fa (fromℕ< (NatP.<-trans x<n n<m ))) to<n where
-      x<n : toℕ x < n
-      x<n = toℕ<n x
-      to<n : toℕ (FiniteSet.F←Q fa (FiniteSet.Q←F fa (fromℕ< (NatP.<-trans x<n n<m)))) < n
-      to<n = subst (λ k → toℕ k < n ) (sym (FiniteSet.finiso← fa _ )) (subst (λ k → k < n ) (sym ( toℕ-fromℕ< (NatP.<-trans x<n n<m) )) x<n )
-    ISO.iso← iso x  = lemma2 where
-      lemma2 : fromℕ< (subst (λ k → toℕ k < n) (sym
-       (FiniteSet.finiso← fa (fromℕ< (NatP.<-trans (toℕ<n x) n<m)))) (subst (λ k → k < n)
-       (sym (toℕ-fromℕ< (NatP.<-trans (toℕ<n x) n<m))) (toℕ<n x))) ≡ x
-      lemma2 = begin
-        fromℕ< (subst (λ k → toℕ k < n) (sym
-          (FiniteSet.finiso← fa (fromℕ< (NatP.<-trans (toℕ<n x) n<m)))) (subst (λ k → k < n)
-               (sym (toℕ-fromℕ< (NatP.<-trans (toℕ<n x) n<m))) (toℕ<n x))) 
-        ≡⟨⟩
-           fromℕ< ( subst (λ k → toℕ ( k ) < n ) (sym (FiniteSet.finiso← fa _ )) lemma6 )
-        ≡⟨ lemma10 (cong (λ k → toℕ k) (FiniteSet.finiso← fa _ ) ) ⟩
-           fromℕ< lemma6
-        ≡⟨ lemma10 (lemma11 n<m ) ⟩
-           fromℕ< ( toℕ<n x )
-        ≡⟨ fromℕ<-toℕ _ _ ⟩
-           x 
-        ∎  where
-          open ≡-Reasoning
-          lemma6 : toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m)) < n
-          lemma6 = subst ( λ k → k < n ) (sym (toℕ-fromℕ< (NatP.<-trans (toℕ<n x) n<m))) (toℕ<n x )
-    ISO.iso→ iso (elm1 elm x) = fin-less-cong fa n<m _ _ lemma (lemma8 (cong (λ k → toℕ (FiniteSet.F←Q fa k) ) lemma ) ) where
-      lemma13 : toℕ (fromℕ< x) ≡ toℕ (FiniteSet.F←Q fa elm)
-      lemma13 = begin
-            toℕ (fromℕ< x)
-         ≡⟨ toℕ-fromℕ< _ ⟩
-            toℕ (FiniteSet.F←Q fa elm)
-         ∎  where open ≡-Reasoning
-      lemma : FiniteSet.Q←F fa (fromℕ< (NatP.<-trans (toℕ<n (ISO.A←B iso (elm1 elm x))) n<m)) ≡ elm 
-      lemma = begin
-           FiniteSet.Q←F fa (fromℕ< (NatP.<-trans (toℕ<n (ISO.A←B iso (elm1 elm x))) n<m))
-         ≡⟨⟩
-           FiniteSet.Q←F fa (fromℕ< ( NatP.<-trans (toℕ<n ( fromℕ< x ) ) n<m))
-         ≡⟨ cong (λ k → FiniteSet.Q←F fa k) (lemma10 lemma13 ) ⟩
-            FiniteSet.Q←F fa (fromℕ< ( NatP.<-trans x n<m))
-         ≡⟨ cong (λ k → FiniteSet.Q←F fa (fromℕ< k ))  {!!} ⟩
-           FiniteSet.Q←F fa (fromℕ< ( toℕ<n (FiniteSet.F←Q fa elm)))
-         ≡⟨ cong (λ k → FiniteSet.Q←F fa k ) ( fromℕ<-toℕ _ _ ) ⟩
-           FiniteSet.Q←F fa (FiniteSet.F←Q fa elm )
-         ≡⟨ FiniteSet.finiso→ fa _ ⟩
-            elm 
-         ∎  where open ≡-Reasoning
-
-
--- a/automaton-in-agda/src/agda/flcagl.agda	Sun Jun 13 18:48:57 2021 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,481 +0,0 @@
-open import Relation.Nullary
-open import Relation.Binary.PropositionalEquality
-module flcagl
-   (A : Set)
-   ( _≟_ :  (a b : A) → Dec ( a ≡ b ) ) where
-
-open import Data.Bool hiding ( _≟_ ) 
--- open import Data.Maybe
-open import Level renaming ( zero to Zero ; suc to succ )
-open import Size 
-
-module List where
-
-        data List (i : Size) (A : Set) : Set where
-          [] : List i A
-          _∷_ : {j : Size< i} (x : A) (xs : List j A) → List i A
-
-
-        map : ∀{i A B} → (A → B) → List i A → List i B
-        map f [] = []
-        map f ( x ∷ xs)= f x ∷ map f xs
-
-        foldr : ∀{i} {A B : Set} → (A → B → B) → B → List i A → B
-        foldr c n [] = n
-        foldr c n (x ∷ xs) = c x (foldr c n xs)
-
-        any : ∀{i A} → (A → Bool) → List i A → Bool
-        any p xs = foldr _∨_ false (map p xs)
-
-module Lang where
-
-        open List 
-
-        record  Lang (i : Size)  : Set  where
-           coinductive
-           field
-              ν : Bool
-              δ : ∀{j : Size< i} → A → Lang j
-
-        open Lang
-
-        _∋_ : ∀{i} → Lang i → List i A → Bool
-        l ∋ [] = ν l
-        l ∋ ( a ∷ as ) = δ l a ∋ as
-
-        trie : ∀{i}  (f : List i A → Bool) → Lang i
-        ν (trie f) = f []
-        δ (trie f) a = trie (λ as → f (a ∷ as))
-
-        ∅ : ∀{i} → Lang i 
-        ν ∅ = false
-        δ ∅ x = ∅
-
-        ε : ∀{i} → Lang i 
-        ν ε = true
-        δ ε x = ∅
-
-        open import Relation.Nullary.Decidable
-
-        char : ∀{i}  (a : A) → Lang i
-        ν (char a) = false
-        δ (char a) x = if ⌊ a ≟ x ⌋ then ε else ∅
-
-        compl : ∀{i}  (l : Lang i) → Lang i
-        ν (compl l) = not (ν l)
-        δ (compl l) x = compl (δ l x)
-
-
-        _∪_ : ∀{i} (k l : Lang i) → Lang i
-        ν (k ∪ l) = ν k ∨ ν l
-        δ (k ∪ l) x = δ k x ∪ δ l x
-
-
-        _·_ : ∀{i}  (k l : Lang i) → Lang i
-        ν (k · l) = ν k ∧ ν l
-        δ (k · l) x = let k′l =  δ k x  · l in if ν k then k′l ∪ δ l x else k′l
-
-        _*_ : ∀{i} (k l : Lang i )  → Lang i
-        ν (k * l) = ν k ∧ ν l
-        δ (_*_ {i} k  l) {j} x =
-            let
-                k′l : Lang j
-                k′l  = _*_ {j} (δ k {j} x) l
-            in  if ν k then _∪_ {j}  k′l (δ l {j} x) else k′l 
-
-        _* : ∀{i} (l : Lang i) → Lang i
-        ν (l *) = true
-        δ (l *) x = δ l x · (l *)
-
-        record _≅⟨_⟩≅_ (l : Lang ∞ ) i (k : Lang ∞) : Set  where
-           coinductive
-           field ≅ν : ν l ≡ ν k
-                 ≅δ : ∀ {j : Size< i } (a : A ) → δ l a ≅⟨ j ⟩≅ δ k a
-
-        open _≅⟨_⟩≅_
-
-        ≅refl : ∀{i} {l : Lang ∞} → l ≅⟨ i ⟩≅ l
-        ≅ν ≅refl = refl
-        ≅δ ≅refl a = ≅refl
-
-
-        ≅sym : ∀{i} {k l : Lang ∞} (p : l ≅⟨ i ⟩≅ k) → k ≅⟨ i ⟩≅ l
-        ≅ν (≅sym p) = sym (≅ν p)
-        ≅δ (≅sym p) a = ≅sym (≅δ p a)
-
-        ≅trans : ∀{i} {k l m : Lang ∞}
-           ( p : k ≅⟨ i ⟩≅ l ) ( q : l ≅⟨ i ⟩≅ m ) → k ≅⟨ i ⟩≅ m
-        ≅ν (≅trans p q) = trans (≅ν p) (≅ν q)
-        ≅δ (≅trans p q) a = ≅trans (≅δ p a) (≅δ q a)
-
-        open import Relation.Binary
-
-        ≅isEquivalence : ∀(i : Size) → IsEquivalence _≅⟨ i ⟩≅_
-        ≅isEquivalence i = record { refl = ≅refl; sym = ≅sym; trans = ≅trans }
-
-        Bis : ∀(i : Size) → Setoid _ _
-        Setoid.Carrier (Bis i) = Lang ∞
-        Setoid._≈_ (Bis i) = _≅⟨ i ⟩≅_
-        Setoid.isEquivalence (Bis i) = ≅isEquivalence i
-
-        import Relation.Binary.EqReasoning as EqR
-
-        ≅trans′ : ∀ i (k l m : Lang ∞)
-           ( p : k ≅⟨ i ⟩≅ l ) ( q : l ≅⟨ i ⟩≅ m ) → k ≅⟨ i ⟩≅ m
-        ≅trans′ i k l m p q = begin
-                k ≈⟨ p ⟩
-                l ≈⟨ q ⟩
-                m ∎ where open EqR (Bis i)
-
-        open import Data.Bool.Properties
-
-        union-assoc : ∀{i} (k {l m} : Lang ∞) → ((k ∪ l) ∪ m ) ≅⟨ i ⟩≅ ( k ∪ (l ∪ m) )
-        ≅ν (union-assoc k) = ∨-assoc (ν k) _ _
-        ≅δ (union-assoc k) a = union-assoc (δ k a)
-        union-comm : ∀{i} (l k : Lang ∞) → (l ∪ k ) ≅⟨ i ⟩≅ ( k ∪ l )
-        ≅ν (union-comm l k) = ∨-comm (ν l) _
-        ≅δ (union-comm l k) a = union-comm (δ l a) (δ k a)
-        union-idem : ∀{i} (l : Lang ∞) → (l ∪ l ) ≅⟨ i ⟩≅ l
-        ≅ν (union-idem l) = ∨-idem _
-        ≅δ (union-idem l) a = union-idem (δ l a)
-        union-emptyl : ∀{i}{l : Lang ∞} → (∅ ∪ l ) ≅⟨ i ⟩≅ l
-        ≅ν union-emptyl = refl
-        ≅δ union-emptyl a = union-emptyl
-
-        union-cong : ∀{i}{k k′ l l′ : Lang ∞}
-             (p : k ≅⟨ i ⟩≅ k′) (q : l ≅⟨ i ⟩≅ l′ ) → ( k ∪ l ) ≅⟨ i ⟩≅ ( k′ ∪ l′ )
-        ≅ν (union-cong p q) = cong₂ _∨_ (≅ν p) (≅ν q)
-        ≅δ (union-cong p q) a = union-cong (≅δ p a) (≅δ q a)
-
-        withExample : (P : Bool → Set) (p : P true) (q : P false) →
-           {A : Set} (g : A → Bool) (x : A) → P (g x)
-        withExample P p q g x with g x
-        ... | true = p
-        ... | false = q
-
-        rewriteExample : {A : Set} {P : A → Set} {x : A} (p : P x)
-            {g : A → A} (e : g x ≡ x) → P (g x)
-        rewriteExample p e rewrite e = p
-
-        infixr 6 _∪_
-        infixr 7 _·_
-        infix 5 _≅⟨_⟩≅_
-
-        union-congl : ∀{i}{k k′ l : Lang ∞}
-             (p : k ≅⟨ i ⟩≅ k′) → ( k ∪ l ) ≅⟨ i ⟩≅ ( k′ ∪ l )
-        union-congl eq = union-cong eq ≅refl
-
-        union-congr : ∀{i}{k l l′ : Lang ∞}
-             (p : l ≅⟨ i ⟩≅ l′) → ( k ∪ l ) ≅⟨ i ⟩≅ ( k ∪ l′ )
-        union-congr eq = union-cong ≅refl eq
-
-        union-swap24 :   ∀{i} ({x y z w} : Lang ∞)  →  (x ∪ y) ∪ z ∪  w
-                                              ≅⟨ i ⟩≅ (x ∪ z) ∪ y ∪ w
-        union-swap24 {_} {x} {y} {z} {w} = begin
-              (x ∪ y) ∪ z ∪ w
-           ≈⟨ union-assoc x ⟩
-               x ∪ y ∪ z ∪ w
-           ≈⟨ union-congr (≅sym ( union-assoc y)) ⟩
-              x ∪ ((y ∪ z) ∪ w)
-           ≈⟨ ≅sym ( union-assoc x ) ⟩
-              (x ∪ ( y ∪ z)) ∪ w
-           ≈⟨ union-congl (union-congr (union-comm y z )) ⟩
-              ( x ∪ (z ∪ y)) ∪ w
-           ≈⟨  union-congl (≅sym ( union-assoc x )) ⟩
-              ((x ∪ z) ∪ y) ∪ w
-           ≈⟨ union-assoc (x ∪ z) ⟩
-              (x ∪ z) ∪ y ∪ w
-           ∎
-               where open EqR (Bis _)
-
-        concat-union-distribr : ∀{i} (k {l m} : Lang ∞) → k · ( l ∪ m ) ≅⟨ i ⟩≅ ( k · l ) ∪ ( k · m )
-        ≅ν (concat-union-distribr k) =  ∧-distribˡ-∨ (ν k) _ _ 
-        ≅δ (concat-union-distribr k) a with ν k
-        ≅δ (concat-union-distribr k {l} {m}) a | true = begin
-              δ k a · (l ∪ m) ∪ (δ l a ∪ δ m a)
-           ≈⟨ union-congl (concat-union-distribr _) ⟩
-              (δ k a · l ∪ δ k a · m) ∪ (δ l a ∪ δ m a)
-           ≈⟨ union-swap24 ⟩
-              (δ k a · l ∪ δ l a) ∪ (δ k a · m ∪ δ m a)
-           ∎
-               where open EqR (Bis _)
-        ≅δ (concat-union-distribr k) a | false = concat-union-distribr (δ k a)
-
-        concat-union-distribl : ∀{i} (k {l m} : Lang ∞) → ( k ∪ l ) · m ≅⟨ i ⟩≅ ( k · m ) ∪ ( l · m )
-        ≅ν (concat-union-distribl k {l} {m}) = ∧-distribʳ-∨ _ (ν k) _ 
-        ≅δ (concat-union-distribl k {l} {m}) a with ν k |  ν l 
-        ≅δ (concat-union-distribl k {l} {m}) a | false | false = concat-union-distribl (δ k a)
-        ≅δ (concat-union-distribl k {l} {m}) a | false | true = begin
-              (if false ∨ true then (δ k a ∪ δ l a) · m ∪ δ m a else (δ k a ∪ δ l a) · m)
-           ≈⟨ ≅refl ⟩
-              ((δ k a ∪ δ l a) · m ) ∪ δ m a
-           ≈⟨ union-congl (concat-union-distribl _) ⟩
-               (δ k a · m ∪ δ l a · m) ∪ δ m a
-           ≈⟨ union-assoc _ ⟩
-              (δ k a · m) ∪ ( δ l a · m ∪ δ m a )
-           ≈⟨ ≅refl ⟩
-              (if false then δ k a · m ∪ δ m a else δ k a · m) ∪ (if true then δ l a · m ∪ δ m a else δ l a · m)
-           ∎
-               where open EqR (Bis _)
-        ≅δ (concat-union-distribl k {l} {m}) a | true | false = begin
-               (if true ∨ false then (δ k a ∪ δ l a) · m ∪ δ m a else (δ k a ∪ δ l a) · m) ≈⟨ ≅refl ⟩
-               ((δ k a ∪ δ l a) · m ) ∪ δ m a ≈⟨ union-congl (concat-union-distribl _) ⟩
-               (δ k a · m ∪ δ l a · m) ∪ δ m a ≈⟨  union-assoc _ ⟩
-                δ k a · m ∪ ( δ l a · m ∪ δ m a ) ≈⟨  union-congr ( union-comm   _ _) ⟩
-                δ k a · m ∪ δ m a ∪ δ l a · m ≈⟨ ≅sym ( union-assoc  _  ) ⟩
-               (δ k a · m ∪ δ m a) ∪ δ l a · m ≈⟨ ≅refl ⟩
-               ((if true then δ k a · m ∪ δ m a else δ k a · m) ∪ (if false then δ l a · m ∪ δ m a else δ l a · m))
-           ∎
-               where open EqR (Bis _)
-        ≅δ (concat-union-distribl k {l} {m}) a | true | true = begin
-               (if true ∨ true then (δ k a ∪ δ l a) · m ∪ δ m a else (δ k a ∪ δ l a) · m) ≈⟨ ≅refl ⟩
-               (δ k a ∪ δ l a) · m ∪ δ m a ≈⟨ union-congl ( concat-union-distribl _ ) ⟩
-               (δ k a · m ∪ δ l a · m) ∪ δ m a ≈⟨  union-assoc _ ⟩
-                δ k a · m ∪ ( δ l a · m ∪ δ m a ) ≈⟨ ≅sym ( union-congr ( union-congr (  union-idem _ ) ) ) ⟩
-                δ k a · m ∪ ( δ l a · m ∪ (δ m a  ∪ δ m a) ) ≈⟨  ≅sym ( union-congr ( union-assoc _ )) ⟩
-                δ k a · m ∪ ( (δ l a · m ∪ δ m a  ) ∪ δ m a ) ≈⟨   union-congr (  union-congl  ( union-comm _  _) )   ⟩
-                δ k a · m ∪ ( (δ m a  ∪ δ l a · m ) ∪ δ m a ) ≈⟨  ≅sym ( union-assoc  _  ) ⟩
-               ( δ k a · m ∪  (δ m a  ∪ δ l a · m )) ∪ δ m a ≈⟨  ≅sym ( union-congl ( union-assoc _  ) ) ⟩
-               ((δ k a · m ∪ δ m a) ∪ δ l a · m) ∪ δ m a ≈⟨  union-assoc _  ⟩
-               (δ k a · m ∪ δ m a) ∪ δ l a · m ∪ δ m a ≈⟨ ≅refl ⟩
-               ((if true then δ k a · m ∪ δ m a else δ k a · m) ∪ (if true then δ l a · m ∪ δ m a else δ l a · m))
-           ∎
-               where open EqR (Bis _)
-
-        postulate
-                concat-emptyl : ∀{i} l → ∅ · l ≅⟨ i ⟩≅ ∅
-                concat-emptyr : ∀{i} l → l · ∅ ≅⟨ i ⟩≅ ∅
-                concat-unitl : ∀{i} l → ε · l ≅⟨ i ⟩≅ l
-                concat-unitr : ∀{i} l → l · ε ≅⟨ i ⟩≅ l
-                star-empty : ∀{i} → ∅ * ≅⟨ i ⟩≅ ε
-
-        concat-congl : ∀{i} {m l k : Lang ∞} → l ≅⟨ i ⟩≅ k → l · m ≅⟨ i ⟩≅ k · m
-        ≅ν (concat-congl {i} {m} p ) =  cong (λ x →  x ∧  ( ν m ))  ( ≅ν p )
-        ≅δ (concat-congl {i} {m} {l} {k} p ) a with ν k | ν l | ≅ν p
-        ≅δ (concat-congl {i} {m} {l} {k} p) a | false | false | refl = concat-congl (≅δ p a)
-        ≅δ (concat-congl {i} {m} {l} {k} p) a | true | true | refl = union-congl (concat-congl (≅δ p a)) 
-
-        concat-congr : ∀{i} {m l k : Lang ∞} → l ≅⟨ i ⟩≅ k → m · l ≅⟨ i ⟩≅ m · k
-        ≅ν (concat-congr {i} {m} {_} {k} p ) =  cong (λ x →  ( ν m ) ∧ x )  ( ≅ν p )
-        ≅δ (concat-congr {i} {m} {l} {k} p ) a with ν m | ν k | ν l | ≅ν p
-        ≅δ (concat-congr {i} {m} {l} {k} p) a | false | x | .x | refl = concat-congr p
-        ≅δ (concat-congr {i} {m} {l} {k} p) a | true | x | .x | refl = union-cong (concat-congr p ) ( ≅δ p a )
-
-        concat-assoc : ∀{i} (k {l m} : Lang ∞) → (k · l) · m ≅⟨ i ⟩≅ k · (l · m)
-        ≅ν (concat-assoc {i} k {l} {m} ) =  ∧-assoc ( ν k ) ( ν l ) ( ν m )
-        ≅δ (concat-assoc {i} k {l} {m} ) a with  ν k 
-        ≅δ (concat-assoc {i} k {l} {m}) a | false  = concat-assoc _
-        ≅δ (concat-assoc {i} k {l} {m}) a | true  with ν l
-        ≅δ (concat-assoc {i} k {l} {m}) a | true | false =  begin
-             ( if false then (δ k a · l ∪ δ l a) · m ∪ δ m a else (δ k a · l ∪ δ l a) · m )
-          ≈⟨ ≅refl  ⟩
-            (δ k a · l ∪ δ l a) · m
-          ≈⟨ concat-union-distribl _ ⟩
-            ((δ k a · l) · m ) ∪ ( δ l a · m )
-          ≈⟨ union-congl (concat-assoc _) ⟩
-             (δ k a · l · m ) ∪ ( δ l a · m )
-          ≈⟨ ≅refl  ⟩
-             δ k a · l · m ∪ (if false then δ l a · m ∪ δ m a else δ l a · m)
-           ∎ where open EqR (Bis _)
-        ≅δ (concat-assoc {i} k {l} {m}) a | true | true = begin
-             (if true then (δ k a · l ∪ δ l a) · m ∪ δ m a else (δ k a · l ∪ δ l a) · m)
-          ≈⟨ ≅refl  ⟩
-             ((( δ k a · l ) ∪ δ l a) · m ) ∪ δ m a
-          ≈⟨ union-congl (concat-union-distribl _   ) ⟩
-             ((δ k a · l) · m   ∪ ( δ l a · m )) ∪ δ m a
-          ≈⟨  union-congl (  union-congl (concat-assoc _))   ⟩
-             (( δ k a · l · m ) ∪ ( δ l a · m )) ∪ δ m a 
-          ≈⟨ union-assoc _ ⟩
-             ( δ k a · l · m ) ∪ ( ( δ l a · m ) ∪ δ m a )
-          ≈⟨ ≅refl  ⟩
-             δ k a · l · m ∪ (if true then δ l a · m ∪ δ m a else δ l a · m)
-           ∎ where open EqR (Bis _)
-
-        star-concat-idem : ∀{i} (l : Lang ∞) → l * · l * ≅⟨ i ⟩≅ l *
-        ≅ν (star-concat-idem l) = refl
-        ≅δ (star-concat-idem l) a = begin
-               δ ((l *) · (l *)) a ≈⟨ union-congl (concat-assoc _) ⟩
-               δ l a · (l * · l *) ∪ δ l a · l * ≈⟨ union-congl (concat-congr (star-concat-idem _)) ⟩
-               δ l a · l * ∪ δ l a · l * ≈⟨ union-idem _ ⟩
-               δ (l *) a ∎ where open EqR (Bis _)
-
-        star-idem : ∀{i} (l : Lang ∞) → (l *) * ≅⟨ i ⟩≅ l *
-        ≅ν (star-idem l) = refl
-        ≅δ (star-idem l) a = begin
-                  δ ((l *) *) a  ≈⟨ concat-assoc (δ l a)  ⟩
-                  δ l a · ((l *) · ((l *) *)) ≈⟨ concat-congr ( concat-congr (star-idem l )) ⟩
-                  δ l a · ((l *) · (l *)) ≈⟨  concat-congr (star-concat-idem l ) ⟩
-                  δ l a · l *
-                ∎ where open EqR (Bis _)
-
-        postulate
-           star-rec : ∀{i} (l : Lang ∞) → l * ≅⟨ i ⟩≅ ε ∪ (l · l *)
-
-        star-from-rec : ∀{i} (k {l m} : Lang ∞)
-                → ν k ≡ false
-                → l ≅⟨ i ⟩≅ k · l ∪ m
-                → l ≅⟨ i ⟩≅ k * · m
-        ≅ν (star-from-rec k n p) with ≅ν p
-        ... | b rewrite n = b
-        ≅δ (star-from-rec k {l} {m} n p) a with ≅δ p a
-        ... | q rewrite n = begin
-                   (δ l a)
-                ≈⟨ q ⟩
-                   δ k a · l ∪ δ m a
-                ≈⟨ union-congl (concat-congr (star-from-rec k {l} {m} n p))  ⟩
-                   (δ k a · (k * · m) ∪ δ m a)
-                ≈⟨ union-congl (≅sym (concat-assoc _)) ⟩
-                    (δ k a · (k *)) · m ∪ δ m a
-                ∎ where open EqR (Bis _)
-
-
-open List
-
-record DA (S : Set) : Set where
-    field ν : (s : S) → Bool
-          δ : (s : S)(a : A) → S
-    νs : ∀{i} (ss : List.List i S) → Bool
-    νs ss = List.any ν ss
-    δs : ∀{i} (ss : List.List i S) (a : A) → List.List i S
-    δs ss a = List.map (λ s → δ s a) ss
-
-open Lang 
-
-lang : ∀{i} {S} (da : DA S) (s : S) → Lang i
-Lang.ν (lang da s) = DA.ν da s
-Lang.δ (lang da s) a = lang da (DA.δ da s a)
-
-open import Data.Unit hiding ( _≟_ )
-
-open DA
-
-∅A : DA ⊤
-ν ∅A s = false
-δ ∅A s a = s
-
-εA : DA Bool
-ν εA b  = b
-δ εA b a = false
-
-open import Relation.Nullary.Decidable
-
-data 3States : Set where
-   init acc err : 3States
-
-charA : (a : A) → DA 3States
-ν (charA a) init = false
-ν (charA a) acc = true
-ν (charA a) err = false
-δ (charA a) init x =
-  if ⌊ a ≟  x ⌋ then acc else err
-δ (charA a) acc x = err
-δ (charA a) err x = err
-
-
-complA : ∀{S} (da : DA S) → DA S
-ν (complA da) s = not (ν da s)
-δ (complA da) s a = δ da s a
-
-open import Data.Product
-
-_⊕_ : ∀{S1 S2} (da1 : DA S1) (da2 : DA S2) → DA (S1 × S2)
-ν (da1 ⊕ da2) (s1 , s2) = ν da1 s1 ∨ ν da2 s2
-δ (da1 ⊕ da2) (s1 , s2) a = δ da1 s1 a , δ da2 s2 a
-
-powA : ∀{S} (da : DA S) → DA (List ∞ S)
-ν (powA da) ss = νs da ss
-δ (powA da) ss a = δs da ss a
-
-open _≅⟨_⟩≅_ 
-
-powA-nil : ∀{i S} (da : DA S) → lang (powA da) [] ≅⟨ i ⟩≅ ∅
-≅ν (powA-nil da) = refl
-≅δ (powA-nil da) a = powA-nil da
-
-powA-cons : ∀{i S} (da : DA S) {s : S} {ss : List ∞ S} →
-        lang (powA da) (s ∷ ss) ≅⟨ i ⟩≅ lang da s ∪ lang (powA da) ss
-≅ν (powA-cons da) = refl
-≅δ (powA-cons da) a = powA-cons da
-
-composeA : ∀{S1 S2} (da1 : DA S1)(s2 : S2)(da2 : DA S2) → DA (S1 × List ∞ S2)
-ν (composeA da1 s2 da2) (s1 , ss2) = (ν da1 s1 ∧ ν da2 s2) ∨ νs da2 ss2
-δ (composeA da1 s2 da2) (s1 , ss2) a =
-        δ da1 s1 a , δs da2 (if ν da1 s1 then s2 ∷ ss2 else ss2) a
-
-import Relation.Binary.EqReasoning as EqR
-
-composeA-gen : ∀{i S1 S2} (da1 : DA S1) (da2 : DA S2) → ∀(s1 : S1)(s2 : S2)(ss : List ∞ S2) →
-        lang (composeA da1 s2 da2) (s1 , ss) ≅⟨ i ⟩≅ lang da1 s1 · lang da2 s2 ∪ lang (powA da2) ss
-≅ν (composeA-gen da1 da2 s1 s2 ss) = refl
-≅δ (composeA-gen da1 da2 s1 s2 ss) a with ν da1 s1
-... | false = composeA-gen da1 da2 (δ da1 s1 a) s2 (δs da2 ss a)
-... | true = begin
-       lang (composeA da1 s2 da2) (δ da1 s1 a , δ da2 s2 a ∷ δs da2 ss a)
-   ≈⟨ composeA-gen da1 da2 (δ da1 s1 a) s2 (δs da2 (s2 ∷ ss) a) ⟩
-       lang da1 (δ da1 s1 a) · lang da2 s2 ∪ lang (powA da2) (δs da2 (s2 ∷ ss) a)
-   ≈⟨ union-congr (powA-cons da2)  ⟩ 
-       lang da1 (δ da1 s1 a) · lang da2 s2 ∪
-          (lang da2 (δ da2 s2 a) ∪ lang (powA da2) (δs da2 ss a))
-   ≈⟨ ≅sym  (union-assoc _)  ⟩
-       (lang da1 (δ da1 s1 a) · lang da2 s2 ∪ lang da2 (δ da2 s2 a)) ∪ lang (powA da2) (δs da2 ss a)
-   ∎ where open EqR (Bis _)
-
-postulate
-  composeA-correct : ∀{i S1 S2} (da1 : DA S1) (da2 : DA S2) s1 s2 →
-     lang (composeA da1 s2 da2) (s1 , []) ≅⟨ i ⟩≅ lang da1 s1 · lang da2 s2
-
-
-open import Data.Maybe
-
-acceptingInitial : ∀{S} (s0 : S) (da : DA S) → DA (Maybe S)
-ν (acceptingInitial s0 da) (just s) = ν da s
-δ (acceptingInitial s0 da) (just s) a = just (δ da s a)
-ν (acceptingInitial s0 da) nothing = true
-δ (acceptingInitial s0 da) nothing a = just (δ da s0 a)
-
-
-
-finalToInitial : ∀{S} (da : DA (Maybe S)) → DA (List ∞ (Maybe S))
-ν (finalToInitial da) ss = νs da ss
-δ (finalToInitial da) ss a =
-        let ss′ = δs da ss a
-        in if νs da ss then δ da nothing a ∷ ss′ else ss′
-
-
-starA : ∀{S}(s0 : S)(da : DA S) → DA (List ∞(Maybe S))
-starA s0 da = finalToInitial (acceptingInitial s0 da)
-
-
-postulate
- acceptingInitial-just : ∀{i S} (s0 : S) (da : DA S) {s : S} →
-   lang (acceptingInitial s0 da) (just s) ≅⟨ i ⟩≅ lang da s
- acceptingInitial-nothing : ∀{i S} (s0 : S) (da : DA S) →
-        lang (acceptingInitial s0 da) nothing ≅⟨ i ⟩≅ ε ∪ lang da s0
- starA-lemma : ∀{i S}(da : DA S)(s0 : S)(ss : List ∞ (Maybe S))→
-        lang (starA s0 da) ss ≅⟨ i ⟩≅ 
-                lang (powA (acceptingInitial s0 da)) ss · (lang da s0) *
- starA-correct : ∀{i S} (da : DA S) (s0 : S) →
-   lang (starA s0 da) (nothing ∷ []) ≅⟨ i ⟩≅ (lang da s0) *
-
-record NAutomaton ( Q : Set ) ( Σ : Set  )
-           : Set  where
-        field
-              Nδ : Q → Σ → Q → Bool
-              Nstart : Q → Bool
-              Nend  :  Q → Bool
-
-postulate
-   exists : { S : Set} → ( S → Bool ) → Bool
-
-nlang : ∀{i} {S} (nfa : NAutomaton S A ) (s : S → Bool ) → Lang i
-Lang.ν (nlang nfa s) = exists ( λ x → (s x ∧ NAutomaton.Nend nfa x ))
-Lang.δ (nlang nfa s) a = nlang nfa (λ x → s x ∧ (NAutomaton.Nδ nfa x a) x) 
-
-nlang1 : ∀{i} {S} (nfa : NAutomaton S A ) (s : S → Bool ) → Lang i
-Lang.ν (nlang1 nfa s) = NAutomaton.Nend nfa  {!!}
-Lang.δ (nlang1 nfa s) a = nlang1 nfa (λ x → s x ∧ (NAutomaton.Nδ nfa x a) x) 
-
--- nlang' : ∀{i} {S} (nfa : DA (S → Bool) ) (s : S → Bool ) → Lang i
--- Lang.ν (nlang' nfa s) = DA.ν nfa  s
--- Lang.δ (nlang' nfa s) a = nlang' nfa (DA.δ nfa s a)
-
--- a/automaton-in-agda/src/agda/gcd.agda	Sun Jun 13 18:48:57 2021 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,217 +0,0 @@
-{-# OPTIONS --allow-unsolved-metas #-}
-module gcd 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
-
-record Factor (n m : ℕ ) : Set where
-   field 
-      factor : ℕ
-      remain : ℕ
-      is-factor : factor * n + remain ≡ m
-
-record Dividable (n m : ℕ ) : Set where
-   field 
-      factor : ℕ
-      is-factor : factor * n + 0 ≡ m 
-
-open Factor
-
-open ≡-Reasoning
-
-decf : { n k : ℕ } → ( x : Factor k (suc n) ) → Factor k n
-decf {n} {k} x with remain x
-... | zero = record { factor = factor x ; remain = k ; is-factor = {!!} }
-... | suc r = record { factor = factor x ; remain = r ; is-factor = {!!} }
-
-ifk0 : (  i0 k : ℕ ) → (i0f : Factor k i0 )  → ( i0=0 : remain i0f ≡ 0 )  → factor i0f * k + 0 ≡ i0
-ifk0 i0 k i0f i0=0 = begin
-   factor i0f * k + 0  ≡⟨ cong (λ m → factor i0f * k + m) (sym i0=0)  ⟩
-   factor i0f * k + remain i0f  ≡⟨ is-factor i0f ⟩
-   i0 ∎ 
-
-ifzero : {k : ℕ } → (jf :  Factor k zero ) →  remain jf ≡ 0
-ifzero = {!!}
-
-gcd1 : ( i i0 j j0 : ℕ ) → ℕ
-gcd1 zero i0 zero j0 with <-cmp i0 j0
-... | tri< a ¬b ¬c = i0
-... | tri≈ ¬a refl ¬c = i0
-... | tri> ¬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<sa
-gcd52 {suc i} = <-trans (gcd52 {i}) a<sa
-
-gcd50 : (i i0 j j0 : ℕ) → 1 < i0 → i ≤ i0 → j ≤ j0 →  gcd1 i i0 j j0 ≤ i0 
-gcd50 zero i0 zero j0 0<i i<i0 j<j0 with <-cmp i0 j0
-... | tri< a ¬b ¬c = ≤-refl    
-... | tri≈ ¬a refl ¬c =  ≤-refl 
-... | tri> ¬a ¬b c = ≤-trans refl-≤s c  
-gcd50 zero (suc i0) (suc zero) j0 0<i i<i0 j<j0 = gcd51 0<i where 
-   gcd51 : 1 < suc i0 → gcd1 zero (suc i0) 1 j0 ≤ suc i0
-   gcd51 1<i = ≤to< 1<i
-gcd50 zero (suc i0) (suc (suc j)) j0 0<i i<i0 j<j0 = gcd50 i0 (suc i0) (suc j) (suc (suc j)) 0<i refl-≤s refl-≤s
-gcd50 (suc zero) i0 zero j0 0<i i<i0 j<j0 = ≤to< 0<i
-gcd50 (suc (suc i)) i0 zero zero 0<i i<i0 j<j0 = ≤-refl
-gcd50 (suc (suc i)) i0 zero (suc j0) 0<i i<i0 j<j0 = ≤-trans (gcd50 (suc i) (suc (suc i))  j0 (suc j0) gcd52  refl-≤s refl-≤s) i<i0
-gcd50 (suc i) i0 (suc j) j0 0<i i<i0 j<j0 = subst (λ k → k ≤ i0 ) (sym (gcd22 i i0 j j0))
-   (gcd50 i i0 j j0 0<i (≤-trans refl-≤s i<i0) (≤-trans refl-≤s j<j0)) 
-
-gcd5 : ( n k : ℕ ) → 1 < n → gcd n k ≤ n
-gcd5 n k 0<n = gcd50 n n k k 0<n ≤-refl ≤-refl 
-
-gcd6 : ( n k : ℕ ) → 1 < n → gcd k n ≤ n
-gcd6 n k 1<n = subst (λ m → m ≤ n) (gcdsym {n} {k}) (gcd5 n k 1<n)
-
-gcd4 : ( n k : ℕ ) → 1 < n  → gcd n k ≡ k → k ≤ n
-gcd4 n k 1<n eq = subst (λ m → m ≤ n ) eq (gcd5 n k 1<n)
-
-gcdmul+1 : ( m n : ℕ ) → gcd (m * n + 1) n ≡ 1
-gcdmul+1 zero n = gcd204 n
-gcdmul+1 (suc m) n = begin
-      gcd (suc m * n + 1) n ≡⟨⟩
-      gcd (n + m * n + 1) n ≡⟨ cong (λ k → gcd k n ) (begin
-         n + m * n + 1 ≡⟨ cong (λ k → k + 1) (+-comm n _) ⟩
-         m * n + n + 1 ≡⟨ +-assoc (m * n) _ _ ⟩
-         m * n + (n + 1)  ≡⟨ cong (λ k → m * n + k) (+-comm n _) ⟩
-         m * n + (1 + n)  ≡⟨ sym ( +-assoc (m * n) _ _ ) ⟩
-         m * n + 1 + n ∎ 
-       ) ⟩
-      gcd (m * n + 1 + n) n ≡⟨ gcd2 (m * n + 1) n ⟩
-      gcd (m * n + 1) n ≡⟨ gcdmul+1 m n ⟩
-      1 ∎ where open ≡-Reasoning
-
--- a/automaton-in-agda/src/agda/halt.agda	Sun Jun 13 18:48:57 2021 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,114 +0,0 @@
-module halt 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 HBijection {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 
---  normal bijection required below, but we don't need this to show the inconsistency
---     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 HBijection 
-
-diag : {S : Set }  (b : HBijection  ( S → Bool ) S) → S → Bool
-diag b n = not (fun← b n n)
-
-diagonal : { S : Set } → ¬ HBijection  ( 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
-
-record TM : Set where
-   field
-      tm : List Bool → Maybe Bool
-
-open TM
-
-record UTM : Set where
-   field
-      utm : TM
-      encode : TM → List Bool
-      is-tm : (t : TM) → (x : List Bool) → tm utm (encode t ++ x ) ≡ tm t x
-
-open UTM 
-
-open _∧_
-
-open import Axiom.Extensionality.Propositional
-postulate f-extensionality : { n : Level}  → Axiom.Extensionality.Propositional.Extensionality n n 
-
-record Halt : Set where
-   field
-      halt :  (t : TM ) → (x : List Bool ) → Bool
-      is-halt :     (t : TM ) → (x : List Bool ) → (halt t x ≡ true )  ⇔ ( (just true ≡ tm t x ) ∨ (just false ≡ tm t x ) )
-      is-not-halt : (t : TM ) → (x : List Bool ) → (halt t x ≡ false ) ⇔ ( nothing ≡ tm t x )
-
-open Halt
-
-TNL : (halt : Halt ) → (utm : UTM) → HBijection (List Bool → Bool) (List Bool)
-TNL halt utm = record {
-       fun←  = λ tm x → Halt.halt halt (UTM.utm utm) (tm ++ x)
-     ; fun→  = λ h  → encode utm record { tm = h1 h } 
-     ; fiso← = λ h →  f-extensionality (λ y → TN1 h y )
-  } where
-     open ≡-Reasoning
-     h1 : (h : List Bool → Bool) → (x : List Bool ) → Maybe Bool
-     h1 h x with h x
-     ... | true =  just true
-     ... | false = nothing
-     tenc : (h : List Bool → Bool) → (y : List Bool) → List Bool
-     tenc h y = encode utm (record { tm = λ x → h1 h x }) ++ y
-     h-nothing : (h : List Bool → Bool) → (y : List Bool) → h y ≡ false → h1 h y ≡ nothing
-     h-nothing h y eq with h y
-     h-nothing h y refl | false = refl
-     h-just : (h : List Bool → Bool) → (y : List Bool) → h y ≡ true → h1 h y ≡ just true
-     h-just h y eq with h y
-     h-just h y refl | true = refl
-     TN1 :  (h : List Bool → Bool) → (y : List Bool ) → Halt.halt halt (UTM.utm utm) (tenc h y) ≡ h y
-     TN1 h y with h y | inspect h y
-     ... | true  | record { eq = eq1 } = begin
-        Halt.halt halt (UTM.utm utm)  (tenc h y) ≡⟨ proj2 (is-halt halt (UTM.utm utm) (tenc h y) ) (case1 (sym tm-tenc)) ⟩
-        true ∎  where
-          tm-tenc :  tm (UTM.utm utm) (tenc h y) ≡ just true
-          tm-tenc = begin
-              tm (UTM.utm utm) (tenc h y)  ≡⟨  is-tm utm _ y ⟩
-              h1 h y ≡⟨ h-just h y eq1  ⟩
-              just true  ∎  
-     ... | false | record { eq = eq1 } = begin
-        Halt.halt halt (UTM.utm utm)  (tenc h y) ≡⟨ proj2 (is-not-halt halt (UTM.utm utm) (tenc h y) ) (sym tm-tenc) ⟩
-        false ∎  where
-          tm-tenc :  tm (UTM.utm utm) (tenc h y) ≡ nothing
-          tm-tenc = begin
-              tm (UTM.utm utm) (tenc h y)  ≡⟨  is-tm utm _ y ⟩
-              h1 h y ≡⟨  h-nothing h y eq1 ⟩
-              nothing  ∎  
-     -- the rest of bijection means encoding is unique
-     -- fiso→ :  (y : List Bool ) → encode utm record { tm = λ x →  h1 (λ tm → Halt.halt halt (UTM.utm utm) tm  ) x } ≡ y
-          
--- a/automaton-in-agda/src/agda/index.ind	Sun Jun 13 18:48:57 2021 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,31 +0,0 @@
---title: list
-<a href=FSetUtil.agda> FSetUtil.agda </a><br>
-<a href=automaton-ex.agda> automaton-ex.agda </a><br>
-<a href=automaton.agda> automaton.agda </a><br>
-<a href=cfg.agda> cfg.agda </a><br>
-<a href=cfg1.agda> cfg1.agda </a><br>
-<a href=chap0.agda> chap0.agda </a><br>
-<a href=derive.agda> derive.agda </a><br>
-<a href=even.agda> even.agda </a><br>
-<a href=finiteSet.agda> finiteSet.agda </a><br>
-<a href=flcagl.agda> flcagl.agda </a><br>
-<a href=gcd.agda> gcd.agda </a><br>
-<a href=halt.agda> halt.agda </a><br>
-<a href=induction-ex.agda> induction-ex.agda </a><br>
-<a href=lang-text.agda> lang-text.agda </a><br>
-<a href=logic.agda> logic.agda </a><br>
-<a href=nat.agda> nat.agda </a><br>
-<a href=nfa.agda> nfa.agda </a><br>
-<a href=nfa136.agda> nfa136.agda </a><br>
-<a href=non-regular.agda> non-regular.agda </a><br>
-<a href=omega-automaton.agda> omega-automaton.agda </a><br>
-<a href=pushdown.agda> pushdown.agda </a><br>
-<a href=puzzle.agda> puzzle.agda </a><br>
-<a href=regex.agda> regex.agda </a><br>
-<a href=regex1.agda> regex1.agda </a><br>
-<a href=regular-concat.agda> regular-concat.agda </a><br>
-<a href=regular-language.agda> regular-language.agda </a><br>
-<a href=root2.agda> root2.agda </a><br>
-<a href=sbconst2.agda> sbconst2.agda </a><br>
-<a href=turing.agda> turing.agda </a><br>
-<a href=utm.agda> utm.agda </a><br>
--- 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
-
--- 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 = {!!}
--- 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
-
-
--- 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 ∷ [] ) 
-
--- 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)
--- 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 = {!!}
-
--- 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 = {!!}
-
-
-
-
-
-
-
--- 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 → ⊥-elim (nat-≤>  n≤j j<n ) ) where
-    np1 : ( m : ℕ ) → ( (j : ℕ ) → m ≤ j → j < n → gcd n j ≡ 1  ) → NonPrime n
-    np1 zero mg = ⊥-elim ( np record { isPrime = λ j lt → mg j z≤n lt } ) -- zero < j , j < n
-    np1 (suc m) mg with <-cmp ( gcd n (suc m) ) 1
-    ... | tri< a ¬b ¬c = {!!}
-    ... | tri≈ ¬a b ¬c = np1 m {!!}
-    ... | tri> ¬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 = {!!}
--- 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 = {!!}
--- 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
--- 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 _&_ _||_
-
-
-
--- 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 ∷ [])
-
--- 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
-
-
-
-
--- 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))
-
--- 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<sa lt 
-    rot1 : even ( m * m )
-    rot1 = subst (λ k → even k ) rot4 (n*even {n * n} {2} tt ) where
-       rot4 : (n * n) * 2 ≡ m * m  
-       rot4 = begin
-          (n * n) * 2     ≡⟨ *-comm (n * n) 2 ⟩
-          2 * ( n * n )   ≡⟨ sym (*-assoc 2 n n) ⟩
-          2 *  n * n      ≡⟨ 2nm ⟩
-          m * m           ∎ where open ≡-Reasoning
-    E : Even m
-    E = e2 m ( even^2 {m} ( rot1 ))
-    rot2 : 2 * n * n ≡ 2 * Even.j E * m
-    rot2 = subst (λ k → 2 * n * n ≡ k * m ) (Even.is-twice E) 2nm
-    rot3 : n * n ≡ Even.j E * m
-    rot3 = e3 ( begin
-          2 * (n * n)   ≡⟨ sym (*-assoc 2 n _) ⟩
-          2 *  n * n    ≡⟨ rot2 ⟩
-          2 * Even.j E * m ≡⟨  *-assoc 2 (Even.j E)  m  ⟩
-          2 * (Even.j E * m)  ∎ ) where open ≡-Reasoning
-    rot7 : even n  
-    rot7 =  even^2 {n} (subst (λ k → even k) (sym rot3) ((n*even {Even.j E} {m} ( even^2 {m} ( rot1 )))))
-    f2 : Factor 2 n
-    f2 = rot11 rot7
-    fm : Factor 2 m
-    fm = record { factor = Even.j E ; remain = 0 ; is-factor = {!!} }
-
--- a/automaton-in-agda/src/agda/sbconst2.agda	Sun Jun 13 18:48:57 2021 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,55 +0,0 @@
-module sbconst2 where
-
-open import Level renaming ( suc to succ ; zero to Zero )
-open import Data.Nat
-open import Data.Fin
-open import Data.List
-
-open import automaton
-open import nfa
-open import logic
-open NAutomaton
-open Automaton
-open import  Relation.Binary.PropositionalEquality hiding ( [_] )
-
-open Bool
-
-δconv : { Q : Set } { Σ : Set  } → ( ( Q → Bool ) → Bool ) →  ( nδ : Q → Σ → Q → Bool ) → (f : Q → Bool) → (i : Σ) → (Q → Bool)
-δconv {Q} { Σ} exists nδ f i q =  exists ( λ r → f r /\ nδ r i q )
-
-subset-construction : { Q : Set } { Σ : Set  } → 
-    ( ( Q → Bool ) → Bool ) →
-    (NAutomaton Q  Σ ) → (Automaton (Q → Bool)  Σ )  
-subset-construction {Q} { Σ}  exists NFA = record {
-        δ = λ q x → δconv exists ( Nδ NFA ) q x
-     ;  aend = λ f → exists ( λ q → f q /\ Nend NFA q )
-   } 
-
-test4 = subset-construction existsS1 am2 
-
-test51 = accept test4 start1 ( i0  ∷ i1  ∷ i0  ∷ [] )
-test61 = accept test4 start1 ( i1  ∷ i1  ∷ i1  ∷ [] )
-
-subset-construction-lemma→ : { Q : Set } { Σ : Set  } { n  : ℕ }  → (exists : ( Q → Bool ) → Bool ) →
-    (NFA : NAutomaton Q  Σ ) → (astart : Q → Bool ) 
-    → (x : List Σ)
-    → Naccept NFA exists astart  x ≡ true
-    → accept (  subset-construction exists NFA ) astart  x ≡ true
-subset-construction-lemma→ {Q} {Σ} {n} exists NFA astart x naccept = lemma1 x astart naccept where
-    lemma1 :  (x : List Σ) → ( states : Q → Bool )
-       → Naccept NFA exists states x ≡ true
-       → accept (  subset-construction exists NFA ) states x ≡ true
-    lemma1 [] states naccept = naccept
-    lemma1 (h ∷ t ) states naccept = lemma1 t (δconv exists (Nδ NFA) states h) naccept
-
-subset-construction-lemma← : { Q : Set } { Σ : Set  } { n  : ℕ }  → (exists : ( Q → Bool ) → Bool ) →
-    (NFA : NAutomaton Q  Σ ) → (astart : Q → Bool )
-    → (x : List Σ)
-    → accept (  subset-construction exists NFA ) astart x ≡ true
-    → Naccept NFA exists astart x ≡ true
-subset-construction-lemma← {Q} {Σ} {n} exists NFA astart x saccept = lemma2 x astart saccept where
-    lemma2 :  (x : List Σ) → ( states : Q → Bool )
-       → accept (  subset-construction exists NFA ) states x ≡ true
-       → Naccept NFA exists states x ≡ true
-    lemma2 [] states saccept = saccept
-    lemma2 (h ∷ t ) states saccept = lemma2 t (δconv exists (Nδ NFA) states h) saccept
--- a/automaton-in-agda/src/agda/turing.agda	Sun Jun 13 18:48:57 2021 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,129 +0,0 @@
-{-# OPTIONS --allow-unsolved-metas #-}
-module turing where
-
-open import Level renaming ( suc to succ ; zero to Zero )
-open import Data.Nat -- hiding ( erase )
-open import Data.List
-open import Data.Maybe hiding ( map )
-open import Data.Bool using ( Bool ; true ; false ) renaming ( not to negate )
-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 hiding ( map )
-
-
-data Write   (  Σ : Set  ) : Set  where
-   write   : Σ → Write  Σ
-   wnone   : Write  Σ
-   --   erase write tnone
-
-data Move : Set  where
-   left   : Move  
-   right  : Move  
-   mnone  : Move  
-
--- at tδ both stack is poped
-
--- write S      push S  , push SR
--- erase        push SL , push tone 
--- none         push SL , push SR 
--- left         push SR , pop      
--- right        pop     , push SL      
-
-{-# TERMINATING #-}
-move : {Q Σ : Set } → { tnone : Σ} → {tδ : Q →  Σ → Q × ( Write  Σ ) ×  Move } → (q : Q ) ( L : List  Σ ) ( L : List   Σ ) → ( Q × List  Σ × List  Σ )
-move {Q} {Σ} {tnone} {tδ} q L [] = move {Q} {Σ} {tnone} {tδ} q  L  ( tnone  ∷ [] ) 
-move {Q} {Σ} {tnone} {tδ} q [] R = move {Q} {Σ} {tnone} {tδ} q  ( tnone  ∷ [] )  R 
-move {Q} {Σ} {tnone} {tδ} q ( LH  ∷ LT ) ( RH ∷ RT ) with  tδ q LH  
-... | nq , write x , left  = ( nq , ( RH ∷ x  ∷ LT ) , RT )
-... | nq , write x , right = ( nq , LT , ( x  ∷ RH  ∷ RT ) )
-... | nq , write x , mnone = ( nq , ( x  ∷ LT ) , (  RH ∷ RT ) )
-... | nq , wnone , left    = ( nq , ( RH  ∷ LH  ∷ LT ) , RT  )
-... | nq , wnone , right   = ( nq ,  LT , ( LH  ∷ RH  ∷ RT ) )
-... | nq , wnone , mnone   = ( nq , ( LH  ∷ LT ) , (  RH ∷ RT )  )
-{-# TERMINATING #-}
-move-loop : {Q Σ : Set } → {tend :  Q → Bool}  → { tnone : Σ} → {tδ : Q →  Σ → Q × ( Write  Σ ) ×  Move }
-    → (q : Q ) ( L : List  Σ ) ( L : List   Σ ) → ( Q × List  Σ × List  Σ )
-move-loop {Q} {Σ} {tend} {tnone} {tδ}  q L R with tend q
-... | true = ( q , L , R )
-... | flase = move-loop {Q} {Σ} {tend} {tnone} {tδ} ( proj₁ next ) ( proj₁ ( proj₂ next ) )  ( proj₂  ( proj₂ next ) )
-        where
-        next = move {Q} {Σ} {tnone} {tδ} q  L  R 
-
-{-# TERMINATING #-}
-move0 : {Q Σ : Set } ( tend : Q → Bool ) (tnone : Σ ) (tδ : Q →  Σ → Q × ( Write  Σ ) ×  Move)
-   (q : Q ) ( L : List  Σ ) ( L : List   Σ ) → ( Q × List  Σ × List  Σ )
-move0 tend tnone tδ  q L R with tend q
-... | true = ( q , L , R )
-move0 tend tnone tδ  q L [] | false = move0 tend tnone tδ  q  L  ( tnone  ∷ [] ) 
-move0 tend tnone tδ  q [] R | false = move0 tend tnone tδ  q  ( tnone  ∷ [] )  R 
-move0 tend tnone tδ  q ( LH  ∷ LT ) ( RH ∷ RT ) | false with  tδ q LH  
-... | nq , write x , left  = move0 tend tnone tδ  nq ( RH ∷ x  ∷ LT ) RT 
-... | nq , write x , right = move0 tend tnone tδ  nq LT ( x  ∷ RH  ∷ RT ) 
-... | nq , write x , mnone = move0 tend tnone tδ  nq ( x  ∷ LT ) (  RH ∷ RT ) 
-... | nq , wnone , left    = move0 tend tnone tδ  nq ( RH  ∷ LH  ∷ LT ) RT  
-... | nq , wnone , right   = move0 tend tnone tδ  nq  LT ( LH  ∷ RH  ∷ RT ) 
-... | nq , wnone , mnone   = move0 tend tnone tδ  nq ( LH  ∷ LT ) (  RH ∷ RT )  
-
-record Turing ( Q : Set ) ( Σ : Set  ) 
-       : Set  where
-    field
-        tδ : Q →  Σ → Q × ( Write  Σ ) ×  Move 
-        tstart : Q
-        tend : Q → Bool
-        tnone :  Σ
-    taccept : List  Σ → ( Q × List  Σ × List  Σ )
-    taccept L = move0 tend tnone tδ tstart L []
-
-data CopyStates : Set where
-   s1 : CopyStates
-   s2 : CopyStates
-   s3 : CopyStates
-   s4 : CopyStates
-   s5 : CopyStates
-   H  : CopyStates
-
-
-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 
-
-copyMachine : Turing CopyStates ℕ
-copyMachine = record {
-        tδ = Copyδ
-     ;  tstart = s1
-     ;  tend = tend
-     ;  tnone =  0
-  } where
-      tend : CopyStates →  Bool
-      tend H = true
-      tend _ = false
-
-test1 : CopyStates × ( List  ℕ ) × ( List  ℕ )
-test1 = Turing.taccept copyMachine  ( 1  ∷ 1  ∷ 0  ∷ 0  ∷  0 ∷ []  )
-
-test2 : ℕ  → CopyStates × ( List  ℕ ) × ( List  ℕ )
-test2 n  = loop n (Turing.tstart copyMachine) ( 1  ∷ 1  ∷ 0  ∷ 0  ∷  0 ∷ []  ) []
-  where
-        loop :  ℕ → CopyStates → ( List  ℕ ) → ( List  ℕ ) → CopyStates × ( List  ℕ ) × ( List  ℕ )
-        loop zero q L R = ( q , L , R )
-        loop (suc n) q L R = loop n ( proj₁ t1 ) ( proj₁ ( proj₂ t1 ) )  ( proj₂  ( proj₂ t1 ) )
-          where
-              t1 = move {CopyStates} {ℕ} {0} {Copyδ} q L R
-
--- testn = map (\ n -> 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
-
--- 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
-    0 : utmΣ
-    1 : 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  0 = read4 , write 0 , left
-utmδ read3  1 = read5 , write 1 , left
-utmδ read3  b = read6 , write b , left
-utmδ read4  @ = loc0 , write 0 , right
-utmδ read4  x = read4 , write x , left
-utmδ read5  @ = loc0 , write 1 , right
-utmδ read5  x = read5 , write x , left
-utmδ read6  @ = loc0 , write B , right
-utmδ read6  x = read6 , write x , left
-utmδ loc0  0 = loc0 , write X , left
-utmδ loc0  1 = 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 0 , right
-utmδ loc1  Y = loc3 , write 1 , right
-utmδ loc1  Z = loc4 , write B , right
-utmδ loc1  * = fetch0 , write * , right
-utmδ loc1  x = loc1 , write x , right
-utmδ loc2  0 = loc5 , write X , right
-utmδ loc2  1 = loc6 , write Y , right
-utmδ loc2  B = loc6 , write Z , right
-utmδ loc2  x = loc2 , write x , right
-utmδ loc3  1 = loc5 , write Y , right
-utmδ loc3  0 = 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  0 = loc6 , write X , right
-utmδ loc4  1 = 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  0 = fetch1 , write X , left
-utmδ fetch0  1 = 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  0 = fetch7 , write X , right
-utmδ fetch4  1 = 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  0 = fetch7 , write Y , right
-utmδ fetch5  1 = 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  0 = fetch7 , write Z , right
-utmδ fetch6  1 = 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 0 , left
-utmδ print5  x = print7 , write 1 , 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  0 = mov4 , write ^ , right
-utmδ mov2  1 = mov5 , write ^ , right
-utmδ mov2  B = mov6 , write ^ , right
-utmδ mov3  0 = mov4 , write ^ , left
-utmδ mov3  1 = mov5 , write ^ , left
-utmδ mov3  B = mov6 , write ^ , left
-utmδ mov4  ^ = tidy0 , write 0 , left
-utmδ mov5  ^ = tidy0 , write 1 , left
-utmδ mov6  ^ = tidy0 , write B , left
-utmδ tidy0  $ = tidy1 , write $ , left
-utmδ tidy0  x = tidy0 , write x , left
-utmδ tidy1  X = tidy1 , write 0 , left
-utmδ tidy1  Y = tidy1 , write 1 , 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 = 
-       0  ∷ 0  ∷ 1  ∷ 0  ∷  1 ∷ 1 ∷ 0 ∷ 0 ∷ 0 ∷ 0 ∷   -- s1 0  = H    , wnone       , mnone
-  *  ∷ 0  ∷ 0  ∷ 1  ∷ 1  ∷  0 ∷ 1 ∷ 0 ∷ 0 ∷ 0 ∷ 1 ∷   -- s1 1  = s2   , write 0 , right
-  *  ∷ 0  ∷ 1  ∷ 0  ∷ 0  ∷  0 ∷ 1 ∷ 1 ∷ 0 ∷ 0 ∷ 1 ∷   -- s2 0  = s3   , write 0 , right
-  *  ∷ 0  ∷ 1  ∷ 0  ∷ 1  ∷  0 ∷ 1 ∷ 0 ∷ 1 ∷ 0 ∷ 1 ∷   -- s2 1  = s2   , write 1 , right
-  *  ∷ 0  ∷ 1  ∷ 1  ∷ 0  ∷  1 ∷ 0 ∷ 0 ∷ 1 ∷ 0 ∷ 0 ∷   -- s3 0  = s4   , write 1 , left
-  *  ∷ 0  ∷ 1  ∷ 1  ∷ 1  ∷  0 ∷ 1 ∷ 1 ∷ 1 ∷ 0 ∷ 1 ∷   -- s3 1  = s3   , write 1 , right
-  *  ∷ 1  ∷ 0  ∷ 0  ∷ 0  ∷  1 ∷ 0 ∷ 1 ∷ 0 ∷ 0 ∷ 0 ∷   -- s4 0  = s5   , write 0 , left
-  *  ∷ 1  ∷ 0  ∷ 0  ∷ 1  ∷  1 ∷ 0 ∷ 0 ∷ 1 ∷ 0 ∷ 0 ∷   -- s4 1  = s4   , write 1 , left
-  *  ∷ 1  ∷ 0  ∷ 1  ∷ 0  ∷  0 ∷ 0 ∷ 1 ∷ 1 ∷ 0 ∷ 1 ∷   -- s5 0  = s1   , write 1 , right
-  *  ∷ 1  ∷ 0  ∷ 1  ∷ 1  ∷  1 ∷ 0 ∷ 1 ∷ 1 ∷ 0 ∷ 0 ∷   -- s5 1  = s5   , write 1 , left
-  []  
-      
-
-input-encode : List utmΣ
-input-encode =  1  ∷ 1  ∷ 0  ∷ 0  ∷  0 ∷ []  
-
-input+Copyδ : List utmΣ
-input+Copyδ = ( $  ∷ 0  ∷ 0  ∷  0 ∷  0 ∷  * ∷  [] ) -- start state
-        ++   Copyδ-encode
-        ++ ( $ ∷ ^ ∷ input-encode )
-
-short-input : List utmΣ
-short-input = $  ∷ 0  ∷ 0  ∷  0 ∷  * ∷
-    0  ∷ 0  ∷  0 ∷  1  ∷ 0  ∷ 1 ∷ 1  ∷  * ∷
-    0  ∷ 0  ∷  1 ∷  0  ∷ 1  ∷ 1 ∷ 1  ∷  * ∷
-    0  ∷ 1  ∷  B  ∷  1 ∷  0  ∷ 1 ∷ 0  ∷  * ∷
-    1  ∷ 0  ∷  0 ∷  0 ∷  1  ∷ 1 ∷ 1  ∷  $ ∷
-    ^   ∷ 0  ∷  0 ∷  1  ∷ 1 ∷ []  
-
-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Σ} {0} {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
--- /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 ( λ () )
+
--- /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
+
--- /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 ) 
+
+
--- /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  ∷ [] ) 
+
--- /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] ∷ [] )
+
--- /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
+
--- /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
+
--- /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 
+
--- /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ℕ<n
+fin<n : {n : ℕ} {f : Fin n} → toℕ f < n
+fin<n {_} {zero} = s≤s z≤n
+fin<n {suc n} {suc f} = s≤s (fin<n {n} {f})
+
+-- toℕ≤n
+fin≤n : {n : ℕ} (f : Fin (suc n)) → toℕ f ≤ n
+fin≤n {_} zero = z≤n
+fin≤n {suc n} (suc f) = s≤s (fin≤n {n} f)
+
+pred<n : {n : ℕ} {f : Fin (suc n)} → n > 0  → Data.Nat.pred (toℕ f) < n
+pred<n {suc n} {zero} (s≤s z≤n) = s≤s z≤n
+pred<n {suc n} {suc f} (s≤s z≤n) = fin<n
+
+fin<asa : {n : ℕ} → toℕ (fromℕ< {n} a<sa) ≡ n
+fin<asa = toℕ-fromℕ< nat.a<sa
+
+-- fromℕ<-toℕ
+toℕ→from : {n : ℕ} {x : Fin (suc n)} → toℕ x ≡ n → fromℕ n ≡ x
+toℕ→from {0} {zero} refl = refl
+toℕ→from {suc n} {suc x} eq = cong (λ k → suc k ) ( toℕ→from {n} {x} (cong (λ k → Data.Nat.pred k ) eq ))
+
+0≤fmax : {n : ℕ } → (# 0) Data.Fin.≤ fromℕ< {n} a<sa
+0≤fmax  = subst (λ k → 0 ≤ k ) (sym (toℕ-fromℕ< a<sa)) z≤n
+
+0<fmax : {n : ℕ } → (# 0) Data.Fin.< fromℕ< {suc n} a<sa
+0<fmax = subst (λ k → 0 < k ) (sym (toℕ-fromℕ< a<sa)) (s≤s z≤n)
+
+-- toℕ-injective
+i=j : {n : ℕ} (i j : Fin n) → toℕ i ≡ toℕ j → i ≡ j
+i=j {suc n} zero zero refl = refl
+i=j {suc n} (suc i) (suc j) eq = cong ( λ k → suc k ) ( i=j i j (cong ( λ k → Data.Nat.pred k ) eq) )
+
+-- raise 1
+fin+1 :  { n : ℕ } → Fin n → Fin (suc n)
+fin+1  zero = zero 
+fin+1  (suc x) = suc (fin+1 x)
+
+open import Data.Nat.Properties as NatP  hiding ( _≟_ )
+
+fin+1≤ : { i n : ℕ } → (a : i < n)  → fin+1 (fromℕ< a) ≡ fromℕ< (<-trans a a<sa)
+fin+1≤ {0} {suc i} (s≤s z≤n) = refl
+fin+1≤ {suc n} {suc (suc i)} (s≤s (s≤s a)) = cong (λ k → suc k ) ( fin+1≤ {n} {suc i} (s≤s a) )
+
+fin+1-toℕ : { n : ℕ } → { x : Fin n} → toℕ (fin+1 x) ≡ toℕ x
+fin+1-toℕ {suc n} {zero} = refl
+fin+1-toℕ {suc n} {suc x} = cong (λ k → suc k ) (fin+1-toℕ {n} {x})
+
+open import Relation.Nullary 
+open import Data.Empty
+
+fin-1 :  { n : ℕ } → (x : Fin (suc n)) → ¬ (x ≡ zero )  → Fin n
+fin-1 zero ne = ⊥-elim (ne refl )
+fin-1 {n} (suc x) ne = x 
+
+fin-1-sx : { n : ℕ } → (x : Fin n) →  fin-1 (suc x) (λ ()) ≡ x 
+fin-1-sx zero = refl
+fin-1-sx (suc x) = refl
+
+fin-1-xs : { n : ℕ } → (x : Fin (suc n)) → (ne : ¬ (x ≡ zero ))  → suc (fin-1 x ne ) ≡ x
+fin-1-xs zero ne = ⊥-elim ( ne refl )
+fin-1-xs (suc x) ne = refl
+
+-- suc-injective
+-- suc-eq : {n : ℕ } {x y : Fin n} → Fin.suc x ≡ Fin.suc y  → x ≡ y
+-- suc-eq {n} {x} {y} eq = subst₂ (λ j k → j ≡ k ) {!!} {!!} (cong (λ k → Data.Fin.pred k ) eq )
+
+-- this is refl
+lemma3 : {a b : ℕ } → (lt : a < b ) → fromℕ< (s≤s lt) ≡ suc (fromℕ< lt)
+lemma3 (s≤s lt) = refl
+
+-- fromℕ<-toℕ 
+lemma12 : {n m : ℕ } → (n<m : n < m ) → (f : Fin m )  → toℕ f ≡ n → f ≡ fromℕ< n<m 
+lemma12 {zero} {suc m} (s≤s z≤n) zero refl = refl
+lemma12 {suc n} {suc m} (s≤s n<m) (suc f) refl =  cong suc ( lemma12 {n} {m} n<m f refl  ) 
+
+open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) 
+open import Data.Fin.Properties
+
+-- <-irrelevant
+<-nat=irr : {i j n : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → i<n ≅ j<n  
+<-nat=irr {zero} {zero} {suc n} refl {s≤s z≤n} {s≤s z≤n} = HE.refl
+<-nat=irr {suc i} {suc i} {suc n} refl {s≤s i<n} {s≤s j<n} = HE.cong (λ k → s≤s k ) ( <-nat=irr {i} {i} {n} refl  )
+
+lemma8 : {i j n : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → i<n ≅ j<n  
+lemma8 {zero} {zero} {suc n} refl {s≤s z≤n} {s≤s z≤n} = HE.refl
+lemma8 {suc i} {suc i} {suc n} refl {s≤s i<n} {s≤s j<n} = HE.cong (λ k → s≤s k ) ( lemma8 {i} {i} {n} refl  )
+
+-- fromℕ<-irrelevant 
+lemma10 : {n i j  : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n }  → fromℕ< i<n ≡ fromℕ< j<n
+lemma10 {n} refl  = HE.≅-to-≡ (HE.cong (λ k → fromℕ< k ) (lemma8 refl  ))
+
+lemma31 : {a b c : ℕ } → { a<b : a < b } { b<c : b < c } { a<c : a < c } → NatP.<-trans a<b b<c ≡ a<c
+lemma31 {a} {b} {c} {a<b} {b<c} {a<c} = HE.≅-to-≡ (lemma8 refl) 
+
+-- toℕ-fromℕ<
+lemma11 : {n m : ℕ } {x : Fin n } → (n<m : n < m ) → toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m)) ≡ toℕ x
+lemma11 {n} {m} {x} n<m  = begin
+              toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m))
+           ≡⟨ toℕ-fromℕ< _ ⟩
+              toℕ x
+           ∎  where
+               open ≡-Reasoning
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/automaton-in-agda/src/finiteSet.agda	Sun Jun 13 20:45:17 2021 +0900
@@ -0,0 +1,42 @@
+{-# OPTIONS --allow-unsolved-metas #-}
+module finiteSet  where
+
+open import Data.Nat hiding ( _≟_ )
+open import Data.Fin renaming ( _<_ to _<<_ ) hiding (_≤_)
+-- open import Data.Fin.Properties
+open import Data.Empty
+open import Relation.Nullary
+open import Relation.Binary.Definitions
+open import Relation.Binary.PropositionalEquality
+open import logic
+open import nat
+open import Data.Nat.Properties hiding ( _≟_ )
+
+open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) 
+
+record FiniteSet ( Q : Set ) : Set  where
+     field
+        finite : ℕ
+        Q←F : Fin finite → Q
+        F←Q : Q → Fin finite
+        finiso→ : (q : Q) → Q←F ( F←Q q ) ≡ q
+        finiso← : (f : Fin finite ) → F←Q ( Q←F f ) ≡ f
+     exists1 : (m : ℕ ) → m Data.Nat.≤ finite → (Q → Bool) → Bool
+     exists1  zero  _ _ = false
+     exists1 ( suc m ) m<n p = p (Q←F (fromℕ< {m} {finite} m<n)) \/ exists1 m (≤to< m<n) p
+     exists : ( Q → Bool ) → Bool
+     exists p = exists1 finite ≤-refl p 
+
+     open import Data.List
+     list1 : (m : ℕ ) → m Data.Nat.≤ finite → (Q → Bool) → List Q 
+     list1  zero  _ _ = []
+     list1 ( suc m ) m<n p with bool-≡-? (p (Q←F (fromℕ< {m} {finite} m<n))) true
+     ... | yes _ = Q←F (fromℕ< {m} {finite} m<n) ∷ list1 m (≤to< m<n) p
+     ... | no  _ = list1 m (≤to< m<n) p
+     to-list : ( Q → Bool ) → List Q 
+     to-list p = list1 finite ≤-refl p 
+
+     equal? : Q → Q → Bool
+     equal? q0 q1 with F←Q q0 ≟ F←Q q1
+     ... | yes p = true
+     ... | no ¬p = false
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/automaton-in-agda/src/finiteSetUtil.agda	Sun Jun 13 20:45:17 2021 +0900
@@ -0,0 +1,461 @@
+{-# OPTIONS --allow-unsolved-metas #-} 
+
+module finiteSetUtil  where
+
+open import Data.Nat hiding ( _≟_ )
+open import Data.Fin renaming ( _<_ to _<<_ ) hiding (_≤_)
+open import Data.Fin.Properties
+open import Data.Empty
+open import Relation.Nullary
+open import Relation.Binary.Definitions
+open import Relation.Binary.PropositionalEquality
+open import logic
+open import nat
+open import finiteSet
+open import fin
+open import Data.Nat.Properties as NatP  hiding ( _≟_ )
+open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) 
+
+record Found ( Q : Set ) (p : Q → Bool ) : Set where
+     field
+       found-q : Q
+       found-p : p found-q ≡ true
+
+module _ {Q : Set } (F : FiniteSet Q) where
+     open FiniteSet F
+     equal→refl  : { x y : Q } → equal? x y ≡ true → x ≡ y
+     equal→refl {q0} {q1} eq with F←Q q0 ≟ F←Q q1
+     equal→refl {q0} {q1} refl | yes eq = begin
+            q0
+        ≡⟨ sym ( finiso→ q0) ⟩
+            Q←F (F←Q q0)
+        ≡⟨ cong (λ k → Q←F k ) eq ⟩
+            Q←F (F←Q q1)
+        ≡⟨ finiso→ q1 ⟩
+            q1
+        ∎  where open ≡-Reasoning
+     End : (m : ℕ ) → (p : Q → Bool ) → Set
+     End m p = (i : Fin finite) → m ≤ toℕ i → p (Q←F i )  ≡ false 
+     first-end :  ( p : Q → Bool ) → End finite p
+     first-end p i i>n = ⊥-elim (nat-≤> i>n (fin<n {finite} {i}) )
+     next-end : {m : ℕ } → ( p : Q → Bool ) → End (suc m) p
+              → (m<n : m < finite ) → p (Q←F (fromℕ< m<n )) ≡ false
+              → End m p
+     next-end {m} p prev m<n np i m<i with NatP.<-cmp m (toℕ i) 
+     next-end p prev m<n np i m<i | tri< a ¬b ¬c = prev i a
+     next-end p prev m<n np i m<i | tri> ¬a ¬b c = ⊥-elim ( nat-≤> m<i c )
+     next-end {m} p prev m<n np i m<i | tri≈ ¬a b ¬c = subst ( λ k → p (Q←F k) ≡ false) (m<n=i i b m<n ) np where
+              m<n=i : {n : ℕ } (i : Fin n) {m : ℕ } → m ≡ (toℕ i) → (m<n : m < n )  → fromℕ< m<n ≡ i
+              m<n=i i eq m<n = {!!} -- toℕ-inject (fromℕ≤ ?) i (subst (λ k → k ≡ toℕ i) (sym (toℕ-fromℕ≤ m<n)) eq )
+     found : { p : Q → Bool } → (q : Q ) → p q ≡ true → exists p ≡ true
+     found {p} q pt = found1 finite  (NatP.≤-refl ) ( first-end p ) where
+         found1 : (m : ℕ ) (m<n : m Data.Nat.≤ finite ) → ((i : Fin finite) → m ≤ toℕ i → p (Q←F i )  ≡ false ) →  exists1 m m<n p ≡ true
+         found1 0 m<n end = ⊥-elim ( ¬-bool (subst (λ k → k ≡ false ) (cong (λ k → p k) (finiso→ q) ) (end (F←Q q) z≤n )) pt )
+         found1 (suc m)  m<n end with bool-≡-? (p (Q←F (fromℕ< m<n))) true
+         found1 (suc m)  m<n end | yes eq = subst (λ k → k \/ exists1 m (≤to<  m<n) p ≡ true ) (sym eq) (bool-or-4 {exists1 m (≤to<  m<n) p} ) 
+         found1 (suc m)  m<n end | no np = begin
+                 p (Q←F (fromℕ< m<n)) \/ exists1 m (≤to<  m<n) p
+              ≡⟨ bool-or-1 (¬-bool-t np ) ⟩
+                 exists1 m (≤to<  m<n) p
+              ≡⟨ found1 m (≤to<  m<n) (next-end p end m<n (¬-bool-t np )) ⟩
+                 true
+              ∎  where open ≡-Reasoning
+
+
+
+record ISO (A B : Set) : Set where
+   field
+     A←B : B → A
+     B←A : A → B
+     iso← : (q : A) → A←B ( B←A q ) ≡ q
+     iso→ : (f : B) → B←A ( A←B f ) ≡ f
+
+iso-fin : {A B : Set} → FiniteSet A  → ISO A B → FiniteSet B 
+iso-fin {A} {B}  fin iso = record {
+   Q←F = λ f → ISO.B←A iso ( FiniteSet.Q←F fin f )
+ ; F←Q = λ b → FiniteSet.F←Q fin ( ISO.A←B iso b )
+ ; finiso→ = finiso→ 
+ ; finiso← = finiso← 
+   } where
+   finiso→ : (q : B) → ISO.B←A iso (FiniteSet.Q←F fin (FiniteSet.F←Q fin (ISO.A←B iso q))) ≡ q
+   finiso→ q = begin
+              ISO.B←A iso (FiniteSet.Q←F fin (FiniteSet.F←Q fin (ISO.A←B iso q))) 
+           ≡⟨ cong (λ k → ISO.B←A iso k ) (FiniteSet.finiso→ fin _ ) ⟩
+              ISO.B←A iso (ISO.A←B iso q)
+           ≡⟨ ISO.iso→ iso _ ⟩
+              q
+           ∎  where
+           open ≡-Reasoning
+   finiso← : (f : Fin (FiniteSet.finite fin ))→ FiniteSet.F←Q fin (ISO.A←B iso (ISO.B←A iso (FiniteSet.Q←F fin f))) ≡ f
+   finiso← f = begin
+              FiniteSet.F←Q fin (ISO.A←B iso (ISO.B←A iso (FiniteSet.Q←F fin f))) 
+           ≡⟨ cong (λ k → FiniteSet.F←Q fin k ) (ISO.iso← iso _) ⟩
+              FiniteSet.F←Q fin (FiniteSet.Q←F fin f) 
+           ≡⟨ FiniteSet.finiso← fin _  ⟩
+              f
+           ∎  where
+           open ≡-Reasoning
+
+data One : Set where
+   one : One
+
+fin-∨1 : {B : Set} → (fb : FiniteSet B ) → FiniteSet (One ∨ B) 
+fin-∨1 {B} fb =  record {
+   Q←F = Q←F
+ ; F←Q =  F←Q
+ ; finiso→ = finiso→
+ ; finiso← = finiso←
+   }  where
+   b = FiniteSet.finite fb
+   Q←F : Fin (suc b) → One ∨ B
+   Q←F zero = case1 one
+   Q←F (suc f) = case2 (FiniteSet.Q←F fb f)
+   F←Q : One ∨ B → Fin (suc b)
+   F←Q (case1 one) = zero
+   F←Q (case2 f ) = suc (FiniteSet.F←Q fb f) 
+   finiso→ : (q : One ∨ B) → Q←F (F←Q q) ≡ q
+   finiso→ (case1 one) = refl
+   finiso→ (case2 b) = cong (λ k → case2 k ) (FiniteSet.finiso→ fb b)
+   finiso← : (q : Fin (suc b)) → F←Q (Q←F q) ≡ q
+   finiso← zero = refl
+   finiso← (suc f) = cong ( λ k → suc k ) (FiniteSet.finiso← fb f)
+
+
+fin-∨2 : {B : Set} → ( a : ℕ ) → FiniteSet B  → FiniteSet (Fin a ∨ B) 
+fin-∨2 {B} zero  fb = iso-fin fb iso where
+   iso : ISO B (Fin zero ∨ B)
+   iso =  record {
+        A←B = A←B
+      ; B←A = λ b → case2 b
+      ; iso→ = iso→
+      ; iso← = λ _ → refl
+    } where
+     A←B : Fin zero ∨ B → B
+     A←B (case2 x) = x 
+     iso→ : (f : Fin zero ∨ B ) → case2 (A←B f) ≡ f
+     iso→ (case2 x)  = refl
+fin-∨2 {B} (suc a) fb =  iso-fin (fin-∨1 (fin-∨2 a fb) ) iso
+    where
+  iso : ISO (One ∨ (Fin a ∨ B) ) (Fin (suc a) ∨ B)
+  ISO.A←B iso (case1 zero) = case1 one
+  ISO.A←B iso (case1 (suc f)) = case2 (case1 f)
+  ISO.A←B iso (case2 b) = case2 (case2 b)
+  ISO.B←A iso (case1 one) = case1 zero
+  ISO.B←A iso (case2 (case1 f)) = case1 (suc f)
+  ISO.B←A iso (case2 (case2 b)) = case2 b
+  ISO.iso← iso (case1 one) = refl
+  ISO.iso← iso (case2 (case1 x)) = refl
+  ISO.iso← iso (case2 (case2 x)) = refl
+  ISO.iso→ iso (case1 zero) = refl
+  ISO.iso→ iso (case1 (suc x)) = refl
+  ISO.iso→ iso (case2 x) = refl
+
+
+FiniteSet→Fin : {A : Set} → (fin : FiniteSet A  ) → ISO (Fin (FiniteSet.finite fin)) A
+ISO.A←B (FiniteSet→Fin fin) f = FiniteSet.F←Q fin f
+ISO.B←A (FiniteSet→Fin fin) f = FiniteSet.Q←F fin f
+ISO.iso← (FiniteSet→Fin fin) = FiniteSet.finiso← fin
+ISO.iso→ (FiniteSet→Fin fin) =  FiniteSet.finiso→ fin
+   
+
+fin-∨ : {A B : Set} → FiniteSet A → FiniteSet B → FiniteSet (A ∨ B) 
+fin-∨ {A} {B}  fa fb = iso-fin (fin-∨2 a  fb ) iso2 where
+    a = FiniteSet.finite fa
+    ia = FiniteSet→Fin fa
+    iso2 : ISO (Fin a ∨ B ) (A ∨ B)
+    ISO.A←B iso2 (case1 x) = case1 ( ISO.A←B ia x )
+    ISO.A←B iso2 (case2 x) = case2 x
+    ISO.B←A iso2 (case1 x) = case1 ( ISO.B←A ia x )
+    ISO.B←A iso2 (case2 x) = case2 x
+    ISO.iso← iso2 (case1 x) = cong ( λ k → case1 k ) (ISO.iso← ia x)
+    ISO.iso← iso2 (case2 x) = refl
+    ISO.iso→ iso2 (case1 x) = cong ( λ k → case1 k ) (ISO.iso→ ia x)
+    ISO.iso→ iso2 (case2 x) = refl
+
+open import Data.Product
+
+fin-× : {A B : Set} → FiniteSet A → FiniteSet B → FiniteSet (A × B) 
+fin-× {A} {B}  fa fb with FiniteSet→Fin fa
+... | a=f = iso-fin (fin-×-f a ) iso-1 where
+   a = FiniteSet.finite fa
+   b = FiniteSet.finite fb
+   iso-1 : ISO (Fin a × B) ( A × B )
+   ISO.A←B iso-1 x = ( FiniteSet.F←Q fa (proj₁ x)  , proj₂ x) 
+   ISO.B←A iso-1 x = ( FiniteSet.Q←F fa (proj₁ x)  , proj₂ x) 
+   ISO.iso← iso-1 x  =  lemma  where
+     lemma : (FiniteSet.F←Q fa (FiniteSet.Q←F fa (proj₁ x)) , proj₂ x) ≡ ( proj₁ x , proj₂ x )
+     lemma = cong ( λ k → ( k ,  proj₂ x ) )  (FiniteSet.finiso← fa _ )
+   ISO.iso→ iso-1 x = cong ( λ k → ( k ,  proj₂ x ) )  (FiniteSet.finiso→ fa _ )
+
+   iso-2 : {a : ℕ } → ISO (B ∨ (Fin a × B)) (Fin (suc a) × B)
+   ISO.A←B iso-2 (zero , b ) = case1 b
+   ISO.A←B iso-2 (suc fst , b ) = case2 ( fst , b )
+   ISO.B←A iso-2 (case1 b) = ( zero , b )
+   ISO.B←A iso-2 (case2 (a , b )) = ( suc a , b )
+   ISO.iso← iso-2 (case1 x) = refl
+   ISO.iso← iso-2 (case2 x) = refl
+   ISO.iso→ iso-2 (zero , b ) = refl
+   ISO.iso→ iso-2 (suc a , b ) = refl
+
+   fin-×-f : ( a  : ℕ ) → FiniteSet ((Fin a) × B) 
+   fin-×-f zero = record { Q←F = λ () ; F←Q = λ () ; finiso→ = λ () ; finiso← = λ () ; finite = 0 }
+   fin-×-f (suc a) = iso-fin ( fin-∨ fb ( fin-×-f a ) ) iso-2
+
+open _∧_
+
+fin-∧ : {A B : Set} → FiniteSet A → FiniteSet B → FiniteSet (A ∧ B) 
+fin-∧ {A} {B} fa fb with FiniteSet→Fin fa    -- same thing for our tool
+... | a=f = iso-fin (fin-×-f a ) iso-1 where
+   a = FiniteSet.finite fa
+   b = FiniteSet.finite fb
+   iso-1 : ISO (Fin a ∧ B) ( A ∧ B )
+   ISO.A←B iso-1 x = record { proj1 = FiniteSet.F←Q fa (proj1 x)  ; proj2 =  proj2 x} 
+   ISO.B←A iso-1 x = record { proj1 = FiniteSet.Q←F fa (proj1 x)  ; proj2 =  proj2 x}
+   ISO.iso← iso-1 x  =  lemma  where
+     lemma : record { proj1 = FiniteSet.F←Q fa (FiniteSet.Q←F fa (proj1 x)) ; proj2 =  proj2 x} ≡ record {proj1 =  proj1 x ; proj2 =  proj2 x }
+     lemma = cong ( λ k → record {proj1 = k ;  proj2 = proj2 x } )  (FiniteSet.finiso← fa _ )
+   ISO.iso→ iso-1 x = cong ( λ k → record {proj1 =  k ; proj2 =  proj2 x } )  (FiniteSet.finiso→ fa _ )
+
+   iso-2 : {a : ℕ } → ISO (B ∨ (Fin a ∧ B)) (Fin (suc a) ∧ B)
+   ISO.A←B iso-2 (record { proj1 = zero ; proj2 =  b }) = case1 b
+   ISO.A←B iso-2 (record { proj1 = suc fst ; proj2 =  b }) = case2 ( record { proj1 = fst ; proj2 =  b } )
+   ISO.B←A iso-2 (case1 b) = record {proj1 =  zero ; proj2 =  b }
+   ISO.B←A iso-2 (case2 (record { proj1 = a ; proj2 =  b })) = record { proj1 =  suc a ; proj2 =  b }
+   ISO.iso← iso-2 (case1 x) = refl
+   ISO.iso← iso-2 (case2 x) = refl
+   ISO.iso→ iso-2 (record { proj1 = zero ; proj2 =  b }) = refl
+   ISO.iso→ iso-2 (record { proj1 = suc a ; proj2 =  b }) = refl
+
+   fin-×-f : ( a  : ℕ ) → FiniteSet ((Fin a) ∧ B) 
+   fin-×-f zero = record { Q←F = λ () ; F←Q = λ () ; finiso→ = λ () ; finiso← = λ () ; finite = 0 }
+   fin-×-f (suc a) = iso-fin ( fin-∨ fb ( fin-×-f a ) ) iso-2
+
+-- import Data.Nat.DivMod
+
+open import Data.Vec
+import Data.Product
+
+exp2 : (n : ℕ ) → exp 2 (suc n) ≡ exp 2 n Data.Nat.+ exp 2 n
+exp2 n = begin
+      exp 2 (suc n)
+   ≡⟨⟩
+      2 * ( exp 2 n )
+   ≡⟨ *-comm 2 (exp 2 n)  ⟩
+      ( exp 2 n ) * 2
+   ≡⟨ *-suc ( exp 2 n ) 1 ⟩
+      (exp 2 n ) Data.Nat.+ ( exp 2 n ) * 1
+   ≡⟨ cong ( λ k →  (exp 2 n ) Data.Nat.+  k ) (proj₂ *-identity (exp 2 n) ) ⟩
+      exp 2 n Data.Nat.+ exp 2 n
+   ∎  where
+       open ≡-Reasoning
+       open Data.Product
+
+cast-iso : {n m : ℕ } → (eq : n ≡ m ) → (f : Fin m ) → cast eq ( cast (sym eq ) f)  ≡ f
+cast-iso refl zero =  refl
+cast-iso refl (suc f) = cong ( λ k → suc k ) ( cast-iso refl f )
+
+
+fin2List : {n : ℕ } → FiniteSet (Vec Bool n) 
+fin2List {zero} = record {
+   Q←F = λ _ → Vec.[]
+ ; F←Q =  λ _ → # 0
+ ; finiso→ = finiso→ 
+ ; finiso← = finiso← 
+   } where
+   Q = Vec Bool zero
+   finiso→ : (q : Q) → [] ≡ q
+   finiso→ [] = refl
+   finiso← : (f : Fin (exp 2 zero)) → # 0 ≡ f
+   finiso← zero = refl
+fin2List {suc n} = subst (λ k → FiniteSet (Vec Bool (suc n)) ) (sym (exp2 n)) ( iso-fin (fin-∨ (fin2List ) (fin2List )) iso )
+    where
+   QtoR : Vec Bool (suc  n) →  Vec Bool n ∨ Vec Bool n
+   QtoR ( true ∷ x ) = case1 x
+   QtoR ( false ∷ x ) = case2 x
+   RtoQ : Vec Bool n ∨ Vec Bool n → Vec Bool (suc  n) 
+   RtoQ ( case1 x ) = true ∷ x
+   RtoQ ( case2 x ) = false ∷ x
+   isoRQ : (x : Vec Bool (suc  n) ) → RtoQ ( QtoR x ) ≡ x
+   isoRQ (true ∷ _ ) = refl
+   isoRQ (false ∷ _ ) = refl
+   isoQR : (x : Vec Bool n ∨ Vec Bool n ) → QtoR ( RtoQ x ) ≡ x
+   isoQR (case1 x) = refl
+   isoQR (case2 x) = refl
+   iso : ISO (Vec Bool n ∨ Vec Bool n) (Vec Bool (suc n))
+   iso = record { A←B = QtoR ; B←A = RtoQ ; iso← = isoQR ; iso→ = isoRQ  }
+
+F2L : {Q : Set } {n : ℕ } → (fin : FiniteSet Q ) → n < suc (FiniteSet.finite fin) → ( (q : Q) → toℕ (FiniteSet.F←Q fin q ) < n  → Bool ) → Vec Bool n
+F2L  {Q} {zero} fin _ Q→B = []
+F2L  {Q} {suc n} fin (s≤s n<m) Q→B = Q→B (FiniteSet.Q←F fin (fromℕ< n<m)) lemma6 ∷ F2L {Q} fin (NatP.<-trans n<m a<sa ) qb1 where
+   lemma6 : toℕ (FiniteSet.F←Q fin (FiniteSet.Q←F fin (fromℕ< n<m))) < suc n
+   lemma6 = subst (λ k → toℕ k < suc n ) (sym (FiniteSet.finiso← fin _ )) (subst (λ k → k < suc n) (sym (toℕ-fromℕ< n<m ))  a<sa )
+   qb1 : (q : Q) → toℕ (FiniteSet.F←Q fin q) < n → Bool
+   qb1 q q<n = Q→B q (NatP.<-trans q<n a<sa)
+
+List2Func : { Q : Set } → {n : ℕ } → (fin : FiniteSet Q ) → n < suc (FiniteSet.finite fin)  → Vec Bool n →  Q → Bool 
+List2Func {Q} {zero} fin (s≤s z≤n) [] q = false
+List2Func {Q} {suc n} fin (s≤s n<m) (h ∷ t) q with  FiniteSet.F←Q fin q ≟ fromℕ< n<m
+... | yes _ = h
+... | no _ = List2Func {Q} fin (NatP.<-trans n<m a<sa ) t q
+
+open import Level renaming ( suc to Suc ; zero to Zero) 
+open import Axiom.Extensionality.Propositional
+postulate f-extensionality : { n : Level}  →  Axiom.Extensionality.Propositional.Extensionality n n 
+
+F2L-iso : { Q : Set } → (fin : FiniteSet Q ) → (x : Vec Bool (FiniteSet.finite fin) ) → F2L fin a<sa (λ q _ → List2Func fin a<sa x q ) ≡ x
+F2L-iso {Q} fin x = f2l m a<sa x where
+  m = FiniteSet.finite fin
+  f2l : (n : ℕ ) → (n<m : n < suc m )→ (x : Vec Bool n ) → F2L fin n<m (λ q q<n → List2Func fin n<m x q )  ≡ x 
+  f2l zero (s≤s z≤n) [] = refl
+  f2l (suc n) (s≤s n<m) (h ∷ t ) = lemma1 lemma2 lemma3f where
+    lemma1 : {n : ℕ } → {h h1 : Bool } → {t t1 : Vec Bool n } → h ≡ h1 → t ≡ t1 →  h ∷ t ≡ h1 ∷ t1
+    lemma1 refl refl = refl
+    lemma2 : List2Func fin (s≤s n<m) (h ∷ t) (FiniteSet.Q←F fin (fromℕ< n<m)) ≡ h
+    lemma2 with FiniteSet.F←Q fin (FiniteSet.Q←F fin (fromℕ< n<m))  ≟ fromℕ< n<m
+    lemma2 | yes p = refl
+    lemma2 | no ¬p = ⊥-elim ( ¬p (FiniteSet.finiso← fin _) )
+    lemma4 : (q : Q ) → toℕ (FiniteSet.F←Q fin q ) < n → List2Func fin (s≤s n<m) (h ∷ t) q ≡ List2Func fin (NatP.<-trans n<m a<sa) t q
+    lemma4 q _ with FiniteSet.F←Q fin q ≟ fromℕ< n<m 
+    lemma4 q lt | yes p = ⊥-elim ( nat-≡< (toℕ-fromℕ< n<m) (lemma5 n lt (cong (λ k → toℕ k) p))) where 
+        lemma5 : {j k : ℕ } → ( n : ℕ) → suc j ≤ n → j ≡ k → k < n
+        lemma5 {zero} (suc n) (s≤s z≤n) refl = s≤s  z≤n
+        lemma5 {suc j} (suc n) (s≤s lt) refl = s≤s (lemma5 {j} n lt refl)
+    lemma4 q _ | no ¬p = refl
+    lemma3f :  F2L fin (NatP.<-trans n<m a<sa) (λ q q<n → List2Func fin (s≤s n<m) (h ∷ t) q  ) ≡ t
+    lemma3f = begin 
+         F2L fin (NatP.<-trans n<m a<sa) (λ q q<n → List2Func fin (s≤s n<m) (h ∷ t) q )
+       ≡⟨ cong (λ k → F2L fin (NatP.<-trans n<m a<sa) ( λ q q<n → k q q<n ))
+              (f-extensionality ( λ q →  
+              (f-extensionality ( λ q<n →  lemma4 q q<n )))) ⟩
+         F2L fin (NatP.<-trans n<m a<sa) (λ q q<n → List2Func fin (NatP.<-trans n<m a<sa) t q )
+       ≡⟨ f2l n (NatP.<-trans n<m a<sa ) t ⟩
+         t
+       ∎  where
+         open ≡-Reasoning
+
+
+L2F : {Q : Set } {n : ℕ } → (fin : FiniteSet Q )  → n < suc (FiniteSet.finite fin) → Vec Bool n → (q :  Q ) → toℕ (FiniteSet.F←Q fin q ) < n  → Bool
+L2F fin n<m x q q<n = List2Func fin n<m x q 
+
+L2F-iso : { Q : Set } → (fin : FiniteSet Q ) → (f : Q → Bool ) → (q : Q ) → (L2F fin a<sa (F2L fin a<sa (λ q _ → f q) )) q (toℕ<n _) ≡ f q
+L2F-iso {Q} fin f q = l2f m a<sa (toℕ<n _) where
+  m = FiniteSet.finite fin
+  lemma11f : {n : ℕ } → (n<m : n < m )  → ¬ ( FiniteSet.F←Q fin q ≡ fromℕ< n<m ) → toℕ (FiniteSet.F←Q fin q) ≤ n → toℕ (FiniteSet.F←Q fin q) < n
+  lemma11f  n<m ¬q=n q≤n = lemma13 n<m (contra-position (lemma12 n<m _) ¬q=n ) q≤n where
+     lemma13 : {n nq : ℕ } → (n<m : n < m )  → ¬ ( nq ≡ n ) → nq  ≤ n → nq < n
+     lemma13 {0} {0} (s≤s z≤n) nt z≤n = ⊥-elim ( nt refl )
+     lemma13 {suc _} {0} (s≤s (s≤s n<m)) nt z≤n = s≤s z≤n
+     lemma13 {suc n} {suc nq} n<m nt (s≤s nq≤n) = s≤s (lemma13 {n} {nq} (NatP.<-trans a<sa n<m ) (λ eq → nt ( cong ( λ k → suc k ) eq )) nq≤n)
+     lemma3f : {a b : ℕ } → (lt : a < b ) → fromℕ< (s≤s lt) ≡ suc (fromℕ< lt)
+     lemma3f (s≤s lt) = refl
+     lemma12f : {n m : ℕ } → (n<m : n < m ) → (f : Fin m )  → toℕ f ≡ n → f ≡ fromℕ< n<m 
+     lemma12f {zero} {suc m} (s≤s z≤n) zero refl = refl
+     lemma12f {suc n} {suc m} (s≤s n<m) (suc f) refl = subst ( λ k → suc f ≡ k ) (sym (lemma3f n<m) ) ( cong ( λ k → suc k ) ( lemma12f {n} {m} n<m f refl  ) )
+  l2f :  (n : ℕ ) → (n<m : n < suc m ) → (q<n : toℕ (FiniteSet.F←Q fin q ) < n )  →  (L2F fin n<m (F2L fin n<m  (λ q _ → f q))) q q<n ≡ f q
+  l2f zero (s≤s z≤n) ()
+  l2f (suc n) (s≤s n<m) (s≤s n<q) with FiniteSet.F←Q fin q ≟ fromℕ< n<m 
+  l2f (suc n) (s≤s n<m) (s≤s n<q) | yes p = begin 
+        f (FiniteSet.Q←F fin (fromℕ< n<m)) 
+     ≡⟨ cong ( λ k → f (FiniteSet.Q←F fin k )) (sym p)  ⟩
+        f (FiniteSet.Q←F fin ( FiniteSet.F←Q fin q ))
+     ≡⟨ cong ( λ k → f k ) (FiniteSet.finiso→ fin _ ) ⟩
+        f q 
+     ∎  where
+       open ≡-Reasoning
+  l2f (suc n) (s≤s n<m) (s≤s n<q) | no ¬p = l2f n (NatP.<-trans n<m a<sa) (lemma11f n<m ¬p n<q)
+
+fin→ : {A : Set} → FiniteSet A → FiniteSet (A → Bool ) 
+fin→ {A}  fin = iso-fin fin2List iso where
+    a = FiniteSet.finite fin
+    iso : ISO (Vec Bool a ) (A → Bool)
+    ISO.A←B iso x = F2L fin a<sa ( λ q _ → x q )
+    ISO.B←A iso x = List2Func fin a<sa x 
+    ISO.iso← iso x  =  F2L-iso fin x 
+    ISO.iso→ iso x = lemma where
+      lemma : List2Func fin a<sa (F2L fin a<sa (λ q _ → x q)) ≡ x
+      lemma = f-extensionality ( λ q → L2F-iso fin x q )
+    
+
+Fin2Finite : ( n : ℕ ) → FiniteSet (Fin n) 
+Fin2Finite n = record { F←Q = λ x → x ; Q←F = λ x → x ; finiso← = λ q → refl ; finiso→ = λ q → refl }
+
+data fin-less { n : ℕ } { A : Set }  (fa : FiniteSet A ) (n<m : n < FiniteSet.finite fa ) : Set where
+  elm1 : (elm : A ) → toℕ (FiniteSet.F←Q fa elm ) < n → fin-less fa n<m 
+
+get-elm : { n : ℕ }  { A : Set } {fa : FiniteSet A } {n<m : n < FiniteSet.finite fa } → fin-less fa n<m → A
+get-elm (elm1 a _ ) = a
+
+get-< : { n : ℕ }  { A : Set } {fa : FiniteSet A } {n<m : n < FiniteSet.finite fa }→ (f : fin-less fa n<m ) → toℕ (FiniteSet.F←Q fa (get-elm f )) < n
+get-< (elm1 _ b ) = b
+
+fin-less-cong : { n : ℕ }  { A : Set } (fa : FiniteSet A ) (n<m : n < FiniteSet.finite fa )
+   → (x y : fin-less fa n<m ) → get-elm {n} {A} {fa} x ≡ get-elm {n} {A} {fa} y → get-< x ≅  get-< y → x ≡ y
+fin-less-cong fa n<m (elm1 elm x) (elm1 elm x) refl HE.refl = refl
+
+fin-< : {A : Set} → { n : ℕ } → (fa : FiniteSet A ) → (n<m : n < FiniteSet.finite fa ) → FiniteSet (fin-less fa n<m ) 
+fin-< {A}  {n} fa n<m = iso-fin (Fin2Finite n) iso where
+    m = FiniteSet.finite fa
+    iso : ISO (Fin n) (fin-less fa n<m )
+    lemma8f : {i j n : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → i<n ≅ j<n  
+    lemma8f {zero} {zero} {suc n} refl {s≤s z≤n} {s≤s z≤n} = HE.refl
+    lemma8f {suc i} {suc i} {suc n} refl {s≤s i<n} {s≤s j<n} = HE.cong (λ k → s≤s k ) ( lemma8f {i} {i}  refl  )
+    lemma10f : {n i j  : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n }  → fromℕ< i<n ≡ fromℕ< j<n
+    lemma10f  refl  = HE.≅-to-≡ (HE.cong (λ k → fromℕ< k ) (lemma8f refl  ))
+    lemma3f : {a b c : ℕ } → { a<b : a < b } { b<c : b < c } { a<c : a < c } → NatP.<-trans a<b b<c ≡ a<c
+    lemma3f {a} {b} {c} {a<b} {b<c} {a<c} = HE.≅-to-≡ (lemma8f refl) 
+    lemma11f : {n : ℕ } {x : Fin n } → (n<m : n < m ) → toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m)) ≡ toℕ x
+    lemma11f {n} {x} n<m  = begin
+         toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m))
+      ≡⟨ toℕ-fromℕ< _ ⟩
+         toℕ x
+      ∎  where
+          open ≡-Reasoning
+    ISO.A←B iso (elm1 elm x) = fromℕ< x
+    ISO.B←A iso x = elm1 (FiniteSet.Q←F fa (fromℕ< (NatP.<-trans x<n n<m ))) to<n where
+      x<n : toℕ x < n
+      x<n = toℕ<n x
+      to<n : toℕ (FiniteSet.F←Q fa (FiniteSet.Q←F fa (fromℕ< (NatP.<-trans x<n n<m)))) < n
+      to<n = subst (λ k → toℕ k < n ) (sym (FiniteSet.finiso← fa _ )) (subst (λ k → k < n ) (sym ( toℕ-fromℕ< (NatP.<-trans x<n n<m) )) x<n )
+    ISO.iso← iso x  = lemma2 where
+      lemma2 : fromℕ< (subst (λ k → toℕ k < n) (sym
+       (FiniteSet.finiso← fa (fromℕ< (NatP.<-trans (toℕ<n x) n<m)))) (subst (λ k → k < n)
+       (sym (toℕ-fromℕ< (NatP.<-trans (toℕ<n x) n<m))) (toℕ<n x))) ≡ x
+      lemma2 = begin
+        fromℕ< (subst (λ k → toℕ k < n) (sym
+          (FiniteSet.finiso← fa (fromℕ< (NatP.<-trans (toℕ<n x) n<m)))) (subst (λ k → k < n)
+               (sym (toℕ-fromℕ< (NatP.<-trans (toℕ<n x) n<m))) (toℕ<n x))) 
+        ≡⟨⟩
+           fromℕ< ( subst (λ k → toℕ ( k ) < n ) (sym (FiniteSet.finiso← fa _ )) lemma6 )
+        ≡⟨ lemma10 (cong (λ k → toℕ k) (FiniteSet.finiso← fa _ ) ) ⟩
+           fromℕ< lemma6
+        ≡⟨ lemma10 (lemma11 n<m ) ⟩
+           fromℕ< ( toℕ<n x )
+        ≡⟨ fromℕ<-toℕ _ _ ⟩
+           x 
+        ∎  where
+          open ≡-Reasoning
+          lemma6 : toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m)) < n
+          lemma6 = subst ( λ k → k < n ) (sym (toℕ-fromℕ< (NatP.<-trans (toℕ<n x) n<m))) (toℕ<n x )
+    ISO.iso→ iso (elm1 elm x) = fin-less-cong fa n<m _ _ lemma (lemma8 (cong (λ k → toℕ (FiniteSet.F←Q fa k) ) lemma ) ) where
+      lemma13 : toℕ (fromℕ< x) ≡ toℕ (FiniteSet.F←Q fa elm)
+      lemma13 = begin
+            toℕ (fromℕ< x)
+         ≡⟨ toℕ-fromℕ< _ ⟩
+            toℕ (FiniteSet.F←Q fa elm)
+         ∎  where open ≡-Reasoning
+      lemma : FiniteSet.Q←F fa (fromℕ< (NatP.<-trans (toℕ<n (ISO.A←B iso (elm1 elm x))) n<m)) ≡ elm 
+      lemma = begin
+           FiniteSet.Q←F fa (fromℕ< (NatP.<-trans (toℕ<n (ISO.A←B iso (elm1 elm x))) n<m))
+         ≡⟨⟩
+           FiniteSet.Q←F fa (fromℕ< ( NatP.<-trans (toℕ<n ( fromℕ< x ) ) n<m))
+         ≡⟨ cong (λ k → FiniteSet.Q←F fa k) (lemma10 lemma13 ) ⟩
+            FiniteSet.Q←F fa (fromℕ< ( NatP.<-trans x n<m))
+         ≡⟨ cong (λ k → FiniteSet.Q←F fa (fromℕ< k ))  {!!} ⟩
+           FiniteSet.Q←F fa (fromℕ< ( toℕ<n (FiniteSet.F←Q fa elm)))
+         ≡⟨ cong (λ k → FiniteSet.Q←F fa k ) ( fromℕ<-toℕ _ _ ) ⟩
+           FiniteSet.Q←F fa (FiniteSet.F←Q fa elm )
+         ≡⟨ FiniteSet.finiso→ fa _ ⟩
+            elm 
+         ∎  where open ≡-Reasoning
+
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/automaton-in-agda/src/flcagl.agda	Sun Jun 13 20:45:17 2021 +0900
@@ -0,0 +1,481 @@
+open import Relation.Nullary
+open import Relation.Binary.PropositionalEquality
+module flcagl
+   (A : Set)
+   ( _≟_ :  (a b : A) → Dec ( a ≡ b ) ) where
+
+open import Data.Bool hiding ( _≟_ ) 
+-- open import Data.Maybe
+open import Level renaming ( zero to Zero ; suc to succ )
+open import Size 
+
+module List where
+
+        data List (i : Size) (A : Set) : Set where
+          [] : List i A
+          _∷_ : {j : Size< i} (x : A) (xs : List j A) → List i A
+
+
+        map : ∀{i A B} → (A → B) → List i A → List i B
+        map f [] = []
+        map f ( x ∷ xs)= f x ∷ map f xs
+
+        foldr : ∀{i} {A B : Set} → (A → B → B) → B → List i A → B
+        foldr c n [] = n
+        foldr c n (x ∷ xs) = c x (foldr c n xs)
+
+        any : ∀{i A} → (A → Bool) → List i A → Bool
+        any p xs = foldr _∨_ false (map p xs)
+
+module Lang where
+
+        open List 
+
+        record  Lang (i : Size)  : Set  where
+           coinductive
+           field
+              ν : Bool
+              δ : ∀{j : Size< i} → A → Lang j
+
+        open Lang
+
+        _∋_ : ∀{i} → Lang i → List i A → Bool
+        l ∋ [] = ν l
+        l ∋ ( a ∷ as ) = δ l a ∋ as
+
+        trie : ∀{i}  (f : List i A → Bool) → Lang i
+        ν (trie f) = f []
+        δ (trie f) a = trie (λ as → f (a ∷ as))
+
+        ∅ : ∀{i} → Lang i 
+        ν ∅ = false
+        δ ∅ x = ∅
+
+        ε : ∀{i} → Lang i 
+        ν ε = true
+        δ ε x = ∅
+
+        open import Relation.Nullary.Decidable
+
+        char : ∀{i}  (a : A) → Lang i
+        ν (char a) = false
+        δ (char a) x = if ⌊ a ≟ x ⌋ then ε else ∅
+
+        compl : ∀{i}  (l : Lang i) → Lang i
+        ν (compl l) = not (ν l)
+        δ (compl l) x = compl (δ l x)
+
+
+        _∪_ : ∀{i} (k l : Lang i) → Lang i
+        ν (k ∪ l) = ν k ∨ ν l
+        δ (k ∪ l) x = δ k x ∪ δ l x
+
+
+        _·_ : ∀{i}  (k l : Lang i) → Lang i
+        ν (k · l) = ν k ∧ ν l
+        δ (k · l) x = let k′l =  δ k x  · l in if ν k then k′l ∪ δ l x else k′l
+
+        _*_ : ∀{i} (k l : Lang i )  → Lang i
+        ν (k * l) = ν k ∧ ν l
+        δ (_*_ {i} k  l) {j} x =
+            let
+                k′l : Lang j
+                k′l  = _*_ {j} (δ k {j} x) l
+            in  if ν k then _∪_ {j}  k′l (δ l {j} x) else k′l 
+
+        _* : ∀{i} (l : Lang i) → Lang i
+        ν (l *) = true
+        δ (l *) x = δ l x · (l *)
+
+        record _≅⟨_⟩≅_ (l : Lang ∞ ) i (k : Lang ∞) : Set  where
+           coinductive
+           field ≅ν : ν l ≡ ν k
+                 ≅δ : ∀ {j : Size< i } (a : A ) → δ l a ≅⟨ j ⟩≅ δ k a
+
+        open _≅⟨_⟩≅_
+
+        ≅refl : ∀{i} {l : Lang ∞} → l ≅⟨ i ⟩≅ l
+        ≅ν ≅refl = refl
+        ≅δ ≅refl a = ≅refl
+
+
+        ≅sym : ∀{i} {k l : Lang ∞} (p : l ≅⟨ i ⟩≅ k) → k ≅⟨ i ⟩≅ l
+        ≅ν (≅sym p) = sym (≅ν p)
+        ≅δ (≅sym p) a = ≅sym (≅δ p a)
+
+        ≅trans : ∀{i} {k l m : Lang ∞}
+           ( p : k ≅⟨ i ⟩≅ l ) ( q : l ≅⟨ i ⟩≅ m ) → k ≅⟨ i ⟩≅ m
+        ≅ν (≅trans p q) = trans (≅ν p) (≅ν q)
+        ≅δ (≅trans p q) a = ≅trans (≅δ p a) (≅δ q a)
+
+        open import Relation.Binary
+
+        ≅isEquivalence : ∀(i : Size) → IsEquivalence _≅⟨ i ⟩≅_
+        ≅isEquivalence i = record { refl = ≅refl; sym = ≅sym; trans = ≅trans }
+
+        Bis : ∀(i : Size) → Setoid _ _
+        Setoid.Carrier (Bis i) = Lang ∞
+        Setoid._≈_ (Bis i) = _≅⟨ i ⟩≅_
+        Setoid.isEquivalence (Bis i) = ≅isEquivalence i
+
+        import Relation.Binary.EqReasoning as EqR
+
+        ≅trans′ : ∀ i (k l m : Lang ∞)
+           ( p : k ≅⟨ i ⟩≅ l ) ( q : l ≅⟨ i ⟩≅ m ) → k ≅⟨ i ⟩≅ m
+        ≅trans′ i k l m p q = begin
+                k ≈⟨ p ⟩
+                l ≈⟨ q ⟩
+                m ∎ where open EqR (Bis i)
+
+        open import Data.Bool.Properties
+
+        union-assoc : ∀{i} (k {l m} : Lang ∞) → ((k ∪ l) ∪ m ) ≅⟨ i ⟩≅ ( k ∪ (l ∪ m) )
+        ≅ν (union-assoc k) = ∨-assoc (ν k) _ _
+        ≅δ (union-assoc k) a = union-assoc (δ k a)
+        union-comm : ∀{i} (l k : Lang ∞) → (l ∪ k ) ≅⟨ i ⟩≅ ( k ∪ l )
+        ≅ν (union-comm l k) = ∨-comm (ν l) _
+        ≅δ (union-comm l k) a = union-comm (δ l a) (δ k a)
+        union-idem : ∀{i} (l : Lang ∞) → (l ∪ l ) ≅⟨ i ⟩≅ l
+        ≅ν (union-idem l) = ∨-idem _
+        ≅δ (union-idem l) a = union-idem (δ l a)
+        union-emptyl : ∀{i}{l : Lang ∞} → (∅ ∪ l ) ≅⟨ i ⟩≅ l
+        ≅ν union-emptyl = refl
+        ≅δ union-emptyl a = union-emptyl
+
+        union-cong : ∀{i}{k k′ l l′ : Lang ∞}
+             (p : k ≅⟨ i ⟩≅ k′) (q : l ≅⟨ i ⟩≅ l′ ) → ( k ∪ l ) ≅⟨ i ⟩≅ ( k′ ∪ l′ )
+        ≅ν (union-cong p q) = cong₂ _∨_ (≅ν p) (≅ν q)
+        ≅δ (union-cong p q) a = union-cong (≅δ p a) (≅δ q a)
+
+        withExample : (P : Bool → Set) (p : P true) (q : P false) →
+           {A : Set} (g : A → Bool) (x : A) → P (g x)
+        withExample P p q g x with g x
+        ... | true = p
+        ... | false = q
+
+        rewriteExample : {A : Set} {P : A → Set} {x : A} (p : P x)
+            {g : A → A} (e : g x ≡ x) → P (g x)
+        rewriteExample p e rewrite e = p
+
+        infixr 6 _∪_
+        infixr 7 _·_
+        infix 5 _≅⟨_⟩≅_
+
+        union-congl : ∀{i}{k k′ l : Lang ∞}
+             (p : k ≅⟨ i ⟩≅ k′) → ( k ∪ l ) ≅⟨ i ⟩≅ ( k′ ∪ l )
+        union-congl eq = union-cong eq ≅refl
+
+        union-congr : ∀{i}{k l l′ : Lang ∞}
+             (p : l ≅⟨ i ⟩≅ l′) → ( k ∪ l ) ≅⟨ i ⟩≅ ( k ∪ l′ )
+        union-congr eq = union-cong ≅refl eq
+
+        union-swap24 :   ∀{i} ({x y z w} : Lang ∞)  →  (x ∪ y) ∪ z ∪  w
+                                              ≅⟨ i ⟩≅ (x ∪ z) ∪ y ∪ w
+        union-swap24 {_} {x} {y} {z} {w} = begin
+              (x ∪ y) ∪ z ∪ w
+           ≈⟨ union-assoc x ⟩
+               x ∪ y ∪ z ∪ w
+           ≈⟨ union-congr (≅sym ( union-assoc y)) ⟩
+              x ∪ ((y ∪ z) ∪ w)
+           ≈⟨ ≅sym ( union-assoc x ) ⟩
+              (x ∪ ( y ∪ z)) ∪ w
+           ≈⟨ union-congl (union-congr (union-comm y z )) ⟩
+              ( x ∪ (z ∪ y)) ∪ w
+           ≈⟨  union-congl (≅sym ( union-assoc x )) ⟩
+              ((x ∪ z) ∪ y) ∪ w
+           ≈⟨ union-assoc (x ∪ z) ⟩
+              (x ∪ z) ∪ y ∪ w
+           ∎
+               where open EqR (Bis _)
+
+        concat-union-distribr : ∀{i} (k {l m} : Lang ∞) → k · ( l ∪ m ) ≅⟨ i ⟩≅ ( k · l ) ∪ ( k · m )
+        ≅ν (concat-union-distribr k) =  ∧-distribˡ-∨ (ν k) _ _ 
+        ≅δ (concat-union-distribr k) a with ν k
+        ≅δ (concat-union-distribr k {l} {m}) a | true = begin
+              δ k a · (l ∪ m) ∪ (δ l a ∪ δ m a)
+           ≈⟨ union-congl (concat-union-distribr _) ⟩
+              (δ k a · l ∪ δ k a · m) ∪ (δ l a ∪ δ m a)
+           ≈⟨ union-swap24 ⟩
+              (δ k a · l ∪ δ l a) ∪ (δ k a · m ∪ δ m a)
+           ∎
+               where open EqR (Bis _)
+        ≅δ (concat-union-distribr k) a | false = concat-union-distribr (δ k a)
+
+        concat-union-distribl : ∀{i} (k {l m} : Lang ∞) → ( k ∪ l ) · m ≅⟨ i ⟩≅ ( k · m ) ∪ ( l · m )
+        ≅ν (concat-union-distribl k {l} {m}) = ∧-distribʳ-∨ _ (ν k) _ 
+        ≅δ (concat-union-distribl k {l} {m}) a with ν k |  ν l 
+        ≅δ (concat-union-distribl k {l} {m}) a | false | false = concat-union-distribl (δ k a)
+        ≅δ (concat-union-distribl k {l} {m}) a | false | true = begin
+              (if false ∨ true then (δ k a ∪ δ l a) · m ∪ δ m a else (δ k a ∪ δ l a) · m)
+           ≈⟨ ≅refl ⟩
+              ((δ k a ∪ δ l a) · m ) ∪ δ m a
+           ≈⟨ union-congl (concat-union-distribl _) ⟩
+               (δ k a · m ∪ δ l a · m) ∪ δ m a
+           ≈⟨ union-assoc _ ⟩
+              (δ k a · m) ∪ ( δ l a · m ∪ δ m a )
+           ≈⟨ ≅refl ⟩
+              (if false then δ k a · m ∪ δ m a else δ k a · m) ∪ (if true then δ l a · m ∪ δ m a else δ l a · m)
+           ∎
+               where open EqR (Bis _)
+        ≅δ (concat-union-distribl k {l} {m}) a | true | false = begin
+               (if true ∨ false then (δ k a ∪ δ l a) · m ∪ δ m a else (δ k a ∪ δ l a) · m) ≈⟨ ≅refl ⟩
+               ((δ k a ∪ δ l a) · m ) ∪ δ m a ≈⟨ union-congl (concat-union-distribl _) ⟩
+               (δ k a · m ∪ δ l a · m) ∪ δ m a ≈⟨  union-assoc _ ⟩
+                δ k a · m ∪ ( δ l a · m ∪ δ m a ) ≈⟨  union-congr ( union-comm   _ _) ⟩
+                δ k a · m ∪ δ m a ∪ δ l a · m ≈⟨ ≅sym ( union-assoc  _  ) ⟩
+               (δ k a · m ∪ δ m a) ∪ δ l a · m ≈⟨ ≅refl ⟩
+               ((if true then δ k a · m ∪ δ m a else δ k a · m) ∪ (if false then δ l a · m ∪ δ m a else δ l a · m))
+           ∎
+               where open EqR (Bis _)
+        ≅δ (concat-union-distribl k {l} {m}) a | true | true = begin
+               (if true ∨ true then (δ k a ∪ δ l a) · m ∪ δ m a else (δ k a ∪ δ l a) · m) ≈⟨ ≅refl ⟩
+               (δ k a ∪ δ l a) · m ∪ δ m a ≈⟨ union-congl ( concat-union-distribl _ ) ⟩
+               (δ k a · m ∪ δ l a · m) ∪ δ m a ≈⟨  union-assoc _ ⟩
+                δ k a · m ∪ ( δ l a · m ∪ δ m a ) ≈⟨ ≅sym ( union-congr ( union-congr (  union-idem _ ) ) ) ⟩
+                δ k a · m ∪ ( δ l a · m ∪ (δ m a  ∪ δ m a) ) ≈⟨  ≅sym ( union-congr ( union-assoc _ )) ⟩
+                δ k a · m ∪ ( (δ l a · m ∪ δ m a  ) ∪ δ m a ) ≈⟨   union-congr (  union-congl  ( union-comm _  _) )   ⟩
+                δ k a · m ∪ ( (δ m a  ∪ δ l a · m ) ∪ δ m a ) ≈⟨  ≅sym ( union-assoc  _  ) ⟩
+               ( δ k a · m ∪  (δ m a  ∪ δ l a · m )) ∪ δ m a ≈⟨  ≅sym ( union-congl ( union-assoc _  ) ) ⟩
+               ((δ k a · m ∪ δ m a) ∪ δ l a · m) ∪ δ m a ≈⟨  union-assoc _  ⟩
+               (δ k a · m ∪ δ m a) ∪ δ l a · m ∪ δ m a ≈⟨ ≅refl ⟩
+               ((if true then δ k a · m ∪ δ m a else δ k a · m) ∪ (if true then δ l a · m ∪ δ m a else δ l a · m))
+           ∎
+               where open EqR (Bis _)
+
+        postulate
+                concat-emptyl : ∀{i} l → ∅ · l ≅⟨ i ⟩≅ ∅
+                concat-emptyr : ∀{i} l → l · ∅ ≅⟨ i ⟩≅ ∅
+                concat-unitl : ∀{i} l → ε · l ≅⟨ i ⟩≅ l
+                concat-unitr : ∀{i} l → l · ε ≅⟨ i ⟩≅ l
+                star-empty : ∀{i} → ∅ * ≅⟨ i ⟩≅ ε
+
+        concat-congl : ∀{i} {m l k : Lang ∞} → l ≅⟨ i ⟩≅ k → l · m ≅⟨ i ⟩≅ k · m
+        ≅ν (concat-congl {i} {m} p ) =  cong (λ x →  x ∧  ( ν m ))  ( ≅ν p )
+        ≅δ (concat-congl {i} {m} {l} {k} p ) a with ν k | ν l | ≅ν p
+        ≅δ (concat-congl {i} {m} {l} {k} p) a | false | false | refl = concat-congl (≅δ p a)
+        ≅δ (concat-congl {i} {m} {l} {k} p) a | true | true | refl = union-congl (concat-congl (≅δ p a)) 
+
+        concat-congr : ∀{i} {m l k : Lang ∞} → l ≅⟨ i ⟩≅ k → m · l ≅⟨ i ⟩≅ m · k
+        ≅ν (concat-congr {i} {m} {_} {k} p ) =  cong (λ x →  ( ν m ) ∧ x )  ( ≅ν p )
+        ≅δ (concat-congr {i} {m} {l} {k} p ) a with ν m | ν k | ν l | ≅ν p
+        ≅δ (concat-congr {i} {m} {l} {k} p) a | false | x | .x | refl = concat-congr p
+        ≅δ (concat-congr {i} {m} {l} {k} p) a | true | x | .x | refl = union-cong (concat-congr p ) ( ≅δ p a )
+
+        concat-assoc : ∀{i} (k {l m} : Lang ∞) → (k · l) · m ≅⟨ i ⟩≅ k · (l · m)
+        ≅ν (concat-assoc {i} k {l} {m} ) =  ∧-assoc ( ν k ) ( ν l ) ( ν m )
+        ≅δ (concat-assoc {i} k {l} {m} ) a with  ν k 
+        ≅δ (concat-assoc {i} k {l} {m}) a | false  = concat-assoc _
+        ≅δ (concat-assoc {i} k {l} {m}) a | true  with ν l
+        ≅δ (concat-assoc {i} k {l} {m}) a | true | false =  begin
+             ( if false then (δ k a · l ∪ δ l a) · m ∪ δ m a else (δ k a · l ∪ δ l a) · m )
+          ≈⟨ ≅refl  ⟩
+            (δ k a · l ∪ δ l a) · m
+          ≈⟨ concat-union-distribl _ ⟩
+            ((δ k a · l) · m ) ∪ ( δ l a · m )
+          ≈⟨ union-congl (concat-assoc _) ⟩
+             (δ k a · l · m ) ∪ ( δ l a · m )
+          ≈⟨ ≅refl  ⟩
+             δ k a · l · m ∪ (if false then δ l a · m ∪ δ m a else δ l a · m)
+           ∎ where open EqR (Bis _)
+        ≅δ (concat-assoc {i} k {l} {m}) a | true | true = begin
+             (if true then (δ k a · l ∪ δ l a) · m ∪ δ m a else (δ k a · l ∪ δ l a) · m)
+          ≈⟨ ≅refl  ⟩
+             ((( δ k a · l ) ∪ δ l a) · m ) ∪ δ m a
+          ≈⟨ union-congl (concat-union-distribl _   ) ⟩
+             ((δ k a · l) · m   ∪ ( δ l a · m )) ∪ δ m a
+          ≈⟨  union-congl (  union-congl (concat-assoc _))   ⟩
+             (( δ k a · l · m ) ∪ ( δ l a · m )) ∪ δ m a 
+          ≈⟨ union-assoc _ ⟩
+             ( δ k a · l · m ) ∪ ( ( δ l a · m ) ∪ δ m a )
+          ≈⟨ ≅refl  ⟩
+             δ k a · l · m ∪ (if true then δ l a · m ∪ δ m a else δ l a · m)
+           ∎ where open EqR (Bis _)
+
+        star-concat-idem : ∀{i} (l : Lang ∞) → l * · l * ≅⟨ i ⟩≅ l *
+        ≅ν (star-concat-idem l) = refl
+        ≅δ (star-concat-idem l) a = begin
+               δ ((l *) · (l *)) a ≈⟨ union-congl (concat-assoc _) ⟩
+               δ l a · (l * · l *) ∪ δ l a · l * ≈⟨ union-congl (concat-congr (star-concat-idem _)) ⟩
+               δ l a · l * ∪ δ l a · l * ≈⟨ union-idem _ ⟩
+               δ (l *) a ∎ where open EqR (Bis _)
+
+        star-idem : ∀{i} (l : Lang ∞) → (l *) * ≅⟨ i ⟩≅ l *
+        ≅ν (star-idem l) = refl
+        ≅δ (star-idem l) a = begin
+                  δ ((l *) *) a  ≈⟨ concat-assoc (δ l a)  ⟩
+                  δ l a · ((l *) · ((l *) *)) ≈⟨ concat-congr ( concat-congr (star-idem l )) ⟩
+                  δ l a · ((l *) · (l *)) ≈⟨  concat-congr (star-concat-idem l ) ⟩
+                  δ l a · l *
+                ∎ where open EqR (Bis _)
+
+        postulate
+           star-rec : ∀{i} (l : Lang ∞) → l * ≅⟨ i ⟩≅ ε ∪ (l · l *)
+
+        star-from-rec : ∀{i} (k {l m} : Lang ∞)
+                → ν k ≡ false
+                → l ≅⟨ i ⟩≅ k · l ∪ m
+                → l ≅⟨ i ⟩≅ k * · m
+        ≅ν (star-from-rec k n p) with ≅ν p
+        ... | b rewrite n = b
+        ≅δ (star-from-rec k {l} {m} n p) a with ≅δ p a
+        ... | q rewrite n = begin
+                   (δ l a)
+                ≈⟨ q ⟩
+                   δ k a · l ∪ δ m a
+                ≈⟨ union-congl (concat-congr (star-from-rec k {l} {m} n p))  ⟩
+                   (δ k a · (k * · m) ∪ δ m a)
+                ≈⟨ union-congl (≅sym (concat-assoc _)) ⟩
+                    (δ k a · (k *)) · m ∪ δ m a
+                ∎ where open EqR (Bis _)
+
+
+open List
+
+record DA (S : Set) : Set where
+    field ν : (s : S) → Bool
+          δ : (s : S)(a : A) → S
+    νs : ∀{i} (ss : List.List i S) → Bool
+    νs ss = List.any ν ss
+    δs : ∀{i} (ss : List.List i S) (a : A) → List.List i S
+    δs ss a = List.map (λ s → δ s a) ss
+
+open Lang 
+
+lang : ∀{i} {S} (da : DA S) (s : S) → Lang i
+Lang.ν (lang da s) = DA.ν da s
+Lang.δ (lang da s) a = lang da (DA.δ da s a)
+
+open import Data.Unit hiding ( _≟_ )
+
+open DA
+
+∅A : DA ⊤
+ν ∅A s = false
+δ ∅A s a = s
+
+εA : DA Bool
+ν εA b  = b
+δ εA b a = false
+
+open import Relation.Nullary.Decidable
+
+data 3States : Set where
+   init acc err : 3States
+
+charA : (a : A) → DA 3States
+ν (charA a) init = false
+ν (charA a) acc = true
+ν (charA a) err = false
+δ (charA a) init x =
+  if ⌊ a ≟  x ⌋ then acc else err
+δ (charA a) acc x = err
+δ (charA a) err x = err
+
+
+complA : ∀{S} (da : DA S) → DA S
+ν (complA da) s = not (ν da s)
+δ (complA da) s a = δ da s a
+
+open import Data.Product
+
+_⊕_ : ∀{S1 S2} (da1 : DA S1) (da2 : DA S2) → DA (S1 × S2)
+ν (da1 ⊕ da2) (s1 , s2) = ν da1 s1 ∨ ν da2 s2
+δ (da1 ⊕ da2) (s1 , s2) a = δ da1 s1 a , δ da2 s2 a
+
+powA : ∀{S} (da : DA S) → DA (List ∞ S)
+ν (powA da) ss = νs da ss
+δ (powA da) ss a = δs da ss a
+
+open _≅⟨_⟩≅_ 
+
+powA-nil : ∀{i S} (da : DA S) → lang (powA da) [] ≅⟨ i ⟩≅ ∅
+≅ν (powA-nil da) = refl
+≅δ (powA-nil da) a = powA-nil da
+
+powA-cons : ∀{i S} (da : DA S) {s : S} {ss : List ∞ S} →
+        lang (powA da) (s ∷ ss) ≅⟨ i ⟩≅ lang da s ∪ lang (powA da) ss
+≅ν (powA-cons da) = refl
+≅δ (powA-cons da) a = powA-cons da
+
+composeA : ∀{S1 S2} (da1 : DA S1)(s2 : S2)(da2 : DA S2) → DA (S1 × List ∞ S2)
+ν (composeA da1 s2 da2) (s1 , ss2) = (ν da1 s1 ∧ ν da2 s2) ∨ νs da2 ss2
+δ (composeA da1 s2 da2) (s1 , ss2) a =
+        δ da1 s1 a , δs da2 (if ν da1 s1 then s2 ∷ ss2 else ss2) a
+
+import Relation.Binary.EqReasoning as EqR
+
+composeA-gen : ∀{i S1 S2} (da1 : DA S1) (da2 : DA S2) → ∀(s1 : S1)(s2 : S2)(ss : List ∞ S2) →
+        lang (composeA da1 s2 da2) (s1 , ss) ≅⟨ i ⟩≅ lang da1 s1 · lang da2 s2 ∪ lang (powA da2) ss
+≅ν (composeA-gen da1 da2 s1 s2 ss) = refl
+≅δ (composeA-gen da1 da2 s1 s2 ss) a with ν da1 s1
+... | false = composeA-gen da1 da2 (δ da1 s1 a) s2 (δs da2 ss a)
+... | true = begin
+       lang (composeA da1 s2 da2) (δ da1 s1 a , δ da2 s2 a ∷ δs da2 ss a)
+   ≈⟨ composeA-gen da1 da2 (δ da1 s1 a) s2 (δs da2 (s2 ∷ ss) a) ⟩
+       lang da1 (δ da1 s1 a) · lang da2 s2 ∪ lang (powA da2) (δs da2 (s2 ∷ ss) a)
+   ≈⟨ union-congr (powA-cons da2)  ⟩ 
+       lang da1 (δ da1 s1 a) · lang da2 s2 ∪
+          (lang da2 (δ da2 s2 a) ∪ lang (powA da2) (δs da2 ss a))
+   ≈⟨ ≅sym  (union-assoc _)  ⟩
+       (lang da1 (δ da1 s1 a) · lang da2 s2 ∪ lang da2 (δ da2 s2 a)) ∪ lang (powA da2) (δs da2 ss a)
+   ∎ where open EqR (Bis _)
+
+postulate
+  composeA-correct : ∀{i S1 S2} (da1 : DA S1) (da2 : DA S2) s1 s2 →
+     lang (composeA da1 s2 da2) (s1 , []) ≅⟨ i ⟩≅ lang da1 s1 · lang da2 s2
+
+
+open import Data.Maybe
+
+acceptingInitial : ∀{S} (s0 : S) (da : DA S) → DA (Maybe S)
+ν (acceptingInitial s0 da) (just s) = ν da s
+δ (acceptingInitial s0 da) (just s) a = just (δ da s a)
+ν (acceptingInitial s0 da) nothing = true
+δ (acceptingInitial s0 da) nothing a = just (δ da s0 a)
+
+
+
+finalToInitial : ∀{S} (da : DA (Maybe S)) → DA (List ∞ (Maybe S))
+ν (finalToInitial da) ss = νs da ss
+δ (finalToInitial da) ss a =
+        let ss′ = δs da ss a
+        in if νs da ss then δ da nothing a ∷ ss′ else ss′
+
+
+starA : ∀{S}(s0 : S)(da : DA S) → DA (List ∞(Maybe S))
+starA s0 da = finalToInitial (acceptingInitial s0 da)
+
+
+postulate
+ acceptingInitial-just : ∀{i S} (s0 : S) (da : DA S) {s : S} →
+   lang (acceptingInitial s0 da) (just s) ≅⟨ i ⟩≅ lang da s
+ acceptingInitial-nothing : ∀{i S} (s0 : S) (da : DA S) →
+        lang (acceptingInitial s0 da) nothing ≅⟨ i ⟩≅ ε ∪ lang da s0
+ starA-lemma : ∀{i S}(da : DA S)(s0 : S)(ss : List ∞ (Maybe S))→
+        lang (starA s0 da) ss ≅⟨ i ⟩≅ 
+                lang (powA (acceptingInitial s0 da)) ss · (lang da s0) *
+ starA-correct : ∀{i S} (da : DA S) (s0 : S) →
+   lang (starA s0 da) (nothing ∷ []) ≅⟨ i ⟩≅ (lang da s0) *
+
+record NAutomaton ( Q : Set ) ( Σ : Set  )
+           : Set  where
+        field
+              Nδ : Q → Σ → Q → Bool
+              Nstart : Q → Bool
+              Nend  :  Q → Bool
+
+postulate
+   exists : { S : Set} → ( S → Bool ) → Bool
+
+nlang : ∀{i} {S} (nfa : NAutomaton S A ) (s : S → Bool ) → Lang i
+Lang.ν (nlang nfa s) = exists ( λ x → (s x ∧ NAutomaton.Nend nfa x ))
+Lang.δ (nlang nfa s) a = nlang nfa (λ x → s x ∧ (NAutomaton.Nδ nfa x a) x) 
+
+nlang1 : ∀{i} {S} (nfa : NAutomaton S A ) (s : S → Bool ) → Lang i
+Lang.ν (nlang1 nfa s) = NAutomaton.Nend nfa  {!!}
+Lang.δ (nlang1 nfa s) a = nlang1 nfa (λ x → s x ∧ (NAutomaton.Nδ nfa x a) x) 
+
+-- nlang' : ∀{i} {S} (nfa : DA (S → Bool) ) (s : S → Bool ) → Lang i
+-- Lang.ν (nlang' nfa s) = DA.ν nfa  s
+-- Lang.δ (nlang' nfa s) a = nlang' nfa (DA.δ nfa s a)
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/automaton-in-agda/src/gcd.agda	Sun Jun 13 20:45:17 2021 +0900
@@ -0,0 +1,217 @@
+{-# OPTIONS --allow-unsolved-metas #-}
+module gcd 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
+
+record Factor (n m : ℕ ) : Set where
+   field 
+      factor : ℕ
+      remain : ℕ
+      is-factor : factor * n + remain ≡ m
+
+record Dividable (n m : ℕ ) : Set where
+   field 
+      factor : ℕ
+      is-factor : factor * n + 0 ≡ m 
+
+open Factor
+
+open ≡-Reasoning
+
+decf : { n k : ℕ } → ( x : Factor k (suc n) ) → Factor k n
+decf {n} {k} x with remain x
+... | zero = record { factor = factor x ; remain = k ; is-factor = {!!} }
+... | suc r = record { factor = factor x ; remain = r ; is-factor = {!!} }
+
+ifk0 : (  i0 k : ℕ ) → (i0f : Factor k i0 )  → ( i0=0 : remain i0f ≡ 0 )  → factor i0f * k + 0 ≡ i0
+ifk0 i0 k i0f i0=0 = begin
+   factor i0f * k + 0  ≡⟨ cong (λ m → factor i0f * k + m) (sym i0=0)  ⟩
+   factor i0f * k + remain i0f  ≡⟨ is-factor i0f ⟩
+   i0 ∎ 
+
+ifzero : {k : ℕ } → (jf :  Factor k zero ) →  remain jf ≡ 0
+ifzero = {!!}
+
+gcd1 : ( i i0 j j0 : ℕ ) → ℕ
+gcd1 zero i0 zero j0 with <-cmp i0 j0
+... | tri< a ¬b ¬c = i0
+... | tri≈ ¬a refl ¬c = i0
+... | tri> ¬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<sa
+gcd52 {suc i} = <-trans (gcd52 {i}) a<sa
+
+gcd50 : (i i0 j j0 : ℕ) → 1 < i0 → i ≤ i0 → j ≤ j0 →  gcd1 i i0 j j0 ≤ i0 
+gcd50 zero i0 zero j0 0<i i<i0 j<j0 with <-cmp i0 j0
+... | tri< a ¬b ¬c = ≤-refl    
+... | tri≈ ¬a refl ¬c =  ≤-refl 
+... | tri> ¬a ¬b c = ≤-trans refl-≤s c  
+gcd50 zero (suc i0) (suc zero) j0 0<i i<i0 j<j0 = gcd51 0<i where 
+   gcd51 : 1 < suc i0 → gcd1 zero (suc i0) 1 j0 ≤ suc i0
+   gcd51 1<i = ≤to< 1<i
+gcd50 zero (suc i0) (suc (suc j)) j0 0<i i<i0 j<j0 = gcd50 i0 (suc i0) (suc j) (suc (suc j)) 0<i refl-≤s refl-≤s
+gcd50 (suc zero) i0 zero j0 0<i i<i0 j<j0 = ≤to< 0<i
+gcd50 (suc (suc i)) i0 zero zero 0<i i<i0 j<j0 = ≤-refl
+gcd50 (suc (suc i)) i0 zero (suc j0) 0<i i<i0 j<j0 = ≤-trans (gcd50 (suc i) (suc (suc i))  j0 (suc j0) gcd52  refl-≤s refl-≤s) i<i0
+gcd50 (suc i) i0 (suc j) j0 0<i i<i0 j<j0 = subst (λ k → k ≤ i0 ) (sym (gcd22 i i0 j j0))
+   (gcd50 i i0 j j0 0<i (≤-trans refl-≤s i<i0) (≤-trans refl-≤s j<j0)) 
+
+gcd5 : ( n k : ℕ ) → 1 < n → gcd n k ≤ n
+gcd5 n k 0<n = gcd50 n n k k 0<n ≤-refl ≤-refl 
+
+gcd6 : ( n k : ℕ ) → 1 < n → gcd k n ≤ n
+gcd6 n k 1<n = subst (λ m → m ≤ n) (gcdsym {n} {k}) (gcd5 n k 1<n)
+
+gcd4 : ( n k : ℕ ) → 1 < n  → gcd n k ≡ k → k ≤ n
+gcd4 n k 1<n eq = subst (λ m → m ≤ n ) eq (gcd5 n k 1<n)
+
+gcdmul+1 : ( m n : ℕ ) → gcd (m * n + 1) n ≡ 1
+gcdmul+1 zero n = gcd204 n
+gcdmul+1 (suc m) n = begin
+      gcd (suc m * n + 1) n ≡⟨⟩
+      gcd (n + m * n + 1) n ≡⟨ cong (λ k → gcd k n ) (begin
+         n + m * n + 1 ≡⟨ cong (λ k → k + 1) (+-comm n _) ⟩
+         m * n + n + 1 ≡⟨ +-assoc (m * n) _ _ ⟩
+         m * n + (n + 1)  ≡⟨ cong (λ k → m * n + k) (+-comm n _) ⟩
+         m * n + (1 + n)  ≡⟨ sym ( +-assoc (m * n) _ _ ) ⟩
+         m * n + 1 + n ∎ 
+       ) ⟩
+      gcd (m * n + 1 + n) n ≡⟨ gcd2 (m * n + 1) n ⟩
+      gcd (m * n + 1) n ≡⟨ gcdmul+1 m n ⟩
+      1 ∎ where open ≡-Reasoning
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/automaton-in-agda/src/halt.agda	Sun Jun 13 20:45:17 2021 +0900
@@ -0,0 +1,114 @@
+module halt 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 HBijection {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 
+--  normal bijection required below, but we don't need this to show the inconsistency
+--     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 HBijection 
+
+diag : {S : Set }  (b : HBijection  ( S → Bool ) S) → S → Bool
+diag b n = not (fun← b n n)
+
+diagonal : { S : Set } → ¬ HBijection  ( 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
+
+record TM : Set where
+   field
+      tm : List Bool → Maybe Bool
+
+open TM
+
+record UTM : Set where
+   field
+      utm : TM
+      encode : TM → List Bool
+      is-tm : (t : TM) → (x : List Bool) → tm utm (encode t ++ x ) ≡ tm t x
+
+open UTM 
+
+open _∧_
+
+open import Axiom.Extensionality.Propositional
+postulate f-extensionality : { n : Level}  → Axiom.Extensionality.Propositional.Extensionality n n 
+
+record Halt : Set where
+   field
+      halt :  (t : TM ) → (x : List Bool ) → Bool
+      is-halt :     (t : TM ) → (x : List Bool ) → (halt t x ≡ true )  ⇔ ( (just true ≡ tm t x ) ∨ (just false ≡ tm t x ) )
+      is-not-halt : (t : TM ) → (x : List Bool ) → (halt t x ≡ false ) ⇔ ( nothing ≡ tm t x )
+
+open Halt
+
+TNL : (halt : Halt ) → (utm : UTM) → HBijection (List Bool → Bool) (List Bool)
+TNL halt utm = record {
+       fun←  = λ tm x → Halt.halt halt (UTM.utm utm) (tm ++ x)
+     ; fun→  = λ h  → encode utm record { tm = h1 h } 
+     ; fiso← = λ h →  f-extensionality (λ y → TN1 h y )
+  } where
+     open ≡-Reasoning
+     h1 : (h : List Bool → Bool) → (x : List Bool ) → Maybe Bool
+     h1 h x with h x
+     ... | true =  just true
+     ... | false = nothing
+     tenc : (h : List Bool → Bool) → (y : List Bool) → List Bool
+     tenc h y = encode utm (record { tm = λ x → h1 h x }) ++ y
+     h-nothing : (h : List Bool → Bool) → (y : List Bool) → h y ≡ false → h1 h y ≡ nothing
+     h-nothing h y eq with h y
+     h-nothing h y refl | false = refl
+     h-just : (h : List Bool → Bool) → (y : List Bool) → h y ≡ true → h1 h y ≡ just true
+     h-just h y eq with h y
+     h-just h y refl | true = refl
+     TN1 :  (h : List Bool → Bool) → (y : List Bool ) → Halt.halt halt (UTM.utm utm) (tenc h y) ≡ h y
+     TN1 h y with h y | inspect h y
+     ... | true  | record { eq = eq1 } = begin
+        Halt.halt halt (UTM.utm utm)  (tenc h y) ≡⟨ proj2 (is-halt halt (UTM.utm utm) (tenc h y) ) (case1 (sym tm-tenc)) ⟩
+        true ∎  where
+          tm-tenc :  tm (UTM.utm utm) (tenc h y) ≡ just true
+          tm-tenc = begin
+              tm (UTM.utm utm) (tenc h y)  ≡⟨  is-tm utm _ y ⟩
+              h1 h y ≡⟨ h-just h y eq1  ⟩
+              just true  ∎  
+     ... | false | record { eq = eq1 } = begin
+        Halt.halt halt (UTM.utm utm)  (tenc h y) ≡⟨ proj2 (is-not-halt halt (UTM.utm utm) (tenc h y) ) (sym tm-tenc) ⟩
+        false ∎  where
+          tm-tenc :  tm (UTM.utm utm) (tenc h y) ≡ nothing
+          tm-tenc = begin
+              tm (UTM.utm utm) (tenc h y)  ≡⟨  is-tm utm _ y ⟩
+              h1 h y ≡⟨  h-nothing h y eq1 ⟩
+              nothing  ∎  
+     -- the rest of bijection means encoding is unique
+     -- fiso→ :  (y : List Bool ) → encode utm record { tm = λ x →  h1 (λ tm → Halt.halt halt (UTM.utm utm) tm  ) x } ≡ y
+          
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/automaton-in-agda/src/index.ind	Sun Jun 13 20:45:17 2021 +0900
@@ -0,0 +1,31 @@
+--title: list
+<a href=FSetUtil.agda> FSetUtil.agda </a><br>
+<a href=automaton-ex.agda> automaton-ex.agda </a><br>
+<a href=automaton.agda> automaton.agda </a><br>
+<a href=cfg.agda> cfg.agda </a><br>
+<a href=cfg1.agda> cfg1.agda </a><br>
+<a href=chap0.agda> chap0.agda </a><br>
+<a href=derive.agda> derive.agda </a><br>
+<a href=even.agda> even.agda </a><br>
+<a href=finiteSet.agda> finiteSet.agda </a><br>
+<a href=flcagl.agda> flcagl.agda </a><br>
+<a href=gcd.agda> gcd.agda </a><br>
+<a href=halt.agda> halt.agda </a><br>
+<a href=induction-ex.agda> induction-ex.agda </a><br>
+<a href=lang-text.agda> lang-text.agda </a><br>
+<a href=logic.agda> logic.agda </a><br>
+<a href=nat.agda> nat.agda </a><br>
+<a href=nfa.agda> nfa.agda </a><br>
+<a href=nfa136.agda> nfa136.agda </a><br>
+<a href=non-regular.agda> non-regular.agda </a><br>
+<a href=omega-automaton.agda> omega-automaton.agda </a><br>
+<a href=pushdown.agda> pushdown.agda </a><br>
+<a href=puzzle.agda> puzzle.agda </a><br>
+<a href=regex.agda> regex.agda </a><br>
+<a href=regex1.agda> regex1.agda </a><br>
+<a href=regular-concat.agda> regular-concat.agda </a><br>
+<a href=regular-language.agda> regular-language.agda </a><br>
+<a href=root2.agda> root2.agda </a><br>
+<a href=sbconst2.agda> sbconst2.agda </a><br>
+<a href=turing.agda> turing.agda </a><br>
+<a href=utm.agda> utm.agda </a><br>
--- /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
+
--- /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 = {!!}
--- /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
+
+
--- /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 ∷ [] ) 
+
--- /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)
--- /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 = {!!}
+
--- /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 = {!!}
+
+
+
+
+
+
+
--- /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 → ⊥-elim (nat-≤>  n≤j j<n ) ) where
+    np1 : ( m : ℕ ) → ( (j : ℕ ) → m ≤ j → j < n → gcd n j ≡ 1  ) → NonPrime n
+    np1 zero mg = ⊥-elim ( np record { isPrime = λ j lt → mg j z≤n lt } ) -- zero < j , j < n
+    np1 (suc m) mg with <-cmp ( gcd n (suc m) ) 1
+    ... | tri< a ¬b ¬c = {!!}
+    ... | tri≈ ¬a b ¬c = np1 m {!!}
+    ... | tri> ¬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 = {!!}
--- /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 = {!!}
--- /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
--- /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 _&_ _||_
+
+
+
--- /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 ∷ [])
+
--- /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
+
+
+
+
--- /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))
+
--- /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<sa lt 
+    rot1 : even ( m * m )
+    rot1 = subst (λ k → even k ) rot4 (n*even {n * n} {2} tt ) where
+       rot4 : (n * n) * 2 ≡ m * m  
+       rot4 = begin
+          (n * n) * 2     ≡⟨ *-comm (n * n) 2 ⟩
+          2 * ( n * n )   ≡⟨ sym (*-assoc 2 n n) ⟩
+          2 *  n * n      ≡⟨ 2nm ⟩
+          m * m           ∎ where open ≡-Reasoning
+    E : Even m
+    E = e2 m ( even^2 {m} ( rot1 ))
+    rot2 : 2 * n * n ≡ 2 * Even.j E * m
+    rot2 = subst (λ k → 2 * n * n ≡ k * m ) (Even.is-twice E) 2nm
+    rot3 : n * n ≡ Even.j E * m
+    rot3 = e3 ( begin
+          2 * (n * n)   ≡⟨ sym (*-assoc 2 n _) ⟩
+          2 *  n * n    ≡⟨ rot2 ⟩
+          2 * Even.j E * m ≡⟨  *-assoc 2 (Even.j E)  m  ⟩
+          2 * (Even.j E * m)  ∎ ) where open ≡-Reasoning
+    rot7 : even n  
+    rot7 =  even^2 {n} (subst (λ k → even k) (sym rot3) ((n*even {Even.j E} {m} ( even^2 {m} ( rot1 )))))
+    f2 : Factor 2 n
+    f2 = rot11 rot7
+    fm : Factor 2 m
+    fm = record { factor = Even.j E ; remain = 0 ; is-factor = {!!} }
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/automaton-in-agda/src/sbconst2.agda	Sun Jun 13 20:45:17 2021 +0900
@@ -0,0 +1,55 @@
+module sbconst2 where
+
+open import Level renaming ( suc to succ ; zero to Zero )
+open import Data.Nat
+open import Data.Fin
+open import Data.List
+
+open import automaton
+open import nfa
+open import logic
+open NAutomaton
+open Automaton
+open import  Relation.Binary.PropositionalEquality hiding ( [_] )
+
+open Bool
+
+δconv : { Q : Set } { Σ : Set  } → ( ( Q → Bool ) → Bool ) →  ( nδ : Q → Σ → Q → Bool ) → (f : Q → Bool) → (i : Σ) → (Q → Bool)
+δconv {Q} { Σ} exists nδ f i q =  exists ( λ r → f r /\ nδ r i q )
+
+subset-construction : { Q : Set } { Σ : Set  } → 
+    ( ( Q → Bool ) → Bool ) →
+    (NAutomaton Q  Σ ) → (Automaton (Q → Bool)  Σ )  
+subset-construction {Q} { Σ}  exists NFA = record {
+        δ = λ q x → δconv exists ( Nδ NFA ) q x
+     ;  aend = λ f → exists ( λ q → f q /\ Nend NFA q )
+   } 
+
+test4 = subset-construction existsS1 am2 
+
+test51 = accept test4 start1 ( i0  ∷ i1  ∷ i0  ∷ [] )
+test61 = accept test4 start1 ( i1  ∷ i1  ∷ i1  ∷ [] )
+
+subset-construction-lemma→ : { Q : Set } { Σ : Set  } { n  : ℕ }  → (exists : ( Q → Bool ) → Bool ) →
+    (NFA : NAutomaton Q  Σ ) → (astart : Q → Bool ) 
+    → (x : List Σ)
+    → Naccept NFA exists astart  x ≡ true
+    → accept (  subset-construction exists NFA ) astart  x ≡ true
+subset-construction-lemma→ {Q} {Σ} {n} exists NFA astart x naccept = lemma1 x astart naccept where
+    lemma1 :  (x : List Σ) → ( states : Q → Bool )
+       → Naccept NFA exists states x ≡ true
+       → accept (  subset-construction exists NFA ) states x ≡ true
+    lemma1 [] states naccept = naccept
+    lemma1 (h ∷ t ) states naccept = lemma1 t (δconv exists (Nδ NFA) states h) naccept
+
+subset-construction-lemma← : { Q : Set } { Σ : Set  } { n  : ℕ }  → (exists : ( Q → Bool ) → Bool ) →
+    (NFA : NAutomaton Q  Σ ) → (astart : Q → Bool )
+    → (x : List Σ)
+    → accept (  subset-construction exists NFA ) astart x ≡ true
+    → Naccept NFA exists astart x ≡ true
+subset-construction-lemma← {Q} {Σ} {n} exists NFA astart x saccept = lemma2 x astart saccept where
+    lemma2 :  (x : List Σ) → ( states : Q → Bool )
+       → accept (  subset-construction exists NFA ) states x ≡ true
+       → Naccept NFA exists states x ≡ true
+    lemma2 [] states saccept = saccept
+    lemma2 (h ∷ t ) states saccept = lemma2 t (δconv exists (Nδ NFA) states h) saccept
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/automaton-in-agda/src/turing.agda	Sun Jun 13 20:45:17 2021 +0900
@@ -0,0 +1,129 @@
+{-# OPTIONS --allow-unsolved-metas #-}
+module turing where
+
+open import Level renaming ( suc to succ ; zero to Zero )
+open import Data.Nat -- hiding ( erase )
+open import Data.List
+open import Data.Maybe hiding ( map )
+open import Data.Bool using ( Bool ; true ; false ) renaming ( not to negate )
+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 hiding ( map )
+
+
+data Write   (  Σ : Set  ) : Set  where
+   write   : Σ → Write  Σ
+   wnone   : Write  Σ
+   --   erase write tnone
+
+data Move : Set  where
+   left   : Move  
+   right  : Move  
+   mnone  : Move  
+
+-- at tδ both stack is poped
+
+-- write S      push S  , push SR
+-- erase        push SL , push tone 
+-- none         push SL , push SR 
+-- left         push SR , pop      
+-- right        pop     , push SL      
+
+{-# TERMINATING #-}
+move : {Q Σ : Set } → { tnone : Σ} → {tδ : Q →  Σ → Q × ( Write  Σ ) ×  Move } → (q : Q ) ( L : List  Σ ) ( L : List   Σ ) → ( Q × List  Σ × List  Σ )
+move {Q} {Σ} {tnone} {tδ} q L [] = move {Q} {Σ} {tnone} {tδ} q  L  ( tnone  ∷ [] ) 
+move {Q} {Σ} {tnone} {tδ} q [] R = move {Q} {Σ} {tnone} {tδ} q  ( tnone  ∷ [] )  R 
+move {Q} {Σ} {tnone} {tδ} q ( LH  ∷ LT ) ( RH ∷ RT ) with  tδ q LH  
+... | nq , write x , left  = ( nq , ( RH ∷ x  ∷ LT ) , RT )
+... | nq , write x , right = ( nq , LT , ( x  ∷ RH  ∷ RT ) )
+... | nq , write x , mnone = ( nq , ( x  ∷ LT ) , (  RH ∷ RT ) )
+... | nq , wnone , left    = ( nq , ( RH  ∷ LH  ∷ LT ) , RT  )
+... | nq , wnone , right   = ( nq ,  LT , ( LH  ∷ RH  ∷ RT ) )
+... | nq , wnone , mnone   = ( nq , ( LH  ∷ LT ) , (  RH ∷ RT )  )
+{-# TERMINATING #-}
+move-loop : {Q Σ : Set } → {tend :  Q → Bool}  → { tnone : Σ} → {tδ : Q →  Σ → Q × ( Write  Σ ) ×  Move }
+    → (q : Q ) ( L : List  Σ ) ( L : List   Σ ) → ( Q × List  Σ × List  Σ )
+move-loop {Q} {Σ} {tend} {tnone} {tδ}  q L R with tend q
+... | true = ( q , L , R )
+... | flase = move-loop {Q} {Σ} {tend} {tnone} {tδ} ( proj₁ next ) ( proj₁ ( proj₂ next ) )  ( proj₂  ( proj₂ next ) )
+        where
+        next = move {Q} {Σ} {tnone} {tδ} q  L  R 
+
+{-# TERMINATING #-}
+move0 : {Q Σ : Set } ( tend : Q → Bool ) (tnone : Σ ) (tδ : Q →  Σ → Q × ( Write  Σ ) ×  Move)
+   (q : Q ) ( L : List  Σ ) ( L : List   Σ ) → ( Q × List  Σ × List  Σ )
+move0 tend tnone tδ  q L R with tend q
+... | true = ( q , L , R )
+move0 tend tnone tδ  q L [] | false = move0 tend tnone tδ  q  L  ( tnone  ∷ [] ) 
+move0 tend tnone tδ  q [] R | false = move0 tend tnone tδ  q  ( tnone  ∷ [] )  R 
+move0 tend tnone tδ  q ( LH  ∷ LT ) ( RH ∷ RT ) | false with  tδ q LH  
+... | nq , write x , left  = move0 tend tnone tδ  nq ( RH ∷ x  ∷ LT ) RT 
+... | nq , write x , right = move0 tend tnone tδ  nq LT ( x  ∷ RH  ∷ RT ) 
+... | nq , write x , mnone = move0 tend tnone tδ  nq ( x  ∷ LT ) (  RH ∷ RT ) 
+... | nq , wnone , left    = move0 tend tnone tδ  nq ( RH  ∷ LH  ∷ LT ) RT  
+... | nq , wnone , right   = move0 tend tnone tδ  nq  LT ( LH  ∷ RH  ∷ RT ) 
+... | nq , wnone , mnone   = move0 tend tnone tδ  nq ( LH  ∷ LT ) (  RH ∷ RT )  
+
+record Turing ( Q : Set ) ( Σ : Set  ) 
+       : Set  where
+    field
+        tδ : Q →  Σ → Q × ( Write  Σ ) ×  Move 
+        tstart : Q
+        tend : Q → Bool
+        tnone :  Σ
+    taccept : List  Σ → ( Q × List  Σ × List  Σ )
+    taccept L = move0 tend tnone tδ tstart L []
+
+data CopyStates : Set where
+   s1 : CopyStates
+   s2 : CopyStates
+   s3 : CopyStates
+   s4 : CopyStates
+   s5 : CopyStates
+   H  : CopyStates
+
+
+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 
+
+copyMachine : Turing CopyStates ℕ
+copyMachine = record {
+        tδ = Copyδ
+     ;  tstart = s1
+     ;  tend = tend
+     ;  tnone =  0
+  } where
+      tend : CopyStates →  Bool
+      tend H = true
+      tend _ = false
+
+test1 : CopyStates × ( List  ℕ ) × ( List  ℕ )
+test1 = Turing.taccept copyMachine  ( 1  ∷ 1  ∷ 0  ∷ 0  ∷  0 ∷ []  )
+
+test2 : ℕ  → CopyStates × ( List  ℕ ) × ( List  ℕ )
+test2 n  = loop n (Turing.tstart copyMachine) ( 1  ∷ 1  ∷ 0  ∷ 0  ∷  0 ∷ []  ) []
+  where
+        loop :  ℕ → CopyStates → ( List  ℕ ) → ( List  ℕ ) → CopyStates × ( List  ℕ ) × ( List  ℕ )
+        loop zero q L R = ( q , L , R )
+        loop (suc n) q L R = loop n ( proj₁ t1 ) ( proj₁ ( proj₂ t1 ) )  ( proj₂  ( proj₂ t1 ) )
+          where
+              t1 = move {CopyStates} {ℕ} {0} {Copyδ} q L R
+
+-- testn = map (\ n -> 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
+
--- /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
+    0 : utmΣ
+    1 : 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  0 = read4 , write 0 , left
+utmδ read3  1 = read5 , write 1 , left
+utmδ read3  b = read6 , write b , left
+utmδ read4  @ = loc0 , write 0 , right
+utmδ read4  x = read4 , write x , left
+utmδ read5  @ = loc0 , write 1 , right
+utmδ read5  x = read5 , write x , left
+utmδ read6  @ = loc0 , write B , right
+utmδ read6  x = read6 , write x , left
+utmδ loc0  0 = loc0 , write X , left
+utmδ loc0  1 = 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 0 , right
+utmδ loc1  Y = loc3 , write 1 , right
+utmδ loc1  Z = loc4 , write B , right
+utmδ loc1  * = fetch0 , write * , right
+utmδ loc1  x = loc1 , write x , right
+utmδ loc2  0 = loc5 , write X , right
+utmδ loc2  1 = loc6 , write Y , right
+utmδ loc2  B = loc6 , write Z , right
+utmδ loc2  x = loc2 , write x , right
+utmδ loc3  1 = loc5 , write Y , right
+utmδ loc3  0 = 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  0 = loc6 , write X , right
+utmδ loc4  1 = 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  0 = fetch1 , write X , left
+utmδ fetch0  1 = 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  0 = fetch7 , write X , right
+utmδ fetch4  1 = 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  0 = fetch7 , write Y , right
+utmδ fetch5  1 = 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  0 = fetch7 , write Z , right
+utmδ fetch6  1 = 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 0 , left
+utmδ print5  x = print7 , write 1 , 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  0 = mov4 , write ^ , right
+utmδ mov2  1 = mov5 , write ^ , right
+utmδ mov2  B = mov6 , write ^ , right
+utmδ mov3  0 = mov4 , write ^ , left
+utmδ mov3  1 = mov5 , write ^ , left
+utmδ mov3  B = mov6 , write ^ , left
+utmδ mov4  ^ = tidy0 , write 0 , left
+utmδ mov5  ^ = tidy0 , write 1 , left
+utmδ mov6  ^ = tidy0 , write B , left
+utmδ tidy0  $ = tidy1 , write $ , left
+utmδ tidy0  x = tidy0 , write x , left
+utmδ tidy1  X = tidy1 , write 0 , left
+utmδ tidy1  Y = tidy1 , write 1 , 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 = 
+       0  ∷ 0  ∷ 1  ∷ 0  ∷  1 ∷ 1 ∷ 0 ∷ 0 ∷ 0 ∷ 0 ∷   -- s1 0  = H    , wnone       , mnone
+  *  ∷ 0  ∷ 0  ∷ 1  ∷ 1  ∷  0 ∷ 1 ∷ 0 ∷ 0 ∷ 0 ∷ 1 ∷   -- s1 1  = s2   , write 0 , right
+  *  ∷ 0  ∷ 1  ∷ 0  ∷ 0  ∷  0 ∷ 1 ∷ 1 ∷ 0 ∷ 0 ∷ 1 ∷   -- s2 0  = s3   , write 0 , right
+  *  ∷ 0  ∷ 1  ∷ 0  ∷ 1  ∷  0 ∷ 1 ∷ 0 ∷ 1 ∷ 0 ∷ 1 ∷   -- s2 1  = s2   , write 1 , right
+  *  ∷ 0  ∷ 1  ∷ 1  ∷ 0  ∷  1 ∷ 0 ∷ 0 ∷ 1 ∷ 0 ∷ 0 ∷   -- s3 0  = s4   , write 1 , left
+  *  ∷ 0  ∷ 1  ∷ 1  ∷ 1  ∷  0 ∷ 1 ∷ 1 ∷ 1 ∷ 0 ∷ 1 ∷   -- s3 1  = s3   , write 1 , right
+  *  ∷ 1  ∷ 0  ∷ 0  ∷ 0  ∷  1 ∷ 0 ∷ 1 ∷ 0 ∷ 0 ∷ 0 ∷   -- s4 0  = s5   , write 0 , left
+  *  ∷ 1  ∷ 0  ∷ 0  ∷ 1  ∷  1 ∷ 0 ∷ 0 ∷ 1 ∷ 0 ∷ 0 ∷   -- s4 1  = s4   , write 1 , left
+  *  ∷ 1  ∷ 0  ∷ 1  ∷ 0  ∷  0 ∷ 0 ∷ 1 ∷ 1 ∷ 0 ∷ 1 ∷   -- s5 0  = s1   , write 1 , right
+  *  ∷ 1  ∷ 0  ∷ 1  ∷ 1  ∷  1 ∷ 0 ∷ 1 ∷ 1 ∷ 0 ∷ 0 ∷   -- s5 1  = s5   , write 1 , left
+  []  
+      
+
+input-encode : List utmΣ
+input-encode =  1  ∷ 1  ∷ 0  ∷ 0  ∷  0 ∷ []  
+
+input+Copyδ : List utmΣ
+input+Copyδ = ( $  ∷ 0  ∷ 0  ∷  0 ∷  0 ∷  * ∷  [] ) -- start state
+        ++   Copyδ-encode
+        ++ ( $ ∷ ^ ∷ input-encode )
+
+short-input : List utmΣ
+short-input = $  ∷ 0  ∷ 0  ∷  0 ∷  * ∷
+    0  ∷ 0  ∷  0 ∷  1  ∷ 0  ∷ 1 ∷ 1  ∷  * ∷
+    0  ∷ 0  ∷  1 ∷  0  ∷ 1  ∷ 1 ∷ 1  ∷  * ∷
+    0  ∷ 1  ∷  B  ∷  1 ∷  0  ∷ 1 ∷ 0  ∷  * ∷
+    1  ∷ 0  ∷  0 ∷  0 ∷  1  ∷ 1 ∷ 1  ∷  $ ∷
+    ^   ∷ 0  ∷  0 ∷  1  ∷ 1 ∷ []  
+
+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Σ} {0} {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