: # *-*-perl-*-* eval 'exec perl -S $0 ${1+"$@"}' if 0; # if running under some shell #!/usr/bin/perl $bapropos = q` turing(1r) - Simple interactive Turing machine simulator `; << 'HEADER_END'; NAME turing -- Simple interactive Turing machine simulator For more perl goodness, go to mrob.com/pub/perl REVISION HISTORY 20000128 Create, use to test sample Turing machines on my web page. 20000128 Using regexps for all tape operations and store tape as a string, instead of storing cells in a hash. Way faster! 20000130 Slight speed optimizations 20000131 Move command processing into getcommand(); add command to edit the tape; add display(); $sincecr becomes $runfor. 20000131 Add first-order (simple) optimization (simple period-1 loops only). It can now easily perform runs of 1e8 steps; I did a long run that went to 3.7e9 steps and 1.25e5 symbols with no problems. 20000201 Add period-3 and period-4 cases to tape compression in display(). 20001127 Update examples to include new BB(6) candidate 20001128 Add 'g' command and options to 'r' to facilitate experiments to analyze BB candidates. 20001129 Add 'p', 'n' and '0' commands. 20031104 Improve the help a bit. 20070901 Add another sample machine; make it easier to cut and paste the samples 20231021 Accept 5-tuple format e.g. "2,_:3,1,> 2,1:4,1,>" when entering machine definition. the next steps are: - dynamic compression and on-demand expansion (tape is stored in compressed format) - make sure it handles (1^3)1(1^4) -> (1^8) - try to make it easy to do searches -- e.g. "1*" gets translated into \(1\^\d+\). Don't need to solve the whole problem now. - 1-cycle optimization adapt to recognize new exponent tape format - test it: it should now run the BB(6) further and faster - implement kgenerator. It needs to test for infinite loops (stepcount > 2^K * N) - implement kmachine. Should be able to retain on-demand exponent stuff - iterate 3 versions of kmachines in parallel, leanest machine survives HEADER_END # This is for implementing Marxen-Buntrock K-macro-machines, but not used # yet %kcode6 = ( "0" => "000000", "1" => "000001", "2" => "000010", "3" => "000011", "4" => "000100", "5" => "000101", "6" => "000110", "7" => "000111", "8" => "001000", "9" => "001001", "A" => "001010", "B" => "001011", "C" => "001100", "D" => "001101", "E" => "001110", "F" => "001111", "G" => "010000", "H" => "010001", "I" => "010010", "J" => "010011", "K" => "010100", "L" => "010101", "M" => "010110", "N" => "010111", "O" => "011000", "P" => "011001", "Q" => "011010", "R" => "011011", "S" => "011100", "T" => "011101", "U" => "011110", "V" => "011111", "W" => "100000", "X" => "100001", "Y" => "100010", "Z" => "100011", "a" => "100100", "b" => "100101", "c" => "100110", "d" => "100111", "e" => "101000", "f" => "101001", "g" => "101010", "h" => "101011", "i" => "101100", "j" => "101101", "k" => "101110", "l" => "101111", "m" => "110000", "n" => "110001", "o" => "110010", "p" => "110011", "q" => "110100", "r" => "110101", "s" => "110110", "t" => "110111", "u" => "111000", "v" => "111001", "w" => "111010", "x" => "111011", "y" => "111100", "z" => "111101", "_" => "111110", "-" => "111111" ); sub initcode { local($k, $v); foreach $k (keys %kcode6) { $v = $kcode6{$k}; $kdecode6{$v} = $k; } } # display the tape sub display { local($t, $n, $head, $hdr); if ($runfor <= 25) { $t = $tape; $t =~ s/_//g; $t =~ s/://; $pop = length($t); $hdr = sprintf("%4d (%4d): ", $steps, $pop); $t = $tape; if ($plain) { $t =~ s/:(.)/#\1#/; $t =~ tr/_/0/ if ($usezeros); print $hdr if ($numbers); print "$state: $t\n"; return; } if (length($t) > ($numbers ? 66 : 79)) { # try to compress the tape display # first, preserve whatever's around the head if ($t =~ s/(..:...)/H/) { $head = $1; } elsif ($t =~ s/(..:)/H/) { $head = $1; } elsif ($t =~ s/(:...)/H/) { $head = $1; } # Simple digit runs are the easiest while ($t =~ s/(111111+)/X/) { $n = length($1); $n = ' 1^' . $n . ' '; $t =~ s/X/$n/; } while ($t =~ s/(______+)/X/) { $n = length($1); $n = ' _^' . $n . ' '; $t =~ s/X/$n/; } # Next handle the 2-cycles (only one) if ($t =~ m/_1_1_1_1/) { $t =~ s/_1/m/g; while ($t =~ s/m(mm+)m/mXm/) { $n = length($1); $n = ' (_1)^' . $n . ' '; $t =~ s/X/$n/; } $t =~ s/m/_1/g; } # 3-cycles if ($t =~ m/_1__1__1__1_/) { $t =~ s/_1_/m/g; while ($t =~ s/m(mm+)m/mXm/) { $n = length($1); $n = ' (_1_)^' . $n . ' '; $t =~ s/X/$n/; } $t =~ s/m/_1_/g; } if ($t =~ m/1_11_11_11_1/) { $t =~ s/1_1/m/g; while ($t =~ s/m(mm+)m/mXm/) { $n = length($1); $n = ' (1_1)^' . $n . ' '; $t =~ s/X/$n/; } $t =~ s/m/1_1/g; } # 4-cycles if ($t =~ m/_1___1___1___1__/) { $t =~ s/_1__/m/g; while ($t =~ s/m(mm+)m/mXm/) { $n = length($1); $n = ' (_1__)^' . $n . ' '; $t =~ s/X/$n/; } $t =~ s/m/_1__/g; } if ($t =~ m/1_111_111_111_11/) { $t =~ s/1_11/m/g; while ($t =~ s/m(mm+)m/mXm/) { $n = length($1); $n = ' (1_11)^' . $n . ' '; $t =~ s/X/$n/; } $t =~ s/m/1_11/g; } # restore head area $t =~ s/H/$head/; } print $hdr if ($numbers); $t =~ s/:(.)/$color[$state] . $1 . $normal/e; $t =~ tr/_/0/ if ($usezeros); print $t; print "\n"; } } sub getcommand { local($l, $t1, $t2); command_loop: ; print "More, # to skip N steps, R to restart, ? for help: "; $l = <>; chop $l; $l =~ tr/A-Z/a-z/; if ($l eq "?") { print " States are not displayed if they contain the same tape pattern as the previously displayed state. /pat - run the machine until the given pattern appears on the tape 170 - skip 170 steps and stop pattern-searching / - return to pattern-searching, using same pattern as before - run another 25 steps, or continue current pattern search r - restart from blank tape, state 1 s/from/to/ - edit tape n - toggle display of step and population numbers p - toggle plain display format 0 - toggle '0' vs '_' ^C - exit "; } elsif ($l eq "p") { $plain = ($plain == 0); } elsif ($l eq "n") { $numbers = ($numbers == 0); } elsif ($l eq "0") { $usezeros = ($usezeros == 0); } elsif ($l =~ m/^r +([1-7]) +([^ ]+)$/) { # restart with state and tape $initstate = $1; $inittape = $2; $inittape =~ tr/0/_/; if ($inittape =~ m/:$/) { $inittape .= "_"; } elsif ($inittape =~ m/:/) { # ok } else { $inittape = ":" . $inittape; } $running = 0; $restart = 1; $runfor = 1; # to get out of command loop $pattern = ""; } elsif ($l =~ m/^r +([1-7])/) { # restart with state $initstate = $1; $inittape = ":_"; $running = 0; $restart = 1; $runfor = 1; # to get out of command loop $pattern = ""; } elsif ($l eq "r") { $initstate = 1; $inittape = ":_"; $running = 0; $restart = 1; $runfor = 1; # to get out of command loop $pattern = ""; } elsif ($l =~ m/^g +([1-7])/) { $l = $1; print "Change head state to $l\n"; $state = $l; } elsif ("$l//" =~ m,^s/([^/]+)/([^/]*)/([^/]*)/,) { # edit the tape $from = $1; $to = $2; $opt = $3; $from =~ tr/0/_/; $to =~ tr/0/_/; $e = '$t1 =~ s/' . $from . "/" . $to . "/" . $opt . ";"; $t1 = $tape; eval($e); if ($t1 ne $tape) { # success: head was not in the way of the pattern $tape = $t1; if ($tape =~ m/:/) { # head was not inside pattern } else { # restore head $tape = ":" . $tape; } } else { # let's try to take the head out and then do the translate $e = '$t1 =~ s/' . $from . "/:" . $to . "/" . $opt . ";"; $t1 =~ s/://; $t2 = $t1; eval($e); if ($t1 ne $t2) { # yup, that worked. $tape = ":" . $t1; } else { print "Pattern /$from/ was not found.\n"; } } } elsif ($l =~ m,^/(.+)/?$,) { $pattern = $1; $pattern =~ tr/0/_/; $lastpat = $pattern; print "Searching at most 5000000 steps for /$pattern/...\n"; $runfor = 5000000; } elsif ($l eq "/") { $pattern = $lastpat; print "Searching at most 5000000 steps for /$pattern/...\n"; $runfor = 5000000; } elsif ($l eq "") { $runfor = 25; # or search some more... if ($pattern ne "") { print "Continuing search for /$pattern/ another 5000000 steps...\n"; $runfor = 5000000; } } else { # interpret as a number: run this many more $pattern = ""; $runfor = $l; } if ($runfor <= 0) { &display(); goto command_loop; } } $| = 1; # Note: These environment variables are nonstandard. I really need to find # a standard way to test which stty erase needs to be set. It depends # on your operating system and what type of terminal connection you're # running in (xterm, telnet, ssh, etc.) Suggestions are welcome! $erase_bs = $ENV{"ERASE_BS"}; $erase_del = $ENV{"ERASE_DEL"}; if ($erase_del) { system("stty erase '^?'"); } elsif ($erase_bs) { system("stty erase '^H'"); } else { system("stty erase '^?'"); } initcode(); $esc = "\033"; $color[1] = $esc . "[0;1;31m"; $color[2] = $esc . "[0;1;33m"; $green = $esc . "[0;1;32m"; $color[3] = $green; $color[4] = $esc . "[0;1;36m"; $color[5] = $esc . "[0;1;34m"; $color[6] = $esc . "[0;1;35m"; $normal = $esc . "[0m"; print " Examples: The 2-state busy beaver: 2,1,> 2,1,< 1,1,< h,1,< A binary counter: B,1,r A,1,l A,_,l B,_,r A,_,l H,1,r The 4-state champion: 2,1,r 2,1,l 1,1,l 3,0,l h,1,r 4,1,l 4,1,r 1,0,r The current 6-state busy beaver candidate: b1r c0r a0l d0r d1r h1r e1l d0l f1r b1l a1r e1r All of the above are valid input: letters A-F = states 1-6; '0' = '_'; 'l' = '<' and 'r' = '>', commas are optional. "; $ns = 0; $l = " "; while($l ne "") { print "State rules for state "; print ($ns+1); print ": "; $l = <>; chop $l; # Allow some flexibility in turing machine rules format. # All of the following input lines are acceptable (standard # "easy to type format" on right): # 2/1/> B1< 21r 21l # 3,1,< 5_R 31l 50r # 40L A_R 40l 10r # 11r 4,0l 11r 40l # H,1/R 3,_/> h1r 30r $l =~ tr/A-Z/a-z/; $l =~ tr/z/h/; $l =~ tr/abcdefg/1234567/; $l =~ s|[:/]|,|g; $l =~ tr|<>|lr|; $l =~ tr|0o|__|; $l =~ s|^ +||; $l =~ s| +$||; if ($l =~ m/^([h0-9]),?([01_]),?([lr]) +([h0-9]),?([01_]),?([lr])$/) { $ns++; $s0 = $1; $w0 = $2; $m0 = $3; $s1 = $4; $w1 = $5; $m1 = $6; $machine{"$ns _"} = "$s0 $w0 $m0"; $machine{"$ns 1"} = "$s1 $w1 $m1"; } elsif ($l =~ m/^([1-9]),?_,?([h0-9]),?([01_]),?([lr]) +([1-9]),?1,?([h0-9]),?([01_]),?([lr])$/) { $v1 = $1; $s0 = $2; $w0 = $3; $m0 = $4; $v2 = $5; $s1 = $6; $w1 = $7; $m1 = $8; if (($v1 == $ns+1) && ($v2 == $ns+1)) { $ns++; $machine{"$ns _"} = "$s0 $w0 $m0"; $machine{"$ns 1"} = "$s1 $w1 $m1"; } else { print "Illegal input -- skipped.\n"; } } elsif ($l ne "") { print "Illegal input -- skipped.\n"; } } $usezeros = 1; $plain = 1; $numbers = 1; full_restart: ; $initstate = 1; $inittape = ":_"; restart_here: ; $tape = $inittape; $state = $initstate; $running = 1; $steps = 0; $restart = 0; $runfor = 25; $sym = "_"; &display(); # print (" 0: " . $color[$state] . "$sym$normal\n"); while($running) { # read symbol # symbol was read immediately after previous move # get instructions to execute $do = $machine{"$state $sym"}; # if we're in a numbered state and if the symbol was legal, the # instructions will match this pattern. if ($do =~ m/^([h0-9]) ([1_]) ([lr])$/) { $state = $1; $write = $2; $move = $3; # noopt will indicate we didn't do optimization $noopt = 1; if (($state eq $laststate) # && ($runfor - length($tape) > 25) ) { # state,sym mapped onto same state. # we can optimize if more of the same sym's exist beyond the current # head position if ($move eq "l") { # change 'sssss:s' to ':swwwww' # this is 5 consecutive moves and writes. # we use /(s+):s/:X/ followed by /X/swwwww/ if ($tape =~ s/($sym+):$sym/:X/) { $pat = $1; $numopt = length($pat); $pat = $sym . ($write x $numopt); $tape =~ s/X/$pat/; $noopt = 0; $steps += $numopt; $runfor -= $numopt; } } else { # change ':ssssss' to 'wwwww:s' # this is 5 consecutive moves and writes. # we use /:(s+)s/X:s/ followed by /X/wwwww/ if ($tape =~ s/:($sym+)$sym/X:$sym/) { $pat = $1; $numopt = length($pat); $pat = ($write x $numopt); $tape =~ s/X/$pat/; $noopt = 0; $steps += $numopt; $runfor -= $numopt; } } } if ($noopt) { # do the write $tape =~ s/:./:$write/; # Perform head movement, and read new tape symbol (used next time # through the loop). $lastsym = $sym; # for testing next time $laststate = $state; if ($move eq "r") { if ($tape =~ s/:(.)(.)/\1:\2/) { $sym = $2; } else { $tape =~ s/:(.)/\1:/; $sym = "_"; $tape .= $sym; } } else { $tape =~ s/^:/_:/; $tape =~ s/(.):/:\1/; $sym = $1; } $steps++; $runfor--; } # detect search pattern if ($pattern =~ m/:/) { $t2 = $tape; if ($t2 =~ m/$pattern/) { $l1 = length($t2); print ($green . "Matched pattern, tape is $l1 symbols long.$normal\n"); $runfor = 0 if ($runfor > 0); } } elsif ($pattern ne "") { $t2 = $tape; $t2 =~ s/://; if ($t2 =~ m/$pattern/) { $l1 = length($t2); print ($green . "Matched pattern, tape is $l1 symbols long.$normal\n"); $runfor = 0 if ($runfor > 0); } } # Show machine state &display(); # Get a command if it's time if ($runfor <= 0) { &getcommand(); } } elsif ($state eq "h") { print "Machine halted normally after "; print ($steps); print " steps, leaving $pop filled cells.\n"; $running = 0; } elsif ($state > $ns) { print "State transition to unknown state $state.\n"; $running = 0; } else { print "Can't parse transition '$do'.\n"; $running = 0; } } if ($restart) { goto restart_here; } else { print "Hit return to restart or ^C to quit: "; $l = <>; goto full_restart; }