Rosetta Code

Universal Turing machine: Difference between revisions

Page Discussion

Universal Turing machine (view source)

Revision as of 10:30, 15 February 2024

798 bytes removed ,  4 months ago
m
→‎{{header|Wren}}: Minor tidy
No edit summary
m (→‎{{header|Wren}}: Minor tidy)
 
(16 intermediate revisions by 3 users not shown)
Line 761:
 
=={{header|APL}}==
===⍺===
{{works with|Dyalog APL}}
<syntaxhighlight lang="apl">:Namespace Turing
Line 843 ⟶ 844:
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}}==
Line 2,372 ⟶ 2,412:
5-state busy beaver (first 20 cells)
10100100100100100100...</pre>
===Control language===
Tmcl is a tiny Turing machine control language.
 
====Instruction set====
 
Tmcl uses postfix notation.
 
<pre>'=' : if scanned symbol = op do
'%' : print op
'<' : move left
'>' : move right
'@' : state <- op
<symbol> : op <- symbol</pre>
 
====Program====
 
Tape is split into two stacks.
 
<pre>T = reverse (left) . right where right is the scanned symbol.
0</pre>
 
<syntaxhighlight lang="lisp">;; 22.06.26
 
(defun run (rules right state halt blank)
(let (left rule op match)
(loop until (member state halt) do
(setf rule (cdr (assoc state rules)) match t)
(loop for token in rule do
(case token
(= (setf match (eql (car right) op)))
(% (when match (rplaca right op)))
(< (when match (push (pop left) right)))
(> (when match (push (pop right) left)))
(@ (when match (setf state op) (return)))
(t (setf op token)))
(unless (car right)
(setf right (cons blank (cdr right))))))
(format t "Q = <~a ~{~a~}.~{~a~}>~%" state (reverse left) right)))</syntaxhighlight>
 
====Code====
 
code is stored in association lists.
 
<syntaxhighlight lang="lisp">(defconstant +incrementer+ '((q0 . (1 = > q0 @ b = 1 % qf @))))
 
(defconstant +three-states-buzy-beaver+ '((a . (0 = 1 % > b @ 1 = < c @))
(b . (0 = 1 % < a @ 1 = > b @))
(c . (0 = 1 % < b @ 1 = halt @))))</syntaxhighlight>
 
====Execution====
 
{{out}}
<pre>(run +incrementer+ '(1 1 1) 'q0 '(qf) 'b)
Q = <QF 111.1>
(run +three-states-buzy-beaver+ '(0) 'a '(halt) '0)
Q = <HALT 111.111></pre>
 
That's all Folks !
 
''cyril nocton (cyril.nocton@gmail.com)''
 
=={{header|Cowgol}}==
<syntaxhighlight lang="cowgol">include "cowgol.coh";
Line 4,532 ⟶ 4,511:
=={{header|Fōrmulæ}}==
 
{{FormulaeEntry|page=https://formulae.org/?script=examples/Universal_Turing_machine}}
Fōrmulæ programs are not textual, visualization/edition of programs is done showing/manipulating structures but not text. Moreover, there can be multiple visual representations of the same program. Even though it is possible to have textual representation &mdash;i.e. XML, JSON&mdash; they are intended for storage and transfer purposes more than visualization and edition.
 
'''Solution'''
Programs in Fōrmulæ are created/edited online in its [https://formulae.org website], However they run on execution servers. By default remote servers are used, but they are limited in memory and processing power, since they are intended for demonstration and casual use. A local server can be downloaded and installed, it has no limitations (it runs in your own computer). Because of that, example programs can be fully visualized and edited, but some of them will not run if they require a moderate or heavy computation/memory resources, and no local server is being used.
 
[[File:Fōrmulæ - Universal Turing machine 01.png]]
In '''[https://formulae.org/?example=Universal_Turing_machine this]''' page you can see the program(s) related to this task and their results.
 
'''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}}==
Line 6,540 ⟶ 6,559:
 
<syntaxhighlight lang="m2000 interpreter">
Module CheckIt {
print "Universal Turing Machine"
print "------------------------Universal Turing Machine"
print "------------------------"
class Machine {
class Machine {
private:
private:
Head=1, Symbols=(,), States=(,)
Head=1, Symbols=(,), States=(,)
Initial_State$, Terminating_state$, Blank_Symbol$
Initial_State$, Terminating_state$, Blank_Symbol$
BS=0, Rules=list, caption$
BS=0, Rules=list, caption$
tp$="{0:4} {1} {2} {3:5} {4:4}"
tp$="{0:4} {1} {2} {3:5} {4:4}"
public:
public:
Module States {
.Module States<=array([]) {
.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()
Module Symbols {
For Turing1 {
.Symbols<=array([])
.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()
Module Reset (.Initial_State$, .Terminating_state$, .Blank_Symbol$) {
For Turing2 {
if len(.States)=0 then error "No States defined"
.init "Three-state busy beaver"
if len(.Symbols)=0 then error "No Symbols defined"
if .States#nothave(.Initial_State$) then"a", error"b", "Initialc", State Not Exist"halt"
.Symbols "0", "1"
if .States#nothave(.Terminating_state$) then error "Terminating State Not Exist"
.Reset "a", "halt", "0"
it=.Symbols#pos(.Blank_Symbol$) : if it=-1 then error "Blank symbol not exist"
.AddRule "a", "0", "1", "right", "b", "a", "1", "1", "left", "c"
.BS<=it
.AddRule "b", "0", "1", "left", "a", "b", "1", "1", "right", "b"
.Rules<=List
.AddRule "c", "0", "1", "left", "b", "c", "1", "1", "stay", "halt"
.Run 1000, true
}
Module Init (.caption$) {
For Turing1 {
flush // empty stack
.init "Sorter"
print .caption$
.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"
Module AddRule (state$, read_symbol$, write_symbol$, action$, end_state$) {
Turing1.Run 1000, false
if .States#nothave(state$) then Error "State not exist"
Turing3=Machine()
if .symbols#nothave(read_symbol$) then Error "Read Symbol not exist"
for Turing3 {
if .symbols#nothave(write_symbol$) then Error "Read Symbol not exist"
.init "5-state, 2-symbol probable Busy Beaver machine from Wikipedia"
if ("right","left","stay")#nothave(action$) then Error "Action not exist"
.States "A","B","C","D", "E", "H"
if .States#nothave(end_state$) then Error "End state not exist"
try.Symbols ok"0", {"1"
.Reset "A", "H", "0"
tuple=(.symbols#pos(write_symbol$), action$, end_state$)
.AddRule "A", "0", "1", "right", "B", "A", "1", "1", "left", "C"
Append .rules, state$+"_"+read_symbol$:=tuple
.AddRule "B", "0", "1", "right", "C", "B", "1", "1", "right", "B"
}
.AddRule "C", "0", "1", "right", "D", "C", "1", "1", "left", "E"
if not ok then error "rule "+ state$+"_"+read_symbol$+" already exist "
.AddRule "D", "0", "1", "left", "A", "D", "1", "1", "left", "D"
Pen 11 {
.AddRule "E", "0", "1", "stay", "H", "E", "1", "0", "left", "A"
Print format$(.tp$, state$, read_symbol$, write_symbol$, action$, end_state$)
profiler
}
.Run 470, false //000000, false
if stack.size>=5 then loop
Print round(timecount/1000,2);"s" // estimated 12.5 hours for 47000000 steps
}
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" // initial state, terminating state, blank symbol
.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 47000, false //000, false
Print round(timecount/1000,2);"s" // estimated 12.5 hours
}
CheckIt
</syntaxhighlight>
{{out}}
Line 6,723 ⟶ 6,745:
tape length: 6
</pre>
 
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
Line 12,298 ⟶ 12,319:
{{libheader|Wren-dynamic}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="ecmascriptwren">import "./dynamic" for Enum, Tuple, Struct
import "./fmt" for Fmt
 
var Dir = Enum.create("Dir", ["LEFT", "RIGHT", "STAY"])
PureFox
9,486

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/333814...351924"