Updated 2014-07-02 14:27:32 by HJG

## Summary  edit

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