A little Deterministic Turing Machine

Summary

Richard Suchenwirth 2005-05-03: At university, I never learned much about Turing machines. Only decades later, a hint in the Tcl chatroom pointed me to http://csc.smsu.edu/~shade/333/project.txt , an assignment to implement a Deterministic Turing Machine (i.e. one with at most one rule per state and input character), which gives clear instructions and two test cases for input and output, so I decided to try my hand in Tcl.

Description

Rules in this little challenge are of the form a bcD e, where

  • a is the state in which they can be applied
  • b is the character that must be read from tape if this rule is to apply
  • c is the character to write to the tape
  • D is the direction to move the tape after writing (R(ight) or L(eft))
  • e is the state to transition to after the rule was applied

Here's my naive implementation, which takes the tape just as the string it initially is. I only had to take care that when moving beyond its ends, I had to attach a space (written as _) on that end, and adjust the position pointer when at the beginning. Rules are also taken as strings, whose parts can easily be extracted with string index - as it's used so often here, I alias it to @.

proc dtm {rules tape} {
    set state 1
    set pos 0
    while 1 {
        set char [@ $tape $pos]
        foreach rule $rules {
            if {[@ $rule 0] eq $state && [@ $rule 2] eq $char} {
                #puts rule:$rule,tape:$tape,pos:$pos,char:$char
                #-- Rewrite tape at head position.
                set tape [string replace $tape $pos $pos [@ $rule 3]]
                #-- Move tape Left or Right as specified in rule.
                incr pos [expr {[@ $rule 4] eq "L"? -1: 1}]
                if {$pos == -1} {
                    set pos 0
                    set tape _$tape
                } elseif {$pos == [string length $tape]} {
                    append tape _
                }
                set state [@ $rule 6]
                break
            }
        }
        if {$state == 0} break
    }
    #-- Highlight the head position on the tape.
    string trim [string replace $tape $pos $pos \[[@ $tape $pos]\]] _
}
interp alias {} @ {} string index
#-- Test data from http://csc.smsu.edu/~shade/333/project.txt
set rules {
    {1 00R 1}
    {2 01L 0}
    {1 __L 2}
    {2 10L 2}
    {2 _1L 0}
    {1 11R 1}
}
set tapes {
    0
    10011
    1111
}
set rules2 {
    {3 _1L 2}
    {1 _1R 2}
    {1 11L 3}
    {2 11R 2}
    {3 11R 0}
    {2 _1L 1}
}
set tapes2 _

#-- Testing:
foreach tape $tapes {puts [dtm $rules $tape]}
puts *
puts [dtm $rules2 $tapes2]

Reports the results as wanted in the paper, on stdout:

C:\_Ricci\sep>tclsh turing.tcl
[_]1
1[0]100
[_]10000
*
1111[1]1

HJG 2014-06-30 - The link to that paper has moved, most likely http://people.missouristate.edu/EricShade/