Download code

Jump to: navigation, search

Back to Turing_machine_simulator_(Scheme)

Download for Windows: zip

Download for UNIX: zip, tar.gz, tar.bz2

test_driver.scm

 1 #| The authors of this work have released all rights to it and placed it
 2 in the public domain under the Creative Commons CC0 1.0 waiver
 3 (http://creativecommons.org/publicdomain/zero/1.0/).
 4 
 5 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 6 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 7 MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
 8 IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
 9 CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
10 TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
11 SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
12 
13 Retrieved from: http://en.literateprograms.org/Turing_machine_simulator_(Scheme)?oldid=16652
14 |#
15 
16 (define test-states
17   '(((0 \#) (4 \# right))
18     ((0 a)  (1 \# right))
19     ((4 \#) (5 \# right))
20     ((1 a)  (1 a  right))
21     ((1 b)  (1 b  right))
22     ((1 \#) (2 \# left))
23     ((2 b)  (3 \# left))
24     ((3 a)  (3 a  left))
25     ((3 b)  (3 b  left))
26     ((3 \#) (0 \# right))))
27 
28 (define (test-anbn-trans-func state symbol)
29   (find-trans-state test-states state symbol '\#))
30 
31 (define (anbn-test initial-tape)
32   (simulate initial-tape 0 0 test-anbn-trans-func '(5) '\#))


hijacker
hijacker
hijacker
hijacker

example_output.txt

 1 > (anbn-test '(a b))
 2 v
 3 ab############################################################################
 4  v
 5 #b############################################################################
 6   v
 7 #b############################################################################
 8  v
 9 #b############################################################################
10 v
11 ##############################################################################
12  v
13 ##############################################################################
14   v
15 ##############################################################################
16    v
17 ##############################################################################
18 #t


hijacker
hijacker
hijacker
hijacker

simulate_turing_machine.scm

 1 #| The authors of this work have released all rights to it and placed it
 2 in the public domain under the Creative Commons CC0 1.0 waiver
 3 (http://creativecommons.org/publicdomain/zero/1.0/).
 4 
 5 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 6 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 7 MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
 8 IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
 9 CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
10 TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
11 SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
12 
13 Retrieved from: http://en.literateprograms.org/Turing_machine_simulator_(Scheme)?oldid=16652
14 |#
15 
16 (define trace-tape-chars 78)
17 
18 (define (symbol-at tape position blank-symbol)
19   (cond ((< position 0)              (error "Invalid tape position"))
20         ((>= position (length tape)) blank-symbol)
21         (else                        (list-ref tape position))))
22 (define (write-to-tape tape position symbol)
23   (let ((l (length tape)))
24     (cond ((or (< position 0)
25                (> position l))  (error "Invalid tape position"))
26           ((= position l)       (append tape (list symbol)))
27           (else                 (replace-symbol tape position symbol)@ text
28 ))))
29 (define (replace-symbol tape position symbol)
30   (letrec ((replace-helper (lambda (tape n acc)
31                              (if (= n 0)
32                                (append (reverse acc) (cons symbol (cdr tape)))
33                                (replace-helper (cdr tape) (- n 1) (cons (car tape) acc))))))
34     (replace-helper tape position '())))
35 (define (trace-state tape head-position blank-symbol)
36   (letrec ((print-n-times (lambda (s n)
37                             (when (> n 0)
38                               (display s)
39                               (print-n-times s (- n 1)))))
40            (print-tape (lambda (tape n)
41                          (when (not (or (null? tape)
42                                         (= n 0)))
43                            (display (car tape))
44                            (print-tape (cdr tape) (- n 1))))))
45     (when (< head-position trace-tape-chars)
46       (print-n-times #\space head-position)
47       (display "v\n"))
48     (print-tape tape trace-tape-chars)
49     (print-n-times blank-symbol (max 0 (- trace-tape-chars (length tape))))
50     (display "\n")))
51 (define (find-trans-state states state symbol blank-symbol)
52   (if (null? states)
53     (values 'invalid blank-symbol 'left)
54     (if (equal? (list state symbol) (caar states))
55       (let ((s (cadar states)))
56         (values (list-ref s 0) (list-ref s 1) (list-ref s 2)))
57       (find-trans-state (cdr states) state symbol blank-symbol))))
58 (define (simulate tape state head-position transition-func accepting-states blank-symbol)
59   (trace-state tape head-position blank-symbol)
60 
61   (cond ((eq? state 'invalid) #f@ text
62 )
63         ((member state accepting-states) #t@ text
64 )
65         (else (let ((symbol (symbol-at tape head-position blank-symbol)@ text
66 ))
67 	        (let-values (((newstate newsymbol movedir) (transition-func state symbol)))
68 	          (simulate (write-to-tape tape head-position newsymbol)@ text
69 
70 		            newstate
71 		            (cond ((eq? movedir 'left)  (- head-position 1))
72 			          ((eq? movedir 'right) (+ head-position 1))
73 			          (else (error "Illegal head move")))@ text
74 
75 		            transition-func
76 		            accepting-states
77 		            blank-symbol)@ text
78 ))@ text
79 ))@ text
80 )


hijacker
hijacker
hijacker
hijacker