** Summary ** [Richard Suchenwirth] 2005-05-03: At university, I never learned much about [Turing machine]s. 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: ======none C:\_Ricci\sep>tclsh turing.tcl [_]1 1[0]100 [_]10000 * 1111[1]1 ====== <> Concept