Universal Turing machine: Difference between revisions
m
→{{header|Wren}}: Minor tidy
Cyril Nocton (talk | contribs) |
m (→{{header|Wren}}: Minor tidy) |
||
(40 intermediate revisions by 5 users not shown) | |||
Line 86:
{{trans|Python}}
<
V st = state
I tape.empty
Line 167:
‘E 0 0 right STOP’.split(‘ ’, group_delimiters' 1B)],
tape' &‘2 2 2 1 2 2 1 2 1 2 1 2 1 2’.split(‘ ’).map(Char)
)</
{{out}}
Line 338:
The execution of the machine, i.e., the procedure Run, allows to define a number Max_Steps, after which the execution stops -- when, e.g., the specified machine runs infinitively. The procedure also allows to optionally output the configuration of the machine before every step.
<
generic
Line 391:
Right: List;
end record;
end Turing;</
===The implementation of the universal machine===
<
function List_To_String(L: List; Map: Symbol_Map) return String is
Line 492:
end Run;
end Turing;</
===The implementation of the simple incrementer===
<
procedure Simple_Incrementer is
Line 523:
Run(Tape, Rules, 20, null); -- don't print the configuration during running
Put_Tape(Tape, Stop); -- print the final configuration
end Simple_Incrementer;</
{{out}}
Line 532:
===The implementation of the busy beaver===
<
procedure Busy_Beaver_3 is
Line 562:
Run(Tape, Rules, 20, Put_Tape'Access); -- print configuration before each step
Put_Tape(Tape, Stop); -- and print the final configuration
end Busy_Beaver_3;</
{{out}}
Line 595:
=={{header|Amazing Hopper}}==
Implementation of a Universal Turing Machine:
<syntaxhighlight lang="amazing hopper">
#include <hopper.h>
#proto UniversalTuringMachine(_X_)
Line 685:
{""}tok sep
back
</syntaxhighlight>
ALternative pseudo-function UniversalTuringMachine (fast):
<pre>
Line 761:
=={{header|APL}}==
===⍺===
{{works with|Dyalog APL}}
<
⍝ Run Turing machine until it halts
∇r←RunTuring (rules init halts blank itape);state;rt;lt;next
Line 838 ⟶ 839:
:EndFor
∇
:EndNamespace</
{{out}}
<pre>1_SimpleIncrementer: 1111
2_ThreeStateBeaver: 111111
3_FiveStateBeaver: 10100100100100100100100100100100... (total length: 12289)</pre>
===⍵===
{{works with|Dyalog APL}}
<syntaxhighlight lang="lisp">
∆I ←'QA.1' '1' 'R' 'QA'
∆I,←'QA.B' '1' 'N' 'QB'
∆INCREMENTER←∆I
∆B ←'QA.0' '1' 'R' 'QB'
∆B,←'QA.1' '1' 'L' 'QC'
∆B,←'QB.0' '1' 'L' 'QA'
∆B,←'QB.1' '1' 'R' 'QB'
∆B,←'QC.0' '1' 'L' 'QB'
∆B,←'QC.1' '1' 'N' 'QD'
∆BEAVER←∆B
∇ R←RUN(F Q H T B);I;J
I←1 ⋄ T←,T
L:→(Q≡H)/E
J←⍸(Q,'.',T[I])∘≡¨F
T[I]←F[J+1]
I←I+2-'RNL'⍳F[J+2]
Q←⊃F[J+3]
T←((I<1)⍴B),T,(I>⍴T)⍴B
I←I+I=0
→L
E:R←T I
∇
</syntaxhighlight>
{{out}}
<pre>
RUN ∆INCREMENTER 'QA' 'QB' '111' 'B'
1111 4
RUN ∆BEAVER 'QA' 'QD' '0' '0'
111111 4
</pre>
=={{header|AutoHotkey}}==
<
SetBatchLines, -1
OnExit, Exit
Line 1,018 ⟶ 1,058:
If (A_Gui = 1)
PostMessage, 0xA1, 2
}</
<b>Input:</b>
Set Section below to desired machine, then save as <scriptname>.ini in the same folder.
Line 1,099 ⟶ 1,139:
<b>Non-universality:</b> as written, the program will fail if you try to use it with a Turing machine that has more than 256 distinct states or a tape that is longer than 704 cells. (In reality, of course, the ZX81's RAM would have been exhausted some time before you reached such a Goliath.) Allowing more states would be pretty trivial, assuming you had the memory space; just use as many bytes as you need. As for supporting a longer tape, the easiest way to do it would be to comment out the <code>PRINT</code> statements (sacrificing the animation) and add a few lines to display one screenful at a time at the very end.
<
1010 LET P=1
1020 IF P>LEN T$ THEN LET T$=T$+B$
Line 1,116 ⟶ 1,156:
1150 GOTO 1020
1160 LET T$=B$+T$
1170 GOTO 1000</
====The incrementer====
Works with 1k of RAM.
<
20 LET S$=CHR$ (CODE "Q"+CODE "0")
30 LET H$=CHR$ (CODE "Q"+CODE "F")
Line 1,126 ⟶ 1,166:
50 LET R$(2)=S$+"B1S"+H$
60 LET B$="B"
70 LET T$="111"</
{{out}}
<pre>1111</pre>
Line 1,132 ⟶ 1,172:
====The three-state beaver====
Requires at least 2k of RAM.
<
20 LET R$(1)="A01RB"
30 LET R$(2)="A11LC"
Line 1,142 ⟶ 1,182:
90 LET S$="A"
100 LET B$="0"
110 LET H$="H"</
{{out}}
<pre>111111</pre>
Line 1,150 ⟶ 1,190:
=={{header|C}}==
<
#include <stdarg.h>
#include <stdlib.h>
Line 1,381 ⟶ 1,421:
run(t);
}
</syntaxhighlight>
{{output}}
Line 1,409 ⟶ 1,449:
=={{header|C sharp}}==
<
using System.Collections.Generic;
using System.Diagnostics;
Line 1,608 ⟶ 1,648:
}
}</
{{out}}
<pre style="height:30ex;overflow:scroll">
Line 1,654 ⟶ 1,694:
=={{header|C++}}==
<
#include <vector>
#include <string>
Line 1,789 ⟶ 1,829:
int main( int a, char* args[] ){ utm mm; mm.start(); return 0; }
//--------------------------------------------------------------------------------------------------
</syntaxhighlight>
'''These are the files you'll need'''<br />
Line 1,871 ⟶ 1,911:
=={{header|Clojure}}==
<
(defn tape
"Creates a new tape with given blank character and tape contents"
Line 1,898 ⟶ 1,938:
(let [[out action new-state] (get rules [state (head tape)])]
(recur new-state (action tape out))))))))
</syntaxhighlight>
=== Tests ===
<
(def simple-incrementer
(new-machine {:initial :q0
Line 1,943 ⟶ 1,983:
(is (= 4098 (get freq 1)))
(is (= 8191 (get freq 0)))))
</syntaxhighlight>
=={{header|CLU}}==
<
tape = cluster [T: type] is make, left, right, get_cell, set_cell,
elements, get_size
Line 2,202 ⟶ 2,242:
print_tape(po, t.tap)
end
end start_up</
{{out}}
<pre>Simple incrementer: 1111
Line 2,213 ⟶ 2,253:
# <code>front</code> contains all cells before the current cell in reverse order (i.e. the first element in <code>front</code> is the direct predecessor of the current cell)
# <code>back</code> contains the current cell as its first element, followed by all successors.
<
(labels ((combine (front back)
(if front
Line 2,247 ⟶ 2,287:
(when verbose
(show-tape front back))
(return (combine front back))))))</
===Recursive version===
Using the same interface and general idea as the iterative version.
<
(labels ((run (state front back)
(if (equal state terminal)
Line 2,287 ⟶ 2,327:
back)))
(run initial '() tape)))</
===Usage===
<
(defun make-rules-table (rules-list)
(let ((rules (make-hash-table :test 'equal)))
Line 2,344 ⟶ 2,384:
(E 1 0 left A)))
'())
0 20))</
{{Out}}
Line 2,372 ⟶ 2,412:
5-state busy beaver (first 20 cells)
10100100100100100100...</pre>
=={{header|Cowgol}}==
<
include "strings.coh";
include "malloc.coh";
Line 2,746 ⟶ 2,712:
print_nl();
i := i + 1;
end loop;</
{{out}}
<pre>Simple incrementer: 1111
Line 2,754 ⟶ 2,720:
===Nearly Strongly Typed Version===
This is typed a little less strongly than the Ada entry. It's fast and safe.
<
std.exception, std.traits, std.math, std.range;
Line 2,989 ⟶ 2,955:
}
M4(tm4);
}</
{{out}}
<pre>Incrementer:
Line 3,046 ⟶ 3,012:
===Simple Version===
While the precedent version is Ada-like, this is more like a script.
<
void turing(Sy, St)(in St state, Sy[int] tape, in int pos,
Line 3,063 ⟶ 3,029:
"b": [0: tuple(1, -1, "a"), 1: tuple(1, 1, "b")],
"c": [0: tuple(1, -1, "b"), 1: tuple(1, 0, "")]]);
}</
{{out}}
<pre>(0)
Line 3,080 ⟶ 3,046:
=={{header|Déjà Vu}}==
<
local :t {}
while /= ) dup:
Line 3,121 ⟶ 3,087:
else:
return paste-together tape-left head tape
paste-together tape-left head tape</
===Simple incrementer===
<
)
:q0 1 1 :right :q0
:q0 :B 1 :stay :qf
!. universal-turing-machine transitions(</
{{out}}
<pre>[ 1 1 1 1 ]</pre>
Line 3,135 ⟶ 3,101:
===Three-state busy beaver===
<
)
:a :B 1 :right :b
Line 3,143 ⟶ 3,109:
:c :B 1 :left :b
:c 1 1 :stay :halt
!. universal-turing-machine transitions(</
{{out}}
<pre>[ 1 1 1 1 1 1 ]</pre>
Line 3,149 ⟶ 3,115:
===5-state, 2-symbol probable Busy Beaver machine===
<
)
:A :B 1 :right :B
Line 3,161 ⟶ 3,127:
:E :B 1 :stay :H
:E 1 :B :left :A
!. universal-turing-machine transitions(</
(Output omitted because of length.)
Line 3,168 ⟶ 3,134:
We define a Turing machine as an instance of TM struct, which stores the definition values (states,symbols,rules) and the current state values (state, tape, position). It can be stopped, restarted, called as a sub-program, or transformed into a sequence or stream.'Huge' TM are run in the background. Rules are compiled into a vector indexed by state * symbol.
=== Turing Machines ===
<
(require 'struct)
Line 3,270 ⟶ 3,236:
(when (= final state) (writeln 'Stopping (TM-name T) 'at-pos (- pos (TM-mem T))))
count)
</syntaxhighlight>
{{out}}
<pre>
Line 3,324 ⟶ 3,290:
We create a task to run it in the background.
{{out}}
<
(define steps 0)
(define (TM-task T)
Line 3,333 ⟶ 3,299:
(when (zero? count) (writeln 'END steps (date)))
(if (zero? count) #f T)) ;; return #f to signal end of task
</syntaxhighlight>
<pre>
;; 5-states 2-symbols busy beaver
Line 3,375 ⟶ 3,341:
When running the 5-state busy beaver, the simulator executed 2.7 billion EDSAC orders, which would have taken about 48 days on the original EDSAC. (Cf the estimate of "months" for the same task in ZX81 Basic.)
<
[Attempt at Turing machine for Rosetta Code.]
[EDSAC program, Initial Orders 2.]
Line 3,666 ⟶ 3,632:
PF [enter with acc = 0]
[end]
</syntaxhighlight>
{{out}}
<pre>
Line 3,685 ⟶ 3,651:
In this universal Turing machine simulator, a machine is defined by giving it a configuration function that returns the initial state, the halting states and the blank symbol, as well as a function for the rules. These are passed in to the public interface <code>turing/3</code> as funs, together with the initial tape setup.
<
-module(turing).
Line 3,752 ⟶ 3,718:
action(stay, _, Tape) -> Tape;
action(right, Blank, {Left, []}) -> {[Blank|Left], []};
action(right, _, {Left, [R|Rs]}) -> {[R|Left], Rs}.</
=={{header|Fortran}}==
Line 3,784 ⟶ 3,750:
===Source===
This is in F77 style, and just one mainline. The Turing action is effected by just five statements:<
TAPE(HEAD) = MARK(I) !Do it. Possibly not changing the symbol.
HEAD = HEAD + MOVE(I) !Possibly not moving the head.
STATE = ICHAR(NEXT(I)) !Hopefully, something has changed!
IF (STATE.GT.0) GO TO 200 !Otherwise, we might loop forever...</
Which manifests the ability to read and write memory, simple arithmetic, and a conditional branch. This is all it takes. And thanks to Kurt Gödel, it is known that simple arithmetic is enough to construct statements that are true, but unprovable.
The use of ICHAR() and CHAR() hopefully involves no machine code effort, they are merely a genuflection to the rules of type checking to calm the compiler. Most of the blather is concerned with acquiring the description (with minimal checking), and preparing some trace output.
Showing the head movement with a plus sign for positive movement but not zero proved a bit tricky, given that an uninitialised MOVE entry has the obtrusive value of -60 so that function SIGN doesn't help: SIGN(1,-60) gives -1, but SIGN(1,0) gives 1. SIGN(MAX(-1,i),i) would do and now this is becoming messy, so array indexing trickery is out unless a special function is to be supplied - but this is a mainline-only attempt. The SP format code causes the appearance of a plus for subsequent fields but alas, zero has a plus sign also. So, write to a text variable, place the plus sign if wanted, and write the resulting text.<
Careful! Reserves a symbol #0 to represent blank tape as a blank.
INTEGER MANY,FIRST,LAST !Some sizes must be decided upon.
Line 3,980 ⟶ 3,946:
END DO !On to the next symbol in the order as supplied.
END DO !And the next state, in numbers order.
END !That was fun.</
===Results===
Line 4,545 ⟶ 4,511:
=={{header|Fōrmulæ}}==
{{FormulaeEntry|page=https://formulae.org/?script=examples/Universal_Turing_machine}}
'''Solution'''
[[File:Fōrmulæ - Universal Turing machine 01.png]]
'''Test case 1. Simple incrementer'''
[[File:Fōrmulæ - Universal Turing machine 02.png]]
[[File:Fōrmulæ - Universal Turing machine 03.png]]
'''Test case 2. One-state busy beaver game'''
[[File:Fōrmulæ - Universal Turing machine 04.png]]
[[File:Fōrmulæ - Universal Turing machine 05.png]]
'''Test case 3. Two-state busy beaver game'''
[[File:Fōrmulæ - Universal Turing machine 06.png]]
[[File:Fōrmulæ - Universal Turing machine 07.png]]
'''Test case 4. Three-state busy beaver game'''
[[File:Fōrmulæ - Universal Turing machine 08.png]]
[[File:Fōrmulæ - Universal Turing machine 09.png]]
'''Test case 5. Four-state busy beaver game'''
[[File:Fōrmulæ - Universal Turing machine 10.png]]
[[File:Fōrmulæ - Universal Turing machine 11.png]]
'''Test case 6. (Probable) Five-state busy beaver game'''
In this case, the length of the tape is returned, and not the tape itself.
This machine will run for more than 47 millions steps.
[[File:Fōrmulæ - Universal Turing machine 12.png]]
[[File:Fōrmulæ - Universal Turing machine 13.png]]
=={{header|Go}}==
<
type Symbol byte
Line 4,728 ⟶ 4,734:
m.state = act.next
}
}</
An example program using the above package:
<
import (
Line 4,800 ⟶ 4,806:
fmt.Println("Turing machine halts after", cnt, "operations")
fmt.Println("Resulting tape:", output)
}</
{{out}}
<pre>Turing machine halts after 4 operations
Line 4,815 ⟶ 4,821:
In this program the tape is infinite, and the machines rules are coded in Haskell as a function from state and value to action, using Haskell as a DSL.
<
data Move = MLeft | MRight | Stay deriving (Show, Eq)
data Tape a = Tape a [a] [a]
Line 4,843 ⟶ 4,849:
runUTM rules stop start tape = steps ++ [final]
where (steps, final:_) = break ((== stop) . fst) $ iterate (step rules) (start, tape)
</syntaxhighlight>
====Increment machine====
<
incr "q0" 0 = Action 1 Stay "qf"
tape1 = tape 0 [] [1,1, 1]
machine1 = runUTM incr "qf" "q0" tape1
</syntaxhighlight>
The output of the increment machine :
<
("q0",0000000000[1]1100000000)
("q0",0000000001[1]1000000000)
Line 4,860 ⟶ 4,866:
("q0",0000000111[0]0000000000)
("qf",0000000111[1]0000000000)
</syntaxhighlight>
====Beaver machine====
<
beaver "a" 1 = Action 1 MLeft "c"
beaver "b" 0 = Action 1 MLeft "a"
Line 4,872 ⟶ 4,878:
tape2 = tape 0 [] []
machine2 = runUTM beaver "halt" "a" tape2
</syntaxhighlight>
====Sorting test====
<
sorting "A" 2 = Action 3 MRight "B"
sorting "A" 0 = Action 0 MLeft "E"
Line 4,892 ⟶ 4,898:
tape3 = tape 0 [] [2,2,2,1,2,2,1,2,1,2,1,2,1,2]
machine3 = runUTM sorting "STOP" "A" tape3
</syntaxhighlight>
===Using State Monad===
Line 4,898 ⟶ 4,904:
Intermediate states can be logged during execution, or they can be discarded. The initial and final states as well as errors are always logged.
Three functions are added so that machines can be written to a file and parsed/run from there. Examples are provided.
<
import Control.Monad.State
import Data.List (intersperse, nub, find)
Line 5,051 ⟶ 5,057:
, machineLog = []
, machineLogActive = True }
</syntaxhighlight>
Examples for machine files:
<pre>
Line 5,139 ⟶ 5,145:
This particular UTM halts when entering a final state or when a motion of 'halt' is acted on.
<
record delta(old_state, input_symbol, new_state, output_symbol, direction)
Line 5,256 ⟶ 5,262:
write(l,r)
write(repl(" ",*l),"^")
end</
First sample machine, with tape changes on each transition traced:
Line 5,329 ⟶ 5,335:
===The universal (stateless point-free) Turing machine===
The universal Turing machine is defined in terms of fixed tacit (stateless point-free) code, showing that this dialect of J is Turing complete.
<
utm=.
Line 5,345 ⟶ 5,351:
)
</syntaxhighlight>
===The incrementer machine===
<
NB. Simple Incrementer...
Line 5,368 ⟶ 5,374:
3 : ^
0 0:1111
4 : ^</
=== The three-state busy beaver machine===
<
NB. 0 1 Tape Symbol Scan
NB. S p m g p m g (p,m,g) → (print,move,goto)
Line 5,409 ⟶ 5,415:
12 : ^
2 1:111111
13 : ^</
=== The probable 5-state, 2-symbol busy beaver machine===
<
NB. 0 1 Tape Symbol Scan
NB. S p m g p m g (p,m,g) → (print,move,goto)
Line 5,428 ⟶ 5,434:
0 :^
4 0 :101001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001001...
47176870: ^</
=== The sorting stress test machine===
<
NB. 0 1 2 3 Tape Symbol Scan
NB. S p m g p m g p m g p m g (p,m,g) ➜ (print,move,goto)
Line 5,451 ⟶ 5,457:
100: ^
4 0:0111111222222220
118: ^</
=== The structured derivation of the universal Turing machine ===
The fixed tacit code was produced by means of an unorthodox tacit toolkit; however, the verb produced is orthodox (i.e., compliant with the language specifications):
<
NB.--------------------------------------------------------------------------------------
Line 5,550 ⟶ 5,556:
utm=. utm f. NB. Fixing the universal Turing machine code
NB. The simulation code is produced by 77 (-@:[ ]\ 5!:5@<@:]) 'utm'</
=={{header|Java}}==
Line 5,557 ⟶ 5,563:
This is an implementation of the universal Turing machine in plain Java using standard libraries only. As generics are used, Java 5 is required. The examples (incrementer and busy beaver) are implemented directly in the main method and executed sequentially; as an additional third example, a sorting algorithm is implemented and executed in the end of the main method. During execution the complete tape and the current active transition are printed out in every step. The state names and tape symbols may contain several characters, so arbitrary strings such as "q1", "q2", ... can be valid state names or tape symbols. The machine is deterministic as the transitions are stored in a HashMap which uses state / tape symbol pairs as keys. This is self-coded, not a standard implementation, so there is no guarantee of correctness.
<
import java.util.HashSet;
import java.util.LinkedList;
Line 5,794 ⟶ 5,800:
System.out.println("Output (sort): " + machine.runTM() + "\n");
}
}</
{{out}} -- [H] denotes the head; its position on the tape is over the symbol printed right from it.
Line 5,898 ⟶ 5,904:
=={{header|JavaScript}}==
{{works with|FireFox}}
<
document.write(d, '<br>')
if (i<0||i>=t.length) return
Line 5,941 ⟶ 5,947:
'3.0: 1, L, 3',
'3.1: 1, L, 1'
)</
{{out}}
Unary incrementer<br> *: a [<u>1</u>11]<br> 1: a [<u> </u>111]<br> 2: h [<u>1</u>111]<br> <br>Unary adder<br> *: 1 [<u>1</u>11 111]<br> 1: 2 [ <u>1</u>1 111]<br> 2: 3 [ 1<u>1</u> 111]<br> 3: 3 [ 11<u> </u>111]<br> 4: 0 [ 11<u>1</u>111]<br> <br>Three-state busy beaver<br> *: 1 [<u> </u>]<br> 1: 2 [1<u> </u>]<br> 2: 3 [1 <u> </u>]<br> 3: 3 [1<u> </u>1]<br> 4: 3 [<u>1</u>11]<br> 5: 1 [<u> </u>111]<br> 6: 2 [1<u>1</u>11]<br> 7: 2 [11<u>1</u>1]<br> 8: 2 [111<u>1</u>]<br> 9: 2 [1111<u> </u>]<br> 10: 3 [1111 <u> </u>]<br> 11: 3 [1111<u> </u>1]<br> 12: 3 [111<u>1</u>11]<br> 13: 1 [11<u>1</u>111]<br> 14: 0 [111<u>1</u>11]
=={{header|Julia}}==
<
@enum Move Left=1 Stay Right
Line 6,031 ⟶ 6,037:
turing(prog, tape, verbose)
end
</
<pre>
Simple incrementer
Line 6,068 ⟶ 6,074:
=={{header|Kotlin}}==
{{trans|C}}
<
enum class Dir { LEFT, RIGHT, STAY }
Line 6,239 ⟶ 6,245:
)
).run()
}</
{{out}}
Line 6,291 ⟶ 6,297:
=={{header|Lambdatalk}}==
<
{require lib_H} // associative arrays library
Line 6,422 ⟶ 6,428:
output: busy_beaver2: [] -> [1,1,1,1,1,1,1,1,1,1,1]
</syntaxhighlight>
=={{header|Lua}}==
<
local incrementer = {
name = "Simple incrementer",
Line 6,508 ⟶ 6,514:
UTM(incrementer, {"1", "1", "1"})
UTM(threeStateBB, {})
UTM(fiveStateBB, {}, "countOnly")</
{{out}}
<pre>
Line 6,549 ⟶ 6,555:
Steps taken: 47176870</pre>
=={{header|M2000 Interpreter}}==
<syntaxhighlight lang="m2000 interpreter">
Module CheckIt {
print "Universal Turing Machine"
print "------------------------"
class Machine {
private:
Head=1, Symbols=(,), States=(,)
Initial_State$, Terminating_state$, Blank_Symbol$
BS=0, Rules=list, caption$
tp$="{0:4} {1} {2} {3:5} {4:4}"
public:
Module States {
.States<=array([])
}
Module Symbols {
.Symbols<=array([])
}
Module Reset (.Initial_State$, .Terminating_state$, .Blank_Symbol$) {
if len(.States)=0 then error "No States defined"
if len(.Symbols)=0 then error "No Symbols defined"
if .States#nothave(.Initial_State$) then error "Initial State Not Exist"
if .States#nothave(.Terminating_state$) then error "Terminating State Not Exist"
it=.Symbols#pos(.Blank_Symbol$) : if it=-1 then error "Blank symbol not exist"
.BS<=it
.Rules<=List
}
Module Init (.caption$) {
flush // empty stack
print .caption$
}
Module AddRule (state$, read_symbol$, write_symbol$, action$, end_state$) {
if .States#nothave(state$) then Error "State not exist"
if .symbols#nothave(read_symbol$) then Error "Read Symbol not exist"
if .symbols#nothave(write_symbol$) then Error "Read Symbol not exist"
if ("right","left","stay")#nothave(action$) then Error "Action not exist"
if .States#nothave(end_state$) then Error "End state not exist"
try ok {
tuple=(.symbols#pos(write_symbol$), action$, end_state$)
Append .rules, state$+"_"+read_symbol$:=tuple
}
if not ok then error "rule "+ state$+"_"+read_symbol$+" already exist "
Pen 11 {
Print format$(.tp$, state$, read_symbol$, write_symbol$, action$, end_state$)
}
if stack.size>=5 then loop
}
Module Tape {
s=[]
m=each(s)
while m
it= .Symbols#pos(stackitem$(m))
if it=-1 then error "Tape symbol not exist at position ";m^
data it
end while
}
Module Run (steps as long, display as boolean) {
if len(.rules)=0 then error "No rules found"
if .Initial_State$="" or .Terminating_state$="" or .Blank_Symbol$="" then
error "Reset the machine please"
end if
if empty then push .BS
curState$=.Initial_State$
cont=true
.head<=1
dim inst$() : link inst$() to inst()
while curState$<>.Terminating_state$
if display then pen 15 {showstack()}
steps--
theRule$=curState$+"_"+.symbols#val$(stackitem(.head))
if not exist(.Rules, theRule$) then error "Undefined "+theRule$
inst$()=.Rules(theRule$)
shift .head : drop :push inst(0): shiftback .head
select case inst$(1)
case "right"
.head++ : if .head>stack.size then data .BS
case "left"
if .head<=1 then push .BS else .head--
else case
cont=false
end select
// change state
curState$=inst$(2)
// Show Stack
if steps=0 or not cont then exit
end while
if steps=0 then print over
Pen 12 {showstack()}
print "tape length: ";stack.size : flush
Refresh
sub showstack()
local d$=format$("{0:-5} {1::-5} ", curState$, .head)
local i: for i=1 to min.data(stack.size, 60): d$+=.symbols#val$(stackitem(i)):Next
print d$
end sub
}
}
Turing1=Machine()
For Turing1 {
.init "Simple incrementer"
.States "q0", "qf"
.Symbols "B", "1"
.Reset "q0", "qf", "B" // initial state, terminating state, blank symbol
.AddRule "q0", "1", "1", "right", "q0"
.AddRule "q0", "B", "1", "stay", "qf"
.tape "1", "1", "1"
.Run 100, true
}
Turing2=Machine()
For Turing2 {
.init "Three-state busy beaver"
.States "a", "b", "c", "halt"
.Symbols "0", "1"
.Reset "a", "halt", "0"
.AddRule "a", "0", "1", "right", "b", "a", "1", "1", "left", "c"
.AddRule "b", "0", "1", "left", "a", "b", "1", "1", "right", "b"
.AddRule "c", "0", "1", "left", "b", "c", "1", "1", "stay", "halt"
.Run 1000, true
}
For Turing1 {
.init "Sorter"
.States "A","B","C","D","E","X"
.Symbols "a","b","B","*"
.Reset "A", "X", "*"
.AddRule "A", "a", "a", "right", "A", "A", "b", "B", "right", "B"
.AddRule "A", "*", "*", "left", "E", "B", "a", "a", "right", "B"
.AddRule "B", "b", "b", "right", "B", "B", "*", "*", "left", "C"
.AddRule "C", "a", "b", "left", "D", "C", "b", "b", "left", "C"
.AddRule "C", "B", "b", "left", "E", "D", "a", "a", "left", "D"
.AddRule "D", "b", "b", "left", "D", "D", "B", "a", "right", "A"
.AddRule "E", "a", "a", "left", "E", "E", "*", "*", "right", "X"
.tape "b", "a", "b","b","b","a","a"
.Run 100, false
}
Turing1.tape "b","b","b","a","b","a","b","a","a","a","b","b","a"
Turing1.Run 1000, false
Turing3=Machine()
for Turing3 {
.init "5-state, 2-symbol probable Busy Beaver machine from Wikipedia"
.States "A","B","C","D", "E", "H"
.Symbols "0", "1"
.Reset "A", "H", "0"
.AddRule "A", "0", "1", "right", "B", "A", "1", "1", "left", "C"
.AddRule "B", "0", "1", "right", "C", "B", "1", "1", "right", "B"
.AddRule "C", "0", "1", "right", "D", "C", "1", "1", "left", "E"
.AddRule "D", "0", "1", "left", "A", "D", "1", "1", "left", "D"
.AddRule "E", "0", "1", "stay", "H", "E", "1", "0", "left", "A"
profiler
.Run 470, false //000000, false
Print round(timecount/1000,2);"s" // estimated 12.5 hours for 47000000 steps
}
}
CheckIt
</syntaxhighlight>
{{out}}
<pre>
(CUT VERSION)
Universal Turing Machine
------------------------
Simple incrementer
q0 1 111
q0 2 111
q0 3 111
q0 4 111B
qf 4 1111
tape length: 4
Three-state busy beaver
a 1 0
b 2 10
a 1 11
c 1 011
b 1 0111
a 1 01111
b 2 11111
b 3 11111
b 4 11111
b 5 11111
b 6 111110
a 5 111111
c 4 111111
halt 4 111111
tape length: 6
</pre>
=={{header|Mathematica}}/{{header|Wolfram Language}}==
Line 6,554 ⟶ 6,750:
Updated to use dynamic definition of a function. Values computed for each input are saved.
Functionally equivalent to computing a matrix for a set of inputs.
<syntaxhighlight lang="mathematica">
left = 1; right = -1; stay = 0;
cmp[s_] := ToExpression[StringSplit[s, ","]];
Line 6,572 ⟶ 6,768:
]; {tape, rh}
];
]; </
===A print routine and test drivers===
<syntaxhighlight lang="mathematica">
printMachine[tape_,pos_]:=(mach=IntegerString[tape,2];
ptr=StringReplace[mach,{"0"-> " ","1"->" "}];
Line 6,595 ⟶ 6,791:
fin=utm[Map[cmp,busyBeaver3S],0,0];
printMachine[fin[[1]],fin[[2]]];
</syntaxhighlight>
Summary output from the 2 short machines
Line 6,608 ⟶ 6,804:
Runs in 4 minutes on an i5 desktop (with the dynamic function definiton).
The resulting tape is very long, we'll print the result of treating the value as a binary encoded integer.
<syntaxhighlight lang="mathematica">
probable5S={
"A, 0, 1, right, B",
Line 6,624 ⟶ 6,820:
fin[[1]]//N
3.254757786465838*10^3698</
=={{header|MATLAB}}==
<
%"rules" is cell array of cell arrays of the following form:
%First element is number representing initial state
Line 6,675 ⟶ 6,871:
end
end
end</
{{out}}
<pre>
Line 6,726 ⟶ 6,922:
===The universal machine===
Source for this example was lightly adapted from [https://bitbucket.org/ttmrichter/turing https://bitbucket.org/ttmrichter/turing]. Of particular interest in this implementation is that because of the type parameterisation of the <code>config</code> type, the machine being simulated cannot be compiled if there is any mistake in the states, symbols and actions. Also, because of Mercury's determinism detection and enforcement, it's impossible to pass in a non-deterministic set of rules. At most one answer can come back from the rules interface.
<
:- interface.
Line 6,783 ⟶ 6,979:
action(stay, _, Tape) = Tape.
action(right, Blank, (Left-[])) = ([Blank|Left]-[]).
action(right, _, (Left-[Right|Rights])) = ([Right|Left]-Rights).</
===The incrementer machine===
This machine has been stripped of the Mercury ceremony around modules, imports, etc.
<
:- type incrementer_symbols ---> b ; '1'.
Line 6,803 ⟶ 6,999:
incrementer(a, b, '1', stay, halt).
TapeOut = turing(incrementer_config, incrementer, [1, 1, 1]).</
This will, on execution, fill TapeOut with [1, 1, 1, 1].
===The busy beaver machine===
This machine has been stripped of the Mercury ceremony around modules, imports, etc.
<
:- type busy_beaver_symbols ---> '0' ; '1'.
Line 6,827 ⟶ 7,023:
busy_beaver(c, '1', '1', stay, halt).
TapeOut = turing(busy_beaver_config, busy_beaver, []).</
This will, on execution, fill TapeOut with [1, 1, 1, 1, 1, 1].
Line 6,837 ⟶ 7,033:
This page also has other information, screen shots, etc.
<
;; "A Turing Turtle": a Turing Machine implemented in NetLogo
;; by Dan Dewey 1/16/2016
Line 7,211 ⟶ 7,407:
end
</syntaxhighlight>
=={{header|Nim}}==
{{trans|Python}}
<
proc runUTM(state, halt, blank: string, tape: seq[string] = @[],
Line 7,289 ⟶ 7,485:
"D 3 1 right A".splitWhitespace,
"E 1 1 left E".splitWhitespace,
"E 0 0 right STOP".splitWhitespace])</
{{out}}
Line 8,043 ⟶ 8,239:
=={{header|Perl}}==
<
use warnings;
Line 8,125 ⟶ 8,321:
[qw/D 3 1 right A/],
[qw/E 1 1 left E/],
[qw/E 0 0 right STOP/]];</
=={{header|Phix}}==
{{trans|Lua}}
<!--<
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">enum</span> <span style="color: #000000;">name</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">initState</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">endState</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">blank</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">rules</span>
Line 8,228 ⟶ 8,424:
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #0000FF;">?</span><span style="color: #7060A8;">elapsed</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">time</span><span style="color: #0000FF;">()-</span><span style="color: #000000;">t0</span><span style="color: #0000FF;">)</span>
<!--</
{{Out}}
<pre>
Line 8,271 ⟶ 8,467:
=={{header|PHL}}==
<
extern printf;
Line 8,422 ⟶ 8,618:
emulateTuring(rules, 0, 3, tape, 0);
return 0;
]</
Output:
Line 8,468 ⟶ 8,664:
=={{header|PicoLisp}}==
<
(de turing (Tape Init Halt Blank Rules Verbose)
(let
Line 8,543 ⟶ 8,739:
(println '1s: (cnt '((X) (= 1 X)) Tape)) )
(bye)</
{{out}}
<pre>"Simple incrementer"
Line 8,573 ⟶ 8,769:
===The universal machine===
Source for this example was lightly adapted from [https://bitbucket.org/ttmrichter/turing https://bitbucket.org/ttmrichter/turing]. This machine, because of Prolog's dynamic nature, has to check its configuration and the rules' compliance to the same at run-time. This is the role of all but the first of the <code>memberchk/2</code> predicates. In addition, calling the user-supplied rules has to be wrapped in a <code>once/1</code> wrapper because there is no way to guarantee in advance that the rules provided are deterministic. (An alternative to doing this is to simply allow <code>perform/5</code> to be non-deterministic or to check for multiple results and report an error on such.)
<
call(Config, IS, _, _, _, _),
perform(Config, Rules, IS, {[], TapeIn}, {Ls, Rs}),
Line 8,603 ⟶ 8,799:
right(L, [], [B|L], [], B).
right(L, [S|Rs], [S|L], Rs, _).</
===The incrementer machine===
<
IS = q0, % initial state
FS = [qf], % halting states
Line 8,614 ⟶ 8,810:
incrementer(q0, b, 1, stay, qf).
turing(incrementer_config, incrementer, [1, 1, 1], TapeOut).</
This will, on execution, fill TapeOut with [1, 1, 1, 1].
===The busy beaver machine===
<
IS = 'A', % initial state
FS = ['HALT'], % halting states
Line 8,630 ⟶ 8,826:
busy_beaver('C', 1, 1, stay, 'HALT').
turing(busy_beaver_config, busy_beaver, [], TapeOut).</
This will, on execution, fill TapeOut with [1, 1, 1, 1, 1, 1].
=={{header|Python}}==
{{trans|Perl}}
<
def run_utm(
Line 8,722 ⟶ 8,918:
)
)
</syntaxhighlight>
=={{header|Racket}}==
<
#lang racket
;;;=============================================================
Line 8,823 ⟶ 9,019:
(match-lambda ['(a b) '(c d e)] ... [x x])
l start))))
</syntaxhighlight>
The resulting Turing Machine is a function that maps the initial tape record to the final one, so that several machines could run one after another or composed as any other functions
Line 8,830 ⟶ 9,026:
The simple incrementer:
<
(define INC
(Turing-Machine #:start 'q0
[q0 1 1 right q0]
[q0 () 1 stay qf]))
</syntaxhighlight>
<pre>
> (INC '(1 1 1))
Line 8,849 ⟶ 9,045:
The incrementer for binary numbers
<
(define ADD1
(Turing-Machine #:start 'Start
Line 8,858 ⟶ 9,054:
[Add 1 0 left Add]
[Add () 1 stay End]))
</syntaxhighlight>
<pre>
> (ADD1 '(1 1 0))
Line 8,892 ⟶ 9,088:
The busy beaver
<
(define BEAVER
(Turing-Machine #:start 'a
Line 8,901 ⟶ 9,097:
[c () 1 left b]
[c 1 1 stay halt]))
</syntaxhighlight>
<pre>
> (BEAVER '(()))
Line 8,923 ⟶ 9,119:
The sorting machine
<
(define SORT
(Turing-Machine #:start 'A
Line 8,940 ⟶ 9,136:
[E 1 1 left E]
[E () () right STOP]))
</syntaxhighlight>
<pre>
> (SORT '(2 1 2 2 2 1 1))
Line 8,992 ⟶ 9,188:
{{trans|Perl}}
{{works with|Rakudo|2018.03}}
<syntaxhighlight lang="raku"
$pos += @tape if $pos < 0;
die "Bad initial position" unless $pos ~~ ^@tape;
Line 9,075 ⟶ 9,271:
[< E 0 0 right STOP >]
];
</syntaxhighlight>
{{out}}
Line 9,238 ⟶ 9,434:
Minimal error checking is done, but if no rule is found to be applicable, an appropriate error message is issued.
===incrementer machine===
<
state = 'q0' /*the initial Turing machine state. */
term = 'qf' /*a state that is used for a halt. */
Line 9,281 ⟶ 9,477:
pad=left('', length( word( arg(1),2 ) ) \==1 ) /*padding for rule*/
rule.rules=arg(1); say right('rule' rules, 20) "═══►" rule.rules
return</
'''output'''
<pre>
Line 9,293 ⟶ 9,489:
===three-state busy beaver===
<
state = 'a' /*the initial Turing machine state. */
term = 'halt' /*a state that is used for a halt. */
Line 9,307 ⟶ 9,503:
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
TM: ∙∙∙ </
'''output'''
<pre>
Line 9,323 ⟶ 9,519:
===five-state busy beaver===
<
state = 'A' /*initialize the Turing machine state.*/
term = 'H' /*a state that is used for the halt. */
Line 9,341 ⟶ 9,537:
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
TM: ∙∙∙ </
'''output'''
<pre>
Line 9,373 ⟶ 9,569:
===stress sort===
<
state = 'A' /*the initial Turing machine state. */
term = 'halt' /*a state that is used for the halt. */
Line 9,395 ⟶ 9,591:
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
TM: ∙∙∙ </
'''output'''
<pre>
Line 9,420 ⟶ 9,616:
=={{header|Ruby}}==
===The universal machine===
<
class Tape
def initialize(symbols, blank, starting_tape)
Line 9,481 ⟶ 9,677:
return @tape.get_tape
end
end</
===The incrementer machine===
<
:q0 => { 1 => [1, :right, :q0],
:b => [1, :stay, :qf]}
Line 9,495 ⟶ 9,691:
incrementer_rules, # operating rules
[1, 1, 1]) # starting tape
print t.run, "\n"</
===The busy beaver machine===
<
:a => { 0 => [1, :right, :b],
1 => [1, :left, :c]},
Line 9,513 ⟶ 9,709:
busy_beaver_rules, # operating rules
[]) # starting tape
print t.run, "\n"</
=={{header|Rust}}==
<
use std::fmt::{Display, Formatter, Result};
Line 9,658 ⟶ 9,854:
}
}
</syntaxhighlight>
{{out}}
<pre>
Line 9,691 ⟶ 9,887:
A simple implementation of Universal Turing Machine in Scala:
<
package utm.scala
Line 9,918 ⟶ 10,114:
}
</syntaxhighlight>
{{output}}
<pre>
Line 9,947 ⟶ 10,143:
{{works with|Chez Scheme}}
'''The Implementation'''
<syntaxhighlight lang="scheme">;----------------------------------------------------------------------------------------------
; The
; to the cell on its right, and the car is a vector containing: 0: the value of the cell;
; 1: pointer to the cell on this cell's left; 2: #t if the cell has never been written.
; Make a new cell with the given contents, but linked to no other cell(s).
; (This is the only place that a cell can be marked as un-written.)
(define make-cell
(lambda (val . opt-unwrit)
(list (vector val '() (if (pair? opt-unwrit) (car opt-unwrit) #f)))))
; Return the un-written flag of the cell.
(define cell-unwrit?
(lambda (cell)
(vector-ref (car cell) 2)))
; Return the value of the cell.
(define cell-get
(lambda (cell)
(
; Store the value of the cell.
; Clears the un-written flag of the cell.
(define cell-set!
(lambda (cell val)
(vector-set
(vector-set! (car cell) 2 #f)))
; Return the cell to the right of the given cell on the tape.
Line 9,971 ⟶ 10,182:
(define cell-left
(lambda (cell)
(
; Return the cell to the right of the given cell on the tape.
; Extends the tape with the give blank symbol if there is no cell to the right.
; Optionally, passes the given un-written flag to make-cell (if needed).
(define cell-extend-right
(lambda (cell blank . opt-unwrit)
(if (null? (cdr cell))
(let ((new (
(vector-set! (car new) 1 cell)
(set-cdr! cell new)
new)
(
; Return the cell to the left of the given cell on the tape.
; Extends the tape with the give blank symbol if there is no cell to the left.
; Optionally, passes the given un-written flag to make-cell (if needed).
(define cell-extend-left
(lambda (cell blank . opt-unwrit)
(if (null? (
(let ((new (
(set-cdr!
(vector-set! (car cell) 1 new)
new)
(
; Make a new tape whose cells contain the values in the given list.
; Optionally, pad the tape per the given blank symbol, left-padding and right-padding amounts.
(define make-tape
(lambda (values . opt-pads)
(
(
(cell tape (cell-extend-right cell (
((null? values) cell))))
(when (pair? opt-pads)
(let ((blank (list-ref opt-pads 0))
(left (list-ref opt-pads 1))
(right (list-ref opt-pads 2)))
(unless (and (integer? left) (integer? right))
(error 'make-tape "padding arguments must be integers" opt-pads))
(do ((count 0 (1+ count))
(cell last (cell-extend-right cell blank #t)))
((>= count right)))
(do ((count 0 (1+ count))
(cell tape (cell-extend-left cell blank #t)))
((>= count left)))))
tape)))
Line 10,006 ⟶ 10,235:
(define tape-copy
(lambda (tape)
(let ((copy (
(do ((tape (cdr tape) (cdr tape))
(cell copy (cell-extend-right cell (cell-get tape))))
Line 10,013 ⟶ 10,242:
; Return the first cell on a tape.
; Optionally, leading blank symbols are not included (will return last cell of blank tape).
(define tape-fst
(lambda (cell . opt-blank)
Line 10,023 ⟶ 10,252:
; Return the last cell on a tape.
; Optionally, trailing blank symbols are not included (will return first cell of blank tape).
(define tape-lst
(lambda (cell . opt-blank)
Line 10,032 ⟶ 10,261:
((or (null? (cell-left lst)) (not (eq? (car opt-blank) (cell-get lst)))) lst))))))
; Return true if the given tape is empty. (I.e. contains nothing but blank symbols.)
(define tape-empty?
(lambda (cell blank)
(let ((fst (tape-fst cell blank)))
(
; Convert the contents of a tape to a string.
Line 10,045 ⟶ 10,271:
; Prints the entire contents regardless of which cell is given.
; Optionally, leading and trailing instances of the given blank symbol are suppressed.
; The values of un-written cells are not shown, though space for them is included.
(define tape->string
(lambda (cell mark . opt-blank)
(let ((strlst (list #\[))
(marked-prev #f)
(fst (if (null? opt-blank) (tape-fst cell) (tape-fst cell (car opt-blank))))
(lst (if (null? opt-blank) (tape-lst cell) (tape-lst cell (car opt-blank)))))
(do ((cell fst (cell-right cell)))
((eq? cell (cell-right lst)))
(
(fmtstr (cond (mark-now " {~a}") (marked-prev " ~a") (else " ~a")))
(
(set! marked-prev mark-now)))
(list->string (append strlst (string->list (if marked-prev " ]" " ]")))))))
;----------------------------------------------------------------------------------------------
; A Turing Machine contains the 7-tuple that formally defines it, stored in an array to
Line 10,131 ⟶ 10,363:
; Return the transitions of a Turing Machine.
(define-syntax turing-transitions (syntax-rules () ((_ tm) (vector-ref tm 6))))
; Return the q_i (current state) of alist element transition.
(define-syntax tran-q_i (syntax-rules () ((_ atran) (car (car atran)))))
; Return the s_j (symbol read from the tape) of alist element transition.
(define-syntax tran-s_j (syntax-rules () ((_ atran) (cdr (car atran)))))
; Return the s_ij (symbol written) of alist element transition.
Line 10,145 ⟶ 10,383:
(lambda (state symbol tm)
(assoc (cons state symbol) (turing-transitions tm))))
; Convert the given Turing Machine transition to a string.
(define tran->string
(lambda (atran)
(format "(~a ~a ~a ~a ~a)"
(tran-q_i atran) (tran-s_j atran) (tran-s_ij atran) (tran-d_ij atran) (tran-q_ij atran))))
; Convert the given Turing Machine definition to a string.
; Options (zero or more) are, in order: component prefix string (default "");
; component suffix string (default ""); component separator string (default newline).
(define turing->string
(lambda (tm . opts)
(let ((prestr (if (> (length opts) 0) (list-ref opts 0) ""))
(sufstr (if (> (length opts) 1) (list-ref opts 1) ""))
(sepstr (if (> (length opts) 2) (list-ref opts 2) (make-string 1 #\newline)))
(strlst '()))
(set! strlst (append strlst (string->list
(format "~a~a~a~a" prestr (turing-symbols tm) sufstr sepstr))))
(set! strlst (append strlst (string->list
(format "~a~a~a~a" prestr (turing-blank tm) sufstr sepstr))))
(set! strlst (append strlst (string->list
(format "~a~a~a~a" prestr (turing-inputs tm) sufstr sepstr))))
(set! strlst (append strlst (string->list
(format "~a~a~a~a" prestr (turing-states tm) sufstr sepstr))))
(set! strlst (append strlst (string->list
(format "~a~a~a~a" prestr (turing-initial tm) sufstr sepstr))))
(set! strlst (append strlst (string->list
(format "~a~a~a~a" prestr (turing-finals tm) sufstr
(if (> (length (turing-transitions tm)) 0) sepstr "")))))
(do ((index 0 (1+ index)))
((>= index (length (turing-transitions tm))))
(set! strlst (append strlst (string->list
(format "~a~a~a~a" prestr (tran->string (list-ref (turing-transitions tm) index)) sufstr
(if (< index (1- (length (turing-transitions tm)))) sepstr ""))))))
(list->string strlst))))
;----------------------------------------------------------------------------------------------
; Run the given Turing Machine on the given input tape.
Line 10,152 ⟶ 10,427:
(define turing-run
(lambda (tm cell show-log? . opt-abort)
; Validate contents of input tape. (
(
(let
((eq? cell (cell-right lst)))
(unless (memq (cell-get cell) (turing-inputs tm))
(error 'turing-run "input tape has disallowed content" (cell-get cell)))))))
; Initialize state and head.
(let ((state (turing-initial tm)) (head cell) (atran #f)
Line 10,169 ⟶ 10,447:
(atrns-lookup state (cell-get head) tm)))
((or (not atran) (memq state (turing-finals tm)) (and abort (>= count abort)))
; Display final progress (optional).
(when show-log?
(let* ((string (format "~a" state))
(strlen (string-length string))
(padlen (max 1 (- 25 strlen)))
(strpad (make-string padlen #\ )))
(printf "~a~a~a~%" string strpad (tape->string cell head))))
; Return resultant count, accepting state (or void), and tape.
(values count (if (memq state (turing-finals tm)) state (void)) head))
; Display progress (optional).
(when show-log?
(let* ((string (format "~
(tran-s_ij atran) (tran-d_ij atran) (tran-q_ij atran)))
(strlen (string-length string))
(padlen (max 1 (-
(strpad (make-string padlen #\ )))
(printf "~a~a~a~%" string strpad (tape->string cell head))))
Line 10,183 ⟶ 10,470:
((L) (cell-extend-left head (turing-blank tm)))
((R) (cell-extend-right head (turing-blank tm)))
((N) head)))))))
;----------------------------------------------------------------------------------------------</syntaxhighlight>
'''Test Runner'''
<syntaxhighlight lang="scheme">;----------------------------------------------------------------------------------------------
; Run specified tests: A caption string, a Turing machine, a list of tests, and options (if
; 'notm present, do not output the Turing Machine definition (otherwise display it); if 'supp
; present, suppress leading/trailing blanks; 'mark present, mark the output tape; if 'supp
; present, suppress leading/trailing blanks; if 'leng present, print only the length of the
; output tape, not the contents of either; if 'show present, show an empty input tape (by
; default empty inputs are not shown)). A test is a list of: limit count (0 = unlimited),
; #t to log progress, and the input tape.
(define run-tm-tests
(lambda (caption tm test-lst . opts)
(printf "~%~a...~%" caption)
(unless (memq 'notm opts) (printf "~%~a~%" (turing->string tm)))
(let ((input #f))
(let loop ((tests test-lst))
Line 10,210 ⟶ 10,505:
(tape->string output (if (memq 'mark opts) output #f)))))
(printf "count = ~d~%accept = ~a~%" count accepting)
(
(printf "input = ~a~%" instr))
(printf "output = ~a~%" outstr))))
(loop (cdr tests)))))))
;----------------------------------------------------------------------------------------------</syntaxhighlight>
'''The Task'''
<
"Simple incrementer"
(make-turing
Line 10,228 ⟶ 10,526:
(list 0 #t (make-tape '(1 1 1)))
(list 0 #t (make-tape '(B)))
) 'notm 'mark)
(run-tm-tests
Line 10,246 ⟶ 10,544:
'(c 1 1 N halt))
(list
(list 0 #t (make-tape '(0) 0 3 2)) ; padding determined empirically
) 'notm 'mark)
(run-tm-tests
Line 10,270 ⟶ 10,568:
(list
(list 0 #f (make-tape '(0)))
) 'notm 'leng)</
{{out}}
<pre style="height: 75ex; overflow: scroll">
Simple incrementer...
q0 1
q0 1
q0 1
q0 B
qf [ 1 1 1 {1} ]
count = 4
accept = qf
input = [ 1 1 1 ]
output = [ 1 1 1 {1} ]
q0 B
qf [ {1} ]
count = 1
accept = qf
Line 10,291 ⟶ 10,591:
Three-state busy beaver...
a 0
b 0
a 1
c 0
b 0
a 0
b 1
b 1
b 1
b 1
b 0
a 1
c 1
halt [ 1 1 1 {1} 1 1 ]
count = 13
accept = halt
output = [ 1 1 1 {1} 1 1 ]
5-state 2-symbol probable busy beaver...
Line 10,315 ⟶ 10,616:
</pre>
'''More Examples'''
<
"Sorting test"
(make-turing
Line 10,326 ⟶ 10,627:
'(A 1 1 R A)
'(A 2 3 R B)
'(A 0 0 L
'(B 1 1 R B)
'(B 2 2 R B)
'(B 0 0 L
'(C 1 2 L
'(C 2 2 L
'(C 3 2 L
'(D 1 1 L
'(D 2 2 L
'(D 3 1 R A)
'(E 1 1 L
'(E 0 0 R STOP))
(list
(list 0 #t (make-tape '(2 2 2 1 2 2 1 2 1 2 1 2 1 2) 0 1 1)) ; padding determined empirically
) 'notm 'supp)
(run-tm-tests
Line 10,362 ⟶ 10,663:
'(s5 1 1 L s5))
(list
(list 0 #t (make-tape '(1 1 1) 0 0 4)) ; padding determined empirically
) 'notm 'supp)
(run-tm-tests
Line 10,380 ⟶ 10,681:
(list
(list 20 #t (make-tape '(_)))
) 'notm 'mark)
(run-tm-tests
Line 10,388 ⟶ 10,689:
'_
'(1 2)
'(
'
'(odd even)
; branch to look for 1 or 2 at end
'(
'(
'(
; walk right to end for 1
'(r1 1 1 R r1)
Line 10,400 ⟶ 10,701:
'(r1 _ _ L e1)
; check end symbol for 1
'(e1 1 _ L
'(e1 _ _ N odd)
; walk right to end for 2
'(r2 2 2 R r2)
Line 10,411 ⟶ 10,708:
'(r2 _ _ L e2)
; check end symbol for 2
'(e2 2 _ L
'(e2 _ _ N odd)
; walk left to
'(
'(
'(
(list
(list 0 #t (make-tape '(1 2 1)))
Line 10,427 ⟶ 10,724:
(list 0 #f (make-tape '(1 1 2 2 1 1)))
(list 0 #f (make-tape '(1 1 2 2 1 2)))
) 'notm 'mark)</
{{out}}
<pre style="height: 107ex; overflow: scroll">
Sorting test...
A 2
B 2
B 2
B 1
B 2
B 2
B 1
B 2
B 1
B 2
B 1
B 2
B 1
B 2
B 0
C 2
C 1
D 2
D 1
D 2
D 1
D 2
D 1
D 2
D 2
D 1
D 2
D 2
D 3
A 2
B 2
B 1
B 2
B 2
B 1
B 2
B 1
B 2
B 1
B 2
B 2
B 2
B 0
C 2
C 2
C 2
C 1
D 2
D 1
D 2
D 1
D 2
D 2
D 1
D 2
D 3
A 2
B 1
B 2
B 2
B 1
B 2
B 1
B 2
B 2
B 2
B 2
B 2
B 0
C 2
C 2
C 2
C 2
C 2
C 1
D 2
D 1
D 2
D 2
D 1
D 3
A 1
A 2
B 2
B 1
B 2
B 2
B 2
B 2
B 2
B 2
B 2
B 0
C 2
C 2
C 2
C 2
C 2
C 2
C 2
C 1
D 2
D 3
A 2
B 2
B 2
B 2
B 2
B 2
B 2
B 2
B 2
B 0
C 2
C 2
C 2
C 2
C 2
C 2
C 2
C 2
C 3
E 1
E 1
E 1
E 1
E 1
E 0
STOP [ 0 {1} 1 1 1 1 2 2 2 2 2 2 2 2 2 0 ]
count = 128
accept = STOP
input = [ 2 2 2 1 2 2 1 2 1 2 1 2 1 2 ]
output = [ 1 1 1 1 1 2 2 2 2 2 2 2 2 2 ]
Duplicate sequence of 1s...
s1 1
s2 1
s2 1
s2 0
s3 0
s4 0
s5 1
s5 1
s5 0
s1 1
s2 1
s2 0
s3 1
s3 0
s4 1
s4 0
s5 1
s5 0
s1 1
s2 0
s3 1
s3 1
s3 0
s4 1
s4 1
s4 0
s5 0
s1 0
H [ 1 1 1 {0} 1 1 1 ]
count = 28
accept = H
input = [ 1 1 1 ]
output = [ 1 1 1 0 1 1 1 ]
Turing's first example from On Computable Numbers...
b _
c _
e _
f _
b _
c _
e _
f _
b _
c _
e _
f _
b _
c _
e _
f _
b _
c _
e _
f _
b [ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ {_} ]
count = 20
accept = #<void>
output = [ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ {_} ]
Palindrome checker...
r1 2
r1 1
r1 _
e1 1
r2 _
e2 _
odd [ _ {_} _ _ ]
count = 10
accept = odd
input = [ 1 2 1 ]
output = [ _ {_} _ _ ]
r1 2
r1 2
r1 _
e1 [ _ 2 {2} _ ]
count = 4
accept = #<void>
input = [ 1 2 2 ]
output = [ _ 2 {2} _ ]
r1 1
r1 _
e1 1
even [ _ {_} _ ]
count = 6
accept = even
input = [ 1 1 ]
output = [ _ {_} _ ]
r2 1
r2 _
e2 [ _ {1} _ ]
count = 3
accept = #<void>
input = [ 2 1 ]
output = [ _ {1} _ ]
r1 _
e1 _
odd [ {_} _ ]
count = 3
accept = odd
input = [ 1 ]
output = [ {_} _ ]
count = 21
accept = odd
input = [ 2 1 1 1 2 ]
output = [ _ _ {_} _ _ _ ]
count = 15
accept = #<void>
input = [ 2 1 1 2 2 ]
output = [ _ _ 1 {2} _ _ ]
count = 28
accept = even
input = [ 1 1 2 2 1 1 ]
output = [ _ _ _ {_} _ _ _ ]
count = 7
accept = #<void>
input = [ 1 1 2 2 1 2 ]
output = [ _ 1 2 2 1 {2} _ ]
</pre>
Line 10,703 ⟶ 11,008:
This implemetnation is based on the Computing Machines introduced in Turing's 1936 paper [https://www.cs.virginia.edu/~robins/Turing_Paper_1936.pdf ON COMPUTABLE NUMBERS, WITH AN APPLICATION TO THE ENTSCHEIDUNGSPROBLEM]. With the exception of "skeleton tables".<br>
'''SequenceL Code:'''<br>
<
import <Utilities/Conversion.sl>;
Line 10,920 ⟶ 11,225:
(CurrentConfig: mConfig.FinalConfig, CurrentPosition: newState.CurrentPosition, Tape: newState.Tape);
//endregion</
'''C++ Driver Code:'''<br>
<
#include <fstream>
#include <string>
Line 10,989 ⟶ 11,294:
}
throw(errno);
}</
'''Turing Machine Files'''<br />
Line 11,128 ⟶ 11,433:
=={{header|Sidef}}==
{{trans|Raku}}
<
if (pos < 0) {
Line 11,225 ⟶ 11,530:
%w(E 1 1 left E),
%w(E 0 0 right STOP),
]);</
=={{header|Standard ML}}==
Line 11,239 ⟶ 11,544:
<
signature TAPE = sig
Line 11,570 ⟶ 11,875:
val () = simulate_int sorting NONE
end
</syntaxhighlight>
{{output}}
Line 11,657 ⟶ 11,962:
=={{header|Tcl}}==
<
set state $initial
set idx 0
Line 11,693 ⟶ 11,998:
}
return [join $tape ""]
}</
Demonstrating:
<
puts TAPE=[turing {q0 qf} q0 qf {1 B} B "111" {
{q0 1 1 right q0}
Line 11,726 ⟶ 12,031:
{E 1 1 left E}
{E 0 0 right H}
} no]</
{{out}}
<pre>
Line 11,773 ⟶ 12,078:
=={{header|UNIX Shell}}==
{{works with|Bourne Again Shell|4+}}
<
main() {
printf 'Simple Incrementer\n'
Line 11,838 ⟶ 12,143:
main "$@"
</syntaxhighlight>
{{Output}}
<pre>Simple Incrementer
Line 11,864 ⟶ 12,169:
=={{header|VBA}}==
{{trans|Phix}}<
Public Enum sett
name_ = 1
Line 11,976 ⟶ 12,281:
Set tap = New Collection
UTM fiveStateBB, tap, countOnly:=-1
End Sub</
<pre>Simple incrementer
==================
Line 12,014 ⟶ 12,319:
{{libheader|Wren-dynamic}}
{{libheader|Wren-fmt}}
<
import "./fmt" for Fmt
var Dir = Enum.create("Dir", ["LEFT", "RIGHT", "STAY"])
Line 12,167 ⟶ 12,472:
Rule.new("E", "1", "0", Dir.LEFT, "A")
]
).run(20)</
{{out}}
Line 12,220 ⟶ 12,525:
=={{header|Yabasic}}==
{{trans|Lua}}
<
name = 1 : initState = 2 : endState = 3 : blank = 4 : countOnly = true
Line 12,332 ⟶ 12,637:
UTM(incrementer$, "111")
UTM(threeStateBB$, " ")
UTM(fiveStateBB$, " ", countOnly)</
=={{header|zkl}}==
This uses a dictionary/hash to hold the tape, limiting the length to 64k.
{{Trans|D}}
<
// blank symbol and terminating state(s) are Void
var Lt=-1, Sy=0, Rt=1; // Left, Stay, Right
Line 12,356 ⟶ 12,661:
tape[pos]=r[0];
return(self.fcn(r[2],tape,pos+r[1],rules,verbose,n+1));
}</
D is a dictionary, SD is a small fixed (at runtime) dictionary
<
turing("q0",D(0,Rt, 1,Rt, 2,Rt),0, // Incrementer
D("q0",D(1,T(1,Rt,"q0"), Void,T(1,Sy,Void)) ) );
Line 12,382 ⟶ 12,687:
"C",D(Void,T(1,Rt,"D"), 1,T(Void,Lt,"E")),
"D",D(Void,T(1,Lt,"A"), 1,T(1, Lt,"D")),
"E",D(Void,T(1,Sy,Void), 1,T(Void,Lt,"A")) ) ,False);</
{{out}}
<pre>
|