Universal Turing machine: Difference between revisions
Content deleted Content added
m sorting |
|||
(107 intermediate revisions by 21 users not shown) | |||
Line 2:
One of the foundational mathematical constructs behind computer science
is the [[wp:Universal Turing machine|universal Turing Machine]].
(Alan Turing introduced the idea of such a machine in 1936–1937.)
Indeed one way to definitively prove that a language
Line 9 ⟶ 12:
;Task:
Simulate such a machine capable
of taking the definition of any other Turing machine and executing it.
Line 80 ⟶ 82:
This machine runs for more than 47 millions steps.
<br><br>
=={{header|11l}}==
{{trans|Python}}
<syntaxhighlight lang="11l">F run_utm(halt, state, Char blank; rules_in, [Char] &tape = [Char](); =pos = 0)
V st = state
I tape.empty
tape.append(blank)
I pos < 0
pos += tape.len
V rules = Dict(rules_in, r -> ((r[0], Char(r[1])), (Char(r[2]), r[3], r[4])))
L
print(st.ljust(4), end' ‘ ’)
L(v) tape
V i = L.index
I i == pos
print(‘[’v‘]’, end' ‘ ’)
E
print(v, end' ‘ ’)
print()
I st == halt
L.break
I (st, tape[pos]) !C rules
L.break
V (v1, dr, s1) = rules[(st, tape[pos])]
tape[pos] = v1
I dr == ‘left’
I pos > 0
pos--
E
tape.insert(0, blank)
I dr == ‘right’
pos++
I pos >= tape.len
tape.append(blank)
st = s1
print("incr machine\n")
run_utm(
halt' ‘qf’,
state' ‘q0’,
blank' Char(‘B’),
rules_in' [‘q0 1 1 right q0’.split(‘ ’, group_delimiters' 1B),
‘q0 B 1 stay qf’.split(‘ ’, group_delimiters' 1B)],
tape' &[‘1’, ‘1’, ‘1’]
)
print("\nbusy beaver\n")
run_utm(
halt' ‘halt’,
state' ‘a’,
blank' Char(‘0’),
rules_in'
[‘a 0 1 right b’.split(‘ ’, group_delimiters' 1B),
‘a 1 1 left c’.split(‘ ’, group_delimiters' 1B),
‘b 0 1 left a’.split(‘ ’, group_delimiters' 1B),
‘b 1 1 right b’.split(‘ ’, group_delimiters' 1B),
‘c 0 1 left b’.split(‘ ’, group_delimiters' 1B),
‘c 1 1 stay halt’.split(‘ ’, group_delimiters' 1B)]
)
print("\nsorting test\n")
run_utm(
halt' ‘STOP’,
state' ‘A’,
blank' Char(‘0’),
rules_in'
[‘A 1 1 right A’.split(‘ ’, group_delimiters' 1B),
‘A 2 3 right B’.split(‘ ’, group_delimiters' 1B),
‘A 0 0 left E’.split(‘ ’, group_delimiters' 1B),
‘B 1 1 right B’.split(‘ ’, group_delimiters' 1B),
‘B 2 2 right B’.split(‘ ’, group_delimiters' 1B),
‘B 0 0 left C’.split(‘ ’, group_delimiters' 1B),
‘C 1 2 left D’.split(‘ ’, group_delimiters' 1B),
‘C 2 2 left C’.split(‘ ’, group_delimiters' 1B),
‘C 3 2 left E’.split(‘ ’, group_delimiters' 1B),
‘D 1 1 left D’.split(‘ ’, group_delimiters' 1B),
‘D 2 2 left D’.split(‘ ’, group_delimiters' 1B),
‘D 3 1 right A’.split(‘ ’, group_delimiters' 1B),
‘E 1 1 left E’.split(‘ ’, group_delimiters' 1B),
‘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)
)</syntaxhighlight>
{{out}}
<pre style="height:30ex;overflow:scroll">
incr machine
q0 [1] 1 1
q0 1 [1] 1
q0 1 1 [1]
q0 1 1 1 [B]
qf 1 1 1 [1]
busy beaver
a [0]
b 1 [0]
a [1] 1
c [0] 1 1
b [0] 1 1 1
a [0] 1 1 1 1
b 1 [1] 1 1 1
b 1 1 [1] 1 1
b 1 1 1 [1] 1
b 1 1 1 1 [1]
b 1 1 1 1 1 [0]
a 1 1 1 1 [1] 1
c 1 1 1 [1] 1 1
halt 1 1 1 [1] 1 1
sorting test
A [2] 2 2 1 2 2 1 2 1 2 1 2 1 2
B 3 [2] 2 1 2 2 1 2 1 2 1 2 1 2
B 3 2 [2] 1 2 2 1 2 1 2 1 2 1 2
B 3 2 2 [1] 2 2 1 2 1 2 1 2 1 2
B 3 2 2 1 [2] 2 1 2 1 2 1 2 1 2
B 3 2 2 1 2 [2] 1 2 1 2 1 2 1 2
B 3 2 2 1 2 2 [1] 2 1 2 1 2 1 2
B 3 2 2 1 2 2 1 [2] 1 2 1 2 1 2
B 3 2 2 1 2 2 1 2 [1] 2 1 2 1 2
B 3 2 2 1 2 2 1 2 1 [2] 1 2 1 2
B 3 2 2 1 2 2 1 2 1 2 [1] 2 1 2
B 3 2 2 1 2 2 1 2 1 2 1 [2] 1 2
B 3 2 2 1 2 2 1 2 1 2 1 2 [1] 2
B 3 2 2 1 2 2 1 2 1 2 1 2 1 [2]
B 3 2 2 1 2 2 1 2 1 2 1 2 1 2 [0]
C 3 2 2 1 2 2 1 2 1 2 1 2 1 [2] 0
C 3 2 2 1 2 2 1 2 1 2 1 2 [1] 2 0
D 3 2 2 1 2 2 1 2 1 2 1 [2] 2 2 0
D 3 2 2 1 2 2 1 2 1 2 [1] 2 2 2 0
D 3 2 2 1 2 2 1 2 1 [2] 1 2 2 2 0
D 3 2 2 1 2 2 1 2 [1] 2 1 2 2 2 0
D 3 2 2 1 2 2 1 [2] 1 2 1 2 2 2 0
D 3 2 2 1 2 2 [1] 2 1 2 1 2 2 2 0
D 3 2 2 1 2 [2] 1 2 1 2 1 2 2 2 0
D 3 2 2 1 [2] 2 1 2 1 2 1 2 2 2 0
D 3 2 2 [1] 2 2 1 2 1 2 1 2 2 2 0
D 3 2 [2] 1 2 2 1 2 1 2 1 2 2 2 0
D 3 [2] 2 1 2 2 1 2 1 2 1 2 2 2 0
D [3] 2 2 1 2 2 1 2 1 2 1 2 2 2 0
A 1 [2] 2 1 2 2 1 2 1 2 1 2 2 2 0
B 1 3 [2] 1 2 2 1 2 1 2 1 2 2 2 0
B 1 3 2 [1] 2 2 1 2 1 2 1 2 2 2 0
B 1 3 2 1 [2] 2 1 2 1 2 1 2 2 2 0
B 1 3 2 1 2 [2] 1 2 1 2 1 2 2 2 0
B 1 3 2 1 2 2 [1] 2 1 2 1 2 2 2 0
B 1 3 2 1 2 2 1 [2] 1 2 1 2 2 2 0
B 1 3 2 1 2 2 1 2 [1] 2 1 2 2 2 0
B 1 3 2 1 2 2 1 2 1 [2] 1 2 2 2 0
B 1 3 2 1 2 2 1 2 1 2 [1] 2 2 2 0
B 1 3 2 1 2 2 1 2 1 2 1 [2] 2 2 0
B 1 3 2 1 2 2 1 2 1 2 1 2 [2] 2 0
B 1 3 2 1 2 2 1 2 1 2 1 2 2 [2] 0
B 1 3 2 1 2 2 1 2 1 2 1 2 2 2 [0]
C 1 3 2 1 2 2 1 2 1 2 1 2 2 [2] 0
C 1 3 2 1 2 2 1 2 1 2 1 2 [2] 2 0
C 1 3 2 1 2 2 1 2 1 2 1 [2] 2 2 0
C 1 3 2 1 2 2 1 2 1 2 [1] 2 2 2 0
D 1 3 2 1 2 2 1 2 1 [2] 2 2 2 2 0
D 1 3 2 1 2 2 1 2 [1] 2 2 2 2 2 0
D 1 3 2 1 2 2 1 [2] 1 2 2 2 2 2 0
D 1 3 2 1 2 2 [1] 2 1 2 2 2 2 2 0
D 1 3 2 1 2 [2] 1 2 1 2 2 2 2 2 0
D 1 3 2 1 [2] 2 1 2 1 2 2 2 2 2 0
D 1 3 2 [1] 2 2 1 2 1 2 2 2 2 2 0
D 1 3 [2] 1 2 2 1 2 1 2 2 2 2 2 0
D 1 [3] 2 1 2 2 1 2 1 2 2 2 2 2 0
A 1 1 [2] 1 2 2 1 2 1 2 2 2 2 2 0
B 1 1 3 [1] 2 2 1 2 1 2 2 2 2 2 0
B 1 1 3 1 [2] 2 1 2 1 2 2 2 2 2 0
B 1 1 3 1 2 [2] 1 2 1 2 2 2 2 2 0
B 1 1 3 1 2 2 [1] 2 1 2 2 2 2 2 0
B 1 1 3 1 2 2 1 [2] 1 2 2 2 2 2 0
B 1 1 3 1 2 2 1 2 [1] 2 2 2 2 2 0
B 1 1 3 1 2 2 1 2 1 [2] 2 2 2 2 0
B 1 1 3 1 2 2 1 2 1 2 [2] 2 2 2 0
B 1 1 3 1 2 2 1 2 1 2 2 [2] 2 2 0
B 1 1 3 1 2 2 1 2 1 2 2 2 [2] 2 0
B 1 1 3 1 2 2 1 2 1 2 2 2 2 [2] 0
B 1 1 3 1 2 2 1 2 1 2 2 2 2 2 [0]
C 1 1 3 1 2 2 1 2 1 2 2 2 2 [2] 0
C 1 1 3 1 2 2 1 2 1 2 2 2 [2] 2 0
C 1 1 3 1 2 2 1 2 1 2 2 [2] 2 2 0
C 1 1 3 1 2 2 1 2 1 2 [2] 2 2 2 0
C 1 1 3 1 2 2 1 2 1 [2] 2 2 2 2 0
C 1 1 3 1 2 2 1 2 [1] 2 2 2 2 2 0
D 1 1 3 1 2 2 1 [2] 2 2 2 2 2 2 0
D 1 1 3 1 2 2 [1] 2 2 2 2 2 2 2 0
D 1 1 3 1 2 [2] 1 2 2 2 2 2 2 2 0
D 1 1 3 1 [2] 2 1 2 2 2 2 2 2 2 0
D 1 1 3 [1] 2 2 1 2 2 2 2 2 2 2 0
D 1 1 [3] 1 2 2 1 2 2 2 2 2 2 2 0
A 1 1 1 [1] 2 2 1 2 2 2 2 2 2 2 0
A 1 1 1 1 [2] 2 1 2 2 2 2 2 2 2 0
B 1 1 1 1 3 [2] 1 2 2 2 2 2 2 2 0
B 1 1 1 1 3 2 [1] 2 2 2 2 2 2 2 0
B 1 1 1 1 3 2 1 [2] 2 2 2 2 2 2 0
B 1 1 1 1 3 2 1 2 [2] 2 2 2 2 2 0
B 1 1 1 1 3 2 1 2 2 [2] 2 2 2 2 0
B 1 1 1 1 3 2 1 2 2 2 [2] 2 2 2 0
B 1 1 1 1 3 2 1 2 2 2 2 [2] 2 2 0
B 1 1 1 1 3 2 1 2 2 2 2 2 [2] 2 0
B 1 1 1 1 3 2 1 2 2 2 2 2 2 [2] 0
B 1 1 1 1 3 2 1 2 2 2 2 2 2 2 [0]
C 1 1 1 1 3 2 1 2 2 2 2 2 2 [2] 0
C 1 1 1 1 3 2 1 2 2 2 2 2 [2] 2 0
C 1 1 1 1 3 2 1 2 2 2 2 [2] 2 2 0
C 1 1 1 1 3 2 1 2 2 2 [2] 2 2 2 0
C 1 1 1 1 3 2 1 2 2 [2] 2 2 2 2 0
C 1 1 1 1 3 2 1 2 [2] 2 2 2 2 2 0
C 1 1 1 1 3 2 1 [2] 2 2 2 2 2 2 0
C 1 1 1 1 3 2 [1] 2 2 2 2 2 2 2 0
D 1 1 1 1 3 [2] 2 2 2 2 2 2 2 2 0
D 1 1 1 1 [3] 2 2 2 2 2 2 2 2 2 0
A 1 1 1 1 1 [2] 2 2 2 2 2 2 2 2 0
B 1 1 1 1 1 3 [2] 2 2 2 2 2 2 2 0
B 1 1 1 1 1 3 2 [2] 2 2 2 2 2 2 0
B 1 1 1 1 1 3 2 2 [2] 2 2 2 2 2 0
B 1 1 1 1 1 3 2 2 2 [2] 2 2 2 2 0
B 1 1 1 1 1 3 2 2 2 2 [2] 2 2 2 0
B 1 1 1 1 1 3 2 2 2 2 2 [2] 2 2 0
B 1 1 1 1 1 3 2 2 2 2 2 2 [2] 2 0
B 1 1 1 1 1 3 2 2 2 2 2 2 2 [2] 0
B 1 1 1 1 1 3 2 2 2 2 2 2 2 2 [0]
C 1 1 1 1 1 3 2 2 2 2 2 2 2 [2] 0
C 1 1 1 1 1 3 2 2 2 2 2 2 [2] 2 0
C 1 1 1 1 1 3 2 2 2 2 2 [2] 2 2 0
C 1 1 1 1 1 3 2 2 2 2 [2] 2 2 2 0
C 1 1 1 1 1 3 2 2 2 [2] 2 2 2 2 0
C 1 1 1 1 1 3 2 2 [2] 2 2 2 2 2 0
C 1 1 1 1 1 3 2 [2] 2 2 2 2 2 2 0
C 1 1 1 1 1 3 [2] 2 2 2 2 2 2 2 0
C 1 1 1 1 1 [3] 2 2 2 2 2 2 2 2 0
E 1 1 1 1 [1] 2 2 2 2 2 2 2 2 2 0
E 1 1 1 [1] 1 2 2 2 2 2 2 2 2 2 0
E 1 1 [1] 1 1 2 2 2 2 2 2 2 2 2 0
E 1 [1] 1 1 1 2 2 2 2 2 2 2 2 2 0
E [1] 1 1 1 1 2 2 2 2 2 2 2 2 2 0
E [0] 1 1 1 1 1 2 2 2 2 2 2 2 2 2 0
STOP 0 [1] 1 1 1 1 2 2 2 2 2 2 2 2 2 0
</pre>
=={{header|Ada}}==
Line 90 ⟶ 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 143 ⟶ 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 244 ⟶ 492:
end Run;
end Turing;</
===The implementation of the simple incrementer===
<
procedure Simple_Incrementer is
Line 275 ⟶ 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 284 ⟶ 532:
===The implementation of the busy beaver===
<
procedure Busy_Beaver_3 is
Line 314 ⟶ 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 345 ⟶ 593:
111111 STOP
^</pre>
=={{header|Amazing Hopper}}==
Implementation of a Universal Turing Machine:
<syntaxhighlight lang="amazing hopper">
#include <hopper.h>
#proto UniversalTuringMachine(_X_)
main:
.ctrlc
stbegin=0,stEnd=0,state=0,ptr=0
tape=0,states=0,rules=0,long=0,tapeSize=0
file="turing/prg03.tm"
// load program, rules & states:
jsub(load Archive)
// RUN Universal Turing Machine program:
i=1
__TURING_RUN__:
_Universal Turing Machine ([i,1:end]get(rules))
++i,{long,i}gt? do{ i=1 }
jt(__TURING_RUN__)
println
exit(0)
.locals
printTape:
#hl{
print(tape[1:(ptr-1)],"\R",tape[ptr],"\OFF",tape[(ptr+1):end],"\n")
//sleep(0.1)
}
up(1)
clear mark
back
Universal Turing Machine(rules)
cont=1
clear mark
#hl{
if( rules[1] == state )
if( tape[ptr] == rules[2] )
tape[ptr] = rules[3]
ptr += rules[4]
if(ptr==0)
}
++tapeSize
{0,1,tape}, array(INSERT), ++ptr
#hl{
else if(ptr>tapeSize)
}
++tapeSize
{tapeSize,tape},array(RESIZE),
[tapeSize]{0},put(tape),clear mark
#hl{
endif
state = rules[5]
if(state == stEnd)
cont=0
endif
}
jsub(print Tape)
#hl{
endif
endif
}, {cont}
back
load Archive:
{","}tok sep
{file} stats file
[1,1:end],{file},!(5),load, mov(tape)
[2,1:3], !(5),load, mov(states)
[3:end,1:5], load, mov(rules)
clear mark
[1:end,4]get(rules),colMoving=0, mov(colMoving)
{"1","RIGHT",colMoving} transform, mov(colMoving)
{"-1","LEFT",colMoving} transform, mov(colMoving)
{"0","STAY",colMoving} transform, xtonum, put(rules)
clear mark
{0}reshape(tape)
size(tape),lengthTape=0,mov(lengthTape),[2]get(lengthTape),mov(tapeSize)
#hl{
stbegin=states[1,1]
stEnd=states[1,2]
ptr=states[1,3]
state=stbegin
}
data rules=0, size(rules), mov(datarules), [2]get(data rules), mov(long)
{""}tok sep
back
</syntaxhighlight>
ALternative pseudo-function UniversalTuringMachine (fast):
<pre>
Universal Turing Machine(rules)
cont=1
clear mark
[1]get(rules),{state},eq?
do{
[ptr]get(tape),[2]get(rules),eq?,
do{
[3]get(rules),[ptr]put(tape)
[4]get(rules),plus(ptr),mov(ptr)
{ptr}zero?,do{
++tapeSize
{0,1,tape}, array(INSERT), ++ptr
}
{ptr}gthan(tapeSize),do{
++tapeSize
{tapeSize,tape},array(RESIZE),
[tapeSize]{0},put(tape),clear mark
}
[5]get(rules),mov(state)
{state,stEnd},eq? do { cont=0 }
jsub(print Tape)
}
},{cont}
back
</pre>
Program PRG01.TM:
<pre>row 1: tape.
row 2: initial state, halt state, and initial pointer position.
row 3 to end, columns 1 to 5: rules.</pre>
<pre>
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
a,halt,5
a,0,1,RIGHT,b
a,1,1,LEFT,c
b,0,1,LEFT,a
b,1,1,RIGHT,b
c,0,1,LEFT,b
c,1,1,STAY,halt
</pre>
Program PRG02.TM:
<pre>
1,1,1,0,0
q0,qf,1
q0,1,1,RIGHT,q0
q0,0,1,STAY,qf
</pre>
Program PRG03.TM:
<pre>
0,0,0,0,0
A,H,1
A,0,1,RIGHT,B
A,1,1,LEFT,C
B,0,1,RIGHT,C
B,1,1,RIGHT,B
C,0,1,RIGHT,D
C,1,0,LEFT,E
D,0,1,LEFT,A
D,1,1,LEFT,D
E,0,1,STAY,H
E,1,0,LEFT,A
</pre>
{{out}}
<pre>
PRG01.TM:
111111000
PRG02.TM:
11110
PRG03.TM (fragment, and veeeery slow with High-level mode :( ):
1111111111111100100100100100100100100100100100100100100100100100100100100111
</pre>
=={{header|APL}}==
===⍺===
{{works with|Dyalog APL}}
<syntaxhighlight lang="apl">:Namespace Turing
⍝ Run Turing machine until it halts
∇r←RunTuring (rules init halts blank itape);state;rt;lt;next
state←init
lt←⍬
rt←,blank
:If 0≠≢itape ⋄ rt←itape ⋄ :EndIf
:While ~(⊂state)∊halts
next←((⊂state(⊃rt))≡¨↓rules[;⍳2])⌿rules
'No rule applies!'⎕SIGNAL(0=≢next)/11
(⊃rt)←⊃next[1;3]
state←⊃next[1;5]
:Select ⊃next[1;4]
:Case 'stay' ⋄ ⍝nothing
:Case 'right'
lt,⍨←⊃rt
rt←1↓rt
:If 0=≢rt ⋄ rt←,blank ⋄ :EndIf
:Case 'left'
:If 0=≢lt ⋄ lt←,blank ⋄ :EndIf
rt,⍨←⊃lt
lt←1↓lt
:Else
'Invalid action'⎕SIGNAL 11
:EndSelect
:EndWhile
r←(⌽lt),rt
∇
⍝ Display the resulting tape neatly
∇r←len Display t
r←(len⌊≢t)↑t
→(len≥≢t)/0
r,←'... (total length: ',(⍕≢t),')'
∇
⍝ Simple incrementer
∇t←∆1_SimpleIncrementer
t ←⊂'q0' '1' '1' 'right' 'q0'
t,←⊂'q0' 'B' '1' 'stay' 'qf'
t←(↑t) 'q0' (,⊂'qf') 'B' '111'
∇
⍝ Three state beaver
∇t←∆2_ThreeStateBeaver
t ←⊂'a' '0' '1' 'right' 'b'
t,←⊂'a' '1' '1' 'left' 'c'
t,←⊂'b' '0' '1' 'left' 'a'
t,←⊂'b' '1' '1' 'right' 'b'
t,←⊂'c' '0' '1' 'left' 'b'
t,←⊂'c' '1' '1' 'stay' 'halt'
t←(↑t) 'a' (,⊂'halt') '0' ''
∇
⍝ Five state beaver
∇t←∆3_FiveStateBeaver
t ←⊂'A' '0' '1' 'right' 'B'
t,←⊂'A' '1' '1' 'left' 'C'
t,←⊂'B' '0' '1' 'right' 'C'
t,←⊂'B' '1' '1' 'right' 'B'
t,←⊂'C' '0' '1' 'right' 'D'
t,←⊂'C' '1' '0' 'left' 'E'
t,←⊂'D' '0' '1' 'left' 'A'
t,←⊂'D' '1' '1' 'left' 'D'
t,←⊂'E' '0' '1' 'stay' 'H'
t,←⊂'E' '1' '0' 'left' 'A'
t←(↑t) 'A' (,⊂'H') '0' ''
∇
⍝ Run all of them and display the results
∇RunAll;m;ms
ms←('∆'=⊃¨ms)/ms←⎕NL¯3
:For m :In ms
⎕←(1↓m),': ',(32 Display RunTuring ⍎m)
:EndFor
∇
:EndNamespace</syntaxhighlight>
{{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 520 ⟶ 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 601 ⟶ 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 618 ⟶ 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 628 ⟶ 1,166:
50 LET R$(2)=S$+"B1S"+H$
60 LET B$="B"
70 LET T$="111"</
{{out}}
<pre>1111</pre>
Line 634 ⟶ 1,172:
====The three-state beaver====
Requires at least 2k of RAM.
<
20 LET R$(1)="A01RB"
30 LET R$(2)="A11LC"
Line 644 ⟶ 1,182:
90 LET S$="A"
100 LET B$="0"
110 LET H$="H"</
{{out}}
<pre>111111</pre>
Line 650 ⟶ 1,188:
If it is true that the <b>five-state probable beaver</b> runs for 47m cycles, then there is no point even attempting it on a slow computer like the ZX81. I don't know exactly how long it would take: but it would be months.
=={{header|C}}==
<
#include <stdarg.h>
#include <stdlib.h>
Line 1,048 ⟶ 1,421:
run(t);
}
</syntaxhighlight>
{{output}}
Line 1,074 ⟶ 1,447:
c 1 1 1 [1] 1 1
halt 1 1 1 [1] 1 1</pre>
=={{header|C sharp}}==
<
using System.Collections.Generic;
using System.Diagnostics;
Line 1,492 ⟶ 1,648:
}
}</
{{out}}
<pre style="height:30ex;overflow:scroll">
Line 1,536 ⟶ 1,692:
47176870 steps
tape length: 12289</pre>
=={{header|C++}}==
<syntaxhighlight lang="cpp">
#include <vector>
#include <string>
#include <iostream>
#include <algorithm>
#include <fstream>
#include <iomanip>
//--------------------------------------------------------------------------------------------------
typedef unsigned int uint;
using namespace std;
const uint TAPE_MAX_LEN = 49152;
//--------------------------------------------------------------------------------------------------
struct action { char write, direction; };
//--------------------------------------------------------------------------------------------------
class tape
{
public:
tape( uint startPos = TAPE_MAX_LEN >> 1 ) : MAX_LEN( TAPE_MAX_LEN ) { _sp = startPos; reset(); }
void reset() { clear( '0' ); headPos = _sp; }
char read(){ return _t[headPos]; }
void input( string a ){ if( a == "" ) return; for( uint s = 0; s < a.length(); s++ ) _t[headPos + s] = a[s]; }
void clear( char c ) { _t.clear(); blk = c; _t.resize( MAX_LEN, blk ); }
void action( const action* a ) { write( a->write ); move( a->direction ); }
void print( int c = 10 )
{
int ml = static_cast<int>( MAX_LEN ), st = static_cast<int>( headPos ) - c, ed = static_cast<int>( headPos ) + c + 1, tx;
for( int x = st; x < ed; x++ )
{ tx = x; if( tx < 0 ) tx += ml; if( tx >= ml ) tx -= ml; cout << _t[tx]; }
cout << endl << setw( c + 1 ) << "^" << endl;
}
private:
void move( char d ) { if( d == 'N' ) return; headPos += d == 'R' ? 1 : -1; if( headPos >= MAX_LEN ) headPos = d == 'R' ? 0 : MAX_LEN - 1; }
void write( char a ) { if( a != 'N' ) { if( a == 'B' ) _t[headPos] = blk; else _t[headPos] = a; } }
string _t; uint headPos, _sp; char blk; const uint MAX_LEN;
};
//--------------------------------------------------------------------------------------------------
class state
{
public:
bool operator ==( const string o ) { return o == name; }
string name, next; char symbol, write, direction;
};
//--------------------------------------------------------------------------------------------------
class actionTable
{
public:
bool loadTable( string file )
{
reset();
ifstream mf; mf.open( file.c_str() ); if( mf.is_open() )
{
string str; state stt;
while( mf.good() )
{
getline( mf, str ); if( str[0] == '\'' ) break;
parseState( str, stt ); states.push_back( stt );
}
while( mf.good() )
{
getline( mf, str ); if( str == "" ) continue;
if( str[0] == '!' ) blank = str.erase( 0, 1 )[0];
if( str[0] == '^' ) curState = str.erase( 0, 1 );
if( str[0] == '>' ) input = str.erase( 0, 1 );
}
mf.close(); return true;
}
cout << "Could not open " << file << endl; return false;
}
bool action( char symbol, action& a )
{
vector<state>::iterator f = states.begin();
while( true )
{
f = find( f, states.end(), curState );
if( f == states.end() ) return false;
if( ( *f ).symbol == '*' || ( *f ).symbol == symbol || ( ( *f ).symbol == 'B' && blank == symbol ) )
{ a.direction = ( *f ).direction; a.write = ( *f ).write; curState = ( *f ).next; break; }
f++;
}
return true;
}
void reset() { states.clear(); blank = '0'; curState = input = ""; }
string getInput() { return input; }
char getBlank() { return blank; }
private:
void parseState( string str, state& stt )
{
string a[5]; int idx = 0;
for( string::iterator si = str.begin(); si != str.end(); si++ )
{ if( ( *si ) == ';' ) idx++; else a[idx].append( &( *si ), 1 ); }
stt.name = a[0]; stt.symbol = a[1][0]; stt.write = a[2][0]; stt.direction = a[3][0]; stt.next = a[4];
}
vector<state> states; char blank; string curState, input;
};
//--------------------------------------------------------------------------------------------------
class utm
{
public:
utm() { files[0] = "incrementer.utm"; files[1] = "busy_beaver.utm"; files[2] = "sort.utm"; }
void start()
{
while( true )
{
reset(); int t = showMenu(); if( t == 0 ) return;
if( !at.loadTable( files[t - 1] ) ) return; startMachine();
}
}
private:
void simulate()
{
char r; action a;
while( true ) { tp.print(); r = tp.read(); if( !( at.action( r, a ) ) ) break; tp.action( &a ); }
cout << endl << endl; system( "pause" );
}
int showMenu()
{
int t = -1;
while( t < 0 || t > 3 )
{
system( "cls" ); cout << "1. Incrementer\n2. Busy beaver\n3. Sort\n\n0. Quit";
cout << endl << endl << "Choose an action "; cin >> t;
}
return t;
}
void reset() { tp.reset(); at.reset(); }
void startMachine() { system( "cls" ); tp.clear( at.getBlank() ); tp.input( at.getInput() ); simulate(); }
tape tp; actionTable at; string files[7];
};
//--------------------------------------------------------------------------------------------------
int main( int a, char* args[] ){ utm mm; mm.start(); return 0; }
//--------------------------------------------------------------------------------------------------
</syntaxhighlight>
'''These are the files you'll need'''<br />
File explanation:<br />
Each line contains one tuple of the form '<current state> <current symbol> <new symbol> <direction> <new state><br />
B = blank, H = halt, N = do nothing, * matches any current symbol<br />
' = marks the end of the action table<br />
! = blank symbol => eg: !0 => 0 is the blank symbol<br />
^ starting state<br />
> input
'''Incrementer'''<pre>q0;1;1;R;q0
q0;B;1;H;qf
'
!0
^q0
>111
</pre>
'''Busy beaver'''<pre>A;0;1;R;B
A;1;1;L;C
B;0;1;L;A
B;1;1;R;B
C;0;1;L;B
C;1;1;N;H
'
!0
^A
</pre>
'''Sort'''<pre>A;1;1;R;A
A;2;3;R;B
A;0;0;L;E
B;1;1;R;B
B;2;2;R;B
B;0;0;L;C
C;1;2;L;D
C;2;2;L;C
C;3;2;L;E
D;1;1;L;D
D;2;2;L;D
D;3;1;R;A
E;1;1;L;E
E;0;0;R;H
'
!0
^A
>1221221211
</pre>
{{out}}Busy beaver
<pre>000000000000000000000
^
000000000100000000000
^
000000000011000000000
^
000000000001100000000
^
000000000001110000000
^
000000000001111000000
^
000000000111110000000
^
000000001111100000000
^
000000011111000000000
^
000000111110000000000
^
000001111100000000000
^
000000111111000000000
^
000000011111100000000
^
000000011111100000000
^</pre>
=={{header|Clojure}}==
<
(defn tape
"Creates a new tape with given blank character and tape contents"
Line 1,565 ⟶ 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,610 ⟶ 1,983:
(is (= 4098 (get freq 1)))
(is (= 8191 (get freq 0)))))
</syntaxhighlight>
=={{header|CLU}}==
<syntaxhighlight lang="clu">% Bidirectional 'infinite' tape
tape = cluster [T: type] is make, left, right, get_cell, set_cell,
elements, get_size
rep = record[
blank: T,
loc: int,
data: array[T]
]
% Make a new tape with a given blank value and initial value
make = proc (blank: T, init: sequence[T]) returns (cvt)
data: array[T]
if sequence[T]$empty(init) then
data := array[T]$[blank]
else
data := sequence[T]$s2a(init)
end
return(rep${
blank: blank,
loc: 1,
data: data
})
end make
% Move the tape head left
left = proc (tap: cvt)
tap.loc := tap.loc - 1
if tap.loc < array[T]$low(tap.data) then
array[T]$addl(tap.data,tap.blank)
end
end left
% Move the tape head right
right = proc (tap: cvt)
tap.loc := tap.loc + 1
if tap.loc > array[T]$high(tap.data) then
array[T]$addh(tap.data,tap.blank)
end
end right
% Get the value of the current cell
get_cell = proc (tap: cvt) returns (T)
return(tap.data[tap.loc])
end get_cell
% Set the value of the current cell
set_cell = proc (tap: cvt, val: T)
tap.data[tap.loc] := val
end set_cell
% Retrieve all touched values, one by one, from left to right
elements = iter (tap: cvt) yields (T)
for v: T in array[T]$elements(tap.data) do
yield(v)
end
end elements
% Get the current size of the tape
get_size = proc (tap: cvt) returns (int)
return(array[T]$size(tap.data))
end get_size
end tape
% Turing machine state table
turing = cluster [T: type] is make, add_rule, run
where T has equal: proctype (T,T) returns (bool)
A_LEFT = 'L'
A_RIGHT = 'R'
A_STAY = 'S'
state = record[name: string, term: bool]
rule = struct[
cur_state: int,
read_sym, write_sym: T,
action: char,
next_state: int
]
rep = struct[
states: array[state],
rules: array[rule],
init_state: int
]
% Find the index of a state given its name
find_state = proc (states: array[state], name: string)
returns (int) signals (bad_state)
for i: int in array[state]$indexes(states) do
if states[i].name = name then return(i) end
end
signal bad_state
end find_state
% Make a new Turing machine given a list of states
make = proc (state_seq: sequence[string], init: string, term: sequence[string])
returns (cvt) signals (bad_state)
states: array[state] := array[state]$[]
for s: string in sequence[string]$elements(state_seq) do
array[state]$addh(states, state${name: s, term: false} )
end
init_n: int := find_state(states, init) resignal bad_state
for s: string in sequence[string]$elements(term) do
term_n: int := find_state(states, s) resignal bad_state
states[term_n].term := true
end
return(rep${states: states,
init_state: init_n,
rules: array[rule]$[]})
end make
% Add a rule to the Turing machine
add_rule = proc (tur: cvt,
in_state: string,
read_sym, write_sym: T,
action: string,
out_state: string)
signals (bad_state, bad_action)
cur_state: int := find_state(tur.states, in_state) resignal bad_state
next_state: int := find_state(tur.states, out_state) resignal bad_state
act: char
if action = "left" then act := A_LEFT
elseif action = "right" then act := A_RIGHT
elseif action = "stay" then act := A_STAY
else signal bad_action
end
array[rule]$addh(tur.rules,
rule${cur_state: cur_state,
read_sym: read_sym,
write_sym: write_sym,
action: act,
next_state: next_state})
end add_rule
% Find first matching rule
find_rule = proc (rules: array[rule], st: int, sym: T)
returns (rule) signals (no_rule)
for r: rule in array[rule]$elements(rules) do
if r.cur_state = st & r.read_sym = sym then
return(r)
end
end
signal no_rule
end find_rule
% Run the Turing machine on a given tape until it terminates
run = proc (tur: cvt, tap: tape[T]) signals (no_rule)
cur: int := tur.init_state
while ~tur.states[cur].term do
r: rule := find_rule(tur.rules, cur, tap.cell) resignal no_rule
tap.cell := r.write_sym
if r.action = A_LEFT then tape[T]$left(tap)
elseif r.action = A_RIGHT then tape[T]$right(tap)
end
cur := r.next_state
end
end run
end turing
% Simple incrementer
simple_incrementer = proc () returns (turing[char])
tc = turing[char]
t: tc := tc$make(
sequence[string]$["q0", "qf"],
"q0",
sequence[string]$["qf"]
)
tc$add_rule(t, "q0", '1', '1', "right", "q0")
tc$add_rule(t, "q0", 'B', '1', "stay", "qf")
return(t)
end simple_incrementer
% Three state beaver
three_state_beaver = proc () returns (turing[char])
tc = turing[char]
t: tc := tc$make(
sequence[string]$["a", "b", "c", "halt"],
"a",
sequence[string]$["halt"]
)
tc$add_rule(t, "a", '0', '1', "right", "b")
tc$add_rule(t, "a", '1', '1', "left", "c")
tc$add_rule(t, "b", '0', '1', "left", "a")
tc$add_rule(t, "b", '1', '1', "right", "b")
tc$add_rule(t, "c", '0', '1', "left", "b")
tc$add_rule(t, "c", '1', '1', "stay", "halt")
return(t)
end three_state_beaver
% Five state beaver
five_state_beaver = proc () returns (turing[char])
tc = turing[char]
t: tc := tc$make(
sequence[string]$["A", "B", "C", "D", "E", "H"],
"A",
sequence[string]$["H"]
)
tc$add_rule(t, "A", '0', '1', "right", "B")
tc$add_rule(t, "A", '1', '1', "left", "C")
tc$add_rule(t, "B", '0', '1', "right", "C")
tc$add_rule(t, "B", '1', '1', "right", "B")
tc$add_rule(t, "C", '0', '1', "right", "D")
tc$add_rule(t, "C", '1', '0', "left", "E")
tc$add_rule(t, "D", '0', '1', "left", "A")
tc$add_rule(t, "D", '1', '1', "left", "D")
tc$add_rule(t, "E", '0', '1', "stay", "H")
tc$add_rule(t, "E", '1', '0', "left", "A")
return(t)
end five_state_beaver
% Print the first 32 touched symbols on a tape
print_tape = proc (s: stream, t: tape[char])
n: int := 32
for c: char in tape[char]$elements(t) do
stream$putc(s, c)
n := n - 1
if n=0 then break end
end
if n=0 then
stream$puts(s, "... (length: " || int$unparse(t.size) || ")")
end
stream$putl(s, "")
end print_tape
% Run the three Turing machines and show the results
start_up = proc ()
turing_factory = proctype () returns (turing[char])
test = record[name: string, tf: turing_factory, tap: tape[char]]
stest = sequence[test]
sc = sequence[char]
tests: stest := stest$[
test${name: "Simple incrementer",
tf: simple_incrementer,
tap: tape[char]$make('B', sc$['1','1','1'])},
test${name: "Three-state busy beaver",
tf: three_state_beaver,
tap: tape[char]$make('0', sc$[])},
test${name: "Five-state probable busy beaver",
tf: five_state_beaver,
tap: tape[char]$make('0', sc$[])}]
po: stream := stream$primary_output()
for t: test in stest$elements(tests) do
stream$puts(po, t.name || ": ")
tm: turing[char] := t.tf()
turing[char]$run(tm, t.tap)
print_tape(po, t.tap)
end
end start_up</syntaxhighlight>
{{out}}
<pre>Simple incrementer: 1111
Three-state busy beaver: 111111
Five-state probable busy beaver: 10100100100100100100100100100100... (length: 12289)</pre>
=={{header|Common Lisp}}==
===Iterative version===
The infinite tape is represented by two lists:
# <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.
<syntaxhighlight lang="lisp">(defun turing (initial terminal blank rules tape &optional (verbose NIL))
(labels ((combine (front back)
(if front
(combine (cdr front) (cons (car front) back))
back))
(update-tape (old-front old-back new-content move)
(cond ((eq move 'right)
(list (cons new-content old-front)
(cdr old-back)))
((eq move 'left)
(list (cdr old-front)
(list* (car old-front) new-content (cdr old-back))))
(T (list old-front
(cons new-content (cdr old-back))))))
(show-tape (front back)
(format T "~{~a~}[~a]~{~a~}~%"
(nreverse (subseq front 0 (min 10 (length front))))
(or (car back) blank)
(subseq (cdr back) 0 (min 10 (length (cdr back)))))))
(loop for back = tape then new-back
for front = '() then new-front
for state = initial then new-state
for content = (or (car back) blank)
for (new-state new-content move) = (gethash (cons state content) rules)
for (new-front new-back) = (update-tape front back new-content move)
until (equal state terminal)
do (when verbose
(show-tape front back))
finally (progn
(when verbose
(show-tape front back))
(return (combine front back))))))</syntaxhighlight>
===Recursive version===
Using the same interface and general idea as the iterative version.
<syntaxhighlight lang="lisp">(defun turing (initial terminal blank rules tape &optional (verbose NIL))
(labels ((run (state front back)
(if (equal state terminal)
(progn
(when verbose
(show-tape front back))
(combine front back))
(let ((current-content (or (car back) blank)))
(destructuring-bind
(new-state new-content move)
(gethash (cons state current-content) rules)
(when verbose
(show-tape front back))
(cond ((eq move 'right)
(run new-state
(cons new-content front)
(cdr back)))
((eq move 'left)
(run new-state
(cdr front)
(list* (car front) new-content (cdr back))))
(T (run new-state
front
(cons new-content (cdr back)))))))))
(show-tape (front back)
(format T "~{~a~}[~a]~{~a~}~%"
(nreverse (subseq front 0 (min 10 (length front))))
(or (car back) blank)
(subseq (cdr back) 0 (min 10 (length (cdr back))))))
(combine (front back)
(if front
(combine (cdr front) (cons (car front) back))
back)))
(run initial '() tape)))</syntaxhighlight>
===Usage===
<syntaxhighlight lang="lisp">;; Helper function for creating the rules table
(defun make-rules-table (rules-list)
(let ((rules (make-hash-table :test 'equal)))
(loop for (state content new-content dir new-state) in rules-list
do (setf (gethash (cons state content) rules)
(list new-state new-content dir)))
rules))
(format T "Simple incrementer~%")
(turing 'q0 'qf 'B (make-rules-table '((q0 1 1 right q0) (q0 B 1 stay qf))) '(1 1 1) T)
(format T "Three-state busy beaver~%")
(turing 'a 'halt 0
(make-rules-table '((a 0 1 right b)
(a 1 1 left c)
(b 0 1 left a)
(b 1 1 right b)
(c 0 1 left b)
(c 1 1 stay halt)))
'() T)
(format T "Sort (final tape)~%")
(format T "~{~a~}~%"
(turing 'A 'H 0
(make-rules-table '((A 1 1 right A)
(A 2 3 right B)
(A 0 0 left E)
(B 1 1 right B)
(B 2 2 right B)
(B 0 0 left C)
(C 1 2 left D)
(C 2 2 left C)
(C 3 2 left E)
(D 1 1 left D)
(D 2 2 left D)
(D 3 1 right A)
(E 1 1 left E)
(E 0 0 right H)))
'(2 1 2 2 2 1 1)))
(format T "5-state busy beaver (first 20 cells)~%")
(format T "~{~a~}...~%"
(subseq (turing 'A 'H 0
(make-rules-table '((A 0 1 right B)
(A 1 1 left C)
(B 0 1 right C)
(B 1 1 right B)
(C 0 1 right D)
(C 1 0 left E)
(D 0 1 left A)
(D 1 1 left D)
(E 0 1 stay H)
(E 1 0 left A)))
'())
0 20))</syntaxhighlight>
{{Out}}
<pre>Simple incrementer
[1]11
1[1]1
11[1]
111[B]
111[1]
Three-state busy beaver
[0]
1[0]
[1]1
[0]11
[0]111
[0]1111
1[1]111
11[1]11
111[1]1
1111[1]
11111[0]
1111[1]1
111[1]11
111[1]11
Sort (final tape)
011122220
5-state busy beaver (first 20 cells)
10100100100100100100...</pre>
=={{header|Cowgol}}==
<syntaxhighlight lang="cowgol">include "cowgol.coh";
include "strings.coh";
include "malloc.coh";
###############################################################################
########################## Turing machine definition ##########################
###############################################################################
typedef Symbol is uint8; # 256 symbols ought to be enough for everyone
const LEFT := 1;
const RIGHT := 2;
const STAY := 3;
typedef Action is int(LEFT, STAY);
# Linked list
record Linked is
next: [Linked];
end record;
record DoublyLinked: Linked is
prev: [DoublyLinked];
end record;
sub FreeLinked(r: [Linked]) is
while r != 0 as [Linked] loop
var v := r.next;
Free(r as [uint8]);
r := v;
end loop;
end sub;
sub FreeDoublyLinked(r: [DoublyLinked]) is
FreeLinked(r.next);
while r != 0 as [DoublyLinked] loop
var v := r.prev;
Free(r as [uint8]);
r := v;
end loop;
end sub;
# Turing machine
typedef Turing is [TuringR];
record StateR: Linked is
tm: Turing; # turing machine this state belongs to
term: uint8; # whether state is terminating
end record;
typedef State is [StateR];
record Cell: DoublyLinked is
sym: Symbol;
end record;
record RuleR: Linked is
instate: State;
insym: Symbol;
outsym: Symbol;
action: Action;
outstate: State;
end record;
typedef Rule is [RuleR];
record TuringR is
states: State;
rules: Rule;
initial: State;
current: State;
blank: Symbol;
head: [Cell];
end record;
sub MakeCell(): (c: [Cell]) is
c := Alloc(@bytesof Cell) as [Cell];
MemZero(c as [uint8], @bytesof Cell);
end sub;
# Define a Turing machine
sub MakeTuring(blank: Symbol, init: [Symbol]): (t: Turing) is
t := Alloc(@bytesof TuringR) as Turing;
MemZero(t as [uint8], @bytesof TuringR);
t.blank := blank;
t.head := MakeCell();
t.head.sym := blank;
var c := t.head;
var d: [Cell];
while [init] != 0 loop
c.sym := [init];
init := @next init;
if [init] == 0 then break; end if;
d := Alloc(@bytesof Cell) as [Cell];
d.prev := c as [DoublyLinked];
d.next := 0 as [Linked];
c.next := d as [Linked];
c := d;
end loop;
end sub;
# Add a state to a Turing machine
const T_NONE := 0;
const T_INIT := 1;
const T_HALT := 2;
sub MakeState(t: Turing, type: uint8): (s: State) is
s := Alloc(@bytesof StateR) as State;
s.tm := t;
s.next := t.states as [Linked];
t.states := s;
if type & T_INIT != 0 then
t.initial := s;
t.current := s;
end if;
s.term := 0;
if type & T_HALT != 0 then
s.term := 1;
end if;
end sub;
# Add a rule to a Turing machine
sub MakeRule(t: Turing,
instate: State,
insym: Symbol,
outsym: Symbol,
action: Action,
outstate: State): (r: Rule) is
r := Alloc(@bytesof RuleR) as Rule;
r.instate := instate;
r.insym := insym;
r.outsym := outsym;
r.action := action;
r.outstate := outstate;
r.next := t.rules as [Linked];
t.rules := r;
end sub;
# Free a Turing machine
sub FreeTuring(t: Turing) is
FreeDoublyLinked(t.head as [DoublyLinked]);
FreeLinked(t.states as [Linked]);
FreeLinked(t.rules as [Linked]);
Free(t as [uint8]);
end sub;
# Move the head
sub MoveHead(t: Turing, a: Action) is
var c: [Cell];
case a is
when STAY: return;
when LEFT:
if t.head.prev == 0 as [DoublyLinked] then
c := Alloc(@bytesof Cell) as [Cell];
c.prev := 0 as [DoublyLinked];
c.next := t.head as [Linked];
c.sym := t.blank;
t.head.prev := c as [DoublyLinked];
end if;
t.head := t.head.prev as [Cell];
return;
when RIGHT:
if t.head.next == 0 as [Linked] then
c := Alloc(@bytesof Cell) as [Cell];
c.next := 0 as [Linked];
c.prev := t.head as [DoublyLinked];
c.sym := t.blank;
t.head.next := c as [Linked];
end if;
t.head := t.head.next as [Cell];
return;
when else:
print("Invalid action\n");
ExitWithError();
end case;
end sub;
# Step a Turing machine
sub Step(t: Turing): (halt: uint8) is
# If we're in a halt state, do nothing
if t.current.term != 0 then
halt := 1;
return;
end if;
var r := t.rules;
while r != 0 as Rule loop
# Check each rule to see if it matches the current configuration
if t.current == r.instate
and t.head.sym == r.insym then
# Found a match
t.head.sym := r.outsym;
MoveHead(t, r.action);
t.current := r.outstate;
halt := t.current.term;
return;
end if;
r := r.next as Rule;
end loop;
print("No valid rule!\n");
ExitWithError();
end sub;
# Run a Turing machine until it halts
sub Run(t: Turing) is
while Step(t) == 0 loop
end loop;
end sub;
# Print the touched part of the tape of a Turing machine
sub PrintTape(t: Turing, max: uint32) is
var c := t.head;
var len: uint32 := 0;
while c.prev != 0 as [DoublyLinked] loop
c := c.prev as [Cell];
end loop;
while c != 0 as [Cell] loop
if len < max then
print_char(c.sym as uint8);
end if;
c := c.next as [Cell];
len := len + 1;
end loop;
if len >= max then
print("... (total length: ");
print_i32(len);
print(")");
end if;
end sub;
###############################################################################
######################## Turing machines from the task ########################
###############################################################################
interface TuringFactory(): (t: Turing);
sub SimpleIncrementer implements TuringFactory is
var r: Rule;
t := MakeTuring('B', "111");
var q0 := MakeState(t, T_INIT);
var qf := MakeState(t, T_HALT);
r := MakeRule(t, q0, '1', '1', RIGHT, q0);
r := MakeRule(t, q0, 'B', '1', STAY, qf);
end sub;
sub ThreeStateBeaver implements TuringFactory is
var r: Rule;
t := MakeTuring('0', "");
var a := MakeState(t, T_INIT);
var b := MakeState(t, T_NONE);
var c := MakeState(t, T_NONE);
var halt := MakeState(t, T_HALT);
r := MakeRule(t, a, '0', '1', RIGHT, b);
r := MakeRule(t, a, '1', '1', LEFT, c);
r := MakeRule(t, b, '0', '1', LEFT, a);
r := MakeRule(t, b, '1', '1', RIGHT, b);
r := MakeRule(t, c, '0', '1', LEFT, b);
r := MakeRule(t, c, '1', '1', STAY, halt);
end sub;
sub FiveStateBeaver implements TuringFactory is
var r: Rule;
t := MakeTuring('0', "");
var A := MakeState(t, T_INIT);
var B := MakeState(t, T_NONE);
var C := MakeState(t, T_NONE);
var D := MakeState(t, T_NONE);
var E := MakeState(t, T_NONE);
var H := MakeState(t, T_HALT);
r := MakeRule(t, A, '0', '1', RIGHT, B);
r := MakeRule(t, A, '1', '1', LEFT, C);
r := MakeRule(t, B, '0', '1', RIGHT, C);
r := MakeRule(t, B, '1', '1', RIGHT, B);
r := MakeRule(t, C, '0', '1', RIGHT, D);
r := MakeRule(t, C, '1', '0', LEFT, E);
r := MakeRule(t, D, '0', '1', LEFT, A);
r := MakeRule(t, D, '1', '1', LEFT, D);
r := MakeRule(t, E, '0', '1', STAY, H);
r := MakeRule(t, E, '1', '0', LEFT, A);
end sub;
record TF is
name: [uint8];
tf: TuringFactory;
end record;
var machines: TF[] := {
{"Simple incrementer", SimpleIncrementer},
{"Three state beaver", ThreeStateBeaver},
{"Five state beaver", FiveStateBeaver}
};
var i: @indexof machines;
i := 0;
while i < @sizeof machines loop
print(machines[i].name);
print(": ");
var t := (machines[i].tf) ();
Run(t);
PrintTape(t, 32);
FreeTuring(t);
print_nl();
i := i + 1;
end loop;</syntaxhighlight>
{{out}}
<pre>Simple incrementer: 1111
Three state beaver: 111111
Five state beaver: 10100100100100100100100100100100... (total length: 12289)</pre>
=={{header|D}}==
===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 1,850 ⟶ 2,955:
}
M4(tm4);
}</
{{out}}
<pre>Incrementer:
Line 1,907 ⟶ 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 1,924 ⟶ 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 1,941 ⟶ 3,046:
=={{header|Déjà Vu}}==
<
local :t {}
while /= ) dup:
Line 1,982 ⟶ 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 1,996 ⟶ 3,101:
===Three-state busy beaver===
<
)
:a :B 1 :right :b
Line 2,004 ⟶ 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 2,010 ⟶ 3,115:
===5-state, 2-symbol probable Busy Beaver machine===
<
)
:A :B 1 :right :B
Line 2,022 ⟶ 3,127:
:E :B 1 :stay :H
:E 1 :B :left :A
!. universal-turing-machine transitions(</
(Output omitted because of length.)
Line 2,029 ⟶ 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 2,131 ⟶ 3,236:
(when (= final state) (writeln 'Stopping (TM-name T) 'at-pos (- pos (TM-mem T))))
count)
</syntaxhighlight>
{{out}}
<pre>
Line 2,185 ⟶ 3,290:
We create a task to run it in the background.
{{out}}
<
(define steps 0)
(define (TM-task T)
Line 2,194 ⟶ 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 2,226 ⟶ 3,331:
(for/sum ((s (TM-tape T))) s)
→ 4098
</pre>
=={{header|EDSAC order code}}==
This program was designed with the aim of running the 5-state busy beaver on an EDSAC simulator. It can be done, although the run time in real life would have been impossibly long (see below).
We know from other solutions that the Turing tape for the 5-state busy beaver requires 12289 cells. Since EDSAC memory was 1024 17-bit words, we are limited to one bit per cell, and hence to two symbols, say 0 and 1. This is enough for the Rosetta Code tasks, though not for the extra sorting task.
The tape is implemented as a circular buffer. Positive positions ascend from the low end of the tape area, while negative positions descend from the high end. Thus we don't need to know in advance where the zero position of the tape should be. Each EDSAC location in the tape area corresponds to 16 cells of the tape (17 would be awkward to code). If the positive and negative pointers collide, the program prints "OV" to indicate overflow.
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.)
<syntaxhighlight lang="edsac">
[Attempt at Turing machine for Rosetta Code.]
[EDSAC program, Initial Orders 2.]
[Library subroutine M3 prints header and is then overwritten.]
PFGKIFAFRDLFUFOFE@A6FG@E8FEZPF
*!!NR!STEPS@&#..PZ [..PZ marks end of header]
T48K [& (delta) parameter: Turing machine tape.]
P8F [Overwrites most of initial orders.]
T50K [X parameter: once-only code.]
P100F [Gets overwritten by the Turing machine tape.]
[Put the following as high in memory as possible,
to make room for the Turing machine tape.]
T52K [A parameter: rules and initial pattern. Also marks end]
P781F [of Turing tape, so must go immediately after tape area.]
T55K [V parameter: program-wide variables.]
P810F [Even address, 9 locations]
T46K [N parameter: constants.]
P820F [Even address]
T47K [M parameter: main routine.]
P859F
T51K [G parameter: library subroutine P7]
P988F [Even address, 35 locations.]
[============================= A parameter ===============================]
E25K TA GK
[0] [End of Turing tape area]
[Comment-in the desired task, or add another (2 symbols only).]
[Counts are stored in the address field.]
[Each rule is defined by an EDSAC pseudo-order, as follows:
Function letter: L = left, R = right, S = stay
Address field = new state number
Code letter: F if new symbol = 0, D if new symbol = 1.
No rule is needed for the halt state.]
[0]
[Simple incrementer: states are q0 = 0, qf = halt = 1
P1F [1 state, excluding the halt state
S1D RD [2 rules for each state (symbols 0 and 1)
P1F [1 word in tape area to be initialized
PF P3D [location 0 relative to tape, init to 7]
[3-state busy beaver: states are a = 0, b = 1, c = 2, halt = 3]
P3F [3 states, excluding the halt state]
R1D L2D [2 rules for each state (symbols 0 and 1)]
L0D R1D
L1D S3D
PF [0 words to be initialized (start with empty tape)]
[5-state busy beaver: states are A = 0, ..., E = 4, halt = 5
P5F 5 states, excluding the halt state
R1D L2D 2 rules for each state (symbols 0 and 1)
R2D R1D
R3D L4F
L0D L3D
S5D L0F
PF 0 words to be initialized (start with empty tape)]
[============================= X parameter ===============================]
E25K TX GK
[The following once-only code is loaded into the Turing machine tape area.]
[It runs at start-up, then gets overwritten when the tape is cleared.]
[Enter with acc = 0.]
[0] T2V [initial state assumed to be state 0]
T3V [tape head starts at position 0 on Turing tape]
T#V [reset count of steps]
T4V [initialize maximum position]
T5V [initialize minimum position]
[Calculate number of available tape positions; store in address field]
A22N [T order for exclusive end of tape]
S21N [T order for start of tape]
L4F [times 16, since each location holds 16 positions]
T25N [store for later use]
[Set up the loop in the main program that writes the initial pattern.
The main program has a list of position-value pairs.
This follows the list of rules, 2 rules per Turing machine state.]
[9] AA [number of states]
LD [times 2, because 2 rules per state]
A2F [plus 1 for the count of states]
A9@ [make A order to load number of position-value pairs]
T14@ [plant order]
[14] AM [load number of pairs (in address field)]
LD [times 2 for length of table]
TF [temp store in 0F]
A14@ [load order that was planted above]
A2F [make order to load first position]
U13M [plant in main routine]
AF [make A order for exclusive end]
T28M [plant in main routine]
[Set up order to load rules]
A26@
A2F
T18N
[Here with acc = 0. Jump to main routine.]
EM
[26] AA
[============================= V parameter ===============================]
E25K TV GK
[0] PFPF [number of steps (35-bit, must be at even address)]
[2] PF [current state of Turing machine]
[3] PF [current tape position, stored in address field]
[4] PF [maximum position on the tape so far]
[5] PF [minimum position on the tape so far]
[6] PF [rule for current state and symbol]
[7] PF [working group of 16 cells (1 EDSAC location)]
[8] PF [mask to select bit for current cell]
[============================= N parameter ===============================]
E25K TN GK
[17-bit masks: 11111111111111110, 11111111111111101, ..., 10111111111111111]
[0] V2047F V2046D V2045D V2043D V2039D V2031D V2015D V1983D
V1919D V1791D V1535D V1023D C2047D B2047D G2047D M2047D
[16] OF [add to A order to make T order with same address]
[17] AN [A order to load first mask in table]
[18] AF [A order to load first rule]
[19] A& [A order for start of tape]
[20] AA [A order for end of tape]
[21] T& [T order for start of tape]
[22] TA [T order for exclusive end of tape]
[23] P2047F [mask to pick out state from a Turing machine rule]
[24] P15F [mask to extract bit number from position]
[25] PF [number of tape positions available (calculated)]
[26] @F [carriage return]
[27] &F [line feed]
[28] K4096F [null]
[29] K2048F [set letters on teleprinter]
[============================= M parameter ===============================]
E25K TM GK
[Once-only code jumps to here with acc = 0]
[Clear the tape; this overwrites the once-only code]
[0] A21N [load T order for start of tape]
E3@ [always jump (since T > 0)]
[2] A22N [loop here after testing for end]
[3] T4@ [plant order to clear 1 location]
[4] TF [execute order]
A4@ [load order just executed]
A2F [inc address]
S22N [test for end]
G2@ [if not end, loop back]
[Here with acc = 0]
[Set up the starting pattern, i.e write 1's at zero or more positions on the tape.]
[To save space, the orders marked (*) are set up by the once-only code.]
[9] A13@ [load A order for next relative addess]
S28@ [compare with A order for exclusive end]
E29@ [if all done, jump out with acc = 0]
TF [clear acc]
[13] AF [(*) load relative address from table]
G17@ [jump if < 0]
A21N [make T order, addr counted from low end of tape]
E18@ [join commoon code (always jumps since T > 0)]
[17] A22N [make T order, addr counted from high end of tape]
[18] T23@ [plant T order in code]
A13@ [make order to load value from table]
A2F
T22@ [plant in code]
[22] AF [load value from table]
[23] TF [store in tape]
A22@ [make A order for next address]
A2F
T13@ [plant in code]
E9@ [always loop back]
[28] AF [(*) A order for exclusive end of list]
[29]
[Next step, i.e. set up new symbol, state and tape position.]
[Acc must be 0 here.]
[Get tape position and deduce corresponding EDSAC location and bit number.]
[29] H24N [mask for bit number]
C3V [acc := bit number]
UF [save bit number in 0F address field]
A17N [make order to load from mask table]
T44@ [plant order in code]
A3V [position]
SF [remove bit number part]
R4F [divide by 16 for relative address]
[If it's a non-negative address, add it to the start of the tape in EDSAC memory.]
[If it's a negative address, add it to the end of the tape.]
G40@ [jump if negative address]
A19N [make A order to load from tape]
G41@ [always jump to common code, since A < 0]
[40] A20N [here if negative address]
[41] U46@ [store order to load current group of 16 bits]
A16N [convert to T order at same address]
T69@ [store T order (a fair way down the code)]
[44] AF [load mask]
T8V
[46] AF [load group]
T7V
[Get rule for this state and symbol (where symbol = 0 or 1)]
H8V
C7V [acc := bit group with current bit cleared]
S7V [acc := 0 if bit is 0, -1 if bit is 1]
E54@
TF [clear acc]
A2F [to inc rule address if symbol is 1]
[54] A2V [add state twice (because each state has 2 rules)]
A2V
A18N [manufacture A order to load rule]
T58@
[58] AF [load rule]
T6V [to work space]
[Write new symbol (0 or 1) to tape. New symbol is in low bit of rule.]
HN [H register := 111...1110]
C6V
S6V [result = 0 if new symbol is 0; -1 if it's 1]
H8V [H register = mask 1...101...1 for current bit]
G67@ [jump to set the bit]
C7V [clear the bit]
E69@ [always jump (because top bit in tape store is always 0)]
[Set bit, assuming acc = -1 here (reason why it works is a bit complicated)]
[67] C7V
S8V
[69] TF [manufactured order]
[Update position of tape head, i.e. inc by 1, dec by 1, or no change.]
[Move is in top 2 bits of rule, thus]
[1x = move left, i.e. dec position (function letter can be L)]
[00 = move right, i.e. inc position (function letter can be R)]
[01 = stay, i.e. don't change position (function letter can be S)]
A6V
G83@ [left if top bit is 1]
[72] LD [else test next bit]
G95@ [skip move if next bit is 1]
[74] TF [here to move right]
A3V [inc position]
A2F
U3V
[Here we update the maximum position if latest >= maximum.]
[This is unnecessary if latest = maximum, but code is simpler this way.]
S4V [test against maximum position]
G95@ [skip if latest < maximum]
A4V [restore after test]
T4V [update maximum]
E91@ [always jump, to check for overflow]
[83] TF [here to move left]
A3V [dec position]
S2F
[86] U3V
S5V [test against current minimum position]
E95@ [jump if >= minimum]
A5V [restore acc after test]
T5V [update minimum]
[After updating maximum or minimum position, check that
available memory hasn't been exceeded.]
[91] A4V [maximum position]
S5V [subtract minimum position]
S25N [compare against number available]
E107@ [jump out if overflow]
[The next order also serves as a constant]
[95] TF [clear acc for next part]
[Increment the number of steps]
A#V
YFYF
T#V
[Finally set the new state.]
[100] H23N [mask for state bits in rule]
C6V [acc := new state]
SA [is it the last state?]
E111@ [if yes, halt the Turing machine]
AA [restore acc after test]
T2V [update state]
E29@ [loop back for next step]
[Overflow, i.e. non-negative tape positions (ascending in EDSAC memory)
collide with negative tape positions (descending).]
[107] O29N [set teleprinter to letters]
O107@ ON [print 'OV' to indicate overflow]
E116@ [jump to exit]
[Print number of steps]
[111] TF A#V [clear accc, load number of steps]
TD [number of steps to 0D for print subroutine
[114] A114 @GG [call print subroutine]
[116] O26N O27N [print CR, LF]
O28N [print null to flush teleprinter buffer]
ZF [stop]
[============================= G parameter ===============================]
E25K TG
[Library subroutine P7. 35 locations, even address. WWG page 18.]
[Prints non-negative integer, up to 10 digits, right-justified.]
GKA3FT26@H28#@NDYFLDT4DS27@TFH8@S8@T1FV4DAFG31@SFLDUFOFFFSFL4F
T4DA1FA27@G11@XFT28#ZPFT27ZP1024FP610D@524D!FO30@SFL8FE22@
[========================== X parameter again ===============================]
E25K TX GK
EZ [define entry point]
PF [enter with acc = 0]
[end]
</syntaxhighlight>
{{out}}
<pre>
[Simple incrementer]
NR STEPS
4
[3-state busy beaver]
NR STEPS
13
[5-state busy beaver; requires fast EDSAC simulator]
NR STEPS
47176870
</pre>
Line 2,233 ⟶ 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 2,300 ⟶ 3,718:
action(stay, _, Tape) -> Tape;
action(right, Blank, {Left, []}) -> {[Blank|Left], []};
action(right, _, {Left, [R|Rs]}) -> {[R|Left], Rs}.</
=={{header|Fortran}}==
Line 2,340 ⟶ 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 2,536 ⟶ 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 3,098 ⟶ 4,508:
</pre>
Removing the code maintaining the bounds HMIN and HMAX as HEAD wandered about reduced the cpu time from 0·578 to 0·562, and reducing the progress report to every ten-millionth step reduced that to 0·516. But adding the code to count the usage of each transition raised it to 0·641. Removing the usage count and the progress report got it down to 0·484. Removing the compiler's array bound checking and activating "maximum optimisations" achieved 0·312. Reverting to normal runs and introducing the check <code>IF (HEAD.LT.FIRST .OR. HEAD.GT.LAST)</code> changed the run time from 0·703 to 0·75. Thus, 47 million tests in 0·05 seconds - not much of a cost for peace of mind.
=={{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 3,276 ⟶ 4,734:
m.state = act.next
}
}</
An example program using the above package:
<
import (
Line 3,348 ⟶ 4,806:
fmt.Println("Turing machine halts after", cnt, "operations")
fmt.Println("Resulting tape:", output)
}</
{{out}}
<pre>Turing machine halts after 4 operations
Line 3,363 ⟶ 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 3,391 ⟶ 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 3,408 ⟶ 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 3,420 ⟶ 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 3,440 ⟶ 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 3,446 ⟶ 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 3,599 ⟶ 5,057:
, machineLog = []
, machineLogActive = True }
</syntaxhighlight>
Examples for machine files:
<pre>
Line 3,687 ⟶ 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 3,804 ⟶ 5,262:
write(l,r)
write(repl(" ",*l),"^")
end</
First sample machine, with tape changes on each transition traced:
Line 3,877 ⟶ 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 3,893 ⟶ 5,351:
)
</syntaxhighlight>
===The incrementer machine===
<
NB. Simple Incrementer...
Line 3,916 ⟶ 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 3,957 ⟶ 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 3,976 ⟶ 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 3,999 ⟶ 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 4,098 ⟶ 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 4,105 ⟶ 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 4,342 ⟶ 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 4,443 ⟶ 5,901:
[ * [H] a a a a a b b b b b * ] --- (see,a)
Output (sort): [*, a, a, a, a, a, b, b, b, b, b, *]</pre>
=={{header|JavaScript}}==
{{works with|FireFox}}
<
document.write(d, '<br>')
if (i<0||i>=t.length) return
Line 4,488 ⟶ 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 4,578 ⟶ 6,037:
turing(prog, tape, verbose)
end
</
<pre>
Simple incrementer
Line 4,615 ⟶ 6,074:
=={{header|Kotlin}}==
{{trans|C}}
<
enum class Dir { LEFT, RIGHT, STAY }
Line 4,786 ⟶ 6,245:
)
).run()
}</
{{out}}
Line 4,836 ⟶ 6,295:
(Only the first 20 lines displayed)
</pre>
=={{header|Lambdatalk}}==
<syntaxhighlight lang="scheme">
{require lib_H} // associative arrays library
{def tm
{def tm.r
{lambda {:data :rules :state :end :blank :i :N}
{if {or {W.equal? :state :end} {> :N 400}} // recursion limited to 400
then :data
else {let { {:data :data} {:rules :rules}
{:state {H.get :state :rules}}
{:end :end} {:blank :blank}
{:i :i} {:N :N}
{:cell {if {W.equal? {A.get :i :data} undefined}
then :blank
else {A.get :i :data}}}
} {tm.r {A.set! :i {H.get write {H.get :cell :state}} :data}
:rules
{H.get next {H.get :cell :state}}
:end
:blank
{+ :i {H.get move {H.get :cell :state}} }
{+ :N 1} } }}}}
{lambda {:name :data :rules :state :end :blank}
:name: {A.duplicate :data} ->
{tm.r :data :rules :state :end :blank 0 0}}}
-> tm
{tm zero2one
{A.new 0 0 0}
{H.new A {H.new 0 {H.new write 1 | move 1 | next A} |
B {H.new write . | move 1 | next H} }
} A H B}
output: zero2one: [0,0,0] -> [1,1,1,.]
{tm add_one
{A.new 1 1 1}
{H.new A {H.new 1 {H.new write 1 | move 1 | next A} |
B {H.new write 1 | move 0 | next B} }
} A B B}
output: add_one: [1,1,1] -> [1,1,1,1]
{tm unary_adder
{A.new 1 1 1 0 1 1 1}
{H.new A {H.new 1 {H.new write 0 | move 1 | next B} } |
B {H.new 1 {H.new write 1 | move 1 | next B} |
0 {H.new write 1 | move 0 | next H} }
} A H B}
output: unary_adder: [1,1,1,0,1,1,1] -> [0,1,1,1,1,1,1]
{tm duplicate
{A.new 1 1 1}
{H.new q0 {H.new 1 {H.new write B | move 1 | next q1} } |
q1 {H.new 1 {H.new write 1 | move 1 | next q1} |
0 {H.new write 0 | move 1 | next q2} |
B {H.new write 0 | move 1 | next q2}} |
q2 {H.new 1 {H.new write 1 | move 1 | next q2} |
B {H.new write 1 | move -1 | next q3}} |
q3 {H.new 1 {H.new write 1 | move -1 | next q3} |
0 {H.new write 0 | move -1 | next q3} |
B {H.new write 1 | move 1 | next q4}} |
q4 {H.new 1 {H.new write B | move 1 | next q1} |
0 {H.new write 0 | move 1 | next qf}}
} q0 qf B}
output: duplicate: [1,1,1] -> [1,1,1,0,1,1,1]
{tm sort
{A.new 2 1 2 2 2 1 1}
{H.new A {H.new 1 {H.new write 1 | move 1 | next A} |
2 {H.new write 3 | move 1 | next B} |
0 {H.new write 0 | move -1 | next E}} |
B {H.new 1 {H.new write 1 | move 1 | next B} |
2 {H.new write 2 | move 1 | next B} |
0 {H.new write 0 | move -1 | next C}} |
C {H.new 1 {H.new write 2 | move -1 | next D} |
2 {H.new write 2 | move -1 | next C} |
3 {H.new write 2 | move -1 | next E}} |
D {H.new 1 {H.new write 1 | move -1 | next D} |
2 {H.new write 2 | move -1 | next D} |
3 {H.new write 1 | move 1 | next A}} |
E {H.new 1 {H.new write 1 | move -1 | next E} |
0 {H.new write 0 | move 1 | next H}}
} A H 0}
output: sort: [2,1,2,2,2,1,1] -> [1,1,1,2,2,2,2,0]
{tm busy_beaver
{A.new}
{H.new A {H.new 0 {H.new write 1 | move 1 | next B} |
1 {H.new write 1 | move -1 | next C}} |
B {H.new 0 {H.new write 1 | move -1 | next A} |
1 {H.new write 1 | move 1 | next B}} |
C {H.new 0 {H.new write 1 | move -1 | next B} |
1 {H.new write 1 | move 0 | next H}}
} A H 0}
output: busy_beaver: [] -> [1,1,1]
{tm busy_beaver2
{A.new}
{H.new A {H.new 0 {H.new write 1 | move 1 | next B} |
1 {H.new write 1 | move -1 | next C}} |
B {H.new 0 {H.new write 1 | move 1 | next C} |
1 {H.new write 1 | move 1 | next B}} |
C {H.new 0 {H.new write 1 | move 1 | next D} |
1 {H.new write 0 | move -1 | next E}} |
D {H.new 0 {H.new write 1 | move -1 | next A} |
1 {H.new write 1 | move -1 | next D}} |
E {H.new 0 {H.new write 1 | move 0 | next K} |
1 {H.new write 0 | move -1 | next A}}
} A K 0}
output: busy_beaver2: [] -> [1,1,1,1,1,1,1,1,1,1,1]
</syntaxhighlight>
=={{header|Lua}}==
<
local incrementer = {
name = "Simple incrementer",
Line 4,921 ⟶ 6,514:
UTM(incrementer, {"1", "1", "1"})
UTM(threeStateBB, {})
UTM(fiveStateBB, {}, "countOnly")</
{{out}}
<pre>
Line 4,963 ⟶ 6,556:
Steps taken: 47176870</pre>
=={{header|
<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}}==
===The universal machine===
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 4,988 ⟶ 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 5,011 ⟶ 6,791:
fin=utm[Map[cmp,busyBeaver3S],0,0];
printMachine[fin[[1]],fin[[2]]];
</syntaxhighlight>
Summary output from the 2 short machines
Line 5,024 ⟶ 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 5,038 ⟶ 6,818:
fin=utm[Map[cmp,probable5S],0,0];
]
fin[[1]]//N
3.254757786465838*10^3698</syntaxhighlight>
=={{header|MATLAB}}==
<syntaxhighlight lang="matlab">function tape=turing(rules,tape,initial,terminal)
%"rules" is cell array of cell arrays of the following form:
%First element is number representing initial state
%Second element is number representing input from the tape
%Third element is number representing output printed onto the tape
%Fourth element is 'l', 'r', or 's' representing whether to go right,
%left, or stay. Treats any input other than 'l' or 'r' as 's'.
%Final value is state we go to
%0 is always blank symbol
term=0;
ind=1;
while term==0
a=[];
for i=1:numel(rules)
if rules{i}{1}==initial
a=[a i];
end
end
possible=rules(a);
n=numel(possible);
while numel(tape)<ind
tape=[tape, 0]; %#ok<AGROW>
end
for i=1:n
if(tape(ind)==possible{i}{2})
break;
end
end
instruction=possible{i};
tape(ind)=instruction{3};
if instruction{4}=='r'
ind=ind+1;
elseif instruction{4}=='l'
if ind==1
tape=[0,tape]; %#ok<AGROW>
else
ind=ind-1;
end
end
if terminal==instruction{5}
term=1;
else
initial=instruction{5};
end
end
end</syntaxhighlight>
{{out}}
<pre>
function Rulesets()
C={{'q0',1,1,'r','q0'};
{'q0',0,1,'s','qf'}};
turing(C,[1,1,1],'q0','qf')
C={{'a',0,1,'r','b'};
{'a',1,1,'l','c'};
{'b',0,1,'l','a'};
{'b',1,1,'r','b'};
{'c',0,1,'l','b'};
{'c',1,1,'s','halt'}};
turing(C,[0],'a','halt')
C={{'A', 0, 1, 'r', 'B'};
{'A', 1, 1, 'l', 'C'};
{'B', 0, 1, 'r', 'C'};
{'B', 1, 1, 'r', 'B'};
{'C', 0, 1, 'r', 'D'};
{'C', 1, 0, 'l', 'E'};
{'D', 0, 1, 'l', 'A'};
{'D', 1, 1, 'l', 'D'};
{'E', 0, 1, 's', 'H'};
{'E', 1, 0, 'l', 'A'}};
a=(turing(C,[0],'A','H'));
numel(a)
sum(a)
end
>> Rulesets
ans =
1 1 1 1
ans =
1 1 1 1 1 1
ans =
12289
ans =
4098
%Therefore, the last one outputs a tape of length 12289 with 4098 ones, which we expect</pre>
=={{header|Mercury}}==
===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 5,104 ⟶ 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 5,123 ⟶ 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 5,147 ⟶ 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 5,157 ⟶ 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 5,531 ⟶ 7,407:
end
</syntaxhighlight>
=={{header|Nim}}==
{{trans|Python}}
<
proc runUTM(state, halt, blank: string, tape: seq[string] = @[],
Line 5,543 ⟶ 7,419:
pos = 0
tape = tape
rulesTable:
if tape.len == 0: tape = @[blank]
Line 5,554 ⟶ 7,430:
while true:
stdout.write st, '\t'
for i, v in tape:
stdout.write if i == pos:
echo()
if st == halt: break
Line 5,578 ⟶ 7,453:
tape = "1 1 1".split,
blank = "B",
rules = @["q0 1 1 right q0".
"q0 B 1 stay qf".
echo "\nbusy beaver\n"
Line 5,585 ⟶ 7,460:
state = "a",
blank = "0",
rules = @["a 0 1 right b".
"a 1 1 left c".
"b 0 1 left a".
"b 1 1 right b".
"c 0 1 left b".
"c 1 1 stay halt".
echo "\nsorting test\n"
Line 5,597 ⟶ 7,472:
blank = "0",
tape = "2 2 2 1 2 2 1 2 1 2 1 2 1 2".split,
rules = @["A 1 1 right A".
"A 2 3 right B".
"A 0 0 left E".
"B 1 1 right B".
"B 2 2 right B".
"B 0 0 left C".
"C 1 2 left D".
"C 2 2 left C".
"C 3 2 left E".
"D 1 1 left D".
"D 2 2 left D".
"D 3 1 right A".
"E 1 1 left E".
"E 0 0 right STOP".
{{out}}
<pre>incr machine
q0 [1] 1 1
q0 1 [1] 1
q0 1 1 [1]
q0 1 1 1 [B]
qf 1 1 1 [1]
busy beaver
a [0]
b 1 [0]
a [1] 1
c [0] 1 1
b [0] 1 1 1
a [0] 1 1 1 1
b 1 [1] 1 1 1
b 1 1 [1] 1 1
b 1 1 1 [1] 1
b 1 1 1 1 [1]
b 1 1 1 1 1 [0]
a 1 1 1 1 [1] 1
c 1 1 1 [1] 1 1
halt 1 1 1 [1] 1 1
sorting test
A [2] 2 2 1 2 2 1 2 1 2 1 2 1 2
B 3 [2] 2 1 2 2 1 2 1 2 1 2 1 2
B 3 2 [2] 1 2 2 1 2 1 2 1 2 1 2
B 3 2 2 [1] 2 2 1 2 1 2 1 2 1 2
B 3 2 2 1 [2] 2 1 2 1 2 1 2 1 2
B 3 2 2 1 2 [2] 1 2 1 2 1 2 1 2
B 3 2 2 1 2 2 [1] 2 1 2 1 2 1 2
B 3 2 2 1 2 2 1 [2] 1 2 1 2 1 2
B 3 2 2 1 2 2 1 2 [1] 2 1 2 1 2
B 3 2 2 1 2 2 1 2 1 [2] 1 2 1 2
B 3 2 2 1 2 2 1 2 1 2 [1] 2 1 2
B 3 2 2 1 2 2 1 2 1 2 1 [2] 1 2
B 3 2 2 1 2 2 1 2 1 2 1 2 [1] 2
B 3 2 2 1 2 2 1 2 1 2 1 2 1 [2]
B 3 2 2 1 2 2 1 2 1 2 1 2 1 2 [0]
C 3 2 2 1 2 2 1 2 1 2 1 2 1 [2] 0
C 3 2 2 1 2 2 1 2 1 2 1 2 [1] 2 0
D 3 2 2 1 2 2 1 2 1 2 1 [2] 2 2 0
D 3 2 2 1 2 2 1 2 1 2 [1] 2 2 2 0
D 3 2 2 1 2 2 1 2 1 [2] 1 2 2 2 0
D 3 2 2 1 2 2 1 2 [1] 2 1 2 2 2 0
D 3 2 2 1 2 2 1 [2] 1 2 1 2 2 2 0
D 3 2 2 1 2 2 [1] 2 1 2 1 2 2 2 0
D 3 2 2 1 2 [2] 1 2 1 2 1 2 2 2 0
D 3 2 2 1 [2] 2 1 2 1 2 1 2 2 2 0
D 3 2 2 [1] 2 2 1 2 1 2 1 2 2 2 0
D 3 2 [2] 1 2 2 1 2 1 2 1 2 2 2 0
D 3 [2] 2 1 2 2 1 2 1 2 1 2 2 2 0
D [3] 2 2 1 2 2 1 2 1 2 1 2 2 2 0
A 1 [2] 2 1 2 2 1 2 1 2 1 2 2 2 0
B 1 3 [2] 1 2 2 1 2 1 2 1 2 2 2 0
B 1 3 2 [1] 2 2 1 2 1 2 1 2 2 2 0
B 1 3 2 1 [2] 2 1 2 1 2 1 2 2 2 0
B 1 3 2 1 2 [2] 1 2 1 2 1 2 2 2 0
B 1 3 2 1 2 2 [1] 2 1 2 1 2 2 2 0
B 1 3 2 1 2 2 1 [2] 1 2 1 2 2 2 0
B 1 3 2 1 2 2 1 2 [1] 2 1 2 2 2 0
B 1 3 2 1 2 2 1 2 1 [2] 1 2 2 2 0
B 1 3 2 1 2 2 1 2 1 2 [1] 2 2 2 0
B 1 3 2 1 2 2 1 2 1 2 1 [2] 2 2 0
B 1 3 2 1 2 2 1 2 1 2 1 2 [2] 2 0
B 1 3 2 1 2 2 1 2 1 2 1 2 2 [2] 0
B 1 3 2 1 2 2 1 2 1 2 1 2 2 2 [0]
C 1 3 2 1 2 2 1 2 1 2 1 2 2 [2] 0
C 1 3 2 1 2 2 1 2 1 2 1 2 [2] 2 0
C 1 3 2 1 2 2 1 2 1 2 1 [2] 2 2 0
C 1 3 2 1 2 2 1 2 1 2 [1] 2 2 2 0
D 1 3 2 1 2 2 1 2 1 [2] 2 2 2 2 0
D 1 3 2 1 2 2 1 2 [1] 2 2 2 2 2 0
D 1 3 2 1 2 2 1 [2] 1 2 2 2 2 2 0
D 1 3 2 1 2 2 [1] 2 1 2 2 2 2 2 0
D 1 3 2 1 2 [2] 1 2 1 2 2 2 2 2 0
D 1 3 2 1 [2] 2 1 2 1 2 2 2 2 2 0
D 1 3 2 [1] 2 2 1 2 1 2 2 2 2 2 0
D 1 3 [2] 1 2 2 1 2 1 2 2 2 2 2 0
D 1 [3] 2 1 2 2 1 2 1 2 2 2 2 2 0
A 1 1 [2] 1 2 2 1 2 1 2 2 2 2 2 0
B 1 1 3 [1] 2 2 1 2 1 2 2 2 2 2 0
B 1 1 3 1 [2] 2 1 2 1 2 2 2 2 2 0
B 1 1 3 1 2 [2] 1 2 1 2 2 2 2 2 0
B 1 1 3 1 2 2 [1] 2 1 2 2 2 2 2 0
B 1 1 3 1 2 2 1 [2] 1 2 2 2 2 2 0
B 1 1 3 1 2 2 1 2 [1] 2 2 2 2 2 0
B 1 1 3 1 2 2 1 2 1 [2] 2 2 2 2 0
B 1 1 3 1 2 2 1 2 1 2 [2] 2 2 2 0
B 1 1 3 1 2 2 1 2 1 2 2 [2] 2 2 0
B 1 1 3 1 2 2 1 2 1 2 2 2 [2] 2 0
B 1 1 3 1 2 2 1 2 1 2 2 2 2 [2] 0
B 1 1 3 1 2 2 1 2 1 2 2 2 2 2 [0]
C 1 1 3 1 2 2 1 2 1 2 2 2 2 [2] 0
C 1 1 3 1 2 2 1 2 1 2 2 2 [2] 2 0
C 1 1 3 1 2 2 1 2 1 2 2 [2] 2 2 0
C 1 1 3 1 2 2 1 2 1 2 [2] 2 2 2 0
C 1 1 3 1 2 2 1 2 1 [2] 2 2 2 2 0
C 1 1 3 1 2 2 1 2 [1] 2 2 2 2 2 0
D 1 1 3 1 2 2 1 [2] 2 2 2 2 2 2 0
D 1 1 3 1 2 2 [1] 2 2 2 2 2 2 2 0
D 1 1 3 1 2 [2] 1 2 2 2 2 2 2 2 0
D 1 1 3 1 [2] 2 1 2 2 2 2 2 2 2 0
D 1 1 3 [1] 2 2 1 2 2 2 2 2 2 2 0
D 1 1 [3] 1 2 2 1 2 2 2 2 2 2 2 0
A 1 1 1 [1] 2 2 1 2 2 2 2 2 2 2 0
A 1 1 1 1 [2] 2 1 2 2 2 2 2 2 2 0
B 1 1 1 1 3 [2] 1 2 2 2 2 2 2 2 0
B 1 1 1 1 3 2 [1] 2 2 2 2 2 2 2 0
B 1 1 1 1 3 2 1 [2] 2 2 2 2 2 2 0
B 1 1 1 1 3 2 1 2 [2] 2 2 2 2 2 0
B 1 1 1 1 3 2 1 2 2 [2] 2 2 2 2 0
B 1 1 1 1 3 2 1 2 2 2 [2] 2 2 2 0
B 1 1 1 1 3 2 1 2 2 2 2 [2] 2 2 0
B 1 1 1 1 3 2 1 2 2 2 2 2 [2] 2 0
B 1 1 1 1 3 2 1 2 2 2 2 2 2 [2] 0
B 1 1 1 1 3 2 1 2 2 2 2 2 2 2 [0]
C 1 1 1 1 3 2 1 2 2 2 2 2 2 [2] 0
C 1 1 1 1 3 2 1 2 2 2 2 2 [2] 2 0
C 1 1 1 1 3 2 1 2 2 2 2 [2] 2 2 0
C 1 1 1 1 3 2 1 2 2 2 [2] 2 2 2 0
C 1 1 1 1 3 2 1 2 2 [2] 2 2 2 2 0
C 1 1 1 1 3 2 1 2 [2] 2 2 2 2 2 0
C 1 1 1 1 3 2 1 [2] 2 2 2 2 2 2 0
C 1 1 1 1 3 2 [1] 2 2 2 2 2 2 2 0
D 1 1 1 1 3 [2] 2 2 2 2 2 2 2 2 0
D 1 1 1 1 [3] 2 2 2 2 2 2 2 2 2 0
A 1 1 1 1 1 [2] 2 2 2 2 2 2 2 2 0
B 1 1 1 1 1 3 [2] 2 2 2 2 2 2 2 0
B 1 1 1 1 1 3 2 [2] 2 2 2 2 2 2 0
B 1 1 1 1 1 3 2 2 [2] 2 2 2 2 2 0
B 1 1 1 1 1 3 2 2 2 [2] 2 2 2 2 0
B 1 1 1 1 1 3 2 2 2 2 [2] 2 2 2 0
B 1 1 1 1 1 3 2 2 2 2 2 [2] 2 2 0
B 1 1 1 1 1 3 2 2 2 2 2 2 [2] 2 0
B 1 1 1 1 1 3 2 2 2 2 2 2 2 [2] 0
B 1 1 1 1 1 3 2 2 2 2 2 2 2 2 [0]
C 1 1 1 1 1 3 2 2 2 2 2 2 2 [2] 0
C 1 1 1 1 1 3 2 2 2 2 2 2 [2] 2 0
C 1 1 1 1 1 3 2 2 2 2 2 [2] 2 2 0
C 1 1 1 1 1 3 2 2 2 2 [2] 2 2 2 0
C 1 1 1 1 1 3 2 2 2 [2] 2 2 2 2 0
C 1 1 1 1 1 3 2 2 [2] 2 2 2 2 2 0
C 1 1 1 1 1 3 2 [2] 2 2 2 2 2 2 0
C 1 1 1 1 1 3 [2] 2 2 2 2 2 2 2 0
C 1 1 1 1 1 [3] 2 2 2 2 2 2 2 2 0
E 1 1 1 1 [1] 2 2 2 2 2 2 2 2 2 0
E 1 1 1 [1] 1 2 2 2 2 2 2 2 2 2 0
E 1 1 [1] 1 1 2 2 2 2 2 2 2 2 2 0
E 1 [1] 1 1 1 2 2 2 2 2 2 2 2 2 0
E [1] 1 1 1 1 2 2 2 2 2 2 2 2 2 0
E [0] 1 1 1 1 1 2 2 2 2 2 2 2 2 2 0
STOP 0 [1] 1 1 1 1 2 2 2 2 2 2 2 2 2 0 </pre>
=={{header|Pascal}}==
Line 6,207 ⟶ 8,239:
=={{header|Perl}}==
<
use warnings;
Line 6,289 ⟶ 8,321:
[qw/D 3 1 right A/],
[qw/E 1 1 left E/],
[qw/E 0 0 right STOP/]];</
=={{header|Phix}}==
{{trans|Lua}}
<!--<syntaxhighlight lang="phix">(phixonline)-->
<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>
<span style="color: #000080;font-style:italic;">-- Machine definitions</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">incrementer</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span>
<span style="color: #000080;font-style:italic;">/*name =*/</span> <span style="color: #008000;">"Simple incrementer"</span><span style="color: #0000FF;">,</span>
<span style="color: #000080;font-style:italic;">/*initState =*/</span> <span style="color: #008000;">"q0"</span><span style="color: #0000FF;">,</span>
<span style="color: #000080;font-style:italic;">/*endState =*/</span> <span style="color: #008000;">"qf"</span><span style="color: #0000FF;">,</span>
<span style="color: #000080;font-style:italic;">/*blank =*/</span> <span style="color: #008000;">"B"</span><span style="color: #0000FF;">,</span>
<span style="color: #000080;font-style:italic;">/*rules =*/</span> <span style="color: #0000FF;">{</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"q0"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"right"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"q0"</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"q0"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"B"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"stay"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"qf"</span><span style="color: #0000FF;">}</span>
<span style="color: #0000FF;">}</span>
<span style="color: #0000FF;">}</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">threeStateBB</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span>
<span style="color: #000080;font-style:italic;">/*name =*/</span> <span style="color: #008000;">"Three-state busy beaver"</span><span style="color: #0000FF;">,</span>
<span style="color: #000080;font-style:italic;">/*initState =*/</span> <span style="color: #008000;">"a"</span><span style="color: #0000FF;">,</span>
<span style="color: #000080;font-style:italic;">/*endState =*/</span> <span style="color: #008000;">"halt"</span><span style="color: #0000FF;">,</span>
<span style="color: #000080;font-style:italic;">/*blank =*/</span> <span style="color: #008000;">"0"</span><span style="color: #0000FF;">,</span>
<span style="color: #000080;font-style:italic;">/*rules =*/</span> <span style="color: #0000FF;">{</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"a"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"0"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"right"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"b"</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"a"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"left"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"c"</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"b"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"0"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"left"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"a"</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"b"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"right"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"b"</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"c"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"0"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"left"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"b"</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"c"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"stay"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"halt"</span><span style="color: #0000FF;">}</span>
<span style="color: #0000FF;">}</span>
<span style="color: #0000FF;">}</span>
<span style="color: #008080;">constant</span> <span style="color: #000000;">fiveStateBB</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span>
<span style="color: #000080;font-style:italic;">/*name =*/</span> <span style="color: #008000;">"Five-state busy beaver"</span><span style="color: #0000FF;">,</span>
<span style="color: #000080;font-style:italic;">/*initState =*/</span> <span style="color: #008000;">"A"</span><span style="color: #0000FF;">,</span>
<span style="color: #000080;font-style:italic;">/*endState =*/</span> <span style="color: #008000;">"H"</span><span style="color: #0000FF;">,</span>
<span style="color: #000080;font-style:italic;">/*blank =*/</span> <span style="color: #008000;">"0"</span><span style="color: #0000FF;">,</span>
<span style="color: #000080;font-style:italic;">/*rules =*/</span> <span style="color: #0000FF;">{</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"A"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"0"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"right"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"B"</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"A"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"left"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"C"</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"B"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"0"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"right"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"C"</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"B"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"right"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"B"</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"C"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"0"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"right"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"D"</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"C"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"0"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"left"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"E"</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"D"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"0"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"left"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"A"</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"D"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"left"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"D"</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"E"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"0"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"stay"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"H"</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #008000;">"E"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"0"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"left"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"A"</span><span style="color: #0000FF;">}</span>
<span style="color: #0000FF;">}</span>
<span style="color: #0000FF;">}</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">show</span><span style="color: #0000FF;">(</span><span style="color: #004080;">string</span> <span style="color: #000000;">state</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">headpos</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">tape</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">" %-6s | "</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">state</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">p</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tape</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">do</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008080;">iff</span><span style="color: #0000FF;">(</span><span style="color: #000000;">p</span><span style="color: #0000FF;">=</span><span style="color: #000000;">headpos</span><span style="color: #0000FF;">?</span><span style="color: #008000;">"[%s]"</span><span style="color: #0000FF;">:</span><span style="color: #008000;">" %s "</span><span style="color: #0000FF;">),{</span><span style="color: #000000;">tape</span><span style="color: #0000FF;">[</span><span style="color: #000000;">p</span><span style="color: #0000FF;">]})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #000080;font-style:italic;">-- a universal turing machine</span>
<span style="color: #008080;">procedure</span> <span style="color: #000000;">UTM</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">machine</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">tape</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">integer</span> <span style="color: #000000;">countOnly</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">string</span> <span style="color: #000000;">state</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">machine</span><span style="color: #0000FF;">[</span><span style="color: #000000;">initState</span><span style="color: #0000FF;">]</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">headpos</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">counter</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\n\n%s\n%s\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">machine</span><span style="color: #0000FF;">[</span><span style="color: #000000;">name</span><span style="color: #0000FF;">],</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #008000;">'='</span><span style="color: #0000FF;">,</span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">machine</span><span style="color: #0000FF;">[</span><span style="color: #000000;">name</span><span style="color: #0000FF;">]))})</span>
<span style="color: #008080;">if</span> <span style="color: #008080;">not</span> <span style="color: #000000;">countOnly</span> <span style="color: #008080;">then</span> <span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">" State | Tape [head]\n---------------------\n"</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">headpos</span><span style="color: #0000FF;">></span><span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tape</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">tape</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">append</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tape</span><span style="color: #0000FF;">,</span><span style="color: #000000;">machine</span><span style="color: #0000FF;">[</span><span style="color: #000000;">blank</span><span style="color: #0000FF;">])</span>
<span style="color: #008080;">elsif</span> <span style="color: #000000;">headpos</span><span style="color: #0000FF;"><</span><span style="color: #000000;">1</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">tape</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">prepend</span><span style="color: #0000FF;">(</span><span style="color: #000000;">tape</span><span style="color: #0000FF;">,</span><span style="color: #000000;">machine</span><span style="color: #0000FF;">[</span><span style="color: #000000;">blank</span><span style="color: #0000FF;">])</span>
<span style="color: #000000;">headpos</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #008080;">not</span> <span style="color: #000000;">countOnly</span> <span style="color: #008080;">then</span> <span style="color: #000000;">show</span><span style="color: #0000FF;">(</span><span style="color: #000000;">state</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">headpos</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">tape</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">machine</span><span style="color: #0000FF;">[</span><span style="color: #000000;">rules</span><span style="color: #0000FF;">])</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">rule</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">machine</span><span style="color: #0000FF;">[</span><span style="color: #000000;">rules</span><span style="color: #0000FF;">][</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">rule</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]=</span><span style="color: #000000;">state</span> <span style="color: #008080;">and</span> <span style="color: #000000;">rule</span><span style="color: #0000FF;">[</span><span style="color: #000000;">2</span><span style="color: #0000FF;">]=</span><span style="color: #000000;">tape</span><span style="color: #0000FF;">[</span><span style="color: #000000;">headpos</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span>
<span style="color: #000000;">tape</span><span style="color: #0000FF;">[</span><span style="color: #000000;">headpos</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">rule</span><span style="color: #0000FF;">[</span><span style="color: #000000;">3</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">rule</span><span style="color: #0000FF;">[</span><span style="color: #000000;">4</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">==</span> <span style="color: #008000;">"left"</span> <span style="color: #008080;">then</span> <span style="color: #000000;">headpos</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">1</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">rule</span><span style="color: #0000FF;">[</span><span style="color: #000000;">4</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">==</span> <span style="color: #008000;">"right"</span> <span style="color: #008080;">then</span> <span style="color: #000000;">headpos</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #000000;">state</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">rule</span><span style="color: #0000FF;">[</span><span style="color: #000000;">5</span><span style="color: #0000FF;">]</span>
<span style="color: #008080;">exit</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #000000;">counter</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">state</span><span style="color: #0000FF;">=</span><span style="color: #000000;">machine</span><span style="color: #0000FF;">[</span><span style="color: #000000;">endState</span><span style="color: #0000FF;">]</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">countOnly</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Steps taken: %d\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">counter</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">else</span>
<span style="color: #000000;">show</span><span style="color: #0000FF;">(</span><span style="color: #000000;">state</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">headpos</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">tape</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">procedure</span>
<span style="color: #004080;">atom</span> <span style="color: #000000;">t0</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">time</span><span style="color: #0000FF;">()</span>
<span style="color: #000000;">UTM</span><span style="color: #0000FF;">(</span><span style="color: #000000;">incrementer</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{</span><span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">,</span> <span style="color: #008000;">"1"</span><span style="color: #0000FF;">})</span>
<span style="color: #000000;">UTM</span><span style="color: #0000FF;">(</span><span style="color: #000000;">threeStateBB</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{})</span>
<span style="color: #008080;">if</span> <span style="color: #7060A8;">platform</span><span style="color: #0000FF;">()!=</span><span style="color: #004600;">JS</span> <span style="color: #008080;">then</span> <span style="color: #000080;font-style:italic;">-- 1min 7s</span>
<span style="color: #000000;">UTM</span><span style="color: #0000FF;">(</span><span style="color: #000000;">fiveStateBB</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">{},</span> <span style="color: #000000;">countOnly</span><span style="color: #0000FF;">:=</span><span style="color: #000000;">1</span><span style="color: #0000FF;">)</span>
<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>
<!--</syntaxhighlight>-->
{{Out}}
<pre>
Line 6,664 ⟶ 8,461:
======================
Steps taken: 47176870
"13.3s"
</pre>
Obviously the first two are near-instant but as shown the last one is a bit too much to bother with running in a browser.
=={{header|PHL}}==
<
extern printf;
Line 6,922 ⟶ 8,618:
emulateTuring(rules, 0, 3, tape, 0);
return 0;
]</
Output:
Line 6,966 ⟶ 8,662:
111111 3
^
=={{header|PicoLisp}}==
<syntaxhighlight lang="picolisp"># Finite state machine
(de turing (Tape Init Halt Blank Rules Verbose)
(let
(Head 1
State Init
Rule NIL
S 'start
C (length Tape))
(catch NIL
(loop
(state 'S
(start 'print
(when (=0 C)
(setq Tape (insert Head Tape Blank))
(inc 'C) ) )
(print 'lookup
(when Verbose
(for (N . I) Tape
(if (= N Head)
(print (list I))
(prin I) ) )
(prinl) )
(when (= State Halt) (throw NIL) ) )
(lookup 'do
(setq Rule
(find
'((X)
(and
(= (car X) State)
(= (cadr X) (car (nth Tape Head))) ) )
Rules ) ) )
(do 'step
(setq Tape (place Head Tape (caddr Rule))) )
(step 'print
(cond
((= (cadddr Rule) 'R) (inc 'Head))
((= (cadddr Rule) 'L) (dec 'Head)) )
(cond
((< Head 1)
(setq Tape (insert Head Tape Blank))
(inc 'C)
(one Head) )
((> Head C)
(setq Tape (insert Head Tape Blank))
(inc 'C) ) )
(setq State (last Rule)) ) ) ) ) )
Tape )
(println "Simple incrementer")
(turing '(1 1 1) 'A 'H 'B '((A 1 1 R A) (A B 1 S H)) T)
(println "Three-state busy beaver")
(turing '() 'A 'H 0
'((A 0 1 R B)
(A 1 1 L C)
(B 0 1 L A)
(B 1 1 R B)
(C 0 1 L B)
(C 1 1 S H)) T )
(println "Five-state busy beaver")
(let Tape (turing '() 'A 'H 0
'((A 0 1 R B)
(A 1 1 L C)
(B 0 1 R C)
(B 1 1 R B)
(C 0 1 R D)
(C 1 0 L E)
(D 0 1 L A)
(D 1 1 L D)
(E 0 1 S H)
(E 1 0 L A)) NIL)
(println '0s: (cnt '((X) (= 0 X)) Tape))
(println '1s: (cnt '((X) (= 1 X)) Tape)) )
(bye)</syntaxhighlight>
{{out}}
<pre>"Simple incrementer"
(1)11
1(1)1
11(1)
111(B)
111(1)
"Three-state busy beaver"
(0)
1(0)
(1)1
(0)11
(0)111
(0)1111
1(1)111
11(1)11
111(1)1
1111(1)
11111(0)
1111(1)1
111(1)11
111(1)11
"Five-state busy beaver"
0s: 8191
1s: 4098</pre>
=={{header|Prolog}}==
===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 7,000 ⟶ 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 7,011 ⟶ 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 7,027 ⟶ 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 7,119 ⟶ 8,918:
)
)
</syntaxhighlight>
===Busy Beaver Function with 1 to 5 beavers (states) and 2 symbols (0,1)===
This function calculates the steps and sum of ones on the infinite tape for the states 1 - 5 with the best knowing set of rules for maximum steps/ones (i.e. highest busy beaver number for state n).
<syntaxhighlight lang="python">def busy_beaver(beavers):
tape = dict()
pos = beaver = steps = 0
while True:
steps += 1
value = tape.get(pos, 0)
new_value, direction, next_beaver = beavers[beaver * 2 + value]
tape[pos] = int(new_value)
if next_beaver == 'H': return steps, sum(tape.values())
pos += 1 if direction == 'R' else -1
beaver = ord(next_beaver) - 65
rules = ['1RH not_used',
'1RB 1LB 1LA 1RH',
'1RB 1RH 0RC 1RB 1LC 1LA',
'1RB 1LB 1LA 0LC 1RH 1LD 1RD 0RA',
'1RB 1LC 1RC 1RB 1RD 0LE 1LA 1LD 1RH 0LA']
for beavers in rules:
beavers = beavers.split()
steps, ones = busy_beaver(beavers)
print(f'BB({len(beavers)//2}) = {steps:>10,} steps with {ones:>5,} ones')</syntaxhighlight>
{{out}}
<pre>BB(1) = 1 steps with 1 ones
BB(2) = 6 steps with 4 ones
BB(3) = 14 steps with 6 ones
BB(4) = 107 steps with 13 ones
BB(5) = 47,176,870 steps with 4,098 ones
</pre>
=={{header|Racket}}==
<
#lang racket
;;;=============================================================
Line 7,220 ⟶ 9,056:
(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 7,227 ⟶ 9,063:
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 7,246 ⟶ 9,082:
The incrementer for binary numbers
<
(define ADD1
(Turing-Machine #:start 'Start
Line 7,255 ⟶ 9,091:
[Add 1 0 left Add]
[Add () 1 stay End]))
</syntaxhighlight>
<pre>
> (ADD1 '(1 1 0))
Line 7,289 ⟶ 9,125:
The busy beaver
<
(define BEAVER
(Turing-Machine #:start 'a
Line 7,298 ⟶ 9,134:
[c () 1 left b]
[c 1 1 stay halt]))
</syntaxhighlight>
<pre>
> (BEAVER '(()))
Line 7,320 ⟶ 9,156:
The sorting machine
<
(define SORT
(Turing-Machine #:start 'A
Line 7,337 ⟶ 9,173:
[E 1 1 left E]
[E () () right STOP]))
</syntaxhighlight>
<pre>
> (SORT '(2 1 2 2 2 1 1))
Line 7,384 ⟶ 9,220:
(1 1 1 2 2 2 2)
</pre>
=={{header|Raku}}==
(formerly Perl 6)
{{trans|Perl}}
{{works with|Rakudo|2018.03}}
<syntaxhighlight lang="raku" line>sub run_utm(:$state! is copy, :$blank!, :@rules!, :@tape = [$blank], :$halt, :$pos is copy = 0) {
$pos += @tape if $pos < 0;
die "Bad initial position" unless $pos ~~ ^@tape;
STEP: loop {
print "$state\t";
for ^@tape {
my $v = @tape[$_];
print $_ == $pos ?? "[$v]" !! " $v ";
}
print "\n";
last if $state eq $halt;
for @rules -> @rule {
my ($s0, $v0, $v1, $dir, $s1) = @rule;
next unless $s0 eq $state and @tape[$pos] eq $v0;
@tape[$pos] = $v1;
given $dir {
when 'left' {
if $pos == 0 { unshift @tape, $blank }
else { $pos-- }
}
when 'right' {
push @tape, $blank if ++$pos >= @tape;
}
}
$state = $s1;
next STEP;
}
die 'No matching rules';
}
}
say "incr machine";
run_utm :halt<qf>,
:state<q0>,
:tape[1,1,1],
:blank<B>,
:rules[
[< q0 1 1 right q0 >],
[< q0 B 1 stay qf >]
];
say "\nbusy beaver";
run_utm :halt<halt>,
:state<a>,
:blank<0>,
:rules[
[< a 0 1 right b >],
[< a 1 1 left c >],
[< b 0 1 left a >],
[< b 1 1 right b >],
[< c 0 1 left b >],
[< c 1 1 stay halt >]
];
say "\nsorting test";
run_utm :halt<STOP>,
:state<A>,
:blank<0>,
:tape[< 2 2 2 1 2 2 1 2 1 2 1 2 1 2 >],
:rules[
[< A 1 1 right A >],
[< A 2 3 right B >],
[< A 0 0 left E >],
[< B 1 1 right B >],
[< B 2 2 right B >],
[< B 0 0 left C >],
[< C 1 2 left D >],
[< C 2 2 left C >],
[< C 3 2 left E >],
[< D 1 1 left D >],
[< D 2 2 left D >],
[< D 3 1 right A >],
[< E 1 1 left E >],
[< E 0 0 right STOP >]
];
</syntaxhighlight>
{{out}}
<pre>incr machine
q0 [1] 1 1
q0 1 [1] 1
q0 1 1 [1]
q0 1 1 1 [B]
qf 1 1 1 [1]
busy beaver
a [0]
b 1 [0]
a [1] 1
c [0] 1 1
b [0] 1 1 1
a [0] 1 1 1 1
b 1 [1] 1 1 1
b 1 1 [1] 1 1
b 1 1 1 [1] 1
b 1 1 1 1 [1]
b 1 1 1 1 1 [0]
a 1 1 1 1 [1] 1
c 1 1 1 [1] 1 1
halt 1 1 1 [1] 1 1
sorting test
A [2] 2 2 1 2 2 1 2 1 2 1 2 1 2
B 3 [2] 2 1 2 2 1 2 1 2 1 2 1 2
B 3 2 [2] 1 2 2 1 2 1 2 1 2 1 2
B 3 2 2 [1] 2 2 1 2 1 2 1 2 1 2
B 3 2 2 1 [2] 2 1 2 1 2 1 2 1 2
B 3 2 2 1 2 [2] 1 2 1 2 1 2 1 2
B 3 2 2 1 2 2 [1] 2 1 2 1 2 1 2
B 3 2 2 1 2 2 1 [2] 1 2 1 2 1 2
B 3 2 2 1 2 2 1 2 [1] 2 1 2 1 2
B 3 2 2 1 2 2 1 2 1 [2] 1 2 1 2
B 3 2 2 1 2 2 1 2 1 2 [1] 2 1 2
B 3 2 2 1 2 2 1 2 1 2 1 [2] 1 2
B 3 2 2 1 2 2 1 2 1 2 1 2 [1] 2
B 3 2 2 1 2 2 1 2 1 2 1 2 1 [2]
B 3 2 2 1 2 2 1 2 1 2 1 2 1 2 [0]
C 3 2 2 1 2 2 1 2 1 2 1 2 1 [2] 0
C 3 2 2 1 2 2 1 2 1 2 1 2 [1] 2 0
D 3 2 2 1 2 2 1 2 1 2 1 [2] 2 2 0
D 3 2 2 1 2 2 1 2 1 2 [1] 2 2 2 0
D 3 2 2 1 2 2 1 2 1 [2] 1 2 2 2 0
D 3 2 2 1 2 2 1 2 [1] 2 1 2 2 2 0
D 3 2 2 1 2 2 1 [2] 1 2 1 2 2 2 0
D 3 2 2 1 2 2 [1] 2 1 2 1 2 2 2 0
D 3 2 2 1 2 [2] 1 2 1 2 1 2 2 2 0
D 3 2 2 1 [2] 2 1 2 1 2 1 2 2 2 0
D 3 2 2 [1] 2 2 1 2 1 2 1 2 2 2 0
D 3 2 [2] 1 2 2 1 2 1 2 1 2 2 2 0
D 3 [2] 2 1 2 2 1 2 1 2 1 2 2 2 0
D [3] 2 2 1 2 2 1 2 1 2 1 2 2 2 0
A 1 [2] 2 1 2 2 1 2 1 2 1 2 2 2 0
B 1 3 [2] 1 2 2 1 2 1 2 1 2 2 2 0
B 1 3 2 [1] 2 2 1 2 1 2 1 2 2 2 0
B 1 3 2 1 [2] 2 1 2 1 2 1 2 2 2 0
B 1 3 2 1 2 [2] 1 2 1 2 1 2 2 2 0
B 1 3 2 1 2 2 [1] 2 1 2 1 2 2 2 0
B 1 3 2 1 2 2 1 [2] 1 2 1 2 2 2 0
B 1 3 2 1 2 2 1 2 [1] 2 1 2 2 2 0
B 1 3 2 1 2 2 1 2 1 [2] 1 2 2 2 0
B 1 3 2 1 2 2 1 2 1 2 [1] 2 2 2 0
B 1 3 2 1 2 2 1 2 1 2 1 [2] 2 2 0
B 1 3 2 1 2 2 1 2 1 2 1 2 [2] 2 0
B 1 3 2 1 2 2 1 2 1 2 1 2 2 [2] 0
B 1 3 2 1 2 2 1 2 1 2 1 2 2 2 [0]
C 1 3 2 1 2 2 1 2 1 2 1 2 2 [2] 0
C 1 3 2 1 2 2 1 2 1 2 1 2 [2] 2 0
C 1 3 2 1 2 2 1 2 1 2 1 [2] 2 2 0
C 1 3 2 1 2 2 1 2 1 2 [1] 2 2 2 0
D 1 3 2 1 2 2 1 2 1 [2] 2 2 2 2 0
D 1 3 2 1 2 2 1 2 [1] 2 2 2 2 2 0
D 1 3 2 1 2 2 1 [2] 1 2 2 2 2 2 0
D 1 3 2 1 2 2 [1] 2 1 2 2 2 2 2 0
D 1 3 2 1 2 [2] 1 2 1 2 2 2 2 2 0
D 1 3 2 1 [2] 2 1 2 1 2 2 2 2 2 0
D 1 3 2 [1] 2 2 1 2 1 2 2 2 2 2 0
D 1 3 [2] 1 2 2 1 2 1 2 2 2 2 2 0
D 1 [3] 2 1 2 2 1 2 1 2 2 2 2 2 0
A 1 1 [2] 1 2 2 1 2 1 2 2 2 2 2 0
B 1 1 3 [1] 2 2 1 2 1 2 2 2 2 2 0
B 1 1 3 1 [2] 2 1 2 1 2 2 2 2 2 0
B 1 1 3 1 2 [2] 1 2 1 2 2 2 2 2 0
B 1 1 3 1 2 2 [1] 2 1 2 2 2 2 2 0
B 1 1 3 1 2 2 1 [2] 1 2 2 2 2 2 0
B 1 1 3 1 2 2 1 2 [1] 2 2 2 2 2 0
B 1 1 3 1 2 2 1 2 1 [2] 2 2 2 2 0
B 1 1 3 1 2 2 1 2 1 2 [2] 2 2 2 0
B 1 1 3 1 2 2 1 2 1 2 2 [2] 2 2 0
B 1 1 3 1 2 2 1 2 1 2 2 2 [2] 2 0
B 1 1 3 1 2 2 1 2 1 2 2 2 2 [2] 0
B 1 1 3 1 2 2 1 2 1 2 2 2 2 2 [0]
C 1 1 3 1 2 2 1 2 1 2 2 2 2 [2] 0
C 1 1 3 1 2 2 1 2 1 2 2 2 [2] 2 0
C 1 1 3 1 2 2 1 2 1 2 2 [2] 2 2 0
C 1 1 3 1 2 2 1 2 1 2 [2] 2 2 2 0
C 1 1 3 1 2 2 1 2 1 [2] 2 2 2 2 0
C 1 1 3 1 2 2 1 2 [1] 2 2 2 2 2 0
D 1 1 3 1 2 2 1 [2] 2 2 2 2 2 2 0
D 1 1 3 1 2 2 [1] 2 2 2 2 2 2 2 0
D 1 1 3 1 2 [2] 1 2 2 2 2 2 2 2 0
D 1 1 3 1 [2] 2 1 2 2 2 2 2 2 2 0
D 1 1 3 [1] 2 2 1 2 2 2 2 2 2 2 0
D 1 1 [3] 1 2 2 1 2 2 2 2 2 2 2 0
A 1 1 1 [1] 2 2 1 2 2 2 2 2 2 2 0
A 1 1 1 1 [2] 2 1 2 2 2 2 2 2 2 0
B 1 1 1 1 3 [2] 1 2 2 2 2 2 2 2 0
B 1 1 1 1 3 2 [1] 2 2 2 2 2 2 2 0
B 1 1 1 1 3 2 1 [2] 2 2 2 2 2 2 0
B 1 1 1 1 3 2 1 2 [2] 2 2 2 2 2 0
B 1 1 1 1 3 2 1 2 2 [2] 2 2 2 2 0
B 1 1 1 1 3 2 1 2 2 2 [2] 2 2 2 0
B 1 1 1 1 3 2 1 2 2 2 2 [2] 2 2 0
B 1 1 1 1 3 2 1 2 2 2 2 2 [2] 2 0
B 1 1 1 1 3 2 1 2 2 2 2 2 2 [2] 0
B 1 1 1 1 3 2 1 2 2 2 2 2 2 2 [0]
C 1 1 1 1 3 2 1 2 2 2 2 2 2 [2] 0
C 1 1 1 1 3 2 1 2 2 2 2 2 [2] 2 0
C 1 1 1 1 3 2 1 2 2 2 2 [2] 2 2 0
C 1 1 1 1 3 2 1 2 2 2 [2] 2 2 2 0
C 1 1 1 1 3 2 1 2 2 [2] 2 2 2 2 0
C 1 1 1 1 3 2 1 2 [2] 2 2 2 2 2 0
C 1 1 1 1 3 2 1 [2] 2 2 2 2 2 2 0
C 1 1 1 1 3 2 [1] 2 2 2 2 2 2 2 0
D 1 1 1 1 3 [2] 2 2 2 2 2 2 2 2 0
D 1 1 1 1 [3] 2 2 2 2 2 2 2 2 2 0
A 1 1 1 1 1 [2] 2 2 2 2 2 2 2 2 0
B 1 1 1 1 1 3 [2] 2 2 2 2 2 2 2 0
B 1 1 1 1 1 3 2 [2] 2 2 2 2 2 2 0
B 1 1 1 1 1 3 2 2 [2] 2 2 2 2 2 0
B 1 1 1 1 1 3 2 2 2 [2] 2 2 2 2 0
B 1 1 1 1 1 3 2 2 2 2 [2] 2 2 2 0
B 1 1 1 1 1 3 2 2 2 2 2 [2] 2 2 0
B 1 1 1 1 1 3 2 2 2 2 2 2 [2] 2 0
B 1 1 1 1 1 3 2 2 2 2 2 2 2 [2] 0
B 1 1 1 1 1 3 2 2 2 2 2 2 2 2 [0]
C 1 1 1 1 1 3 2 2 2 2 2 2 2 [2] 0
C 1 1 1 1 1 3 2 2 2 2 2 2 [2] 2 0
C 1 1 1 1 1 3 2 2 2 2 2 [2] 2 2 0
C 1 1 1 1 1 3 2 2 2 2 [2] 2 2 2 0
C 1 1 1 1 1 3 2 2 2 [2] 2 2 2 2 0
C 1 1 1 1 1 3 2 2 [2] 2 2 2 2 2 0
C 1 1 1 1 1 3 2 [2] 2 2 2 2 2 2 0
C 1 1 1 1 1 3 [2] 2 2 2 2 2 2 2 0
C 1 1 1 1 1 [3] 2 2 2 2 2 2 2 2 0
E 1 1 1 1 [1] 2 2 2 2 2 2 2 2 2 0
E 1 1 1 [1] 1 2 2 2 2 2 2 2 2 2 0
E 1 1 [1] 1 1 2 2 2 2 2 2 2 2 2 0
E 1 [1] 1 1 1 2 2 2 2 2 2 2 2 2 0
E [1] 1 1 1 1 2 2 2 2 2 2 2 2 2 0
E [0] 1 1 1 1 1 2 2 2 2 2 2 2 2 2 0
STOP 0 [1] 1 1 1 1 2 2 2 2 2 2 2 2 2 0</pre>
=={{header|REXX}}==
Line 7,391 ⟶ 9,471:
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 7,434 ⟶ 9,514:
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 7,446 ⟶ 9,526:
===three-state busy beaver===
<
state = 'a' /*the initial Turing machine state. */
term = 'halt' /*a state that is used for a halt. */
Line 7,460 ⟶ 9,540:
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
TM: ∙∙∙ </
'''output'''
<pre>
Line 7,476 ⟶ 9,556:
===five-state busy beaver===
<
state = 'A' /*initialize the Turing machine state.*/
term = 'H' /*a state that is used for the halt. */
Line 7,494 ⟶ 9,574:
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
TM: ∙∙∙ </
'''output'''
<pre>
Line 7,526 ⟶ 9,606:
===stress sort===
<
state = 'A' /*the initial Turing machine state. */
term = 'halt' /*a state that is used for the halt. */
Line 7,548 ⟶ 9,628:
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
TM: ∙∙∙ </
'''output'''
<pre>
Line 7,573 ⟶ 9,653:
=={{header|Ruby}}==
===The universal machine===
<
class Tape
def initialize(symbols, blank, starting_tape)
Line 7,634 ⟶ 9,714:
return @tape.get_tape
end
end</
===The incrementer machine===
<
:q0 => { 1 => [1, :right, :q0],
:b => [1, :stay, :qf]}
Line 7,648 ⟶ 9,728:
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 7,666 ⟶ 9,746:
busy_beaver_rules, # operating rules
[]) # starting tape
print t.run, "\n"</
=={{header|Rust}}==
<syntaxhighlight lang="rust">use std::collections::VecDeque;
use std::fmt::{Display, Formatter, Result};
fn main() {
println!("Simple incrementer");
let rules_si = vec!(
Rule::new("q0", '1', '1', Direction::Right, "q0"),
Rule::new("q0", 'B', '1', Direction::Stay, "qf")
);
let states_si = vec!("q0", "qf");
let terminating_states_si = vec!("qf");
let permissible_symbols_si = vec!('B', '1');
let mut tm_si = TM::new(states_si, "q0", terminating_states_si, permissible_symbols_si, 'B', rules_si, "111");
while !tm_si.is_done() {
println!("{}", tm_si);
tm_si.step();
}
println!("___________________");
println!("Three-state busy beaver");
let rules_bb3 = vec!(
Rule::new("a", '0', '1', Direction::Right, "b"),
Rule::new("a", '1', '1', Direction::Left, "c"),
Rule::new("b", '0', '1', Direction::Left, "a"),
Rule::new("b", '1', '1', Direction::Right, "b"),
Rule::new("c", '0', '1', Direction::Left, "b"),
Rule::new("c", '1', '1', Direction::Stay, "halt"),
);
let states_bb3 = vec!("a", "b", "c", "halt");
let terminating_states_bb3 = vec!("halt");
let permissible_symbols_bb3 = vec!('0', '1');
let mut tm_bb3 = TM::new(states_bb3 ,"a", terminating_states_bb3, permissible_symbols_bb3, '0', rules_bb3, "0");
while !tm_bb3.is_done() {
println!("{}", tm_bb3);
tm_bb3.step();
}
println!("{}", tm_bb3);
println!("___________________");
println!("Five-state busy beaver");
let rules_bb5 = vec!(
Rule::new("A", '0', '1', Direction::Right, "B"),
Rule::new("A", '1', '1', Direction::Left, "C"),
Rule::new("B", '0', '1', Direction::Right, "C"),
Rule::new("B", '1', '1', Direction::Right, "B"),
Rule::new("C", '0', '1', Direction::Right, "D"),
Rule::new("C", '1', '0', Direction::Left, "E"),
Rule::new("D", '0', '1', Direction::Left, "A"),
Rule::new("D", '1', '1', Direction::Left, "D"),
Rule::new("E", '0', '1', Direction::Stay, "H"),
Rule::new("E", '1', '0', Direction::Left, "A"),
);
let states_bb5 = vec!("A", "B", "C", "D", "E", "H");
let terminating_states_bb5 = vec!("H");
let permissible_symbols_bb5 = vec!('0', '1');
let mut tm_bb5 = TM::new(states_bb5 ,"A", terminating_states_bb5, permissible_symbols_bb5, '0', rules_bb5, "0");
let mut steps = 0;
while !tm_bb5.is_done() {
tm_bb5.step();
steps += 1;
}
println!("Steps: {}", steps);
println!("Band lenght: {}", tm_bb5.band.len());
}
struct TM<'a> {
state: &'a str,
terminating_states: Vec<&'a str>,
rules: Vec<Rule<'a>>,
band: VecDeque<char>,
head: usize,
blank: char,
}
struct Rule<'a> {
state: &'a str,
read: char,
write: char,
dir: Direction,
new_state: &'a str,
}
enum Direction{
Left,
Right,
Stay,
}
impl<'a> TM<'a> {
fn new(_states: Vec<&'a str>, initial_state: &'a str, terminating_states: Vec<&'a str>, _permissible_symbols: Vec<char>, blank: char, rules: Vec<Rule<'a>>, input: &str) -> Self {
Self { state: initial_state, terminating_states, rules, band: input.chars().collect::<VecDeque<_>>(), head: 0, blank }
}
fn is_done(&self) -> bool {
self.terminating_states.contains(&self.state)
}
fn step(&mut self) {
let field = self.band.get(self.head).unwrap();
let rule = self.rules.iter().find(|rule| rule.state == self.state && &rule.read == field).unwrap();
let field = self.band.get_mut(self.head).unwrap();
*field = rule.write;
self.state = rule.new_state;
match rule.dir {
Direction::Left => {
if self.head == 0 {
self.band.push_front(self.blank)
} else {
self.head -= 1;
}
},
Direction::Right => {
if self.head == self.band.len() - 1 {
self.band.push_back(self.blank)
}
self.head += 1;
},
Direction::Stay => {},
}
}
}
impl<'a> Display for TM<'a> {
fn fmt(&self, f: &mut Formatter<'_>) -> Result {
let band = self.band.iter().enumerate().map(|(i, c)| {
if i == self.head {
format!("[{}]", c)
} else {
format!(" {} ", c)
}
}).fold(String::new(), |acc, val| acc + &val);
write!(f, "{}\t{}", self.state, band)
}
}
impl<'a> Rule<'a> {
fn new(state: &'a str, read: char, write: char, dir: Direction, new_state: &'a str) -> Self {
Self { state, read, write, dir, new_state }
}
}
</syntaxhighlight>
{{out}}
<pre>
Simple incrementer
q0 [1] 1 1
q0 1 [1] 1
q0 1 1 [1]
q0 1 1 1 [B]
___________________
Three-state busy beaver
a [0]
b 1 [0]
a [1] 1
c [0] 1 1
b [0] 1 1 1
a [0] 1 1 1 1
b 1 [1] 1 1 1
b 1 1 [1] 1 1
b 1 1 1 [1] 1
b 1 1 1 1 [1]
b 1 1 1 1 1 [0]
a 1 1 1 1 [1] 1
c 1 1 1 [1] 1 1
halt 1 1 1 [1] 1 1
___________________
Five-state busy beaver
Steps: 47176870
Band lenght: 12289
</pre>
=={{header|Scala}}==
<
package utm.scala
Line 7,681 ⟶ 9,934:
* Turing machine on arbitrary input
*
* @author Abdulla Abdurakhmanov (https://github.com/
*/
class UniversalTuringMachine[S](
val rules: List[UTMRule[S]],
val finalStates: Set[S],
val inputTapeVals: Iterable[String],
printEveryIter: Int = 1
) {
print( s"${curIteration}: ${state}: " )
tape.printTape()
}
if (finalStates.contains( state )) {
tape
} else {
rules.find(rule => rule.state == state && rule.fromSymbol == tape.current() ) match {
case Some( rule ) => {
val updatedTape = tape.updated( rule.toSymbol, rule.action )
iterate( rule.toState, curIteration + 1, updatedTape )
}
case _ => {
println(
s"Finished: no suitable rules found for ${state}/${tape.current()}"
)
tape.printTape()
tape
}
}
}
}
iterate( state = initialState, curIteration = 0, tape = initialTape )
}
/**
sealed trait UTMAction
object UTMAction {
case object left extends UTMAction
case object right extends UTMAction
case object stay extends UTMAction
}
/**
case class
object UTMRule {
implicit def tupleToUTMLRule[S](
tuple: ( S, String, String, UTMAction, S )
): UTMRule[S] =
UTMRule[S]( tuple._1, tuple._2, tuple._3, tuple._4, tuple._5 )
}
/**
* Universal Turing Machine Tape
*/
case class UTMTape( content: Vector[String], position: Int, blankSymbol: String ) {
private def updateContentAtPos( symbol: String ) = {
if (position >= content.length) {
content :+ symbol
} else if (position < 0) {
symbol +: content
} else if (content( position ) != symbol)
content.updated( position, symbol )
else
content
}
val updatedTape =
this.copy( content = updateContentAtPos( symbol ), position = action match {
case UTMAction.left => position - 1
case UTMAction.right => position + 1
case UTMAction.stay => position
} )
if (updatedTape.position < 0) {
updatedTape.copy(
content = blankSymbol +: updatedTape.content,
position = 0
)
updatedTape.copy( content = updatedTape.content :+ blankSymbol )
updatedTape
}
private[scala] def current(): String = {
if (content.isDefinedAt( position ))
content( position )
else
blankSymbol
}
def printTape(): Unit = {
print( "[" )
if (position < 0)
print( "˅" )
content.zipWithIndex.foreach {
case ( symbol, index ) =>
if (position == index)
print( "˅" )
else
print( " " )
print( s"$symbol" )
}
if (position >= content.length)
print( "˅" )
println( "]" )
}
}
Line 7,820 ⟶ 10,068:
object UniversalTuringMachine extends App {
main()
def main(): Unit = {
import UTMAction._
def createIncrementMachine() = {
sealed trait
case object q0 extends IncrementStates
case object qf extends IncrementStates
new UniversalTuringMachine[IncrementStates](
rules = List( ( q0, "1", "1", right, q0 ), ( q0, "B", "1", stay, qf ) ),
initialState = q0,
finalStates = Set( qf ),
blankSymbol = "B",
inputTapeVals = Seq( "1", "1", "1" )
).run()
}
def createThreeStateBusyBeaver() = {
sealed trait ThreeStateBusyStates
case object a extends ThreeStateBusyStates
case object b extends ThreeStateBusyStates
case object c extends ThreeStateBusyStates
case object halt extends ThreeStateBusyStates
new UniversalTuringMachine[ThreeStateBusyStates](
rules = List(
( a, "0", "1", right, b ),
( a, "1", "1", left, c ),
( b, "0", "1", left, a ),
( b, "1", "1", right, b ),
( c, "0", "1", left, b ),
( c, "1", "1", stay, halt )
),
initialState = a,
finalStates = Set( halt ),
blankSymbol = "0",
inputTapeVals = Seq()
).run()
}
def createFiveState2SymBusyBeaverMachine() = {
sealed trait FiveBeaverStates
case object FD extends FiveBeaverStates
case object FE extends FiveBeaverStates
case object FH extends FiveBeaverStates
( FD, "0", "1", left, FA ),
( FD, "1", "1", left, FD ),
( FE, "0", "1", stay, FH ),
( FE, "1", "0", left, FA )
),
initialState = FA,
finalStates = Set( FH ),
blankSymbol = "0",
inputTapeVals = Seq(),
printEveryIter = 100000
).run()
}
createIncrementMachine()
createThreeStateBusyBeaver()
// careful here, 47 mln iterations
createFiveState2SymBusyBeaverMachine()
}
}
</syntaxhighlight>
{{output}}
<pre>
Line 7,942 ⟶ 10,176:
13: halt(): [ 1 1 1˅1 1 1]
Finished in the final state: halt()
</pre>
=={{header|Scheme}}==
{{works with|Chez Scheme}}
'''The Implementation'''
<syntaxhighlight lang="scheme">;----------------------------------------------------------------------------------------------
; The tape is a doubly-linked list of "cells". Each cell is a pair in which the cdr points
; 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)
(vector-ref (car cell) 0)))
; Store the value of the cell.
; Clears the un-written flag of the cell.
(define cell-set!
(lambda (cell val)
(vector-set! (car cell) 0 val)
(vector-set! (car cell) 2 #f)))
; Return the cell to the right of the given cell on the tape.
; Returns () if there is no cell to the right.
(define cell-right
(lambda (cell)
(cdr cell)))
; Return the cell to the left of the given cell on the tape.
; Returns () if there is no cell to the left.
(define cell-left
(lambda (cell)
(vector-ref (car cell) 1)))
; 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 (if (pair? opt-unwrit) (make-cell blank (car opt-unwrit)) (make-cell blank))))
(vector-set! (car new) 1 cell)
(set-cdr! cell new)
new)
(cell-right cell))))
; 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? (vector-ref (car cell) 1))
(let ((new (if (pair? opt-unwrit) (make-cell blank (car opt-unwrit)) (make-cell blank))))
(set-cdr! new cell)
(vector-set! (car cell) 1 new)
new)
(cell-left cell))))
; 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)
(unless (pair? values) (error 'make-tape "values argument is not a list" pads))
(let* ((tape (make-cell (car values)))
(last (do ((values (cdr values) (cdr values))
(cell tape (cell-extend-right cell (car values))))
((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)))
; Make a deep copy of the given tape.
; Note: Only copies from the given cell forward.
(define tape-copy
(lambda (tape)
(let ((copy (make-cell (cell-get tape))))
(do ((tape (cdr tape) (cdr tape))
(cell copy (cell-extend-right cell (cell-get tape))))
((null? tape)))
copy)))
; 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)
(let ((fst (do ((fst cell (cell-left fst))) ((null? (cell-left fst)) fst))))
(if (null? opt-blank)
fst
(do ((fst fst (cell-right fst)))
((or (null? (cell-right fst)) (not (eq? (car opt-blank) (cell-get fst)))) fst))))))
; 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)
(let ((lst (do ((lst cell (cell-right lst))) ((null? (cell-right lst)) lst))))
(if (null? opt-blank)
lst
(do ((lst lst (cell-left lst)))
((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)))
(and (null? (cell-right fst)) (eq? blank (cell-get fst))))))
; Convert the contents of a tape to a string.
; Place a mark around the indicated cell (if any match).
; 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)))
(let* ((mark-now (eq? cell mark))
(fmtstr (cond (mark-now " {~a}") (marked-prev " ~a") (else " ~a")))
(value (if (and (not mark-now) (cell-unwrit? cell)) " " (cell-get cell))))
(set! strlst (append strlst (string->list (format fmtstr value))))
(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
; make access relatively fast. The transitions are stored in an association list keyed by
; the pair (q_i . s_j) for ease of lookup.
; Make a new Turing Machine from the given arguments:
; Symbols list, blank symbol, input symbols list, states list, initial state, final (accepting)
; states list, and list of transitions. A transition is a 5-element list of: state (q_i),
; symbol read (s_i), symbol to write (s_ij), direction to move (d_ij), and next state (q_ij).
(define make-turing
(lambda (symbols blank inputs states initial finals . transitions)
; Raise error if any element in list lst is not in list set.
(define all-list-in-set
(lambda (set lst msg)
(for-each (lambda (val) (unless (memq val set) (error 'make-turing msg val))) lst)))
; Raise error if the given transition is not correctly formed.
(define transition-validate
(lambda (tran)
(when (or (not (list? tran)) (not (= 5 (length tran))))
(error 'make-turing "transition not a length-5 list" tran))
(let ((q_i (list-ref tran 0))
(s_j (list-ref tran 1))
(s_ij (list-ref tran 2))
(d_ij (list-ref tran 3))
(q_ij (list-ref tran 4)))
(unless (memq q_i states) (error 'make-turing "q_i not in states" q_i))
(unless (memq s_j symbols) (error 'make-turing "s_j not in symbols" s_j))
(unless (memq s_ij symbols) (error 'make-turing "s_ij not in symbols" s_ij))
(unless (memq d_ij '(L R N)) (error 'make-turing "d_ij not in {L R N}" d_ij))
(unless (memq q_ij states) (error 'make-turing "q_ij not in states" q_ij)))))
; Convert the given transitions list into an alist of transitions keyed by (q_i . s_j).
(define transitions-alist
(lambda (trns)
(cond ((null? trns) '())
(else (cons (cons (cons (caar trns) (cadar trns)) (list (cddar trns)))
(transitions-alist (cdr trns)))))))
; Validate all the arguments.
(unless (list? symbols) (error 'make-turing "symbols not a list" symbols))
(unless (memq blank symbols) (error 'make-turing "blank not in symbols" blank))
(all-list-in-set symbols inputs "inputs not all in symbols")
(unless (list? states) (error 'make-turing "states not a list" states))
(unless (memq initial states) (error 'make-turing "initial not in states" initial))
(all-list-in-set states finals "finals not all in states")
(for-each (lambda (tran) (transition-validate tran)) transitions)
; Construct and return the Turing Machine tuple vector.
(let ((tuple (make-vector 7)))
(vector-set! tuple 0 symbols)
(vector-set! tuple 1 blank)
(vector-set! tuple 2 inputs)
(vector-set! tuple 3 states)
(vector-set! tuple 4 initial)
(vector-set! tuple 5 finals)
(vector-set! tuple 6 (transitions-alist transitions))
tuple)))
; Return the symbols of a Turing Machine.
(define-syntax turing-symbols (syntax-rules () ((_ tm) (vector-ref tm 0))))
; Return the blank symbol of a Turing Machine.
(define-syntax turing-blank (syntax-rules () ((_ tm) (vector-ref tm 1))))
; Return the input symbols of a Turing Machine.
(define-syntax turing-inputs (syntax-rules () ((_ tm) (vector-ref tm 2))))
; Return the states of a Turing Machine.
(define-syntax turing-states (syntax-rules () ((_ tm) (vector-ref tm 3))))
; Return the initial state of a Turing Machine.
(define-syntax turing-initial (syntax-rules () ((_ tm) (vector-ref tm 4))))
; Return the final states of a Turing Machine.
(define-syntax turing-finals (syntax-rules () ((_ tm) (vector-ref tm 5))))
; 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.
(define-syntax tran-s_ij (syntax-rules () ((_ atran) (car (cadr atran)))))
; Return the d_ij (direction of move) of alist element transition.
(define-syntax tran-d_ij (syntax-rules () ((_ atran) (cadr (cadr atran)))))
; Return the q_ij (state transition) of alist element transition.
(define-syntax tran-q_ij (syntax-rules () ((_ atran) (caddr (cadr atran)))))
; Lookup the transition matching the given state and symbol in the given Turing Machine.
(define atrns-lookup
(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.
; If specified, display log of progress. Optionally, abort after given number of iterations.
; Returns the count of iterations, the accepting state (if one; else void), and the output
; tape as multiple values.
(define turing-run
(lambda (tm cell show-log? . opt-abort)
; Validate contents of input tape. (Leading/trailing blanks allowed; internals are not.)
(unless (tape-empty? cell (turing-blank tm))
(let ((fst (tape-fst cell (turing-blank tm)))
(lst (tape-lst cell (turing-blank tm))))
(if (eq? fst lst)
(unless (memq (cell-get fst) (turing-symbols tm))
(error 'turing-run "input tape has disallowed content" (cell-get fst)))
(do ((cell fst (cell-right cell)))
((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)
(abort (and (pair? opt-abort) (integer? (car opt-abort))
(> (car opt-abort) 0) (car opt-abort))))
; Loop until no transition matches state/symbol or reached a final state.
(do ((count 0 (1+ count))
(atran (atrns-lookup state (cell-get head) tm)
(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 "~a ~a -> ~a ~a ~a" state (cell-get head)
(tran-s_ij atran) (tran-d_ij atran) (tran-q_ij atran)))
(strlen (string-length string))
(padlen (max 1 (- 25 strlen)))
(strpad (make-string padlen #\ )))
(printf "~a~a~a~%" string strpad (tape->string cell head))))
; Iterate.
(cell-set! head (tran-s_ij atran))
(set! state (tran-q_ij atran))
(set! head (case (tran-d_ij atran)
((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))
(unless (null? tests)
(newline)
(set! input (tape-copy (caddar tests)))
(let-values (((count accepting output)
(turing-run tm (caddar tests) (cadar tests) (caar tests))))
(if (memq 'leng opts)
(printf "count = ~d~%accept = ~a~%output length = ~d~%"
count accepting (length output))
(let ((instr (if (memq 'supp opts)
(tape->string input #f (turing-blank tm))
(tape->string input #f)))
(outstr (if (memq 'supp opts)
(tape->string output (if (memq 'mark opts) output #f)
(turing-blank tm))
(tape->string output (if (memq 'mark opts) output #f)))))
(printf "count = ~d~%accept = ~a~%" count accepting)
(when (or (memq 'show opts) (not (tape-empty? input (turing-blank tm))))
(printf "input = ~a~%" instr))
(printf "output = ~a~%" outstr))))
(loop (cdr tests)))))))
;----------------------------------------------------------------------------------------------</syntaxhighlight>
'''The Task'''
<syntaxhighlight lang="scheme">(run-tm-tests
"Simple incrementer"
(make-turing
'(B 1)
'B
'(1)
'(q0 qf)
'q0
'(qf)
'(q0 1 1 R q0)
'(q0 B 1 N qf))
(list
(list 0 #t (make-tape '(1 1 1)))
(list 0 #t (make-tape '(B)))
) 'notm 'mark)
(run-tm-tests
"Three-state busy beaver"
(make-turing
'(0 1)
'0
'()
'(a b c halt)
'a
'(halt)
'(a 0 1 R b)
'(a 1 1 L c)
'(b 0 1 L a)
'(b 1 1 R b)
'(c 0 1 L b)
'(c 1 1 N halt))
(list
(list 0 #t (make-tape '(0) 0 3 2)) ; padding determined empirically
) 'notm 'mark)
(run-tm-tests
"5-state 2-symbol probable busy beaver"
(make-turing
'(0 1)
'0
'()
'(A B C D E H)
'A
'(H)
'(A 0 1 R B)
'(A 1 1 L C)
'(B 0 1 R C)
'(B 1 1 R B)
'(C 0 1 R D)
'(C 1 0 L E)
'(D 0 1 L A)
'(D 1 1 L D)
'(E 0 1 N H)
'(E 1 0 L A))
(list
(list 0 #f (make-tape '(0)))
) 'notm 'leng)</syntaxhighlight>
{{out}}
<pre style="height: 75ex; overflow: scroll">
Simple incrementer...
q0 1 -> 1 R q0 [ {1} 1 1 ]
q0 1 -> 1 R q0 [ 1 {1} 1 ]
q0 1 -> 1 R q0 [ 1 1 {1} ]
q0 B -> 1 N qf [ 1 1 1 {B} ]
qf [ 1 1 1 {1} ]
count = 4
accept = qf
input = [ 1 1 1 ]
output = [ 1 1 1 {1} ]
q0 B -> 1 N qf [ {B} ]
qf [ {1} ]
count = 1
accept = qf
output = [ {1} ]
Three-state busy beaver...
a 0 -> 1 R b [ {0} ]
b 0 -> 1 L a [ 1 {0} ]
a 1 -> 1 L c [ {1} 1 ]
c 0 -> 1 L b [ {0} 1 1 ]
b 0 -> 1 L a [ {0} 1 1 1 ]
a 0 -> 1 R b [ {0} 1 1 1 1 ]
b 1 -> 1 R b [ 1 {1} 1 1 1 ]
b 1 -> 1 R b [ 1 1 {1} 1 1 ]
b 1 -> 1 R b [ 1 1 1 {1} 1 ]
b 1 -> 1 R b [ 1 1 1 1 {1} ]
b 0 -> 1 L a [ 1 1 1 1 1 {0} ]
a 1 -> 1 L c [ 1 1 1 1 {1} 1 ]
c 1 -> 1 N halt [ 1 1 1 {1} 1 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...
count = 47176870
accept = H
output length = 12289
</pre>
'''More Examples'''
<syntaxhighlight lang="scheme">(run-tm-tests
"Sorting test"
(make-turing
'(0 1 2 3)
'0
'(1 2)
'(A B C D E STOP)
'A
'(STOP)
'(A 1 1 R A)
'(A 2 3 R B)
'(A 0 0 L E)
'(B 1 1 R B)
'(B 2 2 R B)
'(B 0 0 L C)
'(C 1 2 L D)
'(C 2 2 L C)
'(C 3 2 L E)
'(D 1 1 L D)
'(D 2 2 L D)
'(D 3 1 R A)
'(E 1 1 L E)
'(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
"Duplicate sequence of 1s"
(make-turing
'(0 1)
'0
'(1)
'(s1 s2 s3 s4 s5 H)
's1
'(H)
'(s1 0 0 N H)
'(s1 1 0 R s2)
'(s2 0 0 R s3)
'(s2 1 1 R s2)
'(s3 0 1 L s4)
'(s3 1 1 R s3)
'(s4 0 0 L s5)
'(s4 1 1 L s4)
'(s5 0 1 R s1)
'(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
"Turing's first example from On Computable Numbers"
(make-turing
'(_ 0 1)
'_
'(_)
'(b c e f)
'b
'()
'(b _ 0 R c)
'(c _ _ R e)
'(e _ 1 R f)
'(f _ _ R b))
(list
(list 20 #t (make-tape '(_)))
) 'notm 'mark)
(run-tm-tests
"Palindrome checker"
(make-turing
'(_ 1 2)
'_
'(1 2)
'(br r1 e1 r2 e2 wl odd even)
'br
'(odd even)
; branch to look for 1 or 2 at end
'(br 1 _ R r1)
'(br 2 _ R r2)
'(br _ _ N even)
; walk right to end for 1
'(r1 1 1 R r1)
'(r1 2 2 R r1)
'(r1 _ _ L e1)
; check end symbol for 1
'(e1 1 _ L wl)
'(e1 _ _ N odd)
; walk right to end for 2
'(r2 2 2 R r2)
'(r2 1 1 R r2)
'(r2 _ _ L e2)
; check end symbol for 2
'(e2 2 _ L wl)
'(e2 _ _ N odd)
; walk left to beginning
'(wl 1 1 L wl)
'(wl 2 2 L wl)
'(wl _ _ R br))
(list
(list 0 #t (make-tape '(1 2 1)))
(list 0 #t (make-tape '(1 2 2)))
(list 0 #t (make-tape '(1 1)))
(list 0 #t (make-tape '(2 1)))
(list 0 #t (make-tape '(1)))
(list 0 #f (make-tape '(2 1 1 1 2)))
(list 0 #f (make-tape '(2 1 1 2 2)))
(list 0 #f (make-tape '(1 1 2 2 1 1)))
(list 0 #f (make-tape '(1 1 2 2 1 2)))
) 'notm 'mark)</syntaxhighlight>
{{out}}
<pre style="height: 107ex; overflow: scroll">
Sorting test...
A 2 -> 3 R B [ {2} 2 2 1 2 2 1 2 1 2 1 2 1 2 ]
B 2 -> 2 R B [ 3 {2} 2 1 2 2 1 2 1 2 1 2 1 2 ]
B 2 -> 2 R B [ 3 2 {2} 1 2 2 1 2 1 2 1 2 1 2 ]
B 1 -> 1 R B [ 3 2 2 {1} 2 2 1 2 1 2 1 2 1 2 ]
B 2 -> 2 R B [ 3 2 2 1 {2} 2 1 2 1 2 1 2 1 2 ]
B 2 -> 2 R B [ 3 2 2 1 2 {2} 1 2 1 2 1 2 1 2 ]
B 1 -> 1 R B [ 3 2 2 1 2 2 {1} 2 1 2 1 2 1 2 ]
B 2 -> 2 R B [ 3 2 2 1 2 2 1 {2} 1 2 1 2 1 2 ]
B 1 -> 1 R B [ 3 2 2 1 2 2 1 2 {1} 2 1 2 1 2 ]
B 2 -> 2 R B [ 3 2 2 1 2 2 1 2 1 {2} 1 2 1 2 ]
B 1 -> 1 R B [ 3 2 2 1 2 2 1 2 1 2 {1} 2 1 2 ]
B 2 -> 2 R B [ 3 2 2 1 2 2 1 2 1 2 1 {2} 1 2 ]
B 1 -> 1 R B [ 3 2 2 1 2 2 1 2 1 2 1 2 {1} 2 ]
B 2 -> 2 R B [ 3 2 2 1 2 2 1 2 1 2 1 2 1 {2} ]
B 0 -> 0 L C [ 3 2 2 1 2 2 1 2 1 2 1 2 1 2 {0} ]
C 2 -> 2 L C [ 3 2 2 1 2 2 1 2 1 2 1 2 1 {2} 0 ]
C 1 -> 2 L D [ 3 2 2 1 2 2 1 2 1 2 1 2 {1} 2 0 ]
D 2 -> 2 L D [ 3 2 2 1 2 2 1 2 1 2 1 {2} 2 2 0 ]
D 1 -> 1 L D [ 3 2 2 1 2 2 1 2 1 2 {1} 2 2 2 0 ]
D 2 -> 2 L D [ 3 2 2 1 2 2 1 2 1 {2} 1 2 2 2 0 ]
D 1 -> 1 L D [ 3 2 2 1 2 2 1 2 {1} 2 1 2 2 2 0 ]
D 2 -> 2 L D [ 3 2 2 1 2 2 1 {2} 1 2 1 2 2 2 0 ]
D 1 -> 1 L D [ 3 2 2 1 2 2 {1} 2 1 2 1 2 2 2 0 ]
D 2 -> 2 L D [ 3 2 2 1 2 {2} 1 2 1 2 1 2 2 2 0 ]
D 2 -> 2 L D [ 3 2 2 1 {2} 2 1 2 1 2 1 2 2 2 0 ]
D 1 -> 1 L D [ 3 2 2 {1} 2 2 1 2 1 2 1 2 2 2 0 ]
D 2 -> 2 L D [ 3 2 {2} 1 2 2 1 2 1 2 1 2 2 2 0 ]
D 2 -> 2 L D [ 3 {2} 2 1 2 2 1 2 1 2 1 2 2 2 0 ]
D 3 -> 1 R A [ {3} 2 2 1 2 2 1 2 1 2 1 2 2 2 0 ]
A 2 -> 3 R B [ 1 {2} 2 1 2 2 1 2 1 2 1 2 2 2 0 ]
B 2 -> 2 R B [ 1 3 {2} 1 2 2 1 2 1 2 1 2 2 2 0 ]
B 1 -> 1 R B [ 1 3 2 {1} 2 2 1 2 1 2 1 2 2 2 0 ]
B 2 -> 2 R B [ 1 3 2 1 {2} 2 1 2 1 2 1 2 2 2 0 ]
B 2 -> 2 R B [ 1 3 2 1 2 {2} 1 2 1 2 1 2 2 2 0 ]
B 1 -> 1 R B [ 1 3 2 1 2 2 {1} 2 1 2 1 2 2 2 0 ]
B 2 -> 2 R B [ 1 3 2 1 2 2 1 {2} 1 2 1 2 2 2 0 ]
B 1 -> 1 R B [ 1 3 2 1 2 2 1 2 {1} 2 1 2 2 2 0 ]
B 2 -> 2 R B [ 1 3 2 1 2 2 1 2 1 {2} 1 2 2 2 0 ]
B 1 -> 1 R B [ 1 3 2 1 2 2 1 2 1 2 {1} 2 2 2 0 ]
B 2 -> 2 R B [ 1 3 2 1 2 2 1 2 1 2 1 {2} 2 2 0 ]
B 2 -> 2 R B [ 1 3 2 1 2 2 1 2 1 2 1 2 {2} 2 0 ]
B 2 -> 2 R B [ 1 3 2 1 2 2 1 2 1 2 1 2 2 {2} 0 ]
B 0 -> 0 L C [ 1 3 2 1 2 2 1 2 1 2 1 2 2 2 {0} ]
C 2 -> 2 L C [ 1 3 2 1 2 2 1 2 1 2 1 2 2 {2} 0 ]
C 2 -> 2 L C [ 1 3 2 1 2 2 1 2 1 2 1 2 {2} 2 0 ]
C 2 -> 2 L C [ 1 3 2 1 2 2 1 2 1 2 1 {2} 2 2 0 ]
C 1 -> 2 L D [ 1 3 2 1 2 2 1 2 1 2 {1} 2 2 2 0 ]
D 2 -> 2 L D [ 1 3 2 1 2 2 1 2 1 {2} 2 2 2 2 0 ]
D 1 -> 1 L D [ 1 3 2 1 2 2 1 2 {1} 2 2 2 2 2 0 ]
D 2 -> 2 L D [ 1 3 2 1 2 2 1 {2} 1 2 2 2 2 2 0 ]
D 1 -> 1 L D [ 1 3 2 1 2 2 {1} 2 1 2 2 2 2 2 0 ]
D 2 -> 2 L D [ 1 3 2 1 2 {2} 1 2 1 2 2 2 2 2 0 ]
D 2 -> 2 L D [ 1 3 2 1 {2} 2 1 2 1 2 2 2 2 2 0 ]
D 1 -> 1 L D [ 1 3 2 {1} 2 2 1 2 1 2 2 2 2 2 0 ]
D 2 -> 2 L D [ 1 3 {2} 1 2 2 1 2 1 2 2 2 2 2 0 ]
D 3 -> 1 R A [ 1 {3} 2 1 2 2 1 2 1 2 2 2 2 2 0 ]
A 2 -> 3 R B [ 1 1 {2} 1 2 2 1 2 1 2 2 2 2 2 0 ]
B 1 -> 1 R B [ 1 1 3 {1} 2 2 1 2 1 2 2 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 3 1 {2} 2 1 2 1 2 2 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 3 1 2 {2} 1 2 1 2 2 2 2 2 0 ]
B 1 -> 1 R B [ 1 1 3 1 2 2 {1} 2 1 2 2 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 3 1 2 2 1 {2} 1 2 2 2 2 2 0 ]
B 1 -> 1 R B [ 1 1 3 1 2 2 1 2 {1} 2 2 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 3 1 2 2 1 2 1 {2} 2 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 3 1 2 2 1 2 1 2 {2} 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 3 1 2 2 1 2 1 2 2 {2} 2 2 0 ]
B 2 -> 2 R B [ 1 1 3 1 2 2 1 2 1 2 2 2 {2} 2 0 ]
B 2 -> 2 R B [ 1 1 3 1 2 2 1 2 1 2 2 2 2 {2} 0 ]
B 0 -> 0 L C [ 1 1 3 1 2 2 1 2 1 2 2 2 2 2 {0} ]
C 2 -> 2 L C [ 1 1 3 1 2 2 1 2 1 2 2 2 2 {2} 0 ]
C 2 -> 2 L C [ 1 1 3 1 2 2 1 2 1 2 2 2 {2} 2 0 ]
C 2 -> 2 L C [ 1 1 3 1 2 2 1 2 1 2 2 {2} 2 2 0 ]
C 2 -> 2 L C [ 1 1 3 1 2 2 1 2 1 2 {2} 2 2 2 0 ]
C 2 -> 2 L C [ 1 1 3 1 2 2 1 2 1 {2} 2 2 2 2 0 ]
C 1 -> 2 L D [ 1 1 3 1 2 2 1 2 {1} 2 2 2 2 2 0 ]
D 2 -> 2 L D [ 1 1 3 1 2 2 1 {2} 2 2 2 2 2 2 0 ]
D 1 -> 1 L D [ 1 1 3 1 2 2 {1} 2 2 2 2 2 2 2 0 ]
D 2 -> 2 L D [ 1 1 3 1 2 {2} 1 2 2 2 2 2 2 2 0 ]
D 2 -> 2 L D [ 1 1 3 1 {2} 2 1 2 2 2 2 2 2 2 0 ]
D 1 -> 1 L D [ 1 1 3 {1} 2 2 1 2 2 2 2 2 2 2 0 ]
D 3 -> 1 R A [ 1 1 {3} 1 2 2 1 2 2 2 2 2 2 2 0 ]
A 1 -> 1 R A [ 1 1 1 {1} 2 2 1 2 2 2 2 2 2 2 0 ]
A 2 -> 3 R B [ 1 1 1 1 {2} 2 1 2 2 2 2 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 1 1 3 {2} 1 2 2 2 2 2 2 2 0 ]
B 1 -> 1 R B [ 1 1 1 1 3 2 {1} 2 2 2 2 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 1 1 3 2 1 {2} 2 2 2 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 1 1 3 2 1 2 {2} 2 2 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 1 1 3 2 1 2 2 {2} 2 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 1 1 3 2 1 2 2 2 {2} 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 1 1 3 2 1 2 2 2 2 {2} 2 2 0 ]
B 2 -> 2 R B [ 1 1 1 1 3 2 1 2 2 2 2 2 {2} 2 0 ]
B 2 -> 2 R B [ 1 1 1 1 3 2 1 2 2 2 2 2 2 {2} 0 ]
B 0 -> 0 L C [ 1 1 1 1 3 2 1 2 2 2 2 2 2 2 {0} ]
C 2 -> 2 L C [ 1 1 1 1 3 2 1 2 2 2 2 2 2 {2} 0 ]
C 2 -> 2 L C [ 1 1 1 1 3 2 1 2 2 2 2 2 {2} 2 0 ]
C 2 -> 2 L C [ 1 1 1 1 3 2 1 2 2 2 2 {2} 2 2 0 ]
C 2 -> 2 L C [ 1 1 1 1 3 2 1 2 2 2 {2} 2 2 2 0 ]
C 2 -> 2 L C [ 1 1 1 1 3 2 1 2 2 {2} 2 2 2 2 0 ]
C 2 -> 2 L C [ 1 1 1 1 3 2 1 2 {2} 2 2 2 2 2 0 ]
C 2 -> 2 L C [ 1 1 1 1 3 2 1 {2} 2 2 2 2 2 2 0 ]
C 1 -> 2 L D [ 1 1 1 1 3 2 {1} 2 2 2 2 2 2 2 0 ]
D 2 -> 2 L D [ 1 1 1 1 3 {2} 2 2 2 2 2 2 2 2 0 ]
D 3 -> 1 R A [ 1 1 1 1 {3} 2 2 2 2 2 2 2 2 2 0 ]
A 2 -> 3 R B [ 1 1 1 1 1 {2} 2 2 2 2 2 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 1 1 1 3 {2} 2 2 2 2 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 1 1 1 3 2 {2} 2 2 2 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 1 1 1 3 2 2 {2} 2 2 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 1 1 1 3 2 2 2 {2} 2 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 1 1 1 3 2 2 2 2 {2} 2 2 2 0 ]
B 2 -> 2 R B [ 1 1 1 1 1 3 2 2 2 2 2 {2} 2 2 0 ]
B 2 -> 2 R B [ 1 1 1 1 1 3 2 2 2 2 2 2 {2} 2 0 ]
B 2 -> 2 R B [ 1 1 1 1 1 3 2 2 2 2 2 2 2 {2} 0 ]
B 0 -> 0 L C [ 1 1 1 1 1 3 2 2 2 2 2 2 2 2 {0} ]
C 2 -> 2 L C [ 1 1 1 1 1 3 2 2 2 2 2 2 2 {2} 0 ]
C 2 -> 2 L C [ 1 1 1 1 1 3 2 2 2 2 2 2 {2} 2 0 ]
C 2 -> 2 L C [ 1 1 1 1 1 3 2 2 2 2 2 {2} 2 2 0 ]
C 2 -> 2 L C [ 1 1 1 1 1 3 2 2 2 2 {2} 2 2 2 0 ]
C 2 -> 2 L C [ 1 1 1 1 1 3 2 2 2 {2} 2 2 2 2 0 ]
C 2 -> 2 L C [ 1 1 1 1 1 3 2 2 {2} 2 2 2 2 2 0 ]
C 2 -> 2 L C [ 1 1 1 1 1 3 2 {2} 2 2 2 2 2 2 0 ]
C 2 -> 2 L C [ 1 1 1 1 1 3 {2} 2 2 2 2 2 2 2 0 ]
C 3 -> 2 L E [ 1 1 1 1 1 {3} 2 2 2 2 2 2 2 2 0 ]
E 1 -> 1 L E [ 1 1 1 1 {1} 2 2 2 2 2 2 2 2 2 0 ]
E 1 -> 1 L E [ 1 1 1 {1} 1 2 2 2 2 2 2 2 2 2 0 ]
E 1 -> 1 L E [ 1 1 {1} 1 1 2 2 2 2 2 2 2 2 2 0 ]
E 1 -> 1 L E [ 1 {1} 1 1 1 2 2 2 2 2 2 2 2 2 0 ]
E 1 -> 1 L E [ {1} 1 1 1 1 2 2 2 2 2 2 2 2 2 0 ]
E 0 -> 0 R STOP [ {0} 1 1 1 1 1 2 2 2 2 2 2 2 2 2 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 -> 0 R s2 [ {1} 1 1 ]
s2 1 -> 1 R s2 [ 0 {1} 1 ]
s2 1 -> 1 R s2 [ 0 1 {1} ]
s2 0 -> 0 R s3 [ 0 1 1 {0} ]
s3 0 -> 1 L s4 [ 0 1 1 0 {0} ]
s4 0 -> 0 L s5 [ 0 1 1 {0} 1 ]
s5 1 -> 1 L s5 [ 0 1 {1} 0 1 ]
s5 1 -> 1 L s5 [ 0 {1} 1 0 1 ]
s5 0 -> 1 R s1 [ {0} 1 1 0 1 ]
s1 1 -> 0 R s2 [ 1 {1} 1 0 1 ]
s2 1 -> 1 R s2 [ 1 0 {1} 0 1 ]
s2 0 -> 0 R s3 [ 1 0 1 {0} 1 ]
s3 1 -> 1 R s3 [ 1 0 1 0 {1} ]
s3 0 -> 1 L s4 [ 1 0 1 0 1 {0} ]
s4 1 -> 1 L s4 [ 1 0 1 0 {1} 1 ]
s4 0 -> 0 L s5 [ 1 0 1 {0} 1 1 ]
s5 1 -> 1 L s5 [ 1 0 {1} 0 1 1 ]
s5 0 -> 1 R s1 [ 1 {0} 1 0 1 1 ]
s1 1 -> 0 R s2 [ 1 1 {1} 0 1 1 ]
s2 0 -> 0 R s3 [ 1 1 0 {0} 1 1 ]
s3 1 -> 1 R s3 [ 1 1 0 0 {1} 1 ]
s3 1 -> 1 R s3 [ 1 1 0 0 1 {1} ]
s3 0 -> 1 L s4 [ 1 1 0 0 1 1 {0} ]
s4 1 -> 1 L s4 [ 1 1 0 0 1 {1} 1 ]
s4 1 -> 1 L s4 [ 1 1 0 0 {1} 1 1 ]
s4 0 -> 0 L s5 [ 1 1 0 {0} 1 1 1 ]
s5 0 -> 1 R s1 [ 1 1 {0} 0 1 1 1 ]
s1 0 -> 0 N H [ 1 1 1 {0} 1 1 1 ]
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 _ -> 0 R c [ {_} ]
c _ -> _ R e [ 0 {_} ]
e _ -> 1 R f [ 0 _ {_} ]
f _ -> _ R b [ 0 _ 1 {_} ]
b _ -> 0 R c [ 0 _ 1 _ {_} ]
c _ -> _ R e [ 0 _ 1 _ 0 {_} ]
e _ -> 1 R f [ 0 _ 1 _ 0 _ {_} ]
f _ -> _ R b [ 0 _ 1 _ 0 _ 1 {_} ]
b _ -> 0 R c [ 0 _ 1 _ 0 _ 1 _ {_} ]
c _ -> _ R e [ 0 _ 1 _ 0 _ 1 _ 0 {_} ]
e _ -> 1 R f [ 0 _ 1 _ 0 _ 1 _ 0 _ {_} ]
f _ -> _ R b [ 0 _ 1 _ 0 _ 1 _ 0 _ 1 {_} ]
b _ -> 0 R c [ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ {_} ]
c _ -> _ R e [ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ 0 {_} ]
e _ -> 1 R f [ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ 0 _ {_} ]
f _ -> _ R b [ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ 0 _ 1 {_} ]
b _ -> 0 R c [ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ {_} ]
c _ -> _ R e [ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ 0 {_} ]
e _ -> 1 R f [ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ 0 _ {_} ]
f _ -> _ R b [ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ 0 _ 1 _ 0 _ 1 {_} ]
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...
br 1 -> _ R r1 [ {1} 2 1 ]
r1 2 -> 2 R r1 [ _ {2} 1 ]
r1 1 -> 1 R r1 [ _ 2 {1} ]
r1 _ -> _ L e1 [ _ 2 1 {_} ]
e1 1 -> _ L wl [ _ 2 {1} _ ]
wl 2 -> 2 L wl [ _ {2} _ _ ]
wl _ -> _ R br [ {_} 2 _ _ ]
br 2 -> _ R r2 [ _ {2} _ _ ]
r2 _ -> _ L e2 [ _ _ {_} _ ]
e2 _ -> _ N odd [ _ {_} _ _ ]
odd [ _ {_} _ _ ]
count = 10
accept = odd
input = [ 1 2 1 ]
output = [ _ {_} _ _ ]
br 1 -> _ R r1 [ {1} 2 2 ]
r1 2 -> 2 R r1 [ _ {2} 2 ]
r1 2 -> 2 R r1 [ _ 2 {2} ]
r1 _ -> _ L e1 [ _ 2 2 {_} ]
e1 [ _ 2 {2} _ ]
count = 4
accept = #<void>
input = [ 1 2 2 ]
output = [ _ 2 {2} _ ]
br 1 -> _ R r1 [ {1} 1 ]
r1 1 -> 1 R r1 [ _ {1} ]
r1 _ -> _ L e1 [ _ 1 {_} ]
e1 1 -> _ L wl [ _ {1} _ ]
wl _ -> _ R br [ {_} _ _ ]
br _ -> _ N even [ _ {_} _ ]
even [ _ {_} _ ]
count = 6
accept = even
input = [ 1 1 ]
output = [ _ {_} _ ]
br 2 -> _ R r2 [ {2} 1 ]
r2 1 -> 1 R r2 [ _ {1} ]
r2 _ -> _ L e2 [ _ 1 {_} ]
e2 [ _ {1} _ ]
count = 3
accept = #<void>
input = [ 2 1 ]
output = [ _ {1} _ ]
br 1 -> _ R r1 [ {1} ]
r1 _ -> _ L e1 [ _ {_} ]
e1 _ -> _ N odd [ {_} _ ]
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 7,947 ⟶ 11,045:
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 8,164 ⟶ 11,262:
(CurrentConfig: mConfig.FinalConfig, CurrentPosition: newState.CurrentPosition, Tape: newState.Tape);
//endregion</
'''C++ Driver Code:'''<br>
<
#include <fstream>
#include <string>
Line 8,233 ⟶ 11,331:
}
throw(errno);
}</
'''Turing Machine Files'''<br />
Line 8,369 ⟶ 11,467:
|
halt</pre>
=={{header|Sidef}}==
{{trans|
<
if (pos < 0) {
Line 8,470 ⟶ 11,567:
%w(E 1 1 left E),
%w(E 0 0 right STOP),
]);</
=={{header|Standard ML}}==
Line 8,484 ⟶ 11,581:
<
signature TAPE = sig
Line 8,815 ⟶ 11,912:
val () = simulate_int sorting NONE
end
</syntaxhighlight>
{{output}}
Line 8,900 ⟶ 11,997:
Terminated.
</pre>
=={{header|Tcl}}==
<
set state $initial
set idx 0
Line 8,939 ⟶ 12,035:
}
return [join $tape ""]
}</
Demonstrating:
<
puts TAPE=[turing {q0 qf} q0 qf {1 B} B "111" {
{q0 1 1 right q0}
Line 8,972 ⟶ 12,068:
{E 1 1 left E}
{E 0 0 right H}
} no]</
{{out}}
<pre>
Line 9,016 ⟶ 12,112:
TAPE=0111111222222220
</pre>
=={{header|UNIX Shell}}==
{{works with|Bourne Again Shell|4+}}
<syntaxhighlight lang="sh">#!/usr/bin/env bash
main() {
printf 'Simple Incrementer\n'
printf '1 1 1' | run_utm q0 qf B q0,1,1,R,q0 q0,B,1,S,qf
printf '\nThree-state busy beaver\n'
run_utm a halt 0 \
a,0,1,R,b a,1,1,L,c b,0,1,L,a b,1,1,R,b c,0,1,L,b c,1,1,S,halt \
</dev/null
}
run_utm() {
local initial=$1 final=$2 blank=$3
shift 3
local rules=("$@") tape
mapfile -t -d' ' tape
if (( ! ${#tape[@]} )); then
tape=( "$blank" )
fi
local state=$initial
local head=0
while [[ $state != $final ]]; do
print_state "$state" "$head" "${tape[@]}"
local symbol=${tape[head]}
local found=0 rule from input output move to
for rule in "${rules[@]}"; do
IFS=, read from input output move to <<<"$rule"
if [[ $state == $from && $symbol == $input ]]; then
found=1
break
fi
done
if (( ! found )); then
printf >&2 "Configuration error: no match for state=$state input=$sym\n"
return 1
fi
tape[head]=$output
state=$to
case "$move" in
L) if (( ! head-- )); then
head=0
tape=("$blank" "${tape[@]}")
fi
;;
R) if (( ++head >= ${#tape[@]} )); then
tape+=("$blank")
fi
;;
esac
done
print_state "$state" "$head" "${tape[@]}"
}
print_state() {
local state=$1 head=$2
shift 2
local tape=("$@")
printf '%s' "$state"
printf ' %s' "${tape[@]}"
printf '\r'
(( t = ${#state} + 1 + 3 * head ))
printf '\e['"$t"'C<\e[C>\n'
}
main "$@"
</syntaxhighlight>
{{Output}}
<pre>Simple Incrementer
q0 <1> 1 1
q0 1 <1> 1
q0 1 1 <1>
q0 1 1 1 <B>
qf 1 1 1 <1>
Three-state busy beaver
a <0>
b 1 <0>
a <1> 1
c <0> 1 1
b <0> 1 1 1
a <0> 1 1 1 1
b 1 <1> 1 1 1
b 1 1 <1> 1 1
b 1 1 1 <1> 1
b 1 1 1 1 <1>
b 1 1 1 1 1 <0>
a 1 1 1 1 <1> 1
c 1 1 1 <1> 1 1
halt 1 1 1 <1> 1 1</pre>
=={{header|VBA}}==
{{trans|Phix}}<
Public Enum sett
name_ = 1
Line 9,130 ⟶ 12,318:
Set tap = New Collection
UTM fiveStateBB, tap, countOnly:=-1
End Sub</
<pre>Simple incrementer
==================
Line 9,163 ⟶ 12,351:
======================
Steps taken: 47176870</pre>
=={{header|Wren}}==
{{trans|Kotlin}}
{{libheader|Wren-dynamic}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="wren">import "./dynamic" for Enum, Tuple, Struct
import "./fmt" for Fmt
var Dir = Enum.create("Dir", ["LEFT", "RIGHT", "STAY"])
var Rule = Tuple.create("Rule", ["state1", "symbol1", "symbol2", "dir", "state2"])
var Tape = Struct.create("Tape", ["symbol", "left", "right"])
class Turing {
construct new(states, finalStates, symbols, blank, state, tapeInput, rules) {
_states = states
_finalStates = finalStates
_symbols = symbols
_blank = blank
_state = state
_tape = null
_transitions = List.filled(_states.count, null)
for (i in 0..._states.count) _transitions[i] = List.filled(_symbols.count, null)
for (i in 0...tapeInput.count) {
move_(Dir.RIGHT)
_tape.symbol = tapeInput[i]
}
if (tapeInput.count == 0) move_(Dir.RIGHT)
while (_tape.left) _tape = _tape.left
for (i in 0...rules.count) {
var rule = rules[i]
_transitions[stateIndex_(rule.state1)][symbolIndex_(rule.symbol1)] = rule
}
}
stateIndex_(state) {
var i = _states.indexOf(state)
return (i >= 0) ? i : 0
}
symbolIndex_(symbol) {
var i = _symbols.indexOf(symbol)
return (i >= 0) ? i : 0
}
move_(dir) {
var orig = _tape
if (dir == Dir.RIGHT) {
if (orig && orig.right) {
_tape = orig.right
} else {
_tape = Tape.new(_blank, null, null)
if (orig) {
_tape.left = orig
orig.right = _tape
}
}
} else if (dir == Dir.LEFT) {
if (orig && orig.left) {
_tape = orig.left
} else {
_tape = Tape.new(_blank, null, null)
if (orig) {
_tape.right = orig
orig.left = _tape
}
}
} else if (dir == Dir.STAY) {}
}
printState() {
Fmt.write("$-10s ", _state)
var t = _tape
while (t.left) t = t.left
while (t) {
if (t == _tape) {
System.write("[%(t.symbol)]")
} else {
System.write(" %(t.symbol) ")
}
t = t.right
}
System.print()
}
run(maxLines) {
var lines = 0
while (true) {
printState()
for (finalState in _finalStates) {
if (finalState == _state) return
}
lines = lines + 1
if (lines == maxLines) {
System.print("(Only the first %(maxLines) lines displayed)")
return
}
var rule = _transitions[stateIndex_(_state)][symbolIndex_(_tape.symbol)]
_tape.symbol = rule.symbol2
move_(rule.dir)
_state = rule.state2
}
}
}
System.print("Simple incrementer")
Turing.new(
["q0", "qf"], // states
["qf"], // finalStates
["B", "1"], // symbols
"B", // blank
"q0", // state
["1", "1", "1"], // tapeInput
[ // rules
Rule.new("q0", "1", "1", Dir.RIGHT, "q0"),
Rule.new("q0", "B", "1", Dir.STAY, "qf")
]
).run(20)
System.print("\nThree-state busy beaver")
Turing.new(
["a", "b", "c", "halt"], // states
["halt"], // finalStates
["0", "1"], // symbols
"0", // blank
"a", // state
[], // tapeInput
[ // rules
Rule.new("a", "0", "1", Dir.RIGHT, "b"),
Rule.new("a", "1", "1", Dir.LEFT, "c"),
Rule.new("b", "0", "1", Dir.LEFT, "a"),
Rule.new("b", "1", "1", Dir.RIGHT, "b"),
Rule.new("c", "0", "1", Dir.LEFT, "b"),
Rule.new("c", "1", "1", Dir.STAY, "halt")
]
).run(20)
System.print("\nFive-state two-symbol probable busy beaver")
Turing.new(
["A", "B", "C", "D", "E", "H"], // states
["H"], // finalStates
["0", "1"], // symbols
"0", // blank
"A", // state
[], // tapeInput
[ // rules
Rule.new("A", "0", "1", Dir.RIGHT, "B"),
Rule.new("A", "1", "1", Dir.LEFT, "C"),
Rule.new("B", "0", "1", Dir.RIGHT, "C"),
Rule.new("B", "1", "1", Dir.RIGHT, "B"),
Rule.new("C", "0", "1", Dir.RIGHT, "D"),
Rule.new("C", "1", "0", Dir.LEFT, "E"),
Rule.new("D", "0", "1", Dir.LEFT, "A"),
Rule.new("D", "1", "1", Dir.LEFT, "D"),
Rule.new("E", "0", "1", Dir.STAY, "H"),
Rule.new("E", "1", "0", Dir.LEFT, "A")
]
).run(20)</syntaxhighlight>
{{out}}
<pre>
Simple incrementer
q0 [1] 1 1
q0 1 [1] 1
q0 1 1 [1]
q0 1 1 1 [B]
qf 1 1 1 [1]
Three-state busy beaver
a [0]
b 1 [0]
a [1] 1
c [0] 1 1
b [0] 1 1 1
a [0] 1 1 1 1
b 1 [1] 1 1 1
b 1 1 [1] 1 1
b 1 1 1 [1] 1
b 1 1 1 1 [1]
b 1 1 1 1 1 [0]
a 1 1 1 1 [1] 1
c 1 1 1 [1] 1 1
halt 1 1 1 [1] 1 1
Five-state two-symbol probable busy beaver
A [0]
B 1 [0]
C 1 1 [0]
D 1 1 1 [0]
A 1 1 [1] 1
C 1 [1] 1 1
E [1] 0 1 1
A [0] 0 0 1 1
B 1 [0] 0 1 1
C 1 1 [0] 1 1
D 1 1 1 [1] 1
D 1 1 [1] 1 1
D 1 [1] 1 1 1
D [1] 1 1 1 1
D [0] 1 1 1 1 1
A [0] 1 1 1 1 1 1
B 1 [1] 1 1 1 1 1
B 1 1 [1] 1 1 1 1
B 1 1 1 [1] 1 1 1
B 1 1 1 1 [1] 1 1
(Only the first 20 lines displayed)
</pre>
=={{header|Yabasic}}==
{{trans|Lua}}
<
name = 1 : initState = 2 : endState = 3 : blank = 4 : countOnly = true
Line 9,277 ⟶ 12,674:
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 9,301 ⟶ 12,698:
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 9,327 ⟶ 12,724:
"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>
|