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 edit
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/
