Mercurial > hg > Members > kono > Proof > automaton

changeset 19:e5d67f06aca8

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
turing machine done 15 step / 5 min
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 27 Aug 2018 17:17:00 +0900
parents 6ec8e933ab43
children 6032a2317ffa
files agda/turing.agda
diffstat 1 files changed, 35 insertions(+), 22 deletions(-) [+]
line wrap: on
line diff
--- a/agda/turing.agda	Mon Aug 27 15:05:41 2018 +0900
+++ b/agda/turing.agda	Mon Aug 27 17:17:00 2018 +0900
@@ -38,21 +38,25 @@
         tend : Q → Bool
         tnone :  Σ
     {-# TERMINATING #-}
+    move : (q : Q ) ( L : List  Σ ) ( L : List   Σ ) → ( Q × List  Σ × List  Σ )
+    move q L [] = move q  L  ( tnone  ∷ [] ) 
+    move q [] R = move q  ( tnone  ∷ [] )  R 
+    move 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 : Q ) ( L : List  Σ ) ( L : List   Σ ) → ( Q × List  Σ × List  Σ )
+    move-loop  q L R with tend q
+    ... | true = ( q , L , R )
+    ... | flase = move-loop ( proj₁ next ) ( proj₁ ( proj₂ next ) )  ( proj₂  ( proj₂ next ) )
+      where
+        next = move  q  L  R 
     taccept : List  Σ → ( Q × List  Σ × List  Σ )
-    taccept L = move tstart L []
-           where
-              move : (q : Q ) ( L : List  Σ ) ( L : List   Σ ) → ( Q × List  Σ × List  Σ )
-              move q L R with tend q
-              ... | true = ( q , L , R )
-              move q L [] | false = move q L ( tnone  ∷ [] )
-              move q [] R | false = move q ( tnone  ∷ [] ) R
-              move q ( LH  ∷ LT ) ( RH ∷ RT ) | false with  tδ q LH  
-              ... | nq , write x , left  = move nq ( RH  ∷ x  ∷ LT ) RT
-              ... | nq , write x , right = move nq L ( x  ∷ RH  ∷ RT )
-              ... | nq , write x , mnone = move nq ( x  ∷ LT ) (  RH ∷ RT )
-              ... | nq , wnone , left    = move nq ( LT ) ( LH  ∷  RH ∷ RT ) 
-              ... | nq , wnone , right   = move nq ( RH ∷  LH  ∷ LT ) (  RT ) 
-              ... | nq , wnone , mnone   = move nq ( LH  ∷ LT ) (  RH ∷ RT ) 
+    taccept L = move-loop tstart L []
 
 data CopyStates : Set where
    s1 : CopyStates
@@ -60,21 +64,21 @@
    s3 : CopyStates
    s4 : CopyStates
    s5 : CopyStates
-   H : CopyStates
+   H  : CopyStates
 
 
 Copyδ :  CopyStates →  Bool → CopyStates × ( Write  Bool ) × ( Move  Bool )
 Copyδ s1 false  = (H    , wnone       , mnone )
 Copyδ s1 true   = (s2   , write false , right )
 Copyδ s2 false  = (s3   , write false , right )
-Copyδ s2 true   = (s2   , write true , right )
-Copyδ s3 false  = (s4   , write true , left )
-Copyδ s3 true   = (s3   , write true , right )
+Copyδ s2 true   = (s2   , write true  , right )
+Copyδ s3 false  = (s4   , write true  , left )
+Copyδ s3 true   = (s3   , write true  , right )
 Copyδ s4 false  = (s5   , write false , left )
-Copyδ s4 true   = (s4   , write true , left )
-Copyδ s5 false  = (s1   , write true , right )
-Copyδ s5 true   = (s5   , write true , left )
-Copyδ H  _      = (H    , wnone , mnone )
+Copyδ s4 true   = (s4   , write true  , left )
+Copyδ s5 false  = (s1   , write true  , right )
+Copyδ s5 true   = (s5   , write true  , left )
+Copyδ H  _      = (H    , wnone       , mnone )
 
 copyMachine : Turing CopyStates Bool
 copyMachine = record {
@@ -89,3 +93,12 @@
 
 test1 : CopyStates × ( List  Bool ) × ( List  Bool )
 test1 = Turing.taccept copyMachine  ( true  ∷ true  ∷ false  ∷ false  ∷  false ∷ []  )
+
+test2 : ℕ  → CopyStates × ( List  Bool ) × ( List  Bool )
+test2 n  = loop n (Turing.tstart copyMachine) ( true  ∷ true  ∷ false  ∷ false  ∷  false ∷ []  ) []
+  where
+        loop :  ℕ → CopyStates → ( List  Bool ) → ( List  Bool ) → CopyStates × ( List  Bool ) × ( List  Bool )
+        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 = Turing.move copyMachine q L R